LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
cdrvgbx.f
Go to the documentation of this file.
00001 *> \brief \b CDRVGBX
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 CDRVGB( 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               RWORK( * ), S( * )
00024 *       COMPLEX            A( * ), AFB( * ), ASAV( * ), B( * ), BSAV( * ),
00025 *      $                   WORK( * ), X( * ), XACT( * )
00026 *       ..
00027 *  
00028 *
00029 *> \par Purpose:
00030 *  =============
00031 *>
00032 *> \verbatim
00033 *>
00034 *> CDRVGB tests the driver routines CGBSV, -SVX, and -SVXX.
00035 *>
00036 *> Note that this file is used only when the XBLAS are available,
00037 *> otherwise cdrvgb.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 REAL
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 COMPLEX 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 COMPLEX 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 COMPLEX array, dimension (LA)
00111 *> \endverbatim
00112 *>
00113 *> \param[out] B
00114 *> \verbatim
00115 *>          B is COMPLEX array, dimension (NMAX*NRHS)
00116 *> \endverbatim
00117 *>
00118 *> \param[out] BSAV
00119 *> \verbatim
00120 *>          BSAV is COMPLEX array, dimension (NMAX*NRHS)
00121 *> \endverbatim
00122 *>
00123 *> \param[out] X
00124 *> \verbatim
00125 *>          X is COMPLEX array, dimension (NMAX*NRHS)
00126 *> \endverbatim
00127 *>
00128 *> \param[out] XACT
00129 *> \verbatim
00130 *>          XACT is COMPLEX array, dimension (NMAX*NRHS)
00131 *> \endverbatim
00132 *>
00133 *> \param[out] S
00134 *> \verbatim
00135 *>          S is REAL array, dimension (2*NMAX)
00136 *> \endverbatim
00137 *>
00138 *> \param[out] WORK
00139 *> \verbatim
00140 *>          WORK is COMPLEX array, dimension
00141 *>                      (NMAX*max(3,NRHS,NMAX))
00142 *> \endverbatim
00143 *>
00144 *> \param[out] RWORK
00145 *> \verbatim
00146 *>          RWORK is REAL array, dimension
00147 *>                      (max(NMAX,2*NRHS))
00148 *> \endverbatim
00149 *>
00150 *> \param[out] IWORK
00151 *> \verbatim
00152 *>          IWORK is INTEGER array, dimension (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 complex_lin
00172 *
00173 *  =====================================================================
00174       SUBROUTINE CDRVGB( 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       REAL               THRESH
00187 *     ..
00188 *     .. Array Arguments ..
00189       LOGICAL            DOTYPE( * )
00190       INTEGER            IWORK( * ), NVAL( * )
00191       REAL               RWORK( * ), S( * )
00192       COMPLEX            A( * ), AFB( * ), ASAV( * ), B( * ), BSAV( * ),
00193      $                   WORK( * ), X( * ), XACT( * )
00194 *     ..
00195 *
00196 *  =====================================================================
00197 *
00198 *     .. Parameters ..
00199       REAL               ONE, ZERO
00200       PARAMETER          ( ONE = 1.0E+0, ZERO = 0.0E+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       REAL               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       REAL               RDUM( 1 ), RESULT( NTESTS ), BERR( NRHS ),
00226      $                   ERRBNDS_N( NRHS,3 ), ERRBNDS_C( NRHS, 3 )
00227 *     ..
00228 *     .. External Functions ..
00229       LOGICAL            LSAME
00230       REAL               CLANGB, CLANGE, CLANTB, SGET06, SLAMCH,
00231      $                   CLA_GBRPVGRW
00232       EXTERNAL           LSAME, CLANGB, CLANGE, CLANTB, SGET06, SLAMCH,
00233      $                   CLA_GBRPVGRW
00234 *     ..
00235 *     .. External Subroutines ..
00236       EXTERNAL           ALADHD, ALAERH, ALASVM, CERRVX, CGBEQU, CGBSV,
00237      $                   CGBSVX, CGBT01, CGBT02, CGBT05, CGBTRF, CGBTRS,
00238      $                   CGET04, CLACPY, CLAQGB, CLARHS, CLASET, CLATB4,
00239      $                   CLATMS, XLAENV, CGBSVXX
00240 *     ..
00241 *     .. Intrinsic Functions ..
00242       INTRINSIC          ABS, CMPLX, 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 ) = 'Complex 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 CERRVX( 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 CLATB4 and generate a
00367 *                 test matrix with CLATMS.
00368 *
00369                   CALL CLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM,
00370      $                         MODE, CNDNUM, DIST )
00371                   RCONDC = ONE / CNDNUM
00372 *
00373                   SRNAMT = 'CLATMS'
00374                   CALL CLATMS( 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 CLATMS.
00379 *
00380                   IF( INFO.NE.0 ) THEN
00381                      CALL ALAERH( PATH, 'CLATMS', 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 CLACPY( '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 SGESVX (FACT =
00444 *                          'N' reuses the condition number from the
00445 *                          previous iteration with FACT = 'F').
00446 *
00447                            CALL CLACPY( '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 CGBEQU( 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 CLAQGB( 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 CGET04.
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 = CLANGB( '1', N, KL, KU, AFB( KL+1 ),
00489      $                              LDAFB, RWORK )
00490                            ANORMI = CLANGB( 'I', N, KL, KU, AFB( KL+1 ),
00491      $                              LDAFB, RWORK )
00492 *
00493 *                          Factor the matrix A.
00494 *
00495                            CALL CGBTRF( N, N, KL, KU, AFB, LDAFB, IWORK,
00496      $                                  INFO )
00497 *
00498 *                          Form the inverse of A.
00499 *
00500                            CALL CLASET( 'Full', N, N, CMPLX( ZERO ),
00501      $                                  CMPLX( ONE ), WORK, LDB )
00502                            SRNAMT = 'CGBTRS'
00503                            CALL CGBTRS( '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 = CLANGE( '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 = CLANGE( '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 CLACPY( '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 = 'CLARHS'
00549                            CALL CLARHS( PATH, XTYPE, 'Full', TRANS, N,
00550      $                                  N, KL, KU, NRHS, A, LDA, XACT,
00551      $                                  LDB, B, LDB, ISEED, INFO )
00552                            XTYPE = 'C'
00553                            CALL CLACPY( 'Full', N, NRHS, B, LDB, BSAV,
00554      $                                  LDB )
00555 *
00556                            IF( NOFACT .AND. ITRAN.EQ.1 ) THEN
00557 *
00558 *                             --- Test CGBSV  ---
00559 *
00560 *                             Compute the LU factorization of the matrix
00561 *                             and solve the system.
00562 *
00563                               CALL CLACPY( 'Full', KL+KU+1, N, A, LDA,
00564      $                                     AFB( KL+1 ), LDAFB )
00565                               CALL CLACPY( 'Full', N, NRHS, B, LDB, X,
00566      $                                     LDB )
00567 *
00568                               SRNAMT = 'CGBSV '
00569                               CALL CGBSV( N, KL, KU, NRHS, AFB, LDAFB,
00570      $                                    IWORK, X, LDB, INFO )
00571 *
00572 *                             Check error code from CGBSV .
00573 *
00574                               IF( INFO.NE.IZERO )
00575      $                           CALL ALAERH( PATH, 'CGBSV ', 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 CGBT01( 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 CLACPY( 'Full', N, NRHS, B, LDB,
00593      $                                        WORK, LDB )
00594                                  CALL CGBT02( '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 CGET04( 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 )'CGBSV ',
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 CGBSVX ---
00622 *
00623                            IF( .NOT.PREFAC )
00624      $                        CALL CLASET( 'Full', 2*KL+KU+1, N,
00625      $                                     CMPLX( ZERO ), CMPLX( ZERO ),
00626      $                                     AFB, LDAFB )
00627                            CALL CLASET( 'Full', N, NRHS, CMPLX( ZERO ),
00628      $                                  CMPLX( ZERO ), X, LDB )
00629                            IF( IEQUED.GT.1 .AND. N.GT.0 ) THEN
00630 *
00631 *                             Equilibrate the matrix if FACT = 'F' and
00632 *                             EQUED = 'R', 'C', or 'B'.
00633 *
00634                               CALL CLAQGB( N, N, KL, KU, A, LDA, S,
00635      $                                     S( N+1 ), ROWCND, COLCND,
00636      $                                     AMAX, EQUED )
00637                            END IF
00638 *
00639 *                          Solve the system and compute the condition
00640 *                          number and error bounds using CGBSVX.
00641 *
00642                            SRNAMT = 'CGBSVX'
00643                            CALL CGBSVX( FACT, TRANS, N, KL, KU, NRHS, A,
00644      $                                  LDA, AFB, LDAFB, IWORK, EQUED,
00645      $                                  S, S( LDB+1 ), B, LDB, X, LDB,
00646      $                                  RCOND, RWORK, RWORK( NRHS+1 ),
00647      $                                  WORK, RWORK( 2*NRHS+1 ), INFO )
00648 *
00649 *                          Check the error code from CGBSVX.
00650 *
00651                            IF( INFO.NE.IZERO )
00652      $                        CALL ALAERH( PATH, 'CGBSVX', INFO, IZERO,
00653      $                                     FACT // TRANS, N, N, KL, KU,
00654      $                                     NRHS, IMAT, NFAIL, NERRS,
00655      $                                     NOUT )
00656 *
00657 *                          Compare RWORK(2*NRHS+1) from CGBSVX with the
00658 *                          computed reciprocal pivot growth RPVGRW
00659 *
00660                            IF( INFO.NE.0 ) THEN
00661                               ANRMPV = ZERO
00662                               DO 70 J = 1, INFO
00663                                  DO 60 I = MAX( KU+2-J, 1 ),
00664      $                                   MIN( N+KU+1-J, KL+KU+1 )
00665                                     ANRMPV = MAX( ANRMPV,
00666      $                                       ABS( A( I+( J-1 )*LDA ) ) )
00667    60                            CONTINUE
00668    70                         CONTINUE
00669                               RPVGRW = CLANTB( 'M', 'U', 'N', INFO,
00670      $                                 MIN( INFO-1, KL+KU ),
00671      $                                 AFB( MAX( 1, KL+KU+2-INFO ) ),
00672      $                                 LDAFB, RDUM )
00673                               IF( RPVGRW.EQ.ZERO ) THEN
00674                                  RPVGRW = ONE
00675                               ELSE
00676                                  RPVGRW = ANRMPV / RPVGRW
00677                               END IF
00678                            ELSE
00679                               RPVGRW = CLANTB( 'M', 'U', 'N', N, KL+KU,
00680      $                                 AFB, LDAFB, RDUM )
00681                               IF( RPVGRW.EQ.ZERO ) THEN
00682                                  RPVGRW = ONE
00683                               ELSE
00684                                  RPVGRW = CLANGB( 'M', N, KL, KU, A,
00685      $                                    LDA, RDUM ) / RPVGRW
00686                               END IF
00687                            END IF
00688                            RESULT( 7 ) = ABS( RPVGRW-RWORK( 2*NRHS+1 ) )
00689      $                                    / MAX( RWORK( 2*NRHS+1 ),
00690      $                                   RPVGRW ) / SLAMCH( 'E' )
00691 *
00692                            IF( .NOT.PREFAC ) THEN
00693 *
00694 *                             Reconstruct matrix from factors and
00695 *                             compute residual.
00696 *
00697                               CALL CGBT01( N, N, KL, KU, A, LDA, AFB,
00698      $                                     LDAFB, IWORK, WORK,
00699      $                                     RESULT( 1 ) )
00700                               K1 = 1
00701                            ELSE
00702                               K1 = 2
00703                            END IF
00704 *
00705                            IF( INFO.EQ.0 ) THEN
00706                               TRFCON = .FALSE.
00707 *
00708 *                             Compute residual of the computed solution.
00709 *
00710                               CALL CLACPY( 'Full', N, NRHS, BSAV, LDB,
00711      $                                     WORK, LDB )
00712                               CALL CGBT02( TRANS, N, N, KL, KU, NRHS,
00713      $                                     ASAV, LDA, X, LDB, WORK, LDB,
00714      $                                     RESULT( 2 ) )
00715 *
00716 *                             Check solution from generated exact
00717 *                             solution.
00718 *
00719                               IF( NOFACT .OR. ( PREFAC .AND.
00720      $                            LSAME( EQUED, 'N' ) ) ) THEN
00721                                  CALL CGET04( N, NRHS, X, LDB, XACT,
00722      $                                        LDB, RCONDC, RESULT( 3 ) )
00723                               ELSE
00724                                  IF( ITRAN.EQ.1 ) THEN
00725                                     ROLDC = ROLDO
00726                                  ELSE
00727                                     ROLDC = ROLDI
00728                                  END IF
00729                                  CALL CGET04( N, NRHS, X, LDB, XACT,
00730      $                                        LDB, ROLDC, RESULT( 3 ) )
00731                               END IF
00732 *
00733 *                             Check the error bounds from iterative
00734 *                             refinement.
00735 *
00736                               CALL CGBT05( TRANS, N, KL, KU, NRHS, ASAV,
00737      $                                     LDA, BSAV, LDB, X, LDB, XACT,
00738      $                                     LDB, RWORK, RWORK( NRHS+1 ),
00739      $                                     RESULT( 4 ) )
00740                            ELSE
00741                               TRFCON = .TRUE.
00742                            END IF
00743 *
00744 *                          Compare RCOND from CGBSVX with the computed
00745 *                          value in RCONDC.
00746 *
00747                            RESULT( 6 ) = SGET06( RCOND, RCONDC )
00748 *
00749 *                          Print information about the tests that did
00750 *                          not pass the threshold.
00751 *
00752                            IF( .NOT.TRFCON ) THEN
00753                               DO 80 K = K1, NTESTS
00754                                  IF( RESULT( K ).GE.THRESH ) THEN
00755                                     IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00756      $                                 CALL ALADHD( NOUT, PATH )
00757                                     IF( PREFAC ) THEN
00758                                        WRITE( NOUT, FMT = 9995 )
00759      $                                    'CGBSVX', FACT, TRANS, N, KL,
00760      $                                    KU, EQUED, IMAT, K,
00761      $                                    RESULT( K )
00762                                     ELSE
00763                                        WRITE( NOUT, FMT = 9996 )
00764      $                                    'CGBSVX', FACT, TRANS, N, KL,
00765      $                                    KU, IMAT, K, RESULT( K )
00766                                     END IF
00767                                     NFAIL = NFAIL + 1
00768                                  END IF
00769    80                         CONTINUE
00770                               NRUN = NRUN + 7 - K1
00771                            ELSE
00772                               IF( RESULT( 1 ).GE.THRESH .AND. .NOT.
00773      $                            PREFAC ) THEN
00774                                  IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00775      $                              CALL ALADHD( NOUT, PATH )
00776                                  IF( PREFAC ) THEN
00777                                     WRITE( NOUT, FMT = 9995 )'CGBSVX',
00778      $                                 FACT, TRANS, N, KL, KU, EQUED,
00779      $                                 IMAT, 1, RESULT( 1 )
00780                                  ELSE
00781                                     WRITE( NOUT, FMT = 9996 )'CGBSVX',
00782      $                                 FACT, TRANS, N, KL, KU, IMAT, 1,
00783      $                                 RESULT( 1 )
00784                                  END IF
00785                                  NFAIL = NFAIL + 1
00786                                  NRUN = NRUN + 1
00787                               END IF
00788                               IF( RESULT( 6 ).GE.THRESH ) THEN
00789                                  IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00790      $                              CALL ALADHD( NOUT, PATH )
00791                                  IF( PREFAC ) THEN
00792                                     WRITE( NOUT, FMT = 9995 )'CGBSVX',
00793      $                                 FACT, TRANS, N, KL, KU, EQUED,
00794      $                                 IMAT, 6, RESULT( 6 )
00795                                  ELSE
00796                                     WRITE( NOUT, FMT = 9996 )'CGBSVX',
00797      $                                 FACT, TRANS, N, KL, KU, IMAT, 6,
00798      $                                 RESULT( 6 )
00799                                  END IF
00800                                  NFAIL = NFAIL + 1
00801                                  NRUN = NRUN + 1
00802                               END IF
00803                               IF( RESULT( 7 ).GE.THRESH ) THEN
00804                                  IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00805      $                              CALL ALADHD( NOUT, PATH )
00806                                  IF( PREFAC ) THEN
00807                                     WRITE( NOUT, FMT = 9995 )'CGBSVX',
00808      $                                 FACT, TRANS, N, KL, KU, EQUED,
00809      $                                 IMAT, 7, RESULT( 7 )
00810                                  ELSE
00811                                     WRITE( NOUT, FMT = 9996 )'CGBSVX',
00812      $                                 FACT, TRANS, N, KL, KU, IMAT, 7,
00813      $                                 RESULT( 7 )
00814                                  END IF
00815                                  NFAIL = NFAIL + 1
00816                                  NRUN = NRUN + 1
00817                               END IF
00818                            END IF
00819 
00820 *                    --- Test CGBSVXX ---
00821 
00822 *                    Restore the matrices A and B.
00823 
00824 c                     write(*,*) 'begin cgbsvxx testing'
00825 
00826                      CALL CLACPY( 'Full', KL+KU+1, N, ASAV, LDA, A,
00827      $                          LDA )
00828                      CALL CLACPY( 'Full', N, NRHS, BSAV, LDB, B, LDB )
00829 
00830                      IF( .NOT.PREFAC )
00831      $                  CALL CLASET( 'Full', 2*KL+KU+1, N,
00832      $                               CMPLX( ZERO ), CMPLX( ZERO ),
00833      $                               AFB, LDAFB )
00834                      CALL CLASET( 'Full', N, NRHS,
00835      $                            CMPLX( ZERO ), CMPLX( ZERO ),
00836      $                               X, LDB )
00837                      IF( IEQUED.GT.1 .AND. N.GT.0 ) THEN
00838 *
00839 *                       Equilibrate the matrix if FACT = 'F' and
00840 *                       EQUED = 'R', 'C', or 'B'.
00841 *
00842                         CALL CLAQGB( N, N, KL, KU, A, LDA, S,
00843      $                       S( N+1 ), ROWCND, COLCND, AMAX, EQUED )
00844                      END IF
00845 *
00846 *                    Solve the system and compute the condition number
00847 *                    and error bounds using CGBSVXX.
00848 *
00849                      SRNAMT = 'CGBSVXX'
00850                      N_ERR_BNDS = 3
00851                      CALL CGBSVXX( FACT, TRANS, N, KL, KU, NRHS, A, LDA,
00852      $                    AFB, LDAFB, IWORK, EQUED, S, S( N+1 ), B, LDB,
00853      $                    X, LDB, RCOND, RPVGRW_SVXX, BERR, N_ERR_BNDS,
00854      $                    ERRBNDS_N, ERRBNDS_C, 0, ZERO, WORK,
00855      $                    RWORK, INFO )
00856 *
00857 *                    Check the error code from CGBSVXX.
00858 *
00859                      IF( INFO.EQ.N+1 ) GOTO 90
00860                      IF( INFO.NE.IZERO ) THEN
00861                         CALL ALAERH( PATH, 'CGBSVXX', INFO, IZERO,
00862      $                               FACT // TRANS, N, N, -1, -1, NRHS,
00863      $                               IMAT, NFAIL, NERRS, NOUT )
00864                         GOTO 90
00865                      END IF
00866 *
00867 *                    Compare rpvgrw_svxx from CGESVXX with the computed
00868 *                    reciprocal pivot growth factor RPVGRW
00869 *
00870 
00871                      IF ( INFO .GT. 0 .AND. INFO .LT. N+1 ) THEN
00872                         RPVGRW = CLA_GBRPVGRW(N, KL, KU, INFO, A, LDA,
00873      $                       AFB, LDAFB)
00874                      ELSE
00875                         RPVGRW = CLA_GBRPVGRW(N, KL, KU, N, A, LDA,
00876      $                       AFB, LDAFB)
00877                      ENDIF
00878 
00879                      RESULT( 7 ) = ABS( RPVGRW-rpvgrw_svxx ) /
00880      $                             MAX( rpvgrw_svxx, RPVGRW ) /
00881      $                             SLAMCH( 'E' )
00882 *
00883                      IF( .NOT.PREFAC ) THEN
00884 *
00885 *                       Reconstruct matrix from factors and compute
00886 *                       residual.
00887 *
00888                         CALL CGBT01( N, N, KL, KU, A, LDA, AFB, LDAFB,
00889      $                       IWORK, WORK( 2*NRHS+1 ), RESULT( 1 ) )
00890                         K1 = 1
00891                      ELSE
00892                         K1 = 2
00893                      END IF
00894 *
00895                      IF( INFO.EQ.0 ) THEN
00896                         TRFCON = .FALSE.
00897 *
00898 *                       Compute residual of the computed solution.
00899 *
00900                         CALL CLACPY( 'Full', N, NRHS, BSAV, LDB, WORK,
00901      $                               LDB )
00902                         CALL CGBT02( TRANS, N, N, KL, KU, NRHS, ASAV,
00903      $                       LDA, X, LDB, WORK, LDB, RESULT( 2 ) )
00904 *
00905 *                       Check solution from generated exact solution.
00906 *
00907                         IF( NOFACT .OR. ( PREFAC .AND. LSAME( EQUED,
00908      $                      'N' ) ) ) THEN
00909                            CALL CGET04( N, NRHS, X, LDB, XACT, LDB,
00910      $                                  RCONDC, RESULT( 3 ) )
00911                         ELSE
00912                            IF( ITRAN.EQ.1 ) THEN
00913                               ROLDC = ROLDO
00914                            ELSE
00915                               ROLDC = ROLDI
00916                            END IF
00917                            CALL CGET04( N, NRHS, X, LDB, XACT, LDB,
00918      $                                  ROLDC, RESULT( 3 ) )
00919                         END IF
00920                      ELSE
00921                         TRFCON = .TRUE.
00922                      END IF
00923 *
00924 *                    Compare RCOND from CGBSVXX with the computed value
00925 *                    in RCONDC.
00926 *
00927                      RESULT( 6 ) = SGET06( RCOND, RCONDC )
00928 *
00929 *                    Print information about the tests that did not pass
00930 *                    the threshold.
00931 *
00932                      IF( .NOT.TRFCON ) THEN
00933                         DO 45 K = K1, NTESTS
00934                            IF( RESULT( K ).GE.THRESH ) THEN
00935                               IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00936      $                           CALL ALADHD( NOUT, PATH )
00937                               IF( PREFAC ) THEN
00938                                  WRITE( NOUT, FMT = 9995 )'CGBSVXX',
00939      $                                FACT, TRANS, N, KL, KU, EQUED,
00940      $                                IMAT, K, RESULT( K )
00941                               ELSE
00942                                  WRITE( NOUT, FMT = 9996 )'CGBSVXX',
00943      $                                FACT, TRANS, N, KL, KU, IMAT, K,
00944      $                                RESULT( K )
00945                               END IF
00946                               NFAIL = NFAIL + 1
00947                            END IF
00948  45                     CONTINUE
00949                         NRUN = NRUN + 7 - K1
00950                      ELSE
00951                         IF( RESULT( 1 ).GE.THRESH .AND. .NOT.PREFAC )
00952      $                       THEN
00953                            IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00954      $                        CALL ALADHD( NOUT, PATH )
00955                            IF( PREFAC ) THEN
00956                               WRITE( NOUT, FMT = 9995 )'CGBSVXX', FACT,
00957      $                             TRANS, N, KL, KU, EQUED, IMAT, 1,
00958      $                             RESULT( 1 )
00959                            ELSE
00960                               WRITE( NOUT, FMT = 9996 )'CGBSVXX', FACT,
00961      $                             TRANS, N, KL, KU, IMAT, 1,
00962      $                             RESULT( 1 )
00963                            END IF
00964                            NFAIL = NFAIL + 1
00965                            NRUN = NRUN + 1
00966                         END IF
00967                         IF( RESULT( 6 ).GE.THRESH ) THEN
00968                            IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00969      $                        CALL ALADHD( NOUT, PATH )
00970                            IF( PREFAC ) THEN
00971                               WRITE( NOUT, FMT = 9995 )'CGBSVXX', FACT,
00972      $                             TRANS, N, KL, KU, EQUED, IMAT, 6,
00973      $                             RESULT( 6 )
00974                            ELSE
00975                               WRITE( NOUT, FMT = 9996 )'CGBSVXX', FACT,
00976      $                             TRANS, N, KL, KU, IMAT, 6,
00977      $                             RESULT( 6 )
00978                            END IF
00979                            NFAIL = NFAIL + 1
00980                            NRUN = NRUN + 1
00981                         END IF
00982                         IF( RESULT( 7 ).GE.THRESH ) THEN
00983                            IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00984      $                        CALL ALADHD( NOUT, PATH )
00985                            IF( PREFAC ) THEN
00986                               WRITE( NOUT, FMT = 9995 )'CGBSVXX', FACT,
00987      $                             TRANS, N, KL, KU, EQUED, IMAT, 7,
00988      $                             RESULT( 7 )
00989                            ELSE
00990                               WRITE( NOUT, FMT = 9996 )'CGBSVXX', FACT,
00991      $                             TRANS, N, KL, KU, IMAT, 7,
00992      $                             RESULT( 7 )
00993                            END IF
00994                            NFAIL = NFAIL + 1
00995                            NRUN = NRUN + 1
00996                         END IF
00997 *
00998                      END IF
00999 *
01000    90                   CONTINUE
01001   100                CONTINUE
01002   110             CONTINUE
01003   120          CONTINUE
01004   130       CONTINUE
01005   140    CONTINUE
01006   150 CONTINUE
01007 *
01008 *     Print a summary of the results.
01009 *
01010       CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS )
01011 *
01012 
01013 *     Test Error Bounds from CGBSVXX
01014 
01015       CALL CEBCHVXX(THRESH, PATH)
01016 
01017  9999 FORMAT( ' *** In CDRVGB, LA=', I5, ' is too small for N=', I5,
01018      $      ', KU=', I5, ', KL=', I5, / ' ==> Increase LA to at least ',
01019      $      I5 )
01020  9998 FORMAT( ' *** In CDRVGB, LAFB=', I5, ' is too small for N=', I5,
01021      $      ', KU=', I5, ', KL=', I5, /
01022      $      ' ==> Increase LAFB to at least ', I5 )
01023  9997 FORMAT( 1X, A, ', N=', I5, ', KL=', I5, ', KU=', I5, ', type ',
01024      $      I1, ', test(', I1, ')=', G12.5 )
01025  9996 FORMAT( 1X, A, '( ''', A1, ''',''', A1, ''',', I5, ',', I5, ',',
01026      $      I5, ',...), type ', I1, ', test(', I1, ')=', G12.5 )
01027  9995 FORMAT( 1X, A, '( ''', A1, ''',''', A1, ''',', I5, ',', I5, ',',
01028      $      I5, ',...), EQUED=''', A1, ''', type ', I1, ', test(', I1,
01029      $      ')=', G12.5 )
01030 *
01031       RETURN
01032 *
01033 *     End of CDRVGB
01034 *
01035       END
 All Files Functions