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