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

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