LAPACK: TESTING/LIN/sdrvgex.f Source File

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