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.

cdrvhex.f 24 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723
  1. *> \brief \b CDRVHEX
  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 CDRVHE( 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. * REAL THRESH
  19. * ..
  20. * .. Array Arguments ..
  21. * LOGICAL DOTYPE( * )
  22. * INTEGER IWORK( * ), NVAL( * )
  23. * REAL RWORK( * )
  24. * COMPLEX A( * ), AFAC( * ), AINV( * ), B( * ),
  25. * $ WORK( * ), X( * ), XACT( * )
  26. * ..
  27. *
  28. *
  29. *> \par Purpose:
  30. * =============
  31. *>
  32. *> \verbatim
  33. *>
  34. *> CDRVHE tests the driver routines CHESV, -SVX, and -SVXX.
  35. *>
  36. *> Note that this file is used only when the XBLAS are available,
  37. *> otherwise cdrvhe.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 REAL
  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 array, dimension (NMAX*NMAX)
  94. *> \endverbatim
  95. *>
  96. *> \param[out] AFAC
  97. *> \verbatim
  98. *> AFAC is COMPLEX array, dimension (NMAX*NMAX)
  99. *> \endverbatim
  100. *>
  101. *> \param[out] AINV
  102. *> \verbatim
  103. *> AINV is COMPLEX array, dimension (NMAX*NMAX)
  104. *> \endverbatim
  105. *>
  106. *> \param[out] B
  107. *> \verbatim
  108. *> B is COMPLEX array, dimension (NMAX*NRHS)
  109. *> \endverbatim
  110. *>
  111. *> \param[out] X
  112. *> \verbatim
  113. *> X is COMPLEX array, dimension (NMAX*NRHS)
  114. *> \endverbatim
  115. *>
  116. *> \param[out] XACT
  117. *> \verbatim
  118. *> XACT is COMPLEX array, dimension (NMAX*NRHS)
  119. *> \endverbatim
  120. *>
  121. *> \param[out] WORK
  122. *> \verbatim
  123. *> WORK is COMPLEX array, dimension
  124. *> (NMAX*max(2,NRHS))
  125. *> \endverbatim
  126. *>
  127. *> \param[out] RWORK
  128. *> \verbatim
  129. *> RWORK is REAL 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 complex_lin
  154. *
  155. * =====================================================================
  156. SUBROUTINE CDRVHE( 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.4.1) --
  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. REAL THRESH
  169. * ..
  170. * .. Array Arguments ..
  171. LOGICAL DOTYPE( * )
  172. INTEGER IWORK( * ), NVAL( * )
  173. REAL RWORK( * )
  174. COMPLEX A( * ), AFAC( * ), AINV( * ), B( * ),
  175. $ WORK( * ), X( * ), XACT( * )
  176. * ..
  177. *
  178. * =====================================================================
  179. *
  180. * .. Parameters ..
  181. REAL ONE, ZERO
  182. PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
  183. INTEGER NTYPES, NTESTS
  184. PARAMETER ( NTYPES = 10, 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. REAL 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. REAL RESULT( NTESTS ), BERR( NRHS ),
  203. $ ERRBNDS_N( NRHS, 3 ), ERRBNDS_C( NRHS, 3 )
  204. * ..
  205. * .. External Functions ..
  206. REAL CLANHE, SGET06
  207. EXTERNAL CLANHE, SGET06
  208. * ..
  209. * .. External Subroutines ..
  210. EXTERNAL ALADHD, ALAERH, ALASVM, CERRVX, CGET04, CHESV,
  211. $ CHESVX, CHET01, CHETRF, CHETRI2, CLACPY,
  212. $ CLAIPD, CLARHS, CLASET, CLATB4, CLATMS, CPOT02,
  213. $ CPOT05, XLAENV, CHESVXX
  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 CMPLX, 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 ) = 'C'
  236. PATH( 2: 3 ) = 'HE'
  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 CERRVX( 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. * Set up parameters with CLATB4 and generate a test matrix
  287. * with CLATMS.
  288. *
  289. CALL CLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM, MODE,
  290. $ CNDNUM, DIST )
  291. *
  292. SRNAMT = 'CLATMS'
  293. CALL CLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE,
  294. $ CNDNUM, ANORM, KL, KU, UPLO, A, LDA, WORK,
  295. $ INFO )
  296. *
  297. * Check error code from CLATMS.
  298. *
  299. IF( INFO.NE.0 ) THEN
  300. CALL ALAERH( PATH, 'CLATMS', INFO, 0, UPLO, N, N, -1,
  301. $ -1, -1, IMAT, NFAIL, NERRS, NOUT )
  302. GO TO 160
  303. END IF
  304. *
  305. * For types 3-6, zero one or more rows and columns of the
  306. * matrix to test that INFO is returned correctly.
  307. *
  308. IF( ZEROT ) THEN
  309. IF( IMAT.EQ.3 ) THEN
  310. IZERO = 1
  311. ELSE IF( IMAT.EQ.4 ) THEN
  312. IZERO = N
  313. ELSE
  314. IZERO = N / 2 + 1
  315. END IF
  316. *
  317. IF( IMAT.LT.6 ) THEN
  318. *
  319. * Set row and column IZERO to zero.
  320. *
  321. IF( IUPLO.EQ.1 ) THEN
  322. IOFF = ( IZERO-1 )*LDA
  323. DO 20 I = 1, IZERO - 1
  324. A( IOFF+I ) = ZERO
  325. 20 CONTINUE
  326. IOFF = IOFF + IZERO
  327. DO 30 I = IZERO, N
  328. A( IOFF ) = ZERO
  329. IOFF = IOFF + LDA
  330. 30 CONTINUE
  331. ELSE
  332. IOFF = IZERO
  333. DO 40 I = 1, IZERO - 1
  334. A( IOFF ) = ZERO
  335. IOFF = IOFF + LDA
  336. 40 CONTINUE
  337. IOFF = IOFF - IZERO
  338. DO 50 I = IZERO, N
  339. A( IOFF+I ) = ZERO
  340. 50 CONTINUE
  341. END IF
  342. ELSE
  343. IOFF = 0
  344. IF( IUPLO.EQ.1 ) THEN
  345. *
  346. * Set the first IZERO rows and columns to zero.
  347. *
  348. DO 70 J = 1, N
  349. I2 = MIN( J, IZERO )
  350. DO 60 I = 1, I2
  351. A( IOFF+I ) = ZERO
  352. 60 CONTINUE
  353. IOFF = IOFF + LDA
  354. 70 CONTINUE
  355. ELSE
  356. *
  357. * Set the last IZERO rows and columns to zero.
  358. *
  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. *
  372. * Set the imaginary part of the diagonals.
  373. *
  374. CALL CLAIPD( N, A, LDA+1, 0 )
  375. *
  376. DO 150 IFACT = 1, NFACT
  377. *
  378. * Do first for FACT = 'F', then for other values.
  379. *
  380. FACT = FACTS( IFACT )
  381. *
  382. * Compute the condition number for comparison with
  383. * the value returned by CHESVX.
  384. *
  385. IF( ZEROT ) THEN
  386. IF( IFACT.EQ.1 )
  387. $ GO TO 150
  388. RCONDC = ZERO
  389. *
  390. ELSE IF( IFACT.EQ.1 ) THEN
  391. *
  392. * Compute the 1-norm of A.
  393. *
  394. ANORM = CLANHE( '1', UPLO, N, A, LDA, RWORK )
  395. *
  396. * Factor the matrix A.
  397. *
  398. CALL CLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
  399. CALL CHETRF( UPLO, N, AFAC, LDA, IWORK, WORK,
  400. $ LWORK, INFO )
  401. *
  402. * Compute inv(A) and take its norm.
  403. *
  404. CALL CLACPY( UPLO, N, N, AFAC, LDA, AINV, LDA )
  405. LWORK = (N+NB+1)*(NB+3)
  406. CALL CHETRI2( UPLO, N, AINV, LDA, IWORK, WORK,
  407. $ LWORK, INFO )
  408. AINVNM = CLANHE( '1', UPLO, N, AINV, LDA, RWORK )
  409. *
  410. * Compute the 1-norm condition number of A.
  411. *
  412. IF( ANORM.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
  413. RCONDC = ONE
  414. ELSE
  415. RCONDC = ( ONE / ANORM ) / AINVNM
  416. END IF
  417. END IF
  418. *
  419. * Form an exact solution and set the right hand side.
  420. *
  421. SRNAMT = 'CLARHS'
  422. CALL CLARHS( PATH, XTYPE, UPLO, ' ', N, N, KL, KU,
  423. $ NRHS, A, LDA, XACT, LDA, B, LDA, ISEED,
  424. $ INFO )
  425. XTYPE = 'C'
  426. *
  427. * --- Test CHESV ---
  428. *
  429. IF( IFACT.EQ.2 ) THEN
  430. CALL CLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
  431. CALL CLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
  432. *
  433. * Factor the matrix and solve the system using CHESV.
  434. *
  435. SRNAMT = 'CHESV '
  436. CALL CHESV( UPLO, N, NRHS, AFAC, LDA, IWORK, X,
  437. $ LDA, WORK, LWORK, INFO )
  438. *
  439. * Adjust the expected value of INFO to account for
  440. * pivoting.
  441. *
  442. K = IZERO
  443. IF( K.GT.0 ) THEN
  444. 100 CONTINUE
  445. IF( IWORK( K ).LT.0 ) THEN
  446. IF( IWORK( K ).NE.-K ) THEN
  447. K = -IWORK( K )
  448. GO TO 100
  449. END IF
  450. ELSE IF( IWORK( K ).NE.K ) THEN
  451. K = IWORK( K )
  452. GO TO 100
  453. END IF
  454. END IF
  455. *
  456. * Check error code from CHESV .
  457. *
  458. IF( INFO.NE.K ) THEN
  459. CALL ALAERH( PATH, 'CHESV ', INFO, K, UPLO, N,
  460. $ N, -1, -1, NRHS, IMAT, NFAIL,
  461. $ NERRS, NOUT )
  462. GO TO 120
  463. ELSE IF( INFO.NE.0 ) THEN
  464. GO TO 120
  465. END IF
  466. *
  467. * Reconstruct matrix from factors and compute
  468. * residual.
  469. *
  470. CALL CHET01( UPLO, N, A, LDA, AFAC, LDA, IWORK,
  471. $ AINV, LDA, RWORK, RESULT( 1 ) )
  472. *
  473. * Compute residual of the computed solution.
  474. *
  475. CALL CLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
  476. CALL CPOT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
  477. $ LDA, RWORK, RESULT( 2 ) )
  478. *
  479. * Check solution from generated exact solution.
  480. *
  481. CALL CGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
  482. $ RESULT( 3 ) )
  483. NT = 3
  484. *
  485. * Print information about the tests that did not pass
  486. * the threshold.
  487. *
  488. DO 110 K = 1, NT
  489. IF( RESULT( K ).GE.THRESH ) THEN
  490. IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
  491. $ CALL ALADHD( NOUT, PATH )
  492. WRITE( NOUT, FMT = 9999 )'CHESV ', UPLO, N,
  493. $ IMAT, K, RESULT( K )
  494. NFAIL = NFAIL + 1
  495. END IF
  496. 110 CONTINUE
  497. NRUN = NRUN + NT
  498. 120 CONTINUE
  499. END IF
  500. *
  501. * --- Test CHESVX ---
  502. *
  503. IF( IFACT.EQ.2 )
  504. $ CALL CLASET( UPLO, N, N, CMPLX( ZERO ),
  505. $ CMPLX( ZERO ), AFAC, LDA )
  506. CALL CLASET( 'Full', N, NRHS, CMPLX( ZERO ),
  507. $ CMPLX( ZERO ), X, LDA )
  508. *
  509. * Solve the system and compute the condition number and
  510. * error bounds using CHESVX.
  511. *
  512. SRNAMT = 'CHESVX'
  513. CALL CHESVX( FACT, UPLO, N, NRHS, A, LDA, AFAC, LDA,
  514. $ IWORK, B, LDA, X, LDA, RCOND, RWORK,
  515. $ RWORK( NRHS+1 ), WORK, LWORK,
  516. $ RWORK( 2*NRHS+1 ), INFO )
  517. *
  518. * Adjust the expected value of INFO to account for
  519. * pivoting.
  520. *
  521. K = IZERO
  522. IF( K.GT.0 ) THEN
  523. 130 CONTINUE
  524. IF( IWORK( K ).LT.0 ) THEN
  525. IF( IWORK( K ).NE.-K ) THEN
  526. K = -IWORK( K )
  527. GO TO 130
  528. END IF
  529. ELSE IF( IWORK( K ).NE.K ) THEN
  530. K = IWORK( K )
  531. GO TO 130
  532. END IF
  533. END IF
  534. *
  535. * Check the error code from CHESVX.
  536. *
  537. IF( INFO.NE.K ) THEN
  538. CALL ALAERH( PATH, 'CHESVX', INFO, K, FACT // UPLO,
  539. $ N, N, -1, -1, NRHS, IMAT, NFAIL,
  540. $ NERRS, NOUT )
  541. GO TO 150
  542. END IF
  543. *
  544. IF( INFO.EQ.0 ) THEN
  545. IF( IFACT.GE.2 ) THEN
  546. *
  547. * Reconstruct matrix from factors and compute
  548. * residual.
  549. *
  550. CALL CHET01( UPLO, N, A, LDA, AFAC, LDA, IWORK,
  551. $ AINV, LDA, RWORK( 2*NRHS+1 ),
  552. $ RESULT( 1 ) )
  553. K1 = 1
  554. ELSE
  555. K1 = 2
  556. END IF
  557. *
  558. * Compute residual of the computed solution.
  559. *
  560. CALL CLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
  561. CALL CPOT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
  562. $ LDA, RWORK( 2*NRHS+1 ), RESULT( 2 ) )
  563. *
  564. * Check solution from generated exact solution.
  565. *
  566. CALL CGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
  567. $ RESULT( 3 ) )
  568. *
  569. * Check the error bounds from iterative refinement.
  570. *
  571. CALL CPOT05( UPLO, N, NRHS, A, LDA, B, LDA, X, LDA,
  572. $ XACT, LDA, RWORK, RWORK( NRHS+1 ),
  573. $ RESULT( 4 ) )
  574. ELSE
  575. K1 = 6
  576. END IF
  577. *
  578. * Compare RCOND from CHESVX with the computed value
  579. * in RCONDC.
  580. *
  581. RESULT( 6 ) = SGET06( RCOND, RCONDC )
  582. *
  583. * Print information about the tests that did not pass
  584. * the threshold.
  585. *
  586. DO 140 K = K1, 6
  587. IF( RESULT( K ).GE.THRESH ) THEN
  588. IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
  589. $ CALL ALADHD( NOUT, PATH )
  590. WRITE( NOUT, FMT = 9998 )'CHESVX', FACT, UPLO,
  591. $ N, IMAT, K, RESULT( K )
  592. NFAIL = NFAIL + 1
  593. END IF
  594. 140 CONTINUE
  595. NRUN = NRUN + 7 - K1
  596. *
  597. * --- Test CHESVXX ---
  598. *
  599. * Restore the matrices A and B.
  600. *
  601. IF( IFACT.EQ.2 )
  602. $ CALL CLASET( UPLO, N, N, CMPLX( ZERO ),
  603. $ CMPLX( ZERO ), AFAC, LDA )
  604. CALL CLASET( 'Full', N, NRHS, CMPLX( ZERO ),
  605. $ CMPLX( ZERO ), X, LDA )
  606. *
  607. * Solve the system and compute the condition number
  608. * and error bounds using CHESVXX.
  609. *
  610. SRNAMT = 'CHESVXX'
  611. N_ERR_BNDS = 3
  612. EQUED = 'N'
  613. CALL CHESVXX( FACT, UPLO, N, NRHS, A, LDA, AFAC,
  614. $ LDA, IWORK, EQUED, WORK( N+1 ), B, LDA, X,
  615. $ LDA, RCOND, RPVGRW_SVXX, BERR, N_ERR_BNDS,
  616. $ ERRBNDS_N, ERRBNDS_C, 0, ZERO, WORK,
  617. $ RWORK(2*NRHS+1), INFO )
  618. *
  619. * Adjust the expected value of INFO to account for
  620. * pivoting.
  621. *
  622. K = IZERO
  623. IF( K.GT.0 ) THEN
  624. 135 CONTINUE
  625. IF( IWORK( K ).LT.0 ) THEN
  626. IF( IWORK( K ).NE.-K ) THEN
  627. K = -IWORK( K )
  628. GO TO 135
  629. END IF
  630. ELSE IF( IWORK( K ).NE.K ) THEN
  631. K = IWORK( K )
  632. GO TO 135
  633. END IF
  634. END IF
  635. *
  636. * Check the error code from CHESVXX.
  637. *
  638. IF( INFO.NE.K .AND. INFO.LE.N ) THEN
  639. CALL ALAERH( PATH, 'CHESVXX', INFO, K,
  640. $ FACT // UPLO, N, N, -1, -1, NRHS, IMAT, NFAIL,
  641. $ NERRS, NOUT )
  642. GO TO 150
  643. END IF
  644. *
  645. IF( INFO.EQ.0 ) THEN
  646. IF( IFACT.GE.2 ) THEN
  647. *
  648. * Reconstruct matrix from factors and compute
  649. * residual.
  650. *
  651. CALL CHET01( UPLO, N, A, LDA, AFAC, LDA, IWORK,
  652. $ AINV, LDA, RWORK(2*NRHS+1),
  653. $ RESULT( 1 ) )
  654. K1 = 1
  655. ELSE
  656. K1 = 2
  657. END IF
  658. *
  659. * Compute residual of the computed solution.
  660. *
  661. CALL CLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
  662. CALL CPOT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
  663. $ LDA, RWORK( 2*NRHS+1 ), RESULT( 2 ) )
  664. RESULT( 2 ) = 0.0
  665. *
  666. * Check solution from generated exact solution.
  667. *
  668. CALL CGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
  669. $ RESULT( 3 ) )
  670. *
  671. * Check the error bounds from iterative refinement.
  672. *
  673. CALL CPOT05( UPLO, N, NRHS, A, LDA, B, LDA, X, LDA,
  674. $ XACT, LDA, RWORK, RWORK( NRHS+1 ),
  675. $ RESULT( 4 ) )
  676. ELSE
  677. K1 = 6
  678. END IF
  679. *
  680. * Compare RCOND from CHESVXX with the computed value
  681. * in RCONDC.
  682. *
  683. RESULT( 6 ) = SGET06( RCOND, RCONDC )
  684. *
  685. * Print information about the tests that did not pass
  686. * the threshold.
  687. *
  688. DO 85 K = K1, 6
  689. IF( RESULT( K ).GE.THRESH ) THEN
  690. IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
  691. $ CALL ALADHD( NOUT, PATH )
  692. WRITE( NOUT, FMT = 9998 )'CHESVXX',
  693. $ FACT, UPLO, N, IMAT, K,
  694. $ RESULT( K )
  695. NFAIL = NFAIL + 1
  696. END IF
  697. 85 CONTINUE
  698. NRUN = NRUN + 7 - K1
  699. *
  700. 150 CONTINUE
  701. *
  702. 160 CONTINUE
  703. 170 CONTINUE
  704. 180 CONTINUE
  705. *
  706. * Print a summary of the results.
  707. *
  708. CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS )
  709. *
  710. * Test Error Bounds from CHESVXX
  711. CALL CEBCHVXX(THRESH, PATH)
  712. 9999 FORMAT( 1X, A, ', UPLO=''', A1, ''', N =', I5, ', type ', I2,
  713. $ ', test ', I2, ', ratio =', G12.5 )
  714. 9998 FORMAT( 1X, A, ', FACT=''', A1, ''', UPLO=''', A1, ''', N =', I5,
  715. $ ', type ', I2, ', test ', I2, ', ratio =', G12.5 )
  716. RETURN
  717. *
  718. * End of CDRVHE
  719. *
  720. END