LAPACK: TESTING/EIG/cdrgvx.f Source File

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