LAPACK: TESTING/LIN/sdrvpox.f Source File

Go to the documentation of this file.
00001       SUBROUTINE SDRVPO( 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 *  SDRVPO tests the driver routines SPOSV, -SVX, and -SVXX.
00026 *
00027 *  Note that this file is used only when the XBLAS are available,
00028 *  otherwise sdrvpo.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 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 (NMAX)
00075 *
00076 *  WORK    (workspace) REAL array, dimension
00077 *                      (NMAX*max(3,NRHS))
00078 *
00079 *  RWORK   (workspace) REAL array, dimension (NMAX+2*NRHS)
00080 *
00081 *  IWORK   (workspace) INTEGER array, dimension (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 = 9 )
00093       INTEGER            NTESTS
00094       PARAMETER          ( NTESTS = 6 )
00095 *     ..
00096 *     .. Local Scalars ..
00097       LOGICAL            EQUIL, NOFACT, PREFAC, ZEROT
00098       CHARACTER          DIST, EQUED, FACT, TYPE, UPLO, XTYPE
00099       CHARACTER*3        PATH
00100       INTEGER            I, IEQUED, IFACT, IMAT, IN, INFO, IOFF, IUPLO,
00101      $                   IZERO, K, K1, KL, KU, LDA, MODE, N, NB, NBMIN,
00102      $                   NERRS, NFACT, NFAIL, NIMAT, NRUN, NT,
00103      $                   N_ERR_BNDS
00104       REAL               AINVNM, AMAX, ANORM, CNDNUM, RCOND, RCONDC,
00105      $                   ROLDC, SCOND, RPVGRW_SVXX
00106 *     ..
00107 *     .. Local Arrays ..
00108       CHARACTER          EQUEDS( 2 ), FACTS( 3 ), UPLOS( 2 )
00109       INTEGER            ISEED( 4 ), ISEEDY( 4 )
00110       REAL               RESULT( NTESTS ), BERR( NRHS ),
00111      $                   ERRBNDS_N( NRHS, 3 ), ERRBNDS_C( NRHS, 3 )
00112 *     ..
00113 *     .. External Functions ..
00114       LOGICAL            LSAME
00115       REAL               SGET06, SLANSY
00116       EXTERNAL           LSAME, SGET06, SLANSY
00117 *     ..
00118 *     .. External Subroutines ..
00119       EXTERNAL           ALADHD, ALAERH, ALASVM, SERRVX, SGET04, SLACPY,
00120      $                   SLAQSY, SLARHS, SLASET, SLATB4, SLATMS, SPOEQU,
00121      $                   SPOSV, SPOSVX, SPOT01, SPOT02, SPOT05, SPOTRF,
00122      $                   SPOTRI, XLAENV
00123 *     ..
00124 *     .. Intrinsic Functions ..
00125       INTRINSIC          MAX
00126 *     ..
00127 *     .. Scalars in Common ..
00128       LOGICAL            LERR, OK
00129       CHARACTER*32       SRNAMT
00130       INTEGER            INFOT, NUNIT
00131 *     ..
00132 *     .. Common blocks ..
00133       COMMON             / INFOC / INFOT, NUNIT, OK, LERR
00134       COMMON             / SRNAMC / SRNAMT
00135 *     ..
00136 *     .. Data statements ..
00137       DATA               ISEEDY / 1988, 1989, 1990, 1991 /
00138       DATA               UPLOS / 'U', 'L' /
00139       DATA               FACTS / 'F', 'N', 'E' /
00140       DATA               EQUEDS / 'N', 'Y' /
00141 *     ..
00142 *     .. Executable Statements ..
00143 *
00144 *     Initialize constants and the random number seed.
00145 *
00146       PATH( 1: 1 ) = 'Single precision'
00147       PATH( 2: 3 ) = 'PO'
00148       NRUN = 0
00149       NFAIL = 0
00150       NERRS = 0
00151       DO 10 I = 1, 4
00152          ISEED( I ) = ISEEDY( I )
00153    10 CONTINUE
00154 *
00155 *     Test the error exits
00156 *
00157       IF( TSTERR )
00158      $   CALL SERRVX( PATH, NOUT )
00159       INFOT = 0
00160 *
00161 *     Set the block size and minimum block size for testing.
00162 *
00163       NB = 1
00164       NBMIN = 2
00165       CALL XLAENV( 1, NB )
00166       CALL XLAENV( 2, NBMIN )
00167 *
00168 *     Do for each value of N in NVAL
00169 *
00170       DO 130 IN = 1, NN
00171          N = NVAL( IN )
00172          LDA = MAX( N, 1 )
00173          XTYPE = 'N'
00174          NIMAT = NTYPES
00175          IF( N.LE.0 )
00176      $      NIMAT = 1
00177 *
00178          DO 120 IMAT = 1, NIMAT
00179 *
00180 *           Do the tests only if DOTYPE( IMAT ) is true.
00181 *
00182             IF( .NOT.DOTYPE( IMAT ) )
00183      $         GO TO 120
00184 *
00185 *           Skip types 3, 4, or 5 if the matrix size is too small.
00186 *
00187             ZEROT = IMAT.GE.3 .AND. IMAT.LE.5
00188             IF( ZEROT .AND. N.LT.IMAT-2 )
00189      $         GO TO 120
00190 *
00191 *           Do first for UPLO = 'U', then for UPLO = 'L'
00192 *
00193             DO 110 IUPLO = 1, 2
00194                UPLO = UPLOS( IUPLO )
00195 *
00196 *              Set up parameters with SLATB4 and generate a test matrix
00197 *              with SLATMS.
00198 *
00199                CALL SLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM, MODE,
00200      $                      CNDNUM, DIST )
00201 *
00202                SRNAMT = 'SLATMS'
00203                CALL SLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE,
00204      $                      CNDNUM, ANORM, KL, KU, UPLO, 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, UPLO, N, N, -1,
00211      $                         -1, -1, IMAT, NFAIL, NERRS, NOUT )
00212                   GO TO 110
00213                END IF
00214 *
00215 *              For types 3-5, zero one row and column of the matrix to
00216 *              test that INFO is returned correctly.
00217 *
00218                IF( ZEROT ) THEN
00219                   IF( IMAT.EQ.3 ) THEN
00220                      IZERO = 1
00221                   ELSE IF( IMAT.EQ.4 ) THEN
00222                      IZERO = N
00223                   ELSE
00224                      IZERO = N / 2 + 1
00225                   END IF
00226                   IOFF = ( IZERO-1 )*LDA
00227 *
00228 *                 Set row and column IZERO of A to 0.
00229 *
00230                   IF( IUPLO.EQ.1 ) THEN
00231                      DO 20 I = 1, IZERO - 1
00232                         A( IOFF+I ) = ZERO
00233    20                CONTINUE
00234                      IOFF = IOFF + IZERO
00235                      DO 30 I = IZERO, N
00236                         A( IOFF ) = ZERO
00237                         IOFF = IOFF + LDA
00238    30                CONTINUE
00239                   ELSE
00240                      IOFF = IZERO
00241                      DO 40 I = 1, IZERO - 1
00242                         A( IOFF ) = ZERO
00243                         IOFF = IOFF + LDA
00244    40                CONTINUE
00245                      IOFF = IOFF - IZERO
00246                      DO 50 I = IZERO, N
00247                         A( IOFF+I ) = ZERO
00248    50                CONTINUE
00249                   END IF
00250                ELSE
00251                   IZERO = 0
00252                END IF
00253 *
00254 *              Save a copy of the matrix A in ASAV.
00255 *
00256                CALL SLACPY( UPLO, N, N, A, LDA, ASAV, LDA )
00257 *
00258                DO 100 IEQUED = 1, 2
00259                   EQUED = EQUEDS( IEQUED )
00260                   IF( IEQUED.EQ.1 ) THEN
00261                      NFACT = 3
00262                   ELSE
00263                      NFACT = 1
00264                   END IF
00265 *
00266                   DO 90 IFACT = 1, NFACT
00267                      FACT = FACTS( IFACT )
00268                      PREFAC = LSAME( FACT, 'F' )
00269                      NOFACT = LSAME( FACT, 'N' )
00270                      EQUIL = LSAME( FACT, 'E' )
00271 *
00272                      IF( ZEROT ) THEN
00273                         IF( PREFAC )
00274      $                     GO TO 90
00275                         RCONDC = ZERO
00276 *
00277                      ELSE IF( .NOT.LSAME( FACT, 'N' ) ) THEN
00278 *
00279 *                       Compute the condition number for comparison with
00280 *                       the value returned by SPOSVX (FACT = 'N' reuses
00281 *                       the condition number from the previous iteration
00282 *                       with FACT = 'F').
00283 *
00284                         CALL SLACPY( UPLO, N, N, ASAV, LDA, AFAC, LDA )
00285                         IF( EQUIL .OR. IEQUED.GT.1 ) THEN
00286 *
00287 *                          Compute row and column scale factors to
00288 *                          equilibrate the matrix A.
00289 *
00290                            CALL SPOEQU( N, AFAC, LDA, S, SCOND, AMAX,
00291      $                                  INFO )
00292                            IF( INFO.EQ.0 .AND. N.GT.0 ) THEN
00293                               IF( IEQUED.GT.1 )
00294      $                           SCOND = ZERO
00295 *
00296 *                             Equilibrate the matrix.
00297 *
00298                               CALL SLAQSY( UPLO, N, AFAC, LDA, S, SCOND,
00299      $                                     AMAX, EQUED )
00300                            END IF
00301                         END IF
00302 *
00303 *                       Save the condition number of the
00304 *                       non-equilibrated system for use in SGET04.
00305 *
00306                         IF( EQUIL )
00307      $                     ROLDC = RCONDC
00308 *
00309 *                       Compute the 1-norm of A.
00310 *
00311                         ANORM = SLANSY( '1', UPLO, N, AFAC, LDA, RWORK )
00312 *
00313 *                       Factor the matrix A.
00314 *
00315                         CALL SPOTRF( UPLO, N, AFAC, LDA, INFO )
00316 *
00317 *                       Form the inverse of A.
00318 *
00319                         CALL SLACPY( UPLO, N, N, AFAC, LDA, A, LDA )
00320                         CALL SPOTRI( UPLO, N, A, LDA, INFO )
00321 *
00322 *                       Compute the 1-norm condition number of A.
00323 *
00324                         AINVNM = SLANSY( '1', UPLO, N, A, LDA, RWORK )
00325                         IF( ANORM.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
00326                            RCONDC = ONE
00327                         ELSE
00328                            RCONDC = ( ONE / ANORM ) / AINVNM
00329                         END IF
00330                      END IF
00331 *
00332 *                    Restore the matrix A.
00333 *
00334                      CALL SLACPY( UPLO, N, N, ASAV, LDA, A, LDA )
00335 *
00336 *                    Form an exact solution and set the right hand side.
00337 *
00338                      SRNAMT = 'SLARHS'
00339                      CALL SLARHS( PATH, XTYPE, UPLO, ' ', N, N, KL, KU,
00340      $                            NRHS, A, LDA, XACT, LDA, B, LDA,
00341      $                            ISEED, INFO )
00342                      XTYPE = 'C'
00343                      CALL SLACPY( 'Full', N, NRHS, B, LDA, BSAV, LDA )
00344 *
00345                      IF( NOFACT ) THEN
00346 *
00347 *                       --- Test SPOSV  ---
00348 *
00349 *                       Compute the L*L' or U'*U factorization of the
00350 *                       matrix and solve the system.
00351 *
00352                         CALL SLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
00353                         CALL SLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
00354 *
00355                         SRNAMT = 'SPOSV '
00356                         CALL SPOSV( UPLO, N, NRHS, AFAC, LDA, X, LDA,
00357      $                              INFO )
00358 *
00359 *                       Check error code from SPOSV .
00360 *
00361                         IF( INFO.NE.IZERO ) THEN
00362                            CALL ALAERH( PATH, 'SPOSV ', INFO, IZERO,
00363      $                                  UPLO, N, N, -1, -1, NRHS, IMAT,
00364      $                                  NFAIL, NERRS, NOUT )
00365                            GO TO 70
00366                         ELSE IF( INFO.NE.0 ) THEN
00367                            GO TO 70
00368                         END IF
00369 *
00370 *                       Reconstruct matrix from factors and compute
00371 *                       residual.
00372 *
00373                         CALL SPOT01( UPLO, N, A, LDA, AFAC, LDA, RWORK,
00374      $                               RESULT( 1 ) )
00375 *
00376 *                       Compute residual of the computed solution.
00377 *
00378                         CALL SLACPY( 'Full', N, NRHS, B, LDA, WORK,
00379      $                               LDA )
00380                         CALL SPOT02( UPLO, N, NRHS, A, LDA, X, LDA,
00381      $                               WORK, LDA, RWORK, RESULT( 2 ) )
00382 *
00383 *                       Check solution from generated exact solution.
00384 *
00385                         CALL SGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
00386      $                               RESULT( 3 ) )
00387                         NT = 3
00388 *
00389 *                       Print information about the tests that did not
00390 *                       pass the threshold.
00391 *
00392                         DO 60 K = 1, NT
00393                            IF( RESULT( K ).GE.THRESH ) THEN
00394                               IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00395      $                           CALL ALADHD( NOUT, PATH )
00396                               WRITE( NOUT, FMT = 9999 )'SPOSV ', UPLO,
00397      $                           N, IMAT, K, RESULT( K )
00398                               NFAIL = NFAIL + 1
00399                            END IF
00400    60                   CONTINUE
00401                         NRUN = NRUN + NT
00402    70                   CONTINUE
00403                      END IF
00404 *
00405 *                    --- Test SPOSVX ---
00406 *
00407                      IF( .NOT.PREFAC )
00408      $                  CALL SLASET( UPLO, N, N, ZERO, ZERO, AFAC, LDA )
00409                      CALL SLASET( 'Full', N, NRHS, ZERO, ZERO, X, LDA )
00410                      IF( IEQUED.GT.1 .AND. N.GT.0 ) THEN
00411 *
00412 *                       Equilibrate the matrix if FACT='F' and
00413 *                       EQUED='Y'.
00414 *
00415                         CALL SLAQSY( UPLO, N, A, LDA, S, SCOND, AMAX,
00416      $                               EQUED )
00417                      END IF
00418 *
00419 *                    Solve the system and compute the condition number
00420 *                    and error bounds using SPOSVX.
00421 *
00422                      SRNAMT = 'SPOSVX'
00423                      CALL SPOSVX( FACT, UPLO, N, NRHS, A, LDA, AFAC,
00424      $                            LDA, EQUED, S, B, LDA, X, LDA, RCOND,
00425      $                            RWORK, RWORK( NRHS+1 ), WORK, IWORK,
00426      $                            INFO )
00427 *
00428 *                    Check the error code from SPOSVX.
00429 *
00430                      IF( INFO.NE.IZERO )
00431      $                  CALL ALAERH( PATH, 'SPOSVX', INFO, IZERO,
00432      $                               FACT // UPLO, N, N, -1, -1, NRHS,
00433      $                               IMAT, NFAIL, NERRS, NOUT )
00434                         GO TO 90
00435 *
00436                      IF( INFO.EQ.0 ) THEN
00437                         IF( .NOT.PREFAC ) THEN
00438 *
00439 *                          Reconstruct matrix from factors and compute
00440 *                          residual.
00441 *
00442                            CALL SPOT01( UPLO, N, A, LDA, AFAC, LDA,
00443      $                                  RWORK( 2*NRHS+1 ), RESULT( 1 ) )
00444                            K1 = 1
00445                         ELSE
00446                            K1 = 2
00447                         END IF
00448 *
00449 *                       Compute residual of the computed solution.
00450 *
00451                         CALL SLACPY( 'Full', N, NRHS, BSAV, LDA, WORK,
00452      $                               LDA )
00453                         CALL SPOT02( UPLO, N, NRHS, ASAV, LDA, X, LDA,
00454      $                               WORK, LDA, RWORK( 2*NRHS+1 ),
00455      $                               RESULT( 2 ) )
00456 *
00457 *                       Check solution from generated exact solution.
00458 *
00459                         IF( NOFACT .OR. ( PREFAC .AND. LSAME( EQUED,
00460      $                      'N' ) ) ) THEN
00461                            CALL SGET04( N, NRHS, X, LDA, XACT, LDA,
00462      $                                  RCONDC, RESULT( 3 ) )
00463                         ELSE
00464                            CALL SGET04( N, NRHS, X, LDA, XACT, LDA,
00465      $                                  ROLDC, RESULT( 3 ) )
00466                         END IF
00467 *
00468 *                       Check the error bounds from iterative
00469 *                       refinement.
00470 *
00471                         CALL SPOT05( UPLO, N, NRHS, ASAV, LDA, B, LDA,
00472      $                               X, LDA, XACT, LDA, RWORK,
00473      $                               RWORK( NRHS+1 ), RESULT( 4 ) )
00474                      ELSE
00475                         K1 = 6
00476                      END IF
00477 *
00478 *                    Compare RCOND from SPOSVX with the computed value
00479 *                    in RCONDC.
00480 *
00481                      RESULT( 6 ) = SGET06( RCOND, RCONDC )
00482 *
00483 *                    Print information about the tests that did not pass
00484 *                    the threshold.
00485 *
00486                      DO 80 K = K1, 6
00487                         IF( RESULT( K ).GE.THRESH ) THEN
00488                            IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00489      $                        CALL ALADHD( NOUT, PATH )
00490                            IF( PREFAC ) THEN
00491                               WRITE( NOUT, FMT = 9997 )'SPOSVX', FACT,
00492      $                           UPLO, N, EQUED, IMAT, K, RESULT( K )
00493                            ELSE
00494                               WRITE( NOUT, FMT = 9998 )'SPOSVX', FACT,
00495      $                           UPLO, N, IMAT, K, RESULT( K )
00496                            END IF
00497                            NFAIL = NFAIL + 1
00498                         END IF
00499    80                CONTINUE
00500                      NRUN = NRUN + 7 - K1
00501 *
00502 *                    --- Test SPOSVXX ---
00503 *
00504 *                    Restore the matrices A and B.
00505 *
00506                      CALL SLACPY( 'Full', N, N, ASAV, LDA, A, LDA )
00507                      CALL SLACPY( 'Full', N, NRHS, BSAV, LDA, B, LDA )
00508 
00509                      IF( .NOT.PREFAC )
00510      $                  CALL SLASET( UPLO, N, N, ZERO, ZERO, AFAC, LDA )
00511                      CALL SLASET( 'Full', N, NRHS, ZERO, ZERO, X, LDA )
00512                      IF( IEQUED.GT.1 .AND. N.GT.0 ) THEN
00513 *
00514 *                       Equilibrate the matrix if FACT='F' and
00515 *                       EQUED='Y'.
00516 *
00517                         CALL SLAQSY( UPLO, N, A, LDA, S, SCOND, AMAX,
00518      $                               EQUED )
00519                      END IF
00520 *
00521 *                    Solve the system and compute the condition number
00522 *                    and error bounds using SPOSVXX.
00523 *
00524                      SRNAMT = 'SPOSVXX'
00525                      N_ERR_BNDS = 3
00526                      CALL SPOSVXX( FACT, UPLO, N, NRHS, A, LDA, AFAC,
00527      $                    LDA, EQUED, S, B, LDA, X,
00528      $                    LDA, RCOND, RPVGRW_SVXX, BERR, N_ERR_BNDS,
00529      $                    ERRBNDS_N, ERRBNDS_C, 0, ZERO, WORK,
00530      $                    IWORK, INFO )
00531 *
00532 *                    Check the error code from SPOSVXX.
00533 *
00534                      IF( INFO.EQ.N+1 ) GOTO 90
00535                      IF( INFO.NE.IZERO ) THEN
00536                         CALL ALAERH( PATH, 'SPOSVXX', INFO, IZERO,
00537      $                               FACT // UPLO, N, N, -1, -1, NRHS,
00538      $                               IMAT, NFAIL, NERRS, NOUT )
00539                         GO TO 90
00540                      END IF
00541 *
00542                      IF( INFO.EQ.0 ) THEN
00543                         IF( .NOT.PREFAC ) THEN
00544 *
00545 *                          Reconstruct matrix from factors and compute
00546 *                          residual.
00547 *
00548                            CALL SPOT01( UPLO, N, A, LDA, AFAC, LDA,
00549      $                                  RWORK( 2*NRHS+1 ), RESULT( 1 ) )
00550                            K1 = 1
00551                         ELSE
00552                            K1 = 2
00553                         END IF
00554 *
00555 *                       Compute residual of the computed solution.
00556 *
00557                         CALL SLACPY( 'Full', N, NRHS, BSAV, LDA, WORK,
00558      $                               LDA )
00559                         CALL SPOT02( UPLO, N, NRHS, ASAV, LDA, X, LDA,
00560      $                               WORK, LDA, RWORK( 2*NRHS+1 ),
00561      $                               RESULT( 2 ) )
00562 *
00563 *                       Check solution from generated exact solution.
00564 *
00565                         IF( NOFACT .OR. ( PREFAC .AND. LSAME( EQUED,
00566      $                      'N' ) ) ) THEN
00567                            CALL SGET04( N, NRHS, X, LDA, XACT, LDA,
00568      $                                  RCONDC, RESULT( 3 ) )
00569                         ELSE
00570                            CALL SGET04( N, NRHS, X, LDA, XACT, LDA,
00571      $                                  ROLDC, RESULT( 3 ) )
00572                         END IF
00573 *
00574 *                       Check the error bounds from iterative
00575 *                       refinement.
00576 *
00577                         CALL SPOT05( UPLO, N, NRHS, ASAV, LDA, B, LDA,
00578      $                               X, LDA, XACT, LDA, RWORK,
00579      $                               RWORK( NRHS+1 ), RESULT( 4 ) )
00580                      ELSE
00581                         K1 = 6
00582                      END IF
00583 *
00584 *                    Compare RCOND from SPOSVXX with the computed value
00585 *                    in RCONDC.
00586 *
00587                      RESULT( 6 ) = SGET06( RCOND, RCONDC )
00588 *
00589 *                    Print information about the tests that did not pass
00590 *                    the threshold.
00591 *
00592                      DO 85 K = K1, 6
00593                         IF( RESULT( K ).GE.THRESH ) THEN
00594                            IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00595      $                        CALL ALADHD( NOUT, PATH )
00596                            IF( PREFAC ) THEN
00597                               WRITE( NOUT, FMT = 9997 )'SPOSVXX', FACT,
00598      $                           UPLO, N, EQUED, IMAT, K, RESULT( K )
00599                            ELSE
00600                               WRITE( NOUT, FMT = 9998 )'SPOSVXX', FACT,
00601      $                           UPLO, N, IMAT, K, RESULT( K )
00602                            END IF
00603                            NFAIL = NFAIL + 1
00604                         END IF
00605   85                 CONTINUE
00606                      NRUN = NRUN + 7 - K1
00607   90               CONTINUE
00608   100           CONTINUE
00609   110       CONTINUE
00610   120    CONTINUE
00611   130 CONTINUE
00612 *
00613 *     Print a summary of the results.
00614 *
00615       CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS )
00616 *
00617 
00618 *     Test Error Bounds from SPOSVXX
00619 
00620       CALL SEBCHVXX(THRESH, PATH)
00621 
00622  9999 FORMAT( 1X, A, ', UPLO=''', A1, ''', N =', I5, ', type ', I1,
00623      $      ', test(', I1, ')=', G12.5 )
00624  9998 FORMAT( 1X, A, ', FACT=''', A1, ''', UPLO=''', A1, ''', N=', I5,
00625      $      ', type ', I1, ', test(', I1, ')=', G12.5 )
00626  9997 FORMAT( 1X, A, ', FACT=''', A1, ''', UPLO=''', A1, ''', N=', I5,
00627      $      ', EQUED=''', A1, ''', type ', I1, ', test(', I1, ') =',
00628      $      G12.5 )
00629       RETURN
00630 *
00631 *     End of SDRVPO
00632 *
00633       END