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.

ddrvsyx.f 24 kB

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