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