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