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.

cdrvgbx.f 41 kB

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