1*> \brief \b CDRVGB 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 CDRVGB( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, A, LA, 12* AFB, LAFB, ASAV, B, BSAV, X, XACT, S, WORK, 13* RWORK, IWORK, NOUT ) 14* 15* .. Scalar Arguments .. 16* LOGICAL TSTERR 17* INTEGER LA, LAFB, NN, NOUT, NRHS 18* REAL THRESH 19* .. 20* .. Array Arguments .. 21* LOGICAL DOTYPE( * ) 22* INTEGER IWORK( * ), NVAL( * ) 23* REAL RWORK( * ), S( * ) 24* COMPLEX A( * ), AFB( * ), ASAV( * ), B( * ), BSAV( * ), 25* $ WORK( * ), X( * ), XACT( * ) 26* .. 27* 28* 29*> \par Purpose: 30* ============= 31*> 32*> \verbatim 33*> 34*> CDRVGB tests the driver routines CGBSV 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 column 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[out] A 82*> \verbatim 83*> A is COMPLEX array, dimension (LA) 84*> \endverbatim 85*> 86*> \param[in] LA 87*> \verbatim 88*> LA is INTEGER 89*> The length of the array A. LA >= (2*NMAX-1)*NMAX 90*> where NMAX is the largest entry in NVAL. 91*> \endverbatim 92*> 93*> \param[out] AFB 94*> \verbatim 95*> AFB is COMPLEX array, dimension (LAFB) 96*> \endverbatim 97*> 98*> \param[in] LAFB 99*> \verbatim 100*> LAFB is INTEGER 101*> The length of the array AFB. LAFB >= (3*NMAX-2)*NMAX 102*> where NMAX is the largest entry in NVAL. 103*> \endverbatim 104*> 105*> \param[out] ASAV 106*> \verbatim 107*> ASAV is COMPLEX array, dimension (LA) 108*> \endverbatim 109*> 110*> \param[out] B 111*> \verbatim 112*> B is COMPLEX array, dimension (NMAX*NRHS) 113*> \endverbatim 114*> 115*> \param[out] BSAV 116*> \verbatim 117*> BSAV is COMPLEX array, dimension (NMAX*NRHS) 118*> \endverbatim 119*> 120*> \param[out] X 121*> \verbatim 122*> X is COMPLEX array, dimension (NMAX*NRHS) 123*> \endverbatim 124*> 125*> \param[out] XACT 126*> \verbatim 127*> XACT is COMPLEX array, dimension (NMAX*NRHS) 128*> \endverbatim 129*> 130*> \param[out] S 131*> \verbatim 132*> S is REAL array, dimension (2*NMAX) 133*> \endverbatim 134*> 135*> \param[out] WORK 136*> \verbatim 137*> WORK is COMPLEX array, dimension 138*> (NMAX*max(3,NRHS,NMAX)) 139*> \endverbatim 140*> 141*> \param[out] RWORK 142*> \verbatim 143*> RWORK is REAL array, dimension 144*> (NMAX+2*NRHS) 145*> \endverbatim 146*> 147*> \param[out] IWORK 148*> \verbatim 149*> IWORK is INTEGER array, dimension (NMAX) 150*> \endverbatim 151*> 152*> \param[in] NOUT 153*> \verbatim 154*> NOUT is INTEGER 155*> The unit number for output. 156*> \endverbatim 157* 158* Authors: 159* ======== 160* 161*> \author Univ. of Tennessee 162*> \author Univ. of California Berkeley 163*> \author Univ. of Colorado Denver 164*> \author NAG Ltd. 165* 166*> \ingroup complex_lin 167* 168* ===================================================================== 169 SUBROUTINE CDRVGB( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, A, LA, 170 $ AFB, LAFB, ASAV, B, BSAV, X, XACT, S, WORK, 171 $ RWORK, IWORK, NOUT ) 172* 173* -- LAPACK test routine -- 174* -- LAPACK is a software package provided by Univ. of Tennessee, -- 175* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 176* 177* .. Scalar Arguments .. 178 LOGICAL TSTERR 179 INTEGER LA, LAFB, NN, NOUT, NRHS 180 REAL THRESH 181* .. 182* .. Array Arguments .. 183 LOGICAL DOTYPE( * ) 184 INTEGER IWORK( * ), NVAL( * ) 185 REAL RWORK( * ), S( * ) 186 COMPLEX A( * ), AFB( * ), ASAV( * ), B( * ), BSAV( * ), 187 $ WORK( * ), X( * ), XACT( * ) 188* .. 189* 190* ===================================================================== 191* 192* .. Parameters .. 193 REAL ONE, ZERO 194 PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) 195 INTEGER NTYPES 196 PARAMETER ( NTYPES = 8 ) 197 INTEGER NTESTS 198 PARAMETER ( NTESTS = 7 ) 199 INTEGER NTRAN 200 PARAMETER ( NTRAN = 3 ) 201* .. 202* .. Local Scalars .. 203 LOGICAL EQUIL, NOFACT, PREFAC, TRFCON, ZEROT 204 CHARACTER DIST, EQUED, FACT, TRANS, TYPE, XTYPE 205 CHARACTER*3 PATH 206 INTEGER I, I1, I2, IEQUED, IFACT, IKL, IKU, IMAT, IN, 207 $ INFO, IOFF, ITRAN, IZERO, J, K, K1, KL, KU, 208 $ LDA, LDAFB, LDB, MODE, N, NB, NBMIN, NERRS, 209 $ NFACT, NFAIL, NIMAT, NKL, NKU, NRUN, NT 210 REAL AINVNM, AMAX, ANORM, ANORMI, ANORMO, ANRMPV, 211 $ CNDNUM, COLCND, RCOND, RCONDC, RCONDI, RCONDO, 212 $ ROLDC, ROLDI, ROLDO, ROWCND, RPVGRW 213* .. 214* .. Local Arrays .. 215 CHARACTER EQUEDS( 4 ), FACTS( 3 ), TRANSS( NTRAN ) 216 INTEGER ISEED( 4 ), ISEEDY( 4 ) 217 REAL RDUM( 1 ), RESULT( NTESTS ) 218* .. 219* .. External Functions .. 220 LOGICAL LSAME 221 REAL CLANGB, CLANGE, CLANTB, SGET06, SLAMCH 222 EXTERNAL LSAME, CLANGB, CLANGE, CLANTB, SGET06, SLAMCH 223* .. 224* .. External Subroutines .. 225 EXTERNAL ALADHD, ALAERH, ALASVM, CERRVX, CGBEQU, CGBSV, 226 $ CGBSVX, CGBT01, CGBT02, CGBT05, CGBTRF, CGBTRS, 227 $ CGET04, CLACPY, CLAQGB, CLARHS, CLASET, CLATB4, 228 $ CLATMS, XLAENV 229* .. 230* .. Intrinsic Functions .. 231 INTRINSIC ABS, CMPLX, MAX, MIN 232* .. 233* .. Scalars in Common .. 234 LOGICAL LERR, OK 235 CHARACTER*32 SRNAMT 236 INTEGER INFOT, NUNIT 237* .. 238* .. Common blocks .. 239 COMMON / INFOC / INFOT, NUNIT, OK, LERR 240 COMMON / SRNAMC / SRNAMT 241* .. 242* .. Data statements .. 243 DATA ISEEDY / 1988, 1989, 1990, 1991 / 244 DATA TRANSS / 'N', 'T', 'C' / 245 DATA FACTS / 'F', 'N', 'E' / 246 DATA EQUEDS / 'N', 'R', 'C', 'B' / 247* .. 248* .. Executable Statements .. 249* 250* Initialize constants and the random number seed. 251* 252 PATH( 1: 1 ) = 'Complex precision' 253 PATH( 2: 3 ) = 'GB' 254 NRUN = 0 255 NFAIL = 0 256 NERRS = 0 257 DO 10 I = 1, 4 258 ISEED( I ) = ISEEDY( I ) 259 10 CONTINUE 260* 261* Test the error exits 262* 263 IF( TSTERR ) 264 $ CALL CERRVX( PATH, NOUT ) 265 INFOT = 0 266* 267* Set the block size and minimum block size for testing. 268* 269 NB = 1 270 NBMIN = 2 271 CALL XLAENV( 1, NB ) 272 CALL XLAENV( 2, NBMIN ) 273* 274* Do for each value of N in NVAL 275* 276 DO 150 IN = 1, NN 277 N = NVAL( IN ) 278 LDB = MAX( N, 1 ) 279 XTYPE = 'N' 280* 281* Set limits on the number of loop iterations. 282* 283 NKL = MAX( 1, MIN( N, 4 ) ) 284 IF( N.EQ.0 ) 285 $ NKL = 1 286 NKU = NKL 287 NIMAT = NTYPES 288 IF( N.LE.0 ) 289 $ NIMAT = 1 290* 291 DO 140 IKL = 1, NKL 292* 293* Do for KL = 0, N-1, (3N-1)/4, and (N+1)/4. This order makes 294* it easier to skip redundant values for small values of N. 295* 296 IF( IKL.EQ.1 ) THEN 297 KL = 0 298 ELSE IF( IKL.EQ.2 ) THEN 299 KL = MAX( N-1, 0 ) 300 ELSE IF( IKL.EQ.3 ) THEN 301 KL = ( 3*N-1 ) / 4 302 ELSE IF( IKL.EQ.4 ) THEN 303 KL = ( N+1 ) / 4 304 END IF 305 DO 130 IKU = 1, NKU 306* 307* Do for KU = 0, N-1, (3N-1)/4, and (N+1)/4. This order 308* makes it easier to skip redundant values for small 309* values of N. 310* 311 IF( IKU.EQ.1 ) THEN 312 KU = 0 313 ELSE IF( IKU.EQ.2 ) THEN 314 KU = MAX( N-1, 0 ) 315 ELSE IF( IKU.EQ.3 ) THEN 316 KU = ( 3*N-1 ) / 4 317 ELSE IF( IKU.EQ.4 ) THEN 318 KU = ( N+1 ) / 4 319 END IF 320* 321* Check that A and AFB are big enough to generate this 322* matrix. 323* 324 LDA = KL + KU + 1 325 LDAFB = 2*KL + KU + 1 326 IF( LDA*N.GT.LA .OR. LDAFB*N.GT.LAFB ) THEN 327 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 328 $ CALL ALADHD( NOUT, PATH ) 329 IF( LDA*N.GT.LA ) THEN 330 WRITE( NOUT, FMT = 9999 )LA, N, KL, KU, 331 $ N*( KL+KU+1 ) 332 NERRS = NERRS + 1 333 END IF 334 IF( LDAFB*N.GT.LAFB ) THEN 335 WRITE( NOUT, FMT = 9998 )LAFB, N, KL, KU, 336 $ N*( 2*KL+KU+1 ) 337 NERRS = NERRS + 1 338 END IF 339 GO TO 130 340 END IF 341* 342 DO 120 IMAT = 1, NIMAT 343* 344* Do the tests only if DOTYPE( IMAT ) is true. 345* 346 IF( .NOT.DOTYPE( IMAT ) ) 347 $ GO TO 120 348* 349* Skip types 2, 3, or 4 if the matrix is too small. 350* 351 ZEROT = IMAT.GE.2 .AND. IMAT.LE.4 352 IF( ZEROT .AND. N.LT.IMAT-1 ) 353 $ GO TO 120 354* 355* Set up parameters with CLATB4 and generate a 356* test matrix with CLATMS. 357* 358 CALL CLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM, 359 $ MODE, CNDNUM, DIST ) 360 RCONDC = ONE / CNDNUM 361* 362 SRNAMT = 'CLATMS' 363 CALL CLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE, 364 $ CNDNUM, ANORM, KL, KU, 'Z', A, LDA, WORK, 365 $ INFO ) 366* 367* Check the error code from CLATMS. 368* 369 IF( INFO.NE.0 ) THEN 370 CALL ALAERH( PATH, 'CLATMS', INFO, 0, ' ', N, N, 371 $ KL, KU, -1, IMAT, NFAIL, NERRS, NOUT ) 372 GO TO 120 373 END IF 374* 375* For types 2, 3, and 4, zero one or more columns of 376* the matrix to test that INFO is returned correctly. 377* 378 IZERO = 0 379 IF( ZEROT ) THEN 380 IF( IMAT.EQ.2 ) THEN 381 IZERO = 1 382 ELSE IF( IMAT.EQ.3 ) THEN 383 IZERO = N 384 ELSE 385 IZERO = N / 2 + 1 386 END IF 387 IOFF = ( IZERO-1 )*LDA 388 IF( IMAT.LT.4 ) THEN 389 I1 = MAX( 1, KU+2-IZERO ) 390 I2 = MIN( KL+KU+1, KU+1+( N-IZERO ) ) 391 DO 20 I = I1, I2 392 A( IOFF+I ) = ZERO 393 20 CONTINUE 394 ELSE 395 DO 40 J = IZERO, N 396 DO 30 I = MAX( 1, KU+2-J ), 397 $ MIN( KL+KU+1, KU+1+( N-J ) ) 398 A( IOFF+I ) = ZERO 399 30 CONTINUE 400 IOFF = IOFF + LDA 401 40 CONTINUE 402 END IF 403 END IF 404* 405* Save a copy of the matrix A in ASAV. 406* 407 CALL CLACPY( 'Full', KL+KU+1, N, A, LDA, ASAV, LDA ) 408* 409 DO 110 IEQUED = 1, 4 410 EQUED = EQUEDS( IEQUED ) 411 IF( IEQUED.EQ.1 ) THEN 412 NFACT = 3 413 ELSE 414 NFACT = 1 415 END IF 416* 417 DO 100 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 100 426 RCONDO = ZERO 427 RCONDI = ZERO 428* 429 ELSE IF( .NOT.NOFACT ) THEN 430* 431* Compute the condition number for comparison 432* with the value returned by SGESVX (FACT = 433* 'N' reuses the condition number from the 434* previous iteration with FACT = 'F'). 435* 436 CALL CLACPY( 'Full', KL+KU+1, N, ASAV, LDA, 437 $ AFB( KL+1 ), LDAFB ) 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 CGBEQU( N, N, KL, KU, AFB( KL+1 ), 444 $ LDAFB, S, S( N+1 ), ROWCND, 445 $ COLCND, AMAX, INFO ) 446 IF( INFO.EQ.0 .AND. N.GT.0 ) THEN 447 IF( LSAME( EQUED, 'R' ) ) THEN 448 ROWCND = ZERO 449 COLCND = ONE 450 ELSE IF( LSAME( EQUED, 'C' ) ) THEN 451 ROWCND = ONE 452 COLCND = ZERO 453 ELSE IF( LSAME( EQUED, 'B' ) ) THEN 454 ROWCND = ZERO 455 COLCND = ZERO 456 END IF 457* 458* Equilibrate the matrix. 459* 460 CALL CLAQGB( N, N, KL, KU, AFB( KL+1 ), 461 $ LDAFB, S, S( N+1 ), 462 $ ROWCND, COLCND, AMAX, 463 $ EQUED ) 464 END IF 465 END IF 466* 467* Save the condition number of the 468* non-equilibrated system for use in CGET04. 469* 470 IF( EQUIL ) THEN 471 ROLDO = RCONDO 472 ROLDI = RCONDI 473 END IF 474* 475* Compute the 1-norm and infinity-norm of A. 476* 477 ANORMO = CLANGB( '1', N, KL, KU, AFB( KL+1 ), 478 $ LDAFB, RWORK ) 479 ANORMI = CLANGB( 'I', N, KL, KU, AFB( KL+1 ), 480 $ LDAFB, RWORK ) 481* 482* Factor the matrix A. 483* 484 CALL CGBTRF( N, N, KL, KU, AFB, LDAFB, IWORK, 485 $ INFO ) 486* 487* Form the inverse of A. 488* 489 CALL CLASET( 'Full', N, N, CMPLX( ZERO ), 490 $ CMPLX( ONE ), WORK, LDB ) 491 SRNAMT = 'CGBTRS' 492 CALL CGBTRS( 'No transpose', N, KL, KU, N, 493 $ AFB, LDAFB, IWORK, WORK, LDB, 494 $ INFO ) 495* 496* Compute the 1-norm condition number of A. 497* 498 AINVNM = CLANGE( '1', N, N, WORK, LDB, 499 $ RWORK ) 500 IF( ANORMO.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN 501 RCONDO = ONE 502 ELSE 503 RCONDO = ( ONE / ANORMO ) / AINVNM 504 END IF 505* 506* Compute the infinity-norm condition number 507* of A. 508* 509 AINVNM = CLANGE( 'I', N, N, WORK, LDB, 510 $ RWORK ) 511 IF( ANORMI.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN 512 RCONDI = ONE 513 ELSE 514 RCONDI = ( ONE / ANORMI ) / AINVNM 515 END IF 516 END IF 517* 518 DO 90 ITRAN = 1, NTRAN 519* 520* Do for each value of TRANS. 521* 522 TRANS = TRANSS( ITRAN ) 523 IF( ITRAN.EQ.1 ) THEN 524 RCONDC = RCONDO 525 ELSE 526 RCONDC = RCONDI 527 END IF 528* 529* Restore the matrix A. 530* 531 CALL CLACPY( 'Full', KL+KU+1, N, ASAV, LDA, 532 $ A, LDA ) 533* 534* Form an exact solution and set the right hand 535* side. 536* 537 SRNAMT = 'CLARHS' 538 CALL CLARHS( PATH, XTYPE, 'Full', TRANS, N, 539 $ N, KL, KU, NRHS, A, LDA, XACT, 540 $ LDB, B, LDB, ISEED, INFO ) 541 XTYPE = 'C' 542 CALL CLACPY( 'Full', N, NRHS, B, LDB, BSAV, 543 $ LDB ) 544* 545 IF( NOFACT .AND. ITRAN.EQ.1 ) THEN 546* 547* --- Test CGBSV --- 548* 549* Compute the LU factorization of the matrix 550* and solve the system. 551* 552 CALL CLACPY( 'Full', KL+KU+1, N, A, LDA, 553 $ AFB( KL+1 ), LDAFB ) 554 CALL CLACPY( 'Full', N, NRHS, B, LDB, X, 555 $ LDB ) 556* 557 SRNAMT = 'CGBSV ' 558 CALL CGBSV( N, KL, KU, NRHS, AFB, LDAFB, 559 $ IWORK, X, LDB, INFO ) 560* 561* Check error code from CGBSV . 562* 563 IF( INFO.NE.IZERO ) 564 $ CALL ALAERH( PATH, 'CGBSV ', INFO, 565 $ IZERO, ' ', N, N, KL, KU, 566 $ NRHS, IMAT, NFAIL, NERRS, 567 $ NOUT ) 568* 569* Reconstruct matrix from factors and 570* compute residual. 571* 572 CALL CGBT01( N, N, KL, KU, A, LDA, AFB, 573 $ LDAFB, IWORK, WORK, 574 $ RESULT( 1 ) ) 575 NT = 1 576 IF( IZERO.EQ.0 ) THEN 577* 578* Compute residual of the computed 579* solution. 580* 581 CALL CLACPY( 'Full', N, NRHS, B, LDB, 582 $ WORK, LDB ) 583 CALL CGBT02( 'No transpose', N, N, KL, 584 $ KU, NRHS, A, LDA, X, LDB, 585 $ WORK, LDB, RWORK, 586 $ RESULT( 2 ) ) 587* 588* Check solution from generated exact 589* solution. 590* 591 CALL CGET04( N, NRHS, X, LDB, XACT, 592 $ LDB, RCONDC, RESULT( 3 ) ) 593 NT = 3 594 END IF 595* 596* Print information about the tests that did 597* not pass the threshold. 598* 599 DO 50 K = 1, NT 600 IF( RESULT( K ).GE.THRESH ) THEN 601 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 602 $ CALL ALADHD( NOUT, PATH ) 603 WRITE( NOUT, FMT = 9997 )'CGBSV ', 604 $ N, KL, KU, IMAT, K, RESULT( K ) 605 NFAIL = NFAIL + 1 606 END IF 607 50 CONTINUE 608 NRUN = NRUN + NT 609 END IF 610* 611* --- Test CGBSVX --- 612* 613 IF( .NOT.PREFAC ) 614 $ CALL CLASET( 'Full', 2*KL+KU+1, N, 615 $ CMPLX( ZERO ), CMPLX( ZERO ), 616 $ AFB, LDAFB ) 617 CALL CLASET( 'Full', N, NRHS, CMPLX( ZERO ), 618 $ CMPLX( ZERO ), X, LDB ) 619 IF( IEQUED.GT.1 .AND. N.GT.0 ) THEN 620* 621* Equilibrate the matrix if FACT = 'F' and 622* EQUED = 'R', 'C', or 'B'. 623* 624 CALL CLAQGB( N, N, KL, KU, A, LDA, S, 625 $ S( N+1 ), ROWCND, COLCND, 626 $ AMAX, EQUED ) 627 END IF 628* 629* Solve the system and compute the condition 630* number and error bounds using CGBSVX. 631* 632 SRNAMT = 'CGBSVX' 633 CALL CGBSVX( FACT, TRANS, N, KL, KU, NRHS, A, 634 $ LDA, AFB, LDAFB, IWORK, EQUED, 635 $ S, S( LDB+1 ), B, LDB, X, LDB, 636 $ RCOND, RWORK, RWORK( NRHS+1 ), 637 $ WORK, RWORK( 2*NRHS+1 ), INFO ) 638* 639* Check the error code from CGBSVX. 640* 641 IF( INFO.NE.IZERO ) 642 $ CALL ALAERH( PATH, 'CGBSVX', INFO, IZERO, 643 $ FACT // TRANS, N, N, KL, KU, 644 $ NRHS, IMAT, NFAIL, NERRS, 645 $ NOUT ) 646* Compare RWORK(2*NRHS+1) from CGBSVX with the 647* computed reciprocal pivot growth RPVGRW 648* 649 IF( INFO.NE.0 .AND. INFO.LE.N) THEN 650 ANRMPV = ZERO 651 DO 70 J = 1, INFO 652 DO 60 I = MAX( KU+2-J, 1 ), 653 $ MIN( N+KU+1-J, KL+KU+1 ) 654 ANRMPV = MAX( ANRMPV, 655 $ ABS( A( I+( J-1 )*LDA ) ) ) 656 60 CONTINUE 657 70 CONTINUE 658 RPVGRW = CLANTB( 'M', 'U', 'N', INFO, 659 $ MIN( INFO-1, KL+KU ), 660 $ AFB( MAX( 1, KL+KU+2-INFO ) ), 661 $ LDAFB, RDUM ) 662 IF( RPVGRW.EQ.ZERO ) THEN 663 RPVGRW = ONE 664 ELSE 665 RPVGRW = ANRMPV / RPVGRW 666 END IF 667 ELSE 668 RPVGRW = CLANTB( 'M', 'U', 'N', N, KL+KU, 669 $ AFB, LDAFB, RDUM ) 670 IF( RPVGRW.EQ.ZERO ) THEN 671 RPVGRW = ONE 672 ELSE 673 RPVGRW = CLANGB( 'M', N, KL, KU, A, 674 $ LDA, RDUM ) / RPVGRW 675 END IF 676 END IF 677 RESULT( 7 ) = ABS( RPVGRW-RWORK( 2*NRHS+1 ) ) 678 $ / MAX( RWORK( 2*NRHS+1 ), 679 $ RPVGRW ) / SLAMCH( 'E' ) 680* 681 IF( .NOT.PREFAC ) THEN 682* 683* Reconstruct matrix from factors and 684* compute residual. 685* 686 CALL CGBT01( N, N, KL, KU, A, LDA, AFB, 687 $ LDAFB, IWORK, WORK, 688 $ RESULT( 1 ) ) 689 K1 = 1 690 ELSE 691 K1 = 2 692 END IF 693* 694 IF( INFO.EQ.0 ) THEN 695 TRFCON = .FALSE. 696* 697* Compute residual of the computed solution. 698* 699 CALL CLACPY( 'Full', N, NRHS, BSAV, LDB, 700 $ WORK, LDB ) 701 CALL CGBT02( TRANS, N, N, KL, KU, NRHS, 702 $ ASAV, LDA, X, LDB, WORK, LDB, 703 $ RWORK( 2*NRHS+1 ), 704 $ RESULT( 2 ) ) 705* 706* Check solution from generated exact 707* solution. 708* 709 IF( NOFACT .OR. ( PREFAC .AND. 710 $ LSAME( EQUED, 'N' ) ) ) THEN 711 CALL CGET04( N, NRHS, X, LDB, XACT, 712 $ LDB, RCONDC, RESULT( 3 ) ) 713 ELSE 714 IF( ITRAN.EQ.1 ) THEN 715 ROLDC = ROLDO 716 ELSE 717 ROLDC = ROLDI 718 END IF 719 CALL CGET04( N, NRHS, X, LDB, XACT, 720 $ LDB, ROLDC, RESULT( 3 ) ) 721 END IF 722* 723* Check the error bounds from iterative 724* refinement. 725* 726 CALL CGBT05( TRANS, N, KL, KU, NRHS, ASAV, 727 $ LDA, BSAV, LDB, X, LDB, XACT, 728 $ LDB, RWORK, RWORK( NRHS+1 ), 729 $ RESULT( 4 ) ) 730 ELSE 731 TRFCON = .TRUE. 732 END IF 733* 734* Compare RCOND from CGBSVX with the computed 735* value in RCONDC. 736* 737 RESULT( 6 ) = SGET06( RCOND, RCONDC ) 738* 739* Print information about the tests that did 740* not pass the threshold. 741* 742 IF( .NOT.TRFCON ) THEN 743 DO 80 K = K1, NTESTS 744 IF( RESULT( K ).GE.THRESH ) THEN 745 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 746 $ CALL ALADHD( NOUT, PATH ) 747 IF( PREFAC ) THEN 748 WRITE( NOUT, FMT = 9995 ) 749 $ 'CGBSVX', FACT, TRANS, N, KL, 750 $ KU, EQUED, IMAT, K, 751 $ RESULT( K ) 752 ELSE 753 WRITE( NOUT, FMT = 9996 ) 754 $ 'CGBSVX', FACT, TRANS, N, KL, 755 $ KU, IMAT, K, RESULT( K ) 756 END IF 757 NFAIL = NFAIL + 1 758 END IF 759 80 CONTINUE 760 NRUN = NRUN + NTESTS - K1 + 1 761 ELSE 762 IF( RESULT( 1 ).GE.THRESH .AND. .NOT. 763 $ PREFAC ) THEN 764 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 765 $ CALL ALADHD( NOUT, PATH ) 766 IF( PREFAC ) THEN 767 WRITE( NOUT, FMT = 9995 )'CGBSVX', 768 $ FACT, TRANS, N, KL, KU, EQUED, 769 $ IMAT, 1, RESULT( 1 ) 770 ELSE 771 WRITE( NOUT, FMT = 9996 )'CGBSVX', 772 $ FACT, TRANS, N, KL, KU, IMAT, 1, 773 $ RESULT( 1 ) 774 END IF 775 NFAIL = NFAIL + 1 776 NRUN = NRUN + 1 777 END IF 778 IF( RESULT( 6 ).GE.THRESH ) THEN 779 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 780 $ CALL ALADHD( NOUT, PATH ) 781 IF( PREFAC ) THEN 782 WRITE( NOUT, FMT = 9995 )'CGBSVX', 783 $ FACT, TRANS, N, KL, KU, EQUED, 784 $ IMAT, 6, RESULT( 6 ) 785 ELSE 786 WRITE( NOUT, FMT = 9996 )'CGBSVX', 787 $ FACT, TRANS, N, KL, KU, IMAT, 6, 788 $ RESULT( 6 ) 789 END IF 790 NFAIL = NFAIL + 1 791 NRUN = NRUN + 1 792 END IF 793 IF( RESULT( 7 ).GE.THRESH ) THEN 794 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 795 $ CALL ALADHD( NOUT, PATH ) 796 IF( PREFAC ) THEN 797 WRITE( NOUT, FMT = 9995 )'CGBSVX', 798 $ FACT, TRANS, N, KL, KU, EQUED, 799 $ IMAT, 7, RESULT( 7 ) 800 ELSE 801 WRITE( NOUT, FMT = 9996 )'CGBSVX', 802 $ FACT, TRANS, N, KL, KU, IMAT, 7, 803 $ RESULT( 7 ) 804 END IF 805 NFAIL = NFAIL + 1 806 NRUN = NRUN + 1 807 END IF 808 END IF 809 90 CONTINUE 810 100 CONTINUE 811 110 CONTINUE 812 120 CONTINUE 813 130 CONTINUE 814 140 CONTINUE 815 150 CONTINUE 816* 817* Print a summary of the results. 818* 819 CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS ) 820* 821 9999 FORMAT( ' *** In CDRVGB, LA=', I5, ' is too small for N=', I5, 822 $ ', KU=', I5, ', KL=', I5, / ' ==> Increase LA to at least ', 823 $ I5 ) 824 9998 FORMAT( ' *** In CDRVGB, LAFB=', I5, ' is too small for N=', I5, 825 $ ', KU=', I5, ', KL=', I5, / 826 $ ' ==> Increase LAFB to at least ', I5 ) 827 9997 FORMAT( 1X, A, ', N=', I5, ', KL=', I5, ', KU=', I5, ', type ', 828 $ I1, ', test(', I1, ')=', G12.5 ) 829 9996 FORMAT( 1X, A, '( ''', A1, ''',''', A1, ''',', I5, ',', I5, ',', 830 $ I5, ',...), type ', I1, ', test(', I1, ')=', G12.5 ) 831 9995 FORMAT( 1X, A, '( ''', A1, ''',''', A1, ''',', I5, ',', I5, ',', 832 $ I5, ',...), EQUED=''', A1, ''', type ', I1, ', test(', I1, 833 $ ')=', G12.5 ) 834* 835 RETURN 836* 837* End of CDRVGB 838* 839 END 840