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.

dchkgb.f 25 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708
  1. *> \brief \b DCHKGB
  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 DCHKGB( 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. * DOUBLE PRECISION THRESH
  19. * ..
  20. * .. Array Arguments ..
  21. * LOGICAL DOTYPE( * )
  22. * INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NSVAL( * ),
  23. * $ NVAL( * )
  24. * DOUBLE PRECISION A( * ), AFAC( * ), B( * ), RWORK( * ),
  25. * $ WORK( * ), X( * ), XACT( * )
  26. * ..
  27. *
  28. *
  29. *> \par Purpose:
  30. * =============
  31. *>
  32. *> \verbatim
  33. *>
  34. *> DCHKGB tests DGBTRF, -TRS, -RFS, and -CON
  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] NM
  49. *> \verbatim
  50. *> NM is INTEGER
  51. *> The number of values of M contained in the vector MVAL.
  52. *> \endverbatim
  53. *>
  54. *> \param[in] MVAL
  55. *> \verbatim
  56. *> MVAL is INTEGER array, dimension (NM)
  57. *> The values of the matrix row dimension M.
  58. *> \endverbatim
  59. *>
  60. *> \param[in] NN
  61. *> \verbatim
  62. *> NN is INTEGER
  63. *> The number of values of N contained in the vector NVAL.
  64. *> \endverbatim
  65. *>
  66. *> \param[in] NVAL
  67. *> \verbatim
  68. *> NVAL is INTEGER array, dimension (NN)
  69. *> The values of the matrix column dimension N.
  70. *> \endverbatim
  71. *>
  72. *> \param[in] NNB
  73. *> \verbatim
  74. *> NNB is INTEGER
  75. *> The number of values of NB contained in the vector NBVAL.
  76. *> \endverbatim
  77. *>
  78. *> \param[in] NBVAL
  79. *> \verbatim
  80. *> NBVAL is INTEGER array, dimension (NNB)
  81. *> The values of the blocksize NB.
  82. *> \endverbatim
  83. *>
  84. *> \param[in] NNS
  85. *> \verbatim
  86. *> NNS is INTEGER
  87. *> The number of values of NRHS contained in the vector NSVAL.
  88. *> \endverbatim
  89. *>
  90. *> \param[in] NSVAL
  91. *> \verbatim
  92. *> NSVAL is INTEGER array, dimension (NNS)
  93. *> The values of the number of right hand sides NRHS.
  94. *> \endverbatim
  95. *>
  96. *> \param[in] THRESH
  97. *> \verbatim
  98. *> THRESH is DOUBLE PRECISION
  99. *> The threshold value for the test ratios. A result is
  100. *> included in the output file if RESULT >= THRESH. To have
  101. *> every test ratio printed, use THRESH = 0.
  102. *> \endverbatim
  103. *>
  104. *> \param[in] TSTERR
  105. *> \verbatim
  106. *> TSTERR is LOGICAL
  107. *> Flag that indicates whether error exits are to be tested.
  108. *> \endverbatim
  109. *>
  110. *> \param[out] A
  111. *> \verbatim
  112. *> A is DOUBLE PRECISION array, dimension (LA)
  113. *> \endverbatim
  114. *>
  115. *> \param[in] LA
  116. *> \verbatim
  117. *> LA is INTEGER
  118. *> The length of the array A. LA >= (KLMAX+KUMAX+1)*NMAX
  119. *> where KLMAX is the largest entry in the local array KLVAL,
  120. *> KUMAX is the largest entry in the local array KUVAL and
  121. *> NMAX is the largest entry in the input array NVAL.
  122. *> \endverbatim
  123. *>
  124. *> \param[out] AFAC
  125. *> \verbatim
  126. *> AFAC is DOUBLE PRECISION array, dimension (LAFAC)
  127. *> \endverbatim
  128. *>
  129. *> \param[in] LAFAC
  130. *> \verbatim
  131. *> LAFAC is INTEGER
  132. *> The length of the array AFAC. LAFAC >= (2*KLMAX+KUMAX+1)*NMAX
  133. *> where KLMAX is the largest entry in the local array KLVAL,
  134. *> KUMAX is the largest entry in the local array KUVAL and
  135. *> NMAX is the largest entry in the input array NVAL.
  136. *> \endverbatim
  137. *>
  138. *> \param[out] B
  139. *> \verbatim
  140. *> B is DOUBLE PRECISION array, dimension (NMAX*NSMAX)
  141. *> where NSMAX is the largest entry in NSVAL.
  142. *> \endverbatim
  143. *>
  144. *> \param[out] X
  145. *> \verbatim
  146. *> X is DOUBLE PRECISION array, dimension (NMAX*NSMAX)
  147. *> \endverbatim
  148. *>
  149. *> \param[out] XACT
  150. *> \verbatim
  151. *> XACT is DOUBLE PRECISION array, dimension (NMAX*NSMAX)
  152. *> \endverbatim
  153. *>
  154. *> \param[out] WORK
  155. *> \verbatim
  156. *> WORK is DOUBLE PRECISION array, dimension
  157. *> (NMAX*max(3,NSMAX,NMAX))
  158. *> \endverbatim
  159. *>
  160. *> \param[out] RWORK
  161. *> \verbatim
  162. *> RWORK is DOUBLE PRECISION array, dimension
  163. *> (NMAX+2*NSMAX)
  164. *> \endverbatim
  165. *>
  166. *> \param[out] IWORK
  167. *> \verbatim
  168. *> IWORK is INTEGER array, dimension (2*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 double_lin
  186. *
  187. * =====================================================================
  188. SUBROUTINE DCHKGB( 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. DOUBLE PRECISION THRESH
  200. * ..
  201. * .. Array Arguments ..
  202. LOGICAL DOTYPE( * )
  203. INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NSVAL( * ),
  204. $ NVAL( * )
  205. DOUBLE PRECISION A( * ), AFAC( * ), B( * ), RWORK( * ),
  206. $ WORK( * ), X( * ), XACT( * )
  207. * ..
  208. *
  209. * =====================================================================
  210. *
  211. * .. Parameters ..
  212. DOUBLE PRECISION ONE, ZERO
  213. PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
  214. INTEGER NTYPES, NTESTS
  215. PARAMETER ( NTYPES = 8, NTESTS = 7 )
  216. INTEGER NBW, NTRAN
  217. PARAMETER ( NBW = 4, NTRAN = 3 )
  218. * ..
  219. * .. Local Scalars ..
  220. LOGICAL TRFCON, ZEROT
  221. CHARACTER DIST, NORM, TRANS, TYPE, XTYPE
  222. CHARACTER*3 PATH
  223. INTEGER I, I1, I2, IKL, IKU, IM, IMAT, IN, INB, INFO,
  224. $ IOFF, IRHS, ITRAN, IZERO, J, K, KL, KOFF, KU,
  225. $ LDA, LDAFAC, LDB, M, MODE, N, NB, NERRS, NFAIL,
  226. $ NIMAT, NKL, NKU, NRHS, NRUN
  227. DOUBLE PRECISION AINVNM, ANORM, ANORMI, ANORMO, CNDNUM, RCOND,
  228. $ RCONDC, RCONDI, RCONDO
  229. * ..
  230. * .. Local Arrays ..
  231. CHARACTER TRANSS( NTRAN )
  232. INTEGER ISEED( 4 ), ISEEDY( 4 ), KLVAL( NBW ),
  233. $ KUVAL( NBW )
  234. DOUBLE PRECISION RESULT( NTESTS )
  235. * ..
  236. * .. External Functions ..
  237. DOUBLE PRECISION DGET06, DLANGB, DLANGE
  238. EXTERNAL DGET06, DLANGB, DLANGE
  239. * ..
  240. * .. External Subroutines ..
  241. EXTERNAL ALAERH, ALAHD, ALASUM, DCOPY, DERRGE, DGBCON,
  242. $ DGBRFS, DGBT01, DGBT02, DGBT05, DGBTRF, DGBTRS,
  243. $ DGET04, DLACPY, DLARHS, DLASET, DLATB4, DLATMS,
  244. $ XLAENV
  245. * ..
  246. * .. Intrinsic Functions ..
  247. INTRINSIC MAX, MIN
  248. * ..
  249. * .. Scalars in Common ..
  250. LOGICAL LERR, OK
  251. CHARACTER*32 SRNAMT
  252. INTEGER INFOT, NUNIT
  253. * ..
  254. * .. Common blocks ..
  255. COMMON / INFOC / INFOT, NUNIT, OK, LERR
  256. COMMON / SRNAMC / SRNAMT
  257. * ..
  258. * .. Data statements ..
  259. DATA ISEEDY / 1988, 1989, 1990, 1991 / ,
  260. $ TRANSS / 'N', 'T', 'C' /
  261. * ..
  262. * .. Executable Statements ..
  263. *
  264. * Initialize constants and the random number seed.
  265. *
  266. PATH( 1: 1 ) = 'Double precision'
  267. PATH( 2: 3 ) = 'GB'
  268. NRUN = 0
  269. NFAIL = 0
  270. NERRS = 0
  271. DO 10 I = 1, 4
  272. ISEED( I ) = ISEEDY( I )
  273. 10 CONTINUE
  274. *
  275. * Test the error exits
  276. *
  277. IF( TSTERR )
  278. $ CALL DERRGE( PATH, NOUT )
  279. INFOT = 0
  280. CALL XLAENV( 2, 2 )
  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 DLATB4 and generate a
  381. * test matrix with DLATMS.
  382. *
  383. CALL DLATB4( 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 = 'DLATMS'
  391. CALL DLATMS( 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 DLATMS.
  396. *
  397. IF( INFO.NE.0 ) THEN
  398. CALL ALAERH( PATH, 'DLATMS', 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 DCOPY( 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 DCOPY( 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 = DLANGB( 'O', N, KL, KU, A, LDA, RWORK )
  451. * ANORMI = DLANGB( '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 DLACPY( 'Full', KL+KU+1, N, A, LDA,
  463. $ AFAC( KL+1 ), LDAFAC )
  464. SRNAMT = 'DGBTRF'
  465. CALL DGBTRF( M, N, KL, KU, AFAC, LDAFAC, IWORK,
  466. $ INFO )
  467. *
  468. * Check error code from DGBTRF.
  469. *
  470. IF( INFO.NE.IZERO )
  471. $ CALL ALAERH( PATH, 'DGBTRF', 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 DGBT01( 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 = DLANGB( 'O', N, KL, KU, A, LDA, RWORK )
  502. ANORMI = DLANGB( '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 DLASET( 'Full', N, N, ZERO, ONE, WORK,
  511. $ LDB )
  512. SRNAMT = 'DGBTRS'
  513. CALL DGBTRS( '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 = DLANGE( '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 = DLANGE( '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 = 'DLARHS'
  569. CALL DLARHS( PATH, XTYPE, ' ', TRANS, N,
  570. $ N, KL, KU, NRHS, A, LDA,
  571. $ XACT, LDB, B, LDB, ISEED,
  572. $ INFO )
  573. XTYPE = 'C'
  574. CALL DLACPY( 'Full', N, NRHS, B, LDB, X,
  575. $ LDB )
  576. *
  577. SRNAMT = 'DGBTRS'
  578. CALL DGBTRS( TRANS, N, KL, KU, NRHS, AFAC,
  579. $ LDAFAC, IWORK, X, LDB, INFO )
  580. *
  581. * Check error code from DGBTRS.
  582. *
  583. IF( INFO.NE.0 )
  584. $ CALL ALAERH( PATH, 'DGBTRS', INFO, 0,
  585. $ TRANS, N, N, KL, KU, -1,
  586. $ IMAT, NFAIL, NERRS, NOUT )
  587. *
  588. CALL DLACPY( 'Full', N, NRHS, B, LDB,
  589. $ WORK, LDB )
  590. CALL DGBT02( 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 DGET04( 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 = 'DGBRFS'
  606. CALL DGBRFS( TRANS, N, KL, KU, NRHS, A,
  607. $ LDA, AFAC, LDAFAC, IWORK, B,
  608. $ LDB, X, LDB, RWORK,
  609. $ RWORK( NRHS+1 ), WORK,
  610. $ IWORK( N+1 ), INFO )
  611. *
  612. * Check error code from DGBRFS.
  613. *
  614. IF( INFO.NE.0 )
  615. $ CALL ALAERH( PATH, 'DGBRFS', INFO, 0,
  616. $ TRANS, N, N, KL, KU, NRHS,
  617. $ IMAT, NFAIL, NERRS, NOUT )
  618. *
  619. CALL DGET04( N, NRHS, X, LDB, XACT, LDB,
  620. $ RCONDC, RESULT( 4 ) )
  621. CALL DGBT05( TRANS, N, KL, KU, NRHS, A,
  622. $ LDA, B, LDB, X, LDB, XACT,
  623. $ LDB, RWORK, RWORK( NRHS+1 ),
  624. $ RESULT( 5 ) )
  625. DO 60 K = 2, 6
  626. IF( RESULT( K ).GE.THRESH ) THEN
  627. IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
  628. $ CALL ALAHD( NOUT, PATH )
  629. WRITE( NOUT, FMT = 9996 )TRANS, N,
  630. $ KL, KU, NRHS, IMAT, K,
  631. $ RESULT( K )
  632. NFAIL = NFAIL + 1
  633. END IF
  634. 60 CONTINUE
  635. NRUN = NRUN + 5
  636. 70 CONTINUE
  637. 80 CONTINUE
  638. *
  639. *+ TEST 7:
  640. * Get an estimate of RCOND = 1/CNDNUM.
  641. *
  642. 90 CONTINUE
  643. DO 100 ITRAN = 1, 2
  644. IF( ITRAN.EQ.1 ) THEN
  645. ANORM = ANORMO
  646. RCONDC = RCONDO
  647. NORM = 'O'
  648. ELSE
  649. ANORM = ANORMI
  650. RCONDC = RCONDI
  651. NORM = 'I'
  652. END IF
  653. SRNAMT = 'DGBCON'
  654. CALL DGBCON( NORM, N, KL, KU, AFAC, LDAFAC,
  655. $ IWORK, ANORM, RCOND, WORK,
  656. $ IWORK( N+1 ), INFO )
  657. *
  658. * Check error code from DGBCON.
  659. *
  660. IF( INFO.NE.0 )
  661. $ CALL ALAERH( PATH, 'DGBCON', INFO, 0,
  662. $ NORM, N, N, KL, KU, -1, IMAT,
  663. $ NFAIL, NERRS, NOUT )
  664. *
  665. RESULT( 7 ) = DGET06( RCOND, RCONDC )
  666. *
  667. * Print information about the tests that did
  668. * not pass the threshold.
  669. *
  670. IF( RESULT( 7 ).GE.THRESH ) THEN
  671. IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
  672. $ CALL ALAHD( NOUT, PATH )
  673. WRITE( NOUT, FMT = 9995 )NORM, N, KL, KU,
  674. $ IMAT, 7, RESULT( 7 )
  675. NFAIL = NFAIL + 1
  676. END IF
  677. NRUN = NRUN + 1
  678. 100 CONTINUE
  679. *
  680. 110 CONTINUE
  681. 120 CONTINUE
  682. 130 CONTINUE
  683. 140 CONTINUE
  684. 150 CONTINUE
  685. 160 CONTINUE
  686. *
  687. * Print a summary of the results.
  688. *
  689. CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS )
  690. *
  691. 9999 FORMAT( ' *** In DCHKGB, LA=', I5, ' is too small for M=', I5,
  692. $ ', N=', I5, ', KL=', I4, ', KU=', I4,
  693. $ / ' ==> Increase LA to at least ', I5 )
  694. 9998 FORMAT( ' *** In DCHKGB, LAFAC=', I5, ' is too small for M=', I5,
  695. $ ', N=', I5, ', KL=', I4, ', KU=', I4,
  696. $ / ' ==> Increase LAFAC to at least ', I5 )
  697. 9997 FORMAT( ' M =', I5, ', N =', I5, ', KL=', I5, ', KU=', I5,
  698. $ ', NB =', I4, ', type ', I1, ', test(', I1, ')=', G12.5 )
  699. 9996 FORMAT( ' TRANS=''', A1, ''', N=', I5, ', KL=', I5, ', KU=', I5,
  700. $ ', NRHS=', I3, ', type ', I1, ', test(', I1, ')=', G12.5 )
  701. 9995 FORMAT( ' NORM =''', A1, ''', N=', I5, ', KL=', I5, ', KU=', I5,
  702. $ ',', 10X, ' type ', I1, ', test(', I1, ')=', G12.5 )
  703. *
  704. RETURN
  705. *
  706. * End of DCHKGB
  707. *
  708. END