LAPACK: TESTING/LIN/zchkgb.f Source File

Go to the documentation of this file.
00001       SUBROUTINE ZCHKGB( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NNS,
00002      $                   NSVAL, THRESH, TSTERR, A, LA, AFAC, LAFAC, B,
00003      $                   X, XACT, WORK, RWORK, IWORK, NOUT )
00004 *
00005 *  -- LAPACK test routine (version 3.1) --
00006 *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
00007 *     November 2006
00008 *
00009 *     .. Scalar Arguments ..
00010       LOGICAL            TSTERR
00011       INTEGER            LA, LAFAC, NM, NN, NNB, NNS, NOUT
00012       DOUBLE PRECISION   THRESH
00013 *     ..
00014 *     .. Array Arguments ..
00015       LOGICAL            DOTYPE( * )
00016       INTEGER            IWORK( * ), MVAL( * ), NBVAL( * ), NSVAL( * ),
00017      $                   NVAL( * )
00018       DOUBLE PRECISION   RWORK( * )
00019       COMPLEX*16         A( * ), AFAC( * ), B( * ), WORK( * ), X( * ),
00020      $                   XACT( * )
00021 *     ..
00022 *
00023 *  Purpose
00024 *  =======
00025 *
00026 *  ZCHKGB tests ZGBTRF, -TRS, -RFS, and -CON
00027 *
00028 *  Arguments
00029 *  =========
00030 *
00031 *  DOTYPE  (input) LOGICAL array, dimension (NTYPES)
00032 *          The matrix types to be used for testing.  Matrices of type j
00033 *          (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
00034 *          .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
00035 *
00036 *  NM      (input) INTEGER
00037 *          The number of values of M contained in the vector MVAL.
00038 *
00039 *  MVAL    (input) INTEGER array, dimension (NM)
00040 *          The values of the matrix row dimension M.
00041 *
00042 *  NN      (input) INTEGER
00043 *          The number of values of N contained in the vector NVAL.
00044 *
00045 *  NVAL    (input) INTEGER array, dimension (NN)
00046 *          The values of the matrix column dimension N.
00047 *
00048 *  NNB     (input) INTEGER
00049 *          The number of values of NB contained in the vector NBVAL.
00050 *
00051 *  NBVAL   (input) INTEGER array, dimension (NBVAL)
00052 *          The values of the blocksize NB.
00053 *
00054 *  NNS     (input) INTEGER
00055 *          The number of values of NRHS contained in the vector NSVAL.
00056 *
00057 *  NSVAL   (input) INTEGER array, dimension (NNS)
00058 *          The values of the number of right hand sides NRHS.
00059 *
00060 *  THRESH  (input) DOUBLE PRECISION
00061 *          The threshold value for the test ratios.  A result is
00062 *          included in the output file if RESULT >= THRESH.  To have
00063 *          every test ratio printed, use THRESH = 0.
00064 *
00065 *  TSTERR  (input) LOGICAL
00066 *          Flag that indicates whether error exits are to be tested.
00067 *
00068 *  A       (workspace) COMPLEX*16 array, dimension (LA)
00069 *
00070 *  LA      (input) INTEGER
00071 *          The length of the array A.  LA >= (KLMAX+KUMAX+1)*NMAX
00072 *          where KLMAX is the largest entry in the local array KLVAL,
00073 *                KUMAX is the largest entry in the local array KUVAL and
00074 *                NMAX is the largest entry in the input array NVAL.
00075 *
00076 *  AFAC    (workspace) COMPLEX*16 array, dimension (LAFAC)
00077 *
00078 *  LAFAC   (input) INTEGER
00079 *          The length of the array AFAC. LAFAC >= (2*KLMAX+KUMAX+1)*NMAX
00080 *          where KLMAX is the largest entry in the local array KLVAL,
00081 *                KUMAX is the largest entry in the local array KUVAL and
00082 *                NMAX is the largest entry in the input array NVAL.
00083 *
00084 *  B       (workspace) COMPLEX*16 array, dimension (NMAX*NSMAX)
00085 *
00086 *  X       (workspace) COMPLEX*16 array, dimension (NMAX*NSMAX)
00087 *
00088 *  XACT    (workspace) COMPLEX*16 array, dimension (NMAX*NSMAX)
00089 *
00090 *  WORK    (workspace) COMPLEX*16 array, dimension
00091 *                      (NMAX*max(3,NSMAX,NMAX))
00092 *
00093 *  RWORK   (workspace) DOUBLE PRECISION array, dimension
00094 *                      (max(NMAX,2*NSMAX))
00095 *
00096 *  IWORK   (workspace) INTEGER array, dimension (NMAX)
00097 *
00098 *  NOUT    (input) INTEGER
00099 *          The unit number for output.
00100 *
00101 *  =====================================================================
00102 *
00103 *     .. Parameters ..
00104       DOUBLE PRECISION   ONE, ZERO
00105       PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
00106       INTEGER            NTYPES, NTESTS
00107       PARAMETER          ( NTYPES = 8, NTESTS = 7 )
00108       INTEGER            NBW, NTRAN
00109       PARAMETER          ( NBW = 4, NTRAN = 3 )
00110 *     ..
00111 *     .. Local Scalars ..
00112       LOGICAL            TRFCON, ZEROT
00113       CHARACTER          DIST, NORM, TRANS, TYPE, XTYPE
00114       CHARACTER*3        PATH
00115       INTEGER            I, I1, I2, IKL, IKU, IM, IMAT, IN, INB, INFO,
00116      $                   IOFF, IRHS, ITRAN, IZERO, J, K, KL, KOFF, KU,
00117      $                   LDA, LDAFAC, LDB, M, MODE, N, NB, NERRS, NFAIL,
00118      $                   NIMAT, NKL, NKU, NRHS, NRUN
00119       DOUBLE PRECISION   AINVNM, ANORM, ANORMI, ANORMO, CNDNUM, RCOND,
00120      $                   RCONDC, RCONDI, RCONDO
00121 *     ..
00122 *     .. Local Arrays ..
00123       CHARACTER          TRANSS( NTRAN )
00124       INTEGER            ISEED( 4 ), ISEEDY( 4 ), KLVAL( NBW ),
00125      $                   KUVAL( NBW )
00126       DOUBLE PRECISION   RESULT( NTESTS )
00127 *     ..
00128 *     .. External Functions ..
00129       DOUBLE PRECISION   DGET06, ZLANGB, ZLANGE
00130       EXTERNAL           DGET06, ZLANGB, ZLANGE
00131 *     ..
00132 *     .. External Subroutines ..
00133       EXTERNAL           ALAERH, ALAHD, ALASUM, XLAENV, ZCOPY, ZERRGE,
00134      $                   ZGBCON, ZGBRFS, ZGBT01, ZGBT02, ZGBT05, ZGBTRF,
00135      $                   ZGBTRS, ZGET04, ZLACPY, ZLARHS, ZLASET, ZLATB4,
00136      $                   ZLATMS
00137 *     ..
00138 *     .. Intrinsic Functions ..
00139       INTRINSIC          DCMPLX, MAX, MIN
00140 *     ..
00141 *     .. Scalars in Common ..
00142       LOGICAL            LERR, OK
00143       CHARACTER*32       SRNAMT
00144       INTEGER            INFOT, NUNIT
00145 *     ..
00146 *     .. Common blocks ..
00147       COMMON             / INFOC / INFOT, NUNIT, OK, LERR
00148       COMMON             / SRNAMC / SRNAMT
00149 *     ..
00150 *     .. Data statements ..
00151       DATA               ISEEDY / 1988, 1989, 1990, 1991 / ,
00152      $                   TRANSS / 'N', 'T', 'C' /
00153 *     ..
00154 *     .. Executable Statements ..
00155 *
00156 *     Initialize constants and the random number seed.
00157 *
00158       PATH( 1: 1 ) = 'Zomplex precision'
00159       PATH( 2: 3 ) = 'GB'
00160       NRUN = 0
00161       NFAIL = 0
00162       NERRS = 0
00163       DO 10 I = 1, 4
00164          ISEED( I ) = ISEEDY( I )
00165    10 CONTINUE
00166 *
00167 *     Test the error exits
00168 *
00169       IF( TSTERR )
00170      $   CALL ZERRGE( PATH, NOUT )
00171       INFOT = 0
00172 *
00173 *     Initialize the first value for the lower and upper bandwidths.
00174 *
00175       KLVAL( 1 ) = 0
00176       KUVAL( 1 ) = 0
00177 *
00178 *     Do for each value of M in MVAL
00179 *
00180       DO 160 IM = 1, NM
00181          M = MVAL( IM )
00182 *
00183 *        Set values to use for the lower bandwidth.
00184 *
00185          KLVAL( 2 ) = M + ( M+1 ) / 4
00186 *
00187 *        KLVAL( 2 ) = MAX( M-1, 0 )
00188 *
00189          KLVAL( 3 ) = ( 3*M-1 ) / 4
00190          KLVAL( 4 ) = ( M+1 ) / 4
00191 *
00192 *        Do for each value of N in NVAL
00193 *
00194          DO 150 IN = 1, NN
00195             N = NVAL( IN )
00196             XTYPE = 'N'
00197 *
00198 *           Set values to use for the upper bandwidth.
00199 *
00200             KUVAL( 2 ) = N + ( N+1 ) / 4
00201 *
00202 *           KUVAL( 2 ) = MAX( N-1, 0 )
00203 *
00204             KUVAL( 3 ) = ( 3*N-1 ) / 4
00205             KUVAL( 4 ) = ( N+1 ) / 4
00206 *
00207 *           Set limits on the number of loop iterations.
00208 *
00209             NKL = MIN( M+1, 4 )
00210             IF( N.EQ.0 )
00211      $         NKL = 2
00212             NKU = MIN( N+1, 4 )
00213             IF( M.EQ.0 )
00214      $         NKU = 2
00215             NIMAT = NTYPES
00216             IF( M.LE.0 .OR. N.LE.0 )
00217      $         NIMAT = 1
00218 *
00219             DO 140 IKL = 1, NKL
00220 *
00221 *              Do for KL = 0, (5*M+1)/4, (3M-1)/4, and (M+1)/4. This
00222 *              order makes it easier to skip redundant values for small
00223 *              values of M.
00224 *
00225                KL = KLVAL( IKL )
00226                DO 130 IKU = 1, NKU
00227 *
00228 *                 Do for KU = 0, (5*N+1)/4, (3N-1)/4, and (N+1)/4. This
00229 *                 order makes it easier to skip redundant values for
00230 *                 small values of N.
00231 *
00232                   KU = KUVAL( IKU )
00233 *
00234 *                 Check that A and AFAC are big enough to generate this
00235 *                 matrix.
00236 *
00237                   LDA = KL + KU + 1
00238                   LDAFAC = 2*KL + KU + 1
00239                   IF( ( LDA*N ).GT.LA .OR. ( LDAFAC*N ).GT.LAFAC ) THEN
00240                      IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00241      $                  CALL ALAHD( NOUT, PATH )
00242                      IF( N*( KL+KU+1 ).GT.LA ) THEN
00243                         WRITE( NOUT, FMT = 9999 )LA, M, N, KL, KU,
00244      $                     N*( KL+KU+1 )
00245                         NERRS = NERRS + 1
00246                      END IF
00247                      IF( N*( 2*KL+KU+1 ).GT.LAFAC ) THEN
00248                         WRITE( NOUT, FMT = 9998 )LAFAC, M, N, KL, KU,
00249      $                     N*( 2*KL+KU+1 )
00250                         NERRS = NERRS + 1
00251                      END IF
00252                      GO TO 130
00253                   END IF
00254 *
00255                   DO 120 IMAT = 1, NIMAT
00256 *
00257 *                    Do the tests only if DOTYPE( IMAT ) is true.
00258 *
00259                      IF( .NOT.DOTYPE( IMAT ) )
00260      $                  GO TO 120
00261 *
00262 *                    Skip types 2, 3, or 4 if the matrix size is too
00263 *                    small.
00264 *
00265                      ZEROT = IMAT.GE.2 .AND. IMAT.LE.4
00266                      IF( ZEROT .AND. N.LT.IMAT-1 )
00267      $                  GO TO 120
00268 *
00269                      IF( .NOT.ZEROT .OR. .NOT.DOTYPE( 1 ) ) THEN
00270 *
00271 *                       Set up parameters with ZLATB4 and generate a
00272 *                       test matrix with ZLATMS.
00273 *
00274                         CALL ZLATB4( PATH, IMAT, M, N, TYPE, KL, KU,
00275      $                               ANORM, MODE, CNDNUM, DIST )
00276 *
00277                         KOFF = MAX( 1, KU+2-N )
00278                         DO 20 I = 1, KOFF - 1
00279                            A( I ) = ZERO
00280    20                   CONTINUE
00281                         SRNAMT = 'ZLATMS'
00282                         CALL ZLATMS( M, N, DIST, ISEED, TYPE, RWORK,
00283      $                               MODE, CNDNUM, ANORM, KL, KU, 'Z',
00284      $                               A( KOFF ), LDA, WORK, INFO )
00285 *
00286 *                       Check the error code from ZLATMS.
00287 *
00288                         IF( INFO.NE.0 ) THEN
00289                            CALL ALAERH( PATH, 'ZLATMS', INFO, 0, ' ', M,
00290      $                                  N, KL, KU, -1, IMAT, NFAIL,
00291      $                                  NERRS, NOUT )
00292                            GO TO 120
00293                         END IF
00294                      ELSE IF( IZERO.GT.0 ) THEN
00295 *
00296 *                       Use the same matrix for types 3 and 4 as for
00297 *                       type 2 by copying back the zeroed out column.
00298 *
00299                         CALL ZCOPY( I2-I1+1, B, 1, A( IOFF+I1 ), 1 )
00300                      END IF
00301 *
00302 *                    For types 2, 3, and 4, zero one or more columns of
00303 *                    the matrix to test that INFO is returned correctly.
00304 *
00305                      IZERO = 0
00306                      IF( ZEROT ) THEN
00307                         IF( IMAT.EQ.2 ) THEN
00308                            IZERO = 1
00309                         ELSE IF( IMAT.EQ.3 ) THEN
00310                            IZERO = MIN( M, N )
00311                         ELSE
00312                            IZERO = MIN( M, N ) / 2 + 1
00313                         END IF
00314                         IOFF = ( IZERO-1 )*LDA
00315                         IF( IMAT.LT.4 ) THEN
00316 *
00317 *                          Store the column to be zeroed out in B.
00318 *
00319                            I1 = MAX( 1, KU+2-IZERO )
00320                            I2 = MIN( KL+KU+1, KU+1+( M-IZERO ) )
00321                            CALL ZCOPY( I2-I1+1, A( IOFF+I1 ), 1, B, 1 )
00322 *
00323                            DO 30 I = I1, I2
00324                               A( IOFF+I ) = ZERO
00325    30                      CONTINUE
00326                         ELSE
00327                            DO 50 J = IZERO, N
00328                               DO 40 I = MAX( 1, KU+2-J ),
00329      $                                MIN( KL+KU+1, KU+1+( M-J ) )
00330                                  A( IOFF+I ) = ZERO
00331    40                         CONTINUE
00332                               IOFF = IOFF + LDA
00333    50                      CONTINUE
00334                         END IF
00335                      END IF
00336 *
00337 *                    These lines, if used in place of the calls in the
00338 *                    loop over INB, cause the code to bomb on a Sun
00339 *                    SPARCstation.
00340 *
00341 *                     ANORMO = ZLANGB( 'O', N, KL, KU, A, LDA, RWORK )
00342 *                     ANORMI = ZLANGB( 'I', N, KL, KU, A, LDA, RWORK )
00343 *
00344 *                    Do for each blocksize in NBVAL
00345 *
00346                      DO 110 INB = 1, NNB
00347                         NB = NBVAL( INB )
00348                         CALL XLAENV( 1, NB )
00349 *
00350 *                       Compute the LU factorization of the band matrix.
00351 *
00352                         IF( M.GT.0 .AND. N.GT.0 )
00353      $                     CALL ZLACPY( 'Full', KL+KU+1, N, A, LDA,
00354      $                                  AFAC( KL+1 ), LDAFAC )
00355                         SRNAMT = 'ZGBTRF'
00356                         CALL ZGBTRF( M, N, KL, KU, AFAC, LDAFAC, IWORK,
00357      $                               INFO )
00358 *
00359 *                       Check error code from ZGBTRF.
00360 *
00361                         IF( INFO.NE.IZERO )
00362      $                     CALL ALAERH( PATH, 'ZGBTRF', INFO, IZERO,
00363      $                                  ' ', M, N, KL, KU, NB, IMAT,
00364      $                                  NFAIL, NERRS, NOUT )
00365                         TRFCON = .FALSE.
00366 *
00367 *+    TEST 1
00368 *                       Reconstruct matrix from factors and compute
00369 *                       residual.
00370 *
00371                         CALL ZGBT01( M, N, KL, KU, A, LDA, AFAC, LDAFAC,
00372      $                               IWORK, WORK, RESULT( 1 ) )
00373 *
00374 *                       Print information about the tests so far that
00375 *                       did not pass the threshold.
00376 *
00377                         IF( RESULT( 1 ).GE.THRESH ) THEN
00378                            IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00379      $                        CALL ALAHD( NOUT, PATH )
00380                            WRITE( NOUT, FMT = 9997 )M, N, KL, KU, NB,
00381      $                        IMAT, 1, RESULT( 1 )
00382                            NFAIL = NFAIL + 1
00383                         END IF
00384                         NRUN = NRUN + 1
00385 *
00386 *                       Skip the remaining tests if this is not the
00387 *                       first block size or if M .ne. N.
00388 *
00389                         IF( INB.GT.1 .OR. M.NE.N )
00390      $                     GO TO 110
00391 *
00392                         ANORMO = ZLANGB( 'O', N, KL, KU, A, LDA, RWORK )
00393                         ANORMI = ZLANGB( 'I', N, KL, KU, A, LDA, RWORK )
00394 *
00395                         IF( INFO.EQ.0 ) THEN
00396 *
00397 *                          Form the inverse of A so we can get a good
00398 *                          estimate of CNDNUM = norm(A) * norm(inv(A)).
00399 *
00400                            LDB = MAX( 1, N )
00401                            CALL ZLASET( 'Full', N, N, DCMPLX( ZERO ),
00402      $                                  DCMPLX( ONE ), WORK, LDB )
00403                            SRNAMT = 'ZGBTRS'
00404                            CALL ZGBTRS( 'No transpose', N, KL, KU, N,
00405      $                                  AFAC, LDAFAC, IWORK, WORK, LDB,
00406      $                                  INFO )
00407 *
00408 *                          Compute the 1-norm condition number of A.
00409 *
00410                            AINVNM = ZLANGE( 'O', N, N, WORK, LDB,
00411      $                              RWORK )
00412                            IF( ANORMO.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
00413                               RCONDO = ONE
00414                            ELSE
00415                               RCONDO = ( ONE / ANORMO ) / AINVNM
00416                            END IF
00417 *
00418 *                          Compute the infinity-norm condition number of
00419 *                          A.
00420 *
00421                            AINVNM = ZLANGE( 'I', N, N, WORK, LDB,
00422      $                              RWORK )
00423                            IF( ANORMI.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
00424                               RCONDI = ONE
00425                            ELSE
00426                               RCONDI = ( ONE / ANORMI ) / AINVNM
00427                            END IF
00428                         ELSE
00429 *
00430 *                          Do only the condition estimate if INFO.NE.0.
00431 *
00432                            TRFCON = .TRUE.
00433                            RCONDO = ZERO
00434                            RCONDI = ZERO
00435                         END IF
00436 *
00437 *                       Skip the solve tests if the matrix is singular.
00438 *
00439                         IF( TRFCON )
00440      $                     GO TO 90
00441 *
00442                         DO 80 IRHS = 1, NNS
00443                            NRHS = NSVAL( IRHS )
00444                            XTYPE = 'N'
00445 *
00446                            DO 70 ITRAN = 1, NTRAN
00447                               TRANS = TRANSS( ITRAN )
00448                               IF( ITRAN.EQ.1 ) THEN
00449                                  RCONDC = RCONDO
00450                                  NORM = 'O'
00451                               ELSE
00452                                  RCONDC = RCONDI
00453                                  NORM = 'I'
00454                               END IF
00455 *
00456 *+    TEST 2:
00457 *                             Solve and compute residual for A * X = B.
00458 *
00459                               SRNAMT = 'ZLARHS'
00460                               CALL ZLARHS( PATH, XTYPE, ' ', TRANS, N,
00461      $                                     N, KL, KU, NRHS, A, LDA,
00462      $                                     XACT, LDB, B, LDB, ISEED,
00463      $                                     INFO )
00464                               XTYPE = 'C'
00465                               CALL ZLACPY( 'Full', N, NRHS, B, LDB, X,
00466      $                                     LDB )
00467 *
00468                               SRNAMT = 'ZGBTRS'
00469                               CALL ZGBTRS( TRANS, N, KL, KU, NRHS, AFAC,
00470      $                                     LDAFAC, IWORK, X, LDB, INFO )
00471 *
00472 *                             Check error code from ZGBTRS.
00473 *
00474                               IF( INFO.NE.0 )
00475      $                           CALL ALAERH( PATH, 'ZGBTRS', INFO, 0,
00476      $                                        TRANS, N, N, KL, KU, -1,
00477      $                                        IMAT, NFAIL, NERRS, NOUT )
00478 *
00479                               CALL ZLACPY( 'Full', N, NRHS, B, LDB,
00480      $                                     WORK, LDB )
00481                               CALL ZGBT02( TRANS, M, N, KL, KU, NRHS, A,
00482      $                                     LDA, X, LDB, WORK, LDB,
00483      $                                     RESULT( 2 ) )
00484 *
00485 *+    TEST 3:
00486 *                             Check solution from generated exact
00487 *                             solution.
00488 *
00489                               CALL ZGET04( N, NRHS, X, LDB, XACT, LDB,
00490      $                                     RCONDC, RESULT( 3 ) )
00491 *
00492 *+    TESTS 4, 5, 6:
00493 *                             Use iterative refinement to improve the
00494 *                             solution.
00495 *
00496                               SRNAMT = 'ZGBRFS'
00497                               CALL ZGBRFS( TRANS, N, KL, KU, NRHS, A,
00498      $                                     LDA, AFAC, LDAFAC, IWORK, B,
00499      $                                     LDB, X, LDB, RWORK,
00500      $                                     RWORK( NRHS+1 ), WORK,
00501      $                                     RWORK( 2*NRHS+1 ), INFO )
00502 *
00503 *                             Check error code from ZGBRFS.
00504 *
00505                               IF( INFO.NE.0 )
00506      $                           CALL ALAERH( PATH, 'ZGBRFS', INFO, 0,
00507      $                                        TRANS, N, N, KL, KU, NRHS,
00508      $                                        IMAT, NFAIL, NERRS, NOUT )
00509 *
00510                               CALL ZGET04( N, NRHS, X, LDB, XACT, LDB,
00511      $                                     RCONDC, RESULT( 4 ) )
00512                               CALL ZGBT05( TRANS, N, KL, KU, NRHS, A,
00513      $                                     LDA, B, LDB, X, LDB, XACT,
00514      $                                     LDB, RWORK, RWORK( NRHS+1 ),
00515      $                                     RESULT( 5 ) )
00516 *
00517 *                             Print information about the tests that did
00518 *                             not pass the threshold.
00519 *
00520                               DO 60 K = 2, 6
00521                                  IF( RESULT( K ).GE.THRESH ) THEN
00522                                     IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00523      $                                 CALL ALAHD( NOUT, PATH )
00524                                     WRITE( NOUT, FMT = 9996 )TRANS, N,
00525      $                                 KL, KU, NRHS, IMAT, K,
00526      $                                 RESULT( K )
00527                                     NFAIL = NFAIL + 1
00528                                  END IF
00529    60                         CONTINUE
00530                               NRUN = NRUN + 5
00531    70                      CONTINUE
00532    80                   CONTINUE
00533 *
00534 *+    TEST 7:
00535 *                          Get an estimate of RCOND = 1/CNDNUM.
00536 *
00537    90                   CONTINUE
00538                         DO 100 ITRAN = 1, 2
00539                            IF( ITRAN.EQ.1 ) THEN
00540                               ANORM = ANORMO
00541                               RCONDC = RCONDO
00542                               NORM = 'O'
00543                            ELSE
00544                               ANORM = ANORMI
00545                               RCONDC = RCONDI
00546                               NORM = 'I'
00547                            END IF
00548                            SRNAMT = 'ZGBCON'
00549                            CALL ZGBCON( NORM, N, KL, KU, AFAC, LDAFAC,
00550      $                                  IWORK, ANORM, RCOND, WORK,
00551      $                                  RWORK, INFO )
00552 *
00553 *                             Check error code from ZGBCON.
00554 *
00555                            IF( INFO.NE.0 )
00556      $                        CALL ALAERH( PATH, 'ZGBCON', INFO, 0,
00557      $                                     NORM, N, N, KL, KU, -1, IMAT,
00558      $                                     NFAIL, NERRS, NOUT )
00559 *
00560                            RESULT( 7 ) = DGET06( RCOND, RCONDC )
00561 *
00562 *                          Print information about the tests that did
00563 *                          not pass the threshold.
00564 *
00565                            IF( RESULT( 7 ).GE.THRESH ) THEN
00566                               IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00567      $                           CALL ALAHD( NOUT, PATH )
00568                               WRITE( NOUT, FMT = 9995 )NORM, N, KL, KU,
00569      $                           IMAT, 7, RESULT( 7 )
00570                               NFAIL = NFAIL + 1
00571                            END IF
00572                            NRUN = NRUN + 1
00573   100                   CONTINUE
00574   110                CONTINUE
00575   120             CONTINUE
00576   130          CONTINUE
00577   140       CONTINUE
00578   150    CONTINUE
00579   160 CONTINUE
00580 *
00581 *     Print a summary of the results.
00582 *
00583       CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS )
00584 *
00585  9999 FORMAT( ' *** In ZCHKGB, LA=', I5, ' is too small for M=', I5,
00586      $      ', N=', I5, ', KL=', I4, ', KU=', I4,
00587      $      / ' ==> Increase LA to at least ', I5 )
00588  9998 FORMAT( ' *** In ZCHKGB, LAFAC=', I5, ' is too small for M=', I5,
00589      $      ', N=', I5, ', KL=', I4, ', KU=', I4,
00590      $      / ' ==> Increase LAFAC to at least ', I5 )
00591  9997 FORMAT( ' M =', I5, ', N =', I5, ', KL=', I5, ', KU=', I5,
00592      $      ', NB =', I4, ', type ', I1, ', test(', I1, ')=', G12.5 )
00593  9996 FORMAT( ' TRANS=''', A1, ''', N=', I5, ', KL=', I5, ', KU=', I5,
00594      $      ', NRHS=', I3, ', type ', I1, ', test(', I1, ')=', G12.5 )
00595  9995 FORMAT( ' NORM =''', A1, ''', N=', I5, ', KL=', I5, ', KU=', I5,
00596      $      ',', 10X, ' type ', I1, ', test(', I1, ')=', G12.5 )
00597 *
00598       RETURN
00599 *
00600 *     End of ZCHKGB
00601 *
00602       END