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