|
LAPACK 3.3.0
|
|
LAPACK 3.3.0
|
00001 SUBROUTINE SDRVGE( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, 00002 $ A, AFAC, ASAV, B, BSAV, X, XACT, S, WORK, 00003 $ 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 NMAX, NN, NOUT, NRHS 00012 REAL THRESH 00013 * .. 00014 * .. Array Arguments .. 00015 LOGICAL DOTYPE( * ) 00016 INTEGER IWORK( * ), NVAL( * ) 00017 REAL A( * ), AFAC( * ), ASAV( * ), B( * ), 00018 $ BSAV( * ), RWORK( * ), S( * ), WORK( * ), 00019 $ X( * ), XACT( * ) 00020 * .. 00021 * 00022 * Purpose 00023 * ======= 00024 * 00025 * SDRVGE tests the driver routines SGESV and -SVX. 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 * NN (input) INTEGER 00036 * The number of values of N contained in the vector NVAL. 00037 * 00038 * NVAL (input) INTEGER array, dimension (NN) 00039 * The values of the matrix column dimension N. 00040 * 00041 * NRHS (input) INTEGER 00042 * The number of right hand side vectors to be generated for 00043 * each linear system. 00044 * 00045 * THRESH (input) REAL 00046 * The threshold value for the test ratios. A result is 00047 * included in the output file if RESULT >= THRESH. To have 00048 * every test ratio printed, use THRESH = 0. 00049 * 00050 * TSTERR (input) LOGICAL 00051 * Flag that indicates whether error exits are to be tested. 00052 * 00053 * NMAX (input) INTEGER 00054 * The maximum value permitted for N, used in dimensioning the 00055 * work arrays. 00056 * 00057 * A (workspace) REAL array, dimension (NMAX*NMAX) 00058 * 00059 * AFAC (workspace) REAL array, dimension (NMAX*NMAX) 00060 * 00061 * ASAV (workspace) REAL array, dimension (NMAX*NMAX) 00062 * 00063 * B (workspace) REAL array, dimension (NMAX*NRHS) 00064 * 00065 * BSAV (workspace) REAL array, dimension (NMAX*NRHS) 00066 * 00067 * X (workspace) REAL array, dimension (NMAX*NRHS) 00068 * 00069 * XACT (workspace) REAL array, dimension (NMAX*NRHS) 00070 * 00071 * S (workspace) REAL array, dimension (2*NMAX) 00072 * 00073 * WORK (workspace) REAL array, dimension 00074 * (NMAX*max(3,NRHS)) 00075 * 00076 * RWORK (workspace) REAL array, dimension (2*NRHS+NMAX) 00077 * 00078 * IWORK (workspace) INTEGER array, dimension (2*NMAX) 00079 * 00080 * NOUT (input) INTEGER 00081 * The unit number for output. 00082 * 00083 * ===================================================================== 00084 * 00085 * .. Parameters .. 00086 REAL ONE, ZERO 00087 PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) 00088 INTEGER NTYPES 00089 PARAMETER ( NTYPES = 11 ) 00090 INTEGER NTESTS 00091 PARAMETER ( NTESTS = 7 ) 00092 INTEGER NTRAN 00093 PARAMETER ( NTRAN = 3 ) 00094 * .. 00095 * .. Local Scalars .. 00096 LOGICAL EQUIL, NOFACT, PREFAC, TRFCON, ZEROT 00097 CHARACTER DIST, EQUED, FACT, TRANS, TYPE, XTYPE 00098 CHARACTER*3 PATH 00099 INTEGER I, IEQUED, IFACT, IMAT, IN, INFO, IOFF, ITRAN, 00100 $ IZERO, K, K1, KL, KU, LDA, LWORK, MODE, N, NB, 00101 $ NBMIN, NERRS, NFACT, NFAIL, NIMAT, NRUN, NT 00102 REAL AINVNM, AMAX, ANORM, ANORMI, ANORMO, CNDNUM, 00103 $ COLCND, RCOND, RCONDC, RCONDI, RCONDO, ROLDC, 00104 $ ROLDI, ROLDO, ROWCND, RPVGRW 00105 * .. 00106 * .. Local Arrays .. 00107 CHARACTER EQUEDS( 4 ), FACTS( 3 ), TRANSS( NTRAN ) 00108 INTEGER ISEED( 4 ), ISEEDY( 4 ) 00109 REAL RESULT( NTESTS ) 00110 * .. 00111 * .. External Functions .. 00112 LOGICAL LSAME 00113 REAL SGET06, SLAMCH, SLANGE, SLANTR 00114 EXTERNAL LSAME, SGET06, SLAMCH, SLANGE, SLANTR 00115 * .. 00116 * .. External Subroutines .. 00117 EXTERNAL ALADHD, ALAERH, ALASVM, SERRVX, SGEEQU, SGESV, 00118 $ SGESVX, SGET01, SGET02, SGET04, SGET07, SGETRF, 00119 $ SGETRI, SLACPY, SLAQGE, SLARHS, SLASET, SLATB4, 00120 $ SLATMS, XLAENV 00121 * .. 00122 * .. Intrinsic Functions .. 00123 INTRINSIC ABS, MAX 00124 * .. 00125 * .. Scalars in Common .. 00126 LOGICAL LERR, OK 00127 CHARACTER*32 SRNAMT 00128 INTEGER INFOT, NUNIT 00129 * .. 00130 * .. Common blocks .. 00131 COMMON / INFOC / INFOT, NUNIT, OK, LERR 00132 COMMON / SRNAMC / SRNAMT 00133 * .. 00134 * .. Data statements .. 00135 DATA ISEEDY / 1988, 1989, 1990, 1991 / 00136 DATA TRANSS / 'N', 'T', 'C' / 00137 DATA FACTS / 'F', 'N', 'E' / 00138 DATA EQUEDS / 'N', 'R', 'C', 'B' / 00139 * .. 00140 * .. Executable Statements .. 00141 * 00142 * Initialize constants and the random number seed. 00143 * 00144 PATH( 1: 1 ) = 'Single precision' 00145 PATH( 2: 3 ) = 'GE' 00146 NRUN = 0 00147 NFAIL = 0 00148 NERRS = 0 00149 DO 10 I = 1, 4 00150 ISEED( I ) = ISEEDY( I ) 00151 10 CONTINUE 00152 * 00153 * Test the error exits 00154 * 00155 IF( TSTERR ) 00156 $ CALL SERRVX( PATH, NOUT ) 00157 INFOT = 0 00158 * 00159 * Set the block size and minimum block size for testing. 00160 * 00161 NB = 1 00162 NBMIN = 2 00163 CALL XLAENV( 1, NB ) 00164 CALL XLAENV( 2, NBMIN ) 00165 * 00166 * Do for each value of N in NVAL 00167 * 00168 DO 90 IN = 1, NN 00169 N = NVAL( IN ) 00170 LDA = MAX( N, 1 ) 00171 XTYPE = 'N' 00172 NIMAT = NTYPES 00173 IF( N.LE.0 ) 00174 $ NIMAT = 1 00175 * 00176 DO 80 IMAT = 1, NIMAT 00177 * 00178 * Do the tests only if DOTYPE( IMAT ) is true. 00179 * 00180 IF( .NOT.DOTYPE( IMAT ) ) 00181 $ GO TO 80 00182 * 00183 * Skip types 5, 6, or 7 if the matrix size is too small. 00184 * 00185 ZEROT = IMAT.GE.5 .AND. IMAT.LE.7 00186 IF( ZEROT .AND. N.LT.IMAT-4 ) 00187 $ GO TO 80 00188 * 00189 * Set up parameters with SLATB4 and generate a test matrix 00190 * with SLATMS. 00191 * 00192 CALL SLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM, MODE, 00193 $ CNDNUM, DIST ) 00194 RCONDC = ONE / CNDNUM 00195 * 00196 SRNAMT = 'SLATMS' 00197 CALL SLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE, CNDNUM, 00198 $ ANORM, KL, KU, 'No packing', A, LDA, WORK, 00199 $ INFO ) 00200 * 00201 * Check error code from SLATMS. 00202 * 00203 IF( INFO.NE.0 ) THEN 00204 CALL ALAERH( PATH, 'SLATMS', INFO, 0, ' ', N, N, -1, -1, 00205 $ -1, IMAT, NFAIL, NERRS, NOUT ) 00206 GO TO 80 00207 END IF 00208 * 00209 * For types 5-7, zero one or more columns of the matrix to 00210 * test that INFO is returned correctly. 00211 * 00212 IF( ZEROT ) THEN 00213 IF( IMAT.EQ.5 ) THEN 00214 IZERO = 1 00215 ELSE IF( IMAT.EQ.6 ) THEN 00216 IZERO = N 00217 ELSE 00218 IZERO = N / 2 + 1 00219 END IF 00220 IOFF = ( IZERO-1 )*LDA 00221 IF( IMAT.LT.7 ) THEN 00222 DO 20 I = 1, N 00223 A( IOFF+I ) = ZERO 00224 20 CONTINUE 00225 ELSE 00226 CALL SLASET( 'Full', N, N-IZERO+1, ZERO, ZERO, 00227 $ A( IOFF+1 ), LDA ) 00228 END IF 00229 ELSE 00230 IZERO = 0 00231 END IF 00232 * 00233 * Save a copy of the matrix A in ASAV. 00234 * 00235 CALL SLACPY( 'Full', N, N, A, LDA, ASAV, LDA ) 00236 * 00237 DO 70 IEQUED = 1, 4 00238 EQUED = EQUEDS( IEQUED ) 00239 IF( IEQUED.EQ.1 ) THEN 00240 NFACT = 3 00241 ELSE 00242 NFACT = 1 00243 END IF 00244 * 00245 DO 60 IFACT = 1, NFACT 00246 FACT = FACTS( IFACT ) 00247 PREFAC = LSAME( FACT, 'F' ) 00248 NOFACT = LSAME( FACT, 'N' ) 00249 EQUIL = LSAME( FACT, 'E' ) 00250 * 00251 IF( ZEROT ) THEN 00252 IF( PREFAC ) 00253 $ GO TO 60 00254 RCONDO = ZERO 00255 RCONDI = ZERO 00256 * 00257 ELSE IF( .NOT.NOFACT ) THEN 00258 * 00259 * Compute the condition number for comparison with 00260 * the value returned by SGESVX (FACT = 'N' reuses 00261 * the condition number from the previous iteration 00262 * with FACT = 'F'). 00263 * 00264 CALL SLACPY( 'Full', N, N, ASAV, LDA, AFAC, LDA ) 00265 IF( EQUIL .OR. IEQUED.GT.1 ) THEN 00266 * 00267 * Compute row and column scale factors to 00268 * equilibrate the matrix A. 00269 * 00270 CALL SGEEQU( N, N, AFAC, LDA, S, S( N+1 ), 00271 $ ROWCND, COLCND, AMAX, INFO ) 00272 IF( INFO.EQ.0 .AND. N.GT.0 ) THEN 00273 IF( LSAME( EQUED, 'R' ) ) THEN 00274 ROWCND = ZERO 00275 COLCND = ONE 00276 ELSE IF( LSAME( EQUED, 'C' ) ) THEN 00277 ROWCND = ONE 00278 COLCND = ZERO 00279 ELSE IF( LSAME( EQUED, 'B' ) ) THEN 00280 ROWCND = ZERO 00281 COLCND = ZERO 00282 END IF 00283 * 00284 * Equilibrate the matrix. 00285 * 00286 CALL SLAQGE( N, N, AFAC, LDA, S, S( N+1 ), 00287 $ ROWCND, COLCND, AMAX, EQUED ) 00288 END IF 00289 END IF 00290 * 00291 * Save the condition number of the non-equilibrated 00292 * system for use in SGET04. 00293 * 00294 IF( EQUIL ) THEN 00295 ROLDO = RCONDO 00296 ROLDI = RCONDI 00297 END IF 00298 * 00299 * Compute the 1-norm and infinity-norm of A. 00300 * 00301 ANORMO = SLANGE( '1', N, N, AFAC, LDA, RWORK ) 00302 ANORMI = SLANGE( 'I', N, N, AFAC, LDA, RWORK ) 00303 * 00304 * Factor the matrix A. 00305 * 00306 CALL SGETRF( N, N, AFAC, LDA, IWORK, INFO ) 00307 * 00308 * Form the inverse of A. 00309 * 00310 CALL SLACPY( 'Full', N, N, AFAC, LDA, A, LDA ) 00311 LWORK = NMAX*MAX( 3, NRHS ) 00312 CALL SGETRI( N, A, LDA, IWORK, WORK, LWORK, INFO ) 00313 * 00314 * Compute the 1-norm condition number of A. 00315 * 00316 AINVNM = SLANGE( '1', N, N, A, LDA, RWORK ) 00317 IF( ANORMO.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN 00318 RCONDO = ONE 00319 ELSE 00320 RCONDO = ( ONE / ANORMO ) / AINVNM 00321 END IF 00322 * 00323 * Compute the infinity-norm condition number of A. 00324 * 00325 AINVNM = SLANGE( 'I', N, N, A, LDA, RWORK ) 00326 IF( ANORMI.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN 00327 RCONDI = ONE 00328 ELSE 00329 RCONDI = ( ONE / ANORMI ) / AINVNM 00330 END IF 00331 END IF 00332 * 00333 DO 50 ITRAN = 1, NTRAN 00334 * 00335 * Do for each value of TRANS. 00336 * 00337 TRANS = TRANSS( ITRAN ) 00338 IF( ITRAN.EQ.1 ) THEN 00339 RCONDC = RCONDO 00340 ELSE 00341 RCONDC = RCONDI 00342 END IF 00343 * 00344 * Restore the matrix A. 00345 * 00346 CALL SLACPY( 'Full', N, N, ASAV, LDA, A, LDA ) 00347 * 00348 * Form an exact solution and set the right hand side. 00349 * 00350 SRNAMT = 'SLARHS' 00351 CALL SLARHS( PATH, XTYPE, 'Full', TRANS, N, N, KL, 00352 $ KU, NRHS, A, LDA, XACT, LDA, B, LDA, 00353 $ ISEED, INFO ) 00354 XTYPE = 'C' 00355 CALL SLACPY( 'Full', N, NRHS, B, LDA, BSAV, LDA ) 00356 * 00357 IF( NOFACT .AND. ITRAN.EQ.1 ) THEN 00358 * 00359 * --- Test SGESV --- 00360 * 00361 * Compute the LU factorization of the matrix and 00362 * solve the system. 00363 * 00364 CALL SLACPY( 'Full', N, N, A, LDA, AFAC, LDA ) 00365 CALL SLACPY( 'Full', N, NRHS, B, LDA, X, LDA ) 00366 * 00367 SRNAMT = 'SGESV ' 00368 CALL SGESV( N, NRHS, AFAC, LDA, IWORK, X, LDA, 00369 $ INFO ) 00370 * 00371 * Check error code from SGESV . 00372 * 00373 IF( INFO.NE.IZERO ) 00374 $ CALL ALAERH( PATH, 'SGESV ', INFO, IZERO, 00375 $ ' ', N, N, -1, -1, NRHS, IMAT, 00376 $ NFAIL, NERRS, NOUT ) 00377 * 00378 * Reconstruct matrix from factors and compute 00379 * residual. 00380 * 00381 CALL SGET01( N, N, A, LDA, AFAC, LDA, IWORK, 00382 $ RWORK, RESULT( 1 ) ) 00383 NT = 1 00384 IF( IZERO.EQ.0 ) THEN 00385 * 00386 * Compute residual of the computed solution. 00387 * 00388 CALL SLACPY( 'Full', N, NRHS, B, LDA, WORK, 00389 $ LDA ) 00390 CALL SGET02( 'No transpose', N, N, NRHS, A, 00391 $ LDA, X, LDA, WORK, LDA, RWORK, 00392 $ RESULT( 2 ) ) 00393 * 00394 * Check solution from generated exact solution. 00395 * 00396 CALL SGET04( N, NRHS, X, LDA, XACT, LDA, 00397 $ RCONDC, RESULT( 3 ) ) 00398 NT = 3 00399 END IF 00400 * 00401 * Print information about the tests that did not 00402 * pass the threshold. 00403 * 00404 DO 30 K = 1, NT 00405 IF( RESULT( K ).GE.THRESH ) THEN 00406 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 00407 $ CALL ALADHD( NOUT, PATH ) 00408 WRITE( NOUT, FMT = 9999 )'SGESV ', N, 00409 $ IMAT, K, RESULT( K ) 00410 NFAIL = NFAIL + 1 00411 END IF 00412 30 CONTINUE 00413 NRUN = NRUN + NT 00414 END IF 00415 * 00416 * --- Test SGESVX --- 00417 * 00418 IF( .NOT.PREFAC ) 00419 $ CALL SLASET( 'Full', N, N, ZERO, ZERO, AFAC, 00420 $ LDA ) 00421 CALL SLASET( 'Full', N, NRHS, ZERO, ZERO, X, LDA ) 00422 IF( IEQUED.GT.1 .AND. N.GT.0 ) THEN 00423 * 00424 * Equilibrate the matrix if FACT = 'F' and 00425 * EQUED = 'R', 'C', or 'B'. 00426 * 00427 CALL SLAQGE( N, N, A, LDA, S, S( N+1 ), ROWCND, 00428 $ COLCND, AMAX, EQUED ) 00429 END IF 00430 * 00431 * Solve the system and compute the condition number 00432 * and error bounds using SGESVX. 00433 * 00434 SRNAMT = 'SGESVX' 00435 CALL SGESVX( FACT, TRANS, N, NRHS, A, LDA, AFAC, 00436 $ LDA, IWORK, EQUED, S, S( N+1 ), B, 00437 $ LDA, X, LDA, RCOND, RWORK, 00438 $ RWORK( NRHS+1 ), WORK, IWORK( N+1 ), 00439 $ INFO ) 00440 * 00441 * Check the error code from SGESVX. 00442 * 00443 IF( INFO.NE.IZERO ) 00444 $ CALL ALAERH( PATH, 'SGESVX', INFO, IZERO, 00445 $ FACT // TRANS, N, N, -1, -1, NRHS, 00446 $ IMAT, NFAIL, NERRS, NOUT ) 00447 * 00448 * Compare WORK(1) from SGESVX with the computed 00449 * reciprocal pivot growth factor RPVGRW 00450 * 00451 IF( INFO.NE.0 ) THEN 00452 RPVGRW = SLANTR( 'M', 'U', 'N', INFO, INFO, 00453 $ AFAC, LDA, WORK ) 00454 IF( RPVGRW.EQ.ZERO ) THEN 00455 RPVGRW = ONE 00456 ELSE 00457 RPVGRW = SLANGE( 'M', N, INFO, A, LDA, 00458 $ WORK ) / RPVGRW 00459 END IF 00460 ELSE 00461 RPVGRW = SLANTR( 'M', 'U', 'N', N, N, AFAC, LDA, 00462 $ WORK ) 00463 IF( RPVGRW.EQ.ZERO ) THEN 00464 RPVGRW = ONE 00465 ELSE 00466 RPVGRW = SLANGE( 'M', N, N, A, LDA, WORK ) / 00467 $ RPVGRW 00468 END IF 00469 END IF 00470 RESULT( 7 ) = ABS( RPVGRW-WORK( 1 ) ) / 00471 $ MAX( WORK( 1 ), RPVGRW ) / 00472 $ SLAMCH( 'E' ) 00473 * 00474 IF( .NOT.PREFAC ) THEN 00475 * 00476 * Reconstruct matrix from factors and compute 00477 * residual. 00478 * 00479 CALL SGET01( N, N, A, LDA, AFAC, LDA, IWORK, 00480 $ RWORK( 2*NRHS+1 ), RESULT( 1 ) ) 00481 K1 = 1 00482 ELSE 00483 K1 = 2 00484 END IF 00485 * 00486 IF( INFO.EQ.0 ) THEN 00487 TRFCON = .FALSE. 00488 * 00489 * Compute residual of the computed solution. 00490 * 00491 CALL SLACPY( 'Full', N, NRHS, BSAV, LDA, WORK, 00492 $ LDA ) 00493 CALL SGET02( TRANS, N, N, NRHS, ASAV, LDA, X, 00494 $ LDA, WORK, LDA, RWORK( 2*NRHS+1 ), 00495 $ RESULT( 2 ) ) 00496 * 00497 * Check solution from generated exact solution. 00498 * 00499 IF( NOFACT .OR. ( PREFAC .AND. LSAME( EQUED, 00500 $ 'N' ) ) ) THEN 00501 CALL SGET04( N, NRHS, X, LDA, XACT, LDA, 00502 $ RCONDC, RESULT( 3 ) ) 00503 ELSE 00504 IF( ITRAN.EQ.1 ) THEN 00505 ROLDC = ROLDO 00506 ELSE 00507 ROLDC = ROLDI 00508 END IF 00509 CALL SGET04( N, NRHS, X, LDA, XACT, LDA, 00510 $ ROLDC, RESULT( 3 ) ) 00511 END IF 00512 * 00513 * Check the error bounds from iterative 00514 * refinement. 00515 * 00516 CALL SGET07( TRANS, N, NRHS, ASAV, LDA, B, LDA, 00517 $ X, LDA, XACT, LDA, RWORK, .TRUE., 00518 $ RWORK( NRHS+1 ), RESULT( 4 ) ) 00519 ELSE 00520 TRFCON = .TRUE. 00521 END IF 00522 * 00523 * Compare RCOND from SGESVX with the computed value 00524 * in RCONDC. 00525 * 00526 RESULT( 6 ) = SGET06( RCOND, RCONDC ) 00527 * 00528 * Print information about the tests that did not pass 00529 * the threshold. 00530 * 00531 IF( .NOT.TRFCON ) THEN 00532 DO 40 K = K1, NTESTS 00533 IF( RESULT( K ).GE.THRESH ) THEN 00534 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 00535 $ CALL ALADHD( NOUT, PATH ) 00536 IF( PREFAC ) THEN 00537 WRITE( NOUT, FMT = 9997 )'SGESVX', 00538 $ FACT, TRANS, N, EQUED, IMAT, K, 00539 $ RESULT( K ) 00540 ELSE 00541 WRITE( NOUT, FMT = 9998 )'SGESVX', 00542 $ FACT, TRANS, N, IMAT, K, RESULT( K ) 00543 END IF 00544 NFAIL = NFAIL + 1 00545 END IF 00546 40 CONTINUE 00547 NRUN = NRUN + 7 - K1 00548 ELSE 00549 IF( RESULT( 1 ).GE.THRESH .AND. .NOT.PREFAC ) 00550 $ THEN 00551 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 00552 $ CALL ALADHD( NOUT, PATH ) 00553 IF( PREFAC ) THEN 00554 WRITE( NOUT, FMT = 9997 )'SGESVX', FACT, 00555 $ TRANS, N, EQUED, IMAT, 1, RESULT( 1 ) 00556 ELSE 00557 WRITE( NOUT, FMT = 9998 )'SGESVX', FACT, 00558 $ TRANS, N, IMAT, 1, RESULT( 1 ) 00559 END IF 00560 NFAIL = NFAIL + 1 00561 NRUN = NRUN + 1 00562 END IF 00563 IF( RESULT( 6 ).GE.THRESH ) THEN 00564 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 00565 $ CALL ALADHD( NOUT, PATH ) 00566 IF( PREFAC ) THEN 00567 WRITE( NOUT, FMT = 9997 )'SGESVX', FACT, 00568 $ TRANS, N, EQUED, IMAT, 6, RESULT( 6 ) 00569 ELSE 00570 WRITE( NOUT, FMT = 9998 )'SGESVX', FACT, 00571 $ TRANS, N, IMAT, 6, RESULT( 6 ) 00572 END IF 00573 NFAIL = NFAIL + 1 00574 NRUN = NRUN + 1 00575 END IF 00576 IF( RESULT( 7 ).GE.THRESH ) THEN 00577 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 00578 $ CALL ALADHD( NOUT, PATH ) 00579 IF( PREFAC ) THEN 00580 WRITE( NOUT, FMT = 9997 )'SGESVX', FACT, 00581 $ TRANS, N, EQUED, IMAT, 7, RESULT( 7 ) 00582 ELSE 00583 WRITE( NOUT, FMT = 9998 )'SGESVX', FACT, 00584 $ TRANS, N, IMAT, 7, RESULT( 7 ) 00585 END IF 00586 NFAIL = NFAIL + 1 00587 NRUN = NRUN + 1 00588 END IF 00589 * 00590 END IF 00591 * 00592 50 CONTINUE 00593 60 CONTINUE 00594 70 CONTINUE 00595 80 CONTINUE 00596 90 CONTINUE 00597 * 00598 * Print a summary of the results. 00599 * 00600 CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS ) 00601 * 00602 9999 FORMAT( 1X, A, ', N =', I5, ', type ', I2, ', test(', I2, ') =', 00603 $ G12.5 ) 00604 9998 FORMAT( 1X, A, ', FACT=''', A1, ''', TRANS=''', A1, ''', N=', I5, 00605 $ ', type ', I2, ', test(', I1, ')=', G12.5 ) 00606 9997 FORMAT( 1X, A, ', FACT=''', A1, ''', TRANS=''', A1, ''', N=', I5, 00607 $ ', EQUED=''', A1, ''', type ', I2, ', test(', I1, ')=', 00608 $ G12.5 ) 00609 RETURN 00610 * 00611 * End of SDRVGE 00612 * 00613 END
1.7.3 
