You can not select more than 25 topics Topics must start with a chinese character,a letter or number, can include dashes ('-') and can be up to 35 characters long.

zdrvpox.f 26 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738
  1. *> \brief \b ZDRVPOX
  2. *
  3. * =========== DOCUMENTATION ===========
  4. *
  5. * Online html documentation available at
  6. * http://www.netlib.org/lapack/explore-html/
  7. *
  8. * Definition:
  9. * ===========
  10. *
  11. * SUBROUTINE ZDRVPO( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX,
  12. * A, AFAC, ASAV, B, BSAV, X, XACT, S, WORK,
  13. * RWORK, NOUT )
  14. *
  15. * .. Scalar Arguments ..
  16. * LOGICAL TSTERR
  17. * INTEGER NMAX, NN, NOUT, NRHS
  18. * DOUBLE PRECISION THRESH
  19. * ..
  20. * .. Array Arguments ..
  21. * LOGICAL DOTYPE( * )
  22. * INTEGER NVAL( * )
  23. * DOUBLE PRECISION RWORK( * ), S( * )
  24. * COMPLEX*16 A( * ), AFAC( * ), ASAV( * ), B( * ),
  25. * $ BSAV( * ), WORK( * ), X( * ), XACT( * )
  26. * ..
  27. *
  28. *
  29. *> \par Purpose:
  30. * =============
  31. *>
  32. *> \verbatim
  33. *>
  34. *> ZDRVPO tests the driver routines ZPOSV, -SVX, and -SVXX.
  35. *>
  36. *> Note that this file is used only when the XBLAS are available,
  37. *> otherwise zdrvpo.f defines this subroutine.
  38. *> \endverbatim
  39. *
  40. * Arguments:
  41. * ==========
  42. *
  43. *> \param[in] DOTYPE
  44. *> \verbatim
  45. *> DOTYPE is LOGICAL array, dimension (NTYPES)
  46. *> The matrix types to be used for testing. Matrices of type j
  47. *> (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
  48. *> .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
  49. *> \endverbatim
  50. *>
  51. *> \param[in] NN
  52. *> \verbatim
  53. *> NN is INTEGER
  54. *> The number of values of N contained in the vector NVAL.
  55. *> \endverbatim
  56. *>
  57. *> \param[in] NVAL
  58. *> \verbatim
  59. *> NVAL is INTEGER array, dimension (NN)
  60. *> The values of the matrix dimension N.
  61. *> \endverbatim
  62. *>
  63. *> \param[in] NRHS
  64. *> \verbatim
  65. *> NRHS is INTEGER
  66. *> The number of right hand side vectors to be generated for
  67. *> each linear system.
  68. *> \endverbatim
  69. *>
  70. *> \param[in] THRESH
  71. *> \verbatim
  72. *> THRESH is DOUBLE PRECISION
  73. *> The threshold value for the test ratios. A result is
  74. *> included in the output file if RESULT >= THRESH. To have
  75. *> every test ratio printed, use THRESH = 0.
  76. *> \endverbatim
  77. *>
  78. *> \param[in] TSTERR
  79. *> \verbatim
  80. *> TSTERR is LOGICAL
  81. *> Flag that indicates whether error exits are to be tested.
  82. *> \endverbatim
  83. *>
  84. *> \param[in] NMAX
  85. *> \verbatim
  86. *> NMAX is INTEGER
  87. *> The maximum value permitted for N, used in dimensioning the
  88. *> work arrays.
  89. *> \endverbatim
  90. *>
  91. *> \param[out] A
  92. *> \verbatim
  93. *> A is COMPLEX*16 array, dimension (NMAX*NMAX)
  94. *> \endverbatim
  95. *>
  96. *> \param[out] AFAC
  97. *> \verbatim
  98. *> AFAC is COMPLEX*16 array, dimension (NMAX*NMAX)
  99. *> \endverbatim
  100. *>
  101. *> \param[out] ASAV
  102. *> \verbatim
  103. *> ASAV is COMPLEX*16 array, dimension (NMAX*NMAX)
  104. *> \endverbatim
  105. *>
  106. *> \param[out] B
  107. *> \verbatim
  108. *> B is COMPLEX*16 array, dimension (NMAX*NRHS)
  109. *> \endverbatim
  110. *>
  111. *> \param[out] BSAV
  112. *> \verbatim
  113. *> BSAV is COMPLEX*16 array, dimension (NMAX*NRHS)
  114. *> \endverbatim
  115. *>
  116. *> \param[out] X
  117. *> \verbatim
  118. *> X is COMPLEX*16 array, dimension (NMAX*NRHS)
  119. *> \endverbatim
  120. *>
  121. *> \param[out] XACT
  122. *> \verbatim
  123. *> XACT is COMPLEX*16 array, dimension (NMAX*NRHS)
  124. *> \endverbatim
  125. *>
  126. *> \param[out] S
  127. *> \verbatim
  128. *> S is DOUBLE PRECISION array, dimension (NMAX)
  129. *> \endverbatim
  130. *>
  131. *> \param[out] WORK
  132. *> \verbatim
  133. *> WORK is COMPLEX*16 array, dimension
  134. *> (NMAX*max(3,NRHS))
  135. *> \endverbatim
  136. *>
  137. *> \param[out] RWORK
  138. *> \verbatim
  139. *> RWORK is DOUBLE PRECISION array, dimension (NMAX+2*NRHS)
  140. *> \endverbatim
  141. *>
  142. *> \param[in] NOUT
  143. *> \verbatim
  144. *> NOUT is INTEGER
  145. *> The unit number for output.
  146. *> \endverbatim
  147. *
  148. * Authors:
  149. * ========
  150. *
  151. *> \author Univ. of Tennessee
  152. *> \author Univ. of California Berkeley
  153. *> \author Univ. of Colorado Denver
  154. *> \author NAG Ltd.
  155. *
  156. *> \date November 2011
  157. *
  158. *> \ingroup complex16_lin
  159. *
  160. * =====================================================================
  161. SUBROUTINE ZDRVPO( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX,
  162. $ A, AFAC, ASAV, B, BSAV, X, XACT, S, WORK,
  163. $ RWORK, NOUT )
  164. *
  165. * -- LAPACK test routine (version 3.4.0) --
  166. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  167. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  168. * November 2011
  169. *
  170. * .. Scalar Arguments ..
  171. LOGICAL TSTERR
  172. INTEGER NMAX, NN, NOUT, NRHS
  173. DOUBLE PRECISION THRESH
  174. * ..
  175. * .. Array Arguments ..
  176. LOGICAL DOTYPE( * )
  177. INTEGER NVAL( * )
  178. DOUBLE PRECISION RWORK( * ), S( * )
  179. COMPLEX*16 A( * ), AFAC( * ), ASAV( * ), B( * ),
  180. $ BSAV( * ), WORK( * ), X( * ), XACT( * )
  181. * ..
  182. *
  183. * =====================================================================
  184. *
  185. * .. Parameters ..
  186. DOUBLE PRECISION ONE, ZERO
  187. PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
  188. INTEGER NTYPES
  189. PARAMETER ( NTYPES = 9 )
  190. INTEGER NTESTS
  191. PARAMETER ( NTESTS = 6 )
  192. * ..
  193. * .. Local Scalars ..
  194. LOGICAL EQUIL, NOFACT, PREFAC, ZEROT
  195. CHARACTER DIST, EQUED, FACT, TYPE, UPLO, XTYPE
  196. CHARACTER*3 PATH
  197. INTEGER I, IEQUED, IFACT, IMAT, IN, INFO, IOFF, IUPLO,
  198. $ IZERO, K, K1, KL, KU, LDA, MODE, N, NB, NBMIN,
  199. $ NERRS, NFACT, NFAIL, NIMAT, NRUN, NT,
  200. $ N_ERR_BNDS
  201. DOUBLE PRECISION AINVNM, AMAX, ANORM, CNDNUM, RCOND, RCONDC,
  202. $ ROLDC, SCOND, RPVGRW_SVXX
  203. * ..
  204. * .. Local Arrays ..
  205. CHARACTER EQUEDS( 2 ), FACTS( 3 ), UPLOS( 2 )
  206. INTEGER ISEED( 4 ), ISEEDY( 4 )
  207. DOUBLE PRECISION RESULT( NTESTS ), BERR( NRHS ),
  208. $ ERRBNDS_N( NRHS, 3 ), ERRBNDS_C( NRHS, 3 )
  209. * ..
  210. * .. External Functions ..
  211. LOGICAL LSAME
  212. DOUBLE PRECISION DGET06, ZLANHE
  213. EXTERNAL LSAME, DGET06, ZLANHE
  214. * ..
  215. * .. External Subroutines ..
  216. EXTERNAL ALADHD, ALAERH, ALASVM, XLAENV, ZERRVX, ZGET04,
  217. $ ZLACPY, ZLAIPD, ZLAQHE, ZLARHS, ZLASET, ZLATB4,
  218. $ ZLATMS, ZPOEQU, ZPOSV, ZPOSVX, ZPOT01, ZPOT02,
  219. $ ZPOT05, ZPOTRF, ZPOTRI, ZPOSVXX
  220. * ..
  221. * .. Scalars in Common ..
  222. LOGICAL LERR, OK
  223. CHARACTER*32 SRNAMT
  224. INTEGER INFOT, NUNIT
  225. * ..
  226. * .. Common blocks ..
  227. COMMON / INFOC / INFOT, NUNIT, OK, LERR
  228. COMMON / SRNAMC / SRNAMT
  229. * ..
  230. * .. Intrinsic Functions ..
  231. INTRINSIC DCMPLX, MAX
  232. * ..
  233. * .. Data statements ..
  234. DATA ISEEDY / 1988, 1989, 1990, 1991 /
  235. DATA UPLOS / 'U', 'L' /
  236. DATA FACTS / 'F', 'N', 'E' /
  237. DATA EQUEDS / 'N', 'Y' /
  238. * ..
  239. * .. Executable Statements ..
  240. *
  241. * Initialize constants and the random number seed.
  242. *
  243. PATH( 1: 1 ) = 'Zomplex precision'
  244. PATH( 2: 3 ) = 'PO'
  245. NRUN = 0
  246. NFAIL = 0
  247. NERRS = 0
  248. DO 10 I = 1, 4
  249. ISEED( I ) = ISEEDY( I )
  250. 10 CONTINUE
  251. *
  252. * Test the error exits
  253. *
  254. IF( TSTERR )
  255. $ CALL ZERRVX( PATH, NOUT )
  256. INFOT = 0
  257. *
  258. * Set the block size and minimum block size for testing.
  259. *
  260. NB = 1
  261. NBMIN = 2
  262. CALL XLAENV( 1, NB )
  263. CALL XLAENV( 2, NBMIN )
  264. *
  265. * Do for each value of N in NVAL
  266. *
  267. DO 130 IN = 1, NN
  268. N = NVAL( IN )
  269. LDA = MAX( N, 1 )
  270. XTYPE = 'N'
  271. NIMAT = NTYPES
  272. IF( N.LE.0 )
  273. $ NIMAT = 1
  274. *
  275. DO 120 IMAT = 1, NIMAT
  276. *
  277. * Do the tests only if DOTYPE( IMAT ) is true.
  278. *
  279. IF( .NOT.DOTYPE( IMAT ) )
  280. $ GO TO 120
  281. *
  282. * Skip types 3, 4, or 5 if the matrix size is too small.
  283. *
  284. ZEROT = IMAT.GE.3 .AND. IMAT.LE.5
  285. IF( ZEROT .AND. N.LT.IMAT-2 )
  286. $ GO TO 120
  287. *
  288. * Do first for UPLO = 'U', then for UPLO = 'L'
  289. *
  290. DO 110 IUPLO = 1, 2
  291. UPLO = UPLOS( IUPLO )
  292. *
  293. * Set up parameters with ZLATB4 and generate a test matrix
  294. * with ZLATMS.
  295. *
  296. CALL ZLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM, MODE,
  297. $ CNDNUM, DIST )
  298. *
  299. SRNAMT = 'ZLATMS'
  300. CALL ZLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE,
  301. $ CNDNUM, ANORM, KL, KU, UPLO, A, LDA, WORK,
  302. $ INFO )
  303. *
  304. * Check error code from ZLATMS.
  305. *
  306. IF( INFO.NE.0 ) THEN
  307. CALL ALAERH( PATH, 'ZLATMS', INFO, 0, UPLO, N, N, -1,
  308. $ -1, -1, IMAT, NFAIL, NERRS, NOUT )
  309. GO TO 110
  310. END IF
  311. *
  312. * For types 3-5, zero one row and column of the matrix to
  313. * test that INFO is returned correctly.
  314. *
  315. IF( ZEROT ) THEN
  316. IF( IMAT.EQ.3 ) THEN
  317. IZERO = 1
  318. ELSE IF( IMAT.EQ.4 ) THEN
  319. IZERO = N
  320. ELSE
  321. IZERO = N / 2 + 1
  322. END IF
  323. IOFF = ( IZERO-1 )*LDA
  324. *
  325. * Set row and column IZERO of A to 0.
  326. *
  327. IF( IUPLO.EQ.1 ) THEN
  328. DO 20 I = 1, IZERO - 1
  329. A( IOFF+I ) = ZERO
  330. 20 CONTINUE
  331. IOFF = IOFF + IZERO
  332. DO 30 I = IZERO, N
  333. A( IOFF ) = ZERO
  334. IOFF = IOFF + LDA
  335. 30 CONTINUE
  336. ELSE
  337. IOFF = IZERO
  338. DO 40 I = 1, IZERO - 1
  339. A( IOFF ) = ZERO
  340. IOFF = IOFF + LDA
  341. 40 CONTINUE
  342. IOFF = IOFF - IZERO
  343. DO 50 I = IZERO, N
  344. A( IOFF+I ) = ZERO
  345. 50 CONTINUE
  346. END IF
  347. ELSE
  348. IZERO = 0
  349. END IF
  350. *
  351. * Set the imaginary part of the diagonals.
  352. *
  353. CALL ZLAIPD( N, A, LDA+1, 0 )
  354. *
  355. * Save a copy of the matrix A in ASAV.
  356. *
  357. CALL ZLACPY( UPLO, N, N, A, LDA, ASAV, LDA )
  358. *
  359. DO 100 IEQUED = 1, 2
  360. EQUED = EQUEDS( IEQUED )
  361. IF( IEQUED.EQ.1 ) THEN
  362. NFACT = 3
  363. ELSE
  364. NFACT = 1
  365. END IF
  366. *
  367. DO 90 IFACT = 1, NFACT
  368. FACT = FACTS( IFACT )
  369. PREFAC = LSAME( FACT, 'F' )
  370. NOFACT = LSAME( FACT, 'N' )
  371. EQUIL = LSAME( FACT, 'E' )
  372. *
  373. IF( ZEROT ) THEN
  374. IF( PREFAC )
  375. $ GO TO 90
  376. RCONDC = ZERO
  377. *
  378. ELSE IF( .NOT.LSAME( FACT, 'N' ) ) THEN
  379. *
  380. * Compute the condition number for comparison with
  381. * the value returned by ZPOSVX (FACT = 'N' reuses
  382. * the condition number from the previous iteration
  383. * with FACT = 'F').
  384. *
  385. CALL ZLACPY( UPLO, N, N, ASAV, LDA, AFAC, LDA )
  386. IF( EQUIL .OR. IEQUED.GT.1 ) THEN
  387. *
  388. * Compute row and column scale factors to
  389. * equilibrate the matrix A.
  390. *
  391. CALL ZPOEQU( N, AFAC, LDA, S, SCOND, AMAX,
  392. $ INFO )
  393. IF( INFO.EQ.0 .AND. N.GT.0 ) THEN
  394. IF( IEQUED.GT.1 )
  395. $ SCOND = ZERO
  396. *
  397. * Equilibrate the matrix.
  398. *
  399. CALL ZLAQHE( UPLO, N, AFAC, LDA, S, SCOND,
  400. $ AMAX, EQUED )
  401. END IF
  402. END IF
  403. *
  404. * Save the condition number of the
  405. * non-equilibrated system for use in ZGET04.
  406. *
  407. IF( EQUIL )
  408. $ ROLDC = RCONDC
  409. *
  410. * Compute the 1-norm of A.
  411. *
  412. ANORM = ZLANHE( '1', UPLO, N, AFAC, LDA, RWORK )
  413. *
  414. * Factor the matrix A.
  415. *
  416. CALL ZPOTRF( UPLO, N, AFAC, LDA, INFO )
  417. *
  418. * Form the inverse of A.
  419. *
  420. CALL ZLACPY( UPLO, N, N, AFAC, LDA, A, LDA )
  421. CALL ZPOTRI( UPLO, N, A, LDA, INFO )
  422. *
  423. * Compute the 1-norm condition number of A.
  424. *
  425. AINVNM = ZLANHE( '1', UPLO, N, A, LDA, RWORK )
  426. IF( ANORM.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
  427. RCONDC = ONE
  428. ELSE
  429. RCONDC = ( ONE / ANORM ) / AINVNM
  430. END IF
  431. END IF
  432. *
  433. * Restore the matrix A.
  434. *
  435. CALL ZLACPY( UPLO, N, N, ASAV, LDA, A, LDA )
  436. *
  437. * Form an exact solution and set the right hand side.
  438. *
  439. SRNAMT = 'ZLARHS'
  440. CALL ZLARHS( PATH, XTYPE, UPLO, ' ', N, N, KL, KU,
  441. $ NRHS, A, LDA, XACT, LDA, B, LDA,
  442. $ ISEED, INFO )
  443. XTYPE = 'C'
  444. CALL ZLACPY( 'Full', N, NRHS, B, LDA, BSAV, LDA )
  445. *
  446. IF( NOFACT ) THEN
  447. *
  448. * --- Test ZPOSV ---
  449. *
  450. * Compute the L*L' or U'*U factorization of the
  451. * matrix and solve the system.
  452. *
  453. CALL ZLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
  454. CALL ZLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
  455. *
  456. SRNAMT = 'ZPOSV '
  457. CALL ZPOSV( UPLO, N, NRHS, AFAC, LDA, X, LDA,
  458. $ INFO )
  459. *
  460. * Check error code from ZPOSV .
  461. *
  462. IF( INFO.NE.IZERO ) THEN
  463. CALL ALAERH( PATH, 'ZPOSV ', INFO, IZERO,
  464. $ UPLO, N, N, -1, -1, NRHS, IMAT,
  465. $ NFAIL, NERRS, NOUT )
  466. GO TO 70
  467. ELSE IF( INFO.NE.0 ) THEN
  468. GO TO 70
  469. END IF
  470. *
  471. * Reconstruct matrix from factors and compute
  472. * residual.
  473. *
  474. CALL ZPOT01( UPLO, N, A, LDA, AFAC, LDA, RWORK,
  475. $ RESULT( 1 ) )
  476. *
  477. * Compute residual of the computed solution.
  478. *
  479. CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK,
  480. $ LDA )
  481. CALL ZPOT02( UPLO, N, NRHS, A, LDA, X, LDA,
  482. $ WORK, LDA, RWORK, RESULT( 2 ) )
  483. *
  484. * Check solution from generated exact solution.
  485. *
  486. CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
  487. $ RESULT( 3 ) )
  488. NT = 3
  489. *
  490. * Print information about the tests that did not
  491. * pass the threshold.
  492. *
  493. DO 60 K = 1, NT
  494. IF( RESULT( K ).GE.THRESH ) THEN
  495. IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
  496. $ CALL ALADHD( NOUT, PATH )
  497. WRITE( NOUT, FMT = 9999 )'ZPOSV ', UPLO,
  498. $ N, IMAT, K, RESULT( K )
  499. NFAIL = NFAIL + 1
  500. END IF
  501. 60 CONTINUE
  502. NRUN = NRUN + NT
  503. 70 CONTINUE
  504. END IF
  505. *
  506. * --- Test ZPOSVX ---
  507. *
  508. IF( .NOT.PREFAC )
  509. $ CALL ZLASET( UPLO, N, N, DCMPLX( ZERO ),
  510. $ DCMPLX( ZERO ), AFAC, LDA )
  511. CALL ZLASET( 'Full', N, NRHS, DCMPLX( ZERO ),
  512. $ DCMPLX( ZERO ), X, LDA )
  513. IF( IEQUED.GT.1 .AND. N.GT.0 ) THEN
  514. *
  515. * Equilibrate the matrix if FACT='F' and
  516. * EQUED='Y'.
  517. *
  518. CALL ZLAQHE( UPLO, N, A, LDA, S, SCOND, AMAX,
  519. $ EQUED )
  520. END IF
  521. *
  522. * Solve the system and compute the condition number
  523. * and error bounds using ZPOSVX.
  524. *
  525. SRNAMT = 'ZPOSVX'
  526. CALL ZPOSVX( FACT, UPLO, N, NRHS, A, LDA, AFAC,
  527. $ LDA, EQUED, S, B, LDA, X, LDA, RCOND,
  528. $ RWORK, RWORK( NRHS+1 ), WORK,
  529. $ RWORK( 2*NRHS+1 ), INFO )
  530. *
  531. * Check the error code from ZPOSVX.
  532. *
  533. IF( INFO.NE.IZERO )
  534. $ CALL ALAERH( PATH, 'ZPOSVX', INFO, IZERO,
  535. $ FACT // UPLO, N, N, -1, -1, NRHS,
  536. $ IMAT, NFAIL, NERRS, NOUT )
  537. GO TO 90
  538. *
  539. IF( INFO.EQ.0 ) THEN
  540. IF( .NOT.PREFAC ) THEN
  541. *
  542. * Reconstruct matrix from factors and compute
  543. * residual.
  544. *
  545. CALL ZPOT01( UPLO, N, A, LDA, AFAC, LDA,
  546. $ RWORK( 2*NRHS+1 ), RESULT( 1 ) )
  547. K1 = 1
  548. ELSE
  549. K1 = 2
  550. END IF
  551. *
  552. * Compute residual of the computed solution.
  553. *
  554. CALL ZLACPY( 'Full', N, NRHS, BSAV, LDA, WORK,
  555. $ LDA )
  556. CALL ZPOT02( UPLO, N, NRHS, ASAV, LDA, X, LDA,
  557. $ WORK, LDA, RWORK( 2*NRHS+1 ),
  558. $ RESULT( 2 ) )
  559. *
  560. * Check solution from generated exact solution.
  561. *
  562. IF( NOFACT .OR. ( PREFAC .AND. LSAME( EQUED,
  563. $ 'N' ) ) ) THEN
  564. CALL ZGET04( N, NRHS, X, LDA, XACT, LDA,
  565. $ RCONDC, RESULT( 3 ) )
  566. ELSE
  567. CALL ZGET04( N, NRHS, X, LDA, XACT, LDA,
  568. $ ROLDC, RESULT( 3 ) )
  569. END IF
  570. *
  571. * Check the error bounds from iterative
  572. * refinement.
  573. *
  574. CALL ZPOT05( UPLO, N, NRHS, ASAV, LDA, B, LDA,
  575. $ X, LDA, XACT, LDA, RWORK,
  576. $ RWORK( NRHS+1 ), RESULT( 4 ) )
  577. ELSE
  578. K1 = 6
  579. END IF
  580. *
  581. * Compare RCOND from ZPOSVX with the computed value
  582. * in RCONDC.
  583. *
  584. RESULT( 6 ) = DGET06( RCOND, RCONDC )
  585. *
  586. * Print information about the tests that did not pass
  587. * the threshold.
  588. *
  589. DO 80 K = K1, 6
  590. IF( RESULT( K ).GE.THRESH ) THEN
  591. IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
  592. $ CALL ALADHD( NOUT, PATH )
  593. IF( PREFAC ) THEN
  594. WRITE( NOUT, FMT = 9997 )'ZPOSVX', FACT,
  595. $ UPLO, N, EQUED, IMAT, K, RESULT( K )
  596. ELSE
  597. WRITE( NOUT, FMT = 9998 )'ZPOSVX', FACT,
  598. $ UPLO, N, IMAT, K, RESULT( K )
  599. END IF
  600. NFAIL = NFAIL + 1
  601. END IF
  602. 80 CONTINUE
  603. NRUN = NRUN + 7 - K1
  604. *
  605. * --- Test ZPOSVXX ---
  606. *
  607. * Restore the matrices A and B.
  608. *
  609. CALL ZLACPY( 'Full', N, N, ASAV, LDA, A, LDA )
  610. CALL ZLACPY( 'Full', N, NRHS, BSAV, LDA, B, LDA )
  611. IF( .NOT.PREFAC )
  612. $ CALL ZLASET( UPLO, N, N, CMPLX( ZERO ),
  613. $ CMPLX( ZERO ), AFAC, LDA )
  614. CALL ZLASET( 'Full', N, NRHS, CMPLX( ZERO ),
  615. $ CMPLX( ZERO ), X, LDA )
  616. IF( IEQUED.GT.1 .AND. N.GT.0 ) THEN
  617. *
  618. * Equilibrate the matrix if FACT='F' and
  619. * EQUED='Y'.
  620. *
  621. CALL ZLAQHE( UPLO, N, A, LDA, S, SCOND, AMAX,
  622. $ EQUED )
  623. END IF
  624. *
  625. * Solve the system and compute the condition number
  626. * and error bounds using ZPOSVXX.
  627. *
  628. SRNAMT = 'ZPOSVXX'
  629. N_ERR_BNDS = 3
  630. CALL ZPOSVXX( FACT, UPLO, N, NRHS, A, LDA, AFAC,
  631. $ LDA, EQUED, S, B, LDA, X,
  632. $ LDA, RCOND, RPVGRW_SVXX, BERR, N_ERR_BNDS,
  633. $ ERRBNDS_N, ERRBNDS_C, 0, ZERO, WORK,
  634. $ RWORK( 2*NRHS+1 ), INFO )
  635. *
  636. * Check the error code from ZPOSVXX.
  637. *
  638. IF( INFO.EQ.N+1 ) GOTO 90
  639. IF( INFO.NE.IZERO ) THEN
  640. CALL ALAERH( PATH, 'ZPOSVXX', INFO, IZERO,
  641. $ FACT // UPLO, N, N, -1, -1, NRHS,
  642. $ IMAT, NFAIL, NERRS, NOUT )
  643. GO TO 90
  644. END IF
  645. *
  646. IF( INFO.EQ.0 ) THEN
  647. IF( .NOT.PREFAC ) THEN
  648. *
  649. * Reconstruct matrix from factors and compute
  650. * residual.
  651. *
  652. CALL ZPOT01( UPLO, N, A, LDA, AFAC, LDA,
  653. $ RWORK( 2*NRHS+1 ), RESULT( 1 ) )
  654. K1 = 1
  655. ELSE
  656. K1 = 2
  657. END IF
  658. *
  659. * Compute residual of the computed solution.
  660. *
  661. CALL ZLACPY( 'Full', N, NRHS, BSAV, LDA, WORK,
  662. $ LDA )
  663. CALL ZPOT02( UPLO, N, NRHS, ASAV, LDA, X, LDA,
  664. $ WORK, LDA, RWORK( 2*NRHS+1 ),
  665. $ RESULT( 2 ) )
  666. *
  667. * Check solution from generated exact solution.
  668. *
  669. IF( NOFACT .OR. ( PREFAC .AND. LSAME( EQUED,
  670. $ 'N' ) ) ) THEN
  671. CALL ZGET04( N, NRHS, X, LDA, XACT, LDA,
  672. $ RCONDC, RESULT( 3 ) )
  673. ELSE
  674. CALL ZGET04( N, NRHS, X, LDA, XACT, LDA,
  675. $ ROLDC, RESULT( 3 ) )
  676. END IF
  677. *
  678. * Check the error bounds from iterative
  679. * refinement.
  680. *
  681. CALL ZPOT05( UPLO, N, NRHS, ASAV, LDA, B, LDA,
  682. $ X, LDA, XACT, LDA, RWORK,
  683. $ RWORK( NRHS+1 ), RESULT( 4 ) )
  684. ELSE
  685. K1 = 6
  686. END IF
  687. *
  688. * Compare RCOND from ZPOSVXX with the computed value
  689. * in RCONDC.
  690. *
  691. RESULT( 6 ) = DGET06( RCOND, RCONDC )
  692. *
  693. * Print information about the tests that did not pass
  694. * the threshold.
  695. *
  696. DO 85 K = K1, 6
  697. IF( RESULT( K ).GE.THRESH ) THEN
  698. IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
  699. $ CALL ALADHD( NOUT, PATH )
  700. IF( PREFAC ) THEN
  701. WRITE( NOUT, FMT = 9997 )'ZPOSVXX', FACT,
  702. $ UPLO, N, EQUED, IMAT, K, RESULT( K )
  703. ELSE
  704. WRITE( NOUT, FMT = 9998 )'ZPOSVXX', FACT,
  705. $ UPLO, N, IMAT, K, RESULT( K )
  706. END IF
  707. NFAIL = NFAIL + 1
  708. END IF
  709. 85 CONTINUE
  710. NRUN = NRUN + 7 - K1
  711. 90 CONTINUE
  712. 100 CONTINUE
  713. 110 CONTINUE
  714. 120 CONTINUE
  715. 130 CONTINUE
  716. *
  717. * Print a summary of the results.
  718. *
  719. CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS )
  720. *
  721. * Test Error Bounds for ZGESVXX
  722. CALL ZEBCHVXX(THRESH, PATH)
  723. 9999 FORMAT( 1X, A, ', UPLO=''', A1, ''', N =', I5, ', type ', I1,
  724. $ ', test(', I1, ')=', G12.5 )
  725. 9998 FORMAT( 1X, A, ', FACT=''', A1, ''', UPLO=''', A1, ''', N=', I5,
  726. $ ', type ', I1, ', test(', I1, ')=', G12.5 )
  727. 9997 FORMAT( 1X, A, ', FACT=''', A1, ''', UPLO=''', A1, ''', N=', I5,
  728. $ ', EQUED=''', A1, ''', type ', I1, ', test(', I1, ') =',
  729. $ G12.5 )
  730. RETURN
  731. *
  732. * End of ZDRVPO
  733. *
  734. END