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.

cchkgb.f 25 kB

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