LAPACK 3.3.1
Linear Algebra PACKage

zdrvpox.f

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