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.

zdrvsyx.f 24 kB

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