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.

sdrvgex.f 33 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891
  1. *> \brief \b SDRVGEX
  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 SDRVGE( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX,
  12. * A, AFAC, ASAV, B, BSAV, X, XACT, S, WORK,
  13. * RWORK, IWORK, 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( * ), ASAV( * ), B( * ),
  24. * $ BSAV( * ), RWORK( * ), S( * ), WORK( * ),
  25. * $ X( * ), XACT( * )
  26. * ..
  27. *
  28. *
  29. *> \par Purpose:
  30. * =============
  31. *>
  32. *> \verbatim
  33. *>
  34. *> SDRVGE tests the driver routines SGESV, -SVX, and -SVXX.
  35. *>
  36. *> Note that this file is used only when the XBLAS are available,
  37. *> otherwise sdrvge.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 column 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 REAL array, dimension (NMAX*NMAX)
  94. *> \endverbatim
  95. *>
  96. *> \param[out] AFAC
  97. *> \verbatim
  98. *> AFAC is REAL array, dimension (NMAX*NMAX)
  99. *> \endverbatim
  100. *>
  101. *> \param[out] ASAV
  102. *> \verbatim
  103. *> ASAV is REAL array, dimension (NMAX*NMAX)
  104. *> \endverbatim
  105. *>
  106. *> \param[out] B
  107. *> \verbatim
  108. *> B is REAL array, dimension (NMAX*NRHS)
  109. *> \endverbatim
  110. *>
  111. *> \param[out] BSAV
  112. *> \verbatim
  113. *> BSAV is REAL array, dimension (NMAX*NRHS)
  114. *> \endverbatim
  115. *>
  116. *> \param[out] X
  117. *> \verbatim
  118. *> X is REAL array, dimension (NMAX*NRHS)
  119. *> \endverbatim
  120. *>
  121. *> \param[out] XACT
  122. *> \verbatim
  123. *> XACT is REAL array, dimension (NMAX*NRHS)
  124. *> \endverbatim
  125. *>
  126. *> \param[out] S
  127. *> \verbatim
  128. *> S is REAL array, dimension (2*NMAX)
  129. *> \endverbatim
  130. *>
  131. *> \param[out] WORK
  132. *> \verbatim
  133. *> WORK is REAL array, dimension
  134. *> (NMAX*max(3,NRHS))
  135. *> \endverbatim
  136. *>
  137. *> \param[out] RWORK
  138. *> \verbatim
  139. *> RWORK is REAL array, dimension (2*NRHS+NMAX)
  140. *> \endverbatim
  141. *>
  142. *> \param[out] IWORK
  143. *> \verbatim
  144. *> IWORK is INTEGER array, dimension (2*NMAX)
  145. *> \endverbatim
  146. *>
  147. *> \param[in] NOUT
  148. *> \verbatim
  149. *> NOUT is INTEGER
  150. *> The unit number for output.
  151. *> \endverbatim
  152. *
  153. * Authors:
  154. * ========
  155. *
  156. *> \author Univ. of Tennessee
  157. *> \author Univ. of California Berkeley
  158. *> \author Univ. of Colorado Denver
  159. *> \author NAG Ltd.
  160. *
  161. *> \ingroup single_lin
  162. *
  163. * =====================================================================
  164. SUBROUTINE SDRVGE( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX,
  165. $ A, AFAC, ASAV, B, BSAV, X, XACT, S, WORK,
  166. $ RWORK, IWORK, NOUT )
  167. *
  168. * -- LAPACK test routine --
  169. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  170. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  171. *
  172. * .. Scalar Arguments ..
  173. LOGICAL TSTERR
  174. INTEGER NMAX, NN, NOUT, NRHS
  175. REAL THRESH
  176. * ..
  177. * .. Array Arguments ..
  178. LOGICAL DOTYPE( * )
  179. INTEGER IWORK( * ), NVAL( * )
  180. REAL A( * ), AFAC( * ), ASAV( * ), B( * ),
  181. $ BSAV( * ), RWORK( * ), S( * ), WORK( * ),
  182. $ X( * ), XACT( * )
  183. * ..
  184. *
  185. * =====================================================================
  186. *
  187. * .. Parameters ..
  188. REAL ONE, ZERO
  189. PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
  190. INTEGER NTYPES
  191. PARAMETER ( NTYPES = 11 )
  192. INTEGER NTESTS
  193. PARAMETER ( NTESTS = 7 )
  194. INTEGER NTRAN
  195. PARAMETER ( NTRAN = 3 )
  196. * ..
  197. * .. Local Scalars ..
  198. LOGICAL EQUIL, NOFACT, PREFAC, TRFCON, ZEROT
  199. CHARACTER DIST, EQUED, FACT, TRANS, TYPE, XTYPE
  200. CHARACTER*3 PATH
  201. INTEGER I, IEQUED, IFACT, IMAT, IN, INFO, IOFF, ITRAN,
  202. $ IZERO, K, K1, KL, KU, LDA, LWORK, MODE, N, NB,
  203. $ NBMIN, NERRS, NFACT, NFAIL, NIMAT, NRUN, NT,
  204. $ N_ERR_BNDS
  205. REAL AINVNM, AMAX, ANORM, ANORMI, ANORMO, CNDNUM,
  206. $ COLCND, RCOND, RCONDC, RCONDI, RCONDO, ROLDC,
  207. $ ROLDI, ROLDO, ROWCND, RPVGRW, RPVGRW_SVXX
  208. * ..
  209. * .. Local Arrays ..
  210. CHARACTER EQUEDS( 4 ), FACTS( 3 ), TRANSS( NTRAN )
  211. INTEGER ISEED( 4 ), ISEEDY( 4 )
  212. REAL RESULT( NTESTS ), BERR( NRHS ),
  213. $ ERRBNDS_N( NRHS, 3 ), ERRBNDS_C( NRHS, 3 )
  214. * ..
  215. * .. External Functions ..
  216. LOGICAL LSAME
  217. REAL SGET06, SLAMCH, SLANGE, SLANTR, SLA_GERPVGRW
  218. EXTERNAL LSAME, SGET06, SLAMCH, SLANGE, SLANTR,
  219. $ SLA_GERPVGRW
  220. * ..
  221. * .. External Subroutines ..
  222. EXTERNAL ALADHD, ALAERH, ALASVM, SERRVX, SGEEQU, SGESV,
  223. $ SGESVX, SGET01, SGET02, SGET04, SGET07, SGETRF,
  224. $ SGETRI, SLACPY, SLAQGE, SLARHS, SLASET, SLATB4,
  225. $ SLATMS, XLAENV, SGESVXX
  226. * ..
  227. * .. Intrinsic Functions ..
  228. INTRINSIC ABS, MAX
  229. * ..
  230. * .. Scalars in Common ..
  231. LOGICAL LERR, OK
  232. CHARACTER*32 SRNAMT
  233. INTEGER INFOT, NUNIT
  234. * ..
  235. * .. Common blocks ..
  236. COMMON / INFOC / INFOT, NUNIT, OK, LERR
  237. COMMON / SRNAMC / SRNAMT
  238. * ..
  239. * .. Data statements ..
  240. DATA ISEEDY / 1988, 1989, 1990, 1991 /
  241. DATA TRANSS / 'N', 'T', 'C' /
  242. DATA FACTS / 'F', 'N', 'E' /
  243. DATA EQUEDS / 'N', 'R', 'C', 'B' /
  244. * ..
  245. * .. Executable Statements ..
  246. *
  247. * Initialize constants and the random number seed.
  248. *
  249. PATH( 1: 1 ) = 'Single precision'
  250. PATH( 2: 3 ) = 'GE'
  251. NRUN = 0
  252. NFAIL = 0
  253. NERRS = 0
  254. DO 10 I = 1, 4
  255. ISEED( I ) = ISEEDY( I )
  256. 10 CONTINUE
  257. *
  258. * Test the error exits
  259. *
  260. IF( TSTERR )
  261. $ CALL SERRVX( PATH, NOUT )
  262. INFOT = 0
  263. *
  264. * Set the block size and minimum block size for testing.
  265. *
  266. NB = 1
  267. NBMIN = 2
  268. CALL XLAENV( 1, NB )
  269. CALL XLAENV( 2, NBMIN )
  270. *
  271. * Do for each value of N in NVAL
  272. *
  273. DO 90 IN = 1, NN
  274. N = NVAL( IN )
  275. LDA = MAX( N, 1 )
  276. XTYPE = 'N'
  277. NIMAT = NTYPES
  278. IF( N.LE.0 )
  279. $ NIMAT = 1
  280. *
  281. DO 80 IMAT = 1, NIMAT
  282. *
  283. * Do the tests only if DOTYPE( IMAT ) is true.
  284. *
  285. IF( .NOT.DOTYPE( IMAT ) )
  286. $ GO TO 80
  287. *
  288. * Skip types 5, 6, or 7 if the matrix size is too small.
  289. *
  290. ZEROT = IMAT.GE.5 .AND. IMAT.LE.7
  291. IF( ZEROT .AND. N.LT.IMAT-4 )
  292. $ GO TO 80
  293. *
  294. * Set up parameters with SLATB4 and generate a test matrix
  295. * with SLATMS.
  296. *
  297. CALL SLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM, MODE,
  298. $ CNDNUM, DIST )
  299. RCONDC = ONE / CNDNUM
  300. *
  301. SRNAMT = 'SLATMS'
  302. CALL SLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE, CNDNUM,
  303. $ ANORM, KL, KU, 'No packing', A, LDA, WORK,
  304. $ INFO )
  305. *
  306. * Check error code from SLATMS.
  307. *
  308. IF( INFO.NE.0 ) THEN
  309. CALL ALAERH( PATH, 'SLATMS', INFO, 0, ' ', N, N, -1, -1,
  310. $ -1, IMAT, NFAIL, NERRS, NOUT )
  311. GO TO 80
  312. END IF
  313. *
  314. * For types 5-7, zero one or more columns of the matrix to
  315. * test that INFO is returned correctly.
  316. *
  317. IF( ZEROT ) THEN
  318. IF( IMAT.EQ.5 ) THEN
  319. IZERO = 1
  320. ELSE IF( IMAT.EQ.6 ) THEN
  321. IZERO = N
  322. ELSE
  323. IZERO = N / 2 + 1
  324. END IF
  325. IOFF = ( IZERO-1 )*LDA
  326. IF( IMAT.LT.7 ) THEN
  327. DO 20 I = 1, N
  328. A( IOFF+I ) = ZERO
  329. 20 CONTINUE
  330. ELSE
  331. CALL SLASET( 'Full', N, N-IZERO+1, ZERO, ZERO,
  332. $ A( IOFF+1 ), LDA )
  333. END IF
  334. ELSE
  335. IZERO = 0
  336. END IF
  337. *
  338. * Save a copy of the matrix A in ASAV.
  339. *
  340. CALL SLACPY( 'Full', N, N, A, LDA, ASAV, LDA )
  341. *
  342. DO 70 IEQUED = 1, 4
  343. EQUED = EQUEDS( IEQUED )
  344. IF( IEQUED.EQ.1 ) THEN
  345. NFACT = 3
  346. ELSE
  347. NFACT = 1
  348. END IF
  349. *
  350. DO 60 IFACT = 1, NFACT
  351. FACT = FACTS( IFACT )
  352. PREFAC = LSAME( FACT, 'F' )
  353. NOFACT = LSAME( FACT, 'N' )
  354. EQUIL = LSAME( FACT, 'E' )
  355. *
  356. IF( ZEROT ) THEN
  357. IF( PREFAC )
  358. $ GO TO 60
  359. RCONDO = ZERO
  360. RCONDI = ZERO
  361. *
  362. ELSE IF( .NOT.NOFACT ) THEN
  363. *
  364. * Compute the condition number for comparison with
  365. * the value returned by SGESVX (FACT = 'N' reuses
  366. * the condition number from the previous iteration
  367. * with FACT = 'F').
  368. *
  369. CALL SLACPY( 'Full', N, N, ASAV, LDA, AFAC, LDA )
  370. IF( EQUIL .OR. IEQUED.GT.1 ) THEN
  371. *
  372. * Compute row and column scale factors to
  373. * equilibrate the matrix A.
  374. *
  375. CALL SGEEQU( N, N, AFAC, LDA, S, S( N+1 ),
  376. $ ROWCND, COLCND, AMAX, INFO )
  377. IF( INFO.EQ.0 .AND. N.GT.0 ) THEN
  378. IF( LSAME( EQUED, 'R' ) ) THEN
  379. ROWCND = ZERO
  380. COLCND = ONE
  381. ELSE IF( LSAME( EQUED, 'C' ) ) THEN
  382. ROWCND = ONE
  383. COLCND = ZERO
  384. ELSE IF( LSAME( EQUED, 'B' ) ) THEN
  385. ROWCND = ZERO
  386. COLCND = ZERO
  387. END IF
  388. *
  389. * Equilibrate the matrix.
  390. *
  391. CALL SLAQGE( N, N, AFAC, LDA, S, S( N+1 ),
  392. $ ROWCND, COLCND, AMAX, EQUED )
  393. END IF
  394. END IF
  395. *
  396. * Save the condition number of the non-equilibrated
  397. * system for use in SGET04.
  398. *
  399. IF( EQUIL ) THEN
  400. ROLDO = RCONDO
  401. ROLDI = RCONDI
  402. END IF
  403. *
  404. * Compute the 1-norm and infinity-norm of A.
  405. *
  406. ANORMO = SLANGE( '1', N, N, AFAC, LDA, RWORK )
  407. ANORMI = SLANGE( 'I', N, N, AFAC, LDA, RWORK )
  408. *
  409. * Factor the matrix A.
  410. *
  411. CALL SGETRF( N, N, AFAC, LDA, IWORK, INFO )
  412. *
  413. * Form the inverse of A.
  414. *
  415. CALL SLACPY( 'Full', N, N, AFAC, LDA, A, LDA )
  416. LWORK = NMAX*MAX( 3, NRHS )
  417. CALL SGETRI( N, A, LDA, IWORK, WORK, LWORK, INFO )
  418. *
  419. * Compute the 1-norm condition number of A.
  420. *
  421. AINVNM = SLANGE( '1', N, N, A, LDA, RWORK )
  422. IF( ANORMO.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
  423. RCONDO = ONE
  424. ELSE
  425. RCONDO = ( ONE / ANORMO ) / AINVNM
  426. END IF
  427. *
  428. * Compute the infinity-norm condition number of A.
  429. *
  430. AINVNM = SLANGE( 'I', N, N, A, LDA, RWORK )
  431. IF( ANORMI.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
  432. RCONDI = ONE
  433. ELSE
  434. RCONDI = ( ONE / ANORMI ) / AINVNM
  435. END IF
  436. END IF
  437. *
  438. DO 50 ITRAN = 1, NTRAN
  439. *
  440. * Do for each value of TRANS.
  441. *
  442. TRANS = TRANSS( ITRAN )
  443. IF( ITRAN.EQ.1 ) THEN
  444. RCONDC = RCONDO
  445. ELSE
  446. RCONDC = RCONDI
  447. END IF
  448. *
  449. * Restore the matrix A.
  450. *
  451. CALL SLACPY( 'Full', N, N, ASAV, LDA, A, LDA )
  452. *
  453. * Form an exact solution and set the right hand side.
  454. *
  455. SRNAMT = 'SLARHS'
  456. CALL SLARHS( PATH, XTYPE, 'Full', TRANS, N, N, KL,
  457. $ KU, NRHS, A, LDA, XACT, LDA, B, LDA,
  458. $ ISEED, INFO )
  459. XTYPE = 'C'
  460. CALL SLACPY( 'Full', N, NRHS, B, LDA, BSAV, LDA )
  461. *
  462. IF( NOFACT .AND. ITRAN.EQ.1 ) THEN
  463. *
  464. * --- Test SGESV ---
  465. *
  466. * Compute the LU factorization of the matrix and
  467. * solve the system.
  468. *
  469. CALL SLACPY( 'Full', N, N, A, LDA, AFAC, LDA )
  470. CALL SLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
  471. *
  472. SRNAMT = 'SGESV '
  473. CALL SGESV( N, NRHS, AFAC, LDA, IWORK, X, LDA,
  474. $ INFO )
  475. *
  476. * Check error code from SGESV .
  477. *
  478. IF( INFO.NE.IZERO )
  479. $ CALL ALAERH( PATH, 'SGESV ', INFO, IZERO,
  480. $ ' ', N, N, -1, -1, NRHS, IMAT,
  481. $ NFAIL, NERRS, NOUT )
  482. *
  483. * Reconstruct matrix from factors and compute
  484. * residual.
  485. *
  486. CALL SGET01( N, N, A, LDA, AFAC, LDA, IWORK,
  487. $ RWORK, RESULT( 1 ) )
  488. NT = 1
  489. IF( IZERO.EQ.0 ) THEN
  490. *
  491. * Compute residual of the computed solution.
  492. *
  493. CALL SLACPY( 'Full', N, NRHS, B, LDA, WORK,
  494. $ LDA )
  495. CALL SGET02( 'No transpose', N, N, NRHS, A,
  496. $ LDA, X, LDA, WORK, LDA, RWORK,
  497. $ RESULT( 2 ) )
  498. *
  499. * Check solution from generated exact solution.
  500. *
  501. CALL SGET04( N, NRHS, X, LDA, XACT, LDA,
  502. $ RCONDC, RESULT( 3 ) )
  503. NT = 3
  504. END IF
  505. *
  506. * Print information about the tests that did not
  507. * pass the threshold.
  508. *
  509. DO 30 K = 1, NT
  510. IF( RESULT( K ).GE.THRESH ) THEN
  511. IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
  512. $ CALL ALADHD( NOUT, PATH )
  513. WRITE( NOUT, FMT = 9999 )'SGESV ', N,
  514. $ IMAT, K, RESULT( K )
  515. NFAIL = NFAIL + 1
  516. END IF
  517. 30 CONTINUE
  518. NRUN = NRUN + NT
  519. END IF
  520. *
  521. * --- Test SGESVX ---
  522. *
  523. IF( .NOT.PREFAC )
  524. $ CALL SLASET( 'Full', N, N, ZERO, ZERO, AFAC,
  525. $ LDA )
  526. CALL SLASET( 'Full', N, NRHS, ZERO, ZERO, X, LDA )
  527. IF( IEQUED.GT.1 .AND. N.GT.0 ) THEN
  528. *
  529. * Equilibrate the matrix if FACT = 'F' and
  530. * EQUED = 'R', 'C', or 'B'.
  531. *
  532. CALL SLAQGE( N, N, A, LDA, S, S( N+1 ), ROWCND,
  533. $ COLCND, AMAX, EQUED )
  534. END IF
  535. *
  536. * Solve the system and compute the condition number
  537. * and error bounds using SGESVX.
  538. *
  539. SRNAMT = 'SGESVX'
  540. CALL SGESVX( FACT, TRANS, N, NRHS, A, LDA, AFAC,
  541. $ LDA, IWORK, EQUED, S, S( N+1 ), B,
  542. $ LDA, X, LDA, RCOND, RWORK,
  543. $ RWORK( NRHS+1 ), WORK, IWORK( N+1 ),
  544. $ INFO )
  545. *
  546. * Check the error code from SGESVX.
  547. *
  548. IF( INFO.NE.IZERO )
  549. $ CALL ALAERH( PATH, 'SGESVX', INFO, IZERO,
  550. $ FACT // TRANS, N, N, -1, -1, NRHS,
  551. $ IMAT, NFAIL, NERRS, NOUT )
  552. *
  553. * Compare WORK(1) from SGESVX with the computed
  554. * reciprocal pivot growth factor RPVGRW
  555. *
  556. IF( INFO.NE.0 ) THEN
  557. RPVGRW = SLANTR( 'M', 'U', 'N', INFO, INFO,
  558. $ AFAC, LDA, WORK )
  559. IF( RPVGRW.EQ.ZERO ) THEN
  560. RPVGRW = ONE
  561. ELSE
  562. RPVGRW = SLANGE( 'M', N, INFO, A, LDA,
  563. $ WORK ) / RPVGRW
  564. END IF
  565. ELSE
  566. RPVGRW = SLANTR( 'M', 'U', 'N', N, N, AFAC, LDA,
  567. $ WORK )
  568. IF( RPVGRW.EQ.ZERO ) THEN
  569. RPVGRW = ONE
  570. ELSE
  571. RPVGRW = SLANGE( 'M', N, N, A, LDA, WORK ) /
  572. $ RPVGRW
  573. END IF
  574. END IF
  575. RESULT( 7 ) = ABS( RPVGRW-WORK( 1 ) ) /
  576. $ MAX( WORK( 1 ), RPVGRW ) /
  577. $ SLAMCH( 'E' )
  578. *
  579. IF( .NOT.PREFAC ) THEN
  580. *
  581. * Reconstruct matrix from factors and compute
  582. * residual.
  583. *
  584. CALL SGET01( N, N, A, LDA, AFAC, LDA, IWORK,
  585. $ RWORK( 2*NRHS+1 ), RESULT( 1 ) )
  586. K1 = 1
  587. ELSE
  588. K1 = 2
  589. END IF
  590. *
  591. IF( INFO.EQ.0 ) THEN
  592. TRFCON = .FALSE.
  593. *
  594. * Compute residual of the computed solution.
  595. *
  596. CALL SLACPY( 'Full', N, NRHS, BSAV, LDA, WORK,
  597. $ LDA )
  598. CALL SGET02( TRANS, N, N, NRHS, ASAV, LDA, X,
  599. $ LDA, WORK, LDA, RWORK( 2*NRHS+1 ),
  600. $ RESULT( 2 ) )
  601. *
  602. * Check solution from generated exact solution.
  603. *
  604. IF( NOFACT .OR. ( PREFAC .AND. LSAME( EQUED,
  605. $ 'N' ) ) ) THEN
  606. CALL SGET04( N, NRHS, X, LDA, XACT, LDA,
  607. $ RCONDC, RESULT( 3 ) )
  608. ELSE
  609. IF( ITRAN.EQ.1 ) THEN
  610. ROLDC = ROLDO
  611. ELSE
  612. ROLDC = ROLDI
  613. END IF
  614. CALL SGET04( N, NRHS, X, LDA, XACT, LDA,
  615. $ ROLDC, RESULT( 3 ) )
  616. END IF
  617. *
  618. * Check the error bounds from iterative
  619. * refinement.
  620. *
  621. CALL SGET07( TRANS, N, NRHS, ASAV, LDA, B, LDA,
  622. $ X, LDA, XACT, LDA, RWORK, .TRUE.,
  623. $ RWORK( NRHS+1 ), RESULT( 4 ) )
  624. ELSE
  625. TRFCON = .TRUE.
  626. END IF
  627. *
  628. * Compare RCOND from SGESVX with the computed value
  629. * in RCONDC.
  630. *
  631. RESULT( 6 ) = SGET06( RCOND, RCONDC )
  632. *
  633. * Print information about the tests that did not pass
  634. * the threshold.
  635. *
  636. IF( .NOT.TRFCON ) THEN
  637. DO 40 K = K1, NTESTS
  638. IF( RESULT( K ).GE.THRESH ) THEN
  639. IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
  640. $ CALL ALADHD( NOUT, PATH )
  641. IF( PREFAC ) THEN
  642. WRITE( NOUT, FMT = 9997 )'SGESVX',
  643. $ FACT, TRANS, N, EQUED, IMAT, K,
  644. $ RESULT( K )
  645. ELSE
  646. WRITE( NOUT, FMT = 9998 )'SGESVX',
  647. $ FACT, TRANS, N, IMAT, K, RESULT( K )
  648. END IF
  649. NFAIL = NFAIL + 1
  650. END IF
  651. 40 CONTINUE
  652. NRUN = NRUN + 7 - K1
  653. ELSE
  654. IF( RESULT( 1 ).GE.THRESH .AND. .NOT.PREFAC )
  655. $ THEN
  656. IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
  657. $ CALL ALADHD( NOUT, PATH )
  658. IF( PREFAC ) THEN
  659. WRITE( NOUT, FMT = 9997 )'SGESVX', FACT,
  660. $ TRANS, N, EQUED, IMAT, 1, RESULT( 1 )
  661. ELSE
  662. WRITE( NOUT, FMT = 9998 )'SGESVX', FACT,
  663. $ TRANS, N, IMAT, 1, RESULT( 1 )
  664. END IF
  665. NFAIL = NFAIL + 1
  666. NRUN = NRUN + 1
  667. END IF
  668. IF( RESULT( 6 ).GE.THRESH ) THEN
  669. IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
  670. $ CALL ALADHD( NOUT, PATH )
  671. IF( PREFAC ) THEN
  672. WRITE( NOUT, FMT = 9997 )'SGESVX', FACT,
  673. $ TRANS, N, EQUED, IMAT, 6, RESULT( 6 )
  674. ELSE
  675. WRITE( NOUT, FMT = 9998 )'SGESVX', FACT,
  676. $ TRANS, N, IMAT, 6, RESULT( 6 )
  677. END IF
  678. NFAIL = NFAIL + 1
  679. NRUN = NRUN + 1
  680. END IF
  681. IF( RESULT( 7 ).GE.THRESH ) THEN
  682. IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
  683. $ CALL ALADHD( NOUT, PATH )
  684. IF( PREFAC ) THEN
  685. WRITE( NOUT, FMT = 9997 )'SGESVX', FACT,
  686. $ TRANS, N, EQUED, IMAT, 7, RESULT( 7 )
  687. ELSE
  688. WRITE( NOUT, FMT = 9998 )'SGESVX', FACT,
  689. $ TRANS, N, IMAT, 7, RESULT( 7 )
  690. END IF
  691. NFAIL = NFAIL + 1
  692. NRUN = NRUN + 1
  693. END IF
  694. *
  695. END IF
  696. *
  697. * --- Test SGESVXX ---
  698. *
  699. * Restore the matrices A and B.
  700. *
  701. CALL SLACPY( 'Full', N, N, ASAV, LDA, A, LDA )
  702. CALL SLACPY( 'Full', N, NRHS, BSAV, LDA, B, LDA )
  703. IF( .NOT.PREFAC )
  704. $ CALL SLASET( 'Full', N, N, ZERO, ZERO, AFAC,
  705. $ LDA )
  706. CALL SLASET( 'Full', N, NRHS, ZERO, ZERO, X, LDA )
  707. IF( IEQUED.GT.1 .AND. N.GT.0 ) THEN
  708. *
  709. * Equilibrate the matrix if FACT = 'F' and
  710. * EQUED = 'R', 'C', or 'B'.
  711. *
  712. CALL SLAQGE( N, N, A, LDA, S, S( N+1 ), ROWCND,
  713. $ COLCND, AMAX, EQUED )
  714. END IF
  715. *
  716. * Solve the system and compute the condition number
  717. * and error bounds using SGESVXX.
  718. *
  719. SRNAMT = 'SGESVXX'
  720. N_ERR_BNDS = 3
  721. CALL SGESVXX( FACT, TRANS, N, NRHS, A, LDA, AFAC,
  722. $ LDA, IWORK, EQUED, S, S( N+1 ), B, LDA, X,
  723. $ LDA, RCOND, RPVGRW_SVXX, BERR, N_ERR_BNDS,
  724. $ ERRBNDS_N, ERRBNDS_C, 0, ZERO, WORK,
  725. $ IWORK( N+1 ), INFO )
  726. *
  727. * Check the error code from SGESVXX.
  728. *
  729. IF( INFO.EQ.N+1 ) GOTO 50
  730. IF( INFO.NE.IZERO ) THEN
  731. CALL ALAERH( PATH, 'SGESVXX', INFO, IZERO,
  732. $ FACT // TRANS, N, N, -1, -1, NRHS,
  733. $ IMAT, NFAIL, NERRS, NOUT )
  734. GOTO 50
  735. END IF
  736. *
  737. * Compare rpvgrw_svxx from SGESVXX with the computed
  738. * reciprocal pivot growth factor RPVGRW
  739. *
  740. IF ( INFO .GT. 0 .AND. INFO .LT. N+1 ) THEN
  741. RPVGRW = SLA_GERPVGRW
  742. $ (N, INFO, A, LDA, AFAC, LDA)
  743. ELSE
  744. RPVGRW = SLA_GERPVGRW
  745. $ (N, N, A, LDA, AFAC, LDA)
  746. ENDIF
  747. RESULT( 7 ) = ABS( RPVGRW-RPVGRW_SVXX ) /
  748. $ MAX( RPVGRW_SVXX, RPVGRW ) /
  749. $ SLAMCH( 'E' )
  750. *
  751. IF( .NOT.PREFAC ) THEN
  752. *
  753. * Reconstruct matrix from factors and compute
  754. * residual.
  755. *
  756. CALL SGET01( N, N, A, LDA, AFAC, LDA, IWORK,
  757. $ RWORK( 2*NRHS+1 ), RESULT( 1 ) )
  758. K1 = 1
  759. ELSE
  760. K1 = 2
  761. END IF
  762. *
  763. IF( INFO.EQ.0 ) THEN
  764. TRFCON = .FALSE.
  765. *
  766. * Compute residual of the computed solution.
  767. *
  768. CALL SLACPY( 'Full', N, NRHS, BSAV, LDA, WORK,
  769. $ LDA )
  770. CALL SGET02( TRANS, N, N, NRHS, ASAV, LDA, X,
  771. $ LDA, WORK, LDA, RWORK( 2*NRHS+1 ),
  772. $ RESULT( 2 ) )
  773. *
  774. * Check solution from generated exact solution.
  775. *
  776. IF( NOFACT .OR. ( PREFAC .AND. LSAME( EQUED,
  777. $ 'N' ) ) ) THEN
  778. CALL SGET04( N, NRHS, X, LDA, XACT, LDA,
  779. $ RCONDC, RESULT( 3 ) )
  780. ELSE
  781. IF( ITRAN.EQ.1 ) THEN
  782. ROLDC = ROLDO
  783. ELSE
  784. ROLDC = ROLDI
  785. END IF
  786. CALL SGET04( N, NRHS, X, LDA, XACT, LDA,
  787. $ ROLDC, RESULT( 3 ) )
  788. END IF
  789. ELSE
  790. TRFCON = .TRUE.
  791. END IF
  792. *
  793. * Compare RCOND from SGESVXX with the computed value
  794. * in RCONDC.
  795. *
  796. RESULT( 6 ) = SGET06( RCOND, RCONDC )
  797. *
  798. * Print information about the tests that did not pass
  799. * the threshold.
  800. *
  801. IF( .NOT.TRFCON ) THEN
  802. DO 45 K = K1, NTESTS
  803. IF( RESULT( K ).GE.THRESH ) THEN
  804. IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
  805. $ CALL ALADHD( NOUT, PATH )
  806. IF( PREFAC ) THEN
  807. WRITE( NOUT, FMT = 9997 )'SGESVXX',
  808. $ FACT, TRANS, N, EQUED, IMAT, K,
  809. $ RESULT( K )
  810. ELSE
  811. WRITE( NOUT, FMT = 9998 )'SGESVXX',
  812. $ FACT, TRANS, N, IMAT, K, RESULT( K )
  813. END IF
  814. NFAIL = NFAIL + 1
  815. END IF
  816. 45 CONTINUE
  817. NRUN = NRUN + 7 - K1
  818. ELSE
  819. IF( RESULT( 1 ).GE.THRESH .AND. .NOT.PREFAC )
  820. $ THEN
  821. IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
  822. $ CALL ALADHD( NOUT, PATH )
  823. IF( PREFAC ) THEN
  824. WRITE( NOUT, FMT = 9997 )'SGESVXX', FACT,
  825. $ TRANS, N, EQUED, IMAT, 1, RESULT( 1 )
  826. ELSE
  827. WRITE( NOUT, FMT = 9998 )'SGESVXX', FACT,
  828. $ TRANS, N, IMAT, 1, RESULT( 1 )
  829. END IF
  830. NFAIL = NFAIL + 1
  831. NRUN = NRUN + 1
  832. END IF
  833. IF( RESULT( 6 ).GE.THRESH ) THEN
  834. IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
  835. $ CALL ALADHD( NOUT, PATH )
  836. IF( PREFAC ) THEN
  837. WRITE( NOUT, FMT = 9997 )'SGESVXX', FACT,
  838. $ TRANS, N, EQUED, IMAT, 6, RESULT( 6 )
  839. ELSE
  840. WRITE( NOUT, FMT = 9998 )'SGESVXX', FACT,
  841. $ TRANS, N, IMAT, 6, RESULT( 6 )
  842. END IF
  843. NFAIL = NFAIL + 1
  844. NRUN = NRUN + 1
  845. END IF
  846. IF( RESULT( 7 ).GE.THRESH ) THEN
  847. IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
  848. $ CALL ALADHD( NOUT, PATH )
  849. IF( PREFAC ) THEN
  850. WRITE( NOUT, FMT = 9997 )'SGESVXX', FACT,
  851. $ TRANS, N, EQUED, IMAT, 7, RESULT( 7 )
  852. ELSE
  853. WRITE( NOUT, FMT = 9998 )'SGESVXX', FACT,
  854. $ TRANS, N, IMAT, 7, RESULT( 7 )
  855. END IF
  856. NFAIL = NFAIL + 1
  857. NRUN = NRUN + 1
  858. END IF
  859. *
  860. END IF
  861. *
  862. 50 CONTINUE
  863. 60 CONTINUE
  864. 70 CONTINUE
  865. 80 CONTINUE
  866. 90 CONTINUE
  867. *
  868. * Print a summary of the results.
  869. *
  870. CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS )
  871. *
  872. * Test Error Bounds from SGESVXX
  873. CALL SEBCHVXX(THRESH, PATH)
  874. 9999 FORMAT( 1X, A, ', N =', I5, ', type ', I2, ', test(', I2, ') =',
  875. $ G12.5 )
  876. 9998 FORMAT( 1X, A, ', FACT=''', A1, ''', TRANS=''', A1, ''', N=', I5,
  877. $ ', type ', I2, ', test(', I1, ')=', G12.5 )
  878. 9997 FORMAT( 1X, A, ', FACT=''', A1, ''', TRANS=''', A1, ''', N=', I5,
  879. $ ', EQUED=''', A1, ''', type ', I2, ', test(', I1, ')=',
  880. $ G12.5 )
  881. RETURN
  882. *
  883. * End of SDRVGEX
  884. *
  885. END