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