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