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.

sdrvsyx.f 23 kB

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