LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
cchkgb.f
Go to the documentation of this file.
00001 *> \brief \b CCHKGB
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 CCHKGB( 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               RWORK( * )
00025 *       COMPLEX            A( * ), AFAC( * ), B( * ), WORK( * ), X( * ),
00026 *      $                   XACT( * )
00027 *       ..
00028 *  
00029 *
00030 *> \par Purpose:
00031 *  =============
00032 *>
00033 *> \verbatim
00034 *>
00035 *> CCHKGB tests CGBTRF, -TRS, -RFS, and -CON
00036 *> \endverbatim
00037 *
00038 *  Arguments:
00039 *  ==========
00040 *
00041 *> \param[in] DOTYPE
00042 *> \verbatim
00043 *>          DOTYPE is LOGICAL array, dimension (NTYPES)
00044 *>          The matrix types to be used for testing.  Matrices of type j
00045 *>          (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
00046 *>          .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
00047 *> \endverbatim
00048 *>
00049 *> \param[in] NM
00050 *> \verbatim
00051 *>          NM is INTEGER
00052 *>          The number of values of M contained in the vector MVAL.
00053 *> \endverbatim
00054 *>
00055 *> \param[in] MVAL
00056 *> \verbatim
00057 *>          MVAL is INTEGER array, dimension (NM)
00058 *>          The values of the matrix row dimension M.
00059 *> \endverbatim
00060 *>
00061 *> \param[in] NN
00062 *> \verbatim
00063 *>          NN is INTEGER
00064 *>          The number of values of N contained in the vector NVAL.
00065 *> \endverbatim
00066 *>
00067 *> \param[in] NVAL
00068 *> \verbatim
00069 *>          NVAL is INTEGER array, dimension (NN)
00070 *>          The values of the matrix column dimension N.
00071 *> \endverbatim
00072 *>
00073 *> \param[in] NNB
00074 *> \verbatim
00075 *>          NNB is INTEGER
00076 *>          The number of values of NB contained in the vector NBVAL.
00077 *> \endverbatim
00078 *>
00079 *> \param[in] NBVAL
00080 *> \verbatim
00081 *>          NBVAL is INTEGER array, dimension (NNB)
00082 *>          The values of the blocksize NB.
00083 *> \endverbatim
00084 *>
00085 *> \param[in] NNS
00086 *> \verbatim
00087 *>          NNS is INTEGER
00088 *>          The number of values of NRHS contained in the vector NSVAL.
00089 *> \endverbatim
00090 *>
00091 *> \param[in] NSVAL
00092 *> \verbatim
00093 *>          NSVAL is INTEGER array, dimension (NNS)
00094 *>          The values of the number of right hand sides NRHS.
00095 *> \endverbatim
00096 *>
00097 *> \param[in] THRESH
00098 *> \verbatim
00099 *>          THRESH is REAL
00100 *>          The threshold value for the test ratios.  A result is
00101 *>          included in the output file if RESULT >= THRESH.  To have
00102 *>          every test ratio printed, use THRESH = 0.
00103 *> \endverbatim
00104 *>
00105 *> \param[in] TSTERR
00106 *> \verbatim
00107 *>          TSTERR is LOGICAL
00108 *>          Flag that indicates whether error exits are to be tested.
00109 *> \endverbatim
00110 *>
00111 *> \param[out] A
00112 *> \verbatim
00113 *>          A is COMPLEX array, dimension (LA)
00114 *> \endverbatim
00115 *>
00116 *> \param[in] LA
00117 *> \verbatim
00118 *>          LA is INTEGER
00119 *>          The length of the array A.  LA >= (KLMAX+KUMAX+1)*NMAX
00120 *>          where KLMAX is the largest entry in the local array KLVAL,
00121 *>                KUMAX is the largest entry in the local array KUVAL and
00122 *>                NMAX is the largest entry in the input array NVAL.
00123 *> \endverbatim
00124 *>
00125 *> \param[out] AFAC
00126 *> \verbatim
00127 *>          AFAC is COMPLEX array, dimension (LAFAC)
00128 *> \endverbatim
00129 *>
00130 *> \param[in] LAFAC
00131 *> \verbatim
00132 *>          LAFAC is INTEGER
00133 *>          The length of the array AFAC. LAFAC >= (2*KLMAX+KUMAX+1)*NMAX
00134 *>          where KLMAX is the largest entry in the local array KLVAL,
00135 *>                KUMAX is the largest entry in the local array KUVAL and
00136 *>                NMAX is the largest entry in the input array NVAL.
00137 *> \endverbatim
00138 *>
00139 *> \param[out] B
00140 *> \verbatim
00141 *>          B is COMPLEX array, dimension (NMAX*NSMAX)
00142 *> \endverbatim
00143 *>
00144 *> \param[out] X
00145 *> \verbatim
00146 *>          X is COMPLEX array, dimension (NMAX*NSMAX)
00147 *> \endverbatim
00148 *>
00149 *> \param[out] XACT
00150 *> \verbatim
00151 *>          XACT is COMPLEX array, dimension (NMAX*NSMAX)
00152 *> \endverbatim
00153 *>
00154 *> \param[out] WORK
00155 *> \verbatim
00156 *>          WORK is COMPLEX 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 (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 complex_lin
00188 *
00189 *  =====================================================================
00190       SUBROUTINE CCHKGB( 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               RWORK( * )
00209       COMPLEX            A( * ), AFAC( * ), B( * ), WORK( * ), X( * ),
00210      $                   XACT( * )
00211 *     ..
00212 *
00213 *  =====================================================================
00214 *
00215 *     .. Parameters ..
00216       REAL               ONE, ZERO
00217       PARAMETER          ( ONE = 1.0E+0, ZERO = 0.0E+0 )
00218       INTEGER            NTYPES, NTESTS
00219       PARAMETER          ( NTYPES = 8, NTESTS = 7 )
00220       INTEGER            NBW, NTRAN
00221       PARAMETER          ( NBW = 4, NTRAN = 3 )
00222 *     ..
00223 *     .. Local Scalars ..
00224       LOGICAL            TRFCON, ZEROT
00225       CHARACTER          DIST, NORM, TRANS, TYPE, XTYPE
00226       CHARACTER*3        PATH
00227       INTEGER            I, I1, I2, IKL, IKU, IM, IMAT, IN, INB, INFO,
00228      $                   IOFF, IRHS, ITRAN, IZERO, J, K, KL, KOFF, KU,
00229      $                   LDA, LDAFAC, LDB, M, MODE, N, NB, NERRS, NFAIL,
00230      $                   NIMAT, NKL, NKU, NRHS, NRUN
00231       REAL               AINVNM, ANORM, ANORMI, ANORMO, CNDNUM, RCOND,
00232      $                   RCONDC, RCONDI, RCONDO
00233 *     ..
00234 *     .. Local Arrays ..
00235       CHARACTER          TRANSS( NTRAN )
00236       INTEGER            ISEED( 4 ), ISEEDY( 4 ), KLVAL( NBW ),
00237      $                   KUVAL( NBW )
00238       REAL               RESULT( NTESTS )
00239 *     ..
00240 *     .. External Functions ..
00241       REAL               CLANGB, CLANGE, SGET06
00242       EXTERNAL           CLANGB, CLANGE, SGET06
00243 *     ..
00244 *     .. External Subroutines ..
00245       EXTERNAL           ALAERH, ALAHD, ALASUM, CCOPY, CERRGE, CGBCON,
00246      $                   CGBRFS, CGBT01, CGBT02, CGBT05, CGBTRF, CGBTRS,
00247      $                   CGET04, CLACPY, CLARHS, CLASET, CLATB4, CLATMS,
00248      $                   XLAENV
00249 *     ..
00250 *     .. Intrinsic Functions ..
00251       INTRINSIC          CMPLX, MAX, MIN
00252 *     ..
00253 *     .. Scalars in Common ..
00254       LOGICAL            LERR, OK
00255       CHARACTER*32       SRNAMT
00256       INTEGER            INFOT, NUNIT
00257 *     ..
00258 *     .. Common blocks ..
00259       COMMON             / INFOC / INFOT, NUNIT, OK, LERR
00260       COMMON             / SRNAMC / SRNAMT
00261 *     ..
00262 *     .. Data statements ..
00263       DATA               ISEEDY / 1988, 1989, 1990, 1991 / ,
00264      $                   TRANSS / 'N', 'T', 'C' /
00265 *     ..
00266 *     .. Executable Statements ..
00267 *
00268 *     Initialize constants and the random number seed.
00269 *
00270       PATH( 1: 1 ) = 'Complex precision'
00271       PATH( 2: 3 ) = 'GB'
00272       NRUN = 0
00273       NFAIL = 0
00274       NERRS = 0
00275       DO 10 I = 1, 4
00276          ISEED( I ) = ISEEDY( I )
00277    10 CONTINUE
00278 *
00279 *     Test the error exits
00280 *
00281       IF( TSTERR )
00282      $   CALL CERRGE( PATH, NOUT )
00283       INFOT = 0
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 CLATB4 and generate a
00384 *                       test matrix with CLATMS.
00385 *
00386                         CALL CLATB4( 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 = 'CLATMS'
00394                         CALL CLATMS( 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 CLATMS.
00399 *
00400                         IF( INFO.NE.0 ) THEN
00401                            CALL ALAERH( PATH, 'CLATMS', 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 CCOPY( 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 CCOPY( 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 = CLANGB( 'O', N, KL, KU, A, LDA, RWORK )
00454 *                     ANORMI = CLANGB( '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 CLACPY( 'Full', KL+KU+1, N, A, LDA,
00466      $                                  AFAC( KL+1 ), LDAFAC )
00467                         SRNAMT = 'CGBTRF'
00468                         CALL CGBTRF( M, N, KL, KU, AFAC, LDAFAC, IWORK,
00469      $                               INFO )
00470 *
00471 *                       Check error code from CGBTRF.
00472 *
00473                         IF( INFO.NE.IZERO )
00474      $                     CALL ALAERH( PATH, 'CGBTRF', 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 CGBT01( 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 = CLANGB( 'O', N, KL, KU, A, LDA, RWORK )
00505                         ANORMI = CLANGB( '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 CLASET( 'Full', N, N, CMPLX( ZERO ),
00514      $                                  CMPLX( ONE ), WORK, LDB )
00515                            SRNAMT = 'CGBTRS'
00516                            CALL CGBTRS( '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 = CLANGE( '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 = CLANGE( '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 = 'CLARHS'
00572                               CALL CLARHS( PATH, XTYPE, ' ', TRANS, N,
00573      $                                     N, KL, KU, NRHS, A, LDA,
00574      $                                     XACT, LDB, B, LDB, ISEED,
00575      $                                     INFO )
00576                               XTYPE = 'C'
00577                               CALL CLACPY( 'Full', N, NRHS, B, LDB, X,
00578      $                                     LDB )
00579 *
00580                               SRNAMT = 'CGBTRS'
00581                               CALL CGBTRS( TRANS, N, KL, KU, NRHS, AFAC,
00582      $                                     LDAFAC, IWORK, X, LDB, INFO )
00583 *
00584 *                             Check error code from CGBTRS.
00585 *
00586                               IF( INFO.NE.0 )
00587      $                           CALL ALAERH( PATH, 'CGBTRS', INFO, 0,
00588      $                                        TRANS, N, N, KL, KU, -1,
00589      $                                        IMAT, NFAIL, NERRS, NOUT )
00590 *
00591                               CALL CLACPY( 'Full', N, NRHS, B, LDB,
00592      $                                     WORK, LDB )
00593                               CALL CGBT02( 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 CGET04( 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 = 'CGBRFS'
00609                               CALL CGBRFS( TRANS, N, KL, KU, NRHS, A,
00610      $                                     LDA, AFAC, LDAFAC, IWORK, B,
00611      $                                     LDB, X, LDB, RWORK,
00612      $                                     RWORK( NRHS+1 ), WORK,
00613      $                                     RWORK( 2*NRHS+1 ), INFO )
00614 *
00615 *                             Check error code from CGBRFS.
00616 *
00617                               IF( INFO.NE.0 )
00618      $                           CALL ALAERH( PATH, 'CGBRFS', INFO, 0,
00619      $                                        TRANS, N, N, KL, KU, NRHS,
00620      $                                        IMAT, NFAIL, NERRS, NOUT )
00621 *
00622                               CALL CGET04( N, NRHS, X, LDB, XACT, LDB,
00623      $                                     RCONDC, RESULT( 4 ) )
00624                               CALL CGBT05( TRANS, N, KL, KU, NRHS, A,
00625      $                                     LDA, B, LDB, X, LDB, XACT,
00626      $                                     LDB, RWORK, RWORK( NRHS+1 ),
00627      $                                     RESULT( 5 ) )
00628 *
00629 *                             Print information about the tests that did
00630 *                             not pass the threshold.
00631 *
00632                               DO 60 K = 2, 6
00633                                  IF( RESULT( K ).GE.THRESH ) THEN
00634                                     IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00635      $                                 CALL ALAHD( NOUT, PATH )
00636                                     WRITE( NOUT, FMT = 9996 )TRANS, N,
00637      $                                 KL, KU, NRHS, IMAT, K,
00638      $                                 RESULT( K )
00639                                     NFAIL = NFAIL + 1
00640                                  END IF
00641    60                         CONTINUE
00642                               NRUN = NRUN + 5
00643    70                      CONTINUE
00644    80                   CONTINUE
00645 *
00646 *+    TEST 7:
00647 *                          Get an estimate of RCOND = 1/CNDNUM.
00648 *
00649    90                   CONTINUE
00650                         DO 100 ITRAN = 1, 2
00651                            IF( ITRAN.EQ.1 ) THEN
00652                               ANORM = ANORMO
00653                               RCONDC = RCONDO
00654                               NORM = 'O'
00655                            ELSE
00656                               ANORM = ANORMI
00657                               RCONDC = RCONDI
00658                               NORM = 'I'
00659                            END IF
00660                            SRNAMT = 'CGBCON'
00661                            CALL CGBCON( NORM, N, KL, KU, AFAC, LDAFAC,
00662      $                                  IWORK, ANORM, RCOND, WORK,
00663      $                                  RWORK, INFO )
00664 *
00665 *                             Check error code from CGBCON.
00666 *
00667                            IF( INFO.NE.0 )
00668      $                        CALL ALAERH( PATH, 'CGBCON', INFO, 0,
00669      $                                     NORM, N, N, KL, KU, -1, IMAT,
00670      $                                     NFAIL, NERRS, NOUT )
00671 *
00672                            RESULT( 7 ) = SGET06( RCOND, RCONDC )
00673 *
00674 *                          Print information about the tests that did
00675 *                          not pass the threshold.
00676 *
00677                            IF( RESULT( 7 ).GE.THRESH ) THEN
00678                               IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00679      $                           CALL ALAHD( NOUT, PATH )
00680                               WRITE( NOUT, FMT = 9995 )NORM, N, KL, KU,
00681      $                           IMAT, 7, RESULT( 7 )
00682                               NFAIL = NFAIL + 1
00683                            END IF
00684                            NRUN = NRUN + 1
00685   100                   CONTINUE
00686   110                CONTINUE
00687   120             CONTINUE
00688   130          CONTINUE
00689   140       CONTINUE
00690   150    CONTINUE
00691   160 CONTINUE
00692 *
00693 *     Print a summary of the results.
00694 *
00695       CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS )
00696 *
00697  9999 FORMAT( ' *** In CCHKGB, LA=', I5, ' is too small for M=', I5,
00698      $      ', N=', I5, ', KL=', I4, ', KU=', I4,
00699      $      / ' ==> Increase LA to at least ', I5 )
00700  9998 FORMAT( ' *** In CCHKGB, LAFAC=', I5, ' is too small for M=', I5,
00701      $      ', N=', I5, ', KL=', I4, ', KU=', I4,
00702      $      / ' ==> Increase LAFAC to at least ', I5 )
00703  9997 FORMAT( ' M =', I5, ', N =', I5, ', KL=', I5, ', KU=', I5,
00704      $      ', NB =', I4, ', type ', I1, ', test(', I1, ')=', G12.5 )
00705  9996 FORMAT( ' TRANS=''', A1, ''', N=', I5, ', KL=', I5, ', KU=', I5,
00706      $      ', NRHS=', I3, ', type ', I1, ', test(', I1, ')=', G12.5 )
00707  9995 FORMAT( ' NORM =''', A1, ''', N=', I5, ', KL=', I5, ', KU=', I5,
00708      $      ',', 10X, ' type ', I1, ', test(', I1, ')=', G12.5 )
00709 *
00710       RETURN
00711 *
00712 *     End of CCHKGB
00713 *
00714       END
 All Files Functions