LAPACK 3.3.1 Linear Algebra PACKage

# ddrvpox.f

Go to the documentation of this file.
```00001       SUBROUTINE DDRVPO( 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       DOUBLE PRECISION   THRESH
00013 *     ..
00014 *     .. Array Arguments ..
00015       LOGICAL            DOTYPE( * )
00016       INTEGER            IWORK( * ), NVAL( * )
00017       DOUBLE PRECISION   A( * ), AFAC( * ), ASAV( * ), B( * ),
00018      \$                   BSAV( * ), RWORK( * ), S( * ), WORK( * ),
00019      \$                   X( * ), XACT( * )
00020 *     ..
00021 *
00022 *  Purpose
00023 *  =======
00024 *
00025 *  DDRVPO tests the driver routines DPOSV, -SVX, and -SVXX.
00026 *
00027 *  Note that this file is used only when the XBLAS are available,
00028 *  otherwise ddrvpo.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) DOUBLE PRECISION
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) DOUBLE PRECISION array, dimension (NMAX*NMAX)
00061 *
00062 *  AFAC    (workspace) DOUBLE PRECISION array, dimension (NMAX*NMAX)
00063 *
00064 *  ASAV    (workspace) DOUBLE PRECISION array, dimension (NMAX*NMAX)
00065 *
00066 *  B       (workspace) DOUBLE PRECISION array, dimension (NMAX*NRHS)
00067 *
00068 *  BSAV    (workspace) DOUBLE PRECISION array, dimension (NMAX*NRHS)
00069 *
00070 *  X       (workspace) DOUBLE PRECISION array, dimension (NMAX*NRHS)
00071 *
00072 *  XACT    (workspace) DOUBLE PRECISION array, dimension (NMAX*NRHS)
00073 *
00074 *  S       (workspace) DOUBLE PRECISION array, dimension (NMAX)
00075 *
00076 *  WORK    (workspace) DOUBLE PRECISION array, dimension
00077 *                      (NMAX*max(3,NRHS))
00078 *
00079 *  RWORK   (workspace) DOUBLE PRECISION 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       DOUBLE PRECISION   ONE, ZERO
00090       PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+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       DOUBLE PRECISION   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       DOUBLE PRECISION   RESULT( NTESTS ), BERR( NRHS ),
00111      \$                   ERRBNDS_N( NRHS, 3 ), ERRBNDS_C( NRHS, 3 )
00112 *     ..
00113 *     .. External Functions ..
00114       LOGICAL            LSAME
00115       DOUBLE PRECISION   DGET06, DLANSY
00116       EXTERNAL           LSAME, DGET06, DLANSY
00117 *     ..
00118 *     .. External Subroutines ..
00119       EXTERNAL           ALADHD, ALAERH, ALASVM, DERRVX, DGET04, DLACPY,
00120      \$                   DLAQSY, DLARHS, DLASET, DLATB4, DLATMS, DPOEQU,
00121      \$                   DPOSV, DPOSVX, DPOT01, DPOT02, DPOT05, DPOTRF,
00122      \$                   DPOTRI, 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 ) = 'Double 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 DERRVX( 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 DLATB4 and generate a test matrix
00197 *              with DLATMS.
00198 *
00199                CALL DLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM, MODE,
00200      \$                      CNDNUM, DIST )
00201 *
00202                SRNAMT = 'DLATMS'
00203                CALL DLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE,
00204      \$                      CNDNUM, ANORM, KL, KU, UPLO, A, LDA, WORK,
00205      \$                      INFO )
00206 *
00207 *              Check error code from DLATMS.
00208 *
00209                IF( INFO.NE.0 ) THEN
00210                   CALL ALAERH( PATH, 'DLATMS', 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 DLACPY( 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 DPOSVX (FACT = 'N' reuses
00281 *                       the condition number from the previous iteration
00282 *                       with FACT = 'F').
00283 *
00284                         CALL DLACPY( 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 DPOEQU( 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 DLAQSY( 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 DGET04.
00305 *
00306                         IF( EQUIL )
00307      \$                     ROLDC = RCONDC
00308 *
00309 *                       Compute the 1-norm of A.
00310 *
00311                         ANORM = DLANSY( '1', UPLO, N, AFAC, LDA, RWORK )
00312 *
00313 *                       Factor the matrix A.
00314 *
00315                         CALL DPOTRF( UPLO, N, AFAC, LDA, INFO )
00316 *
00317 *                       Form the inverse of A.
00318 *
00319                         CALL DLACPY( UPLO, N, N, AFAC, LDA, A, LDA )
00320                         CALL DPOTRI( UPLO, N, A, LDA, INFO )
00321 *
00322 *                       Compute the 1-norm condition number of A.
00323 *
00324                         AINVNM = DLANSY( '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 DLACPY( UPLO, N, N, ASAV, LDA, A, LDA )
00335 *
00336 *                    Form an exact solution and set the right hand side.
00337 *
00338                      SRNAMT = 'DLARHS'
00339                      CALL DLARHS( PATH, XTYPE, UPLO, ' ', N, N, KL, KU,
00340      \$                            NRHS, A, LDA, XACT, LDA, B, LDA,
00341      \$                            ISEED, INFO )
00342                      XTYPE = 'C'
00343                      CALL DLACPY( 'Full', N, NRHS, B, LDA, BSAV, LDA )
00344 *
00345                      IF( NOFACT ) THEN
00346 *
00347 *                       --- Test DPOSV  ---
00348 *
00349 *                       Compute the L*L' or U'*U factorization of the
00350 *                       matrix and solve the system.
00351 *
00352                         CALL DLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
00353                         CALL DLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
00354 *
00355                         SRNAMT = 'DPOSV '
00356                         CALL DPOSV( UPLO, N, NRHS, AFAC, LDA, X, LDA,
00357      \$                              INFO )
00358 *
00359 *                       Check error code from DPOSV .
00360 *
00361                         IF( INFO.NE.IZERO ) THEN
00362                            CALL ALAERH( PATH, 'DPOSV ', 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 DPOT01( UPLO, N, A, LDA, AFAC, LDA, RWORK,
00374      \$                               RESULT( 1 ) )
00375 *
00376 *                       Compute residual of the computed solution.
00377 *
00378                         CALL DLACPY( 'Full', N, NRHS, B, LDA, WORK,
00379      \$                               LDA )
00380                         CALL DPOT02( UPLO, N, NRHS, A, LDA, X, LDA,
00381      \$                               WORK, LDA, RWORK, RESULT( 2 ) )
00382 *
00383 *                       Check solution from generated exact solution.
00384 *
00385                         CALL DGET04( 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 )'DPOSV ', 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 DPOSVX ---
00406 *
00407                      IF( .NOT.PREFAC )
00408      \$                  CALL DLASET( UPLO, N, N, ZERO, ZERO, AFAC, LDA )
00409                      CALL DLASET( '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 DLAQSY( 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 DPOSVX.
00421 *
00422                      SRNAMT = 'DPOSVX'
00423                      CALL DPOSVX( 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 DPOSVX.
00429 *
00430                      IF( INFO.NE.IZERO )
00431      \$                  CALL ALAERH( PATH, 'DPOSVX', 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 DPOT01( 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 DLACPY( 'Full', N, NRHS, BSAV, LDA, WORK,
00452      \$                               LDA )
00453                         CALL DPOT02( 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 DGET04( N, NRHS, X, LDA, XACT, LDA,
00462      \$                                  RCONDC, RESULT( 3 ) )
00463                         ELSE
00464                            CALL DGET04( 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 DPOT05( 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 DPOSVX with the computed value
00479 *                    in RCONDC.
00480 *
00481                      RESULT( 6 ) = DGET06( 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 )'DPOSVX', FACT,
00492      \$                           UPLO, N, EQUED, IMAT, K, RESULT( K )
00493                            ELSE
00494                               WRITE( NOUT, FMT = 9998 )'DPOSVX', 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 DPOSVXX ---
00503 *
00504 *                    Restore the matrices A and B.
00505 *
00506                      CALL DLACPY( 'Full', N, N, ASAV, LDA, A, LDA )
00507                      CALL DLACPY( 'Full', N, NRHS, BSAV, LDA, B, LDA )
00508
00509                      IF( .NOT.PREFAC )
00510      \$                  CALL DLASET( UPLO, N, N, ZERO, ZERO, AFAC, LDA )
00511                      CALL DLASET( '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 DLAQSY( 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 DPOSVXX.
00523 *
00524                      SRNAMT = 'DPOSVXX'
00525                      N_ERR_BNDS = 3
00526                      CALL DPOSVXX( 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 DPOSVXX.
00533 *
00534                      IF( INFO.EQ.N+1 ) GOTO 90
00535                      IF( INFO.NE.IZERO ) THEN
00536                         CALL ALAERH( PATH, 'DPOSVXX', 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 DPOT01( 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 DLACPY( 'Full', N, NRHS, BSAV, LDA, WORK,
00558      \$                               LDA )
00559                         CALL DPOT02( 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 DGET04( N, NRHS, X, LDA, XACT, LDA,
00568      \$                                  RCONDC, RESULT( 3 ) )
00569                         ELSE
00570                            CALL DGET04( 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 DPOT05( 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 DPOSVXX with the computed value
00585 *                    in RCONDC.
00586 *
00587                      RESULT( 6 ) = DGET06( 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 )'DPOSVXX', FACT,
00598      \$                           UPLO, N, EQUED, IMAT, K, RESULT( K )
00599                            ELSE
00600                               WRITE( NOUT, FMT = 9998 )'DPOSVXX', 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 DPOSVXX
00619
00620       CALL DEBCHVXX( 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 DDRVPO
00632 *
00633       END
```