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.

zchksy.f 23 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690
  1. *> \brief \b ZCHKSY
  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 ZCHKSY( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL,
  12. * THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X,
  13. * XACT, WORK, RWORK, IWORK, NOUT )
  14. *
  15. * .. Scalar Arguments ..
  16. * LOGICAL TSTERR
  17. * INTEGER NMAX, NN, NNB, NNS, NOUT
  18. * DOUBLE PRECISION THRESH
  19. * ..
  20. * .. Array Arguments ..
  21. * LOGICAL DOTYPE( * )
  22. * INTEGER IWORK( * ), NBVAL( * ), NSVAL( * ), 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. *> ZCHKSY tests ZSYTRF, -TRI2, -TRS, -TRS2, -RFS, and -CON.
  35. *> \endverbatim
  36. *
  37. * Arguments:
  38. * ==========
  39. *
  40. *> \param[in] DOTYPE
  41. *> \verbatim
  42. *> DOTYPE is LOGICAL array, dimension (NTYPES)
  43. *> The matrix types to be used for testing. Matrices of type j
  44. *> (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
  45. *> .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
  46. *> \endverbatim
  47. *>
  48. *> \param[in] NN
  49. *> \verbatim
  50. *> NN is INTEGER
  51. *> The number of values of N contained in the vector NVAL.
  52. *> \endverbatim
  53. *>
  54. *> \param[in] NVAL
  55. *> \verbatim
  56. *> NVAL is INTEGER array, dimension (NN)
  57. *> The values of the matrix dimension N.
  58. *> \endverbatim
  59. *>
  60. *> \param[in] NNB
  61. *> \verbatim
  62. *> NNB is INTEGER
  63. *> The number of values of NB contained in the vector NBVAL.
  64. *> \endverbatim
  65. *>
  66. *> \param[in] NBVAL
  67. *> \verbatim
  68. *> NBVAL is INTEGER array, dimension (NBVAL)
  69. *> The values of the blocksize NB.
  70. *> \endverbatim
  71. *>
  72. *> \param[in] NNS
  73. *> \verbatim
  74. *> NNS is INTEGER
  75. *> The number of values of NRHS contained in the vector NSVAL.
  76. *> \endverbatim
  77. *>
  78. *> \param[in] NSVAL
  79. *> \verbatim
  80. *> NSVAL is INTEGER array, dimension (NNS)
  81. *> The values of the number of right hand sides NRHS.
  82. *> \endverbatim
  83. *>
  84. *> \param[in] THRESH
  85. *> \verbatim
  86. *> THRESH is DOUBLE PRECISION
  87. *> The threshold value for the test ratios. A result is
  88. *> included in the output file if RESULT >= THRESH. To have
  89. *> every test ratio printed, use THRESH = 0.
  90. *> \endverbatim
  91. *>
  92. *> \param[in] TSTERR
  93. *> \verbatim
  94. *> TSTERR is LOGICAL
  95. *> Flag that indicates whether error exits are to be tested.
  96. *> \endverbatim
  97. *>
  98. *> \param[in] NMAX
  99. *> \verbatim
  100. *> NMAX is INTEGER
  101. *> The maximum value permitted for N, used in dimensioning the
  102. *> work arrays.
  103. *> \endverbatim
  104. *>
  105. *> \param[out] A
  106. *> \verbatim
  107. *> A is COMPLEX*16 array, dimension (NMAX*NMAX)
  108. *> \endverbatim
  109. *>
  110. *> \param[out] AFAC
  111. *> \verbatim
  112. *> AFAC is COMPLEX*16 array, dimension (NMAX*NMAX)
  113. *> \endverbatim
  114. *>
  115. *> \param[out] AINV
  116. *> \verbatim
  117. *> AINV is COMPLEX*16 array, dimension (NMAX*NMAX)
  118. *> \endverbatim
  119. *>
  120. *> \param[out] B
  121. *> \verbatim
  122. *> B is COMPLEX*16 array, dimension (NMAX*NSMAX)
  123. *> where NSMAX is the largest entry in NSVAL.
  124. *> \endverbatim
  125. *>
  126. *> \param[out] X
  127. *> \verbatim
  128. *> X is COMPLEX*16 array, dimension (NMAX*NSMAX)
  129. *> \endverbatim
  130. *>
  131. *> \param[out] XACT
  132. *> \verbatim
  133. *> XACT is COMPLEX*16 array, dimension (NMAX*NSMAX)
  134. *> \endverbatim
  135. *>
  136. *> \param[out] WORK
  137. *> \verbatim
  138. *> WORK is COMPLEX*16 array, dimension (NMAX*max(2,NSMAX))
  139. *> \endverbatim
  140. *>
  141. *> \param[out] RWORK
  142. *> \verbatim
  143. *> RWORK is DOUBLE PRECISION array, dimension (NMAX+2*NSMAX)
  144. *> \endverbatim
  145. *>
  146. *> \param[out] IWORK
  147. *> \verbatim
  148. *> IWORK is INTEGER array, dimension (NMAX)
  149. *> \endverbatim
  150. *>
  151. *> \param[in] NOUT
  152. *> \verbatim
  153. *> NOUT is INTEGER
  154. *> The unit number for output.
  155. *> \endverbatim
  156. *
  157. * Authors:
  158. * ========
  159. *
  160. *> \author Univ. of Tennessee
  161. *> \author Univ. of California Berkeley
  162. *> \author Univ. of Colorado Denver
  163. *> \author NAG Ltd.
  164. *
  165. *> \date November 2013
  166. *
  167. *> \ingroup complex16_lin
  168. *
  169. * =====================================================================
  170. SUBROUTINE ZCHKSY( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL,
  171. $ THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X,
  172. $ XACT, WORK, RWORK, IWORK, NOUT )
  173. *
  174. * -- LAPACK test routine (version 3.5.0) --
  175. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  176. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  177. * November 2013
  178. *
  179. * .. Scalar Arguments ..
  180. LOGICAL TSTERR
  181. INTEGER NMAX, NN, NNB, NNS, NOUT
  182. DOUBLE PRECISION THRESH
  183. * ..
  184. * .. Array Arguments ..
  185. LOGICAL DOTYPE( * )
  186. INTEGER IWORK( * ), NBVAL( * ), NSVAL( * ), NVAL( * )
  187. DOUBLE PRECISION RWORK( * )
  188. COMPLEX*16 A( * ), AFAC( * ), AINV( * ), B( * ),
  189. $ WORK( * ), X( * ), XACT( * )
  190. * ..
  191. *
  192. * =====================================================================
  193. *
  194. * .. Parameters ..
  195. DOUBLE PRECISION ZERO
  196. PARAMETER ( ZERO = 0.0D+0 )
  197. COMPLEX*16 CZERO
  198. PARAMETER ( CZERO = ( 0.0D+0, 0.0D+0 ) )
  199. INTEGER NTYPES
  200. PARAMETER ( NTYPES = 11 )
  201. INTEGER NTESTS
  202. PARAMETER ( NTESTS = 9 )
  203. * ..
  204. * .. Local Scalars ..
  205. LOGICAL TRFCON, ZEROT
  206. CHARACTER DIST, TYPE, UPLO, XTYPE
  207. CHARACTER*3 PATH
  208. INTEGER I, I1, I2, IMAT, IN, INB, INFO, IOFF, IRHS,
  209. $ IUPLO, IZERO, J, K, KL, KU, LDA, LWORK, MODE,
  210. $ N, NB, NERRS, NFAIL, NIMAT, NRHS, NRUN, NT
  211. DOUBLE PRECISION ANORM, CNDNUM, RCOND, RCONDC
  212. * ..
  213. * .. Local Arrays ..
  214. CHARACTER UPLOS( 2 )
  215. INTEGER ISEED( 4 ), ISEEDY( 4 )
  216. DOUBLE PRECISION RESULT( NTESTS )
  217. * ..
  218. * .. External Functions ..
  219. DOUBLE PRECISION DGET06, ZLANSY
  220. EXTERNAL DGET06, ZLANSY
  221. * ..
  222. * .. External Subroutines ..
  223. EXTERNAL ALAERH, ALAHD, ALASUM, XLAENV, ZERRSY, ZGET04,
  224. $ ZLACPY, ZLARHS, ZLATB4, ZLATMS, ZLATSY, ZPOT05,
  225. $ ZSYCON, ZSYRFS, ZSYT01, ZSYT02, ZSYT03, ZSYTRF,
  226. $ ZSYTRI2, ZSYTRS, ZSYTRS2
  227. * ..
  228. * .. Intrinsic Functions ..
  229. INTRINSIC MAX, MIN
  230. * ..
  231. * .. Scalars in Common ..
  232. LOGICAL LERR, OK
  233. CHARACTER*32 SRNAMT
  234. INTEGER INFOT, NUNIT
  235. * ..
  236. * .. Common blocks ..
  237. COMMON / INFOC / INFOT, NUNIT, OK, LERR
  238. COMMON / SRNAMC / SRNAMT
  239. * ..
  240. * .. Data statements ..
  241. DATA ISEEDY / 1988, 1989, 1990, 1991 /
  242. DATA UPLOS / 'U', 'L' /
  243. * ..
  244. * .. Executable Statements ..
  245. *
  246. * Initialize constants and the random number seed.
  247. *
  248. PATH( 1: 1 ) = 'Zomplex precision'
  249. PATH( 2: 3 ) = 'SY'
  250. NRUN = 0
  251. NFAIL = 0
  252. NERRS = 0
  253. DO 10 I = 1, 4
  254. ISEED( I ) = ISEEDY( I )
  255. 10 CONTINUE
  256. *
  257. * Test the error exits
  258. *
  259. IF( TSTERR )
  260. $ CALL ZERRSY( PATH, NOUT )
  261. INFOT = 0
  262. *
  263. * Set the minimum block size for which the block routine should
  264. * be used, which will be later returned by ILAENV
  265. *
  266. CALL XLAENV( 2, 2 )
  267. *
  268. * Do for each value of N in NVAL
  269. *
  270. DO 180 IN = 1, NN
  271. N = NVAL( IN )
  272. LDA = MAX( N, 1 )
  273. XTYPE = 'N'
  274. NIMAT = NTYPES
  275. IF( N.LE.0 )
  276. $ NIMAT = 1
  277. *
  278. IZERO = 0
  279. *
  280. * Do for each value of matrix type IMAT
  281. *
  282. DO 170 IMAT = 1, NIMAT
  283. *
  284. * Do the tests only if DOTYPE( IMAT ) is true.
  285. *
  286. IF( .NOT.DOTYPE( IMAT ) )
  287. $ GO TO 170
  288. *
  289. * Skip types 3, 4, 5, or 6 if the matrix size is too small.
  290. *
  291. ZEROT = IMAT.GE.3 .AND. IMAT.LE.6
  292. IF( ZEROT .AND. N.LT.IMAT-2 )
  293. $ GO TO 170
  294. *
  295. * Do first for UPLO = 'U', then for UPLO = 'L'
  296. *
  297. DO 160 IUPLO = 1, 2
  298. UPLO = UPLOS( IUPLO )
  299. *
  300. * Begin generate test matrix A.
  301. *
  302. IF( IMAT.NE.NTYPES ) THEN
  303. *
  304. * Set up parameters with ZLATB4 for the matrix generator
  305. * based on the type of matrix to be generated.
  306. *
  307. CALL ZLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM,
  308. $ MODE, CNDNUM, DIST )
  309. *
  310. * Generate a matrix with ZLATMS.
  311. *
  312. SRNAMT = 'ZLATMS'
  313. CALL ZLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE,
  314. $ CNDNUM, ANORM, KL, KU, 'N', A, LDA, WORK,
  315. $ INFO )
  316. *
  317. * Check error code from ZLATMS and handle error.
  318. *
  319. IF( INFO.NE.0 ) THEN
  320. CALL ALAERH( PATH, 'ZLATMS', INFO, 0, UPLO, N, N,
  321. $ -1, -1, -1, IMAT, NFAIL, NERRS, NOUT )
  322. *
  323. * Skip all tests for this generated matrix
  324. *
  325. GO TO 160
  326. END IF
  327. *
  328. * For matrix types 3-6, zero one or more rows and
  329. * columns of the matrix to test that INFO is returned
  330. * correctly.
  331. *
  332. IF( ZEROT ) THEN
  333. IF( IMAT.EQ.3 ) THEN
  334. IZERO = 1
  335. ELSE IF( IMAT.EQ.4 ) THEN
  336. IZERO = N
  337. ELSE
  338. IZERO = N / 2 + 1
  339. END IF
  340. *
  341. IF( IMAT.LT.6 ) THEN
  342. *
  343. * Set row and column IZERO to zero.
  344. *
  345. IF( IUPLO.EQ.1 ) THEN
  346. IOFF = ( IZERO-1 )*LDA
  347. DO 20 I = 1, IZERO - 1
  348. A( IOFF+I ) = CZERO
  349. 20 CONTINUE
  350. IOFF = IOFF + IZERO
  351. DO 30 I = IZERO, N
  352. A( IOFF ) = CZERO
  353. IOFF = IOFF + LDA
  354. 30 CONTINUE
  355. ELSE
  356. IOFF = IZERO
  357. DO 40 I = 1, IZERO - 1
  358. A( IOFF ) = CZERO
  359. IOFF = IOFF + LDA
  360. 40 CONTINUE
  361. IOFF = IOFF - IZERO
  362. DO 50 I = IZERO, N
  363. A( IOFF+I ) = CZERO
  364. 50 CONTINUE
  365. END IF
  366. ELSE
  367. IF( IUPLO.EQ.1 ) THEN
  368. *
  369. * Set the first IZERO rows to zero.
  370. *
  371. IOFF = 0
  372. DO 70 J = 1, N
  373. I2 = MIN( J, IZERO )
  374. DO 60 I = 1, I2
  375. A( IOFF+I ) = CZERO
  376. 60 CONTINUE
  377. IOFF = IOFF + LDA
  378. 70 CONTINUE
  379. ELSE
  380. *
  381. * Set the last IZERO rows to zero.
  382. *
  383. IOFF = 0
  384. DO 90 J = 1, N
  385. I1 = MAX( J, IZERO )
  386. DO 80 I = I1, N
  387. A( IOFF+I ) = CZERO
  388. 80 CONTINUE
  389. IOFF = IOFF + LDA
  390. 90 CONTINUE
  391. END IF
  392. END IF
  393. ELSE
  394. IZERO = 0
  395. END IF
  396. *
  397. ELSE
  398. *
  399. * For matrix kind IMAT = 11, generate special block
  400. * diagonal matrix to test alternate code
  401. * for the 2 x 2 blocks.
  402. *
  403. CALL ZLATSY( UPLO, N, A, LDA, ISEED )
  404. *
  405. END IF
  406. *
  407. * End generate test matrix A.
  408. *
  409. *
  410. * Do for each value of NB in NBVAL
  411. *
  412. DO 150 INB = 1, NNB
  413. *
  414. * Set the optimal blocksize, which will be later
  415. * returned by ILAENV.
  416. *
  417. NB = NBVAL( INB )
  418. CALL XLAENV( 1, NB )
  419. *
  420. * Copy the test matrix A into matrix AFAC which
  421. * will be factorized in place. This is needed to
  422. * preserve the test matrix A for subsequent tests.
  423. *
  424. CALL ZLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
  425. *
  426. * Compute the L*D*L**T or U*D*U**T factorization of the
  427. * matrix. IWORK stores details of the interchanges and
  428. * the block structure of D. AINV is a work array for
  429. * block factorization, LWORK is the length of AINV.
  430. *
  431. LWORK = MAX( 2, NB )*LDA
  432. SRNAMT = 'ZSYTRF'
  433. CALL ZSYTRF( UPLO, N, AFAC, LDA, IWORK, AINV, LWORK,
  434. $ INFO )
  435. *
  436. * Adjust the expected value of INFO to account for
  437. * pivoting.
  438. *
  439. K = IZERO
  440. IF( K.GT.0 ) THEN
  441. 100 CONTINUE
  442. IF( IWORK( K ).LT.0 ) THEN
  443. IF( IWORK( K ).NE.-K ) THEN
  444. K = -IWORK( K )
  445. GO TO 100
  446. END IF
  447. ELSE IF( IWORK( K ).NE.K ) THEN
  448. K = IWORK( K )
  449. GO TO 100
  450. END IF
  451. END IF
  452. *
  453. * Check error code from ZSYTRF and handle error.
  454. *
  455. IF( INFO.NE.K )
  456. $ CALL ALAERH( PATH, 'ZSYTRF', INFO, K, UPLO, N, N,
  457. $ -1, -1, NB, IMAT, NFAIL, NERRS, NOUT )
  458. *
  459. * Set the condition estimate flag if the INFO is not 0.
  460. *
  461. IF( INFO.NE.0 ) THEN
  462. TRFCON = .TRUE.
  463. ELSE
  464. TRFCON = .FALSE.
  465. END IF
  466. *
  467. *+ TEST 1
  468. * Reconstruct matrix from factors and compute residual.
  469. *
  470. CALL ZSYT01( UPLO, N, A, LDA, AFAC, LDA, IWORK, AINV,
  471. $ LDA, RWORK, RESULT( 1 ) )
  472. NT = 1
  473. *
  474. *+ TEST 2
  475. * Form the inverse and compute the residual,
  476. * if the factorization was competed without INFO > 0
  477. * (i.e. there is no zero rows and columns).
  478. * Do it only for the first block size.
  479. *
  480. IF( INB.EQ.1 .AND. .NOT.TRFCON ) THEN
  481. CALL ZLACPY( UPLO, N, N, AFAC, LDA, AINV, LDA )
  482. SRNAMT = 'ZSYTRI2'
  483. LWORK = (N+NB+1)*(NB+3)
  484. CALL ZSYTRI2( UPLO, N, AINV, LDA, IWORK, WORK,
  485. $ LWORK, INFO )
  486. *
  487. * Check error code from ZSYTRI2 and handle error.
  488. *
  489. IF( INFO.NE.0 )
  490. $ CALL ALAERH( PATH, 'ZSYTRI2', INFO, 0, UPLO, N,
  491. $ N, -1, -1, -1, IMAT, NFAIL, NERRS,
  492. $ NOUT )
  493. *
  494. * Compute the residual for a symmetric matrix times
  495. * its inverse.
  496. *
  497. CALL ZSYT03( UPLO, N, A, LDA, AINV, LDA, WORK, LDA,
  498. $ RWORK, RCONDC, RESULT( 2 ) )
  499. NT = 2
  500. END IF
  501. *
  502. * Print information about the tests that did not pass
  503. * the threshold.
  504. *
  505. DO 110 K = 1, NT
  506. IF( RESULT( K ).GE.THRESH ) THEN
  507. IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
  508. $ CALL ALAHD( NOUT, PATH )
  509. WRITE( NOUT, FMT = 9999 )UPLO, N, NB, IMAT, K,
  510. $ RESULT( K )
  511. NFAIL = NFAIL + 1
  512. END IF
  513. 110 CONTINUE
  514. NRUN = NRUN + NT
  515. *
  516. * Skip the other tests if this is not the first block
  517. * size.
  518. *
  519. IF( INB.GT.1 )
  520. $ GO TO 150
  521. *
  522. * Do only the condition estimate if INFO is not 0.
  523. *
  524. IF( TRFCON ) THEN
  525. RCONDC = ZERO
  526. GO TO 140
  527. END IF
  528. *
  529. * Do for each value of NRHS in NSVAL.
  530. *
  531. DO 130 IRHS = 1, NNS
  532. NRHS = NSVAL( IRHS )
  533. *
  534. *+ TEST 3 (Using TRS)
  535. * Solve and compute residual for A * X = B.
  536. *
  537. * Choose a set of NRHS random solution vectors
  538. * stored in XACT and set up the right hand side B
  539. *
  540. SRNAMT = 'ZLARHS'
  541. CALL ZLARHS( PATH, XTYPE, UPLO, ' ', N, N, KL, KU,
  542. $ NRHS, A, LDA, XACT, LDA, B, LDA,
  543. $ ISEED, INFO )
  544. CALL ZLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
  545. *
  546. SRNAMT = 'ZSYTRS'
  547. CALL ZSYTRS( UPLO, N, NRHS, AFAC, LDA, IWORK, X,
  548. $ LDA, INFO )
  549. *
  550. * Check error code from ZSYTRS and handle error.
  551. *
  552. IF( INFO.NE.0 )
  553. $ CALL ALAERH( PATH, 'ZSYTRS', INFO, 0, UPLO, N,
  554. $ N, -1, -1, NRHS, IMAT, NFAIL,
  555. $ NERRS, NOUT )
  556. *
  557. CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
  558. *
  559. * Compute the residual for the solution
  560. *
  561. CALL ZSYT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
  562. $ LDA, RWORK, RESULT( 3 ) )
  563. *
  564. *+ TEST 4 (Using TRS2)
  565. * Solve and compute residual for A * X = B.
  566. *
  567. * Choose a set of NRHS random solution vectors
  568. * stored in XACT and set up the right hand side B
  569. *
  570. SRNAMT = 'ZLARHS'
  571. CALL ZLARHS( PATH, XTYPE, UPLO, ' ', N, N, KL, KU,
  572. $ NRHS, A, LDA, XACT, LDA, B, LDA,
  573. $ ISEED, INFO )
  574. CALL ZLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
  575. *
  576. SRNAMT = 'ZSYTRS2'
  577. CALL ZSYTRS2( UPLO, N, NRHS, AFAC, LDA, IWORK, X,
  578. $ LDA, WORK, INFO )
  579. *
  580. * Check error code from ZSYTRS2 and handle error.
  581. *
  582. IF( INFO.NE.0 )
  583. $ CALL ALAERH( PATH, 'ZSYTRS', INFO, 0, UPLO, N,
  584. $ N, -1, -1, NRHS, IMAT, NFAIL,
  585. $ NERRS, NOUT )
  586. *
  587. CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
  588. *
  589. * Compute the residual for the solution
  590. *
  591. CALL ZSYT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
  592. $ LDA, RWORK, RESULT( 4 ) )
  593. *
  594. *
  595. *+ TEST 5
  596. * Check solution from generated exact solution.
  597. *
  598. CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
  599. $ RESULT( 5 ) )
  600. *
  601. *+ TESTS 6, 7, and 8
  602. * Use iterative refinement to improve the solution.
  603. *
  604. SRNAMT = 'ZSYRFS'
  605. CALL ZSYRFS( UPLO, N, NRHS, A, LDA, AFAC, LDA,
  606. $ IWORK, B, LDA, X, LDA, RWORK,
  607. $ RWORK( NRHS+1 ), WORK,
  608. $ RWORK( 2*NRHS+1 ), INFO )
  609. *
  610. * Check error code from ZSYRFS and handle error.
  611. *
  612. IF( INFO.NE.0 )
  613. $ CALL ALAERH( PATH, 'ZSYRFS', INFO, 0, UPLO, N,
  614. $ N, -1, -1, NRHS, IMAT, NFAIL,
  615. $ NERRS, NOUT )
  616. *
  617. CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
  618. $ RESULT( 6 ) )
  619. CALL ZPOT05( UPLO, N, NRHS, A, LDA, B, LDA, X, LDA,
  620. $ XACT, LDA, RWORK, RWORK( NRHS+1 ),
  621. $ RESULT( 7 ) )
  622. *
  623. * Print information about the tests that did not pass
  624. * the threshold.
  625. *
  626. DO 120 K = 3, 8
  627. IF( RESULT( K ).GE.THRESH ) THEN
  628. IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
  629. $ CALL ALAHD( NOUT, PATH )
  630. WRITE( NOUT, FMT = 9998 )UPLO, N, NRHS,
  631. $ IMAT, K, RESULT( K )
  632. NFAIL = NFAIL + 1
  633. END IF
  634. 120 CONTINUE
  635. NRUN = NRUN + 6
  636. *
  637. * End do for each value of NRHS in NSVAL.
  638. *
  639. 130 CONTINUE
  640. *
  641. *+ TEST 9
  642. * Get an estimate of RCOND = 1/CNDNUM.
  643. *
  644. 140 CONTINUE
  645. ANORM = ZLANSY( '1', UPLO, N, A, LDA, RWORK )
  646. SRNAMT = 'ZSYCON'
  647. CALL ZSYCON( UPLO, N, AFAC, LDA, IWORK, ANORM, RCOND,
  648. $ WORK, INFO )
  649. *
  650. * Check error code from ZSYCON and handle error.
  651. *
  652. IF( INFO.NE.0 )
  653. $ CALL ALAERH( PATH, 'ZSYCON', INFO, 0, UPLO, N, N,
  654. $ -1, -1, -1, IMAT, NFAIL, NERRS, NOUT )
  655. *
  656. * Compute the test ratio to compare values of RCOND
  657. *
  658. RESULT( 9 ) = DGET06( RCOND, RCONDC )
  659. *
  660. * Print information about the tests that did not pass
  661. * the threshold.
  662. *
  663. IF( RESULT( 9 ).GE.THRESH ) THEN
  664. IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
  665. $ CALL ALAHD( NOUT, PATH )
  666. WRITE( NOUT, FMT = 9997 )UPLO, N, IMAT, 9,
  667. $ RESULT( 9 )
  668. NFAIL = NFAIL + 1
  669. END IF
  670. NRUN = NRUN + 1
  671. 150 CONTINUE
  672. 160 CONTINUE
  673. 170 CONTINUE
  674. 180 CONTINUE
  675. *
  676. * Print a summary of the results.
  677. *
  678. CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS )
  679. *
  680. 9999 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NB =', I4, ', type ',
  681. $ I2, ', test ', I2, ', ratio =', G12.5 )
  682. 9998 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NRHS=', I3, ', type ',
  683. $ I2, ', test(', I2, ') =', G12.5 )
  684. 9997 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ',', 10X, ' type ', I2,
  685. $ ', test(', I2, ') =', G12.5 )
  686. RETURN
  687. *
  688. * End of ZCHKSY
  689. *
  690. END