LAPACK: TESTING/LIN/cdrvgbx.f Source File

Go to the documentation of this file.
00001       SUBROUTINE CDRVGB( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, A, LA,
00002      $                   AFB, LAFB, ASAV, B, BSAV, X, XACT, S, WORK,
00003      $                   RWORK, IWORK, NOUT )
00004 *
00005 *  -- LAPACK test routine (version 3.2.2) --
00006 *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
00007 *     April 2009
00008 *
00009 *     .. Scalar Arguments ..
00010       LOGICAL            TSTERR
00011       INTEGER            LA, LAFB, NN, NOUT, NRHS
00012       REAL               THRESH
00013 *     ..
00014 *     .. Array Arguments ..
00015       LOGICAL            DOTYPE( * )
00016       INTEGER            IWORK( * ), NVAL( * )
00017       REAL               RWORK( * ), S( * )
00018       COMPLEX            A( * ), AFB( * ), ASAV( * ), B( * ), BSAV( * ),
00019      $                   WORK( * ), X( * ), XACT( * )
00020 *     ..
00021 *
00022 *  Purpose
00023 *  =======
00024 *
00025 *  CDRVGB tests the driver routines CGBSV, -SVX, and -SVXX.
00026 *
00027 *  Note that this file is used only when the XBLAS are available,
00028 *  otherwise cdrvgb.f defines this subroutine.
00029 *
00030 *  Arguments
00031 *  =========
00032 *
00033 *  DOTYPE  (input) LOGICAL array, dimension (NTYPES)
00034 *          The matrix types to be used for testing.  Matrices of type j
00035 *          (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
00036 *          .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
00037 *
00038 *  NN      (input) INTEGER
00039 *          The number of values of N contained in the vector NVAL.
00040 *
00041 *  NVAL    (input) INTEGER array, dimension (NN)
00042 *          The values of the matrix column dimension N.
00043 *
00044 *  NRHS    (input) INTEGER
00045 *          The number of right hand side vectors to be generated for
00046 *          each linear system.
00047 *
00048 *  THRESH  (input) REAL
00049 *          The threshold value for the test ratios.  A result is
00050 *          included in the output file if RESULT >= THRESH.  To have
00051 *          every test ratio printed, use THRESH = 0.
00052 *
00053 *  TSTERR  (input) LOGICAL
00054 *          Flag that indicates whether error exits are to be tested.
00055 *
00056 *  A       (workspace) COMPLEX array, dimension (LA)
00057 *
00058 *  LA      (input) INTEGER
00059 *          The length of the array A.  LA >= (2*NMAX-1)*NMAX
00060 *          where NMAX is the largest entry in NVAL.
00061 *
00062 *  AFB     (workspace) COMPLEX array, dimension (LAFB)
00063 *
00064 *  LAFB    (input) INTEGER
00065 *          The length of the array AFB.  LAFB >= (3*NMAX-2)*NMAX
00066 *          where NMAX is the largest entry in NVAL.
00067 *
00068 *  ASAV    (workspace) COMPLEX array, dimension (LA)
00069 *
00070 *  B       (workspace) COMPLEX array, dimension (NMAX*NRHS)
00071 *
00072 *  BSAV    (workspace) COMPLEX array, dimension (NMAX*NRHS)
00073 *
00074 *  X       (workspace) COMPLEX array, dimension (NMAX*NRHS)
00075 *
00076 *  XACT    (workspace) COMPLEX array, dimension (NMAX*NRHS)
00077 *
00078 *  S       (workspace) REAL array, dimension (2*NMAX)
00079 *
00080 *  WORK    (workspace) COMPLEX array, dimension
00081 *                      (NMAX*max(3,NRHS,NMAX))
00082 *
00083 *  RWORK   (workspace) REAL array, dimension
00084 *                      (max(NMAX,2*NRHS))
00085 *
00086 *  IWORK   (workspace) INTEGER array, dimension (NMAX)
00087 *
00088 *  NOUT    (input) INTEGER
00089 *          The unit number for output.
00090 *
00091 *  =====================================================================
00092 *
00093 *     .. Parameters ..
00094       REAL               ONE, ZERO
00095       PARAMETER          ( ONE = 1.0E+0, ZERO = 0.0E+0 )
00096       INTEGER            NTYPES
00097       PARAMETER          ( NTYPES = 8 )
00098       INTEGER            NTESTS
00099       PARAMETER          ( NTESTS = 7 )
00100       INTEGER            NTRAN
00101       PARAMETER          ( NTRAN = 3 )
00102 *     ..
00103 *     .. Local Scalars ..
00104       LOGICAL            EQUIL, NOFACT, PREFAC, TRFCON, ZEROT
00105       CHARACTER          DIST, EQUED, FACT, TRANS, TYPE, XTYPE
00106       CHARACTER*3        PATH
00107       INTEGER            I, I1, I2, IEQUED, IFACT, IKL, IKU, IMAT, IN,
00108      $                   INFO, IOFF, ITRAN, IZERO, J, K, K1, KL, KU,
00109      $                   LDA, LDAFB, LDB, MODE, N, NB, NBMIN, NERRS,
00110      $                   NFACT, NFAIL, NIMAT, NKL, NKU, NRUN, NT,
00111      $                   N_ERR_BNDS
00112       REAL               AINVNM, AMAX, ANORM, ANORMI, ANORMO, ANRMPV,
00113      $                   CNDNUM, COLCND, RCOND, RCONDC, RCONDI, RCONDO,
00114      $                   ROLDC, ROLDI, ROLDO, ROWCND, RPVGRW,
00115      $                   RPVGRW_SVXX
00116 *     ..
00117 *     .. Local Arrays ..
00118       CHARACTER          EQUEDS( 4 ), FACTS( 3 ), TRANSS( NTRAN )
00119       INTEGER            ISEED( 4 ), ISEEDY( 4 )
00120       REAL               RDUM( 1 ), RESULT( NTESTS ), BERR( NRHS ),
00121      $                   ERRBNDS_N( NRHS,3 ), ERRBNDS_C( NRHS, 3 )
00122 *     ..
00123 *     .. External Functions ..
00124       LOGICAL            LSAME
00125       REAL               CLANGB, CLANGE, CLANTB, SGET06, SLAMCH,
00126      $                   CLA_GBRPVGRW
00127       EXTERNAL           LSAME, CLANGB, CLANGE, CLANTB, SGET06, SLAMCH,
00128      $                   CLA_GBRPVGRW
00129 *     ..
00130 *     .. External Subroutines ..
00131       EXTERNAL           ALADHD, ALAERH, ALASVM, CERRVX, CGBEQU, CGBSV,
00132      $                   CGBSVX, CGBT01, CGBT02, CGBT05, CGBTRF, CGBTRS,
00133      $                   CGET04, CLACPY, CLAQGB, CLARHS, CLASET, CLATB4,
00134      $                   CLATMS, XLAENV, CGBSVXX
00135 *     ..
00136 *     .. Intrinsic Functions ..
00137       INTRINSIC          ABS, CMPLX, MAX, MIN
00138 *     ..
00139 *     .. Scalars in Common ..
00140       LOGICAL            LERR, OK
00141       CHARACTER*32       SRNAMT
00142       INTEGER            INFOT, NUNIT
00143 *     ..
00144 *     .. Common blocks ..
00145       COMMON             / INFOC / INFOT, NUNIT, OK, LERR
00146       COMMON             / SRNAMC / SRNAMT
00147 *     ..
00148 *     .. Data statements ..
00149       DATA               ISEEDY / 1988, 1989, 1990, 1991 /
00150       DATA               TRANSS / 'N', 'T', 'C' /
00151       DATA               FACTS / 'F', 'N', 'E' /
00152       DATA               EQUEDS / 'N', 'R', 'C', 'B' /
00153 *     ..
00154 *     .. Executable Statements ..
00155 *
00156 *     Initialize constants and the random number seed.
00157 *
00158       PATH( 1: 1 ) = 'Complex 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 CERRVX( PATH, NOUT )
00171       INFOT = 0
00172 *
00173 *     Set the block size and minimum block size for testing.
00174 *
00175       NB = 1
00176       NBMIN = 2
00177       CALL XLAENV( 1, NB )
00178       CALL XLAENV( 2, NBMIN )
00179 *
00180 *     Do for each value of N in NVAL
00181 *
00182       DO 150 IN = 1, NN
00183          N = NVAL( IN )
00184          LDB = MAX( N, 1 )
00185          XTYPE = 'N'
00186 *
00187 *        Set limits on the number of loop iterations.
00188 *
00189          NKL = MAX( 1, MIN( N, 4 ) )
00190          IF( N.EQ.0 )
00191      $      NKL = 1
00192          NKU = NKL
00193          NIMAT = NTYPES
00194          IF( N.LE.0 )
00195      $      NIMAT = 1
00196 *
00197          DO 140 IKL = 1, NKL
00198 *
00199 *           Do for KL = 0, N-1, (3N-1)/4, and (N+1)/4. This order makes
00200 *           it easier to skip redundant values for small values of N.
00201 *
00202             IF( IKL.EQ.1 ) THEN
00203                KL = 0
00204             ELSE IF( IKL.EQ.2 ) THEN
00205                KL = MAX( N-1, 0 )
00206             ELSE IF( IKL.EQ.3 ) THEN
00207                KL = ( 3*N-1 ) / 4
00208             ELSE IF( IKL.EQ.4 ) THEN
00209                KL = ( N+1 ) / 4
00210             END IF
00211             DO 130 IKU = 1, NKU
00212 *
00213 *              Do for KU = 0, N-1, (3N-1)/4, and (N+1)/4. This order
00214 *              makes it easier to skip redundant values for small
00215 *              values of N.
00216 *
00217                IF( IKU.EQ.1 ) THEN
00218                   KU = 0
00219                ELSE IF( IKU.EQ.2 ) THEN
00220                   KU = MAX( N-1, 0 )
00221                ELSE IF( IKU.EQ.3 ) THEN
00222                   KU = ( 3*N-1 ) / 4
00223                ELSE IF( IKU.EQ.4 ) THEN
00224                   KU = ( N+1 ) / 4
00225                END IF
00226 *
00227 *              Check that A and AFB are big enough to generate this
00228 *              matrix.
00229 *
00230                LDA = KL + KU + 1
00231                LDAFB = 2*KL + KU + 1
00232                IF( LDA*N.GT.LA .OR. LDAFB*N.GT.LAFB ) THEN
00233                   IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00234      $               CALL ALADHD( NOUT, PATH )
00235                   IF( LDA*N.GT.LA ) THEN
00236                      WRITE( NOUT, FMT = 9999 )LA, N, KL, KU,
00237      $                  N*( KL+KU+1 )
00238                      NERRS = NERRS + 1
00239                   END IF
00240                   IF( LDAFB*N.GT.LAFB ) THEN
00241                      WRITE( NOUT, FMT = 9998 )LAFB, N, KL, KU,
00242      $                  N*( 2*KL+KU+1 )
00243                      NERRS = NERRS + 1
00244                   END IF
00245                   GO TO 130
00246                END IF
00247 *
00248                DO 120 IMAT = 1, NIMAT
00249 *
00250 *                 Do the tests only if DOTYPE( IMAT ) is true.
00251 *
00252                   IF( .NOT.DOTYPE( IMAT ) )
00253      $               GO TO 120
00254 *
00255 *                 Skip types 2, 3, or 4 if the matrix is too small.
00256 *
00257                   ZEROT = IMAT.GE.2 .AND. IMAT.LE.4
00258                   IF( ZEROT .AND. N.LT.IMAT-1 )
00259      $               GO TO 120
00260 *
00261 *                 Set up parameters with CLATB4 and generate a
00262 *                 test matrix with CLATMS.
00263 *
00264                   CALL CLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM,
00265      $                         MODE, CNDNUM, DIST )
00266                   RCONDC = ONE / CNDNUM
00267 *
00268                   SRNAMT = 'CLATMS'
00269                   CALL CLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE,
00270      $                         CNDNUM, ANORM, KL, KU, 'Z', A, LDA, WORK,
00271      $                         INFO )
00272 *
00273 *                 Check the error code from CLATMS.
00274 *
00275                   IF( INFO.NE.0 ) THEN
00276                      CALL ALAERH( PATH, 'CLATMS', INFO, 0, ' ', N, N,
00277      $                            KL, KU, -1, IMAT, NFAIL, NERRS, NOUT )
00278                      GO TO 120
00279                   END IF
00280 *
00281 *                 For types 2, 3, and 4, zero one or more columns of
00282 *                 the matrix to test that INFO is returned correctly.
00283 *
00284                   IZERO = 0
00285                   IF( ZEROT ) THEN
00286                      IF( IMAT.EQ.2 ) THEN
00287                         IZERO = 1
00288                      ELSE IF( IMAT.EQ.3 ) THEN
00289                         IZERO = N
00290                      ELSE
00291                         IZERO = N / 2 + 1
00292                      END IF
00293                      IOFF = ( IZERO-1 )*LDA
00294                      IF( IMAT.LT.4 ) THEN
00295                         I1 = MAX( 1, KU+2-IZERO )
00296                         I2 = MIN( KL+KU+1, KU+1+( N-IZERO ) )
00297                         DO 20 I = I1, I2
00298                            A( IOFF+I ) = ZERO
00299    20                   CONTINUE
00300                      ELSE
00301                         DO 40 J = IZERO, N
00302                            DO 30 I = MAX( 1, KU+2-J ),
00303      $                             MIN( KL+KU+1, KU+1+( N-J ) )
00304                               A( IOFF+I ) = ZERO
00305    30                      CONTINUE
00306                            IOFF = IOFF + LDA
00307    40                   CONTINUE
00308                      END IF
00309                   END IF
00310 *
00311 *                 Save a copy of the matrix A in ASAV.
00312 *
00313                   CALL CLACPY( 'Full', KL+KU+1, N, A, LDA, ASAV, LDA )
00314 *
00315                   DO 110 IEQUED = 1, 4
00316                      EQUED = EQUEDS( IEQUED )
00317                      IF( IEQUED.EQ.1 ) THEN
00318                         NFACT = 3
00319                      ELSE
00320                         NFACT = 1
00321                      END IF
00322 *
00323                      DO 100 IFACT = 1, NFACT
00324                         FACT = FACTS( IFACT )
00325                         PREFAC = LSAME( FACT, 'F' )
00326                         NOFACT = LSAME( FACT, 'N' )
00327                         EQUIL = LSAME( FACT, 'E' )
00328 *
00329                         IF( ZEROT ) THEN
00330                            IF( PREFAC )
00331      $                        GO TO 100
00332                            RCONDO = ZERO
00333                            RCONDI = ZERO
00334 *
00335                         ELSE IF( .NOT.NOFACT ) THEN
00336 *
00337 *                          Compute the condition number for comparison
00338 *                          with the value returned by SGESVX (FACT =
00339 *                          'N' reuses the condition number from the
00340 *                          previous iteration with FACT = 'F').
00341 *
00342                            CALL CLACPY( 'Full', KL+KU+1, N, ASAV, LDA,
00343      $                                  AFB( KL+1 ), LDAFB )
00344                            IF( EQUIL .OR. IEQUED.GT.1 ) THEN
00345 *
00346 *                             Compute row and column scale factors to
00347 *                             equilibrate the matrix A.
00348 *
00349                               CALL CGBEQU( N, N, KL, KU, AFB( KL+1 ),
00350      $                                     LDAFB, S, S( N+1 ), ROWCND,
00351      $                                     COLCND, AMAX, INFO )
00352                               IF( INFO.EQ.0 .AND. N.GT.0 ) THEN
00353                                  IF( LSAME( EQUED, 'R' ) ) THEN
00354                                     ROWCND = ZERO
00355                                     COLCND = ONE
00356                                  ELSE IF( LSAME( EQUED, 'C' ) ) THEN
00357                                     ROWCND = ONE
00358                                     COLCND = ZERO
00359                                  ELSE IF( LSAME( EQUED, 'B' ) ) THEN
00360                                     ROWCND = ZERO
00361                                     COLCND = ZERO
00362                                  END IF
00363 *
00364 *                                Equilibrate the matrix.
00365 *
00366                                  CALL CLAQGB( N, N, KL, KU, AFB( KL+1 ),
00367      $                                        LDAFB, S, S( N+1 ),
00368      $                                        ROWCND, COLCND, AMAX,
00369      $                                        EQUED )
00370                               END IF
00371                            END IF
00372 *
00373 *                          Save the condition number of the
00374 *                          non-equilibrated system for use in CGET04.
00375 *
00376                            IF( EQUIL ) THEN
00377                               ROLDO = RCONDO
00378                               ROLDI = RCONDI
00379                            END IF
00380 *
00381 *                          Compute the 1-norm and infinity-norm of A.
00382 *
00383                            ANORMO = CLANGB( '1', N, KL, KU, AFB( KL+1 ),
00384      $                              LDAFB, RWORK )
00385                            ANORMI = CLANGB( 'I', N, KL, KU, AFB( KL+1 ),
00386      $                              LDAFB, RWORK )
00387 *
00388 *                          Factor the matrix A.
00389 *
00390                            CALL CGBTRF( N, N, KL, KU, AFB, LDAFB, IWORK,
00391      $                                  INFO )
00392 *
00393 *                          Form the inverse of A.
00394 *
00395                            CALL CLASET( 'Full', N, N, CMPLX( ZERO ),
00396      $                                  CMPLX( ONE ), WORK, LDB )
00397                            SRNAMT = 'CGBTRS'
00398                            CALL CGBTRS( 'No transpose', N, KL, KU, N,
00399      $                                  AFB, LDAFB, IWORK, WORK, LDB,
00400      $                                  INFO )
00401 *
00402 *                          Compute the 1-norm condition number of A.
00403 *
00404                            AINVNM = CLANGE( '1', N, N, WORK, LDB,
00405      $                              RWORK )
00406                            IF( ANORMO.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
00407                               RCONDO = ONE
00408                            ELSE
00409                               RCONDO = ( ONE / ANORMO ) / AINVNM
00410                            END IF
00411 *
00412 *                          Compute the infinity-norm condition number
00413 *                          of A.
00414 *
00415                            AINVNM = CLANGE( 'I', N, N, WORK, LDB,
00416      $                              RWORK )
00417                            IF( ANORMI.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
00418                               RCONDI = ONE
00419                            ELSE
00420                               RCONDI = ( ONE / ANORMI ) / AINVNM
00421                            END IF
00422                         END IF
00423 *
00424                         DO 90 ITRAN = 1, NTRAN
00425 *
00426 *                          Do for each value of TRANS.
00427 *
00428                            TRANS = TRANSS( ITRAN )
00429                            IF( ITRAN.EQ.1 ) THEN
00430                               RCONDC = RCONDO
00431                            ELSE
00432                               RCONDC = RCONDI
00433                            END IF
00434 *
00435 *                          Restore the matrix A.
00436 *
00437                            CALL CLACPY( 'Full', KL+KU+1, N, ASAV, LDA,
00438      $                                  A, LDA )
00439 *
00440 *                          Form an exact solution and set the right hand
00441 *                          side.
00442 *
00443                            SRNAMT = 'CLARHS'
00444                            CALL CLARHS( PATH, XTYPE, 'Full', TRANS, N,
00445      $                                  N, KL, KU, NRHS, A, LDA, XACT,
00446      $                                  LDB, B, LDB, ISEED, INFO )
00447                            XTYPE = 'C'
00448                            CALL CLACPY( 'Full', N, NRHS, B, LDB, BSAV,
00449      $                                  LDB )
00450 *
00451                            IF( NOFACT .AND. ITRAN.EQ.1 ) THEN
00452 *
00453 *                             --- Test CGBSV  ---
00454 *
00455 *                             Compute the LU factorization of the matrix
00456 *                             and solve the system.
00457 *
00458                               CALL CLACPY( 'Full', KL+KU+1, N, A, LDA,
00459      $                                     AFB( KL+1 ), LDAFB )
00460                               CALL CLACPY( 'Full', N, NRHS, B, LDB, X,
00461      $                                     LDB )
00462 *
00463                               SRNAMT = 'CGBSV '
00464                               CALL CGBSV( N, KL, KU, NRHS, AFB, LDAFB,
00465      $                                    IWORK, X, LDB, INFO )
00466 *
00467 *                             Check error code from CGBSV .
00468 *
00469                               IF( INFO.NE.IZERO )
00470      $                           CALL ALAERH( PATH, 'CGBSV ', INFO,
00471      $                                        IZERO, ' ', N, N, KL, KU,
00472      $                                        NRHS, IMAT, NFAIL, NERRS,
00473      $                                        NOUT )
00474 *
00475 *                             Reconstruct matrix from factors and
00476 *                             compute residual.
00477 *
00478                               CALL CGBT01( N, N, KL, KU, A, LDA, AFB,
00479      $                                     LDAFB, IWORK, WORK,
00480      $                                     RESULT( 1 ) )
00481                               NT = 1
00482                               IF( IZERO.EQ.0 ) THEN
00483 *
00484 *                                Compute residual of the computed
00485 *                                solution.
00486 *
00487                                  CALL CLACPY( 'Full', N, NRHS, B, LDB,
00488      $                                        WORK, LDB )
00489                                  CALL CGBT02( 'No transpose', N, N, KL,
00490      $                                        KU, NRHS, A, LDA, X, LDB,
00491      $                                        WORK, LDB, RESULT( 2 ) )
00492 *
00493 *                                Check solution from generated exact
00494 *                                solution.
00495 *
00496                                  CALL CGET04( N, NRHS, X, LDB, XACT,
00497      $                                        LDB, RCONDC, RESULT( 3 ) )
00498                                  NT = 3
00499                               END IF
00500 *
00501 *                             Print information about the tests that did
00502 *                             not pass the threshold.
00503 *
00504                               DO 50 K = 1, NT
00505                                  IF( RESULT( K ).GE.THRESH ) THEN
00506                                     IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00507      $                                 CALL ALADHD( NOUT, PATH )
00508                                     WRITE( NOUT, FMT = 9997 )'CGBSV ',
00509      $                                 N, KL, KU, IMAT, K, RESULT( K )
00510                                     NFAIL = NFAIL + 1
00511                                  END IF
00512    50                         CONTINUE
00513                               NRUN = NRUN + NT
00514                            END IF
00515 *
00516 *                          --- Test CGBSVX ---
00517 *
00518                            IF( .NOT.PREFAC )
00519      $                        CALL CLASET( 'Full', 2*KL+KU+1, N,
00520      $                                     CMPLX( ZERO ), CMPLX( ZERO ),
00521      $                                     AFB, LDAFB )
00522                            CALL CLASET( 'Full', N, NRHS, CMPLX( ZERO ),
00523      $                                  CMPLX( ZERO ), X, LDB )
00524                            IF( IEQUED.GT.1 .AND. N.GT.0 ) THEN
00525 *
00526 *                             Equilibrate the matrix if FACT = 'F' and
00527 *                             EQUED = 'R', 'C', or 'B'.
00528 *
00529                               CALL CLAQGB( N, N, KL, KU, A, LDA, S,
00530      $                                     S( N+1 ), ROWCND, COLCND,
00531      $                                     AMAX, EQUED )
00532                            END IF
00533 *
00534 *                          Solve the system and compute the condition
00535 *                          number and error bounds using CGBSVX.
00536 *
00537                            SRNAMT = 'CGBSVX'
00538                            CALL CGBSVX( FACT, TRANS, N, KL, KU, NRHS, A,
00539      $                                  LDA, AFB, LDAFB, IWORK, EQUED,
00540      $                                  S, S( LDB+1 ), B, LDB, X, LDB,
00541      $                                  RCOND, RWORK, RWORK( NRHS+1 ),
00542      $                                  WORK, RWORK( 2*NRHS+1 ), INFO )
00543 *
00544 *                          Check the error code from CGBSVX.
00545 *
00546                            IF( INFO.NE.IZERO )
00547      $                        CALL ALAERH( PATH, 'CGBSVX', INFO, IZERO,
00548      $                                     FACT // TRANS, N, N, KL, KU,
00549      $                                     NRHS, IMAT, NFAIL, NERRS,
00550      $                                     NOUT )
00551 *
00552 *                          Compare RWORK(2*NRHS+1) from CGBSVX with the
00553 *                          computed reciprocal pivot growth RPVGRW
00554 *
00555                            IF( INFO.NE.0 ) THEN
00556                               ANRMPV = ZERO
00557                               DO 70 J = 1, INFO
00558                                  DO 60 I = MAX( KU+2-J, 1 ),
00559      $                                   MIN( N+KU+1-J, KL+KU+1 )
00560                                     ANRMPV = MAX( ANRMPV,
00561      $                                       ABS( A( I+( J-1 )*LDA ) ) )
00562    60                            CONTINUE
00563    70                         CONTINUE
00564                               RPVGRW = CLANTB( 'M', 'U', 'N', INFO,
00565      $                                 MIN( INFO-1, KL+KU ),
00566      $                                 AFB( MAX( 1, KL+KU+2-INFO ) ),
00567      $                                 LDAFB, RDUM )
00568                               IF( RPVGRW.EQ.ZERO ) THEN
00569                                  RPVGRW = ONE
00570                               ELSE
00571                                  RPVGRW = ANRMPV / RPVGRW
00572                               END IF
00573                            ELSE
00574                               RPVGRW = CLANTB( 'M', 'U', 'N', N, KL+KU,
00575      $                                 AFB, LDAFB, RDUM )
00576                               IF( RPVGRW.EQ.ZERO ) THEN
00577                                  RPVGRW = ONE
00578                               ELSE
00579                                  RPVGRW = CLANGB( 'M', N, KL, KU, A,
00580      $                                    LDA, RDUM ) / RPVGRW
00581                               END IF
00582                            END IF
00583                            RESULT( 7 ) = ABS( RPVGRW-RWORK( 2*NRHS+1 ) )
00584      $                                    / MAX( RWORK( 2*NRHS+1 ),
00585      $                                   RPVGRW ) / SLAMCH( 'E' )
00586 *
00587                            IF( .NOT.PREFAC ) THEN
00588 *
00589 *                             Reconstruct matrix from factors and
00590 *                             compute residual.
00591 *
00592                               CALL CGBT01( N, N, KL, KU, A, LDA, AFB,
00593      $                                     LDAFB, IWORK, WORK,
00594      $                                     RESULT( 1 ) )
00595                               K1 = 1
00596                            ELSE
00597                               K1 = 2
00598                            END IF
00599 *
00600                            IF( INFO.EQ.0 ) THEN
00601                               TRFCON = .FALSE.
00602 *
00603 *                             Compute residual of the computed solution.
00604 *
00605                               CALL CLACPY( 'Full', N, NRHS, BSAV, LDB,
00606      $                                     WORK, LDB )
00607                               CALL CGBT02( TRANS, N, N, KL, KU, NRHS,
00608      $                                     ASAV, LDA, X, LDB, WORK, LDB,
00609      $                                     RESULT( 2 ) )
00610 *
00611 *                             Check solution from generated exact
00612 *                             solution.
00613 *
00614                               IF( NOFACT .OR. ( PREFAC .AND.
00615      $                            LSAME( EQUED, 'N' ) ) ) THEN
00616                                  CALL CGET04( N, NRHS, X, LDB, XACT,
00617      $                                        LDB, RCONDC, RESULT( 3 ) )
00618                               ELSE
00619                                  IF( ITRAN.EQ.1 ) THEN
00620                                     ROLDC = ROLDO
00621                                  ELSE
00622                                     ROLDC = ROLDI
00623                                  END IF
00624                                  CALL CGET04( N, NRHS, X, LDB, XACT,
00625      $                                        LDB, ROLDC, RESULT( 3 ) )
00626                               END IF
00627 *
00628 *                             Check the error bounds from iterative
00629 *                             refinement.
00630 *
00631                               CALL CGBT05( TRANS, N, KL, KU, NRHS, ASAV,
00632      $                                     LDA, BSAV, LDB, X, LDB, XACT,
00633      $                                     LDB, RWORK, RWORK( NRHS+1 ),
00634      $                                     RESULT( 4 ) )
00635                            ELSE
00636                               TRFCON = .TRUE.
00637                            END IF
00638 *
00639 *                          Compare RCOND from CGBSVX with the computed
00640 *                          value in RCONDC.
00641 *
00642                            RESULT( 6 ) = SGET06( RCOND, RCONDC )
00643 *
00644 *                          Print information about the tests that did
00645 *                          not pass the threshold.
00646 *
00647                            IF( .NOT.TRFCON ) THEN
00648                               DO 80 K = K1, NTESTS
00649                                  IF( RESULT( K ).GE.THRESH ) THEN
00650                                     IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00651      $                                 CALL ALADHD( NOUT, PATH )
00652                                     IF( PREFAC ) THEN
00653                                        WRITE( NOUT, FMT = 9995 )
00654      $                                    'CGBSVX', FACT, TRANS, N, KL,
00655      $                                    KU, EQUED, IMAT, K,
00656      $                                    RESULT( K )
00657                                     ELSE
00658                                        WRITE( NOUT, FMT = 9996 )
00659      $                                    'CGBSVX', FACT, TRANS, N, KL,
00660      $                                    KU, IMAT, K, RESULT( K )
00661                                     END IF
00662                                     NFAIL = NFAIL + 1
00663                                  END IF
00664    80                         CONTINUE
00665                               NRUN = NRUN + 7 - K1
00666                            ELSE
00667                               IF( RESULT( 1 ).GE.THRESH .AND. .NOT.
00668      $                            PREFAC ) THEN
00669                                  IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00670      $                              CALL ALADHD( NOUT, PATH )
00671                                  IF( PREFAC ) THEN
00672                                     WRITE( NOUT, FMT = 9995 )'CGBSVX',
00673      $                                 FACT, TRANS, N, KL, KU, EQUED,
00674      $                                 IMAT, 1, RESULT( 1 )
00675                                  ELSE
00676                                     WRITE( NOUT, FMT = 9996 )'CGBSVX',
00677      $                                 FACT, TRANS, N, KL, KU, IMAT, 1,
00678      $                                 RESULT( 1 )
00679                                  END IF
00680                                  NFAIL = NFAIL + 1
00681                                  NRUN = NRUN + 1
00682                               END IF
00683                               IF( RESULT( 6 ).GE.THRESH ) THEN
00684                                  IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00685      $                              CALL ALADHD( NOUT, PATH )
00686                                  IF( PREFAC ) THEN
00687                                     WRITE( NOUT, FMT = 9995 )'CGBSVX',
00688      $                                 FACT, TRANS, N, KL, KU, EQUED,
00689      $                                 IMAT, 6, RESULT( 6 )
00690                                  ELSE
00691                                     WRITE( NOUT, FMT = 9996 )'CGBSVX',
00692      $                                 FACT, TRANS, N, KL, KU, IMAT, 6,
00693      $                                 RESULT( 6 )
00694                                  END IF
00695                                  NFAIL = NFAIL + 1
00696                                  NRUN = NRUN + 1
00697                               END IF
00698                               IF( RESULT( 7 ).GE.THRESH ) THEN
00699                                  IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00700      $                              CALL ALADHD( NOUT, PATH )
00701                                  IF( PREFAC ) THEN
00702                                     WRITE( NOUT, FMT = 9995 )'CGBSVX',
00703      $                                 FACT, TRANS, N, KL, KU, EQUED,
00704      $                                 IMAT, 7, RESULT( 7 )
00705                                  ELSE
00706                                     WRITE( NOUT, FMT = 9996 )'CGBSVX',
00707      $                                 FACT, TRANS, N, KL, KU, IMAT, 7,
00708      $                                 RESULT( 7 )
00709                                  END IF
00710                                  NFAIL = NFAIL + 1
00711                                  NRUN = NRUN + 1
00712                               END IF
00713                            END IF
00714 
00715 *                    --- Test CGBSVXX ---
00716 
00717 *                    Restore the matrices A and B.
00718 
00719 c                     write(*,*) 'begin cgbsvxx testing'
00720 
00721                      CALL CLACPY( 'Full', KL+KU+1, N, ASAV, LDA, A,
00722      $                          LDA )
00723                      CALL CLACPY( 'Full', N, NRHS, BSAV, LDB, B, LDB )
00724 
00725                      IF( .NOT.PREFAC )
00726      $                  CALL CLASET( 'Full', 2*KL+KU+1, N, ZERO, ZERO,
00727      $                    AFB, LDAFB )
00728                      CALL CLASET( 'Full', N, NRHS, ZERO, ZERO, X, LDB )
00729                      IF( IEQUED.GT.1 .AND. N.GT.0 ) THEN
00730 *
00731 *                       Equilibrate the matrix if FACT = 'F' and
00732 *                       EQUED = 'R', 'C', or 'B'.
00733 *
00734                         CALL CLAQGB( N, N, KL, KU, A, LDA, S,
00735      $                       S( N+1 ), ROWCND, COLCND, AMAX, EQUED )
00736                      END IF
00737 *
00738 *                    Solve the system and compute the condition number
00739 *                    and error bounds using CGBSVXX.
00740 *
00741                      SRNAMT = 'CGBSVXX'
00742                      N_ERR_BNDS = 3
00743                      CALL CGBSVXX( FACT, TRANS, N, KL, KU, NRHS, A, LDA,
00744      $                    AFB, LDAFB, IWORK, EQUED, S, S( N+1 ), B, LDB,
00745      $                    X, LDB, RCOND, RPVGRW_SVXX, BERR, N_ERR_BNDS,
00746      $                    ERRBNDS_N, ERRBNDS_C, 0, ZERO, WORK,
00747      $                    RWORK, INFO )
00748 *
00749 *                    Check the error code from CGBSVXX.
00750 *
00751                      IF( INFO.EQ.N+1 ) GOTO 90
00752                      IF( INFO.NE.IZERO ) THEN
00753                         CALL ALAERH( PATH, 'CGBSVXX', INFO, IZERO,
00754      $                               FACT // TRANS, N, N, -1, -1, NRHS,
00755      $                               IMAT, NFAIL, NERRS, NOUT )
00756                         GOTO 90
00757                      END IF
00758 *
00759 *                    Compare rpvgrw_svxx from CGESVXX with the computed
00760 *                    reciprocal pivot growth factor RPVGRW
00761 *
00762 
00763                      IF ( INFO .GT. 0 .AND. INFO .LT. N+1 ) THEN
00764                         RPVGRW = CLA_GBRPVGRW(N, KL, KU, INFO, A, LDA,
00765      $                       AFB, LDAFB)
00766                      ELSE
00767                         RPVGRW = CLA_GBRPVGRW(N, KL, KU, N, A, LDA,
00768      $                       AFB, LDAFB)
00769                      ENDIF
00770 
00771                      RESULT( 7 ) = ABS( RPVGRW-rpvgrw_svxx ) /
00772      $                             MAX( rpvgrw_svxx, RPVGRW ) /
00773      $                             SLAMCH( 'E' )
00774 *
00775                      IF( .NOT.PREFAC ) THEN
00776 *
00777 *                       Reconstruct matrix from factors and compute
00778 *                       residual.
00779 *
00780                         CALL CGBT01( N, N, KL, KU, A, LDA, AFB, LDAFB,
00781      $                       IWORK, RWORK( 2*NRHS+1 ), RESULT( 1 ) )
00782                         K1 = 1
00783                      ELSE
00784                         K1 = 2
00785                      END IF
00786 *
00787                      IF( INFO.EQ.0 ) THEN
00788                         TRFCON = .FALSE.
00789 *
00790 *                       Compute residual of the computed solution.
00791 *
00792                         CALL CLACPY( 'Full', N, NRHS, BSAV, LDB, WORK,
00793      $                               LDB )
00794                         CALL CGBT02( TRANS, N, N, KL, KU, NRHS, ASAV,
00795      $                       LDA, X, LDB, WORK, LDB, RWORK( 2*NRHS+1 ),
00796      $                               RESULT( 2 ) )
00797 *
00798 *                       Check solution from generated exact solution.
00799 *
00800                         IF( NOFACT .OR. ( PREFAC .AND. LSAME( EQUED,
00801      $                      'N' ) ) ) THEN
00802                            CALL CGET04( N, NRHS, X, LDB, XACT, LDB,
00803      $                                  RCONDC, RESULT( 3 ) )
00804                         ELSE
00805                            IF( ITRAN.EQ.1 ) THEN
00806                               ROLDC = ROLDO
00807                            ELSE
00808                               ROLDC = ROLDI
00809                            END IF
00810                            CALL CGET04( N, NRHS, X, LDB, XACT, LDB,
00811      $                                  ROLDC, RESULT( 3 ) )
00812                         END IF
00813                      ELSE
00814                         TRFCON = .TRUE.
00815                      END IF
00816 *
00817 *                    Compare RCOND from CGBSVXX with the computed value
00818 *                    in RCONDC.
00819 *
00820                      RESULT( 6 ) = SGET06( RCOND, RCONDC )
00821 *
00822 *                    Print information about the tests that did not pass
00823 *                    the threshold.
00824 *
00825                      IF( .NOT.TRFCON ) THEN
00826                         DO 45 K = K1, NTESTS
00827                            IF( RESULT( K ).GE.THRESH ) THEN
00828                               IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00829      $                           CALL ALADHD( NOUT, PATH )
00830                               IF( PREFAC ) THEN
00831                                  WRITE( NOUT, FMT = 9995 )'CGBSVXX',
00832      $                                FACT, TRANS, N, KL, KU, EQUED,
00833      $                                IMAT, K, RESULT( K )
00834                               ELSE
00835                                  WRITE( NOUT, FMT = 9996 )'CGBSVXX',
00836      $                                FACT, TRANS, N, KL, KU, IMAT, K,
00837      $                                RESULT( K )
00838                               END IF
00839                               NFAIL = NFAIL + 1
00840                            END IF
00841  45                     CONTINUE
00842                         NRUN = NRUN + 7 - K1
00843                      ELSE
00844                         IF( RESULT( 1 ).GE.THRESH .AND. .NOT.PREFAC )
00845      $                       THEN
00846                            IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00847      $                        CALL ALADHD( NOUT, PATH )
00848                            IF( PREFAC ) THEN
00849                               WRITE( NOUT, FMT = 9995 )'CGBSVXX', FACT,
00850      $                             TRANS, N, KL, KU, EQUED, IMAT, 1,
00851      $                             RESULT( 1 )
00852                            ELSE
00853                               WRITE( NOUT, FMT = 9996 )'CGBSVXX', FACT,
00854      $                             TRANS, N, KL, KU, IMAT, 1,
00855      $                             RESULT( 1 )
00856                            END IF
00857                            NFAIL = NFAIL + 1
00858                            NRUN = NRUN + 1
00859                         END IF
00860                         IF( RESULT( 6 ).GE.THRESH ) THEN
00861                            IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00862      $                        CALL ALADHD( NOUT, PATH )
00863                            IF( PREFAC ) THEN
00864                               WRITE( NOUT, FMT = 9995 )'CGBSVXX', FACT,
00865      $                             TRANS, N, KL, KU, EQUED, IMAT, 6,
00866      $                             RESULT( 6 )
00867                            ELSE
00868                               WRITE( NOUT, FMT = 9996 )'CGBSVXX', FACT,
00869      $                             TRANS, N, KL, KU, IMAT, 6,
00870      $                             RESULT( 6 )
00871                            END IF
00872                            NFAIL = NFAIL + 1
00873                            NRUN = NRUN + 1
00874                         END IF
00875                         IF( RESULT( 7 ).GE.THRESH ) THEN
00876                            IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00877      $                        CALL ALADHD( NOUT, PATH )
00878                            IF( PREFAC ) THEN
00879                               WRITE( NOUT, FMT = 9995 )'CGBSVXX', FACT,
00880      $                             TRANS, N, KL, KU, EQUED, IMAT, 7,
00881      $                             RESULT( 7 )
00882                            ELSE
00883                               WRITE( NOUT, FMT = 9996 )'CGBSVXX', FACT,
00884      $                             TRANS, N, KL, KU, IMAT, 7,
00885      $                             RESULT( 7 )
00886                            END IF
00887                            NFAIL = NFAIL + 1
00888                            NRUN = NRUN + 1
00889                         END IF
00890 *
00891                      END IF
00892 *
00893    90                   CONTINUE
00894   100                CONTINUE
00895   110             CONTINUE
00896   120          CONTINUE
00897   130       CONTINUE
00898   140    CONTINUE
00899   150 CONTINUE
00900 *
00901 *     Print a summary of the results.
00902 *
00903       CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS )
00904 *
00905 
00906 *     Test Error Bounds from CGBSVXX
00907 
00908       CALL CEBCHVXX(THRESH, PATH)
00909 
00910  9999 FORMAT( ' *** In CDRVGB, LA=', I5, ' is too small for N=', I5,
00911      $      ', KU=', I5, ', KL=', I5, / ' ==> Increase LA to at least ',
00912      $      I5 )
00913  9998 FORMAT( ' *** In CDRVGB, LAFB=', I5, ' is too small for N=', I5,
00914      $      ', KU=', I5, ', KL=', I5, /
00915      $      ' ==> Increase LAFB to at least ', I5 )
00916  9997 FORMAT( 1X, A, ', N=', I5, ', KL=', I5, ', KU=', I5, ', type ',
00917      $      I1, ', test(', I1, ')=', G12.5 )
00918  9996 FORMAT( 1X, A, '( ''', A1, ''',''', A1, ''',', I5, ',', I5, ',',
00919      $      I5, ',...), type ', I1, ', test(', I1, ')=', G12.5 )
00920  9995 FORMAT( 1X, A, '( ''', A1, ''',''', A1, ''',', I5, ',', I5, ',',
00921      $      I5, ',...), EQUED=''', A1, ''', type ', I1, ', test(', I1,
00922      $      ')=', G12.5 )
00923 *
00924       RETURN
00925 *
00926 *     End of CDRVGB
00927 *
00928       END