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