LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
ddrvpox.f
Go to the documentation of this file.
00001 *> \brief \b DDRVPOX
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 DDRVPO( 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 *       DOUBLE PRECISION   THRESH
00019 *       ..
00020 *       .. Array Arguments ..
00021 *       LOGICAL            DOTYPE( * )
00022 *       INTEGER            IWORK( * ), NVAL( * )
00023 *       DOUBLE PRECISION   A( * ), AFAC( * ), ASAV( * ), B( * ),
00024 *      $                   BSAV( * ), RWORK( * ), S( * ), WORK( * ),
00025 *      $                   X( * ), XACT( * )
00026 *       ..
00027 *  
00028 *
00029 *> \par Purpose:
00030 *  =============
00031 *>
00032 *> \verbatim
00033 *>
00034 *> DDRVPO tests the driver routines DPOSV, -SVX, and -SVXX.
00035 *>
00036 *> Note that this file is used only when the XBLAS are available,
00037 *> otherwise ddrvpo.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 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 DOUBLE PRECISION
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 DOUBLE PRECISION array, dimension (NMAX*NMAX)
00094 *> \endverbatim
00095 *>
00096 *> \param[out] AFAC
00097 *> \verbatim
00098 *>          AFAC is DOUBLE PRECISION array, dimension (NMAX*NMAX)
00099 *> \endverbatim
00100 *>
00101 *> \param[out] ASAV
00102 *> \verbatim
00103 *>          ASAV is DOUBLE PRECISION array, dimension (NMAX*NMAX)
00104 *> \endverbatim
00105 *>
00106 *> \param[out] B
00107 *> \verbatim
00108 *>          B is DOUBLE PRECISION array, dimension (NMAX*NRHS)
00109 *> \endverbatim
00110 *>
00111 *> \param[out] BSAV
00112 *> \verbatim
00113 *>          BSAV is DOUBLE PRECISION array, dimension (NMAX*NRHS)
00114 *> \endverbatim
00115 *>
00116 *> \param[out] X
00117 *> \verbatim
00118 *>          X is DOUBLE PRECISION array, dimension (NMAX*NRHS)
00119 *> \endverbatim
00120 *>
00121 *> \param[out] XACT
00122 *> \verbatim
00123 *>          XACT is DOUBLE PRECISION array, dimension (NMAX*NRHS)
00124 *> \endverbatim
00125 *>
00126 *> \param[out] S
00127 *> \verbatim
00128 *>          S is DOUBLE PRECISION array, dimension (NMAX)
00129 *> \endverbatim
00130 *>
00131 *> \param[out] WORK
00132 *> \verbatim
00133 *>          WORK is DOUBLE PRECISION array, dimension
00134 *>                      (NMAX*max(3,NRHS))
00135 *> \endverbatim
00136 *>
00137 *> \param[out] RWORK
00138 *> \verbatim
00139 *>          RWORK is DOUBLE PRECISION array, dimension (NMAX+2*NRHS)
00140 *> \endverbatim
00141 *>
00142 *> \param[out] IWORK
00143 *> \verbatim
00144 *>          IWORK is INTEGER array, dimension (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 November 2011
00162 *
00163 *> \ingroup double_lin
00164 *
00165 *  =====================================================================
00166       SUBROUTINE DDRVPO( 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.0) --
00171 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00172 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00173 *     November 2011
00174 *
00175 *     .. Scalar Arguments ..
00176       LOGICAL            TSTERR
00177       INTEGER            NMAX, NN, NOUT, NRHS
00178       DOUBLE PRECISION   THRESH
00179 *     ..
00180 *     .. Array Arguments ..
00181       LOGICAL            DOTYPE( * )
00182       INTEGER            IWORK( * ), NVAL( * )
00183       DOUBLE PRECISION   A( * ), AFAC( * ), ASAV( * ), B( * ),
00184      $                   BSAV( * ), RWORK( * ), S( * ), WORK( * ),
00185      $                   X( * ), XACT( * )
00186 *     ..
00187 *
00188 *  =====================================================================
00189 *
00190 *     .. Parameters ..
00191       DOUBLE PRECISION   ONE, ZERO
00192       PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
00193       INTEGER            NTYPES
00194       PARAMETER          ( NTYPES = 9 )
00195       INTEGER            NTESTS
00196       PARAMETER          ( NTESTS = 6 )
00197 *     ..
00198 *     .. Local Scalars ..
00199       LOGICAL            EQUIL, NOFACT, PREFAC, ZEROT
00200       CHARACTER          DIST, EQUED, FACT, TYPE, UPLO, XTYPE
00201       CHARACTER*3        PATH
00202       INTEGER            I, IEQUED, IFACT, IMAT, IN, INFO, IOFF, IUPLO,
00203      $                   IZERO, K, K1, KL, KU, LDA, MODE, N, NB, NBMIN,
00204      $                   NERRS, NFACT, NFAIL, NIMAT, NRUN, NT,
00205      $                   N_ERR_BNDS
00206       DOUBLE PRECISION   AINVNM, AMAX, ANORM, CNDNUM, RCOND, RCONDC,
00207      $                   ROLDC, SCOND, RPVGRW_SVXX
00208 *     ..
00209 *     .. Local Arrays ..
00210       CHARACTER          EQUEDS( 2 ), FACTS( 3 ), UPLOS( 2 )
00211       INTEGER            ISEED( 4 ), ISEEDY( 4 )
00212       DOUBLE PRECISION   RESULT( NTESTS ), BERR( NRHS ),
00213      $                   ERRBNDS_N( NRHS, 3 ), ERRBNDS_C( NRHS, 3 )
00214 *     ..
00215 *     .. External Functions ..
00216       LOGICAL            LSAME
00217       DOUBLE PRECISION   DGET06, DLANSY
00218       EXTERNAL           LSAME, DGET06, DLANSY
00219 *     ..
00220 *     .. External Subroutines ..
00221       EXTERNAL           ALADHD, ALAERH, ALASVM, DERRVX, DGET04, DLACPY,
00222      $                   DLAQSY, DLARHS, DLASET, DLATB4, DLATMS, DPOEQU,
00223      $                   DPOSV, DPOSVX, DPOT01, DPOT02, DPOT05, DPOTRF,
00224      $                   DPOTRI, XLAENV
00225 *     ..
00226 *     .. Intrinsic Functions ..
00227       INTRINSIC          MAX
00228 *     ..
00229 *     .. Scalars in Common ..
00230       LOGICAL            LERR, OK
00231       CHARACTER*32       SRNAMT
00232       INTEGER            INFOT, NUNIT
00233 *     ..
00234 *     .. Common blocks ..
00235       COMMON             / INFOC / INFOT, NUNIT, OK, LERR
00236       COMMON             / SRNAMC / SRNAMT
00237 *     ..
00238 *     .. Data statements ..
00239       DATA               ISEEDY / 1988, 1989, 1990, 1991 /
00240       DATA               UPLOS / 'U', 'L' /
00241       DATA               FACTS / 'F', 'N', 'E' /
00242       DATA               EQUEDS / 'N', 'Y' /
00243 *     ..
00244 *     .. Executable Statements ..
00245 *
00246 *     Initialize constants and the random number seed.
00247 *
00248       PATH( 1: 1 ) = 'Double precision'
00249       PATH( 2: 3 ) = 'PO'
00250       NRUN = 0
00251       NFAIL = 0
00252       NERRS = 0
00253       DO 10 I = 1, 4
00254          ISEED( I ) = ISEEDY( I )
00255    10 CONTINUE
00256 *
00257 *     Test the error exits
00258 *
00259       IF( TSTERR )
00260      $   CALL DERRVX( PATH, NOUT )
00261       INFOT = 0
00262 *
00263 *     Set the block size and minimum block size for testing.
00264 *
00265       NB = 1
00266       NBMIN = 2
00267       CALL XLAENV( 1, NB )
00268       CALL XLAENV( 2, NBMIN )
00269 *
00270 *     Do for each value of N in NVAL
00271 *
00272       DO 130 IN = 1, NN
00273          N = NVAL( IN )
00274          LDA = MAX( N, 1 )
00275          XTYPE = 'N'
00276          NIMAT = NTYPES
00277          IF( N.LE.0 )
00278      $      NIMAT = 1
00279 *
00280          DO 120 IMAT = 1, NIMAT
00281 *
00282 *           Do the tests only if DOTYPE( IMAT ) is true.
00283 *
00284             IF( .NOT.DOTYPE( IMAT ) )
00285      $         GO TO 120
00286 *
00287 *           Skip types 3, 4, or 5 if the matrix size is too small.
00288 *
00289             ZEROT = IMAT.GE.3 .AND. IMAT.LE.5
00290             IF( ZEROT .AND. N.LT.IMAT-2 )
00291      $         GO TO 120
00292 *
00293 *           Do first for UPLO = 'U', then for UPLO = 'L'
00294 *
00295             DO 110 IUPLO = 1, 2
00296                UPLO = UPLOS( IUPLO )
00297 *
00298 *              Set up parameters with DLATB4 and generate a test matrix
00299 *              with DLATMS.
00300 *
00301                CALL DLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM, MODE,
00302      $                      CNDNUM, DIST )
00303 *
00304                SRNAMT = 'DLATMS'
00305                CALL DLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE,
00306      $                      CNDNUM, ANORM, KL, KU, UPLO, A, LDA, WORK,
00307      $                      INFO )
00308 *
00309 *              Check error code from DLATMS.
00310 *
00311                IF( INFO.NE.0 ) THEN
00312                   CALL ALAERH( PATH, 'DLATMS', INFO, 0, UPLO, N, N, -1,
00313      $                         -1, -1, IMAT, NFAIL, NERRS, NOUT )
00314                   GO TO 110
00315                END IF
00316 *
00317 *              For types 3-5, zero one row and column of the matrix to
00318 *              test that INFO is returned correctly.
00319 *
00320                IF( ZEROT ) THEN
00321                   IF( IMAT.EQ.3 ) THEN
00322                      IZERO = 1
00323                   ELSE IF( IMAT.EQ.4 ) THEN
00324                      IZERO = N
00325                   ELSE
00326                      IZERO = N / 2 + 1
00327                   END IF
00328                   IOFF = ( IZERO-1 )*LDA
00329 *
00330 *                 Set row and column IZERO of A to 0.
00331 *
00332                   IF( IUPLO.EQ.1 ) THEN
00333                      DO 20 I = 1, IZERO - 1
00334                         A( IOFF+I ) = ZERO
00335    20                CONTINUE
00336                      IOFF = IOFF + IZERO
00337                      DO 30 I = IZERO, N
00338                         A( IOFF ) = ZERO
00339                         IOFF = IOFF + LDA
00340    30                CONTINUE
00341                   ELSE
00342                      IOFF = IZERO
00343                      DO 40 I = 1, IZERO - 1
00344                         A( IOFF ) = ZERO
00345                         IOFF = IOFF + LDA
00346    40                CONTINUE
00347                      IOFF = IOFF - IZERO
00348                      DO 50 I = IZERO, N
00349                         A( IOFF+I ) = ZERO
00350    50                CONTINUE
00351                   END IF
00352                ELSE
00353                   IZERO = 0
00354                END IF
00355 *
00356 *              Save a copy of the matrix A in ASAV.
00357 *
00358                CALL DLACPY( UPLO, N, N, A, LDA, ASAV, LDA )
00359 *
00360                DO 100 IEQUED = 1, 2
00361                   EQUED = EQUEDS( IEQUED )
00362                   IF( IEQUED.EQ.1 ) THEN
00363                      NFACT = 3
00364                   ELSE
00365                      NFACT = 1
00366                   END IF
00367 *
00368                   DO 90 IFACT = 1, NFACT
00369                      FACT = FACTS( IFACT )
00370                      PREFAC = LSAME( FACT, 'F' )
00371                      NOFACT = LSAME( FACT, 'N' )
00372                      EQUIL = LSAME( FACT, 'E' )
00373 *
00374                      IF( ZEROT ) THEN
00375                         IF( PREFAC )
00376      $                     GO TO 90
00377                         RCONDC = ZERO
00378 *
00379                      ELSE IF( .NOT.LSAME( FACT, 'N' ) ) THEN
00380 *
00381 *                       Compute the condition number for comparison with
00382 *                       the value returned by DPOSVX (FACT = 'N' reuses
00383 *                       the condition number from the previous iteration
00384 *                       with FACT = 'F').
00385 *
00386                         CALL DLACPY( UPLO, N, N, ASAV, LDA, AFAC, LDA )
00387                         IF( EQUIL .OR. IEQUED.GT.1 ) THEN
00388 *
00389 *                          Compute row and column scale factors to
00390 *                          equilibrate the matrix A.
00391 *
00392                            CALL DPOEQU( N, AFAC, LDA, S, SCOND, AMAX,
00393      $                                  INFO )
00394                            IF( INFO.EQ.0 .AND. N.GT.0 ) THEN
00395                               IF( IEQUED.GT.1 )
00396      $                           SCOND = ZERO
00397 *
00398 *                             Equilibrate the matrix.
00399 *
00400                               CALL DLAQSY( UPLO, N, AFAC, LDA, S, SCOND,
00401      $                                     AMAX, EQUED )
00402                            END IF
00403                         END IF
00404 *
00405 *                       Save the condition number of the
00406 *                       non-equilibrated system for use in DGET04.
00407 *
00408                         IF( EQUIL )
00409      $                     ROLDC = RCONDC
00410 *
00411 *                       Compute the 1-norm of A.
00412 *
00413                         ANORM = DLANSY( '1', UPLO, N, AFAC, LDA, RWORK )
00414 *
00415 *                       Factor the matrix A.
00416 *
00417                         CALL DPOTRF( UPLO, N, AFAC, LDA, INFO )
00418 *
00419 *                       Form the inverse of A.
00420 *
00421                         CALL DLACPY( UPLO, N, N, AFAC, LDA, A, LDA )
00422                         CALL DPOTRI( UPLO, N, A, LDA, INFO )
00423 *
00424 *                       Compute the 1-norm condition number of A.
00425 *
00426                         AINVNM = DLANSY( '1', UPLO, N, A, LDA, RWORK )
00427                         IF( ANORM.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
00428                            RCONDC = ONE
00429                         ELSE
00430                            RCONDC = ( ONE / ANORM ) / AINVNM
00431                         END IF
00432                      END IF
00433 *
00434 *                    Restore the matrix A.
00435 *
00436                      CALL DLACPY( UPLO, N, N, ASAV, LDA, A, LDA )
00437 *
00438 *                    Form an exact solution and set the right hand side.
00439 *
00440                      SRNAMT = 'DLARHS'
00441                      CALL DLARHS( PATH, XTYPE, UPLO, ' ', N, N, KL, KU,
00442      $                            NRHS, A, LDA, XACT, LDA, B, LDA,
00443      $                            ISEED, INFO )
00444                      XTYPE = 'C'
00445                      CALL DLACPY( 'Full', N, NRHS, B, LDA, BSAV, LDA )
00446 *
00447                      IF( NOFACT ) THEN
00448 *
00449 *                       --- Test DPOSV  ---
00450 *
00451 *                       Compute the L*L' or U'*U factorization of the
00452 *                       matrix and solve the system.
00453 *
00454                         CALL DLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
00455                         CALL DLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
00456 *
00457                         SRNAMT = 'DPOSV '
00458                         CALL DPOSV( UPLO, N, NRHS, AFAC, LDA, X, LDA,
00459      $                              INFO )
00460 *
00461 *                       Check error code from DPOSV .
00462 *
00463                         IF( INFO.NE.IZERO ) THEN
00464                            CALL ALAERH( PATH, 'DPOSV ', INFO, IZERO,
00465      $                                  UPLO, N, N, -1, -1, NRHS, IMAT,
00466      $                                  NFAIL, NERRS, NOUT )
00467                            GO TO 70
00468                         ELSE IF( INFO.NE.0 ) THEN
00469                            GO TO 70
00470                         END IF
00471 *
00472 *                       Reconstruct matrix from factors and compute
00473 *                       residual.
00474 *
00475                         CALL DPOT01( UPLO, N, A, LDA, AFAC, LDA, RWORK,
00476      $                               RESULT( 1 ) )
00477 *
00478 *                       Compute residual of the computed solution.
00479 *
00480                         CALL DLACPY( 'Full', N, NRHS, B, LDA, WORK,
00481      $                               LDA )
00482                         CALL DPOT02( UPLO, N, NRHS, A, LDA, X, LDA,
00483      $                               WORK, LDA, RWORK, RESULT( 2 ) )
00484 *
00485 *                       Check solution from generated exact solution.
00486 *
00487                         CALL DGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
00488      $                               RESULT( 3 ) )
00489                         NT = 3
00490 *
00491 *                       Print information about the tests that did not
00492 *                       pass the threshold.
00493 *
00494                         DO 60 K = 1, NT
00495                            IF( RESULT( K ).GE.THRESH ) THEN
00496                               IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00497      $                           CALL ALADHD( NOUT, PATH )
00498                               WRITE( NOUT, FMT = 9999 )'DPOSV ', UPLO,
00499      $                           N, IMAT, K, RESULT( K )
00500                               NFAIL = NFAIL + 1
00501                            END IF
00502    60                   CONTINUE
00503                         NRUN = NRUN + NT
00504    70                   CONTINUE
00505                      END IF
00506 *
00507 *                    --- Test DPOSVX ---
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 DPOSVX.
00523 *
00524                      SRNAMT = 'DPOSVX'
00525                      CALL DPOSVX( FACT, UPLO, N, NRHS, A, LDA, AFAC,
00526      $                            LDA, EQUED, S, B, LDA, X, LDA, RCOND,
00527      $                            RWORK, RWORK( NRHS+1 ), WORK, IWORK,
00528      $                            INFO )
00529 *
00530 *                    Check the error code from DPOSVX.
00531 *
00532                      IF( INFO.NE.IZERO )
00533      $                  CALL ALAERH( PATH, 'DPOSVX', INFO, IZERO,
00534      $                               FACT // UPLO, N, N, -1, -1, NRHS,
00535      $                               IMAT, NFAIL, NERRS, NOUT )
00536                         GO TO 90
00537 *
00538                      IF( INFO.EQ.0 ) THEN
00539                         IF( .NOT.PREFAC ) THEN
00540 *
00541 *                          Reconstruct matrix from factors and compute
00542 *                          residual.
00543 *
00544                            CALL DPOT01( UPLO, N, A, LDA, AFAC, LDA,
00545      $                                  RWORK( 2*NRHS+1 ), RESULT( 1 ) )
00546                            K1 = 1
00547                         ELSE
00548                            K1 = 2
00549                         END IF
00550 *
00551 *                       Compute residual of the computed solution.
00552 *
00553                         CALL DLACPY( 'Full', N, NRHS, BSAV, LDA, WORK,
00554      $                               LDA )
00555                         CALL DPOT02( UPLO, N, NRHS, ASAV, LDA, X, LDA,
00556      $                               WORK, LDA, RWORK( 2*NRHS+1 ),
00557      $                               RESULT( 2 ) )
00558 *
00559 *                       Check solution from generated exact solution.
00560 *
00561                         IF( NOFACT .OR. ( PREFAC .AND. LSAME( EQUED,
00562      $                      'N' ) ) ) THEN
00563                            CALL DGET04( N, NRHS, X, LDA, XACT, LDA,
00564      $                                  RCONDC, RESULT( 3 ) )
00565                         ELSE
00566                            CALL DGET04( N, NRHS, X, LDA, XACT, LDA,
00567      $                                  ROLDC, RESULT( 3 ) )
00568                         END IF
00569 *
00570 *                       Check the error bounds from iterative
00571 *                       refinement.
00572 *
00573                         CALL DPOT05( UPLO, N, NRHS, ASAV, LDA, B, LDA,
00574      $                               X, LDA, XACT, LDA, RWORK,
00575      $                               RWORK( NRHS+1 ), RESULT( 4 ) )
00576                      ELSE
00577                         K1 = 6
00578                      END IF
00579 *
00580 *                    Compare RCOND from DPOSVX with the computed value
00581 *                    in RCONDC.
00582 *
00583                      RESULT( 6 ) = DGET06( RCOND, RCONDC )
00584 *
00585 *                    Print information about the tests that did not pass
00586 *                    the threshold.
00587 *
00588                      DO 80 K = K1, 6
00589                         IF( RESULT( K ).GE.THRESH ) THEN
00590                            IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00591      $                        CALL ALADHD( NOUT, PATH )
00592                            IF( PREFAC ) THEN
00593                               WRITE( NOUT, FMT = 9997 )'DPOSVX', FACT,
00594      $                           UPLO, N, EQUED, IMAT, K, RESULT( K )
00595                            ELSE
00596                               WRITE( NOUT, FMT = 9998 )'DPOSVX', FACT,
00597      $                           UPLO, N, IMAT, K, RESULT( K )
00598                            END IF
00599                            NFAIL = NFAIL + 1
00600                         END IF
00601    80                CONTINUE
00602                      NRUN = NRUN + 7 - K1
00603 *
00604 *                    --- Test DPOSVXX ---
00605 *
00606 *                    Restore the matrices A and B.
00607 *
00608                      CALL DLACPY( 'Full', N, N, ASAV, LDA, A, LDA )
00609                      CALL DLACPY( 'Full', N, NRHS, BSAV, LDA, B, LDA )
00610 
00611                      IF( .NOT.PREFAC )
00612      $                  CALL DLASET( UPLO, N, N, ZERO, ZERO, AFAC, LDA )
00613                      CALL DLASET( 'Full', N, NRHS, ZERO, ZERO, X, LDA )
00614                      IF( IEQUED.GT.1 .AND. N.GT.0 ) THEN
00615 *
00616 *                       Equilibrate the matrix if FACT='F' and
00617 *                       EQUED='Y'.
00618 *
00619                         CALL DLAQSY( UPLO, N, A, LDA, S, SCOND, AMAX,
00620      $                               EQUED )
00621                      END IF
00622 *
00623 *                    Solve the system and compute the condition number
00624 *                    and error bounds using DPOSVXX.
00625 *
00626                      SRNAMT = 'DPOSVXX'
00627                      N_ERR_BNDS = 3
00628                      CALL DPOSVXX( FACT, UPLO, N, NRHS, A, LDA, AFAC,
00629      $                    LDA, EQUED, S, B, LDA, X,
00630      $                    LDA, RCOND, RPVGRW_SVXX, BERR, N_ERR_BNDS,
00631      $                    ERRBNDS_N, ERRBNDS_C, 0, ZERO, WORK,
00632      $                    IWORK, INFO )
00633 *
00634 *                    Check the error code from DPOSVXX.
00635 *
00636                      IF( INFO.EQ.N+1 ) GOTO 90
00637                      IF( INFO.NE.IZERO ) THEN
00638                         CALL ALAERH( PATH, 'DPOSVXX', INFO, IZERO,
00639      $                               FACT // UPLO, N, N, -1, -1, NRHS,
00640      $                               IMAT, NFAIL, NERRS, NOUT )
00641                         GO TO 90
00642                      END IF
00643 *
00644                      IF( INFO.EQ.0 ) THEN
00645                         IF( .NOT.PREFAC ) THEN
00646 *
00647 *                          Reconstruct matrix from factors and compute
00648 *                          residual.
00649 *
00650                            CALL DPOT01( UPLO, N, A, LDA, AFAC, LDA,
00651      $                                  RWORK( 2*NRHS+1 ), RESULT( 1 ) )
00652                            K1 = 1
00653                         ELSE
00654                            K1 = 2
00655                         END IF
00656 *
00657 *                       Compute residual of the computed solution.
00658 *
00659                         CALL DLACPY( 'Full', N, NRHS, BSAV, LDA, WORK,
00660      $                               LDA )
00661                         CALL DPOT02( UPLO, N, NRHS, ASAV, LDA, X, LDA,
00662      $                               WORK, LDA, RWORK( 2*NRHS+1 ),
00663      $                               RESULT( 2 ) )
00664 *
00665 *                       Check solution from generated exact solution.
00666 *
00667                         IF( NOFACT .OR. ( PREFAC .AND. LSAME( EQUED,
00668      $                      'N' ) ) ) THEN
00669                            CALL DGET04( N, NRHS, X, LDA, XACT, LDA,
00670      $                                  RCONDC, RESULT( 3 ) )
00671                         ELSE
00672                            CALL DGET04( N, NRHS, X, LDA, XACT, LDA,
00673      $                                  ROLDC, RESULT( 3 ) )
00674                         END IF
00675 *
00676 *                       Check the error bounds from iterative
00677 *                       refinement.
00678 *
00679                         CALL DPOT05( UPLO, N, NRHS, ASAV, LDA, B, LDA,
00680      $                               X, LDA, XACT, LDA, RWORK,
00681      $                               RWORK( NRHS+1 ), RESULT( 4 ) )
00682                      ELSE
00683                         K1 = 6
00684                      END IF
00685 *
00686 *                    Compare RCOND from DPOSVXX with the computed value
00687 *                    in RCONDC.
00688 *
00689                      RESULT( 6 ) = DGET06( RCOND, RCONDC )
00690 *
00691 *                    Print information about the tests that did not pass
00692 *                    the threshold.
00693 *
00694                      DO 85 K = K1, 6
00695                         IF( RESULT( K ).GE.THRESH ) THEN
00696                            IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00697      $                        CALL ALADHD( NOUT, PATH )
00698                            IF( PREFAC ) THEN
00699                               WRITE( NOUT, FMT = 9997 )'DPOSVXX', FACT,
00700      $                           UPLO, N, EQUED, IMAT, K, RESULT( K )
00701                            ELSE
00702                               WRITE( NOUT, FMT = 9998 )'DPOSVXX', FACT,
00703      $                           UPLO, N, IMAT, K, RESULT( K )
00704                            END IF
00705                            NFAIL = NFAIL + 1
00706                         END IF
00707    85                CONTINUE
00708                      NRUN = NRUN + 7 - K1
00709    90             CONTINUE
00710   100          CONTINUE
00711   110       CONTINUE
00712   120    CONTINUE
00713   130 CONTINUE
00714 *
00715 *     Print a summary of the results.
00716 *
00717       CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS )
00718 *
00719 
00720 *     Test Error Bounds from DPOSVXX
00721 
00722       CALL DEBCHVXX( THRESH, PATH )
00723 
00724  9999 FORMAT( 1X, A, ', UPLO=''', A1, ''', N =', I5, ', type ', I1,
00725      $      ', test(', I1, ')=', G12.5 )
00726  9998 FORMAT( 1X, A, ', FACT=''', A1, ''', UPLO=''', A1, ''', N=', I5,
00727      $      ', type ', I1, ', test(', I1, ')=', G12.5 )
00728  9997 FORMAT( 1X, A, ', FACT=''', A1, ''', UPLO=''', A1, ''', N=', I5,
00729      $      ', EQUED=''', A1, ''', type ', I1, ', test(', I1, ') =',
00730      $      G12.5 )
00731       RETURN
00732 *
00733 *     End of DDRVPO
00734 *
00735       END
 All Files Functions