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