LAPACK: TESTING/EIG/sdrgvx.f Source File

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