 |
LAPACK 3.3.1
Linear Algebra PACKage
|
|
LAPACK 3.3.1
Linear Algebra PACKage
|
00001 SUBROUTINE ZDRVPO( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, 00002 $ A, AFAC, ASAV, B, BSAV, X, XACT, S, WORK, 00003 $ RWORK, NOUT ) 00004 * 00005 * -- LAPACK test routine (version 3.2.1) -- 00006 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. 00007 * April 2009 00008 * 00009 * .. Scalar Arguments .. 00010 LOGICAL TSTERR 00011 INTEGER NMAX, NN, NOUT, NRHS 00012 DOUBLE PRECISION THRESH 00013 * .. 00014 * .. Array Arguments .. 00015 LOGICAL DOTYPE( * ) 00016 INTEGER NVAL( * ) 00017 DOUBLE PRECISION RWORK( * ), S( * ) 00018 COMPLEX*16 A( * ), AFAC( * ), ASAV( * ), B( * ), 00019 $ BSAV( * ), WORK( * ), X( * ), XACT( * ) 00020 * .. 00021 * 00022 * Purpose 00023 * ======= 00024 * 00025 * ZDRVPO tests the driver routines ZPOSV, -SVX, and -SVXX. 00026 * 00027 * Note that this file is used only when the XBLAS are available, 00028 * otherwise zdrvpo.f defines this subroutine. 00029 * 00030 * Arguments 00031 * ========= 00032 * 00033 * DOTYPE (input) LOGICAL array, dimension (NTYPES) 00034 * The matrix types to be used for testing. Matrices of type j 00035 * (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) = 00036 * .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used. 00037 * 00038 * NN (input) INTEGER 00039 * The number of values of N contained in the vector NVAL. 00040 * 00041 * NVAL (input) INTEGER array, dimension (NN) 00042 * The values of the matrix dimension N. 00043 * 00044 * NRHS (input) INTEGER 00045 * The number of right hand side vectors to be generated for 00046 * each linear system. 00047 * 00048 * THRESH (input) DOUBLE PRECISION 00049 * The threshold value for the test ratios. A result is 00050 * included in the output file if RESULT >= THRESH. To have 00051 * every test ratio printed, use THRESH = 0. 00052 * 00053 * TSTERR (input) LOGICAL 00054 * Flag that indicates whether error exits are to be tested. 00055 * 00056 * NMAX (input) INTEGER 00057 * The maximum value permitted for N, used in dimensioning the 00058 * work arrays. 00059 * 00060 * A (workspace) COMPLEX*16 array, dimension (NMAX*NMAX) 00061 * 00062 * AFAC (workspace) COMPLEX*16 array, dimension (NMAX*NMAX) 00063 * 00064 * ASAV (workspace) COMPLEX*16 array, dimension (NMAX*NMAX) 00065 * 00066 * B (workspace) COMPLEX*16 array, dimension (NMAX*NRHS) 00067 * 00068 * BSAV (workspace) COMPLEX*16 array, dimension (NMAX*NRHS) 00069 * 00070 * X (workspace) COMPLEX*16 array, dimension (NMAX*NRHS) 00071 * 00072 * XACT (workspace) COMPLEX*16 array, dimension (NMAX*NRHS) 00073 * 00074 * S (workspace) DOUBLE PRECISION array, dimension (NMAX) 00075 * 00076 * WORK (workspace) COMPLEX*16 array, dimension 00077 * (NMAX*max(3,NRHS)) 00078 * 00079 * RWORK (workspace) DOUBLE PRECISION array, dimension (NMAX+2*NRHS) 00080 * 00081 * NOUT (input) INTEGER 00082 * The unit number for output. 00083 * 00084 * ===================================================================== 00085 * 00086 * .. Parameters .. 00087 DOUBLE PRECISION ONE, ZERO 00088 PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 ) 00089 INTEGER NTYPES 00090 PARAMETER ( NTYPES = 9 ) 00091 INTEGER NTESTS 00092 PARAMETER ( NTESTS = 6 ) 00093 * .. 00094 * .. Local Scalars .. 00095 LOGICAL EQUIL, NOFACT, PREFAC, ZEROT 00096 CHARACTER DIST, EQUED, FACT, TYPE, UPLO, XTYPE 00097 CHARACTER*3 PATH 00098 INTEGER I, IEQUED, IFACT, IMAT, IN, INFO, IOFF, IUPLO, 00099 $ IZERO, K, K1, KL, KU, LDA, MODE, N, NB, NBMIN, 00100 $ NERRS, NFACT, NFAIL, NIMAT, NRUN, NT, 00101 $ N_ERR_BNDS 00102 DOUBLE PRECISION AINVNM, AMAX, ANORM, CNDNUM, RCOND, RCONDC, 00103 $ ROLDC, SCOND, RPVGRW_SVXX 00104 * .. 00105 * .. Local Arrays .. 00106 CHARACTER EQUEDS( 2 ), FACTS( 3 ), UPLOS( 2 ) 00107 INTEGER ISEED( 4 ), ISEEDY( 4 ) 00108 DOUBLE PRECISION RESULT( NTESTS ), BERR( NRHS ), 00109 $ ERRBNDS_N( NRHS, 3 ), ERRBNDS_C( NRHS, 3 ) 00110 * .. 00111 * .. External Functions .. 00112 LOGICAL LSAME 00113 DOUBLE PRECISION DGET06, ZLANHE 00114 EXTERNAL LSAME, DGET06, ZLANHE 00115 * .. 00116 * .. External Subroutines .. 00117 EXTERNAL ALADHD, ALAERH, ALASVM, XLAENV, ZERRVX, ZGET04, 00118 $ ZLACPY, ZLAIPD, ZLAQHE, ZLARHS, ZLASET, ZLATB4, 00119 $ ZLATMS, ZPOEQU, ZPOSV, ZPOSVX, ZPOT01, ZPOT02, 00120 $ ZPOT05, ZPOTRF, ZPOTRI, ZPOSVXX 00121 * .. 00122 * .. Scalars in Common .. 00123 LOGICAL LERR, OK 00124 CHARACTER*32 SRNAMT 00125 INTEGER INFOT, NUNIT 00126 * .. 00127 * .. Common blocks .. 00128 COMMON / INFOC / INFOT, NUNIT, OK, LERR 00129 COMMON / SRNAMC / SRNAMT 00130 * .. 00131 * .. Intrinsic Functions .. 00132 INTRINSIC DCMPLX, MAX 00133 * .. 00134 * .. Data statements .. 00135 DATA ISEEDY / 1988, 1989, 1990, 1991 / 00136 DATA UPLOS / 'U', 'L' / 00137 DATA FACTS / 'F', 'N', 'E' / 00138 DATA EQUEDS / 'N', 'Y' / 00139 * .. 00140 * .. Executable Statements .. 00141 * 00142 * Initialize constants and the random number seed. 00143 * 00144 PATH( 1: 1 ) = 'Zomplex precision' 00145 PATH( 2: 3 ) = 'PO' 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 ZERRVX( 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 130 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 120 IMAT = 1, NIMAT 00177 * 00178 * Do the tests only if DOTYPE( IMAT ) is true. 00179 * 00180 IF( .NOT.DOTYPE( IMAT ) ) 00181 $ GO TO 120 00182 * 00183 * Skip types 3, 4, or 5 if the matrix size is too small. 00184 * 00185 ZEROT = IMAT.GE.3 .AND. IMAT.LE.5 00186 IF( ZEROT .AND. N.LT.IMAT-2 ) 00187 $ GO TO 120 00188 * 00189 * Do first for UPLO = 'U', then for UPLO = 'L' 00190 * 00191 DO 110 IUPLO = 1, 2 00192 UPLO = UPLOS( IUPLO ) 00193 * 00194 * Set up parameters with ZLATB4 and generate a test matrix 00195 * with ZLATMS. 00196 * 00197 CALL ZLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM, MODE, 00198 $ CNDNUM, DIST ) 00199 * 00200 SRNAMT = 'ZLATMS' 00201 CALL ZLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE, 00202 $ CNDNUM, ANORM, KL, KU, UPLO, A, LDA, WORK, 00203 $ INFO ) 00204 * 00205 * Check error code from ZLATMS. 00206 * 00207 IF( INFO.NE.0 ) THEN 00208 CALL ALAERH( PATH, 'ZLATMS', INFO, 0, UPLO, N, N, -1, 00209 $ -1, -1, IMAT, NFAIL, NERRS, NOUT ) 00210 GO TO 110 00211 END IF 00212 * 00213 * For types 3-5, zero one row and column of the matrix to 00214 * test that INFO is returned correctly. 00215 * 00216 IF( ZEROT ) THEN 00217 IF( IMAT.EQ.3 ) THEN 00218 IZERO = 1 00219 ELSE IF( IMAT.EQ.4 ) THEN 00220 IZERO = N 00221 ELSE 00222 IZERO = N / 2 + 1 00223 END IF 00224 IOFF = ( IZERO-1 )*LDA 00225 * 00226 * Set row and column IZERO of A to 0. 00227 * 00228 IF( IUPLO.EQ.1 ) THEN 00229 DO 20 I = 1, IZERO - 1 00230 A( IOFF+I ) = ZERO 00231 20 CONTINUE 00232 IOFF = IOFF + IZERO 00233 DO 30 I = IZERO, N 00234 A( IOFF ) = ZERO 00235 IOFF = IOFF + LDA 00236 30 CONTINUE 00237 ELSE 00238 IOFF = IZERO 00239 DO 40 I = 1, IZERO - 1 00240 A( IOFF ) = ZERO 00241 IOFF = IOFF + LDA 00242 40 CONTINUE 00243 IOFF = IOFF - IZERO 00244 DO 50 I = IZERO, N 00245 A( IOFF+I ) = ZERO 00246 50 CONTINUE 00247 END IF 00248 ELSE 00249 IZERO = 0 00250 END IF 00251 * 00252 * Set the imaginary part of the diagonals. 00253 * 00254 CALL ZLAIPD( N, A, LDA+1, 0 ) 00255 * 00256 * Save a copy of the matrix A in ASAV. 00257 * 00258 CALL ZLACPY( UPLO, N, N, A, LDA, ASAV, LDA ) 00259 * 00260 DO 100 IEQUED = 1, 2 00261 EQUED = EQUEDS( IEQUED ) 00262 IF( IEQUED.EQ.1 ) THEN 00263 NFACT = 3 00264 ELSE 00265 NFACT = 1 00266 END IF 00267 * 00268 DO 90 IFACT = 1, NFACT 00269 FACT = FACTS( IFACT ) 00270 PREFAC = LSAME( FACT, 'F' ) 00271 NOFACT = LSAME( FACT, 'N' ) 00272 EQUIL = LSAME( FACT, 'E' ) 00273 * 00274 IF( ZEROT ) THEN 00275 IF( PREFAC ) 00276 $ GO TO 90 00277 RCONDC = ZERO 00278 * 00279 ELSE IF( .NOT.LSAME( FACT, 'N' ) ) THEN 00280 * 00281 * Compute the condition number for comparison with 00282 * the value returned by ZPOSVX (FACT = 'N' reuses 00283 * the condition number from the previous iteration 00284 * with FACT = 'F'). 00285 * 00286 CALL ZLACPY( UPLO, N, N, ASAV, LDA, AFAC, LDA ) 00287 IF( EQUIL .OR. IEQUED.GT.1 ) THEN 00288 * 00289 * Compute row and column scale factors to 00290 * equilibrate the matrix A. 00291 * 00292 CALL ZPOEQU( N, AFAC, LDA, S, SCOND, AMAX, 00293 $ INFO ) 00294 IF( INFO.EQ.0 .AND. N.GT.0 ) THEN 00295 IF( IEQUED.GT.1 ) 00296 $ SCOND = ZERO 00297 * 00298 * Equilibrate the matrix. 00299 * 00300 CALL ZLAQHE( UPLO, N, AFAC, LDA, S, SCOND, 00301 $ AMAX, EQUED ) 00302 END IF 00303 END IF 00304 * 00305 * Save the condition number of the 00306 * non-equilibrated system for use in ZGET04. 00307 * 00308 IF( EQUIL ) 00309 $ ROLDC = RCONDC 00310 * 00311 * Compute the 1-norm of A. 00312 * 00313 ANORM = ZLANHE( '1', UPLO, N, AFAC, LDA, RWORK ) 00314 * 00315 * Factor the matrix A. 00316 * 00317 CALL ZPOTRF( UPLO, N, AFAC, LDA, INFO ) 00318 * 00319 * Form the inverse of A. 00320 * 00321 CALL ZLACPY( UPLO, N, N, AFAC, LDA, A, LDA ) 00322 CALL ZPOTRI( UPLO, N, A, LDA, INFO ) 00323 * 00324 * Compute the 1-norm condition number of A. 00325 * 00326 AINVNM = ZLANHE( '1', UPLO, N, A, LDA, RWORK ) 00327 IF( ANORM.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN 00328 RCONDC = ONE 00329 ELSE 00330 RCONDC = ( ONE / ANORM ) / AINVNM 00331 END IF 00332 END IF 00333 * 00334 * Restore the matrix A. 00335 * 00336 CALL ZLACPY( UPLO, N, N, ASAV, LDA, A, LDA ) 00337 * 00338 * Form an exact solution and set the right hand side. 00339 * 00340 SRNAMT = 'ZLARHS' 00341 CALL ZLARHS( PATH, XTYPE, UPLO, ' ', N, N, KL, KU, 00342 $ NRHS, A, LDA, XACT, LDA, B, LDA, 00343 $ ISEED, INFO ) 00344 XTYPE = 'C' 00345 CALL ZLACPY( 'Full', N, NRHS, B, LDA, BSAV, LDA ) 00346 * 00347 IF( NOFACT ) THEN 00348 * 00349 * --- Test ZPOSV --- 00350 * 00351 * Compute the L*L' or U'*U factorization of the 00352 * matrix and solve the system. 00353 * 00354 CALL ZLACPY( UPLO, N, N, A, LDA, AFAC, LDA ) 00355 CALL ZLACPY( 'Full', N, NRHS, B, LDA, X, LDA ) 00356 * 00357 SRNAMT = 'ZPOSV ' 00358 CALL ZPOSV( UPLO, N, NRHS, AFAC, LDA, X, LDA, 00359 $ INFO ) 00360 * 00361 * Check error code from ZPOSV . 00362 * 00363 IF( INFO.NE.IZERO ) THEN 00364 CALL ALAERH( PATH, 'ZPOSV ', INFO, IZERO, 00365 $ UPLO, N, N, -1, -1, NRHS, IMAT, 00366 $ NFAIL, NERRS, NOUT ) 00367 GO TO 70 00368 ELSE IF( INFO.NE.0 ) THEN 00369 GO TO 70 00370 END IF 00371 * 00372 * Reconstruct matrix from factors and compute 00373 * residual. 00374 * 00375 CALL ZPOT01( UPLO, N, A, LDA, AFAC, LDA, RWORK, 00376 $ RESULT( 1 ) ) 00377 * 00378 * Compute residual of the computed solution. 00379 * 00380 CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK, 00381 $ LDA ) 00382 CALL ZPOT02( UPLO, N, NRHS, A, LDA, X, LDA, 00383 $ WORK, LDA, RWORK, RESULT( 2 ) ) 00384 * 00385 * Check solution from generated exact solution. 00386 * 00387 CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC, 00388 $ RESULT( 3 ) ) 00389 NT = 3 00390 * 00391 * Print information about the tests that did not 00392 * pass the threshold. 00393 * 00394 DO 60 K = 1, NT 00395 IF( RESULT( K ).GE.THRESH ) THEN 00396 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 00397 $ CALL ALADHD( NOUT, PATH ) 00398 WRITE( NOUT, FMT = 9999 )'ZPOSV ', UPLO, 00399 $ N, IMAT, K, RESULT( K ) 00400 NFAIL = NFAIL + 1 00401 END IF 00402 60 CONTINUE 00403 NRUN = NRUN + NT 00404 70 CONTINUE 00405 END IF 00406 * 00407 * --- Test ZPOSVX --- 00408 * 00409 IF( .NOT.PREFAC ) 00410 $ CALL ZLASET( UPLO, N, N, DCMPLX( ZERO ), 00411 $ DCMPLX( ZERO ), AFAC, LDA ) 00412 CALL ZLASET( 'Full', N, NRHS, DCMPLX( ZERO ), 00413 $ DCMPLX( ZERO ), X, LDA ) 00414 IF( IEQUED.GT.1 .AND. N.GT.0 ) THEN 00415 * 00416 * Equilibrate the matrix if FACT='F' and 00417 * EQUED='Y'. 00418 * 00419 CALL ZLAQHE( UPLO, N, A, LDA, S, SCOND, AMAX, 00420 $ EQUED ) 00421 END IF 00422 * 00423 * Solve the system and compute the condition number 00424 * and error bounds using ZPOSVX. 00425 * 00426 SRNAMT = 'ZPOSVX' 00427 CALL ZPOSVX( FACT, UPLO, N, NRHS, A, LDA, AFAC, 00428 $ LDA, EQUED, S, B, LDA, X, LDA, RCOND, 00429 $ RWORK, RWORK( NRHS+1 ), WORK, 00430 $ RWORK( 2*NRHS+1 ), INFO ) 00431 * 00432 * Check the error code from ZPOSVX. 00433 * 00434 IF( INFO.NE.IZERO ) 00435 $ CALL ALAERH( PATH, 'ZPOSVX', INFO, IZERO, 00436 $ FACT // UPLO, N, N, -1, -1, NRHS, 00437 $ IMAT, NFAIL, NERRS, NOUT ) 00438 GO TO 90 00439 * 00440 IF( INFO.EQ.0 ) THEN 00441 IF( .NOT.PREFAC ) THEN 00442 * 00443 * Reconstruct matrix from factors and compute 00444 * residual. 00445 * 00446 CALL ZPOT01( UPLO, N, A, LDA, AFAC, LDA, 00447 $ RWORK( 2*NRHS+1 ), RESULT( 1 ) ) 00448 K1 = 1 00449 ELSE 00450 K1 = 2 00451 END IF 00452 * 00453 * Compute residual of the computed solution. 00454 * 00455 CALL ZLACPY( 'Full', N, NRHS, BSAV, LDA, WORK, 00456 $ LDA ) 00457 CALL ZPOT02( UPLO, N, NRHS, ASAV, LDA, X, LDA, 00458 $ WORK, LDA, RWORK( 2*NRHS+1 ), 00459 $ RESULT( 2 ) ) 00460 * 00461 * Check solution from generated exact solution. 00462 * 00463 IF( NOFACT .OR. ( PREFAC .AND. LSAME( EQUED, 00464 $ 'N' ) ) ) THEN 00465 CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, 00466 $ RCONDC, RESULT( 3 ) ) 00467 ELSE 00468 CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, 00469 $ ROLDC, RESULT( 3 ) ) 00470 END IF 00471 * 00472 * Check the error bounds from iterative 00473 * refinement. 00474 * 00475 CALL ZPOT05( UPLO, N, NRHS, ASAV, LDA, B, LDA, 00476 $ X, LDA, XACT, LDA, RWORK, 00477 $ RWORK( NRHS+1 ), RESULT( 4 ) ) 00478 ELSE 00479 K1 = 6 00480 END IF 00481 * 00482 * Compare RCOND from ZPOSVX with the computed value 00483 * in RCONDC. 00484 * 00485 RESULT( 6 ) = DGET06( RCOND, RCONDC ) 00486 * 00487 * Print information about the tests that did not pass 00488 * the threshold. 00489 * 00490 DO 80 K = K1, 6 00491 IF( RESULT( K ).GE.THRESH ) THEN 00492 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 00493 $ CALL ALADHD( NOUT, PATH ) 00494 IF( PREFAC ) THEN 00495 WRITE( NOUT, FMT = 9997 )'ZPOSVX', FACT, 00496 $ UPLO, N, EQUED, IMAT, K, RESULT( K ) 00497 ELSE 00498 WRITE( NOUT, FMT = 9998 )'ZPOSVX', FACT, 00499 $ UPLO, N, IMAT, K, RESULT( K ) 00500 END IF 00501 NFAIL = NFAIL + 1 00502 END IF 00503 80 CONTINUE 00504 NRUN = NRUN + 7 - K1 00505 * 00506 * --- Test ZPOSVXX --- 00507 * 00508 * Restore the matrices A and B. 00509 * 00510 CALL ZLACPY( 'Full', N, N, ASAV, LDA, A, LDA ) 00511 CALL ZLACPY( 'Full', N, NRHS, BSAV, LDA, B, LDA ) 00512 00513 IF( .NOT.PREFAC ) 00514 $ CALL ZLASET( UPLO, N, N, CMPLX( ZERO ), 00515 $ CMPLX( ZERO ), AFAC, LDA ) 00516 CALL ZLASET( 'Full', N, NRHS, CMPLX( ZERO ), 00517 $ CMPLX( ZERO ), X, LDA ) 00518 IF( IEQUED.GT.1 .AND. N.GT.0 ) THEN 00519 * 00520 * Equilibrate the matrix if FACT='F' and 00521 * EQUED='Y'. 00522 * 00523 CALL ZLAQHE( UPLO, N, A, LDA, S, SCOND, AMAX, 00524 $ EQUED ) 00525 END IF 00526 * 00527 * Solve the system and compute the condition number 00528 * and error bounds using ZPOSVXX. 00529 * 00530 SRNAMT = 'ZPOSVXX' 00531 N_ERR_BNDS = 3 00532 CALL ZPOSVXX( FACT, UPLO, N, NRHS, A, LDA, AFAC, 00533 $ LDA, EQUED, S, B, LDA, X, 00534 $ LDA, RCOND, RPVGRW_SVXX, BERR, N_ERR_BNDS, 00535 $ ERRBNDS_N, ERRBNDS_C, 0, ZERO, WORK, 00536 $ RWORK( 2*NRHS+1 ), INFO ) 00537 * 00538 * Check the error code from ZPOSVXX. 00539 * 00540 IF( INFO.EQ.N+1 ) GOTO 90 00541 IF( INFO.NE.IZERO ) THEN 00542 CALL ALAERH( PATH, 'ZPOSVXX', INFO, IZERO, 00543 $ FACT // UPLO, N, N, -1, -1, NRHS, 00544 $ IMAT, NFAIL, NERRS, NOUT ) 00545 GO TO 90 00546 END IF 00547 * 00548 IF( INFO.EQ.0 ) THEN 00549 IF( .NOT.PREFAC ) THEN 00550 * 00551 * Reconstruct matrix from factors and compute 00552 * residual. 00553 * 00554 CALL ZPOT01( UPLO, N, A, LDA, AFAC, LDA, 00555 $ RWORK( 2*NRHS+1 ), RESULT( 1 ) ) 00556 K1 = 1 00557 ELSE 00558 K1 = 2 00559 END IF 00560 * 00561 * Compute residual of the computed solution. 00562 * 00563 CALL ZLACPY( 'Full', N, NRHS, BSAV, LDA, WORK, 00564 $ LDA ) 00565 CALL ZPOT02( UPLO, N, NRHS, ASAV, LDA, X, LDA, 00566 $ WORK, LDA, RWORK( 2*NRHS+1 ), 00567 $ RESULT( 2 ) ) 00568 * 00569 * Check solution from generated exact solution. 00570 * 00571 IF( NOFACT .OR. ( PREFAC .AND. LSAME( EQUED, 00572 $ 'N' ) ) ) THEN 00573 CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, 00574 $ RCONDC, RESULT( 3 ) ) 00575 ELSE 00576 CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, 00577 $ ROLDC, RESULT( 3 ) ) 00578 END IF 00579 * 00580 * Check the error bounds from iterative 00581 * refinement. 00582 * 00583 CALL ZPOT05( UPLO, N, NRHS, ASAV, LDA, B, LDA, 00584 $ X, LDA, XACT, LDA, RWORK, 00585 $ RWORK( NRHS+1 ), RESULT( 4 ) ) 00586 ELSE 00587 K1 = 6 00588 END IF 00589 * 00590 * Compare RCOND from ZPOSVXX with the computed value 00591 * in RCONDC. 00592 * 00593 RESULT( 6 ) = DGET06( RCOND, RCONDC ) 00594 * 00595 * Print information about the tests that did not pass 00596 * the threshold. 00597 * 00598 DO 85 K = K1, 6 00599 IF( RESULT( K ).GE.THRESH ) THEN 00600 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 00601 $ CALL ALADHD( NOUT, PATH ) 00602 IF( PREFAC ) THEN 00603 WRITE( NOUT, FMT = 9997 )'ZPOSVXX', FACT, 00604 $ UPLO, N, EQUED, IMAT, K, RESULT( K ) 00605 ELSE 00606 WRITE( NOUT, FMT = 9998 )'ZPOSVXX', FACT, 00607 $ UPLO, N, IMAT, K, RESULT( K ) 00608 END IF 00609 NFAIL = NFAIL + 1 00610 END IF 00611 85 CONTINUE 00612 NRUN = NRUN + 7 - K1 00613 90 CONTINUE 00614 100 CONTINUE 00615 110 CONTINUE 00616 120 CONTINUE 00617 130 CONTINUE 00618 * 00619 * Print a summary of the results. 00620 * 00621 CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS ) 00622 * 00623 00624 * Test Error Bounds for ZGESVXX 00625 00626 CALL ZEBCHVXX(THRESH, PATH) 00627 00628 9999 FORMAT( 1X, A, ', UPLO=''', A1, ''', N =', I5, ', type ', I1, 00629 $ ', test(', I1, ')=', G12.5 ) 00630 9998 FORMAT( 1X, A, ', FACT=''', A1, ''', UPLO=''', A1, ''', N=', I5, 00631 $ ', type ', I1, ', test(', I1, ')=', G12.5 ) 00632 9997 FORMAT( 1X, A, ', FACT=''', A1, ''', UPLO=''', A1, ''', N=', I5, 00633 $ ', EQUED=''', A1, ''', type ', I1, ', test(', I1, ') =', 00634 $ G12.5 ) 00635 RETURN 00636 * 00637 * End of ZDRVPO 00638 * 00639 END
1.7.3 
