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