![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b CCHKGB 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 * Definition: 00009 * =========== 00010 * 00011 * SUBROUTINE CCHKGB( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NNS, 00012 * NSVAL, THRESH, TSTERR, A, LA, AFAC, LAFAC, B, 00013 * X, XACT, WORK, RWORK, IWORK, NOUT ) 00014 * 00015 * .. Scalar Arguments .. 00016 * LOGICAL TSTERR 00017 * INTEGER LA, LAFAC, NM, NN, NNB, NNS, NOUT 00018 * REAL THRESH 00019 * .. 00020 * .. Array Arguments .. 00021 * LOGICAL DOTYPE( * ) 00022 * INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NSVAL( * ), 00023 * $ NVAL( * ) 00024 * REAL RWORK( * ) 00025 * COMPLEX A( * ), AFAC( * ), B( * ), WORK( * ), X( * ), 00026 * $ XACT( * ) 00027 * .. 00028 * 00029 * 00030 *> \par Purpose: 00031 * ============= 00032 *> 00033 *> \verbatim 00034 *> 00035 *> CCHKGB tests CGBTRF, -TRS, -RFS, and -CON 00036 *> \endverbatim 00037 * 00038 * Arguments: 00039 * ========== 00040 * 00041 *> \param[in] DOTYPE 00042 *> \verbatim 00043 *> DOTYPE is LOGICAL array, dimension (NTYPES) 00044 *> The matrix types to be used for testing. Matrices of type j 00045 *> (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) = 00046 *> .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used. 00047 *> \endverbatim 00048 *> 00049 *> \param[in] NM 00050 *> \verbatim 00051 *> NM is INTEGER 00052 *> The number of values of M contained in the vector MVAL. 00053 *> \endverbatim 00054 *> 00055 *> \param[in] MVAL 00056 *> \verbatim 00057 *> MVAL is INTEGER array, dimension (NM) 00058 *> The values of the matrix row dimension M. 00059 *> \endverbatim 00060 *> 00061 *> \param[in] NN 00062 *> \verbatim 00063 *> NN is INTEGER 00064 *> The number of values of N contained in the vector NVAL. 00065 *> \endverbatim 00066 *> 00067 *> \param[in] NVAL 00068 *> \verbatim 00069 *> NVAL is INTEGER array, dimension (NN) 00070 *> The values of the matrix column dimension N. 00071 *> \endverbatim 00072 *> 00073 *> \param[in] NNB 00074 *> \verbatim 00075 *> NNB is INTEGER 00076 *> The number of values of NB contained in the vector NBVAL. 00077 *> \endverbatim 00078 *> 00079 *> \param[in] NBVAL 00080 *> \verbatim 00081 *> NBVAL is INTEGER array, dimension (NNB) 00082 *> The values of the blocksize NB. 00083 *> \endverbatim 00084 *> 00085 *> \param[in] NNS 00086 *> \verbatim 00087 *> NNS is INTEGER 00088 *> The number of values of NRHS contained in the vector NSVAL. 00089 *> \endverbatim 00090 *> 00091 *> \param[in] NSVAL 00092 *> \verbatim 00093 *> NSVAL is INTEGER array, dimension (NNS) 00094 *> The values of the number of right hand sides NRHS. 00095 *> \endverbatim 00096 *> 00097 *> \param[in] THRESH 00098 *> \verbatim 00099 *> THRESH is REAL 00100 *> The threshold value for the test ratios. A result is 00101 *> included in the output file if RESULT >= THRESH. To have 00102 *> every test ratio printed, use THRESH = 0. 00103 *> \endverbatim 00104 *> 00105 *> \param[in] TSTERR 00106 *> \verbatim 00107 *> TSTERR is LOGICAL 00108 *> Flag that indicates whether error exits are to be tested. 00109 *> \endverbatim 00110 *> 00111 *> \param[out] A 00112 *> \verbatim 00113 *> A is COMPLEX array, dimension (LA) 00114 *> \endverbatim 00115 *> 00116 *> \param[in] LA 00117 *> \verbatim 00118 *> LA is INTEGER 00119 *> The length of the array A. LA >= (KLMAX+KUMAX+1)*NMAX 00120 *> where KLMAX is the largest entry in the local array KLVAL, 00121 *> KUMAX is the largest entry in the local array KUVAL and 00122 *> NMAX is the largest entry in the input array NVAL. 00123 *> \endverbatim 00124 *> 00125 *> \param[out] AFAC 00126 *> \verbatim 00127 *> AFAC is COMPLEX array, dimension (LAFAC) 00128 *> \endverbatim 00129 *> 00130 *> \param[in] LAFAC 00131 *> \verbatim 00132 *> LAFAC is INTEGER 00133 *> The length of the array AFAC. LAFAC >= (2*KLMAX+KUMAX+1)*NMAX 00134 *> where KLMAX is the largest entry in the local array KLVAL, 00135 *> KUMAX is the largest entry in the local array KUVAL and 00136 *> NMAX is the largest entry in the input array NVAL. 00137 *> \endverbatim 00138 *> 00139 *> \param[out] B 00140 *> \verbatim 00141 *> B is COMPLEX array, dimension (NMAX*NSMAX) 00142 *> \endverbatim 00143 *> 00144 *> \param[out] X 00145 *> \verbatim 00146 *> X is COMPLEX array, dimension (NMAX*NSMAX) 00147 *> \endverbatim 00148 *> 00149 *> \param[out] XACT 00150 *> \verbatim 00151 *> XACT is COMPLEX array, dimension (NMAX*NSMAX) 00152 *> \endverbatim 00153 *> 00154 *> \param[out] WORK 00155 *> \verbatim 00156 *> WORK is COMPLEX array, dimension 00157 *> (NMAX*max(3,NSMAX,NMAX)) 00158 *> \endverbatim 00159 *> 00160 *> \param[out] RWORK 00161 *> \verbatim 00162 *> RWORK is REAL array, dimension 00163 *> (max(NMAX,2*NSMAX)) 00164 *> \endverbatim 00165 *> 00166 *> \param[out] IWORK 00167 *> \verbatim 00168 *> IWORK is INTEGER array, dimension (NMAX) 00169 *> \endverbatim 00170 *> 00171 *> \param[in] NOUT 00172 *> \verbatim 00173 *> NOUT is INTEGER 00174 *> The unit number for output. 00175 *> \endverbatim 00176 * 00177 * Authors: 00178 * ======== 00179 * 00180 *> \author Univ. of Tennessee 00181 *> \author Univ. of California Berkeley 00182 *> \author Univ. of Colorado Denver 00183 *> \author NAG Ltd. 00184 * 00185 *> \date November 2011 00186 * 00187 *> \ingroup complex_lin 00188 * 00189 * ===================================================================== 00190 SUBROUTINE CCHKGB( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NNS, 00191 $ NSVAL, THRESH, TSTERR, A, LA, AFAC, LAFAC, B, 00192 $ X, XACT, WORK, RWORK, IWORK, NOUT ) 00193 * 00194 * -- LAPACK test routine (version 3.4.0) -- 00195 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00196 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00197 * November 2011 00198 * 00199 * .. Scalar Arguments .. 00200 LOGICAL TSTERR 00201 INTEGER LA, LAFAC, NM, NN, NNB, NNS, NOUT 00202 REAL THRESH 00203 * .. 00204 * .. Array Arguments .. 00205 LOGICAL DOTYPE( * ) 00206 INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NSVAL( * ), 00207 $ NVAL( * ) 00208 REAL RWORK( * ) 00209 COMPLEX A( * ), AFAC( * ), B( * ), WORK( * ), X( * ), 00210 $ XACT( * ) 00211 * .. 00212 * 00213 * ===================================================================== 00214 * 00215 * .. Parameters .. 00216 REAL ONE, ZERO 00217 PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) 00218 INTEGER NTYPES, NTESTS 00219 PARAMETER ( NTYPES = 8, NTESTS = 7 ) 00220 INTEGER NBW, NTRAN 00221 PARAMETER ( NBW = 4, NTRAN = 3 ) 00222 * .. 00223 * .. Local Scalars .. 00224 LOGICAL TRFCON, ZEROT 00225 CHARACTER DIST, NORM, TRANS, TYPE, XTYPE 00226 CHARACTER*3 PATH 00227 INTEGER I, I1, I2, IKL, IKU, IM, IMAT, IN, INB, INFO, 00228 $ IOFF, IRHS, ITRAN, IZERO, J, K, KL, KOFF, KU, 00229 $ LDA, LDAFAC, LDB, M, MODE, N, NB, NERRS, NFAIL, 00230 $ NIMAT, NKL, NKU, NRHS, NRUN 00231 REAL AINVNM, ANORM, ANORMI, ANORMO, CNDNUM, RCOND, 00232 $ RCONDC, RCONDI, RCONDO 00233 * .. 00234 * .. Local Arrays .. 00235 CHARACTER TRANSS( NTRAN ) 00236 INTEGER ISEED( 4 ), ISEEDY( 4 ), KLVAL( NBW ), 00237 $ KUVAL( NBW ) 00238 REAL RESULT( NTESTS ) 00239 * .. 00240 * .. External Functions .. 00241 REAL CLANGB, CLANGE, SGET06 00242 EXTERNAL CLANGB, CLANGE, SGET06 00243 * .. 00244 * .. External Subroutines .. 00245 EXTERNAL ALAERH, ALAHD, ALASUM, CCOPY, CERRGE, CGBCON, 00246 $ CGBRFS, CGBT01, CGBT02, CGBT05, CGBTRF, CGBTRS, 00247 $ CGET04, CLACPY, CLARHS, CLASET, CLATB4, CLATMS, 00248 $ XLAENV 00249 * .. 00250 * .. Intrinsic Functions .. 00251 INTRINSIC CMPLX, MAX, MIN 00252 * .. 00253 * .. Scalars in Common .. 00254 LOGICAL LERR, OK 00255 CHARACTER*32 SRNAMT 00256 INTEGER INFOT, NUNIT 00257 * .. 00258 * .. Common blocks .. 00259 COMMON / INFOC / INFOT, NUNIT, OK, LERR 00260 COMMON / SRNAMC / SRNAMT 00261 * .. 00262 * .. Data statements .. 00263 DATA ISEEDY / 1988, 1989, 1990, 1991 / , 00264 $ TRANSS / 'N', 'T', 'C' / 00265 * .. 00266 * .. Executable Statements .. 00267 * 00268 * Initialize constants and the random number seed. 00269 * 00270 PATH( 1: 1 ) = 'Complex precision' 00271 PATH( 2: 3 ) = 'GB' 00272 NRUN = 0 00273 NFAIL = 0 00274 NERRS = 0 00275 DO 10 I = 1, 4 00276 ISEED( I ) = ISEEDY( I ) 00277 10 CONTINUE 00278 * 00279 * Test the error exits 00280 * 00281 IF( TSTERR ) 00282 $ CALL CERRGE( PATH, NOUT ) 00283 INFOT = 0 00284 * 00285 * Initialize the first value for the lower and upper bandwidths. 00286 * 00287 KLVAL( 1 ) = 0 00288 KUVAL( 1 ) = 0 00289 * 00290 * Do for each value of M in MVAL 00291 * 00292 DO 160 IM = 1, NM 00293 M = MVAL( IM ) 00294 * 00295 * Set values to use for the lower bandwidth. 00296 * 00297 KLVAL( 2 ) = M + ( M+1 ) / 4 00298 * 00299 * KLVAL( 2 ) = MAX( M-1, 0 ) 00300 * 00301 KLVAL( 3 ) = ( 3*M-1 ) / 4 00302 KLVAL( 4 ) = ( M+1 ) / 4 00303 * 00304 * Do for each value of N in NVAL 00305 * 00306 DO 150 IN = 1, NN 00307 N = NVAL( IN ) 00308 XTYPE = 'N' 00309 * 00310 * Set values to use for the upper bandwidth. 00311 * 00312 KUVAL( 2 ) = N + ( N+1 ) / 4 00313 * 00314 * KUVAL( 2 ) = MAX( N-1, 0 ) 00315 * 00316 KUVAL( 3 ) = ( 3*N-1 ) / 4 00317 KUVAL( 4 ) = ( N+1 ) / 4 00318 * 00319 * Set limits on the number of loop iterations. 00320 * 00321 NKL = MIN( M+1, 4 ) 00322 IF( N.EQ.0 ) 00323 $ NKL = 2 00324 NKU = MIN( N+1, 4 ) 00325 IF( M.EQ.0 ) 00326 $ NKU = 2 00327 NIMAT = NTYPES 00328 IF( M.LE.0 .OR. N.LE.0 ) 00329 $ NIMAT = 1 00330 * 00331 DO 140 IKL = 1, NKL 00332 * 00333 * Do for KL = 0, (5*M+1)/4, (3M-1)/4, and (M+1)/4. This 00334 * order makes it easier to skip redundant values for small 00335 * values of M. 00336 * 00337 KL = KLVAL( IKL ) 00338 DO 130 IKU = 1, NKU 00339 * 00340 * Do for KU = 0, (5*N+1)/4, (3N-1)/4, and (N+1)/4. This 00341 * order makes it easier to skip redundant values for 00342 * small values of N. 00343 * 00344 KU = KUVAL( IKU ) 00345 * 00346 * Check that A and AFAC are big enough to generate this 00347 * matrix. 00348 * 00349 LDA = KL + KU + 1 00350 LDAFAC = 2*KL + KU + 1 00351 IF( ( LDA*N ).GT.LA .OR. ( LDAFAC*N ).GT.LAFAC ) THEN 00352 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 00353 $ CALL ALAHD( NOUT, PATH ) 00354 IF( N*( KL+KU+1 ).GT.LA ) THEN 00355 WRITE( NOUT, FMT = 9999 )LA, M, N, KL, KU, 00356 $ N*( KL+KU+1 ) 00357 NERRS = NERRS + 1 00358 END IF 00359 IF( N*( 2*KL+KU+1 ).GT.LAFAC ) THEN 00360 WRITE( NOUT, FMT = 9998 )LAFAC, M, N, KL, KU, 00361 $ N*( 2*KL+KU+1 ) 00362 NERRS = NERRS + 1 00363 END IF 00364 GO TO 130 00365 END IF 00366 * 00367 DO 120 IMAT = 1, NIMAT 00368 * 00369 * Do the tests only if DOTYPE( IMAT ) is true. 00370 * 00371 IF( .NOT.DOTYPE( IMAT ) ) 00372 $ GO TO 120 00373 * 00374 * Skip types 2, 3, or 4 if the matrix size is too 00375 * small. 00376 * 00377 ZEROT = IMAT.GE.2 .AND. IMAT.LE.4 00378 IF( ZEROT .AND. N.LT.IMAT-1 ) 00379 $ GO TO 120 00380 * 00381 IF( .NOT.ZEROT .OR. .NOT.DOTYPE( 1 ) ) THEN 00382 * 00383 * Set up parameters with CLATB4 and generate a 00384 * test matrix with CLATMS. 00385 * 00386 CALL CLATB4( PATH, IMAT, M, N, TYPE, KL, KU, 00387 $ ANORM, MODE, CNDNUM, DIST ) 00388 * 00389 KOFF = MAX( 1, KU+2-N ) 00390 DO 20 I = 1, KOFF - 1 00391 A( I ) = ZERO 00392 20 CONTINUE 00393 SRNAMT = 'CLATMS' 00394 CALL CLATMS( M, N, DIST, ISEED, TYPE, RWORK, 00395 $ MODE, CNDNUM, ANORM, KL, KU, 'Z', 00396 $ A( KOFF ), LDA, WORK, INFO ) 00397 * 00398 * Check the error code from CLATMS. 00399 * 00400 IF( INFO.NE.0 ) THEN 00401 CALL ALAERH( PATH, 'CLATMS', INFO, 0, ' ', M, 00402 $ N, KL, KU, -1, IMAT, NFAIL, 00403 $ NERRS, NOUT ) 00404 GO TO 120 00405 END IF 00406 ELSE IF( IZERO.GT.0 ) THEN 00407 * 00408 * Use the same matrix for types 3 and 4 as for 00409 * type 2 by copying back the zeroed out column. 00410 * 00411 CALL CCOPY( I2-I1+1, B, 1, A( IOFF+I1 ), 1 ) 00412 END IF 00413 * 00414 * For types 2, 3, and 4, zero one or more columns of 00415 * the matrix to test that INFO is returned correctly. 00416 * 00417 IZERO = 0 00418 IF( ZEROT ) THEN 00419 IF( IMAT.EQ.2 ) THEN 00420 IZERO = 1 00421 ELSE IF( IMAT.EQ.3 ) THEN 00422 IZERO = MIN( M, N ) 00423 ELSE 00424 IZERO = MIN( M, N ) / 2 + 1 00425 END IF 00426 IOFF = ( IZERO-1 )*LDA 00427 IF( IMAT.LT.4 ) THEN 00428 * 00429 * Store the column to be zeroed out in B. 00430 * 00431 I1 = MAX( 1, KU+2-IZERO ) 00432 I2 = MIN( KL+KU+1, KU+1+( M-IZERO ) ) 00433 CALL CCOPY( I2-I1+1, A( IOFF+I1 ), 1, B, 1 ) 00434 * 00435 DO 30 I = I1, I2 00436 A( IOFF+I ) = ZERO 00437 30 CONTINUE 00438 ELSE 00439 DO 50 J = IZERO, N 00440 DO 40 I = MAX( 1, KU+2-J ), 00441 $ MIN( KL+KU+1, KU+1+( M-J ) ) 00442 A( IOFF+I ) = ZERO 00443 40 CONTINUE 00444 IOFF = IOFF + LDA 00445 50 CONTINUE 00446 END IF 00447 END IF 00448 * 00449 * These lines, if used in place of the calls in the 00450 * loop over INB, cause the code to bomb on a Sun 00451 * SPARCstation. 00452 * 00453 * ANORMO = CLANGB( 'O', N, KL, KU, A, LDA, RWORK ) 00454 * ANORMI = CLANGB( 'I', N, KL, KU, A, LDA, RWORK ) 00455 * 00456 * Do for each blocksize in NBVAL 00457 * 00458 DO 110 INB = 1, NNB 00459 NB = NBVAL( INB ) 00460 CALL XLAENV( 1, NB ) 00461 * 00462 * Compute the LU factorization of the band matrix. 00463 * 00464 IF( M.GT.0 .AND. N.GT.0 ) 00465 $ CALL CLACPY( 'Full', KL+KU+1, N, A, LDA, 00466 $ AFAC( KL+1 ), LDAFAC ) 00467 SRNAMT = 'CGBTRF' 00468 CALL CGBTRF( M, N, KL, KU, AFAC, LDAFAC, IWORK, 00469 $ INFO ) 00470 * 00471 * Check error code from CGBTRF. 00472 * 00473 IF( INFO.NE.IZERO ) 00474 $ CALL ALAERH( PATH, 'CGBTRF', INFO, IZERO, 00475 $ ' ', M, N, KL, KU, NB, IMAT, 00476 $ NFAIL, NERRS, NOUT ) 00477 TRFCON = .FALSE. 00478 * 00479 *+ TEST 1 00480 * Reconstruct matrix from factors and compute 00481 * residual. 00482 * 00483 CALL CGBT01( M, N, KL, KU, A, LDA, AFAC, LDAFAC, 00484 $ IWORK, WORK, RESULT( 1 ) ) 00485 * 00486 * Print information about the tests so far that 00487 * did not pass the threshold. 00488 * 00489 IF( RESULT( 1 ).GE.THRESH ) THEN 00490 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 00491 $ CALL ALAHD( NOUT, PATH ) 00492 WRITE( NOUT, FMT = 9997 )M, N, KL, KU, NB, 00493 $ IMAT, 1, RESULT( 1 ) 00494 NFAIL = NFAIL + 1 00495 END IF 00496 NRUN = NRUN + 1 00497 * 00498 * Skip the remaining tests if this is not the 00499 * first block size or if M .ne. N. 00500 * 00501 IF( INB.GT.1 .OR. M.NE.N ) 00502 $ GO TO 110 00503 * 00504 ANORMO = CLANGB( 'O', N, KL, KU, A, LDA, RWORK ) 00505 ANORMI = CLANGB( 'I', N, KL, KU, A, LDA, RWORK ) 00506 * 00507 IF( INFO.EQ.0 ) THEN 00508 * 00509 * Form the inverse of A so we can get a good 00510 * estimate of CNDNUM = norm(A) * norm(inv(A)). 00511 * 00512 LDB = MAX( 1, N ) 00513 CALL CLASET( 'Full', N, N, CMPLX( ZERO ), 00514 $ CMPLX( ONE ), WORK, LDB ) 00515 SRNAMT = 'CGBTRS' 00516 CALL CGBTRS( 'No transpose', N, KL, KU, N, 00517 $ AFAC, LDAFAC, IWORK, WORK, LDB, 00518 $ INFO ) 00519 * 00520 * Compute the 1-norm condition number of A. 00521 * 00522 AINVNM = CLANGE( 'O', N, N, WORK, LDB, 00523 $ RWORK ) 00524 IF( ANORMO.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN 00525 RCONDO = ONE 00526 ELSE 00527 RCONDO = ( ONE / ANORMO ) / AINVNM 00528 END IF 00529 * 00530 * Compute the infinity-norm condition number of 00531 * A. 00532 * 00533 AINVNM = CLANGE( 'I', N, N, WORK, LDB, 00534 $ RWORK ) 00535 IF( ANORMI.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN 00536 RCONDI = ONE 00537 ELSE 00538 RCONDI = ( ONE / ANORMI ) / AINVNM 00539 END IF 00540 ELSE 00541 * 00542 * Do only the condition estimate if INFO.NE.0. 00543 * 00544 TRFCON = .TRUE. 00545 RCONDO = ZERO 00546 RCONDI = ZERO 00547 END IF 00548 * 00549 * Skip the solve tests if the matrix is singular. 00550 * 00551 IF( TRFCON ) 00552 $ GO TO 90 00553 * 00554 DO 80 IRHS = 1, NNS 00555 NRHS = NSVAL( IRHS ) 00556 XTYPE = 'N' 00557 * 00558 DO 70 ITRAN = 1, NTRAN 00559 TRANS = TRANSS( ITRAN ) 00560 IF( ITRAN.EQ.1 ) THEN 00561 RCONDC = RCONDO 00562 NORM = 'O' 00563 ELSE 00564 RCONDC = RCONDI 00565 NORM = 'I' 00566 END IF 00567 * 00568 *+ TEST 2: 00569 * Solve and compute residual for A * X = B. 00570 * 00571 SRNAMT = 'CLARHS' 00572 CALL CLARHS( PATH, XTYPE, ' ', TRANS, N, 00573 $ N, KL, KU, NRHS, A, LDA, 00574 $ XACT, LDB, B, LDB, ISEED, 00575 $ INFO ) 00576 XTYPE = 'C' 00577 CALL CLACPY( 'Full', N, NRHS, B, LDB, X, 00578 $ LDB ) 00579 * 00580 SRNAMT = 'CGBTRS' 00581 CALL CGBTRS( TRANS, N, KL, KU, NRHS, AFAC, 00582 $ LDAFAC, IWORK, X, LDB, INFO ) 00583 * 00584 * Check error code from CGBTRS. 00585 * 00586 IF( INFO.NE.0 ) 00587 $ CALL ALAERH( PATH, 'CGBTRS', INFO, 0, 00588 $ TRANS, N, N, KL, KU, -1, 00589 $ IMAT, NFAIL, NERRS, NOUT ) 00590 * 00591 CALL CLACPY( 'Full', N, NRHS, B, LDB, 00592 $ WORK, LDB ) 00593 CALL CGBT02( TRANS, M, N, KL, KU, NRHS, A, 00594 $ LDA, X, LDB, WORK, LDB, 00595 $ RESULT( 2 ) ) 00596 * 00597 *+ TEST 3: 00598 * Check solution from generated exact 00599 * solution. 00600 * 00601 CALL CGET04( N, NRHS, X, LDB, XACT, LDB, 00602 $ RCONDC, RESULT( 3 ) ) 00603 * 00604 *+ TESTS 4, 5, 6: 00605 * Use iterative refinement to improve the 00606 * solution. 00607 * 00608 SRNAMT = 'CGBRFS' 00609 CALL CGBRFS( TRANS, N, KL, KU, NRHS, A, 00610 $ LDA, AFAC, LDAFAC, IWORK, B, 00611 $ LDB, X, LDB, RWORK, 00612 $ RWORK( NRHS+1 ), WORK, 00613 $ RWORK( 2*NRHS+1 ), INFO ) 00614 * 00615 * Check error code from CGBRFS. 00616 * 00617 IF( INFO.NE.0 ) 00618 $ CALL ALAERH( PATH, 'CGBRFS', INFO, 0, 00619 $ TRANS, N, N, KL, KU, NRHS, 00620 $ IMAT, NFAIL, NERRS, NOUT ) 00621 * 00622 CALL CGET04( N, NRHS, X, LDB, XACT, LDB, 00623 $ RCONDC, RESULT( 4 ) ) 00624 CALL CGBT05( TRANS, N, KL, KU, NRHS, A, 00625 $ LDA, B, LDB, X, LDB, XACT, 00626 $ LDB, RWORK, RWORK( NRHS+1 ), 00627 $ RESULT( 5 ) ) 00628 * 00629 * Print information about the tests that did 00630 * not pass the threshold. 00631 * 00632 DO 60 K = 2, 6 00633 IF( RESULT( K ).GE.THRESH ) THEN 00634 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 00635 $ CALL ALAHD( NOUT, PATH ) 00636 WRITE( NOUT, FMT = 9996 )TRANS, N, 00637 $ KL, KU, NRHS, IMAT, K, 00638 $ RESULT( K ) 00639 NFAIL = NFAIL + 1 00640 END IF 00641 60 CONTINUE 00642 NRUN = NRUN + 5 00643 70 CONTINUE 00644 80 CONTINUE 00645 * 00646 *+ TEST 7: 00647 * Get an estimate of RCOND = 1/CNDNUM. 00648 * 00649 90 CONTINUE 00650 DO 100 ITRAN = 1, 2 00651 IF( ITRAN.EQ.1 ) THEN 00652 ANORM = ANORMO 00653 RCONDC = RCONDO 00654 NORM = 'O' 00655 ELSE 00656 ANORM = ANORMI 00657 RCONDC = RCONDI 00658 NORM = 'I' 00659 END IF 00660 SRNAMT = 'CGBCON' 00661 CALL CGBCON( NORM, N, KL, KU, AFAC, LDAFAC, 00662 $ IWORK, ANORM, RCOND, WORK, 00663 $ RWORK, INFO ) 00664 * 00665 * Check error code from CGBCON. 00666 * 00667 IF( INFO.NE.0 ) 00668 $ CALL ALAERH( PATH, 'CGBCON', INFO, 0, 00669 $ NORM, N, N, KL, KU, -1, IMAT, 00670 $ NFAIL, NERRS, NOUT ) 00671 * 00672 RESULT( 7 ) = SGET06( RCOND, RCONDC ) 00673 * 00674 * Print information about the tests that did 00675 * not pass the threshold. 00676 * 00677 IF( RESULT( 7 ).GE.THRESH ) THEN 00678 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 00679 $ CALL ALAHD( NOUT, PATH ) 00680 WRITE( NOUT, FMT = 9995 )NORM, N, KL, KU, 00681 $ IMAT, 7, RESULT( 7 ) 00682 NFAIL = NFAIL + 1 00683 END IF 00684 NRUN = NRUN + 1 00685 100 CONTINUE 00686 110 CONTINUE 00687 120 CONTINUE 00688 130 CONTINUE 00689 140 CONTINUE 00690 150 CONTINUE 00691 160 CONTINUE 00692 * 00693 * Print a summary of the results. 00694 * 00695 CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS ) 00696 * 00697 9999 FORMAT( ' *** In CCHKGB, LA=', I5, ' is too small for M=', I5, 00698 $ ', N=', I5, ', KL=', I4, ', KU=', I4, 00699 $ / ' ==> Increase LA to at least ', I5 ) 00700 9998 FORMAT( ' *** In CCHKGB, LAFAC=', I5, ' is too small for M=', I5, 00701 $ ', N=', I5, ', KL=', I4, ', KU=', I4, 00702 $ / ' ==> Increase LAFAC to at least ', I5 ) 00703 9997 FORMAT( ' M =', I5, ', N =', I5, ', KL=', I5, ', KU=', I5, 00704 $ ', NB =', I4, ', type ', I1, ', test(', I1, ')=', G12.5 ) 00705 9996 FORMAT( ' TRANS=''', A1, ''', N=', I5, ', KL=', I5, ', KU=', I5, 00706 $ ', NRHS=', I3, ', type ', I1, ', test(', I1, ')=', G12.5 ) 00707 9995 FORMAT( ' NORM =''', A1, ''', N=', I5, ', KL=', I5, ', KU=', I5, 00708 $ ',', 10X, ' type ', I1, ', test(', I1, ')=', G12.5 ) 00709 * 00710 RETURN 00711 * 00712 * End of CCHKGB 00713 * 00714 END