1*> \brief \b ZDRVPB 2* 3* =========== DOCUMENTATION =========== 4* 5* Online html documentation available at 6* http://www.netlib.org/lapack/explore-html/ 7* 8* Definition: 9* =========== 10* 11* SUBROUTINE ZDRVPB( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, 12* A, AFAC, ASAV, B, BSAV, X, XACT, S, WORK, 13* RWORK, NOUT ) 14* 15* .. Scalar Arguments .. 16* LOGICAL TSTERR 17* INTEGER NMAX, NN, NOUT, NRHS 18* DOUBLE PRECISION THRESH 19* .. 20* .. Array Arguments .. 21* LOGICAL DOTYPE( * ) 22* INTEGER NVAL( * ) 23* DOUBLE PRECISION RWORK( * ), S( * ) 24* COMPLEX*16 A( * ), AFAC( * ), ASAV( * ), B( * ), 25* $ BSAV( * ), WORK( * ), X( * ), XACT( * ) 26* .. 27* 28* 29*> \par Purpose: 30* ============= 31*> 32*> \verbatim 33*> 34*> ZDRVPB tests the driver routines ZPBSV and -SVX. 35*> \endverbatim 36* 37* Arguments: 38* ========== 39* 40*> \param[in] DOTYPE 41*> \verbatim 42*> DOTYPE is LOGICAL array, dimension (NTYPES) 43*> The matrix types to be used for testing. Matrices of type j 44*> (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) = 45*> .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used. 46*> \endverbatim 47*> 48*> \param[in] NN 49*> \verbatim 50*> NN is INTEGER 51*> The number of values of N contained in the vector NVAL. 52*> \endverbatim 53*> 54*> \param[in] NVAL 55*> \verbatim 56*> NVAL is INTEGER array, dimension (NN) 57*> The values of the matrix dimension N. 58*> \endverbatim 59*> 60*> \param[in] NRHS 61*> \verbatim 62*> NRHS is INTEGER 63*> The number of right hand side vectors to be generated for 64*> each linear system. 65*> \endverbatim 66*> 67*> \param[in] THRESH 68*> \verbatim 69*> THRESH is DOUBLE PRECISION 70*> The threshold value for the test ratios. A result is 71*> included in the output file if RESULT >= THRESH. To have 72*> every test ratio printed, use THRESH = 0. 73*> \endverbatim 74*> 75*> \param[in] TSTERR 76*> \verbatim 77*> TSTERR is LOGICAL 78*> Flag that indicates whether error exits are to be tested. 79*> \endverbatim 80*> 81*> \param[in] NMAX 82*> \verbatim 83*> NMAX is INTEGER 84*> The maximum value permitted for N, used in dimensioning the 85*> work arrays. 86*> \endverbatim 87*> 88*> \param[out] A 89*> \verbatim 90*> A is COMPLEX*16 array, dimension (NMAX*NMAX) 91*> \endverbatim 92*> 93*> \param[out] AFAC 94*> \verbatim 95*> AFAC is COMPLEX*16 array, dimension (NMAX*NMAX) 96*> \endverbatim 97*> 98*> \param[out] ASAV 99*> \verbatim 100*> ASAV is COMPLEX*16 array, dimension (NMAX*NMAX) 101*> \endverbatim 102*> 103*> \param[out] B 104*> \verbatim 105*> B is COMPLEX*16 array, dimension (NMAX*NRHS) 106*> \endverbatim 107*> 108*> \param[out] BSAV 109*> \verbatim 110*> BSAV is COMPLEX*16 array, dimension (NMAX*NRHS) 111*> \endverbatim 112*> 113*> \param[out] X 114*> \verbatim 115*> X is COMPLEX*16 array, dimension (NMAX*NRHS) 116*> \endverbatim 117*> 118*> \param[out] XACT 119*> \verbatim 120*> XACT is COMPLEX*16 array, dimension (NMAX*NRHS) 121*> \endverbatim 122*> 123*> \param[out] S 124*> \verbatim 125*> S is DOUBLE PRECISION array, dimension (NMAX) 126*> \endverbatim 127*> 128*> \param[out] WORK 129*> \verbatim 130*> WORK is COMPLEX*16 array, dimension 131*> (NMAX*max(3,NRHS)) 132*> \endverbatim 133*> 134*> \param[out] RWORK 135*> \verbatim 136*> RWORK is DOUBLE PRECISION array, dimension (NMAX+2*NRHS) 137*> \endverbatim 138*> 139*> \param[in] NOUT 140*> \verbatim 141*> NOUT is INTEGER 142*> The unit number for output. 143*> \endverbatim 144* 145* Authors: 146* ======== 147* 148*> \author Univ. of Tennessee 149*> \author Univ. of California Berkeley 150*> \author Univ. of Colorado Denver 151*> \author NAG Ltd. 152* 153*> \date December 2016 154* 155*> \ingroup complex16_lin 156* 157* ===================================================================== 158 SUBROUTINE ZDRVPB( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, 159 $ A, AFAC, ASAV, B, BSAV, X, XACT, S, WORK, 160 $ RWORK, NOUT ) 161* 162* -- LAPACK test routine (version 3.7.0) -- 163* -- LAPACK is a software package provided by Univ. of Tennessee, -- 164* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 165* December 2016 166* 167* .. Scalar Arguments .. 168 LOGICAL TSTERR 169 INTEGER NMAX, NN, NOUT, NRHS 170 DOUBLE PRECISION THRESH 171* .. 172* .. Array Arguments .. 173 LOGICAL DOTYPE( * ) 174 INTEGER NVAL( * ) 175 DOUBLE PRECISION RWORK( * ), S( * ) 176 COMPLEX*16 A( * ), AFAC( * ), ASAV( * ), B( * ), 177 $ BSAV( * ), WORK( * ), X( * ), XACT( * ) 178* .. 179* 180* ===================================================================== 181* 182* .. Parameters .. 183 DOUBLE PRECISION ONE, ZERO 184 PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 ) 185 INTEGER NTYPES, NTESTS 186 PARAMETER ( NTYPES = 8, NTESTS = 6 ) 187 INTEGER NBW 188 PARAMETER ( NBW = 4 ) 189* .. 190* .. Local Scalars .. 191 LOGICAL EQUIL, NOFACT, PREFAC, ZEROT 192 CHARACTER DIST, EQUED, FACT, PACKIT, TYPE, UPLO, XTYPE 193 CHARACTER*3 PATH 194 INTEGER I, I1, I2, IEQUED, IFACT, IKD, IMAT, IN, INFO, 195 $ IOFF, IUPLO, IW, IZERO, K, K1, KD, KL, KOFF, 196 $ KU, LDA, LDAB, MODE, N, NB, NBMIN, NERRS, 197 $ NFACT, NFAIL, NIMAT, NKD, NRUN, NT 198 DOUBLE PRECISION AINVNM, AMAX, ANORM, CNDNUM, RCOND, RCONDC, 199 $ ROLDC, SCOND 200* .. 201* .. Local Arrays .. 202 CHARACTER EQUEDS( 2 ), FACTS( 3 ) 203 INTEGER ISEED( 4 ), ISEEDY( 4 ), KDVAL( NBW ) 204 DOUBLE PRECISION RESULT( NTESTS ) 205* .. 206* .. External Functions .. 207 LOGICAL LSAME 208 DOUBLE PRECISION DGET06, ZLANGE, ZLANHB 209 EXTERNAL LSAME, DGET06, ZLANGE, ZLANHB 210* .. 211* .. External Subroutines .. 212 EXTERNAL ALADHD, ALAERH, ALASVM, XLAENV, ZCOPY, ZERRVX, 213 $ ZGET04, ZLACPY, ZLAIPD, ZLAQHB, ZLARHS, ZLASET, 214 $ ZLATB4, ZLATMS, ZPBEQU, ZPBSV, ZPBSVX, ZPBT01, 215 $ ZPBT02, ZPBT05, ZPBTRF, ZPBTRS, ZSWAP 216* .. 217* .. Intrinsic Functions .. 218 INTRINSIC DCMPLX, MAX, MIN 219* .. 220* .. Scalars in Common .. 221 LOGICAL LERR, OK 222 CHARACTER*32 SRNAMT 223 INTEGER INFOT, NUNIT 224* .. 225* .. Common blocks .. 226 COMMON / INFOC / INFOT, NUNIT, OK, LERR 227 COMMON / SRNAMC / SRNAMT 228* .. 229* .. Data statements .. 230 DATA ISEEDY / 1988, 1989, 1990, 1991 / 231 DATA FACTS / 'F', 'N', 'E' / , EQUEDS / 'N', 'Y' / 232* .. 233* .. Executable Statements .. 234* 235* Initialize constants and the random number seed. 236* 237 PATH( 1: 1 ) = 'Zomplex precision' 238 PATH( 2: 3 ) = 'PB' 239 NRUN = 0 240 NFAIL = 0 241 NERRS = 0 242 DO 10 I = 1, 4 243 ISEED( I ) = ISEEDY( I ) 244 10 CONTINUE 245* 246* Test the error exits 247* 248 IF( TSTERR ) 249 $ CALL ZERRVX( PATH, NOUT ) 250 INFOT = 0 251 KDVAL( 1 ) = 0 252* 253* Set the block size and minimum block size for testing. 254* 255 NB = 1 256 NBMIN = 2 257 CALL XLAENV( 1, NB ) 258 CALL XLAENV( 2, NBMIN ) 259* 260* Do for each value of N in NVAL 261* 262 DO 110 IN = 1, NN 263 N = NVAL( IN ) 264 LDA = MAX( N, 1 ) 265 XTYPE = 'N' 266* 267* Set limits on the number of loop iterations. 268* 269 NKD = MAX( 1, MIN( N, 4 ) ) 270 NIMAT = NTYPES 271 IF( N.EQ.0 ) 272 $ NIMAT = 1 273* 274 KDVAL( 2 ) = N + ( N+1 ) / 4 275 KDVAL( 3 ) = ( 3*N-1 ) / 4 276 KDVAL( 4 ) = ( N+1 ) / 4 277* 278 DO 100 IKD = 1, NKD 279* 280* Do for KD = 0, (5*N+1)/4, (3N-1)/4, and (N+1)/4. This order 281* makes it easier to skip redundant values for small values 282* of N. 283* 284 KD = KDVAL( IKD ) 285 LDAB = KD + 1 286* 287* Do first for UPLO = 'U', then for UPLO = 'L' 288* 289 DO 90 IUPLO = 1, 2 290 KOFF = 1 291 IF( IUPLO.EQ.1 ) THEN 292 UPLO = 'U' 293 PACKIT = 'Q' 294 KOFF = MAX( 1, KD+2-N ) 295 ELSE 296 UPLO = 'L' 297 PACKIT = 'B' 298 END IF 299* 300 DO 80 IMAT = 1, NIMAT 301* 302* Do the tests only if DOTYPE( IMAT ) is true. 303* 304 IF( .NOT.DOTYPE( IMAT ) ) 305 $ GO TO 80 306* 307* Skip types 2, 3, or 4 if the matrix size is too small. 308* 309 ZEROT = IMAT.GE.2 .AND. IMAT.LE.4 310 IF( ZEROT .AND. N.LT.IMAT-1 ) 311 $ GO TO 80 312* 313 IF( .NOT.ZEROT .OR. .NOT.DOTYPE( 1 ) ) THEN 314* 315* Set up parameters with ZLATB4 and generate a test 316* matrix with ZLATMS. 317* 318 CALL ZLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM, 319 $ MODE, CNDNUM, DIST ) 320* 321 SRNAMT = 'ZLATMS' 322 CALL ZLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE, 323 $ CNDNUM, ANORM, KD, KD, PACKIT, 324 $ A( KOFF ), LDAB, WORK, INFO ) 325* 326* Check error code from ZLATMS. 327* 328 IF( INFO.NE.0 ) THEN 329 CALL ALAERH( PATH, 'ZLATMS', INFO, 0, UPLO, N, 330 $ N, -1, -1, -1, IMAT, NFAIL, NERRS, 331 $ NOUT ) 332 GO TO 80 333 END IF 334 ELSE IF( IZERO.GT.0 ) THEN 335* 336* Use the same matrix for types 3 and 4 as for type 337* 2 by copying back the zeroed out column, 338* 339 IW = 2*LDA + 1 340 IF( IUPLO.EQ.1 ) THEN 341 IOFF = ( IZERO-1 )*LDAB + KD + 1 342 CALL ZCOPY( IZERO-I1, WORK( IW ), 1, 343 $ A( IOFF-IZERO+I1 ), 1 ) 344 IW = IW + IZERO - I1 345 CALL ZCOPY( I2-IZERO+1, WORK( IW ), 1, 346 $ A( IOFF ), MAX( LDAB-1, 1 ) ) 347 ELSE 348 IOFF = ( I1-1 )*LDAB + 1 349 CALL ZCOPY( IZERO-I1, WORK( IW ), 1, 350 $ A( IOFF+IZERO-I1 ), 351 $ MAX( LDAB-1, 1 ) ) 352 IOFF = ( IZERO-1 )*LDAB + 1 353 IW = IW + IZERO - I1 354 CALL ZCOPY( I2-IZERO+1, WORK( IW ), 1, 355 $ A( IOFF ), 1 ) 356 END IF 357 END IF 358* 359* For types 2-4, zero one row and column of the matrix 360* to test that INFO is returned correctly. 361* 362 IZERO = 0 363 IF( ZEROT ) THEN 364 IF( IMAT.EQ.2 ) THEN 365 IZERO = 1 366 ELSE IF( IMAT.EQ.3 ) THEN 367 IZERO = N 368 ELSE 369 IZERO = N / 2 + 1 370 END IF 371* 372* Save the zeroed out row and column in WORK(*,3) 373* 374 IW = 2*LDA 375 DO 20 I = 1, MIN( 2*KD+1, N ) 376 WORK( IW+I ) = ZERO 377 20 CONTINUE 378 IW = IW + 1 379 I1 = MAX( IZERO-KD, 1 ) 380 I2 = MIN( IZERO+KD, N ) 381* 382 IF( IUPLO.EQ.1 ) THEN 383 IOFF = ( IZERO-1 )*LDAB + KD + 1 384 CALL ZSWAP( IZERO-I1, A( IOFF-IZERO+I1 ), 1, 385 $ WORK( IW ), 1 ) 386 IW = IW + IZERO - I1 387 CALL ZSWAP( I2-IZERO+1, A( IOFF ), 388 $ MAX( LDAB-1, 1 ), WORK( IW ), 1 ) 389 ELSE 390 IOFF = ( I1-1 )*LDAB + 1 391 CALL ZSWAP( IZERO-I1, A( IOFF+IZERO-I1 ), 392 $ MAX( LDAB-1, 1 ), WORK( IW ), 1 ) 393 IOFF = ( IZERO-1 )*LDAB + 1 394 IW = IW + IZERO - I1 395 CALL ZSWAP( I2-IZERO+1, A( IOFF ), 1, 396 $ WORK( IW ), 1 ) 397 END IF 398 END IF 399* 400* Set the imaginary part of the diagonals. 401* 402 IF( IUPLO.EQ.1 ) THEN 403 CALL ZLAIPD( N, A( KD+1 ), LDAB, 0 ) 404 ELSE 405 CALL ZLAIPD( N, A( 1 ), LDAB, 0 ) 406 END IF 407* 408* Save a copy of the matrix A in ASAV. 409* 410 CALL ZLACPY( 'Full', KD+1, N, A, LDAB, ASAV, LDAB ) 411* 412 DO 70 IEQUED = 1, 2 413 EQUED = EQUEDS( IEQUED ) 414 IF( IEQUED.EQ.1 ) THEN 415 NFACT = 3 416 ELSE 417 NFACT = 1 418 END IF 419* 420 DO 60 IFACT = 1, NFACT 421 FACT = FACTS( IFACT ) 422 PREFAC = LSAME( FACT, 'F' ) 423 NOFACT = LSAME( FACT, 'N' ) 424 EQUIL = LSAME( FACT, 'E' ) 425* 426 IF( ZEROT ) THEN 427 IF( PREFAC ) 428 $ GO TO 60 429 RCONDC = ZERO 430* 431 ELSE IF( .NOT.LSAME( FACT, 'N' ) ) THEN 432* 433* Compute the condition number for comparison 434* with the value returned by ZPBSVX (FACT = 435* 'N' reuses the condition number from the 436* previous iteration with FACT = 'F'). 437* 438 CALL ZLACPY( 'Full', KD+1, N, ASAV, LDAB, 439 $ AFAC, LDAB ) 440 IF( EQUIL .OR. IEQUED.GT.1 ) THEN 441* 442* Compute row and column scale factors to 443* equilibrate the matrix A. 444* 445 CALL ZPBEQU( UPLO, N, KD, AFAC, LDAB, S, 446 $ SCOND, AMAX, INFO ) 447 IF( INFO.EQ.0 .AND. N.GT.0 ) THEN 448 IF( IEQUED.GT.1 ) 449 $ SCOND = ZERO 450* 451* Equilibrate the matrix. 452* 453 CALL ZLAQHB( UPLO, N, KD, AFAC, LDAB, 454 $ S, SCOND, AMAX, EQUED ) 455 END IF 456 END IF 457* 458* Save the condition number of the 459* non-equilibrated system for use in ZGET04. 460* 461 IF( EQUIL ) 462 $ ROLDC = RCONDC 463* 464* Compute the 1-norm of A. 465* 466 ANORM = ZLANHB( '1', UPLO, N, KD, AFAC, LDAB, 467 $ RWORK ) 468* 469* Factor the matrix A. 470* 471 CALL ZPBTRF( UPLO, N, KD, AFAC, LDAB, INFO ) 472* 473* Form the inverse of A. 474* 475 CALL ZLASET( 'Full', N, N, DCMPLX( ZERO ), 476 $ DCMPLX( ONE ), A, LDA ) 477 SRNAMT = 'ZPBTRS' 478 CALL ZPBTRS( UPLO, N, KD, N, AFAC, LDAB, A, 479 $ LDA, INFO ) 480* 481* Compute the 1-norm condition number of A. 482* 483 AINVNM = ZLANGE( '1', N, N, A, LDA, RWORK ) 484 IF( ANORM.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN 485 RCONDC = ONE 486 ELSE 487 RCONDC = ( ONE / ANORM ) / AINVNM 488 END IF 489 END IF 490* 491* Restore the matrix A. 492* 493 CALL ZLACPY( 'Full', KD+1, N, ASAV, LDAB, A, 494 $ LDAB ) 495* 496* Form an exact solution and set the right hand 497* side. 498* 499 SRNAMT = 'ZLARHS' 500 CALL ZLARHS( PATH, XTYPE, UPLO, ' ', N, N, KD, 501 $ KD, NRHS, A, LDAB, XACT, LDA, B, 502 $ LDA, ISEED, INFO ) 503 XTYPE = 'C' 504 CALL ZLACPY( 'Full', N, NRHS, B, LDA, BSAV, 505 $ LDA ) 506* 507 IF( NOFACT ) THEN 508* 509* --- Test ZPBSV --- 510* 511* Compute the L*L' or U'*U factorization of the 512* matrix and solve the system. 513* 514 CALL ZLACPY( 'Full', KD+1, N, A, LDAB, AFAC, 515 $ LDAB ) 516 CALL ZLACPY( 'Full', N, NRHS, B, LDA, X, 517 $ LDA ) 518* 519 SRNAMT = 'ZPBSV ' 520 CALL ZPBSV( UPLO, N, KD, NRHS, AFAC, LDAB, X, 521 $ LDA, INFO ) 522* 523* Check error code from ZPBSV . 524* 525 IF( INFO.NE.IZERO ) THEN 526 CALL ALAERH( PATH, 'ZPBSV ', INFO, IZERO, 527 $ UPLO, N, N, KD, KD, NRHS, 528 $ IMAT, NFAIL, NERRS, NOUT ) 529 GO TO 40 530 ELSE IF( INFO.NE.0 ) THEN 531 GO TO 40 532 END IF 533* 534* Reconstruct matrix from factors and compute 535* residual. 536* 537 CALL ZPBT01( UPLO, N, KD, A, LDAB, AFAC, 538 $ LDAB, RWORK, RESULT( 1 ) ) 539* 540* Compute residual of the computed solution. 541* 542 CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK, 543 $ LDA ) 544 CALL ZPBT02( UPLO, N, KD, NRHS, A, LDAB, X, 545 $ LDA, WORK, LDA, RWORK, 546 $ RESULT( 2 ) ) 547* 548* Check solution from generated exact solution. 549* 550 CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, 551 $ RCONDC, RESULT( 3 ) ) 552 NT = 3 553* 554* Print information about the tests that did 555* not pass the threshold. 556* 557 DO 30 K = 1, NT 558 IF( RESULT( K ).GE.THRESH ) THEN 559 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 560 $ CALL ALADHD( NOUT, PATH ) 561 WRITE( NOUT, FMT = 9999 )'ZPBSV ', 562 $ UPLO, N, KD, IMAT, K, RESULT( K ) 563 NFAIL = NFAIL + 1 564 END IF 565 30 CONTINUE 566 NRUN = NRUN + NT 567 40 CONTINUE 568 END IF 569* 570* --- Test ZPBSVX --- 571* 572 IF( .NOT.PREFAC ) 573 $ CALL ZLASET( 'Full', KD+1, N, DCMPLX( ZERO ), 574 $ DCMPLX( ZERO ), AFAC, LDAB ) 575 CALL ZLASET( 'Full', N, NRHS, DCMPLX( ZERO ), 576 $ DCMPLX( ZERO ), X, LDA ) 577 IF( IEQUED.GT.1 .AND. N.GT.0 ) THEN 578* 579* Equilibrate the matrix if FACT='F' and 580* EQUED='Y' 581* 582 CALL ZLAQHB( UPLO, N, KD, A, LDAB, S, SCOND, 583 $ AMAX, EQUED ) 584 END IF 585* 586* Solve the system and compute the condition 587* number and error bounds using ZPBSVX. 588* 589 SRNAMT = 'ZPBSVX' 590 CALL ZPBSVX( FACT, UPLO, N, KD, NRHS, A, LDAB, 591 $ AFAC, LDAB, EQUED, S, B, LDA, X, 592 $ LDA, RCOND, RWORK, RWORK( NRHS+1 ), 593 $ WORK, RWORK( 2*NRHS+1 ), INFO ) 594* 595* Check the error code from ZPBSVX. 596* 597 IF( INFO.NE.IZERO ) THEN 598 CALL ALAERH( PATH, 'ZPBSVX', INFO, IZERO, 599 $ FACT // UPLO, N, N, KD, KD, 600 $ NRHS, IMAT, NFAIL, NERRS, NOUT ) 601 GO TO 60 602 END IF 603* 604 IF( INFO.EQ.0 ) THEN 605 IF( .NOT.PREFAC ) THEN 606* 607* Reconstruct matrix from factors and 608* compute residual. 609* 610 CALL ZPBT01( UPLO, N, KD, A, LDAB, AFAC, 611 $ LDAB, RWORK( 2*NRHS+1 ), 612 $ RESULT( 1 ) ) 613 K1 = 1 614 ELSE 615 K1 = 2 616 END IF 617* 618* Compute residual of the computed solution. 619* 620 CALL ZLACPY( 'Full', N, NRHS, BSAV, LDA, 621 $ WORK, LDA ) 622 CALL ZPBT02( UPLO, N, KD, NRHS, ASAV, LDAB, 623 $ X, LDA, WORK, LDA, 624 $ RWORK( 2*NRHS+1 ), RESULT( 2 ) ) 625* 626* Check solution from generated exact solution. 627* 628 IF( NOFACT .OR. ( PREFAC .AND. LSAME( EQUED, 629 $ 'N' ) ) ) THEN 630 CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, 631 $ RCONDC, RESULT( 3 ) ) 632 ELSE 633 CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, 634 $ ROLDC, RESULT( 3 ) ) 635 END IF 636* 637* Check the error bounds from iterative 638* refinement. 639* 640 CALL ZPBT05( UPLO, N, KD, NRHS, ASAV, LDAB, 641 $ B, LDA, X, LDA, XACT, LDA, 642 $ RWORK, RWORK( NRHS+1 ), 643 $ RESULT( 4 ) ) 644 ELSE 645 K1 = 6 646 END IF 647* 648* Compare RCOND from ZPBSVX with the computed 649* value in RCONDC. 650* 651 RESULT( 6 ) = DGET06( RCOND, RCONDC ) 652* 653* Print information about the tests that did not 654* pass the threshold. 655* 656 DO 50 K = K1, 6 657 IF( RESULT( K ).GE.THRESH ) THEN 658 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 659 $ CALL ALADHD( NOUT, PATH ) 660 IF( PREFAC ) THEN 661 WRITE( NOUT, FMT = 9997 )'ZPBSVX', 662 $ FACT, UPLO, N, KD, EQUED, IMAT, K, 663 $ RESULT( K ) 664 ELSE 665 WRITE( NOUT, FMT = 9998 )'ZPBSVX', 666 $ FACT, UPLO, N, KD, IMAT, K, 667 $ RESULT( K ) 668 END IF 669 NFAIL = NFAIL + 1 670 END IF 671 50 CONTINUE 672 NRUN = NRUN + 7 - K1 673 60 CONTINUE 674 70 CONTINUE 675 80 CONTINUE 676 90 CONTINUE 677 100 CONTINUE 678 110 CONTINUE 679* 680* Print a summary of the results. 681* 682 CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS ) 683* 684 9999 FORMAT( 1X, A, ', UPLO=''', A1, ''', N =', I5, ', KD =', I5, 685 $ ', type ', I1, ', test(', I1, ')=', G12.5 ) 686 9998 FORMAT( 1X, A, '( ''', A1, ''', ''', A1, ''', ', I5, ', ', I5, 687 $ ', ... ), type ', I1, ', test(', I1, ')=', G12.5 ) 688 9997 FORMAT( 1X, A, '( ''', A1, ''', ''', A1, ''', ', I5, ', ', I5, 689 $ ', ... ), EQUED=''', A1, ''', type ', I1, ', test(', I1, 690 $ ')=', G12.5 ) 691 RETURN 692* 693* End of ZDRVPB 694* 695 END 696