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