LAPACK: TESTING/EIG/zdrgvx.f Source File

Go to the documentation of this file.
00001       SUBROUTINE ZDRGVX( NSIZE, THRESH, NIN, NOUT, A, LDA, B, AI, BI,
00002      $                   ALPHA, BETA, VL, VR, ILO, IHI, LSCALE, RSCALE,
00003      $                   S, DTRU, DIF, DIFTRU, WORK, LWORK, RWORK,
00004      $                   IWORK, LIWORK, RESULT, BWORK, INFO )
00005 *
00006 *  -- LAPACK test routine (version 3.1) --
00007 *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
00008 *     November 2006
00009 *
00010 *     .. Scalar Arguments ..
00011       INTEGER            IHI, ILO, INFO, LDA, LIWORK, LWORK, NIN, NOUT,
00012      $                   NSIZE
00013       DOUBLE PRECISION   THRESH
00014 *     ..
00015 *     .. Array Arguments ..
00016       LOGICAL            BWORK( * )
00017       INTEGER            IWORK( * )
00018       DOUBLE PRECISION   DIF( * ), DIFTRU( * ), DTRU( * ), LSCALE( * ),
00019      $                   RESULT( 4 ), RSCALE( * ), RWORK( * ), S( * )
00020       COMPLEX*16         A( LDA, * ), AI( LDA, * ), ALPHA( * ),
00021      $                   B( LDA, * ), BETA( * ), BI( LDA, * ),
00022      $                   VL( LDA, * ), VR( LDA, * ), WORK( * )
00023 *     ..
00024 *
00025 *  Purpose
00026 *  =======
00027 *
00028 *  ZDRGVX checks the nonsymmetric generalized eigenvalue problem
00029 *  expert driver ZGGEVX.
00030 *
00031 *  ZGGEVX computes the generalized eigenvalues, (optionally) the left
00032 *  and/or right eigenvectors, (optionally) computes a balancing
00033 *  transformation to improve the conditioning, and (optionally)
00034 *  reciprocal condition numbers for the eigenvalues and eigenvectors.
00035 *
00036 *  When ZDRGVX is called with NSIZE > 0, two types of test matrix pairs
00037 *  are generated by the subroutine DLATM6 and test the driver ZGGEVX.
00038 *  The test matrices have the known exact condition numbers for
00039 *  eigenvalues. For the condition numbers of the eigenvectors
00040 *  corresponding the first and last eigenvalues are also know
00041 *  ``exactly'' (see ZLATM6).
00042 *  For each matrix pair, the following tests will be performed and
00043 *  compared with the threshhold THRESH.
00044 *
00045 *  (1) max over all left eigenvalue/-vector pairs (beta/alpha,l) of
00046 *
00047 *     | l**H * (beta A - alpha B) | / ( ulp max( |beta A|, |alpha B| ) )
00048 *
00049 *      where l**H is the conjugate tranpose of l.
00050 *
00051 *  (2) max over all right eigenvalue/-vector pairs (beta/alpha,r) of
00052 *
00053 *        | (beta A - alpha B) r | / ( ulp max( |beta A|, |alpha B| ) )
00054 *
00055 *  (3) The condition number S(i) of eigenvalues computed by ZGGEVX
00056 *      differs less than a factor THRESH from the exact S(i) (see
00057 *      ZLATM6).
00058 *
00059 *  (4) DIF(i) computed by ZTGSNA differs less than a factor 10*THRESH
00060 *      from the exact value (for the 1st and 5th vectors only).
00061 *
00062 *  Test Matrices
00063 *  =============
00064 *
00065 *  Two kinds of test matrix pairs
00066 *           (A, B) = inverse(YH) * (Da, Db) * inverse(X)
00067 *  are used in the tests:
00068 *
00069 *  1: Da = 1+a   0    0    0    0    Db = 1   0   0   0   0
00070 *           0   2+a   0    0    0         0   1   0   0   0
00071 *           0    0   3+a   0    0         0   0   1   0   0
00072 *           0    0    0   4+a   0         0   0   0   1   0
00073 *           0    0    0    0   5+a ,      0   0   0   0   1 , and
00074 *
00075 *  2: Da =  1   -1    0    0    0    Db = 1   0   0   0   0
00076 *           1    1    0    0    0         0   1   0   0   0
00077 *           0    0    1    0    0         0   0   1   0   0
00078 *           0    0    0   1+a  1+b        0   0   0   1   0
00079 *           0    0    0  -1-b  1+a ,      0   0   0   0   1 .
00080 *
00081 *  In both cases the same inverse(YH) and inverse(X) are used to compute
00082 *  (A, B), giving the exact eigenvectors to (A,B) as (YH, X):
00083 *
00084 *  YH:  =  1    0   -y    y   -y    X =  1   0  -x  -x   x
00085 *          0    1   -y    y   -y         0   1   x  -x  -x
00086 *          0    0    1    0    0         0   0   1   0   0
00087 *          0    0    0    1    0         0   0   0   1   0
00088 *          0    0    0    0    1,        0   0   0   0   1 , where
00089 *
00090 *  a, b, x and y will have all values independently of each other from
00091 *  { sqrt(sqrt(ULP)),  0.1,  1,  10,  1/sqrt(sqrt(ULP)) }.
00092 *
00093 *  Arguments
00094 *  =========
00095 *
00096 *  NSIZE   (input) INTEGER
00097 *          The number of sizes of matrices to use.  NSIZE must be at
00098 *          least zero. If it is zero, no randomly generated matrices
00099 *          are tested, but any test matrices read from NIN will be
00100 *          tested.  If it is not zero, then N = 5.
00101 *
00102 *  THRESH  (input) DOUBLE PRECISION
00103 *          A test will count as "failed" if the "error", computed as
00104 *          described above, exceeds THRESH.  Note that the error
00105 *          is scaled to be O(1), so THRESH should be a reasonably
00106 *          small multiple of 1, e.g., 10 or 100.  In particular,
00107 *          it should not depend on the precision (single vs. double)
00108 *          or the size of the matrix.  It must be at least zero.
00109 *
00110 *  NIN     (input) INTEGER
00111 *          The FORTRAN unit number for reading in the data file of
00112 *          problems to solve.
00113 *
00114 *  NOUT    (input) INTEGER
00115 *          The FORTRAN unit number for printing out error messages
00116 *          (e.g., if a routine returns IINFO not equal to 0.)
00117 *
00118 *  A       (workspace) COMPLEX*16 array, dimension (LDA, NSIZE)
00119 *          Used to hold the matrix whose eigenvalues are to be
00120 *          computed.  On exit, A contains the last matrix actually used.
00121 *
00122 *  LDA     (input) INTEGER
00123 *          The leading dimension of A, B, AI, BI, Ao, and Bo.
00124 *          It must be at least 1 and at least NSIZE.
00125 *
00126 *  B       (workspace) COMPLEX*16 array, dimension (LDA, NSIZE)
00127 *          Used to hold the matrix whose eigenvalues are to be
00128 *          computed.  On exit, B contains the last matrix actually used.
00129 *
00130 *  AI      (workspace) COMPLEX*16 array, dimension (LDA, NSIZE)
00131 *          Copy of A, modified by ZGGEVX.
00132 *
00133 *  BI      (workspace) COMPLEX*16 array, dimension (LDA, NSIZE)
00134 *          Copy of B, modified by ZGGEVX.
00135 *
00136 *  ALPHA   (workspace) COMPLEX*16 array, dimension (NSIZE)
00137 *  BETA    (workspace) COMPLEX*16 array, dimension (NSIZE)
00138 *          On exit, ALPHA/BETA are the eigenvalues.
00139 *
00140 *  VL      (workspace) COMPLEX*16 array, dimension (LDA, NSIZE)
00141 *          VL holds the left eigenvectors computed by ZGGEVX.
00142 *
00143 *  VR      (workspace) COMPLEX*16 array, dimension (LDA, NSIZE)
00144 *          VR holds the right eigenvectors computed by ZGGEVX.
00145 *
00146 *  ILO     (output/workspace) INTEGER
00147 *
00148 *  IHI     (output/workspace) INTEGER
00149 *
00150 *  LSCALE  (output/workspace) DOUBLE PRECISION array, dimension (N)
00151 *
00152 *  RSCALE  (output/workspace) DOUBLE PRECISION array, dimension (N)
00153 *
00154 *  S       (output/workspace) DOUBLE PRECISION array, dimension (N)
00155 *
00156 *  DTRU    (output/workspace) DOUBLE PRECISION array, dimension (N)
00157 *
00158 *  DIF     (output/workspace) DOUBLE PRECISION array, dimension (N)
00159 *
00160 *  DIFTRU  (output/workspace) DOUBLE PRECISION array, dimension (N)
00161 *
00162 *  WORK    (workspace) COMPLEX*16 array, dimension (LWORK)
00163 *
00164 *  LWORK   (input) INTEGER
00165 *          Leading dimension of WORK.  LWORK >= 2*N*N + 2*N
00166 *
00167 *  RWORK   (workspace) DOUBLE PRECISION array, dimension (6*N)
00168 *
00169 *  IWORK   (workspace) INTEGER array, dimension (LIWORK)
00170 *
00171 *  LIWORK  (input) INTEGER
00172 *          Leading dimension of IWORK.  LIWORK >= N+2.
00173 *
00174 *  RESULT  (output/workspace) DOUBLE PRECISION array, dimension (4)
00175 *
00176 *  BWORK   (workspace) LOGICAL array, dimension (N)
00177 *
00178 *  INFO    (output) INTEGER
00179 *          = 0:  successful exit
00180 *          < 0:  if INFO = -i, the i-th argument had an illegal value.
00181 *          > 0:  A routine returned an error code.
00182 *
00183 *  =====================================================================
00184 *
00185 *     .. Parameters ..
00186       DOUBLE PRECISION   ZERO, ONE, TEN, TNTH
00187       PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0, TEN = 1.0D+1,
00188      $                   TNTH = 1.0D-1 )
00189 *     ..
00190 *     .. Local Scalars ..
00191       INTEGER            I, IPTYPE, IWA, IWB, IWX, IWY, J, LINFO,
00192      $                   MAXWRK, MINWRK, N, NERRS, NMAX, NPTKNT, NTESTT
00193       DOUBLE PRECISION   ABNORM, ANORM, BNORM, RATIO1, RATIO2, THRSH2,
00194      $                   ULP, ULPINV
00195 *     ..
00196 *     .. Local Arrays ..
00197       COMPLEX*16         WEIGHT( 5 )
00198 *     ..
00199 *     .. External Functions ..
00200       INTEGER            ILAENV
00201       DOUBLE PRECISION   DLAMCH, ZLANGE
00202       EXTERNAL           ILAENV, DLAMCH, ZLANGE
00203 *     ..
00204 *     .. External Subroutines ..
00205       EXTERNAL           ALASVM, XERBLA, ZGET52, ZGGEVX, ZLACPY, ZLATM6
00206 *     ..
00207 *     .. Intrinsic Functions ..
00208       INTRINSIC          ABS, DCMPLX, MAX, SQRT
00209 *     ..
00210 *     .. Executable Statements ..
00211 *
00212 *     Check for errors
00213 *
00214       INFO = 0
00215 *
00216       NMAX = 5
00217 *
00218       IF( NSIZE.LT.0 ) THEN
00219          INFO = -1
00220       ELSE IF( THRESH.LT.ZERO ) THEN
00221          INFO = -2
00222       ELSE IF( NIN.LE.0 ) THEN
00223          INFO = -3
00224       ELSE IF( NOUT.LE.0 ) THEN
00225          INFO = -4
00226       ELSE IF( LDA.LT.1 .OR. LDA.LT.NMAX ) THEN
00227          INFO = -6
00228       ELSE IF( LIWORK.LT.NMAX+2 ) THEN
00229          INFO = -26
00230       END IF
00231 *
00232 *     Compute workspace
00233 *      (Note: Comments in the code beginning "Workspace:" describe the
00234 *       minimal amount of workspace needed at that point in the code,
00235 *       as well as the preferred amount for good performance.
00236 *       NB refers to the optimal block size for the immediately
00237 *       following subroutine, as returned by ILAENV.)
00238 *
00239       MINWRK = 1
00240       IF( INFO.EQ.0 .AND. LWORK.GE.1 ) THEN
00241          MINWRK = 2*NMAX*( NMAX+1 )
00242          MAXWRK = NMAX*( 1+ILAENV( 1, 'ZGEQRF', ' ', NMAX, 1, NMAX,
00243      $            0 ) )
00244          MAXWRK = MAX( MAXWRK, 2*NMAX*( NMAX+1 ) )
00245          WORK( 1 ) = MAXWRK
00246       END IF
00247 *
00248       IF( LWORK.LT.MINWRK )
00249      $   INFO = -23
00250 *
00251       IF( INFO.NE.0 ) THEN
00252          CALL XERBLA( 'ZDRGVX', -INFO )
00253          RETURN
00254       END IF
00255 *
00256       N = 5
00257       ULP = DLAMCH( 'P' )
00258       ULPINV = ONE / ULP
00259       THRSH2 = TEN*THRESH
00260       NERRS = 0
00261       NPTKNT = 0
00262       NTESTT = 0
00263 *
00264       IF( NSIZE.EQ.0 )
00265      $   GO TO 90
00266 *
00267 *     Parameters used for generating test matrices.
00268 *
00269       WEIGHT( 1 ) = DCMPLX( SQRT( SQRT( ULP ) ), ZERO )
00270       WEIGHT( 2 ) = DCMPLX( TNTH, ZERO )
00271       WEIGHT( 3 ) = ONE
00272       WEIGHT( 4 ) = ONE / WEIGHT( 2 )
00273       WEIGHT( 5 ) = ONE / WEIGHT( 1 )
00274 *
00275       DO 80 IPTYPE = 1, 2
00276          DO 70 IWA = 1, 5
00277             DO 60 IWB = 1, 5
00278                DO 50 IWX = 1, 5
00279                   DO 40 IWY = 1, 5
00280 *
00281 *                    generated a pair of test matrix
00282 *
00283                      CALL ZLATM6( IPTYPE, 5, A, LDA, B, VR, LDA, VL,
00284      $                            LDA, WEIGHT( IWA ), WEIGHT( IWB ),
00285      $                            WEIGHT( IWX ), WEIGHT( IWY ), DTRU,
00286      $                            DIFTRU )
00287 *
00288 *                    Compute eigenvalues/eigenvectors of (A, B).
00289 *                    Compute eigenvalue/eigenvector condition numbers
00290 *                    using computed eigenvectors.
00291 *
00292                      CALL ZLACPY( 'F', N, N, A, LDA, AI, LDA )
00293                      CALL ZLACPY( 'F', N, N, B, LDA, BI, LDA )
00294 *
00295                      CALL ZGGEVX( 'N', 'V', 'V', 'B', N, AI, LDA, BI,
00296      $                            LDA, ALPHA, BETA, VL, LDA, VR, LDA,
00297      $                            ILO, IHI, LSCALE, RSCALE, ANORM,
00298      $                            BNORM, S, DIF, WORK, LWORK, RWORK,
00299      $                            IWORK, BWORK, LINFO )
00300                      IF( LINFO.NE.0 ) THEN
00301                         WRITE( NOUT, FMT = 9999 )'ZGGEVX', LINFO, N,
00302      $                     IPTYPE, IWA, IWB, IWX, IWY
00303                         GO TO 30
00304                      END IF
00305 *
00306 *                    Compute the norm(A, B)
00307 *
00308                      CALL ZLACPY( 'Full', N, N, AI, LDA, WORK, N )
00309                      CALL ZLACPY( 'Full', N, N, BI, LDA, WORK( N*N+1 ),
00310      $                            N )
00311                      ABNORM = ZLANGE( 'Fro', N, 2*N, WORK, N, RWORK )
00312 *
00313 *                    Tests (1) and (2)
00314 *
00315                      RESULT( 1 ) = ZERO
00316                      CALL ZGET52( .TRUE., N, A, LDA, B, LDA, VL, LDA,
00317      $                            ALPHA, BETA, WORK, RWORK,
00318      $                            RESULT( 1 ) )
00319                      IF( RESULT( 2 ).GT.THRESH ) THEN
00320                         WRITE( NOUT, FMT = 9998 )'Left', 'ZGGEVX',
00321      $                     RESULT( 2 ), N, IPTYPE, IWA, IWB, IWX, IWY
00322                      END IF
00323 *
00324                      RESULT( 2 ) = ZERO
00325                      CALL ZGET52( .FALSE., N, A, LDA, B, LDA, VR, LDA,
00326      $                            ALPHA, BETA, WORK, RWORK,
00327      $                            RESULT( 2 ) )
00328                      IF( RESULT( 3 ).GT.THRESH ) THEN
00329                         WRITE( NOUT, FMT = 9998 )'Right', 'ZGGEVX',
00330      $                     RESULT( 3 ), N, IPTYPE, IWA, IWB, IWX, IWY
00331                      END IF
00332 *
00333 *                    Test (3)
00334 *
00335                      RESULT( 3 ) = ZERO
00336                      DO 10 I = 1, N
00337                         IF( S( I ).EQ.ZERO ) THEN
00338                            IF( DTRU( I ).GT.ABNORM*ULP )
00339      $                        RESULT( 3 ) = ULPINV
00340                         ELSE IF( DTRU( I ).EQ.ZERO ) THEN
00341                            IF( S( I ).GT.ABNORM*ULP )
00342      $                        RESULT( 3 ) = ULPINV
00343                         ELSE
00344                            RWORK( I ) = MAX( ABS( DTRU( I ) / S( I ) ),
00345      $                                  ABS( S( I ) / DTRU( I ) ) )
00346                            RESULT( 3 ) = MAX( RESULT( 3 ), RWORK( I ) )
00347                         END IF
00348    10                CONTINUE
00349 *
00350 *                    Test (4)
00351 *
00352                      RESULT( 4 ) = ZERO
00353                      IF( DIF( 1 ).EQ.ZERO ) THEN
00354                         IF( DIFTRU( 1 ).GT.ABNORM*ULP )
00355      $                     RESULT( 4 ) = ULPINV
00356                      ELSE IF( DIFTRU( 1 ).EQ.ZERO ) THEN
00357                         IF( DIF( 1 ).GT.ABNORM*ULP )
00358      $                     RESULT( 4 ) = ULPINV
00359                      ELSE IF( DIF( 5 ).EQ.ZERO ) THEN
00360                         IF( DIFTRU( 5 ).GT.ABNORM*ULP )
00361      $                     RESULT( 4 ) = ULPINV
00362                      ELSE IF( DIFTRU( 5 ).EQ.ZERO ) THEN
00363                         IF( DIF( 5 ).GT.ABNORM*ULP )
00364      $                     RESULT( 4 ) = ULPINV
00365                      ELSE
00366                         RATIO1 = MAX( ABS( DIFTRU( 1 ) / DIF( 1 ) ),
00367      $                           ABS( DIF( 1 ) / DIFTRU( 1 ) ) )
00368                         RATIO2 = MAX( ABS( DIFTRU( 5 ) / DIF( 5 ) ),
00369      $                           ABS( DIF( 5 ) / DIFTRU( 5 ) ) )
00370                         RESULT( 4 ) = MAX( RATIO1, RATIO2 )
00371                      END IF
00372 *
00373                      NTESTT = NTESTT + 4
00374 *
00375 *                    Print out tests which fail.
00376 *
00377                      DO 20 J = 1, 4
00378                         IF( ( RESULT( J ).GE.THRSH2 .AND. J.GE.4 ) .OR.
00379      $                      ( RESULT( J ).GE.THRESH .AND. J.LE.3 ) )
00380      $                       THEN
00381 *
00382 *                       If this is the first test to fail,
00383 *                       print a header to the data file.
00384 *
00385                            IF( NERRS.EQ.0 ) THEN
00386                               WRITE( NOUT, FMT = 9997 )'ZXV'
00387 *
00388 *                          Print out messages for built-in examples
00389 *
00390 *                          Matrix types
00391 *
00392                               WRITE( NOUT, FMT = 9995 )
00393                               WRITE( NOUT, FMT = 9994 )
00394                               WRITE( NOUT, FMT = 9993 )
00395 *
00396 *                          Tests performed
00397 *
00398                               WRITE( NOUT, FMT = 9992 )'''',
00399      $                           'transpose', ''''
00400 *
00401                            END IF
00402                            NERRS = NERRS + 1
00403                            IF( RESULT( J ).LT.10000.0D0 ) THEN
00404                               WRITE( NOUT, FMT = 9991 )IPTYPE, IWA,
00405      $                           IWB, IWX, IWY, J, RESULT( J )
00406                            ELSE
00407                               WRITE( NOUT, FMT = 9990 )IPTYPE, IWA,
00408      $                           IWB, IWX, IWY, J, RESULT( J )
00409                            END IF
00410                         END IF
00411    20                CONTINUE
00412 *
00413    30                CONTINUE
00414 *
00415    40             CONTINUE
00416    50          CONTINUE
00417    60       CONTINUE
00418    70    CONTINUE
00419    80 CONTINUE
00420 *
00421       GO TO 150
00422 *
00423    90 CONTINUE
00424 *
00425 *     Read in data from file to check accuracy of condition estimation
00426 *     Read input data until N=0
00427 *
00428       READ( NIN, FMT = *, END = 150 )N
00429       IF( N.EQ.0 )
00430      $   GO TO 150
00431       DO 100 I = 1, N
00432          READ( NIN, FMT = * )( A( I, J ), J = 1, N )
00433   100 CONTINUE
00434       DO 110 I = 1, N
00435          READ( NIN, FMT = * )( B( I, J ), J = 1, N )
00436   110 CONTINUE
00437       READ( NIN, FMT = * )( DTRU( I ), I = 1, N )
00438       READ( NIN, FMT = * )( DIFTRU( I ), I = 1, N )
00439 *
00440       NPTKNT = NPTKNT + 1
00441 *
00442 *     Compute eigenvalues/eigenvectors of (A, B).
00443 *     Compute eigenvalue/eigenvector condition numbers
00444 *     using computed eigenvectors.
00445 *
00446       CALL ZLACPY( 'F', N, N, A, LDA, AI, LDA )
00447       CALL ZLACPY( 'F', N, N, B, LDA, BI, LDA )
00448 *
00449       CALL ZGGEVX( 'N', 'V', 'V', 'B', N, AI, LDA, BI, LDA, ALPHA, BETA,
00450      $             VL, LDA, VR, LDA, ILO, IHI, LSCALE, RSCALE, ANORM,
00451      $             BNORM, S, DIF, WORK, LWORK, RWORK, IWORK, BWORK,
00452      $             LINFO )
00453 *
00454       IF( LINFO.NE.0 ) THEN
00455          WRITE( NOUT, FMT = 9987 )'ZGGEVX', LINFO, N, NPTKNT
00456          GO TO 140
00457       END IF
00458 *
00459 *     Compute the norm(A, B)
00460 *
00461       CALL ZLACPY( 'Full', N, N, AI, LDA, WORK, N )
00462       CALL ZLACPY( 'Full', N, N, BI, LDA, WORK( N*N+1 ), N )
00463       ABNORM = ZLANGE( 'Fro', N, 2*N, WORK, N, RWORK )
00464 *
00465 *     Tests (1) and (2)
00466 *
00467       RESULT( 1 ) = ZERO
00468       CALL ZGET52( .TRUE., N, A, LDA, B, LDA, VL, LDA, ALPHA, BETA,
00469      $             WORK, RWORK, RESULT( 1 ) )
00470       IF( RESULT( 2 ).GT.THRESH ) THEN
00471          WRITE( NOUT, FMT = 9986 )'Left', 'ZGGEVX', RESULT( 2 ), N,
00472      $      NPTKNT
00473       END IF
00474 *
00475       RESULT( 2 ) = ZERO
00476       CALL ZGET52( .FALSE., N, A, LDA, B, LDA, VR, LDA, ALPHA, BETA,
00477      $             WORK, RWORK, RESULT( 2 ) )
00478       IF( RESULT( 3 ).GT.THRESH ) THEN
00479          WRITE( NOUT, FMT = 9986 )'Right', 'ZGGEVX', RESULT( 3 ), N,
00480      $      NPTKNT
00481       END IF
00482 *
00483 *     Test (3)
00484 *
00485       RESULT( 3 ) = ZERO
00486       DO 120 I = 1, N
00487          IF( S( I ).EQ.ZERO ) THEN
00488             IF( DTRU( I ).GT.ABNORM*ULP )
00489      $         RESULT( 3 ) = ULPINV
00490          ELSE IF( DTRU( I ).EQ.ZERO ) THEN
00491             IF( S( I ).GT.ABNORM*ULP )
00492      $         RESULT( 3 ) = ULPINV
00493          ELSE
00494             RWORK( I ) = MAX( ABS( DTRU( I ) / S( I ) ),
00495      $                   ABS( S( I ) / DTRU( I ) ) )
00496             RESULT( 3 ) = MAX( RESULT( 3 ), RWORK( I ) )
00497          END IF
00498   120 CONTINUE
00499 *
00500 *     Test (4)
00501 *
00502       RESULT( 4 ) = ZERO
00503       IF( DIF( 1 ).EQ.ZERO ) THEN
00504          IF( DIFTRU( 1 ).GT.ABNORM*ULP )
00505      $      RESULT( 4 ) = ULPINV
00506       ELSE IF( DIFTRU( 1 ).EQ.ZERO ) THEN
00507          IF( DIF( 1 ).GT.ABNORM*ULP )
00508      $      RESULT( 4 ) = ULPINV
00509       ELSE IF( DIF( 5 ).EQ.ZERO ) THEN
00510          IF( DIFTRU( 5 ).GT.ABNORM*ULP )
00511      $      RESULT( 4 ) = ULPINV
00512       ELSE IF( DIFTRU( 5 ).EQ.ZERO ) THEN
00513          IF( DIF( 5 ).GT.ABNORM*ULP )
00514      $      RESULT( 4 ) = ULPINV
00515       ELSE
00516          RATIO1 = MAX( ABS( DIFTRU( 1 ) / DIF( 1 ) ),
00517      $            ABS( DIF( 1 ) / DIFTRU( 1 ) ) )
00518          RATIO2 = MAX( ABS( DIFTRU( 5 ) / DIF( 5 ) ),
00519      $            ABS( DIF( 5 ) / DIFTRU( 5 ) ) )
00520          RESULT( 4 ) = MAX( RATIO1, RATIO2 )
00521       END IF
00522 *
00523       NTESTT = NTESTT + 4
00524 *
00525 *     Print out tests which fail.
00526 *
00527       DO 130 J = 1, 4
00528          IF( RESULT( J ).GE.THRSH2 ) THEN
00529 *
00530 *           If this is the first test to fail,
00531 *           print a header to the data file.
00532 *
00533             IF( NERRS.EQ.0 ) THEN
00534                WRITE( NOUT, FMT = 9997 )'ZXV'
00535 *
00536 *              Print out messages for built-in examples
00537 *
00538 *              Matrix types
00539 *
00540                WRITE( NOUT, FMT = 9996 )
00541 *
00542 *              Tests performed
00543 *
00544                WRITE( NOUT, FMT = 9992 )'''', 'transpose', ''''
00545 *
00546             END IF
00547             NERRS = NERRS + 1
00548             IF( RESULT( J ).LT.10000.0D0 ) THEN
00549                WRITE( NOUT, FMT = 9989 )NPTKNT, N, J, RESULT( J )
00550             ELSE
00551                WRITE( NOUT, FMT = 9988 )NPTKNT, N, J, RESULT( J )
00552             END IF
00553          END IF
00554   130 CONTINUE
00555 *
00556   140 CONTINUE
00557 *
00558       GO TO 90
00559   150 CONTINUE
00560 *
00561 *     Summary
00562 *
00563       CALL ALASVM( 'ZXV', NOUT, NERRS, NTESTT, 0 )
00564 *
00565       WORK( 1 ) = MAXWRK
00566 *
00567       RETURN
00568 *
00569  9999 FORMAT( ' ZDRGVX: ', A, ' returned INFO=', I6, '.', / 9X, 'N=',
00570      $      I6, ', JTYPE=', I6, ')' )
00571 *
00572  9998 FORMAT( ' ZDRGVX: ', A, ' Eigenvectors from ', A, ' incorrectly ',
00573      $      'normalized.', / ' Bits of error=', 0P, G10.3, ',', 9X,
00574      $      'N=', I6, ', JTYPE=', I6, ', IWA=', I5, ', IWB=', I5,
00575      $      ', IWX=', I5, ', IWY=', I5 )
00576 *
00577  9997 FORMAT( / 1X, A3, ' -- Complex Expert Eigenvalue/vector',
00578      $      ' problem driver' )
00579 *
00580  9996 FORMAT( 'Input Example' )
00581 *
00582  9995 FORMAT( ' Matrix types: ', / )
00583 *
00584  9994 FORMAT( ' TYPE 1: Da is diagonal, Db is identity, ',
00585      $      / '     A = Y^(-H) Da X^(-1), B = Y^(-H) Db X^(-1) ',
00586      $      / '     YH and X are left and right eigenvectors. ', / )
00587 *
00588  9993 FORMAT( ' TYPE 2: Da is quasi-diagonal, Db is identity, ',
00589      $      / '     A = Y^(-H) Da X^(-1), B = Y^(-H) Db X^(-1) ',
00590      $      / '     YH and X are left and right eigenvectors. ', / )
00591 *
00592  9992 FORMAT( / ' Tests performed:  ', / 4X,
00593      $      ' a is alpha, b is beta, l is a left eigenvector, ', / 4X,
00594      $      ' r is a right eigenvector and ', A, ' means ', A, '.',
00595      $      / ' 1 = max | ( b A - a B )', A, ' l | / const.',
00596      $      / ' 2 = max | ( b A - a B ) r | / const.',
00597      $      / ' 3 = max ( Sest/Stru, Stru/Sest ) ',
00598      $      ' over all eigenvalues', /
00599      $      ' 4 = max( DIFest/DIFtru, DIFtru/DIFest ) ',
00600      $      ' over the 1st and 5th eigenvectors', / )
00601 *
00602  9991 FORMAT( ' Type=', I2, ',', ' IWA=', I2, ', IWB=', I2, ', IWX=',
00603      $      I2, ', IWY=', I2, ', result ', I2, ' is', 0P, F8.2 )
00604 *
00605  9990 FORMAT( ' Type=', I2, ',', ' IWA=', I2, ', IWB=', I2, ', IWX=',
00606      $      I2, ', IWY=', I2, ', result ', I2, ' is', 1P, D10.3 )
00607 *
00608  9989 FORMAT( ' Input example #', I2, ', matrix order=', I4, ',',
00609      $      ' result ', I2, ' is', 0P, F8.2 )
00610 *
00611  9988 FORMAT( ' Input example #', I2, ', matrix order=', I4, ',',
00612      $      ' result ', I2, ' is', 1P, D10.3 )
00613 *
00614  9987 FORMAT( ' ZDRGVX: ', A, ' returned INFO=', I6, '.', / 9X, 'N=',
00615      $      I6, ', Input example #', I2, ')' )
00616 *
00617  9986 FORMAT( ' ZDRGVX: ', A, ' Eigenvectors from ', A, ' incorrectly ',
00618      $      'normalized.', / ' Bits of error=', 0P, G10.3, ',', 9X,
00619      $      'N=', I6, ', Input Example #', I2, ')' )
00620 *
00621 *     End of ZDRGVX
00622 *
00623       END