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