LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
sdrvge.f
Go to the documentation of this file.
00001 *> \brief \b SDRVGE
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 SDRVGE( 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               A( * ), AFAC( * ), ASAV( * ), B( * ),
00024 *      $                   BSAV( * ), RWORK( * ), S( * ), WORK( * ),
00025 *      $                   X( * ), XACT( * )
00026 *       ..
00027 *  
00028 *
00029 *> \par Purpose:
00030 *  =============
00031 *>
00032 *> \verbatim
00033 *>
00034 *> SDRVGE tests the driver routines SGESV 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 REAL array, dimension (NMAX*NMAX)
00091 *> \endverbatim
00092 *>
00093 *> \param[out] AFAC
00094 *> \verbatim
00095 *>          AFAC is REAL array, dimension (NMAX*NMAX)
00096 *> \endverbatim
00097 *>
00098 *> \param[out] ASAV
00099 *> \verbatim
00100 *>          ASAV is REAL array, dimension (NMAX*NMAX)
00101 *> \endverbatim
00102 *>
00103 *> \param[out] B
00104 *> \verbatim
00105 *>          B is REAL array, dimension (NMAX*NRHS)
00106 *> \endverbatim
00107 *>
00108 *> \param[out] BSAV
00109 *> \verbatim
00110 *>          BSAV is REAL array, dimension (NMAX*NRHS)
00111 *> \endverbatim
00112 *>
00113 *> \param[out] X
00114 *> \verbatim
00115 *>          X is REAL array, dimension (NMAX*NRHS)
00116 *> \endverbatim
00117 *>
00118 *> \param[out] XACT
00119 *> \verbatim
00120 *>          XACT is REAL 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 REAL 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 (2*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 single_lin
00161 *
00162 *  =====================================================================
00163       SUBROUTINE SDRVGE( 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               A( * ), AFAC( * ), ASAV( * ), B( * ),
00181      $                   BSAV( * ), RWORK( * ), S( * ), WORK( * ),
00182      $                   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               RESULT( NTESTS )
00212 *     ..
00213 *     .. External Functions ..
00214       LOGICAL            LSAME
00215       REAL               SGET06, SLAMCH, SLANGE, SLANTR
00216       EXTERNAL           LSAME, SGET06, SLAMCH, SLANGE, SLANTR
00217 *     ..
00218 *     .. External Subroutines ..
00219       EXTERNAL           ALADHD, ALAERH, ALASVM, SERRVX, SGEEQU, SGESV,
00220      $                   SGESVX, SGET01, SGET02, SGET04, SGET07, SGETRF,
00221      $                   SGETRI, SLACPY, SLAQGE, SLARHS, SLASET, SLATB4,
00222      $                   SLATMS, XLAENV
00223 *     ..
00224 *     .. Intrinsic Functions ..
00225       INTRINSIC          ABS, 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 ) = 'Single 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 SERRVX( 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 SLATB4 and generate a test matrix
00292 *           with SLATMS.
00293 *
00294             CALL SLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM, MODE,
00295      $                   CNDNUM, DIST )
00296             RCONDC = ONE / CNDNUM
00297 *
00298             SRNAMT = 'SLATMS'
00299             CALL SLATMS( 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 SLATMS.
00304 *
00305             IF( INFO.NE.0 ) THEN
00306                CALL ALAERH( PATH, 'SLATMS', 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 SLASET( 'Full', N, N-IZERO+1, ZERO, ZERO,
00329      $                         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 SLACPY( '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 SGESVX (FACT = 'N' reuses
00363 *                    the condition number from the previous iteration
00364 *                    with FACT = 'F').
00365 *
00366                      CALL SLACPY( '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 SGEEQU( 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 SLAQGE( 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 SGET04.
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 = SLANGE( '1', N, N, AFAC, LDA, RWORK )
00404                      ANORMI = SLANGE( 'I', N, N, AFAC, LDA, RWORK )
00405 *
00406 *                    Factor the matrix A.
00407 *
00408                      SRNAMT = 'SGETRF'
00409                      CALL SGETRF( N, N, AFAC, LDA, IWORK, INFO )
00410 *
00411 *                    Form the inverse of A.
00412 *
00413                      CALL SLACPY( 'Full', N, N, AFAC, LDA, A, LDA )
00414                      LWORK = NMAX*MAX( 3, NRHS )
00415                      SRNAMT = 'SGETRI'
00416                      CALL SGETRI( N, A, LDA, IWORK, WORK, LWORK, INFO )
00417 *
00418 *                    Compute the 1-norm condition number of A.
00419 *
00420                      AINVNM = SLANGE( '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 = SLANGE( '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 SLACPY( 'Full', N, N, ASAV, LDA, A, LDA )
00451 *
00452 *                    Form an exact solution and set the right hand side.
00453 *
00454                      SRNAMT = 'SLARHS'
00455                      CALL SLARHS( PATH, XTYPE, 'Full', TRANS, N, N, KL,
00456      $                            KU, NRHS, A, LDA, XACT, LDA, B, LDA,
00457      $                            ISEED, INFO )
00458                      XTYPE = 'C'
00459                      CALL SLACPY( 'Full', N, NRHS, B, LDA, BSAV, LDA )
00460 *
00461                      IF( NOFACT .AND. ITRAN.EQ.1 ) THEN
00462 *
00463 *                       --- Test SGESV  ---
00464 *
00465 *                       Compute the LU factorization of the matrix and
00466 *                       solve the system.
00467 *
00468                         CALL SLACPY( 'Full', N, N, A, LDA, AFAC, LDA )
00469                         CALL SLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
00470 *
00471                         SRNAMT = 'SGESV '
00472                         CALL SGESV( N, NRHS, AFAC, LDA, IWORK, X, LDA,
00473      $                              INFO )
00474 *
00475 *                       Check error code from SGESV .
00476 *
00477                         IF( INFO.NE.IZERO )
00478      $                     CALL ALAERH( PATH, 'SGESV ', 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 SGET01( 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 SLACPY( 'Full', N, NRHS, B, LDA, WORK,
00493      $                                  LDA )
00494                            CALL SGET02( '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 SGET04( 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 )'SGESV ', 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 SGESVX ---
00521 *
00522                      IF( .NOT.PREFAC )
00523      $                  CALL SLASET( 'Full', N, N, ZERO, ZERO, AFAC,
00524      $                               LDA )
00525                      CALL SLASET( 'Full', N, NRHS, ZERO, ZERO, X, LDA )
00526                      IF( IEQUED.GT.1 .AND. N.GT.0 ) THEN
00527 *
00528 *                       Equilibrate the matrix if FACT = 'F' and
00529 *                       EQUED = 'R', 'C', or 'B'.
00530 *
00531                         CALL SLAQGE( N, N, A, LDA, S, S( N+1 ), ROWCND,
00532      $                               COLCND, AMAX, EQUED )
00533                      END IF
00534 *
00535 *                    Solve the system and compute the condition number
00536 *                    and error bounds using SGESVX.
00537 *
00538                      SRNAMT = 'SGESVX'
00539                      CALL SGESVX( FACT, TRANS, N, NRHS, A, LDA, AFAC,
00540      $                            LDA, IWORK, EQUED, S, S( N+1 ), B,
00541      $                            LDA, X, LDA, RCOND, RWORK,
00542      $                            RWORK( NRHS+1 ), WORK, IWORK( N+1 ),
00543      $                            INFO )
00544 *
00545 *                    Check the error code from SGESVX.
00546 *
00547                      IF( INFO.NE.IZERO )
00548      $                  CALL ALAERH( PATH, 'SGESVX', INFO, IZERO,
00549      $                               FACT // TRANS, N, N, -1, -1, NRHS,
00550      $                               IMAT, NFAIL, NERRS, NOUT )
00551 *
00552 *                    Compare WORK(1) from SGESVX with the computed
00553 *                    reciprocal pivot growth factor RPVGRW
00554 *
00555                      IF( INFO.NE.0 ) THEN
00556                         RPVGRW = SLANTR( 'M', 'U', 'N', INFO, INFO,
00557      $                           AFAC, LDA, WORK )
00558                         IF( RPVGRW.EQ.ZERO ) THEN
00559                            RPVGRW = ONE
00560                         ELSE
00561                            RPVGRW = SLANGE( 'M', N, INFO, A, LDA,
00562      $                              WORK ) / RPVGRW
00563                         END IF
00564                      ELSE
00565                         RPVGRW = SLANTR( 'M', 'U', 'N', N, N, AFAC, LDA,
00566      $                           WORK )
00567                         IF( RPVGRW.EQ.ZERO ) THEN
00568                            RPVGRW = ONE
00569                         ELSE
00570                            RPVGRW = SLANGE( 'M', N, N, A, LDA, WORK ) /
00571      $                              RPVGRW
00572                         END IF
00573                      END IF
00574                      RESULT( 7 ) = ABS( RPVGRW-WORK( 1 ) ) /
00575      $                             MAX( WORK( 1 ), RPVGRW ) /
00576      $                             SLAMCH( 'E' )
00577 *
00578                      IF( .NOT.PREFAC ) THEN
00579 *
00580 *                       Reconstruct matrix from factors and compute
00581 *                       residual.
00582 *
00583                         CALL SGET01( N, N, A, LDA, AFAC, LDA, IWORK,
00584      $                               RWORK( 2*NRHS+1 ), RESULT( 1 ) )
00585                         K1 = 1
00586                      ELSE
00587                         K1 = 2
00588                      END IF
00589 *
00590                      IF( INFO.EQ.0 ) THEN
00591                         TRFCON = .FALSE.
00592 *
00593 *                       Compute residual of the computed solution.
00594 *
00595                         CALL SLACPY( 'Full', N, NRHS, BSAV, LDA, WORK,
00596      $                               LDA )
00597                         CALL SGET02( TRANS, N, N, NRHS, ASAV, LDA, X,
00598      $                               LDA, WORK, LDA, RWORK( 2*NRHS+1 ),
00599      $                               RESULT( 2 ) )
00600 *
00601 *                       Check solution from generated exact solution.
00602 *
00603                         IF( NOFACT .OR. ( PREFAC .AND. LSAME( EQUED,
00604      $                      'N' ) ) ) THEN
00605                            CALL SGET04( N, NRHS, X, LDA, XACT, LDA,
00606      $                                  RCONDC, RESULT( 3 ) )
00607                         ELSE
00608                            IF( ITRAN.EQ.1 ) THEN
00609                               ROLDC = ROLDO
00610                            ELSE
00611                               ROLDC = ROLDI
00612                            END IF
00613                            CALL SGET04( N, NRHS, X, LDA, XACT, LDA,
00614      $                                  ROLDC, RESULT( 3 ) )
00615                         END IF
00616 *
00617 *                       Check the error bounds from iterative
00618 *                       refinement.
00619 *
00620                         CALL SGET07( TRANS, N, NRHS, ASAV, LDA, B, LDA,
00621      $                               X, LDA, XACT, LDA, RWORK, .TRUE.,
00622      $                               RWORK( NRHS+1 ), RESULT( 4 ) )
00623                      ELSE
00624                         TRFCON = .TRUE.
00625                      END IF
00626 *
00627 *                    Compare RCOND from SGESVX with the computed value
00628 *                    in RCONDC.
00629 *
00630                      RESULT( 6 ) = SGET06( RCOND, RCONDC )
00631 *
00632 *                    Print information about the tests that did not pass
00633 *                    the threshold.
00634 *
00635                      IF( .NOT.TRFCON ) THEN
00636                         DO 40 K = K1, NTESTS
00637                            IF( RESULT( K ).GE.THRESH ) THEN
00638                               IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00639      $                           CALL ALADHD( NOUT, PATH )
00640                               IF( PREFAC ) THEN
00641                                  WRITE( NOUT, FMT = 9997 )'SGESVX',
00642      $                              FACT, TRANS, N, EQUED, IMAT, K,
00643      $                              RESULT( K )
00644                               ELSE
00645                                  WRITE( NOUT, FMT = 9998 )'SGESVX',
00646      $                              FACT, TRANS, N, IMAT, K, RESULT( K )
00647                               END IF
00648                               NFAIL = NFAIL + 1
00649                            END IF
00650    40                   CONTINUE
00651                         NRUN = NRUN + 7 - K1
00652                      ELSE
00653                         IF( RESULT( 1 ).GE.THRESH .AND. .NOT.PREFAC )
00654      $                       THEN
00655                            IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00656      $                        CALL ALADHD( NOUT, PATH )
00657                            IF( PREFAC ) THEN
00658                               WRITE( NOUT, FMT = 9997 )'SGESVX', FACT,
00659      $                           TRANS, N, EQUED, IMAT, 1, RESULT( 1 )
00660                            ELSE
00661                               WRITE( NOUT, FMT = 9998 )'SGESVX', FACT,
00662      $                           TRANS, N, IMAT, 1, RESULT( 1 )
00663                            END IF
00664                            NFAIL = NFAIL + 1
00665                            NRUN = NRUN + 1
00666                         END IF
00667                         IF( RESULT( 6 ).GE.THRESH ) THEN
00668                            IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00669      $                        CALL ALADHD( NOUT, PATH )
00670                            IF( PREFAC ) THEN
00671                               WRITE( NOUT, FMT = 9997 )'SGESVX', FACT,
00672      $                           TRANS, N, EQUED, IMAT, 6, RESULT( 6 )
00673                            ELSE
00674                               WRITE( NOUT, FMT = 9998 )'SGESVX', FACT,
00675      $                           TRANS, N, IMAT, 6, RESULT( 6 )
00676                            END IF
00677                            NFAIL = NFAIL + 1
00678                            NRUN = NRUN + 1
00679                         END IF
00680                         IF( RESULT( 7 ).GE.THRESH ) THEN
00681                            IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00682      $                        CALL ALADHD( NOUT, PATH )
00683                            IF( PREFAC ) THEN
00684                               WRITE( NOUT, FMT = 9997 )'SGESVX', FACT,
00685      $                           TRANS, N, EQUED, IMAT, 7, RESULT( 7 )
00686                            ELSE
00687                               WRITE( NOUT, FMT = 9998 )'SGESVX', FACT,
00688      $                           TRANS, N, IMAT, 7, RESULT( 7 )
00689                            END IF
00690                            NFAIL = NFAIL + 1
00691                            NRUN = NRUN + 1
00692                         END IF
00693 *
00694                      END IF
00695 *
00696    50             CONTINUE
00697    60          CONTINUE
00698    70       CONTINUE
00699    80    CONTINUE
00700    90 CONTINUE
00701 *
00702 *     Print a summary of the results.
00703 *
00704       CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS )
00705 *
00706  9999 FORMAT( 1X, A, ', N =', I5, ', type ', I2, ', test(', I2, ') =',
00707      $      G12.5 )
00708  9998 FORMAT( 1X, A, ', FACT=''', A1, ''', TRANS=''', A1, ''', N=', I5,
00709      $      ', type ', I2, ', test(', I1, ')=', G12.5 )
00710  9997 FORMAT( 1X, A, ', FACT=''', A1, ''', TRANS=''', A1, ''', N=', I5,
00711      $      ', EQUED=''', A1, ''', type ', I2, ', test(', I1, ')=',
00712      $      G12.5 )
00713       RETURN
00714 *
00715 *     End of SDRVGE
00716 *
00717       END
 All Files Functions