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.

cdrvge.f 25 kB

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