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