1*> \brief \b ZDRVGBX 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 ZDRVGB( 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* DOUBLE PRECISION THRESH 19* .. 20* .. Array Arguments .. 21* LOGICAL DOTYPE( * ) 22* INTEGER IWORK( * ), NVAL( * ) 23* DOUBLE PRECISION RWORK( * ), S( * ) 24* COMPLEX*16 A( * ), AFB( * ), ASAV( * ), B( * ), BSAV( * ), 25* $ WORK( * ), X( * ), XACT( * ) 26* .. 27* 28* 29*> \par Purpose: 30* ============= 31*> 32*> \verbatim 33*> 34*> ZDRVGB tests the driver routines ZGBSV, -SVX, and -SVXX. 35*> 36*> Note that this file is used only when the XBLAS are available, 37*> otherwise zdrvgb.f defines this subroutine. 38*> \endverbatim 39* 40* Arguments: 41* ========== 42* 43*> \param[in] DOTYPE 44*> \verbatim 45*> DOTYPE is LOGICAL array, dimension (NTYPES) 46*> The matrix types to be used for testing. Matrices of type j 47*> (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) = 48*> .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used. 49*> \endverbatim 50*> 51*> \param[in] NN 52*> \verbatim 53*> NN is INTEGER 54*> The number of values of N contained in the vector NVAL. 55*> \endverbatim 56*> 57*> \param[in] NVAL 58*> \verbatim 59*> NVAL is INTEGER array, dimension (NN) 60*> The values of the matrix column dimension N. 61*> \endverbatim 62*> 63*> \param[in] NRHS 64*> \verbatim 65*> NRHS is INTEGER 66*> The number of right hand side vectors to be generated for 67*> each linear system. 68*> \endverbatim 69*> 70*> \param[in] THRESH 71*> \verbatim 72*> THRESH is DOUBLE PRECISION 73*> The threshold value for the test ratios. A result is 74*> included in the output file if RESULT >= THRESH. To have 75*> every test ratio printed, use THRESH = 0. 76*> \endverbatim 77*> 78*> \param[in] TSTERR 79*> \verbatim 80*> TSTERR is LOGICAL 81*> Flag that indicates whether error exits are to be tested. 82*> \endverbatim 83*> 84*> \param[out] A 85*> \verbatim 86*> A is COMPLEX*16 array, dimension (LA) 87*> \endverbatim 88*> 89*> \param[in] LA 90*> \verbatim 91*> LA is INTEGER 92*> The length of the array A. LA >= (2*NMAX-1)*NMAX 93*> where NMAX is the largest entry in NVAL. 94*> \endverbatim 95*> 96*> \param[out] AFB 97*> \verbatim 98*> AFB is COMPLEX*16 array, dimension (LAFB) 99*> \endverbatim 100*> 101*> \param[in] LAFB 102*> \verbatim 103*> LAFB is INTEGER 104*> The length of the array AFB. LAFB >= (3*NMAX-2)*NMAX 105*> where NMAX is the largest entry in NVAL. 106*> \endverbatim 107*> 108*> \param[out] ASAV 109*> \verbatim 110*> ASAV is COMPLEX*16 array, dimension (LA) 111*> \endverbatim 112*> 113*> \param[out] B 114*> \verbatim 115*> B is COMPLEX*16 array, dimension (NMAX*NRHS) 116*> \endverbatim 117*> 118*> \param[out] BSAV 119*> \verbatim 120*> BSAV is COMPLEX*16 array, dimension (NMAX*NRHS) 121*> \endverbatim 122*> 123*> \param[out] X 124*> \verbatim 125*> X is COMPLEX*16 array, dimension (NMAX*NRHS) 126*> \endverbatim 127*> 128*> \param[out] XACT 129*> \verbatim 130*> XACT is COMPLEX*16 array, dimension (NMAX*NRHS) 131*> \endverbatim 132*> 133*> \param[out] S 134*> \verbatim 135*> S is DOUBLE PRECISION array, dimension (2*NMAX) 136*> \endverbatim 137*> 138*> \param[out] WORK 139*> \verbatim 140*> WORK is COMPLEX*16 array, dimension 141*> (NMAX*max(3,NRHS,NMAX)) 142*> \endverbatim 143*> 144*> \param[out] RWORK 145*> \verbatim 146*> RWORK is DOUBLE PRECISION array, dimension 147*> (max(NMAX,2*NRHS)) 148*> \endverbatim 149*> 150*> \param[out] IWORK 151*> \verbatim 152*> IWORK is INTEGER array, dimension (NMAX) 153*> \endverbatim 154*> 155*> \param[in] NOUT 156*> \verbatim 157*> NOUT is INTEGER 158*> The unit number for output. 159*> \endverbatim 160* 161* Authors: 162* ======== 163* 164*> \author Univ. of Tennessee 165*> \author Univ. of California Berkeley 166*> \author Univ. of Colorado Denver 167*> \author NAG Ltd. 168* 169*> \date December 2016 170* 171*> \ingroup complex16_lin 172* 173* ===================================================================== 174 SUBROUTINE ZDRVGB( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, A, LA, 175 $ AFB, LAFB, ASAV, B, BSAV, X, XACT, S, WORK, 176 $ RWORK, IWORK, NOUT ) 177* 178* -- LAPACK test routine (version 3.7.0) -- 179* -- LAPACK is a software package provided by Univ. of Tennessee, -- 180* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 181* December 2016 182* 183* .. Scalar Arguments .. 184 LOGICAL TSTERR 185 INTEGER LA, LAFB, NN, NOUT, NRHS 186 DOUBLE PRECISION THRESH 187* .. 188* .. Array Arguments .. 189 LOGICAL DOTYPE( * ) 190 INTEGER IWORK( * ), NVAL( * ) 191 DOUBLE PRECISION RWORK( * ), S( * ) 192 COMPLEX*16 A( * ), AFB( * ), ASAV( * ), B( * ), BSAV( * ), 193 $ WORK( * ), X( * ), XACT( * ) 194* .. 195* 196* ===================================================================== 197* 198* .. Parameters .. 199 DOUBLE PRECISION ONE, ZERO 200 PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 ) 201 INTEGER NTYPES 202 PARAMETER ( NTYPES = 8 ) 203 INTEGER NTESTS 204 PARAMETER ( NTESTS = 7 ) 205 INTEGER NTRAN 206 PARAMETER ( NTRAN = 3 ) 207* .. 208* .. Local Scalars .. 209 LOGICAL EQUIL, NOFACT, PREFAC, TRFCON, ZEROT 210 CHARACTER DIST, EQUED, FACT, TRANS, TYPE, XTYPE 211 CHARACTER*3 PATH 212 INTEGER I, I1, I2, IEQUED, IFACT, IKL, IKU, IMAT, IN, 213 $ INFO, IOFF, ITRAN, IZERO, J, K, K1, KL, KU, 214 $ LDA, LDAFB, LDB, MODE, N, NB, NBMIN, NERRS, 215 $ NFACT, NFAIL, NIMAT, NKL, NKU, NRUN, NT, 216 $ N_ERR_BNDS 217 DOUBLE PRECISION AINVNM, AMAX, ANORM, ANORMI, ANORMO, ANRMPV, 218 $ CNDNUM, COLCND, RCOND, RCONDC, RCONDI, RCONDO, 219 $ ROLDC, ROLDI, ROLDO, ROWCND, RPVGRW, 220 $ RPVGRW_SVXX 221* .. 222* .. Local Arrays .. 223 CHARACTER EQUEDS( 4 ), FACTS( 3 ), TRANSS( NTRAN ) 224 INTEGER ISEED( 4 ), ISEEDY( 4 ) 225 DOUBLE PRECISION RDUM( 1 ), RESULT( NTESTS ), BERR( NRHS ), 226 $ ERRBNDS_N( NRHS, 3 ), ERRBNDS_C( NRHS, 3 ) 227* .. 228* .. External Functions .. 229 LOGICAL LSAME 230 DOUBLE PRECISION DGET06, DLAMCH, ZLANGB, ZLANGE, ZLANTB, 231 $ ZLA_GBRPVGRW 232 EXTERNAL LSAME, DGET06, DLAMCH, ZLANGB, ZLANGE, ZLANTB, 233 $ ZLA_GBRPVGRW 234* .. 235* .. External Subroutines .. 236 EXTERNAL ALADHD, ALAERH, ALASVM, XLAENV, ZERRVX, ZGBEQU, 237 $ ZGBSV, ZGBSVX, ZGBT01, ZGBT02, ZGBT05, ZGBTRF, 238 $ ZGBTRS, ZGET04, ZLACPY, ZLAQGB, ZLARHS, ZLASET, 239 $ ZLATB4, ZLATMS, ZGBSVXX 240* .. 241* .. Intrinsic Functions .. 242 INTRINSIC ABS, DCMPLX, MAX, MIN 243* .. 244* .. Scalars in Common .. 245 LOGICAL LERR, OK 246 CHARACTER*32 SRNAMT 247 INTEGER INFOT, NUNIT 248* .. 249* .. Common blocks .. 250 COMMON / INFOC / INFOT, NUNIT, OK, LERR 251 COMMON / SRNAMC / SRNAMT 252* .. 253* .. Data statements .. 254 DATA ISEEDY / 1988, 1989, 1990, 1991 / 255 DATA TRANSS / 'N', 'T', 'C' / 256 DATA FACTS / 'F', 'N', 'E' / 257 DATA EQUEDS / 'N', 'R', 'C', 'B' / 258* .. 259* .. Executable Statements .. 260* 261* Initialize constants and the random number seed. 262* 263 PATH( 1: 1 ) = 'Zomplex precision' 264 PATH( 2: 3 ) = 'GB' 265 NRUN = 0 266 NFAIL = 0 267 NERRS = 0 268 DO 10 I = 1, 4 269 ISEED( I ) = ISEEDY( I ) 270 10 CONTINUE 271* 272* Test the error exits 273* 274 IF( TSTERR ) 275 $ CALL ZERRVX( PATH, NOUT ) 276 INFOT = 0 277* 278* Set the block size and minimum block size for testing. 279* 280 NB = 1 281 NBMIN = 2 282 CALL XLAENV( 1, NB ) 283 CALL XLAENV( 2, NBMIN ) 284* 285* Do for each value of N in NVAL 286* 287 DO 150 IN = 1, NN 288 N = NVAL( IN ) 289 LDB = MAX( N, 1 ) 290 XTYPE = 'N' 291* 292* Set limits on the number of loop iterations. 293* 294 NKL = MAX( 1, MIN( N, 4 ) ) 295 IF( N.EQ.0 ) 296 $ NKL = 1 297 NKU = NKL 298 NIMAT = NTYPES 299 IF( N.LE.0 ) 300 $ NIMAT = 1 301* 302 DO 140 IKL = 1, NKL 303* 304* Do for KL = 0, N-1, (3N-1)/4, and (N+1)/4. This order makes 305* it easier to skip redundant values for small values of N. 306* 307 IF( IKL.EQ.1 ) THEN 308 KL = 0 309 ELSE IF( IKL.EQ.2 ) THEN 310 KL = MAX( N-1, 0 ) 311 ELSE IF( IKL.EQ.3 ) THEN 312 KL = ( 3*N-1 ) / 4 313 ELSE IF( IKL.EQ.4 ) THEN 314 KL = ( N+1 ) / 4 315 END IF 316 DO 130 IKU = 1, NKU 317* 318* Do for KU = 0, N-1, (3N-1)/4, and (N+1)/4. This order 319* makes it easier to skip redundant values for small 320* values of N. 321* 322 IF( IKU.EQ.1 ) THEN 323 KU = 0 324 ELSE IF( IKU.EQ.2 ) THEN 325 KU = MAX( N-1, 0 ) 326 ELSE IF( IKU.EQ.3 ) THEN 327 KU = ( 3*N-1 ) / 4 328 ELSE IF( IKU.EQ.4 ) THEN 329 KU = ( N+1 ) / 4 330 END IF 331* 332* Check that A and AFB are big enough to generate this 333* matrix. 334* 335 LDA = KL + KU + 1 336 LDAFB = 2*KL + KU + 1 337 IF( LDA*N.GT.LA .OR. LDAFB*N.GT.LAFB ) THEN 338 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 339 $ CALL ALADHD( NOUT, PATH ) 340 IF( LDA*N.GT.LA ) THEN 341 WRITE( NOUT, FMT = 9999 )LA, N, KL, KU, 342 $ N*( KL+KU+1 ) 343 NERRS = NERRS + 1 344 END IF 345 IF( LDAFB*N.GT.LAFB ) THEN 346 WRITE( NOUT, FMT = 9998 )LAFB, N, KL, KU, 347 $ N*( 2*KL+KU+1 ) 348 NERRS = NERRS + 1 349 END IF 350 GO TO 130 351 END IF 352* 353 DO 120 IMAT = 1, NIMAT 354* 355* Do the tests only if DOTYPE( IMAT ) is true. 356* 357 IF( .NOT.DOTYPE( IMAT ) ) 358 $ GO TO 120 359* 360* Skip types 2, 3, or 4 if the matrix is too small. 361* 362 ZEROT = IMAT.GE.2 .AND. IMAT.LE.4 363 IF( ZEROT .AND. N.LT.IMAT-1 ) 364 $ GO TO 120 365* 366* Set up parameters with ZLATB4 and generate a 367* test matrix with ZLATMS. 368* 369 CALL ZLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM, 370 $ MODE, CNDNUM, DIST ) 371 RCONDC = ONE / CNDNUM 372* 373 SRNAMT = 'ZLATMS' 374 CALL ZLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE, 375 $ CNDNUM, ANORM, KL, KU, 'Z', A, LDA, WORK, 376 $ INFO ) 377* 378* Check the error code from ZLATMS. 379* 380 IF( INFO.NE.0 ) THEN 381 CALL ALAERH( PATH, 'ZLATMS', INFO, 0, ' ', N, N, 382 $ KL, KU, -1, IMAT, NFAIL, NERRS, NOUT ) 383 GO TO 120 384 END IF 385* 386* For types 2, 3, and 4, zero one or more columns of 387* the matrix to test that INFO is returned correctly. 388* 389 IZERO = 0 390 IF( ZEROT ) THEN 391 IF( IMAT.EQ.2 ) THEN 392 IZERO = 1 393 ELSE IF( IMAT.EQ.3 ) THEN 394 IZERO = N 395 ELSE 396 IZERO = N / 2 + 1 397 END IF 398 IOFF = ( IZERO-1 )*LDA 399 IF( IMAT.LT.4 ) THEN 400 I1 = MAX( 1, KU+2-IZERO ) 401 I2 = MIN( KL+KU+1, KU+1+( N-IZERO ) ) 402 DO 20 I = I1, I2 403 A( IOFF+I ) = ZERO 404 20 CONTINUE 405 ELSE 406 DO 40 J = IZERO, N 407 DO 30 I = MAX( 1, KU+2-J ), 408 $ MIN( KL+KU+1, KU+1+( N-J ) ) 409 A( IOFF+I ) = ZERO 410 30 CONTINUE 411 IOFF = IOFF + LDA 412 40 CONTINUE 413 END IF 414 END IF 415* 416* Save a copy of the matrix A in ASAV. 417* 418 CALL ZLACPY( 'Full', KL+KU+1, N, A, LDA, ASAV, LDA ) 419* 420 DO 110 IEQUED = 1, 4 421 EQUED = EQUEDS( IEQUED ) 422 IF( IEQUED.EQ.1 ) THEN 423 NFACT = 3 424 ELSE 425 NFACT = 1 426 END IF 427* 428 DO 100 IFACT = 1, NFACT 429 FACT = FACTS( IFACT ) 430 PREFAC = LSAME( FACT, 'F' ) 431 NOFACT = LSAME( FACT, 'N' ) 432 EQUIL = LSAME( FACT, 'E' ) 433* 434 IF( ZEROT ) THEN 435 IF( PREFAC ) 436 $ GO TO 100 437 RCONDO = ZERO 438 RCONDI = ZERO 439* 440 ELSE IF( .NOT.NOFACT ) THEN 441* 442* Compute the condition number for comparison 443* with the value returned by DGESVX (FACT = 444* 'N' reuses the condition number from the 445* previous iteration with FACT = 'F'). 446* 447 CALL ZLACPY( 'Full', KL+KU+1, N, ASAV, LDA, 448 $ AFB( KL+1 ), LDAFB ) 449 IF( EQUIL .OR. IEQUED.GT.1 ) THEN 450* 451* Compute row and column scale factors to 452* equilibrate the matrix A. 453* 454 CALL ZGBEQU( N, N, KL, KU, AFB( KL+1 ), 455 $ LDAFB, S, S( N+1 ), ROWCND, 456 $ COLCND, AMAX, INFO ) 457 IF( INFO.EQ.0 .AND. N.GT.0 ) THEN 458 IF( LSAME( EQUED, 'R' ) ) THEN 459 ROWCND = ZERO 460 COLCND = ONE 461 ELSE IF( LSAME( EQUED, 'C' ) ) THEN 462 ROWCND = ONE 463 COLCND = ZERO 464 ELSE IF( LSAME( EQUED, 'B' ) ) THEN 465 ROWCND = ZERO 466 COLCND = ZERO 467 END IF 468* 469* Equilibrate the matrix. 470* 471 CALL ZLAQGB( N, N, KL, KU, AFB( KL+1 ), 472 $ LDAFB, S, S( N+1 ), 473 $ ROWCND, COLCND, AMAX, 474 $ EQUED ) 475 END IF 476 END IF 477* 478* Save the condition number of the 479* non-equilibrated system for use in ZGET04. 480* 481 IF( EQUIL ) THEN 482 ROLDO = RCONDO 483 ROLDI = RCONDI 484 END IF 485* 486* Compute the 1-norm and infinity-norm of A. 487* 488 ANORMO = ZLANGB( '1', N, KL, KU, AFB( KL+1 ), 489 $ LDAFB, RWORK ) 490 ANORMI = ZLANGB( 'I', N, KL, KU, AFB( KL+1 ), 491 $ LDAFB, RWORK ) 492* 493* Factor the matrix A. 494* 495 CALL ZGBTRF( N, N, KL, KU, AFB, LDAFB, IWORK, 496 $ INFO ) 497* 498* Form the inverse of A. 499* 500 CALL ZLASET( 'Full', N, N, DCMPLX( ZERO ), 501 $ DCMPLX( ONE ), WORK, LDB ) 502 SRNAMT = 'ZGBTRS' 503 CALL ZGBTRS( 'No transpose', N, KL, KU, N, 504 $ AFB, LDAFB, IWORK, WORK, LDB, 505 $ INFO ) 506* 507* Compute the 1-norm condition number of A. 508* 509 AINVNM = ZLANGE( '1', N, N, WORK, LDB, 510 $ RWORK ) 511 IF( ANORMO.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN 512 RCONDO = ONE 513 ELSE 514 RCONDO = ( ONE / ANORMO ) / AINVNM 515 END IF 516* 517* Compute the infinity-norm condition number 518* of A. 519* 520 AINVNM = ZLANGE( 'I', N, N, WORK, LDB, 521 $ RWORK ) 522 IF( ANORMI.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN 523 RCONDI = ONE 524 ELSE 525 RCONDI = ( ONE / ANORMI ) / AINVNM 526 END IF 527 END IF 528* 529 DO 90 ITRAN = 1, NTRAN 530* 531* Do for each value of TRANS. 532* 533 TRANS = TRANSS( ITRAN ) 534 IF( ITRAN.EQ.1 ) THEN 535 RCONDC = RCONDO 536 ELSE 537 RCONDC = RCONDI 538 END IF 539* 540* Restore the matrix A. 541* 542 CALL ZLACPY( 'Full', KL+KU+1, N, ASAV, LDA, 543 $ A, LDA ) 544* 545* Form an exact solution and set the right hand 546* side. 547* 548 SRNAMT = 'ZLARHS' 549 CALL ZLARHS( PATH, XTYPE, 'Full', TRANS, N, 550 $ N, KL, KU, NRHS, A, LDA, XACT, 551 $ LDB, B, LDB, ISEED, INFO ) 552 XTYPE = 'C' 553 CALL ZLACPY( 'Full', N, NRHS, B, LDB, BSAV, 554 $ LDB ) 555* 556 IF( NOFACT .AND. ITRAN.EQ.1 ) THEN 557* 558* --- Test ZGBSV --- 559* 560* Compute the LU factorization of the matrix 561* and solve the system. 562* 563 CALL ZLACPY( 'Full', KL+KU+1, N, A, LDA, 564 $ AFB( KL+1 ), LDAFB ) 565 CALL ZLACPY( 'Full', N, NRHS, B, LDB, X, 566 $ LDB ) 567* 568 SRNAMT = 'ZGBSV ' 569 CALL ZGBSV( N, KL, KU, NRHS, AFB, LDAFB, 570 $ IWORK, X, LDB, INFO ) 571* 572* Check error code from ZGBSV . 573* 574 IF( INFO.NE.IZERO ) 575 $ CALL ALAERH( PATH, 'ZGBSV ', INFO, 576 $ IZERO, ' ', N, N, KL, KU, 577 $ NRHS, IMAT, NFAIL, NERRS, 578 $ NOUT ) 579* 580* Reconstruct matrix from factors and 581* compute residual. 582* 583 CALL ZGBT01( N, N, KL, KU, A, LDA, AFB, 584 $ LDAFB, IWORK, WORK, 585 $ RESULT( 1 ) ) 586 NT = 1 587 IF( IZERO.EQ.0 ) THEN 588* 589* Compute residual of the computed 590* solution. 591* 592 CALL ZLACPY( 'Full', N, NRHS, B, LDB, 593 $ WORK, LDB ) 594 CALL ZGBT02( 'No transpose', N, N, KL, 595 $ KU, NRHS, A, LDA, X, LDB, 596 $ WORK, LDB, RESULT( 2 ) ) 597* 598* Check solution from generated exact 599* solution. 600* 601 CALL ZGET04( N, NRHS, X, LDB, XACT, 602 $ LDB, RCONDC, RESULT( 3 ) ) 603 NT = 3 604 END IF 605* 606* Print information about the tests that did 607* not pass the threshold. 608* 609 DO 50 K = 1, NT 610 IF( RESULT( K ).GE.THRESH ) THEN 611 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 612 $ CALL ALADHD( NOUT, PATH ) 613 WRITE( NOUT, FMT = 9997 )'ZGBSV ', 614 $ N, KL, KU, IMAT, K, RESULT( K ) 615 NFAIL = NFAIL + 1 616 END IF 617 50 CONTINUE 618 NRUN = NRUN + NT 619 END IF 620* 621* --- Test ZGBSVX --- 622* 623 IF( .NOT.PREFAC ) 624 $ CALL ZLASET( 'Full', 2*KL+KU+1, N, 625 $ DCMPLX( ZERO ), 626 $ DCMPLX( ZERO ), AFB, LDAFB ) 627 CALL ZLASET( 'Full', N, NRHS, DCMPLX( ZERO ), 628 $ DCMPLX( ZERO ), X, LDB ) 629 IF( IEQUED.GT.1 .AND. N.GT.0 ) THEN 630* 631* Equilibrate the matrix if FACT = 'F' and 632* EQUED = 'R', 'C', or 'B'. 633* 634 CALL ZLAQGB( N, N, KL, KU, A, LDA, S, 635 $ S( N+1 ), ROWCND, COLCND, 636 $ AMAX, EQUED ) 637 END IF 638* 639* Solve the system and compute the condition 640* number and error bounds using ZGBSVX. 641* 642 SRNAMT = 'ZGBSVX' 643 CALL ZGBSVX( FACT, TRANS, N, KL, KU, NRHS, A, 644 $ LDA, AFB, LDAFB, IWORK, EQUED, 645 $ S, S( LDB+1 ), B, LDB, X, LDB, 646 $ RCOND, RWORK, RWORK( NRHS+1 ), 647 $ WORK, RWORK( 2*NRHS+1 ), INFO ) 648* 649* Check the error code from ZGBSVX. 650* 651 IF( INFO.NE.IZERO ) 652 $ CALL ALAERH( PATH, 'ZGBSVX', INFO, IZERO, 653 $ FACT // TRANS, N, N, KL, KU, 654 $ NRHS, IMAT, NFAIL, NERRS, 655 $ NOUT ) 656* 657* Compare RWORK(2*NRHS+1) from ZGBSVX with the 658* computed reciprocal pivot growth RPVGRW 659* 660 IF( INFO.NE.0 ) THEN 661 ANRMPV = ZERO 662 DO 70 J = 1, INFO 663 DO 60 I = MAX( KU+2-J, 1 ), 664 $ MIN( N+KU+1-J, KL+KU+1 ) 665 ANRMPV = MAX( ANRMPV, 666 $ ABS( A( I+( J-1 )*LDA ) ) ) 667 60 CONTINUE 668 70 CONTINUE 669 RPVGRW = ZLANTB( 'M', 'U', 'N', INFO, 670 $ MIN( INFO-1, KL+KU ), 671 $ AFB( MAX( 1, KL+KU+2-INFO ) ), 672 $ LDAFB, RDUM ) 673 IF( RPVGRW.EQ.ZERO ) THEN 674 RPVGRW = ONE 675 ELSE 676 RPVGRW = ANRMPV / RPVGRW 677 END IF 678 ELSE 679 RPVGRW = ZLANTB( 'M', 'U', 'N', N, KL+KU, 680 $ AFB, LDAFB, RDUM ) 681 IF( RPVGRW.EQ.ZERO ) THEN 682 RPVGRW = ONE 683 ELSE 684 RPVGRW = ZLANGB( 'M', N, KL, KU, A, 685 $ LDA, RDUM ) / RPVGRW 686 END IF 687 END IF 688 RESULT( 7 ) = ABS( RPVGRW-RWORK( 2*NRHS+1 ) ) 689 $ / MAX( RWORK( 2*NRHS+1 ), 690 $ RPVGRW ) / DLAMCH( 'E' ) 691* 692 IF( .NOT.PREFAC ) THEN 693* 694* Reconstruct matrix from factors and 695* compute residual. 696* 697 CALL ZGBT01( N, N, KL, KU, A, LDA, AFB, 698 $ LDAFB, IWORK, WORK, 699 $ RESULT( 1 ) ) 700 K1 = 1 701 ELSE 702 K1 = 2 703 END IF 704* 705 IF( INFO.EQ.0 ) THEN 706 TRFCON = .FALSE. 707* 708* Compute residual of the computed solution. 709* 710 CALL ZLACPY( 'Full', N, NRHS, BSAV, LDB, 711 $ WORK, LDB ) 712 CALL ZGBT02( TRANS, N, N, KL, KU, NRHS, 713 $ ASAV, LDA, X, LDB, WORK, LDB, 714 $ RESULT( 2 ) ) 715* 716* Check solution from generated exact 717* solution. 718* 719 IF( NOFACT .OR. ( PREFAC .AND. 720 $ LSAME( EQUED, 'N' ) ) ) THEN 721 CALL ZGET04( N, NRHS, X, LDB, XACT, 722 $ LDB, RCONDC, RESULT( 3 ) ) 723 ELSE 724 IF( ITRAN.EQ.1 ) THEN 725 ROLDC = ROLDO 726 ELSE 727 ROLDC = ROLDI 728 END IF 729 CALL ZGET04( N, NRHS, X, LDB, XACT, 730 $ LDB, ROLDC, RESULT( 3 ) ) 731 END IF 732* 733* Check the error bounds from iterative 734* refinement. 735* 736 CALL ZGBT05( TRANS, N, KL, KU, NRHS, ASAV, 737 $ LDA, BSAV, LDB, X, LDB, XACT, 738 $ LDB, RWORK, RWORK( NRHS+1 ), 739 $ RESULT( 4 ) ) 740 ELSE 741 TRFCON = .TRUE. 742 END IF 743* 744* Compare RCOND from ZGBSVX with the computed 745* value in RCONDC. 746* 747 RESULT( 6 ) = DGET06( RCOND, RCONDC ) 748* 749* Print information about the tests that did 750* not pass the threshold. 751* 752 IF( .NOT.TRFCON ) THEN 753 DO 80 K = K1, NTESTS 754 IF( RESULT( K ).GE.THRESH ) THEN 755 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 756 $ CALL ALADHD( NOUT, PATH ) 757 IF( PREFAC ) THEN 758 WRITE( NOUT, FMT = 9995 ) 759 $ 'ZGBSVX', FACT, TRANS, N, KL, 760 $ KU, EQUED, IMAT, K, 761 $ RESULT( K ) 762 ELSE 763 WRITE( NOUT, FMT = 9996 ) 764 $ 'ZGBSVX', FACT, TRANS, N, KL, 765 $ KU, IMAT, K, RESULT( K ) 766 END IF 767 NFAIL = NFAIL + 1 768 END IF 769 80 CONTINUE 770 NRUN = NRUN + 7 - K1 771 ELSE 772 IF( RESULT( 1 ).GE.THRESH .AND. .NOT. 773 $ PREFAC ) THEN 774 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 775 $ CALL ALADHD( NOUT, PATH ) 776 IF( PREFAC ) THEN 777 WRITE( NOUT, FMT = 9995 )'ZGBSVX', 778 $ FACT, TRANS, N, KL, KU, EQUED, 779 $ IMAT, 1, RESULT( 1 ) 780 ELSE 781 WRITE( NOUT, FMT = 9996 )'ZGBSVX', 782 $ FACT, TRANS, N, KL, KU, IMAT, 1, 783 $ RESULT( 1 ) 784 END IF 785 NFAIL = NFAIL + 1 786 NRUN = NRUN + 1 787 END IF 788 IF( RESULT( 6 ).GE.THRESH ) THEN 789 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 790 $ CALL ALADHD( NOUT, PATH ) 791 IF( PREFAC ) THEN 792 WRITE( NOUT, FMT = 9995 )'ZGBSVX', 793 $ FACT, TRANS, N, KL, KU, EQUED, 794 $ IMAT, 6, RESULT( 6 ) 795 ELSE 796 WRITE( NOUT, FMT = 9996 )'ZGBSVX', 797 $ FACT, TRANS, N, KL, KU, IMAT, 6, 798 $ RESULT( 6 ) 799 END IF 800 NFAIL = NFAIL + 1 801 NRUN = NRUN + 1 802 END IF 803 IF( RESULT( 7 ).GE.THRESH ) THEN 804 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 805 $ CALL ALADHD( NOUT, PATH ) 806 IF( PREFAC ) THEN 807 WRITE( NOUT, FMT = 9995 )'ZGBSVX', 808 $ FACT, TRANS, N, KL, KU, EQUED, 809 $ IMAT, 7, RESULT( 7 ) 810 ELSE 811 WRITE( NOUT, FMT = 9996 )'ZGBSVX', 812 $ FACT, TRANS, N, KL, KU, IMAT, 7, 813 $ RESULT( 7 ) 814 END IF 815 NFAIL = NFAIL + 1 816 NRUN = NRUN + 1 817 END IF 818 END IF 819 820* --- Test ZGBSVXX --- 821 822* Restore the matrices A and B. 823 824c write(*,*) 'begin zgbsvxx testing' 825 826 CALL ZLACPY( 'Full', KL+KU+1, N, ASAV, LDA, A, 827 $ LDA ) 828 CALL ZLACPY( 'Full', N, NRHS, BSAV, LDB, B, LDB ) 829 830 IF( .NOT.PREFAC ) 831 $ CALL ZLASET( 'Full', 2*KL+KU+1, N, 832 $ DCMPLX( ZERO ), DCMPLX( ZERO ), 833 $ AFB, LDAFB ) 834 CALL ZLASET( 'Full', N, NRHS, 835 $ DCMPLX( ZERO ), DCMPLX( ZERO ), 836 $ X, LDB ) 837 IF( IEQUED.GT.1 .AND. N.GT.0 ) THEN 838* 839* Equilibrate the matrix if FACT = 'F' and 840* EQUED = 'R', 'C', or 'B'. 841* 842 CALL ZLAQGB( N, N, KL, KU, A, LDA, S, 843 $ S( N+1 ), ROWCND, COLCND, AMAX, EQUED ) 844 END IF 845* 846* Solve the system and compute the condition number 847* and error bounds using ZGBSVXX. 848* 849 SRNAMT = 'ZGBSVXX' 850 N_ERR_BNDS = 3 851 CALL ZGBSVXX( FACT, TRANS, N, KL, KU, NRHS, A, LDA, 852 $ AFB, LDAFB, IWORK, EQUED, S, S( N+1 ), B, LDB, 853 $ X, LDB, RCOND, RPVGRW_SVXX, BERR, N_ERR_BNDS, 854 $ ERRBNDS_N, ERRBNDS_C, 0, ZERO, WORK, 855 $ RWORK, INFO ) 856* 857* Check the error code from ZGBSVXX. 858* 859 IF( INFO.EQ.N+1 ) GOTO 90 860 IF( INFO.NE.IZERO ) THEN 861 CALL ALAERH( PATH, 'ZGBSVXX', INFO, IZERO, 862 $ FACT // TRANS, N, N, -1, -1, NRHS, 863 $ IMAT, NFAIL, NERRS, NOUT ) 864 GOTO 90 865 END IF 866* 867* Compare rpvgrw_svxx from ZGESVXX with the computed 868* reciprocal pivot growth factor RPVGRW 869* 870 871 IF ( INFO .GT. 0 .AND. INFO .LT. N+1 ) THEN 872 RPVGRW = ZLA_GBRPVGRW(N, KL, KU, INFO, A, LDA, 873 $ AFB, LDAFB) 874 ELSE 875 RPVGRW = ZLA_GBRPVGRW(N, KL, KU, N, A, LDA, 876 $ AFB, LDAFB) 877 ENDIF 878 879 RESULT( 7 ) = ABS( RPVGRW-rpvgrw_svxx ) / 880 $ MAX( rpvgrw_svxx, RPVGRW ) / 881 $ DLAMCH( 'E' ) 882* 883 IF( .NOT.PREFAC ) THEN 884* 885* Reconstruct matrix from factors and compute 886* residual. 887* 888 CALL ZGBT01( N, N, KL, KU, A, LDA, AFB, LDAFB, 889 $ IWORK, WORK( 2*NRHS+1 ), RESULT( 1 ) ) 890 K1 = 1 891 ELSE 892 K1 = 2 893 END IF 894* 895 IF( INFO.EQ.0 ) THEN 896 TRFCON = .FALSE. 897* 898* Compute residual of the computed solution. 899* 900 CALL ZLACPY( 'Full', N, NRHS, BSAV, LDB, WORK, 901 $ LDB ) 902 CALL ZGBT02( TRANS, N, N, KL, KU, NRHS, ASAV, 903 $ LDA, X, LDB, WORK, LDB, RESULT( 2 ) ) 904* 905* Check solution from generated exact solution. 906* 907 IF( NOFACT .OR. ( PREFAC .AND. LSAME( EQUED, 908 $ 'N' ) ) ) THEN 909 CALL ZGET04( N, NRHS, X, LDB, XACT, LDB, 910 $ RCONDC, RESULT( 3 ) ) 911 ELSE 912 IF( ITRAN.EQ.1 ) THEN 913 ROLDC = ROLDO 914 ELSE 915 ROLDC = ROLDI 916 END IF 917 CALL ZGET04( N, NRHS, X, LDB, XACT, LDB, 918 $ ROLDC, RESULT( 3 ) ) 919 END IF 920 ELSE 921 TRFCON = .TRUE. 922 END IF 923* 924* Compare RCOND from ZGBSVXX with the computed value 925* in RCONDC. 926* 927 RESULT( 6 ) = DGET06( RCOND, RCONDC ) 928* 929* Print information about the tests that did not pass 930* the threshold. 931* 932 IF( .NOT.TRFCON ) THEN 933 DO 45 K = K1, NTESTS 934 IF( RESULT( K ).GE.THRESH ) THEN 935 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 936 $ CALL ALADHD( NOUT, PATH ) 937 IF( PREFAC ) THEN 938 WRITE( NOUT, FMT = 9995 )'ZGBSVXX', 939 $ FACT, TRANS, N, KL, KU, EQUED, 940 $ IMAT, K, RESULT( K ) 941 ELSE 942 WRITE( NOUT, FMT = 9996 )'ZGBSVXX', 943 $ FACT, TRANS, N, KL, KU, IMAT, K, 944 $ RESULT( K ) 945 END IF 946 NFAIL = NFAIL + 1 947 END IF 948 45 CONTINUE 949 NRUN = NRUN + 7 - K1 950 ELSE 951 IF( RESULT( 1 ).GE.THRESH .AND. .NOT.PREFAC ) 952 $ THEN 953 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 954 $ CALL ALADHD( NOUT, PATH ) 955 IF( PREFAC ) THEN 956 WRITE( NOUT, FMT = 9995 )'ZGBSVXX', FACT, 957 $ TRANS, N, KL, KU, EQUED, IMAT, 1, 958 $ RESULT( 1 ) 959 ELSE 960 WRITE( NOUT, FMT = 9996 )'ZGBSVXX', FACT, 961 $ TRANS, N, KL, KU, IMAT, 1, 962 $ RESULT( 1 ) 963 END IF 964 NFAIL = NFAIL + 1 965 NRUN = NRUN + 1 966 END IF 967 IF( RESULT( 6 ).GE.THRESH ) THEN 968 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 969 $ CALL ALADHD( NOUT, PATH ) 970 IF( PREFAC ) THEN 971 WRITE( NOUT, FMT = 9995 )'ZGBSVXX', FACT, 972 $ TRANS, N, KL, KU, EQUED, IMAT, 6, 973 $ RESULT( 6 ) 974 ELSE 975 WRITE( NOUT, FMT = 9996 )'ZGBSVXX', FACT, 976 $ TRANS, N, KL, KU, IMAT, 6, 977 $ RESULT( 6 ) 978 END IF 979 NFAIL = NFAIL + 1 980 NRUN = NRUN + 1 981 END IF 982 IF( RESULT( 7 ).GE.THRESH ) THEN 983 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 984 $ CALL ALADHD( NOUT, PATH ) 985 IF( PREFAC ) THEN 986 WRITE( NOUT, FMT = 9995 )'ZGBSVXX', FACT, 987 $ TRANS, N, KL, KU, EQUED, IMAT, 7, 988 $ RESULT( 7 ) 989 ELSE 990 WRITE( NOUT, FMT = 9996 )'ZGBSVXX', FACT, 991 $ TRANS, N, KL, KU, IMAT, 7, 992 $ RESULT( 7 ) 993 END IF 994 NFAIL = NFAIL + 1 995 NRUN = NRUN + 1 996 END IF 997* 998 END IF 999* 1000 90 CONTINUE 1001 100 CONTINUE 1002 110 CONTINUE 1003 120 CONTINUE 1004 130 CONTINUE 1005 140 CONTINUE 1006 150 CONTINUE 1007* 1008* Print a summary of the results. 1009* 1010 CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS ) 1011* 1012 1013* Test Error Bounds from ZGBSVXX 1014 1015 CALL ZEBCHVXX(THRESH, PATH) 1016 1017 9999 FORMAT( ' *** In ZDRVGB, LA=', I5, ' is too small for N=', I5, 1018 $ ', KU=', I5, ', KL=', I5, / ' ==> Increase LA to at least ', 1019 $ I5 ) 1020 9998 FORMAT( ' *** In ZDRVGB, LAFB=', I5, ' is too small for N=', I5, 1021 $ ', KU=', I5, ', KL=', I5, / 1022 $ ' ==> Increase LAFB to at least ', I5 ) 1023 9997 FORMAT( 1X, A, ', N=', I5, ', KL=', I5, ', KU=', I5, ', type ', 1024 $ I1, ', test(', I1, ')=', G12.5 ) 1025 9996 FORMAT( 1X, A, '( ''', A1, ''',''', A1, ''',', I5, ',', I5, ',', 1026 $ I5, ',...), type ', I1, ', test(', I1, ')=', G12.5 ) 1027 9995 FORMAT( 1X, A, '( ''', A1, ''',''', A1, ''',', I5, ',', I5, ',', 1028 $ I5, ',...), EQUED=''', A1, ''', type ', I1, ', test(', I1, 1029 $ ')=', G12.5 ) 1030* 1031 RETURN 1032* 1033* End of ZDRVGB 1034* 1035 END 1036