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