LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
zdrvgex.f
Go to the documentation of this file.
00001 *> \brief \b ZDRVGEX
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 ZDRVGE( 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   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 *> ZDRVGE tests the driver routines ZGESV, -SVX, and -SVXX.
00035 *>
00036 *> Note that this file is used only when the XBLAS are available,
00037 *> otherwise zdrvge.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 column 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 (2*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 (2*NRHS+NMAX)
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 April 2012
00162 *
00163 *> \ingroup complex16_lin
00164 *
00165 *  =====================================================================
00166       SUBROUTINE ZDRVGE( 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.1) --
00171 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00172 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00173 *     April 2012
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   RWORK( * ), S( * )
00184       COMPLEX*16         A( * ), AFAC( * ), ASAV( * ), B( * ),
00185      $                   BSAV( * ), WORK( * ), 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 = 11 )
00195       INTEGER            NTESTS
00196       PARAMETER          ( NTESTS = 7 )
00197       INTEGER            NTRAN
00198       PARAMETER          ( NTRAN = 3 )
00199 *     ..
00200 *     .. Local Scalars ..
00201       LOGICAL            EQUIL, NOFACT, PREFAC, TRFCON, ZEROT
00202       CHARACTER          DIST, EQUED, FACT, TRANS, TYPE, XTYPE
00203       CHARACTER*3        PATH
00204       INTEGER            I, IEQUED, IFACT, IMAT, IN, INFO, IOFF, ITRAN,
00205      $                   IZERO, K, K1, KL, KU, LDA, LWORK, MODE, N, NB,
00206      $                   NBMIN, NERRS, NFACT, NFAIL, NIMAT, NRUN, NT,
00207      $                   N_ERR_BNDS
00208       DOUBLE PRECISION   AINVNM, AMAX, ANORM, ANORMI, ANORMO, CNDNUM,
00209      $                   COLCND, RCOND, RCONDC, RCONDI, RCONDO, ROLDC,
00210      $                   ROLDI, ROLDO, ROWCND, RPVGRW, RPVGRW_SVXX
00211 *     ..
00212 *     .. Local Arrays ..
00213       CHARACTER          EQUEDS( 4 ), FACTS( 3 ), TRANSS( NTRAN )
00214       INTEGER            ISEED( 4 ), ISEEDY( 4 )
00215       DOUBLE PRECISION   RDUM( 1 ), RESULT( NTESTS ), BERR( NRHS ),
00216      $                   ERRBNDS_N( NRHS, 3 ), ERRBNDS_C( NRHS, 3 )
00217 *     ..
00218 *     .. External Functions ..
00219       LOGICAL            LSAME
00220       DOUBLE PRECISION   DGET06, DLAMCH, ZLANGE, ZLANTR, ZLA_GERPVGRW
00221       EXTERNAL           LSAME, DGET06, DLAMCH, ZLANGE, ZLANTR,
00222      $                   ZLA_GERPVGRW
00223 *     ..
00224 *     .. External Subroutines ..
00225       EXTERNAL           ALADHD, ALAERH, ALASVM, XLAENV, ZERRVX, ZGEEQU,
00226      $                   ZGESV, ZGESVX, ZGET01, ZGET02, ZGET04, ZGET07,
00227      $                   ZGETRF, ZGETRI, ZLACPY, ZLAQGE, ZLARHS, ZLASET,
00228      $                   ZLATB4, ZLATMS, ZGESVXX
00229 *     ..
00230 *     .. Intrinsic Functions ..
00231       INTRINSIC          ABS, DCMPLX, MAX, DBLE, DIMAG
00232 *     ..
00233 *     .. Scalars in Common ..
00234       LOGICAL            LERR, OK
00235       CHARACTER*32       SRNAMT
00236       INTEGER            INFOT, NUNIT
00237 *     ..
00238 *     .. Common blocks ..
00239       COMMON             / INFOC / INFOT, NUNIT, OK, LERR
00240       COMMON             / SRNAMC / SRNAMT
00241 *     ..
00242 *     .. Data statements ..
00243       DATA               ISEEDY / 1988, 1989, 1990, 1991 /
00244       DATA               TRANSS / 'N', 'T', 'C' /
00245       DATA               FACTS / 'F', 'N', 'E' /
00246       DATA               EQUEDS / 'N', 'R', 'C', 'B' /
00247 *     ..
00248 *     .. Executable Statements ..
00249 *
00250 *     Initialize constants and the random number seed.
00251 *
00252       PATH( 1: 1 ) = 'Zomplex precision'
00253       PATH( 2: 3 ) = 'GE'
00254       NRUN = 0
00255       NFAIL = 0
00256       NERRS = 0
00257       DO 10 I = 1, 4
00258          ISEED( I ) = ISEEDY( I )
00259    10 CONTINUE
00260 *
00261 *     Test the error exits
00262 *
00263       IF( TSTERR )
00264      $   CALL ZERRVX( PATH, NOUT )
00265       INFOT = 0
00266 *
00267 *     Set the block size and minimum block size for testing.
00268 *
00269       NB = 1
00270       NBMIN = 2
00271       CALL XLAENV( 1, NB )
00272       CALL XLAENV( 2, NBMIN )
00273 *
00274 *     Do for each value of N in NVAL
00275 *
00276       DO 90 IN = 1, NN
00277          N = NVAL( IN )
00278          LDA = MAX( N, 1 )
00279          XTYPE = 'N'
00280          NIMAT = NTYPES
00281          IF( N.LE.0 )
00282      $      NIMAT = 1
00283 *
00284          DO 80 IMAT = 1, NIMAT
00285 *
00286 *           Do the tests only if DOTYPE( IMAT ) is true.
00287 *
00288             IF( .NOT.DOTYPE( IMAT ) )
00289      $         GO TO 80
00290 *
00291 *           Skip types 5, 6, or 7 if the matrix size is too small.
00292 *
00293             ZEROT = IMAT.GE.5 .AND. IMAT.LE.7
00294             IF( ZEROT .AND. N.LT.IMAT-4 )
00295      $         GO TO 80
00296 *
00297 *           Set up parameters with ZLATB4 and generate a test matrix
00298 *           with ZLATMS.
00299 *
00300             CALL ZLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM, MODE,
00301      $                   CNDNUM, DIST )
00302             RCONDC = ONE / CNDNUM
00303 *
00304             SRNAMT = 'ZLATMS'
00305             CALL ZLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE, CNDNUM,
00306      $                   ANORM, KL, KU, 'No packing', A, LDA, WORK,
00307      $                   INFO )
00308 *
00309 *           Check error code from ZLATMS.
00310 *
00311             IF( INFO.NE.0 ) THEN
00312                CALL ALAERH( PATH, 'ZLATMS', INFO, 0, ' ', N, N, -1, -1,
00313      $                      -1, IMAT, NFAIL, NERRS, NOUT )
00314                GO TO 80
00315             END IF
00316 *
00317 *           For types 5-7, zero one or more columns of the matrix to
00318 *           test that INFO is returned correctly.
00319 *
00320             IF( ZEROT ) THEN
00321                IF( IMAT.EQ.5 ) THEN
00322                   IZERO = 1
00323                ELSE IF( IMAT.EQ.6 ) THEN
00324                   IZERO = N
00325                ELSE
00326                   IZERO = N / 2 + 1
00327                END IF
00328                IOFF = ( IZERO-1 )*LDA
00329                IF( IMAT.LT.7 ) THEN
00330                   DO 20 I = 1, N
00331                      A( IOFF+I ) = ZERO
00332    20             CONTINUE
00333                ELSE
00334                   CALL ZLASET( 'Full', N, N-IZERO+1, DCMPLX( ZERO ),
00335      $                         DCMPLX( ZERO ), A( IOFF+1 ), LDA )
00336                END IF
00337             ELSE
00338                IZERO = 0
00339             END IF
00340 *
00341 *           Save a copy of the matrix A in ASAV.
00342 *
00343             CALL ZLACPY( 'Full', N, N, A, LDA, ASAV, LDA )
00344 *
00345             DO 70 IEQUED = 1, 4
00346                EQUED = EQUEDS( IEQUED )
00347                IF( IEQUED.EQ.1 ) THEN
00348                   NFACT = 3
00349                ELSE
00350                   NFACT = 1
00351                END IF
00352 *
00353                DO 60 IFACT = 1, NFACT
00354                   FACT = FACTS( IFACT )
00355                   PREFAC = LSAME( FACT, 'F' )
00356                   NOFACT = LSAME( FACT, 'N' )
00357                   EQUIL = LSAME( FACT, 'E' )
00358 *
00359                   IF( ZEROT ) THEN
00360                      IF( PREFAC )
00361      $                  GO TO 60
00362                      RCONDO = ZERO
00363                      RCONDI = ZERO
00364 *
00365                   ELSE IF( .NOT.NOFACT ) THEN
00366 *
00367 *                    Compute the condition number for comparison with
00368 *                    the value returned by ZGESVX (FACT = 'N' reuses
00369 *                    the condition number from the previous iteration
00370 *                    with FACT = 'F').
00371 *
00372                      CALL ZLACPY( 'Full', N, N, ASAV, LDA, AFAC, LDA )
00373                      IF( EQUIL .OR. IEQUED.GT.1 ) THEN
00374 *
00375 *                       Compute row and column scale factors to
00376 *                       equilibrate the matrix A.
00377 *
00378                         CALL ZGEEQU( N, N, AFAC, LDA, S, S( N+1 ),
00379      $                               ROWCND, COLCND, AMAX, INFO )
00380                         IF( INFO.EQ.0 .AND. N.GT.0 ) THEN
00381                            IF( LSAME( EQUED, 'R' ) ) THEN
00382                               ROWCND = ZERO
00383                               COLCND = ONE
00384                            ELSE IF( LSAME( EQUED, 'C' ) ) THEN
00385                               ROWCND = ONE
00386                               COLCND = ZERO
00387                            ELSE IF( LSAME( EQUED, 'B' ) ) THEN
00388                               ROWCND = ZERO
00389                               COLCND = ZERO
00390                            END IF
00391 *
00392 *                          Equilibrate the matrix.
00393 *
00394                            CALL ZLAQGE( N, N, AFAC, LDA, S, S( N+1 ),
00395      $                                  ROWCND, COLCND, AMAX, EQUED )
00396                         END IF
00397                      END IF
00398 *
00399 *                    Save the condition number of the non-equilibrated
00400 *                    system for use in ZGET04.
00401 *
00402                      IF( EQUIL ) THEN
00403                         ROLDO = RCONDO
00404                         ROLDI = RCONDI
00405                      END IF
00406 *
00407 *                    Compute the 1-norm and infinity-norm of A.
00408 *
00409                      ANORMO = ZLANGE( '1', N, N, AFAC, LDA, RWORK )
00410                      ANORMI = ZLANGE( 'I', N, N, AFAC, LDA, RWORK )
00411 *
00412 *                    Factor the matrix A.
00413 *
00414                      CALL ZGETRF( N, N, AFAC, LDA, IWORK, INFO )
00415 *
00416 *                    Form the inverse of A.
00417 *
00418                      CALL ZLACPY( 'Full', N, N, AFAC, LDA, A, LDA )
00419                      LWORK = NMAX*MAX( 3, NRHS )
00420                      CALL ZGETRI( N, A, LDA, IWORK, WORK, LWORK, INFO )
00421 *
00422 *                    Compute the 1-norm condition number of A.
00423 *
00424                      AINVNM = ZLANGE( '1', N, N, A, LDA, RWORK )
00425                      IF( ANORMO.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
00426                         RCONDO = ONE
00427                      ELSE
00428                         RCONDO = ( ONE / ANORMO ) / AINVNM
00429                      END IF
00430 *
00431 *                    Compute the infinity-norm condition number of A.
00432 *
00433                      AINVNM = ZLANGE( 'I', N, N, A, LDA, RWORK )
00434                      IF( ANORMI.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
00435                         RCONDI = ONE
00436                      ELSE
00437                         RCONDI = ( ONE / ANORMI ) / AINVNM
00438                      END IF
00439                   END IF
00440 *
00441                   DO 50 ITRAN = 1, NTRAN
00442 *
00443 *                    Do for each value of TRANS.
00444 *
00445                      TRANS = TRANSS( ITRAN )
00446                      IF( ITRAN.EQ.1 ) THEN
00447                         RCONDC = RCONDO
00448                      ELSE
00449                         RCONDC = RCONDI
00450                      END IF
00451 *
00452 *                    Restore the matrix A.
00453 *
00454                      CALL ZLACPY( 'Full', N, N, ASAV, LDA, A, LDA )
00455 *
00456 *                    Form an exact solution and set the right hand side.
00457 *
00458                      SRNAMT = 'ZLARHS'
00459                      CALL ZLARHS( PATH, XTYPE, 'Full', TRANS, N, N, KL,
00460      $                            KU, NRHS, A, LDA, XACT, LDA, B, LDA,
00461      $                            ISEED, INFO )
00462                      XTYPE = 'C'
00463                      CALL ZLACPY( 'Full', N, NRHS, B, LDA, BSAV, LDA )
00464 *
00465                      IF( NOFACT .AND. ITRAN.EQ.1 ) THEN
00466 *
00467 *                       --- Test ZGESV  ---
00468 *
00469 *                       Compute the LU factorization of the matrix and
00470 *                       solve the system.
00471 *
00472                         CALL ZLACPY( 'Full', N, N, A, LDA, AFAC, LDA )
00473                         CALL ZLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
00474 *
00475                         SRNAMT = 'ZGESV '
00476                         CALL ZGESV( N, NRHS, AFAC, LDA, IWORK, X, LDA,
00477      $                              INFO )
00478 *
00479 *                       Check error code from ZGESV .
00480 *
00481                         IF( INFO.NE.IZERO )
00482      $                     CALL ALAERH( PATH, 'ZGESV ', INFO, IZERO,
00483      $                                  ' ', N, N, -1, -1, NRHS, IMAT,
00484      $                                  NFAIL, NERRS, NOUT )
00485 *
00486 *                       Reconstruct matrix from factors and compute
00487 *                       residual.
00488 *
00489                         CALL ZGET01( N, N, A, LDA, AFAC, LDA, IWORK,
00490      $                               RWORK, RESULT( 1 ) )
00491                         NT = 1
00492                         IF( IZERO.EQ.0 ) THEN
00493 *
00494 *                          Compute residual of the computed solution.
00495 *
00496                            CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK,
00497      $                                  LDA )
00498                            CALL ZGET02( 'No transpose', N, N, NRHS, A,
00499      $                                  LDA, X, LDA, WORK, LDA, RWORK,
00500      $                                  RESULT( 2 ) )
00501 *
00502 *                          Check solution from generated exact solution.
00503 *
00504                            CALL ZGET04( N, NRHS, X, LDA, XACT, LDA,
00505      $                                  RCONDC, RESULT( 3 ) )
00506                            NT = 3
00507                         END IF
00508 *
00509 *                       Print information about the tests that did not
00510 *                       pass the threshold.
00511 *
00512                         DO 30 K = 1, NT
00513                            IF( RESULT( K ).GE.THRESH ) THEN
00514                               IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00515      $                           CALL ALADHD( NOUT, PATH )
00516                               WRITE( NOUT, FMT = 9999 )'ZGESV ', N,
00517      $                           IMAT, K, RESULT( K )
00518                               NFAIL = NFAIL + 1
00519                            END IF
00520    30                   CONTINUE
00521                         NRUN = NRUN + NT
00522                      END IF
00523 *
00524 *                    --- Test ZGESVX ---
00525 *
00526                      IF( .NOT.PREFAC )
00527      $                  CALL ZLASET( 'Full', N, N, DCMPLX( ZERO ),
00528      $                               DCMPLX( ZERO ), AFAC, LDA )
00529                      CALL ZLASET( 'Full', N, NRHS, DCMPLX( ZERO ),
00530      $                            DCMPLX( ZERO ), X, LDA )
00531                      IF( IEQUED.GT.1 .AND. N.GT.0 ) THEN
00532 *
00533 *                       Equilibrate the matrix if FACT = 'F' and
00534 *                       EQUED = 'R', 'C', or 'B'.
00535 *
00536                         CALL ZLAQGE( N, N, A, LDA, S, S( N+1 ), ROWCND,
00537      $                               COLCND, AMAX, EQUED )
00538                      END IF
00539 *
00540 *                    Solve the system and compute the condition number
00541 *                    and error bounds using ZGESVX.
00542 *
00543                      SRNAMT = 'ZGESVX'
00544                      CALL ZGESVX( FACT, TRANS, N, NRHS, A, LDA, AFAC,
00545      $                            LDA, IWORK, EQUED, S, S( N+1 ), B,
00546      $                            LDA, X, LDA, RCOND, RWORK,
00547      $                            RWORK( NRHS+1 ), WORK,
00548      $                            RWORK( 2*NRHS+1 ), INFO )
00549 *
00550 *                    Check the error code from ZGESVX.
00551 *
00552                      IF( INFO.NE.IZERO )
00553      $                  CALL ALAERH( PATH, 'ZGESVX', INFO, IZERO,
00554      $                               FACT // TRANS, N, N, -1, -1, NRHS,
00555      $                               IMAT, NFAIL, NERRS, NOUT )
00556 *
00557 *                    Compare RWORK(2*NRHS+1) from ZGESVX with the
00558 *                    computed reciprocal pivot growth factor RPVGRW
00559 *
00560                      IF( INFO.NE.0 ) THEN
00561                         RPVGRW = ZLANTR( 'M', 'U', 'N', INFO, INFO,
00562      $                           AFAC, LDA, RDUM )
00563                         IF( RPVGRW.EQ.ZERO ) THEN
00564                            RPVGRW = ONE
00565                         ELSE
00566                            RPVGRW = ZLANGE( 'M', N, INFO, A, LDA,
00567      $                              RDUM ) / RPVGRW
00568                         END IF
00569                      ELSE
00570                         RPVGRW = ZLANTR( 'M', 'U', 'N', N, N, AFAC, LDA,
00571      $                           RDUM )
00572                         IF( RPVGRW.EQ.ZERO ) THEN
00573                            RPVGRW = ONE
00574                         ELSE
00575                            RPVGRW = ZLANGE( 'M', N, N, A, LDA, RDUM ) /
00576      $                              RPVGRW
00577                         END IF
00578                      END IF
00579                      RESULT( 7 ) = ABS( RPVGRW-RWORK( 2*NRHS+1 ) ) /
00580      $                             MAX( RWORK( 2*NRHS+1 ), RPVGRW ) /
00581      $                             DLAMCH( 'E' )
00582 *
00583                      IF( .NOT.PREFAC ) THEN
00584 *
00585 *                       Reconstruct matrix from factors and compute
00586 *                       residual.
00587 *
00588                         CALL ZGET01( N, N, A, LDA, AFAC, LDA, IWORK,
00589      $                               RWORK( 2*NRHS+1 ), RESULT( 1 ) )
00590                         K1 = 1
00591                      ELSE
00592                         K1 = 2
00593                      END IF
00594 *
00595                      IF( INFO.EQ.0 ) THEN
00596                         TRFCON = .FALSE.
00597 *
00598 *                       Compute residual of the computed solution.
00599 *
00600                         CALL ZLACPY( 'Full', N, NRHS, BSAV, LDA, WORK,
00601      $                               LDA )
00602                         CALL ZGET02( TRANS, N, N, NRHS, ASAV, LDA, X,
00603      $                               LDA, WORK, LDA, RWORK( 2*NRHS+1 ),
00604      $                               RESULT( 2 ) )
00605 *
00606 *                       Check solution from generated exact solution.
00607 *
00608                         IF( NOFACT .OR. ( PREFAC .AND. LSAME( EQUED,
00609      $                      'N' ) ) ) THEN
00610                            CALL ZGET04( N, NRHS, X, LDA, XACT, LDA,
00611      $                                  RCONDC, RESULT( 3 ) )
00612                         ELSE
00613                            IF( ITRAN.EQ.1 ) THEN
00614                               ROLDC = ROLDO
00615                            ELSE
00616                               ROLDC = ROLDI
00617                            END IF
00618                            CALL ZGET04( N, NRHS, X, LDA, XACT, LDA,
00619      $                                  ROLDC, RESULT( 3 ) )
00620                         END IF
00621 *
00622 *                       Check the error bounds from iterative
00623 *                       refinement.
00624 *
00625                         CALL ZGET07( TRANS, N, NRHS, ASAV, LDA, B, LDA,
00626      $                               X, LDA, XACT, LDA, RWORK, .TRUE.,
00627      $                               RWORK( NRHS+1 ), RESULT( 4 ) )
00628                      ELSE
00629                         TRFCON = .TRUE.
00630                      END IF
00631 *
00632 *                    Compare RCOND from ZGESVX with the computed value
00633 *                    in RCONDC.
00634 *
00635                      RESULT( 6 ) = DGET06( RCOND, RCONDC )
00636 *
00637 *                    Print information about the tests that did not pass
00638 *                    the threshold.
00639 *
00640                      IF( .NOT.TRFCON ) THEN
00641                         DO 40 K = K1, NTESTS
00642                            IF( RESULT( K ).GE.THRESH ) THEN
00643                               IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00644      $                           CALL ALADHD( NOUT, PATH )
00645                               IF( PREFAC ) THEN
00646                                  WRITE( NOUT, FMT = 9997 )'ZGESVX',
00647      $                              FACT, TRANS, N, EQUED, IMAT, K,
00648      $                              RESULT( K )
00649                               ELSE
00650                                  WRITE( NOUT, FMT = 9998 )'ZGESVX',
00651      $                              FACT, TRANS, N, IMAT, K, RESULT( K )
00652                               END IF
00653                               NFAIL = NFAIL + 1
00654                            END IF
00655    40                   CONTINUE
00656                         NRUN = NRUN + 7 - K1
00657                      ELSE
00658                         IF( RESULT( 1 ).GE.THRESH .AND. .NOT.PREFAC )
00659      $                       THEN
00660                            IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00661      $                        CALL ALADHD( NOUT, PATH )
00662                            IF( PREFAC ) THEN
00663                               WRITE( NOUT, FMT = 9997 )'ZGESVX', FACT,
00664      $                           TRANS, N, EQUED, IMAT, 1, RESULT( 1 )
00665                            ELSE
00666                               WRITE( NOUT, FMT = 9998 )'ZGESVX', FACT,
00667      $                           TRANS, N, IMAT, 1, RESULT( 1 )
00668                            END IF
00669                            NFAIL = NFAIL + 1
00670                            NRUN = NRUN + 1
00671                         END IF
00672                         IF( RESULT( 6 ).GE.THRESH ) THEN
00673                            IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00674      $                        CALL ALADHD( NOUT, PATH )
00675                            IF( PREFAC ) THEN
00676                               WRITE( NOUT, FMT = 9997 )'ZGESVX', FACT,
00677      $                           TRANS, N, EQUED, IMAT, 6, RESULT( 6 )
00678                            ELSE
00679                               WRITE( NOUT, FMT = 9998 )'ZGESVX', FACT,
00680      $                           TRANS, N, IMAT, 6, RESULT( 6 )
00681                            END IF
00682                            NFAIL = NFAIL + 1
00683                            NRUN = NRUN + 1
00684                         END IF
00685                         IF( RESULT( 7 ).GE.THRESH ) THEN
00686                            IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00687      $                        CALL ALADHD( NOUT, PATH )
00688                            IF( PREFAC ) THEN
00689                               WRITE( NOUT, FMT = 9997 )'ZGESVX', FACT,
00690      $                           TRANS, N, EQUED, IMAT, 7, RESULT( 7 )
00691                            ELSE
00692                               WRITE( NOUT, FMT = 9998 )'ZGESVX', FACT,
00693      $                           TRANS, N, IMAT, 7, RESULT( 7 )
00694                            END IF
00695                            NFAIL = NFAIL + 1
00696                            NRUN = NRUN + 1
00697                         END IF
00698 *
00699                      END IF
00700 *
00701 *                    --- Test ZGESVXX ---
00702 *
00703 *                    Restore the matrices A and B.
00704 *
00705 
00706                      CALL ZLACPY( 'Full', N, N, ASAV, LDA, A, LDA )
00707                      CALL ZLACPY( 'Full', N, NRHS, BSAV, LDA, B, LDA )
00708 
00709                      IF( .NOT.PREFAC )
00710      $                  CALL ZLASET( 'Full', N, N, ZERO, ZERO, AFAC,
00711      $                               LDA )
00712                      CALL ZLASET( 'Full', N, NRHS, ZERO, ZERO, X, LDA )
00713                      IF( IEQUED.GT.1 .AND. N.GT.0 ) THEN
00714 *
00715 *                       Equilibrate the matrix if FACT = 'F' and
00716 *                       EQUED = 'R', 'C', or 'B'.
00717 *
00718                         CALL ZLAQGE( N, N, A, LDA, S, S( N+1 ), ROWCND,
00719      $                               COLCND, AMAX, EQUED )
00720                      END IF
00721 *
00722 *                    Solve the system and compute the condition number
00723 *                    and error bounds using ZGESVXX.
00724 *
00725                      SRNAMT = 'ZGESVXX'
00726                      N_ERR_BNDS = 3
00727                      CALL ZGESVXX( FACT, TRANS, N, NRHS, A, LDA, AFAC,
00728      $                    LDA, IWORK, EQUED, S, S( N+1 ), B, LDA, X,
00729      $                    LDA, RCOND, RPVGRW_SVXX, BERR, N_ERR_BNDS,
00730      $                    ERRBNDS_N, ERRBNDS_C, 0, ZERO, WORK,
00731      $                    RWORK, INFO )
00732 *
00733 *                    Check the error code from ZGESVXX.
00734 *
00735                      IF( INFO.EQ.N+1 ) GOTO 50
00736                      IF( INFO.NE.IZERO ) THEN
00737                         CALL ALAERH( PATH, 'ZGESVXX', INFO, IZERO,
00738      $                               FACT // TRANS, N, N, -1, -1, NRHS,
00739      $                               IMAT, NFAIL, NERRS, NOUT )
00740                         GOTO 50
00741                      END IF
00742 *
00743 *                    Compare rpvgrw_svxx from ZGESVXX with the computed
00744 *                    reciprocal pivot growth factor RPVGRW
00745 *
00746 
00747                      IF ( INFO .GT. 0 .AND. INFO .LT. N+1 ) THEN
00748                         RPVGRW = ZLA_GERPVGRW
00749      $                               (N, INFO, A, LDA, AFAC, LDA)
00750                      ELSE
00751                         RPVGRW = ZLA_GERPVGRW
00752      $                               (N, N, A, LDA, AFAC, LDA)
00753                      ENDIF
00754 
00755                      RESULT( 7 ) = ABS( RPVGRW-rpvgrw_svxx ) /
00756      $                             MAX( rpvgrw_svxx, RPVGRW ) /
00757      $                             DLAMCH( 'E' )
00758 *
00759                      IF( .NOT.PREFAC ) THEN
00760 *
00761 *                       Reconstruct matrix from factors and compute
00762 *                       residual.
00763 *
00764                         CALL ZGET01( N, N, A, LDA, AFAC, LDA, IWORK,
00765      $                               RWORK( 2*NRHS+1 ), RESULT( 1 ) )
00766                         K1 = 1
00767                      ELSE
00768                         K1 = 2
00769                      END IF
00770 *
00771                      IF( INFO.EQ.0 ) THEN
00772                         TRFCON = .FALSE.
00773 *
00774 *                       Compute residual of the computed solution.
00775 *
00776                         CALL ZLACPY( 'Full', N, NRHS, BSAV, LDA, WORK,
00777      $                               LDA )
00778                         CALL ZGET02( TRANS, N, N, NRHS, ASAV, LDA, X,
00779      $                               LDA, WORK, LDA, RWORK( 2*NRHS+1 ),
00780      $                               RESULT( 2 ) )
00781 *
00782 *                       Check solution from generated exact solution.
00783 *
00784                         IF( NOFACT .OR. ( PREFAC .AND. LSAME( EQUED,
00785      $                      'N' ) ) ) THEN
00786                            CALL ZGET04( N, NRHS, X, LDA, XACT, LDA,
00787      $                                  RCONDC, RESULT( 3 ) )
00788                         ELSE
00789                            IF( ITRAN.EQ.1 ) THEN
00790                               ROLDC = ROLDO
00791                            ELSE
00792                               ROLDC = ROLDI
00793                            END IF
00794                            CALL ZGET04( N, NRHS, X, LDA, XACT, LDA,
00795      $                                  ROLDC, RESULT( 3 ) )
00796                         END IF
00797                      ELSE
00798                         TRFCON = .TRUE.
00799                      END IF
00800 *
00801 *                    Compare RCOND from ZGESVXX with the computed value
00802 *                    in RCONDC.
00803 *
00804                      RESULT( 6 ) = DGET06( RCOND, RCONDC )
00805 *
00806 *                    Print information about the tests that did not pass
00807 *                    the threshold.
00808 *
00809                      IF( .NOT.TRFCON ) THEN
00810                         DO 45 K = K1, NTESTS
00811                            IF( RESULT( K ).GE.THRESH ) THEN
00812                               IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00813      $                           CALL ALADHD( NOUT, PATH )
00814                               IF( PREFAC ) THEN
00815                                  WRITE( NOUT, FMT = 9997 )'ZGESVXX',
00816      $                              FACT, TRANS, N, EQUED, IMAT, K,
00817      $                              RESULT( K )
00818                               ELSE
00819                                  WRITE( NOUT, FMT = 9998 )'ZGESVXX',
00820      $                              FACT, TRANS, N, IMAT, K, RESULT( K )
00821                               END IF
00822                               NFAIL = NFAIL + 1
00823                            END IF
00824  45                     CONTINUE
00825                         NRUN = NRUN + 7 - K1
00826                      ELSE
00827                         IF( RESULT( 1 ).GE.THRESH .AND. .NOT.PREFAC )
00828      $                       THEN
00829                            IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00830      $                        CALL ALADHD( NOUT, PATH )
00831                            IF( PREFAC ) THEN
00832                               WRITE( NOUT, FMT = 9997 )'ZGESVXX', FACT,
00833      $                           TRANS, N, EQUED, IMAT, 1, RESULT( 1 )
00834                            ELSE
00835                               WRITE( NOUT, FMT = 9998 )'ZGESVXX', FACT,
00836      $                           TRANS, N, IMAT, 1, RESULT( 1 )
00837                            END IF
00838                            NFAIL = NFAIL + 1
00839                            NRUN = NRUN + 1
00840                         END IF
00841                         IF( RESULT( 6 ).GE.THRESH ) THEN
00842                            IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00843      $                        CALL ALADHD( NOUT, PATH )
00844                            IF( PREFAC ) THEN
00845                               WRITE( NOUT, FMT = 9997 )'ZGESVXX', FACT,
00846      $                           TRANS, N, EQUED, IMAT, 6, RESULT( 6 )
00847                            ELSE
00848                               WRITE( NOUT, FMT = 9998 )'ZGESVXX', FACT,
00849      $                           TRANS, N, IMAT, 6, RESULT( 6 )
00850                            END IF
00851                            NFAIL = NFAIL + 1
00852                            NRUN = NRUN + 1
00853                         END IF
00854                         IF( RESULT( 7 ).GE.THRESH ) THEN
00855                            IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00856      $                        CALL ALADHD( NOUT, PATH )
00857                            IF( PREFAC ) THEN
00858                               WRITE( NOUT, FMT = 9997 )'ZGESVXX', FACT,
00859      $                           TRANS, N, EQUED, IMAT, 7, RESULT( 7 )
00860                            ELSE
00861                               WRITE( NOUT, FMT = 9998 )'ZGESVXX', FACT,
00862      $                           TRANS, N, IMAT, 7, RESULT( 7 )
00863                            END IF
00864                            NFAIL = NFAIL + 1
00865                            NRUN = NRUN + 1
00866                         END IF
00867 *
00868                      END IF
00869 *
00870    50             CONTINUE
00871    60          CONTINUE
00872    70       CONTINUE
00873    80    CONTINUE
00874    90 CONTINUE
00875 *
00876 *     Print a summary of the results.
00877 *
00878       CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS )
00879 *
00880 
00881 *     Test Error Bounds for ZGESVXX
00882 
00883       CALL ZEBCHVXX(THRESH, PATH)
00884 
00885  9999 FORMAT( 1X, A, ', N =', I5, ', type ', I2, ', test(', I2, ') =',
00886      $      G12.5 )
00887  9998 FORMAT( 1X, A, ', FACT=''', A1, ''', TRANS=''', A1, ''', N=', I5,
00888      $      ', type ', I2, ', test(', I1, ')=', G12.5 )
00889  9997 FORMAT( 1X, A, ', FACT=''', A1, ''', TRANS=''', A1, ''', N=', I5,
00890      $      ', EQUED=''', A1, ''', type ', I2, ', test(', I1, ')=',
00891      $      G12.5 )
00892       RETURN
00893 *
00894 *     End of ZDRVGE
00895 *
00896       END
 All Files Functions