TESTING/LIN/zdrvgb.f

   1 *> \brief \b ZDRVGB
   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 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 DOUBLE PRECISION
  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*16 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*16 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*16 array, dimension (LA)
 108 *> \endverbatim
 109 *>
 110 *> \param[out] B
 111 *> \verbatim
 112 *>          B is COMPLEX*16 array, dimension (NMAX*NRHS)
 113 *> \endverbatim
 114 *>
 115 *> \param[out] BSAV
 116 *> \verbatim
 117 *>          BSAV is COMPLEX*16 array, dimension (NMAX*NRHS)
 118 *> \endverbatim
 119 *>
 120 *> \param[out] X
 121 *> \verbatim
 122 *>          X is COMPLEX*16 array, dimension (NMAX*NRHS)
 123 *> \endverbatim
 124 *>
 125 *> \param[out] XACT
 126 *> \verbatim
 127 *>          XACT is COMPLEX*16 array, dimension (NMAX*NRHS)
 128 *> \endverbatim
 129 *>
 130 *> \param[out] S
 131 *> \verbatim
 132 *>          S is DOUBLE PRECISION array, dimension (2*NMAX)
 133 *> \endverbatim
 134 *>
 135 *> \param[out] WORK
 136 *> \verbatim
 137 *>          WORK is COMPLEX*16 array, dimension
 138 *>                      (NMAX*max(3,NRHS,NMAX))
 139 *> \endverbatim
 140 *>
 141 *> \param[out] RWORK
 142 *> \verbatim
 143 *>          RWORK is DOUBLE PRECISION 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 2015
 167 *
 168 *> \ingroup complex16_lin
 169 *
 170 *  =====================================================================
 171       SUBROUTINE ZDRVGB( 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.6.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 2015
 179 *
 180 *     .. Scalar Arguments ..
 181       LOGICAL            TSTERR
 182       INTEGER            LA, LAFB, NN, NOUT, NRHS
 183       DOUBLE PRECISION   THRESH
 184 *     ..
 185 *     .. Array Arguments ..
 186       LOGICAL            DOTYPE( * )
 187       INTEGER            IWORK( * ), NVAL( * )
 188       DOUBLE PRECISION   RWORK( * ), S( * )
 189       COMPLEX*16         A( * ), AFB( * ), ASAV( * ), B( * ), BSAV( * ),
 190      $                   WORK( * ), X( * ), XACT( * )
 191 *     ..
 192 *
 193 *  =====================================================================
 194 *
 195 *     .. Parameters ..
 196       DOUBLE PRECISION   ONE, ZERO
 197       PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+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       DOUBLE PRECISION   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       DOUBLE PRECISION   RDUM( 1 ), RESULT( NTESTS )
 221 *     ..
 222 *     .. External Functions ..
 223       LOGICAL            LSAME
 224       DOUBLE PRECISION   DGET06, DLAMCH, ZLANGB, ZLANGE, ZLANTB
 225       EXTERNAL           LSAME, DGET06, DLAMCH, ZLANGB, ZLANGE, ZLANTB
 226 *     ..
 227 *     .. External Subroutines ..
 228       EXTERNAL           ALADHD, ALAERH, ALASVM, XLAENV, ZERRVX, ZGBEQU,
 229      $                   ZGBSV, ZGBSVX, ZGBT01, ZGBT02, ZGBT05, ZGBTRF,
 230      $                   ZGBTRS, ZGET04, ZLACPY, ZLAQGB, ZLARHS, ZLASET,
 231      $                   ZLATB4, ZLATMS
 232 *     ..
 233 *     .. Intrinsic Functions ..
 234       INTRINSIC          ABS, DCMPLX, 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 ) = 'Zomplex 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 ZERRVX( 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 ZLATB4 and generate a
 359 *                 test matrix with ZLATMS.
 360 *
 361                   CALL ZLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM,
 362      $                         MODE, CNDNUM, DIST )
 363                   RCONDC = ONE / CNDNUM
 364 *
 365                   SRNAMT = 'ZLATMS'
 366                   CALL ZLATMS( 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 ZLATMS.
 371 *
 372                   IF( INFO.NE.0 ) THEN
 373                      CALL ALAERH( PATH, 'ZLATMS', 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 ZLACPY( '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 DGESVX (FACT =
 436 *                          'N' reuses the condition number from the
 437 *                          previous iteration with FACT = 'F').
 438 *
 439                            CALL ZLACPY( '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 ZGBEQU( 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 ZLAQGB( 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 ZGET04.
 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 = ZLANGB( '1', N, KL, KU, AFB( KL+1 ),
 481      $                              LDAFB, RWORK )
 482                            ANORMI = ZLANGB( 'I', N, KL, KU, AFB( KL+1 ),
 483      $                              LDAFB, RWORK )
 484 *
 485 *                          Factor the matrix A.
 486 *
 487                            CALL ZGBTRF( N, N, KL, KU, AFB, LDAFB, IWORK,
 488      $                                  INFO )
 489 *
 490 *                          Form the inverse of A.
 491 *
 492                            CALL ZLASET( 'Full', N, N, DCMPLX( ZERO ),
 493      $                                  DCMPLX( ONE ), WORK, LDB )
 494                            SRNAMT = 'ZGBTRS'
 495                            CALL ZGBTRS( '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 = ZLANGE( '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 = ZLANGE( '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 ZLACPY( '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 = 'ZLARHS'
 541                            CALL ZLARHS( PATH, XTYPE, 'Full', TRANS, N,
 542      $                                  N, KL, KU, NRHS, A, LDA, XACT,
 543      $                                  LDB, B, LDB, ISEED, INFO )
 544                            XTYPE = 'C'
 545                            CALL ZLACPY( 'Full', N, NRHS, B, LDB, BSAV,
 546      $                                  LDB )
 547 *
 548                            IF( NOFACT .AND. ITRAN.EQ.1 ) THEN
 549 *
 550 *                             --- Test ZGBSV  ---
 551 *
 552 *                             Compute the LU factorization of the matrix
 553 *                             and solve the system.
 554 *
 555                               CALL ZLACPY( 'Full', KL+KU+1, N, A, LDA,
 556      $                                     AFB( KL+1 ), LDAFB )
 557                               CALL ZLACPY( 'Full', N, NRHS, B, LDB, X,
 558      $                                     LDB )
 559 *
 560                               SRNAMT = 'ZGBSV '
 561                               CALL ZGBSV( N, KL, KU, NRHS, AFB, LDAFB,
 562      $                                    IWORK, X, LDB, INFO )
 563 *
 564 *                             Check error code from ZGBSV .
 565 *
 566                               IF( INFO.NE.IZERO )
 567      $                           CALL ALAERH( PATH, 'ZGBSV ', 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 ZGBT01( 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 ZLACPY( 'Full', N, NRHS, B, LDB,
 585      $                                        WORK, LDB )
 586                                  CALL ZGBT02( '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 ZGET04( 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 )'ZGBSV ',
 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 ZGBSVX ---
 614 *
 615                            IF( .NOT.PREFAC )
 616      $                        CALL ZLASET( 'Full', 2*KL+KU+1, N,
 617      $                                     DCMPLX( ZERO ),
 618      $                                     DCMPLX( ZERO ), AFB, LDAFB )
 619                            CALL ZLASET( 'Full', N, NRHS, DCMPLX( ZERO ),
 620      $                                  DCMPLX( 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 ZLAQGB( 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 ZGBSVX.
 633 *
 634                            SRNAMT = 'ZGBSVX'
 635                            CALL ZGBSVX( 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 ZGBSVX.
 642 *
 643                            IF( INFO.NE.IZERO )
 644      $                        CALL ALAERH( PATH, 'ZGBSVX', INFO, IZERO,
 645      $                                     FACT // TRANS, N, N, KL, KU,
 646      $                                     NRHS, IMAT, NFAIL, NERRS,
 647      $                                     NOUT )
 648 *                          Compare RWORK(2*NRHS+1) from ZGBSVX 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 = ZLANTB( '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 = ZLANTB( 'M', 'U', 'N', N, KL+KU,
 671      $                                 AFB, LDAFB, RDUM )
 672                               IF( RPVGRW.EQ.ZERO ) THEN
 673                                  RPVGRW = ONE
 674                               ELSE
 675                                  RPVGRW = ZLANGB( '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 ) / DLAMCH( 'E' )
 682 *
 683                            IF( .NOT.PREFAC ) THEN
 684 *
 685 *                             Reconstruct matrix from factors and
 686 *                             compute residual.
 687 *
 688                               CALL ZGBT01( 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 ZLACPY( 'Full', N, NRHS, BSAV, LDB,
 702      $                                     WORK, LDB )
 703                               CALL ZGBT02( 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 ZGET04( 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 ZGET04( 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 ZGBT05( 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 ZGBSVX with the computed
 736 *                          value in RCONDC.
 737 *
 738                            RESULT( 6 ) = DGET06( 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      $                                    'ZGBSVX', FACT, TRANS, N, KL,
 751      $                                    KU, EQUED, IMAT, K,
 752      $                                    RESULT( K )
 753                                     ELSE
 754                                        WRITE( NOUT, FMT = 9996 )
 755      $                                    'ZGBSVX', 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 + NTESTS - K1 + 1
 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 )'ZGBSVX',
 769      $                                 FACT, TRANS, N, KL, KU, EQUED,
 770      $                                 IMAT, 1, RESULT( 1 )
 771                                  ELSE
 772                                     WRITE( NOUT, FMT = 9996 )'ZGBSVX',
 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 )'ZGBSVX',
 784      $                                 FACT, TRANS, N, KL, KU, EQUED,
 785      $                                 IMAT, 6, RESULT( 6 )
 786                                  ELSE
 787                                     WRITE( NOUT, FMT = 9996 )'ZGBSVX',
 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 )'ZGBSVX',
 799      $                                 FACT, TRANS, N, KL, KU, EQUED,
 800      $                                 IMAT, 7, RESULT( 7 )
 801                                  ELSE
 802                                     WRITE( NOUT, FMT = 9996 )'ZGBSVX',
 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 ZDRVGB, LA=', I5, ' is too small for N=', I5,
 823      $      ', KU=', I5, ', KL=', I5, / ' ==> Increase LA to at least ',
 824      $      I5 )
 825  9998 FORMAT( ' *** In ZDRVGB, 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 ZDRVGB
 839 *
 840       END