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