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