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