LAPACK: TESTING/LIN/zdrvgex.f Source File

Go to the documentation of this file.
00001       SUBROUTINE ZDRVGE( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX,
00002      $                   A, AFAC, ASAV, B, BSAV, X, XACT, S, WORK,
00003      $                   RWORK, IWORK, NOUT )
00004 *
00005 *  -- LAPACK test routine (version 3.2.1) --
00006 *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
00007 *     April 2009
00008 *
00009 *     .. Scalar Arguments ..
00010       LOGICAL            TSTERR
00011       INTEGER            NMAX, NN, NOUT, NRHS
00012       DOUBLE PRECISION   THRESH
00013 *     ..
00014 *     .. Array Arguments ..
00015       LOGICAL            DOTYPE( * )
00016       INTEGER            IWORK( * ), NVAL( * )
00017       DOUBLE PRECISION   RWORK( * ), S( * )
00018       COMPLEX*16         A( * ), AFAC( * ), ASAV( * ), B( * ),
00019      $                   BSAV( * ), WORK( * ), X( * ), XACT( * )
00020 *     ..
00021 *
00022 *  Purpose
00023 *  =======
00024 *
00025 *  ZDRVGE tests the driver routines ZGESV, -SVX, and -SVXX.
00026 *
00027 *  Note that this file is used only when the XBLAS are available,
00028 *  otherwise zdrvge.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 column 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 (2*NMAX)
00075 *
00076 *  WORK    (workspace) COMPLEX*16 array, dimension
00077 *                      (NMAX*max(3,NRHS))
00078 *
00079 *  RWORK   (workspace) DOUBLE PRECISION array, dimension (2*NRHS+NMAX)
00080 *
00081 *  IWORK   (workspace) INTEGER array, dimension (NMAX)
00082 *
00083 *  NOUT    (input) INTEGER
00084 *          The unit number for output.
00085 *
00086 *  =====================================================================
00087 *
00088 *     .. Parameters ..
00089       DOUBLE PRECISION   ONE, ZERO
00090       PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
00091       INTEGER            NTYPES
00092       PARAMETER          ( NTYPES = 11 )
00093       INTEGER            NTESTS
00094       PARAMETER          ( NTESTS = 7 )
00095       INTEGER            NTRAN
00096       PARAMETER          ( NTRAN = 3 )
00097 *     ..
00098 *     .. Local Scalars ..
00099       LOGICAL            EQUIL, NOFACT, PREFAC, TRFCON, ZEROT
00100       CHARACTER          DIST, EQUED, FACT, TRANS, TYPE, XTYPE
00101       CHARACTER*3        PATH
00102       INTEGER            I, IEQUED, IFACT, IMAT, IN, INFO, IOFF, ITRAN,
00103      $                   IZERO, K, K1, KL, KU, LDA, LWORK, MODE, N, NB,
00104      $                   NBMIN, NERRS, NFACT, NFAIL, NIMAT, NRUN, NT,
00105      $                   N_ERR_BNDS
00106       DOUBLE PRECISION   AINVNM, AMAX, ANORM, ANORMI, ANORMO, CNDNUM,
00107      $                   COLCND, RCOND, RCONDC, RCONDI, RCONDO, ROLDC,
00108      $                   ROLDI, ROLDO, ROWCND, RPVGRW, RPVGRW_SVXX
00109 *     ..
00110 *     .. Local Arrays ..
00111       CHARACTER          EQUEDS( 4 ), FACTS( 3 ), TRANSS( NTRAN )
00112       INTEGER            ISEED( 4 ), ISEEDY( 4 )
00113       DOUBLE PRECISION   RDUM( 1 ), RESULT( NTESTS ), BERR( NRHS ),
00114      $                   ERRBNDS_N( NRHS, 3 ), ERRBNDS_C( NRHS, 3 )
00115 *     ..
00116 *     .. External Functions ..
00117       LOGICAL            LSAME
00118       DOUBLE PRECISION   DGET06, DLAMCH, ZLANGE, ZLANTR, ZLA_RPVGRW
00119       EXTERNAL           LSAME, DGET06, DLAMCH, ZLANGE, ZLANTR,
00120      $                   ZLA_RPVGRW
00121 *     ..
00122 *     .. External Subroutines ..
00123       EXTERNAL           ALADHD, ALAERH, ALASVM, XLAENV, ZERRVX, ZGEEQU,
00124      $                   ZGESV, ZGESVX, ZGET01, ZGET02, ZGET04, ZGET07,
00125      $                   ZGETRF, ZGETRI, ZLACPY, ZLAQGE, ZLARHS, ZLASET,
00126      $                   ZLATB4, ZLATMS, ZGESVXX
00127 *     ..
00128 *     .. Intrinsic Functions ..
00129       INTRINSIC          ABS, DCMPLX, MAX, DBLE, DIMAG
00130 *     ..
00131 *     .. Scalars in Common ..
00132       LOGICAL            LERR, OK
00133       CHARACTER*32       SRNAMT
00134       INTEGER            INFOT, NUNIT
00135 *     ..
00136 *     .. Common blocks ..
00137       COMMON             / INFOC / INFOT, NUNIT, OK, LERR
00138       COMMON             / SRNAMC / SRNAMT
00139 *     ..
00140 *     .. Data statements ..
00141       DATA               ISEEDY / 1988, 1989, 1990, 1991 /
00142       DATA               TRANSS / 'N', 'T', 'C' /
00143       DATA               FACTS / 'F', 'N', 'E' /
00144       DATA               EQUEDS / 'N', 'R', 'C', 'B' /
00145 *     ..
00146 *     .. Executable Statements ..
00147 *
00148 *     Initialize constants and the random number seed.
00149 *
00150       PATH( 1: 1 ) = 'Zomplex precision'
00151       PATH( 2: 3 ) = 'GE'
00152       NRUN = 0
00153       NFAIL = 0
00154       NERRS = 0
00155       DO 10 I = 1, 4
00156          ISEED( I ) = ISEEDY( I )
00157    10 CONTINUE
00158 *
00159 *     Test the error exits
00160 *
00161       IF( TSTERR )
00162      $   CALL ZERRVX( PATH, NOUT )
00163       INFOT = 0
00164 *
00165 *     Set the block size and minimum block size for testing.
00166 *
00167       NB = 1
00168       NBMIN = 2
00169       CALL XLAENV( 1, NB )
00170       CALL XLAENV( 2, NBMIN )
00171 *
00172 *     Do for each value of N in NVAL
00173 *
00174       DO 90 IN = 1, NN
00175          N = NVAL( IN )
00176          LDA = MAX( N, 1 )
00177          XTYPE = 'N'
00178          NIMAT = NTYPES
00179          IF( N.LE.0 )
00180      $      NIMAT = 1
00181 *
00182          DO 80 IMAT = 1, NIMAT
00183 *
00184 *           Do the tests only if DOTYPE( IMAT ) is true.
00185 *
00186             IF( .NOT.DOTYPE( IMAT ) )
00187      $         GO TO 80
00188 *
00189 *           Skip types 5, 6, or 7 if the matrix size is too small.
00190 *
00191             ZEROT = IMAT.GE.5 .AND. IMAT.LE.7
00192             IF( ZEROT .AND. N.LT.IMAT-4 )
00193      $         GO TO 80
00194 *
00195 *           Set up parameters with ZLATB4 and generate a test matrix
00196 *           with ZLATMS.
00197 *
00198             CALL ZLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM, MODE,
00199      $                   CNDNUM, DIST )
00200             RCONDC = ONE / CNDNUM
00201 *
00202             SRNAMT = 'ZLATMS'
00203             CALL ZLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE, CNDNUM,
00204      $                   ANORM, KL, KU, 'No packing', A, LDA, WORK,
00205      $                   INFO )
00206 *
00207 *           Check error code from ZLATMS.
00208 *
00209             IF( INFO.NE.0 ) THEN
00210                CALL ALAERH( PATH, 'ZLATMS', INFO, 0, ' ', N, N, -1, -1,
00211      $                      -1, IMAT, NFAIL, NERRS, NOUT )
00212                GO TO 80
00213             END IF
00214 *
00215 *           For types 5-7, zero one or more columns of the matrix to
00216 *           test that INFO is returned correctly.
00217 *
00218             IF( ZEROT ) THEN
00219                IF( IMAT.EQ.5 ) THEN
00220                   IZERO = 1
00221                ELSE IF( IMAT.EQ.6 ) THEN
00222                   IZERO = N
00223                ELSE
00224                   IZERO = N / 2 + 1
00225                END IF
00226                IOFF = ( IZERO-1 )*LDA
00227                IF( IMAT.LT.7 ) THEN
00228                   DO 20 I = 1, N
00229                      A( IOFF+I ) = ZERO
00230    20             CONTINUE
00231                ELSE
00232                   CALL ZLASET( 'Full', N, N-IZERO+1, DCMPLX( ZERO ),
00233      $                         DCMPLX( ZERO ), A( IOFF+1 ), LDA )
00234                END IF
00235             ELSE
00236                IZERO = 0
00237             END IF
00238 *
00239 *           Save a copy of the matrix A in ASAV.
00240 *
00241             CALL ZLACPY( 'Full', N, N, A, LDA, ASAV, LDA )
00242 *
00243             DO 70 IEQUED = 1, 4
00244                EQUED = EQUEDS( IEQUED )
00245                IF( IEQUED.EQ.1 ) THEN
00246                   NFACT = 3
00247                ELSE
00248                   NFACT = 1
00249                END IF
00250 *
00251                DO 60 IFACT = 1, NFACT
00252                   FACT = FACTS( IFACT )
00253                   PREFAC = LSAME( FACT, 'F' )
00254                   NOFACT = LSAME( FACT, 'N' )
00255                   EQUIL = LSAME( FACT, 'E' )
00256 *
00257                   IF( ZEROT ) THEN
00258                      IF( PREFAC )
00259      $                  GO TO 60
00260                      RCONDO = ZERO
00261                      RCONDI = ZERO
00262 *
00263                   ELSE IF( .NOT.NOFACT ) THEN
00264 *
00265 *                    Compute the condition number for comparison with
00266 *                    the value returned by ZGESVX (FACT = 'N' reuses
00267 *                    the condition number from the previous iteration
00268 *                    with FACT = 'F').
00269 *
00270                      CALL ZLACPY( 'Full', N, N, ASAV, LDA, AFAC, LDA )
00271                      IF( EQUIL .OR. IEQUED.GT.1 ) THEN
00272 *
00273 *                       Compute row and column scale factors to
00274 *                       equilibrate the matrix A.
00275 *
00276                         CALL ZGEEQU( N, N, AFAC, LDA, S, S( N+1 ),
00277      $                               ROWCND, COLCND, AMAX, INFO )
00278                         IF( INFO.EQ.0 .AND. N.GT.0 ) THEN
00279                            IF( LSAME( EQUED, 'R' ) ) THEN
00280                               ROWCND = ZERO
00281                               COLCND = ONE
00282                            ELSE IF( LSAME( EQUED, 'C' ) ) THEN
00283                               ROWCND = ONE
00284                               COLCND = ZERO
00285                            ELSE IF( LSAME( EQUED, 'B' ) ) THEN
00286                               ROWCND = ZERO
00287                               COLCND = ZERO
00288                            END IF
00289 *
00290 *                          Equilibrate the matrix.
00291 *
00292                            CALL ZLAQGE( N, N, AFAC, LDA, S, S( N+1 ),
00293      $                                  ROWCND, COLCND, AMAX, EQUED )
00294                         END IF
00295                      END IF
00296 *
00297 *                    Save the condition number of the non-equilibrated
00298 *                    system for use in ZGET04.
00299 *
00300                      IF( EQUIL ) THEN
00301                         ROLDO = RCONDO
00302                         ROLDI = RCONDI
00303                      END IF
00304 *
00305 *                    Compute the 1-norm and infinity-norm of A.
00306 *
00307                      ANORMO = ZLANGE( '1', N, N, AFAC, LDA, RWORK )
00308                      ANORMI = ZLANGE( 'I', N, N, AFAC, LDA, RWORK )
00309 *
00310 *                    Factor the matrix A.
00311 *
00312                      CALL ZGETRF( N, N, AFAC, LDA, IWORK, INFO )
00313 *
00314 *                    Form the inverse of A.
00315 *
00316                      CALL ZLACPY( 'Full', N, N, AFAC, LDA, A, LDA )
00317                      LWORK = NMAX*MAX( 3, NRHS )
00318                      CALL ZGETRI( N, A, LDA, IWORK, WORK, LWORK, INFO )
00319 *
00320 *                    Compute the 1-norm condition number of A.
00321 *
00322                      AINVNM = ZLANGE( '1', N, N, A, LDA, RWORK )
00323                      IF( ANORMO.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
00324                         RCONDO = ONE
00325                      ELSE
00326                         RCONDO = ( ONE / ANORMO ) / AINVNM
00327                      END IF
00328 *
00329 *                    Compute the infinity-norm condition number of A.
00330 *
00331                      AINVNM = ZLANGE( 'I', N, N, A, LDA, RWORK )
00332                      IF( ANORMI.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
00333                         RCONDI = ONE
00334                      ELSE
00335                         RCONDI = ( ONE / ANORMI ) / AINVNM
00336                      END IF
00337                   END IF
00338 *
00339                   DO 50 ITRAN = 1, NTRAN
00340 *
00341 *                    Do for each value of TRANS.
00342 *
00343                      TRANS = TRANSS( ITRAN )
00344                      IF( ITRAN.EQ.1 ) THEN
00345                         RCONDC = RCONDO
00346                      ELSE
00347                         RCONDC = RCONDI
00348                      END IF
00349 *
00350 *                    Restore the matrix A.
00351 *
00352                      CALL ZLACPY( 'Full', N, N, ASAV, LDA, A, LDA )
00353 *
00354 *                    Form an exact solution and set the right hand side.
00355 *
00356                      SRNAMT = 'ZLARHS'
00357                      CALL ZLARHS( PATH, XTYPE, 'Full', TRANS, N, N, KL,
00358      $                            KU, NRHS, A, LDA, XACT, LDA, B, LDA,
00359      $                            ISEED, INFO )
00360                      XTYPE = 'C'
00361                      CALL ZLACPY( 'Full', N, NRHS, B, LDA, BSAV, LDA )
00362 *
00363                      IF( NOFACT .AND. ITRAN.EQ.1 ) THEN
00364 *
00365 *                       --- Test ZGESV  ---
00366 *
00367 *                       Compute the LU factorization of the matrix and
00368 *                       solve the system.
00369 *
00370                         CALL ZLACPY( 'Full', N, N, A, LDA, AFAC, LDA )
00371                         CALL ZLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
00372 *
00373                         SRNAMT = 'ZGESV '
00374                         CALL ZGESV( N, NRHS, AFAC, LDA, IWORK, X, LDA,
00375      $                              INFO )
00376 *
00377 *                       Check error code from ZGESV .
00378 *
00379                         IF( INFO.NE.IZERO )
00380      $                     CALL ALAERH( PATH, 'ZGESV ', INFO, IZERO,
00381      $                                  ' ', N, N, -1, -1, NRHS, IMAT,
00382      $                                  NFAIL, NERRS, NOUT )
00383 *
00384 *                       Reconstruct matrix from factors and compute
00385 *                       residual.
00386 *
00387                         CALL ZGET01( N, N, A, LDA, AFAC, LDA, IWORK,
00388      $                               RWORK, RESULT( 1 ) )
00389                         NT = 1
00390                         IF( IZERO.EQ.0 ) THEN
00391 *
00392 *                          Compute residual of the computed solution.
00393 *
00394                            CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK,
00395      $                                  LDA )
00396                            CALL ZGET02( 'No transpose', N, N, NRHS, A,
00397      $                                  LDA, X, LDA, WORK, LDA, RWORK,
00398      $                                  RESULT( 2 ) )
00399 *
00400 *                          Check solution from generated exact solution.
00401 *
00402                            CALL ZGET04( N, NRHS, X, LDA, XACT, LDA,
00403      $                                  RCONDC, RESULT( 3 ) )
00404                            NT = 3
00405                         END IF
00406 *
00407 *                       Print information about the tests that did not
00408 *                       pass the threshold.
00409 *
00410                         DO 30 K = 1, NT
00411                            IF( RESULT( K ).GE.THRESH ) THEN
00412                               IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00413      $                           CALL ALADHD( NOUT, PATH )
00414                               WRITE( NOUT, FMT = 9999 )'ZGESV ', N,
00415      $                           IMAT, K, RESULT( K )
00416                               NFAIL = NFAIL + 1
00417                            END IF
00418    30                   CONTINUE
00419                         NRUN = NRUN + NT
00420                      END IF
00421 *
00422 *                    --- Test ZGESVX ---
00423 *
00424                      IF( .NOT.PREFAC )
00425      $                  CALL ZLASET( 'Full', N, N, DCMPLX( ZERO ),
00426      $                               DCMPLX( ZERO ), AFAC, LDA )
00427                      CALL ZLASET( 'Full', N, NRHS, DCMPLX( ZERO ),
00428      $                            DCMPLX( ZERO ), X, LDA )
00429                      IF( IEQUED.GT.1 .AND. N.GT.0 ) THEN
00430 *
00431 *                       Equilibrate the matrix if FACT = 'F' and
00432 *                       EQUED = 'R', 'C', or 'B'.
00433 *
00434                         CALL ZLAQGE( N, N, A, LDA, S, S( N+1 ), ROWCND,
00435      $                               COLCND, AMAX, EQUED )
00436                      END IF
00437 *
00438 *                    Solve the system and compute the condition number
00439 *                    and error bounds using ZGESVX.
00440 *
00441                      SRNAMT = 'ZGESVX'
00442                      CALL ZGESVX( FACT, TRANS, N, NRHS, A, LDA, AFAC,
00443      $                            LDA, IWORK, EQUED, S, S( N+1 ), B,
00444      $                            LDA, X, LDA, RCOND, RWORK,
00445      $                            RWORK( NRHS+1 ), WORK,
00446      $                            RWORK( 2*NRHS+1 ), INFO )
00447 *
00448 *                    Check the error code from ZGESVX.
00449 *
00450                      IF( INFO.NE.IZERO )
00451      $                  CALL ALAERH( PATH, 'ZGESVX', INFO, IZERO,
00452      $                               FACT // TRANS, N, N, -1, -1, NRHS,
00453      $                               IMAT, NFAIL, NERRS, NOUT )
00454 *
00455 *                    Compare RWORK(2*NRHS+1) from ZGESVX with the
00456 *                    computed reciprocal pivot growth factor RPVGRW
00457 *
00458                      IF( INFO.NE.0 ) THEN
00459                         RPVGRW = ZLANTR( 'M', 'U', 'N', INFO, INFO,
00460      $                           AFAC, LDA, RDUM )
00461                         IF( RPVGRW.EQ.ZERO ) THEN
00462                            RPVGRW = ONE
00463                         ELSE
00464                            RPVGRW = ZLANGE( 'M', N, INFO, A, LDA,
00465      $                              RDUM ) / RPVGRW
00466                         END IF
00467                      ELSE
00468                         RPVGRW = ZLANTR( 'M', 'U', 'N', N, N, AFAC, LDA,
00469      $                           RDUM )
00470                         IF( RPVGRW.EQ.ZERO ) THEN
00471                            RPVGRW = ONE
00472                         ELSE
00473                            RPVGRW = ZLANGE( 'M', N, N, A, LDA, RDUM ) /
00474      $                              RPVGRW
00475                         END IF
00476                      END IF
00477                      RESULT( 7 ) = ABS( RPVGRW-RWORK( 2*NRHS+1 ) ) /
00478      $                             MAX( RWORK( 2*NRHS+1 ), RPVGRW ) /
00479      $                             DLAMCH( 'E' )
00480 *
00481                      IF( .NOT.PREFAC ) THEN
00482 *
00483 *                       Reconstruct matrix from factors and compute
00484 *                       residual.
00485 *
00486                         CALL ZGET01( N, N, A, LDA, AFAC, LDA, IWORK,
00487      $                               RWORK( 2*NRHS+1 ), RESULT( 1 ) )
00488                         K1 = 1
00489                      ELSE
00490                         K1 = 2
00491                      END IF
00492 *
00493                      IF( INFO.EQ.0 ) THEN
00494                         TRFCON = .FALSE.
00495 *
00496 *                       Compute residual of the computed solution.
00497 *
00498                         CALL ZLACPY( 'Full', N, NRHS, BSAV, LDA, WORK,
00499      $                               LDA )
00500                         CALL ZGET02( TRANS, N, N, NRHS, ASAV, LDA, X,
00501      $                               LDA, WORK, LDA, RWORK( 2*NRHS+1 ),
00502      $                               RESULT( 2 ) )
00503 *
00504 *                       Check solution from generated exact solution.
00505 *
00506                         IF( NOFACT .OR. ( PREFAC .AND. LSAME( EQUED,
00507      $                      'N' ) ) ) THEN
00508                            CALL ZGET04( N, NRHS, X, LDA, XACT, LDA,
00509      $                                  RCONDC, RESULT( 3 ) )
00510                         ELSE
00511                            IF( ITRAN.EQ.1 ) THEN
00512                               ROLDC = ROLDO
00513                            ELSE
00514                               ROLDC = ROLDI
00515                            END IF
00516                            CALL ZGET04( N, NRHS, X, LDA, XACT, LDA,
00517      $                                  ROLDC, RESULT( 3 ) )
00518                         END IF
00519 *
00520 *                       Check the error bounds from iterative
00521 *                       refinement.
00522 *
00523                         CALL ZGET07( TRANS, N, NRHS, ASAV, LDA, B, LDA,
00524      $                               X, LDA, XACT, LDA, RWORK, .TRUE.,
00525      $                               RWORK( NRHS+1 ), RESULT( 4 ) )
00526                      ELSE
00527                         TRFCON = .TRUE.
00528                      END IF
00529 *
00530 *                    Compare RCOND from ZGESVX with the computed value
00531 *                    in RCONDC.
00532 *
00533                      RESULT( 6 ) = DGET06( RCOND, RCONDC )
00534 *
00535 *                    Print information about the tests that did not pass
00536 *                    the threshold.
00537 *
00538                      IF( .NOT.TRFCON ) THEN
00539                         DO 40 K = K1, NTESTS
00540                            IF( RESULT( K ).GE.THRESH ) THEN
00541                               IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00542      $                           CALL ALADHD( NOUT, PATH )
00543                               IF( PREFAC ) THEN
00544                                  WRITE( NOUT, FMT = 9997 )'ZGESVX',
00545      $                              FACT, TRANS, N, EQUED, IMAT, K,
00546      $                              RESULT( K )
00547                               ELSE
00548                                  WRITE( NOUT, FMT = 9998 )'ZGESVX',
00549      $                              FACT, TRANS, N, IMAT, K, RESULT( K )
00550                               END IF
00551                               NFAIL = NFAIL + 1
00552                            END IF
00553    40                   CONTINUE
00554                         NRUN = NRUN + 7 - K1
00555                      ELSE
00556                         IF( RESULT( 1 ).GE.THRESH .AND. .NOT.PREFAC )
00557      $                       THEN
00558                            IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00559      $                        CALL ALADHD( NOUT, PATH )
00560                            IF( PREFAC ) THEN
00561                               WRITE( NOUT, FMT = 9997 )'ZGESVX', FACT,
00562      $                           TRANS, N, EQUED, IMAT, 1, RESULT( 1 )
00563                            ELSE
00564                               WRITE( NOUT, FMT = 9998 )'ZGESVX', FACT,
00565      $                           TRANS, N, IMAT, 1, RESULT( 1 )
00566                            END IF
00567                            NFAIL = NFAIL + 1
00568                            NRUN = NRUN + 1
00569                         END IF
00570                         IF( RESULT( 6 ).GE.THRESH ) THEN
00571                            IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00572      $                        CALL ALADHD( NOUT, PATH )
00573                            IF( PREFAC ) THEN
00574                               WRITE( NOUT, FMT = 9997 )'ZGESVX', FACT,
00575      $                           TRANS, N, EQUED, IMAT, 6, RESULT( 6 )
00576                            ELSE
00577                               WRITE( NOUT, FMT = 9998 )'ZGESVX', FACT,
00578      $                           TRANS, N, IMAT, 6, RESULT( 6 )
00579                            END IF
00580                            NFAIL = NFAIL + 1
00581                            NRUN = NRUN + 1
00582                         END IF
00583                         IF( RESULT( 7 ).GE.THRESH ) THEN
00584                            IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00585      $                        CALL ALADHD( NOUT, PATH )
00586                            IF( PREFAC ) THEN
00587                               WRITE( NOUT, FMT = 9997 )'ZGESVX', FACT,
00588      $                           TRANS, N, EQUED, IMAT, 7, RESULT( 7 )
00589                            ELSE
00590                               WRITE( NOUT, FMT = 9998 )'ZGESVX', FACT,
00591      $                           TRANS, N, IMAT, 7, RESULT( 7 )
00592                            END IF
00593                            NFAIL = NFAIL + 1
00594                            NRUN = NRUN + 1
00595                         END IF
00596 *
00597                      END IF
00598 *
00599 *                    --- Test ZGESVXX ---
00600 *
00601 *                    Restore the matrices A and B.
00602 *
00603 
00604                      CALL ZLACPY( 'Full', N, N, ASAV, LDA, A, LDA )
00605                      CALL ZLACPY( 'Full', N, NRHS, BSAV, LDA, B, LDA )
00606 
00607                      IF( .NOT.PREFAC )
00608      $                  CALL ZLASET( 'Full', N, N, ZERO, ZERO, AFAC,
00609      $                               LDA )
00610                      CALL ZLASET( 'Full', N, NRHS, ZERO, ZERO, X, LDA )
00611                      IF( IEQUED.GT.1 .AND. N.GT.0 ) THEN
00612 *
00613 *                       Equilibrate the matrix if FACT = 'F' and
00614 *                       EQUED = 'R', 'C', or 'B'.
00615 *
00616                         CALL ZLAQGE( N, N, A, LDA, S, S( N+1 ), ROWCND,
00617      $                               COLCND, AMAX, EQUED )
00618                      END IF
00619 *
00620 *                    Solve the system and compute the condition number
00621 *                    and error bounds using ZGESVXX.
00622 *
00623                      SRNAMT = 'ZGESVXX'
00624                      N_ERR_BNDS = 3
00625                      CALL ZGESVXX( FACT, TRANS, N, NRHS, A, LDA, AFAC,
00626      $                    LDA, IWORK, EQUED, S, S( N+1 ), B, LDA, X,
00627      $                    LDA, RCOND, RPVGRW_SVXX, BERR, N_ERR_BNDS,
00628      $                    ERRBNDS_N, ERRBNDS_C, 0, ZERO, WORK,
00629      $                    RWORK, INFO )
00630 *
00631 *                    Check the error code from ZGESVXX.
00632 *
00633                      IF( INFO.EQ.N+1 ) GOTO 50
00634                      IF( INFO.NE.IZERO ) THEN
00635                         CALL ALAERH( PATH, 'ZGESVXX', INFO, IZERO,
00636      $                               FACT // TRANS, N, N, -1, -1, NRHS,
00637      $                               IMAT, NFAIL, NERRS, NOUT )
00638                         GOTO 50
00639                      END IF
00640 *
00641 *                    Compare rpvgrw_svxx from ZGESVXX with the computed
00642 *                    reciprocal pivot growth factor RPVGRW
00643 *
00644 
00645                      IF ( INFO .GT. 0 .AND. INFO .LT. N+1 ) THEN
00646                         RPVGRW = ZLA_RPVGRW(N, INFO, A, LDA, AFAC, LDA)
00647                      ELSE
00648                         RPVGRW = ZLA_RPVGRW(N, N, A, LDA, AFAC, LDA)
00649                      ENDIF
00650 
00651                      RESULT( 7 ) = ABS( RPVGRW-rpvgrw_svxx ) /
00652      $                             MAX( rpvgrw_svxx, RPVGRW ) /
00653      $                             DLAMCH( 'E' )
00654 *
00655                      IF( .NOT.PREFAC ) THEN
00656 *
00657 *                       Reconstruct matrix from factors and compute
00658 *                       residual.
00659 *
00660                         CALL ZGET01( N, N, A, LDA, AFAC, LDA, IWORK,
00661      $                               RWORK( 2*NRHS+1 ), RESULT( 1 ) )
00662                         K1 = 1
00663                      ELSE
00664                         K1 = 2
00665                      END IF
00666 *
00667                      IF( INFO.EQ.0 ) THEN
00668                         TRFCON = .FALSE.
00669 *
00670 *                       Compute residual of the computed solution.
00671 *
00672                         CALL ZLACPY( 'Full', N, NRHS, BSAV, LDA, WORK,
00673      $                               LDA )
00674                         CALL ZGET02( TRANS, N, N, NRHS, ASAV, LDA, X,
00675      $                               LDA, WORK, LDA, RWORK( 2*NRHS+1 ),
00676      $                               RESULT( 2 ) )
00677 *
00678 *                       Check solution from generated exact solution.
00679 *
00680                         IF( NOFACT .OR. ( PREFAC .AND. LSAME( EQUED,
00681      $                      'N' ) ) ) THEN
00682                            CALL ZGET04( N, NRHS, X, LDA, XACT, LDA,
00683      $                                  RCONDC, RESULT( 3 ) )
00684                         ELSE
00685                            IF( ITRAN.EQ.1 ) THEN
00686                               ROLDC = ROLDO
00687                            ELSE
00688                               ROLDC = ROLDI
00689                            END IF
00690                            CALL ZGET04( N, NRHS, X, LDA, XACT, LDA,
00691      $                                  ROLDC, RESULT( 3 ) )
00692                         END IF
00693                      ELSE
00694                         TRFCON = .TRUE.
00695                      END IF
00696 *
00697 *                    Compare RCOND from ZGESVXX with the computed value
00698 *                    in RCONDC.
00699 *
00700                      RESULT( 6 ) = DGET06( RCOND, RCONDC )
00701 *
00702 *                    Print information about the tests that did not pass
00703 *                    the threshold.
00704 *
00705                      IF( .NOT.TRFCON ) THEN
00706                         DO 45 K = K1, NTESTS
00707                            IF( RESULT( K ).GE.THRESH ) THEN
00708                               IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00709      $                           CALL ALADHD( NOUT, PATH )
00710                               IF( PREFAC ) THEN
00711                                  WRITE( NOUT, FMT = 9997 )'ZGESVXX',
00712      $                              FACT, TRANS, N, EQUED, IMAT, K,
00713      $                              RESULT( K )
00714                               ELSE
00715                                  WRITE( NOUT, FMT = 9998 )'ZGESVXX',
00716      $                              FACT, TRANS, N, IMAT, K, RESULT( K )
00717                               END IF
00718                               NFAIL = NFAIL + 1
00719                            END IF
00720  45                     CONTINUE
00721                         NRUN = NRUN + 7 - K1
00722                      ELSE
00723                         IF( RESULT( 1 ).GE.THRESH .AND. .NOT.PREFAC )
00724      $                       THEN
00725                            IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00726      $                        CALL ALADHD( NOUT, PATH )
00727                            IF( PREFAC ) THEN
00728                               WRITE( NOUT, FMT = 9997 )'ZGESVXX', FACT,
00729      $                           TRANS, N, EQUED, IMAT, 1, RESULT( 1 )
00730                            ELSE
00731                               WRITE( NOUT, FMT = 9998 )'ZGESVXX', FACT,
00732      $                           TRANS, N, IMAT, 1, RESULT( 1 )
00733                            END IF
00734                            NFAIL = NFAIL + 1
00735                            NRUN = NRUN + 1
00736                         END IF
00737                         IF( RESULT( 6 ).GE.THRESH ) THEN
00738                            IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00739      $                        CALL ALADHD( NOUT, PATH )
00740                            IF( PREFAC ) THEN
00741                               WRITE( NOUT, FMT = 9997 )'ZGESVXX', FACT,
00742      $                           TRANS, N, EQUED, IMAT, 6, RESULT( 6 )
00743                            ELSE
00744                               WRITE( NOUT, FMT = 9998 )'ZGESVXX', FACT,
00745      $                           TRANS, N, IMAT, 6, RESULT( 6 )
00746                            END IF
00747                            NFAIL = NFAIL + 1
00748                            NRUN = NRUN + 1
00749                         END IF
00750                         IF( RESULT( 7 ).GE.THRESH ) THEN
00751                            IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00752      $                        CALL ALADHD( NOUT, PATH )
00753                            IF( PREFAC ) THEN
00754                               WRITE( NOUT, FMT = 9997 )'ZGESVXX', FACT,
00755      $                           TRANS, N, EQUED, IMAT, 7, RESULT( 7 )
00756                            ELSE
00757                               WRITE( NOUT, FMT = 9998 )'ZGESVXX', FACT,
00758      $                           TRANS, N, IMAT, 7, RESULT( 7 )
00759                            END IF
00760                            NFAIL = NFAIL + 1
00761                            NRUN = NRUN + 1
00762                         END IF
00763 *
00764                      END IF
00765 *
00766    50             CONTINUE
00767    60          CONTINUE
00768    70       CONTINUE
00769    80    CONTINUE
00770    90 CONTINUE
00771 *
00772 *     Print a summary of the results.
00773 *
00774       CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS )
00775 *
00776 
00777 *     Test Error Bounds for ZGESVXX
00778 
00779       CALL ZEBCHVXX(THRESH, PATH)
00780 
00781  9999 FORMAT( 1X, A, ', N =', I5, ', type ', I2, ', test(', I2, ') =',
00782      $      G12.5 )
00783  9998 FORMAT( 1X, A, ', FACT=''', A1, ''', TRANS=''', A1, ''', N=', I5,
00784      $      ', type ', I2, ', test(', I1, ')=', G12.5 )
00785  9997 FORMAT( 1X, A, ', FACT=''', A1, ''', TRANS=''', A1, ''', N=', I5,
00786      $      ', EQUED=''', A1, ''', type ', I2, ', test(', I1, ')=',
00787      $      G12.5 )
00788       RETURN
00789 *
00790 *     End of ZDRVGE
00791 *
00792       END