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