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.

zdrvgex.f 33 kB

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