LAPACK: TESTING/LIN/dchkgb.f Source File

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