1*> \brief \b CCHKGB 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 CCHKGB( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NNS, 12* NSVAL, THRESH, TSTERR, A, LA, AFAC, LAFAC, B, 13* X, XACT, WORK, RWORK, IWORK, NOUT ) 14* 15* .. Scalar Arguments .. 16* LOGICAL TSTERR 17* INTEGER LA, LAFAC, NM, NN, NNB, NNS, NOUT 18* REAL THRESH 19* .. 20* .. Array Arguments .. 21* LOGICAL DOTYPE( * ) 22* INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NSVAL( * ), 23* $ NVAL( * ) 24* REAL RWORK( * ) 25* COMPLEX A( * ), AFAC( * ), B( * ), WORK( * ), X( * ), 26* $ XACT( * ) 27* .. 28* 29* 30*> \par Purpose: 31* ============= 32*> 33*> \verbatim 34*> 35*> CCHKGB tests CGBTRF, -TRS, -RFS, and -CON 36*> \endverbatim 37* 38* Arguments: 39* ========== 40* 41*> \param[in] DOTYPE 42*> \verbatim 43*> DOTYPE is LOGICAL array, dimension (NTYPES) 44*> The matrix types to be used for testing. Matrices of type j 45*> (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) = 46*> .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used. 47*> \endverbatim 48*> 49*> \param[in] NM 50*> \verbatim 51*> NM is INTEGER 52*> The number of values of M contained in the vector MVAL. 53*> \endverbatim 54*> 55*> \param[in] MVAL 56*> \verbatim 57*> MVAL is INTEGER array, dimension (NM) 58*> The values of the matrix row dimension M. 59*> \endverbatim 60*> 61*> \param[in] NN 62*> \verbatim 63*> NN is INTEGER 64*> The number of values of N contained in the vector NVAL. 65*> \endverbatim 66*> 67*> \param[in] NVAL 68*> \verbatim 69*> NVAL is INTEGER array, dimension (NN) 70*> The values of the matrix column dimension N. 71*> \endverbatim 72*> 73*> \param[in] NNB 74*> \verbatim 75*> NNB is INTEGER 76*> The number of values of NB contained in the vector NBVAL. 77*> \endverbatim 78*> 79*> \param[in] NBVAL 80*> \verbatim 81*> NBVAL is INTEGER array, dimension (NNB) 82*> The values of the blocksize NB. 83*> \endverbatim 84*> 85*> \param[in] NNS 86*> \verbatim 87*> NNS is INTEGER 88*> The number of values of NRHS contained in the vector NSVAL. 89*> \endverbatim 90*> 91*> \param[in] NSVAL 92*> \verbatim 93*> NSVAL is INTEGER array, dimension (NNS) 94*> The values of the number of right hand sides NRHS. 95*> \endverbatim 96*> 97*> \param[in] THRESH 98*> \verbatim 99*> THRESH is REAL 100*> The threshold value for the test ratios. A result is 101*> included in the output file if RESULT >= THRESH. To have 102*> every test ratio printed, use THRESH = 0. 103*> \endverbatim 104*> 105*> \param[in] TSTERR 106*> \verbatim 107*> TSTERR is LOGICAL 108*> Flag that indicates whether error exits are to be tested. 109*> \endverbatim 110*> 111*> \param[out] A 112*> \verbatim 113*> A is COMPLEX array, dimension (LA) 114*> \endverbatim 115*> 116*> \param[in] LA 117*> \verbatim 118*> LA is INTEGER 119*> The length of the array A. LA >= (KLMAX+KUMAX+1)*NMAX 120*> where KLMAX is the largest entry in the local array KLVAL, 121*> KUMAX is the largest entry in the local array KUVAL and 122*> NMAX is the largest entry in the input array NVAL. 123*> \endverbatim 124*> 125*> \param[out] AFAC 126*> \verbatim 127*> AFAC is COMPLEX array, dimension (LAFAC) 128*> \endverbatim 129*> 130*> \param[in] LAFAC 131*> \verbatim 132*> LAFAC is INTEGER 133*> The length of the array AFAC. LAFAC >= (2*KLMAX+KUMAX+1)*NMAX 134*> where KLMAX is the largest entry in the local array KLVAL, 135*> KUMAX is the largest entry in the local array KUVAL and 136*> NMAX is the largest entry in the input array NVAL. 137*> \endverbatim 138*> 139*> \param[out] B 140*> \verbatim 141*> B is COMPLEX array, dimension (NMAX*NSMAX) 142*> \endverbatim 143*> 144*> \param[out] X 145*> \verbatim 146*> X is COMPLEX array, dimension (NMAX*NSMAX) 147*> \endverbatim 148*> 149*> \param[out] XACT 150*> \verbatim 151*> XACT is COMPLEX array, dimension (NMAX*NSMAX) 152*> \endverbatim 153*> 154*> \param[out] WORK 155*> \verbatim 156*> WORK is COMPLEX array, dimension 157*> (NMAX*max(3,NSMAX,NMAX)) 158*> \endverbatim 159*> 160*> \param[out] RWORK 161*> \verbatim 162*> RWORK is REAL array, dimension 163*> (NMAX+2*NSMAX) 164*> \endverbatim 165*> 166*> \param[out] IWORK 167*> \verbatim 168*> IWORK is INTEGER array, dimension (NMAX) 169*> \endverbatim 170*> 171*> \param[in] NOUT 172*> \verbatim 173*> NOUT is INTEGER 174*> The unit number for output. 175*> \endverbatim 176* 177* Authors: 178* ======== 179* 180*> \author Univ. of Tennessee 181*> \author Univ. of California Berkeley 182*> \author Univ. of Colorado Denver 183*> \author NAG Ltd. 184* 185*> \ingroup complex_lin 186* 187* ===================================================================== 188 SUBROUTINE CCHKGB( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NNS, 189 $ NSVAL, THRESH, TSTERR, A, LA, AFAC, LAFAC, B, 190 $ X, XACT, WORK, RWORK, IWORK, NOUT ) 191* 192* -- LAPACK test routine -- 193* -- LAPACK is a software package provided by Univ. of Tennessee, -- 194* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 195* 196* .. Scalar Arguments .. 197 LOGICAL TSTERR 198 INTEGER LA, LAFAC, NM, NN, NNB, NNS, NOUT 199 REAL THRESH 200* .. 201* .. Array Arguments .. 202 LOGICAL DOTYPE( * ) 203 INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NSVAL( * ), 204 $ NVAL( * ) 205 REAL RWORK( * ) 206 COMPLEX A( * ), AFAC( * ), B( * ), WORK( * ), X( * ), 207 $ XACT( * ) 208* .. 209* 210* ===================================================================== 211* 212* .. Parameters .. 213 REAL ONE, ZERO 214 PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) 215 INTEGER NTYPES, NTESTS 216 PARAMETER ( NTYPES = 8, NTESTS = 7 ) 217 INTEGER NBW, NTRAN 218 PARAMETER ( NBW = 4, NTRAN = 3 ) 219* .. 220* .. Local Scalars .. 221 LOGICAL TRFCON, ZEROT 222 CHARACTER DIST, NORM, TRANS, TYPE, XTYPE 223 CHARACTER*3 PATH 224 INTEGER I, I1, I2, IKL, IKU, IM, IMAT, IN, INB, INFO, 225 $ IOFF, IRHS, ITRAN, IZERO, J, K, KL, KOFF, KU, 226 $ LDA, LDAFAC, LDB, M, MODE, N, NB, NERRS, NFAIL, 227 $ NIMAT, NKL, NKU, NRHS, NRUN 228 REAL AINVNM, ANORM, ANORMI, ANORMO, CNDNUM, RCOND, 229 $ RCONDC, RCONDI, RCONDO 230* .. 231* .. Local Arrays .. 232 CHARACTER TRANSS( NTRAN ) 233 INTEGER ISEED( 4 ), ISEEDY( 4 ), KLVAL( NBW ), 234 $ KUVAL( NBW ) 235 REAL RESULT( NTESTS ) 236* .. 237* .. External Functions .. 238 REAL CLANGB, CLANGE, SGET06 239 EXTERNAL CLANGB, CLANGE, SGET06 240* .. 241* .. External Subroutines .. 242 EXTERNAL ALAERH, ALAHD, ALASUM, CCOPY, CERRGE, CGBCON, 243 $ CGBRFS, CGBT01, CGBT02, CGBT05, CGBTRF, CGBTRS, 244 $ CGET04, CLACPY, CLARHS, CLASET, CLATB4, CLATMS, 245 $ XLAENV 246* .. 247* .. Intrinsic Functions .. 248 INTRINSIC CMPLX, MAX, MIN 249* .. 250* .. Scalars in Common .. 251 LOGICAL LERR, OK 252 CHARACTER*32 SRNAMT 253 INTEGER INFOT, NUNIT 254* .. 255* .. Common blocks .. 256 COMMON / INFOC / INFOT, NUNIT, OK, LERR 257 COMMON / SRNAMC / SRNAMT 258* .. 259* .. Data statements .. 260 DATA ISEEDY / 1988, 1989, 1990, 1991 / , 261 $ TRANSS / 'N', 'T', 'C' / 262* .. 263* .. Executable Statements .. 264* 265* Initialize constants and the random number seed. 266* 267 PATH( 1: 1 ) = 'Complex precision' 268 PATH( 2: 3 ) = 'GB' 269 NRUN = 0 270 NFAIL = 0 271 NERRS = 0 272 DO 10 I = 1, 4 273 ISEED( I ) = ISEEDY( I ) 274 10 CONTINUE 275* 276* Test the error exits 277* 278 IF( TSTERR ) 279 $ CALL CERRGE( PATH, NOUT ) 280 INFOT = 0 281* 282* Initialize the first value for the lower and upper bandwidths. 283* 284 KLVAL( 1 ) = 0 285 KUVAL( 1 ) = 0 286* 287* Do for each value of M in MVAL 288* 289 DO 160 IM = 1, NM 290 M = MVAL( IM ) 291* 292* Set values to use for the lower bandwidth. 293* 294 KLVAL( 2 ) = M + ( M+1 ) / 4 295* 296* KLVAL( 2 ) = MAX( M-1, 0 ) 297* 298 KLVAL( 3 ) = ( 3*M-1 ) / 4 299 KLVAL( 4 ) = ( M+1 ) / 4 300* 301* Do for each value of N in NVAL 302* 303 DO 150 IN = 1, NN 304 N = NVAL( IN ) 305 XTYPE = 'N' 306* 307* Set values to use for the upper bandwidth. 308* 309 KUVAL( 2 ) = N + ( N+1 ) / 4 310* 311* KUVAL( 2 ) = MAX( N-1, 0 ) 312* 313 KUVAL( 3 ) = ( 3*N-1 ) / 4 314 KUVAL( 4 ) = ( N+1 ) / 4 315* 316* Set limits on the number of loop iterations. 317* 318 NKL = MIN( M+1, 4 ) 319 IF( N.EQ.0 ) 320 $ NKL = 2 321 NKU = MIN( N+1, 4 ) 322 IF( M.EQ.0 ) 323 $ NKU = 2 324 NIMAT = NTYPES 325 IF( M.LE.0 .OR. N.LE.0 ) 326 $ NIMAT = 1 327* 328 DO 140 IKL = 1, NKL 329* 330* Do for KL = 0, (5*M+1)/4, (3M-1)/4, and (M+1)/4. This 331* order makes it easier to skip redundant values for small 332* values of M. 333* 334 KL = KLVAL( IKL ) 335 DO 130 IKU = 1, NKU 336* 337* Do for KU = 0, (5*N+1)/4, (3N-1)/4, and (N+1)/4. This 338* order makes it easier to skip redundant values for 339* small values of N. 340* 341 KU = KUVAL( IKU ) 342* 343* Check that A and AFAC are big enough to generate this 344* matrix. 345* 346 LDA = KL + KU + 1 347 LDAFAC = 2*KL + KU + 1 348 IF( ( LDA*N ).GT.LA .OR. ( LDAFAC*N ).GT.LAFAC ) THEN 349 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 350 $ CALL ALAHD( NOUT, PATH ) 351 IF( N*( KL+KU+1 ).GT.LA ) THEN 352 WRITE( NOUT, FMT = 9999 )LA, M, N, KL, KU, 353 $ N*( KL+KU+1 ) 354 NERRS = NERRS + 1 355 END IF 356 IF( N*( 2*KL+KU+1 ).GT.LAFAC ) THEN 357 WRITE( NOUT, FMT = 9998 )LAFAC, M, N, KL, KU, 358 $ N*( 2*KL+KU+1 ) 359 NERRS = NERRS + 1 360 END IF 361 GO TO 130 362 END IF 363* 364 DO 120 IMAT = 1, NIMAT 365* 366* Do the tests only if DOTYPE( IMAT ) is true. 367* 368 IF( .NOT.DOTYPE( IMAT ) ) 369 $ GO TO 120 370* 371* Skip types 2, 3, or 4 if the matrix size is too 372* small. 373* 374 ZEROT = IMAT.GE.2 .AND. IMAT.LE.4 375 IF( ZEROT .AND. N.LT.IMAT-1 ) 376 $ GO TO 120 377* 378 IF( .NOT.ZEROT .OR. .NOT.DOTYPE( 1 ) ) THEN 379* 380* Set up parameters with CLATB4 and generate a 381* test matrix with CLATMS. 382* 383 CALL CLATB4( PATH, IMAT, M, N, TYPE, KL, KU, 384 $ ANORM, MODE, CNDNUM, DIST ) 385* 386 KOFF = MAX( 1, KU+2-N ) 387 DO 20 I = 1, KOFF - 1 388 A( I ) = ZERO 389 20 CONTINUE 390 SRNAMT = 'CLATMS' 391 CALL CLATMS( M, N, DIST, ISEED, TYPE, RWORK, 392 $ MODE, CNDNUM, ANORM, KL, KU, 'Z', 393 $ A( KOFF ), LDA, WORK, INFO ) 394* 395* Check the error code from CLATMS. 396* 397 IF( INFO.NE.0 ) THEN 398 CALL ALAERH( PATH, 'CLATMS', INFO, 0, ' ', M, 399 $ N, KL, KU, -1, IMAT, NFAIL, 400 $ NERRS, NOUT ) 401 GO TO 120 402 END IF 403 ELSE IF( IZERO.GT.0 ) THEN 404* 405* Use the same matrix for types 3 and 4 as for 406* type 2 by copying back the zeroed out column. 407* 408 CALL CCOPY( I2-I1+1, B, 1, A( IOFF+I1 ), 1 ) 409 END IF 410* 411* For types 2, 3, and 4, zero one or more columns of 412* the matrix to test that INFO is returned correctly. 413* 414 IZERO = 0 415 IF( ZEROT ) THEN 416 IF( IMAT.EQ.2 ) THEN 417 IZERO = 1 418 ELSE IF( IMAT.EQ.3 ) THEN 419 IZERO = MIN( M, N ) 420 ELSE 421 IZERO = MIN( M, N ) / 2 + 1 422 END IF 423 IOFF = ( IZERO-1 )*LDA 424 IF( IMAT.LT.4 ) THEN 425* 426* Store the column to be zeroed out in B. 427* 428 I1 = MAX( 1, KU+2-IZERO ) 429 I2 = MIN( KL+KU+1, KU+1+( M-IZERO ) ) 430 CALL CCOPY( I2-I1+1, A( IOFF+I1 ), 1, B, 1 ) 431* 432 DO 30 I = I1, I2 433 A( IOFF+I ) = ZERO 434 30 CONTINUE 435 ELSE 436 DO 50 J = IZERO, N 437 DO 40 I = MAX( 1, KU+2-J ), 438 $ MIN( KL+KU+1, KU+1+( M-J ) ) 439 A( IOFF+I ) = ZERO 440 40 CONTINUE 441 IOFF = IOFF + LDA 442 50 CONTINUE 443 END IF 444 END IF 445* 446* These lines, if used in place of the calls in the 447* loop over INB, cause the code to bomb on a Sun 448* SPARCstation. 449* 450* ANORMO = CLANGB( 'O', N, KL, KU, A, LDA, RWORK ) 451* ANORMI = CLANGB( 'I', N, KL, KU, A, LDA, RWORK ) 452* 453* Do for each blocksize in NBVAL 454* 455 DO 110 INB = 1, NNB 456 NB = NBVAL( INB ) 457 CALL XLAENV( 1, NB ) 458* 459* Compute the LU factorization of the band matrix. 460* 461 IF( M.GT.0 .AND. N.GT.0 ) 462 $ CALL CLACPY( 'Full', KL+KU+1, N, A, LDA, 463 $ AFAC( KL+1 ), LDAFAC ) 464 SRNAMT = 'CGBTRF' 465 CALL CGBTRF( M, N, KL, KU, AFAC, LDAFAC, IWORK, 466 $ INFO ) 467* 468* Check error code from CGBTRF. 469* 470 IF( INFO.NE.IZERO ) 471 $ CALL ALAERH( PATH, 'CGBTRF', INFO, IZERO, 472 $ ' ', M, N, KL, KU, NB, IMAT, 473 $ NFAIL, NERRS, NOUT ) 474 TRFCON = .FALSE. 475* 476*+ TEST 1 477* Reconstruct matrix from factors and compute 478* residual. 479* 480 CALL CGBT01( M, N, KL, KU, A, LDA, AFAC, LDAFAC, 481 $ IWORK, WORK, RESULT( 1 ) ) 482* 483* Print information about the tests so far that 484* did not pass the threshold. 485* 486 IF( RESULT( 1 ).GE.THRESH ) THEN 487 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 488 $ CALL ALAHD( NOUT, PATH ) 489 WRITE( NOUT, FMT = 9997 )M, N, KL, KU, NB, 490 $ IMAT, 1, RESULT( 1 ) 491 NFAIL = NFAIL + 1 492 END IF 493 NRUN = NRUN + 1 494* 495* Skip the remaining tests if this is not the 496* first block size or if M .ne. N. 497* 498 IF( INB.GT.1 .OR. M.NE.N ) 499 $ GO TO 110 500* 501 ANORMO = CLANGB( 'O', N, KL, KU, A, LDA, RWORK ) 502 ANORMI = CLANGB( 'I', N, KL, KU, A, LDA, RWORK ) 503* 504 IF( INFO.EQ.0 ) THEN 505* 506* Form the inverse of A so we can get a good 507* estimate of CNDNUM = norm(A) * norm(inv(A)). 508* 509 LDB = MAX( 1, N ) 510 CALL CLASET( 'Full', N, N, CMPLX( ZERO ), 511 $ CMPLX( ONE ), WORK, LDB ) 512 SRNAMT = 'CGBTRS' 513 CALL CGBTRS( 'No transpose', N, KL, KU, N, 514 $ AFAC, LDAFAC, IWORK, WORK, LDB, 515 $ INFO ) 516* 517* Compute the 1-norm condition number of A. 518* 519 AINVNM = CLANGE( 'O', N, N, WORK, LDB, 520 $ RWORK ) 521 IF( ANORMO.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN 522 RCONDO = ONE 523 ELSE 524 RCONDO = ( ONE / ANORMO ) / AINVNM 525 END IF 526* 527* Compute the infinity-norm condition number of 528* A. 529* 530 AINVNM = CLANGE( 'I', N, N, WORK, LDB, 531 $ RWORK ) 532 IF( ANORMI.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN 533 RCONDI = ONE 534 ELSE 535 RCONDI = ( ONE / ANORMI ) / AINVNM 536 END IF 537 ELSE 538* 539* Do only the condition estimate if INFO.NE.0. 540* 541 TRFCON = .TRUE. 542 RCONDO = ZERO 543 RCONDI = ZERO 544 END IF 545* 546* Skip the solve tests if the matrix is singular. 547* 548 IF( TRFCON ) 549 $ GO TO 90 550* 551 DO 80 IRHS = 1, NNS 552 NRHS = NSVAL( IRHS ) 553 XTYPE = 'N' 554* 555 DO 70 ITRAN = 1, NTRAN 556 TRANS = TRANSS( ITRAN ) 557 IF( ITRAN.EQ.1 ) THEN 558 RCONDC = RCONDO 559 NORM = 'O' 560 ELSE 561 RCONDC = RCONDI 562 NORM = 'I' 563 END IF 564* 565*+ TEST 2: 566* Solve and compute residual for op(A) * X = B. 567* 568 SRNAMT = 'CLARHS' 569 CALL CLARHS( PATH, XTYPE, ' ', TRANS, N, 570 $ N, KL, KU, NRHS, A, LDA, 571 $ XACT, LDB, B, LDB, ISEED, 572 $ INFO ) 573 XTYPE = 'C' 574 CALL CLACPY( 'Full', N, NRHS, B, LDB, X, 575 $ LDB ) 576* 577 SRNAMT = 'CGBTRS' 578 CALL CGBTRS( TRANS, N, KL, KU, NRHS, AFAC, 579 $ LDAFAC, IWORK, X, LDB, INFO ) 580* 581* Check error code from CGBTRS. 582* 583 IF( INFO.NE.0 ) 584 $ CALL ALAERH( PATH, 'CGBTRS', INFO, 0, 585 $ TRANS, N, N, KL, KU, -1, 586 $ IMAT, NFAIL, NERRS, NOUT ) 587* 588 CALL CLACPY( 'Full', N, NRHS, B, LDB, 589 $ WORK, LDB ) 590 CALL CGBT02( TRANS, M, N, KL, KU, NRHS, A, 591 $ LDA, X, LDB, WORK, LDB, 592 $ RWORK, RESULT( 2 ) ) 593* 594*+ TEST 3: 595* Check solution from generated exact 596* solution. 597* 598 CALL CGET04( N, NRHS, X, LDB, XACT, LDB, 599 $ RCONDC, RESULT( 3 ) ) 600* 601*+ TESTS 4, 5, 6: 602* Use iterative refinement to improve the 603* solution. 604* 605 SRNAMT = 'CGBRFS' 606 CALL CGBRFS( TRANS, N, KL, KU, NRHS, A, 607 $ LDA, AFAC, LDAFAC, IWORK, B, 608 $ LDB, X, LDB, RWORK, 609 $ RWORK( NRHS+1 ), WORK, 610 $ RWORK( 2*NRHS+1 ), INFO ) 611* 612* Check error code from CGBRFS. 613* 614 IF( INFO.NE.0 ) 615 $ CALL ALAERH( PATH, 'CGBRFS', INFO, 0, 616 $ TRANS, N, N, KL, KU, NRHS, 617 $ IMAT, NFAIL, NERRS, NOUT ) 618* 619 CALL CGET04( N, NRHS, X, LDB, XACT, LDB, 620 $ RCONDC, RESULT( 4 ) ) 621 CALL CGBT05( TRANS, N, KL, KU, NRHS, A, 622 $ LDA, B, LDB, X, LDB, XACT, 623 $ LDB, RWORK, RWORK( NRHS+1 ), 624 $ RESULT( 5 ) ) 625* 626* Print information about the tests that did 627* not pass the threshold. 628* 629 DO 60 K = 2, 6 630 IF( RESULT( K ).GE.THRESH ) THEN 631 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 632 $ CALL ALAHD( NOUT, PATH ) 633 WRITE( NOUT, FMT = 9996 )TRANS, N, 634 $ KL, KU, NRHS, IMAT, K, 635 $ RESULT( K ) 636 NFAIL = NFAIL + 1 637 END IF 638 60 CONTINUE 639 NRUN = NRUN + 5 640 70 CONTINUE 641 80 CONTINUE 642* 643*+ TEST 7: 644* Get an estimate of RCOND = 1/CNDNUM. 645* 646 90 CONTINUE 647 DO 100 ITRAN = 1, 2 648 IF( ITRAN.EQ.1 ) THEN 649 ANORM = ANORMO 650 RCONDC = RCONDO 651 NORM = 'O' 652 ELSE 653 ANORM = ANORMI 654 RCONDC = RCONDI 655 NORM = 'I' 656 END IF 657 SRNAMT = 'CGBCON' 658 CALL CGBCON( NORM, N, KL, KU, AFAC, LDAFAC, 659 $ IWORK, ANORM, RCOND, WORK, 660 $ RWORK, INFO ) 661* 662* Check error code from CGBCON. 663* 664 IF( INFO.NE.0 ) 665 $ CALL ALAERH( PATH, 'CGBCON', INFO, 0, 666 $ NORM, N, N, KL, KU, -1, IMAT, 667 $ NFAIL, NERRS, NOUT ) 668* 669 RESULT( 7 ) = SGET06( RCOND, RCONDC ) 670* 671* Print information about the tests that did 672* not pass the threshold. 673* 674 IF( RESULT( 7 ).GE.THRESH ) THEN 675 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 676 $ CALL ALAHD( NOUT, PATH ) 677 WRITE( NOUT, FMT = 9995 )NORM, N, KL, KU, 678 $ IMAT, 7, RESULT( 7 ) 679 NFAIL = NFAIL + 1 680 END IF 681 NRUN = NRUN + 1 682 100 CONTINUE 683 110 CONTINUE 684 120 CONTINUE 685 130 CONTINUE 686 140 CONTINUE 687 150 CONTINUE 688 160 CONTINUE 689* 690* Print a summary of the results. 691* 692 CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS ) 693* 694 9999 FORMAT( ' *** In CCHKGB, LA=', I5, ' is too small for M=', I5, 695 $ ', N=', I5, ', KL=', I4, ', KU=', I4, 696 $ / ' ==> Increase LA to at least ', I5 ) 697 9998 FORMAT( ' *** In CCHKGB, LAFAC=', I5, ' is too small for M=', I5, 698 $ ', N=', I5, ', KL=', I4, ', KU=', I4, 699 $ / ' ==> Increase LAFAC to at least ', I5 ) 700 9997 FORMAT( ' M =', I5, ', N =', I5, ', KL=', I5, ', KU=', I5, 701 $ ', NB =', I4, ', type ', I1, ', test(', I1, ')=', G12.5 ) 702 9996 FORMAT( ' TRANS=''', A1, ''', N=', I5, ', KL=', I5, ', KU=', I5, 703 $ ', NRHS=', I3, ', type ', I1, ', test(', I1, ')=', G12.5 ) 704 9995 FORMAT( ' NORM =''', A1, ''', N=', I5, ', KL=', I5, ', KU=', I5, 705 $ ',', 10X, ' type ', I1, ', test(', I1, ')=', G12.5 ) 706* 707 RETURN 708* 709* End of CCHKGB 710* 711 END 712