/TESTING/EIG/ddrgvx.f
FORTRAN Legacy | 759 lines | 295 code | 0 blank | 464 comment | 0 complexity | a3dcbf9e4ddddb0f61b92521813c8bee MD5 | raw file
Possible License(s): BSD-3-Clause
- *> \brief \b DDRGVX
- *
- * =========== DOCUMENTATION ===========
- *
- * Online html documentation available at
- * http://www.netlib.org/lapack/explore-html/
- *
- * Definition:
- * ===========
- *
- * SUBROUTINE DDRGVX( NSIZE, THRESH, NIN, NOUT, A, LDA, B, AI, BI,
- * ALPHAR, ALPHAI, BETA, VL, VR, ILO, IHI, LSCALE,
- * RSCALE, S, DTRU, DIF, DIFTRU, WORK, LWORK,
- * IWORK, LIWORK, RESULT, BWORK, INFO )
- *
- * .. Scalar Arguments ..
- * INTEGER IHI, ILO, INFO, LDA, LIWORK, LWORK, NIN, NOUT,
- * $ NSIZE
- * DOUBLE PRECISION THRESH
- * ..
- * .. Array Arguments ..
- * LOGICAL BWORK( * )
- * INTEGER IWORK( * )
- * DOUBLE PRECISION A( LDA, * ), AI( LDA, * ), ALPHAI( * ),
- * $ ALPHAR( * ), B( LDA, * ), BETA( * ),
- * $ BI( LDA, * ), DIF( * ), DIFTRU( * ), DTRU( * ),
- * $ LSCALE( * ), RESULT( 4 ), RSCALE( * ), S( * ),
- * $ VL( LDA, * ), VR( LDA, * ), WORK( * )
- * ..
- *
- *
- *> \par Purpose:
- * =============
- *>
- *> \verbatim
- *>
- *> DDRGVX checks the nonsymmetric generalized eigenvalue problem
- *> expert driver DGGEVX.
- *>
- *> DGGEVX computes the generalized eigenvalues, (optionally) the left
- *> and/or right eigenvectors, (optionally) computes a balancing
- *> transformation to improve the conditioning, and (optionally)
- *> reciprocal condition numbers for the eigenvalues and eigenvectors.
- *>
- *> When DDRGVX is called with NSIZE > 0, two types of test matrix pairs
- *> are generated by the subroutine DLATM6 and test the driver DGGEVX.
- *> The test matrices have the known exact condition numbers for
- *> eigenvalues. For the condition numbers of the eigenvectors
- *> corresponding the first and last eigenvalues are also know
- *> ``exactly'' (see DLATM6).
- *>
- *> For each matrix pair, the following tests will be performed and
- *> compared with the threshold THRESH.
- *>
- *> (1) max over all left eigenvalue/-vector pairs (beta/alpha,l) of
- *>
- *> | l**H * (beta A - alpha B) | / ( ulp max( |beta A|, |alpha B| ) )
- *>
- *> where l**H is the conjugate tranpose of l.
- *>
- *> (2) max over all right eigenvalue/-vector pairs (beta/alpha,r) of
- *>
- *> | (beta A - alpha B) r | / ( ulp max( |beta A|, |alpha B| ) )
- *>
- *> (3) The condition number S(i) of eigenvalues computed by DGGEVX
- *> differs less than a factor THRESH from the exact S(i) (see
- *> DLATM6).
- *>
- *> (4) DIF(i) computed by DTGSNA differs less than a factor 10*THRESH
- *> from the exact value (for the 1st and 5th vectors only).
- *>
- *> Test Matrices
- *> =============
- *>
- *> Two kinds of test matrix pairs
- *>
- *> (A, B) = inverse(YH) * (Da, Db) * inverse(X)
- *>
- *> are used in the tests:
- *>
- *> 1: Da = 1+a 0 0 0 0 Db = 1 0 0 0 0
- *> 0 2+a 0 0 0 0 1 0 0 0
- *> 0 0 3+a 0 0 0 0 1 0 0
- *> 0 0 0 4+a 0 0 0 0 1 0
- *> 0 0 0 0 5+a , 0 0 0 0 1 , and
- *>
- *> 2: Da = 1 -1 0 0 0 Db = 1 0 0 0 0
- *> 1 1 0 0 0 0 1 0 0 0
- *> 0 0 1 0 0 0 0 1 0 0
- *> 0 0 0 1+a 1+b 0 0 0 1 0
- *> 0 0 0 -1-b 1+a , 0 0 0 0 1 .
- *>
- *> In both cases the same inverse(YH) and inverse(X) are used to compute
- *> (A, B), giving the exact eigenvectors to (A,B) as (YH, X):
- *>
- *> YH: = 1 0 -y y -y X = 1 0 -x -x x
- *> 0 1 -y y -y 0 1 x -x -x
- *> 0 0 1 0 0 0 0 1 0 0
- *> 0 0 0 1 0 0 0 0 1 0
- *> 0 0 0 0 1, 0 0 0 0 1 , where
- *>
- *> a, b, x and y will have all values independently of each other from
- *> { sqrt(sqrt(ULP)), 0.1, 1, 10, 1/sqrt(sqrt(ULP)) }.
- *> \endverbatim
- *
- * Arguments:
- * ==========
- *
- *> \param[in] NSIZE
- *> \verbatim
- *> NSIZE is INTEGER
- *> The number of sizes of matrices to use. NSIZE must be at
- *> least zero. If it is zero, no randomly generated matrices
- *> are tested, but any test matrices read from NIN will be
- *> tested.
- *> \endverbatim
- *>
- *> \param[in] THRESH
- *> \verbatim
- *> THRESH is DOUBLE PRECISION
- *> A test will count as "failed" if the "error", computed as
- *> described above, exceeds THRESH. Note that the error
- *> is scaled to be O(1), so THRESH should be a reasonably
- *> small multiple of 1, e.g., 10 or 100. In particular,
- *> it should not depend on the precision (single vs. double)
- *> or the size of the matrix. It must be at least zero.
- *> \endverbatim
- *>
- *> \param[in] NIN
- *> \verbatim
- *> NIN is INTEGER
- *> The FORTRAN unit number for reading in the data file of
- *> problems to solve.
- *> \endverbatim
- *>
- *> \param[in] NOUT
- *> \verbatim
- *> NOUT is INTEGER
- *> The FORTRAN unit number for printing out error messages
- *> (e.g., if a routine returns IINFO not equal to 0.)
- *> \endverbatim
- *>
- *> \param[out] A
- *> \verbatim
- *> A is DOUBLE PRECISION array, dimension (LDA, NSIZE)
- *> Used to hold the matrix whose eigenvalues are to be
- *> computed. On exit, A contains the last matrix actually used.
- *> \endverbatim
- *>
- *> \param[in] LDA
- *> \verbatim
- *> LDA is INTEGER
- *> The leading dimension of A, B, AI, BI, Ao, and Bo.
- *> It must be at least 1 and at least NSIZE.
- *> \endverbatim
- *>
- *> \param[out] B
- *> \verbatim
- *> B is DOUBLE PRECISION array, dimension (LDA, NSIZE)
- *> Used to hold the matrix whose eigenvalues are to be
- *> computed. On exit, B contains the last matrix actually used.
- *> \endverbatim
- *>
- *> \param[out] AI
- *> \verbatim
- *> AI is DOUBLE PRECISION array, dimension (LDA, NSIZE)
- *> Copy of A, modified by DGGEVX.
- *> \endverbatim
- *>
- *> \param[out] BI
- *> \verbatim
- *> BI is DOUBLE PRECISION array, dimension (LDA, NSIZE)
- *> Copy of B, modified by DGGEVX.
- *> \endverbatim
- *>
- *> \param[out] ALPHAR
- *> \verbatim
- *> ALPHAR is DOUBLE PRECISION array, dimension (NSIZE)
- *> \endverbatim
- *>
- *> \param[out] ALPHAI
- *> \verbatim
- *> ALPHAI is DOUBLE PRECISION array, dimension (NSIZE)
- *> \endverbatim
- *>
- *> \param[out] BETA
- *> \verbatim
- *> BETA is DOUBLE PRECISION array, dimension (NSIZE)
- *>
- *> On exit, (ALPHAR + ALPHAI*i)/BETA are the eigenvalues.
- *> \endverbatim
- *>
- *> \param[out] VL
- *> \verbatim
- *> VL is DOUBLE PRECISION array, dimension (LDA, NSIZE)
- *> VL holds the left eigenvectors computed by DGGEVX.
- *> \endverbatim
- *>
- *> \param[out] VR
- *> \verbatim
- *> VR is DOUBLE PRECISION array, dimension (LDA, NSIZE)
- *> VR holds the right eigenvectors computed by DGGEVX.
- *> \endverbatim
- *>
- *> \param[out] ILO
- *> \verbatim
- *> ILO is INTEGER
- *> \endverbatim
- *>
- *> \param[out] IHI
- *> \verbatim
- *> IHI is INTEGER
- *> \endverbatim
- *>
- *> \param[out] LSCALE
- *> \verbatim
- *> LSCALE is DOUBLE PRECISION array, dimension (N)
- *> \endverbatim
- *>
- *> \param[out] RSCALE
- *> \verbatim
- *> RSCALE is DOUBLE PRECISION array, dimension (N)
- *> \endverbatim
- *>
- *> \param[out] S
- *> \verbatim
- *> S is DOUBLE PRECISION array, dimension (N)
- *> \endverbatim
- *>
- *> \param[out] DTRU
- *> \verbatim
- *> DTRU is DOUBLE PRECISION array, dimension (N)
- *> \endverbatim
- *>
- *> \param[out] DIF
- *> \verbatim
- *> DIF is DOUBLE PRECISION array, dimension (N)
- *> \endverbatim
- *>
- *> \param[out] DIFTRU
- *> \verbatim
- *> DIFTRU is DOUBLE PRECISION array, dimension (N)
- *> \endverbatim
- *>
- *> \param[out] WORK
- *> \verbatim
- *> WORK is DOUBLE PRECISION array, dimension (LWORK)
- *> \endverbatim
- *>
- *> \param[in] LWORK
- *> \verbatim
- *> LWORK is INTEGER
- *> Leading dimension of WORK. LWORK >= 2*N*N+12*N+16.
- *> \endverbatim
- *>
- *> \param[out] IWORK
- *> \verbatim
- *> IWORK is INTEGER array, dimension (LIWORK)
- *> \endverbatim
- *>
- *> \param[in] LIWORK
- *> \verbatim
- *> LIWORK is INTEGER
- *> Leading dimension of IWORK. Must be at least N+6.
- *> \endverbatim
- *>
- *> \param[out] RESULT
- *> \verbatim
- *> RESULT is DOUBLE PRECISION array, dimension (4)
- *> \endverbatim
- *>
- *> \param[out] BWORK
- *> \verbatim
- *> BWORK is LOGICAL array, dimension (N)
- *> \endverbatim
- *>
- *> \param[out] INFO
- *> \verbatim
- *> INFO is INTEGER
- *> = 0: successful exit
- *> < 0: if INFO = -i, the i-th argument had an illegal value.
- *> > 0: A routine returned an error code.
- *> \endverbatim
- *
- * Authors:
- * ========
- *
- *> \author Univ. of Tennessee
- *> \author Univ. of California Berkeley
- *> \author Univ. of Colorado Denver
- *> \author NAG Ltd.
- *
- *> \ingroup double_eig
- *
- * =====================================================================
- SUBROUTINE DDRGVX( NSIZE, THRESH, NIN, NOUT, A, LDA, B, AI, BI,
- $ ALPHAR, ALPHAI, BETA, VL, VR, ILO, IHI, LSCALE,
- $ RSCALE, S, DTRU, DIF, DIFTRU, WORK, LWORK,
- $ IWORK, LIWORK, RESULT, BWORK, INFO )
- *
- * -- LAPACK test routine --
- * -- LAPACK is a software package provided by Univ. of Tennessee, --
- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
- *
- * .. Scalar Arguments ..
- INTEGER IHI, ILO, INFO, LDA, LIWORK, LWORK, NIN, NOUT,
- $ NSIZE
- DOUBLE PRECISION THRESH
- * ..
- * .. Array Arguments ..
- LOGICAL BWORK( * )
- INTEGER IWORK( * )
- DOUBLE PRECISION A( LDA, * ), AI( LDA, * ), ALPHAI( * ),
- $ ALPHAR( * ), B( LDA, * ), BETA( * ),
- $ BI( LDA, * ), DIF( * ), DIFTRU( * ), DTRU( * ),
- $ LSCALE( * ), RESULT( 4 ), RSCALE( * ), S( * ),
- $ VL( LDA, * ), VR( LDA, * ), WORK( * )
- * ..
- *
- * =====================================================================
- *
- * .. Parameters ..
- DOUBLE PRECISION ZERO, ONE, TEN, TNTH, HALF
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0, TEN = 1.0D+1,
- $ TNTH = 1.0D-1, HALF = 0.5D+0 )
- * ..
- * .. Local Scalars ..
- INTEGER I, IPTYPE, IWA, IWB, IWX, IWY, J, LINFO,
- $ MAXWRK, MINWRK, N, NERRS, NMAX, NPTKNT, NTESTT
- DOUBLE PRECISION ABNORM, ANORM, BNORM, RATIO1, RATIO2, THRSH2,
- $ ULP, ULPINV
- * ..
- * .. Local Arrays ..
- DOUBLE PRECISION WEIGHT( 5 )
- * ..
- * .. External Functions ..
- INTEGER ILAENV
- DOUBLE PRECISION DLAMCH, DLANGE
- EXTERNAL ILAENV, DLAMCH, DLANGE
- * ..
- * .. External Subroutines ..
- EXTERNAL ALASVM, DGET52, DGGEVX, DLACPY, DLATM6, XERBLA
- * ..
- * .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, SQRT
- * ..
- * .. Executable Statements ..
- *
- * Check for errors
- *
- INFO = 0
- *
- NMAX = 5
- *
- IF( NSIZE.LT.0 ) THEN
- INFO = -1
- ELSE IF( THRESH.LT.ZERO ) THEN
- INFO = -2
- ELSE IF( NIN.LE.0 ) THEN
- INFO = -3
- ELSE IF( NOUT.LE.0 ) THEN
- INFO = -4
- ELSE IF( LDA.LT.1 .OR. LDA.LT.NMAX ) THEN
- INFO = -6
- ELSE IF( LIWORK.LT.NMAX+6 ) THEN
- INFO = -26
- END IF
- *
- * Compute workspace
- * (Note: Comments in the code beginning "Workspace:" describe the
- * minimal amount of workspace needed at that point in the code,
- * as well as the preferred amount for good performance.
- * NB refers to the optimal block size for the immediately
- * following subroutine, as returned by ILAENV.)
- *
- MINWRK = 1
- IF( INFO.EQ.0 .AND. LWORK.GE.1 ) THEN
- MINWRK = 2*NMAX*NMAX + 12*NMAX + 16
- MAXWRK = 6*NMAX + NMAX*ILAENV( 1, 'DGEQRF', ' ', NMAX, 1, NMAX,
- $ 0 )
- MAXWRK = MAX( MAXWRK, 2*NMAX*NMAX+12*NMAX+16 )
- WORK( 1 ) = MAXWRK
- END IF
- *
- IF( LWORK.LT.MINWRK )
- $ INFO = -24
- *
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DDRGVX', -INFO )
- RETURN
- END IF
- *
- N = 5
- ULP = DLAMCH( 'P' )
- ULPINV = ONE / ULP
- THRSH2 = TEN*THRESH
- NERRS = 0
- NPTKNT = 0
- NTESTT = 0
- *
- IF( NSIZE.EQ.0 )
- $ GO TO 90
- *
- * Parameters used for generating test matrices.
- *
- WEIGHT( 1 ) = TNTH
- WEIGHT( 2 ) = HALF
- WEIGHT( 3 ) = ONE
- WEIGHT( 4 ) = ONE / WEIGHT( 2 )
- WEIGHT( 5 ) = ONE / WEIGHT( 1 )
- *
- DO 80 IPTYPE = 1, 2
- DO 70 IWA = 1, 5
- DO 60 IWB = 1, 5
- DO 50 IWX = 1, 5
- DO 40 IWY = 1, 5
- *
- * generated a test matrix pair
- *
- CALL DLATM6( IPTYPE, 5, A, LDA, B, VR, LDA, VL,
- $ LDA, WEIGHT( IWA ), WEIGHT( IWB ),
- $ WEIGHT( IWX ), WEIGHT( IWY ), DTRU,
- $ DIFTRU )
- *
- * Compute eigenvalues/eigenvectors of (A, B).
- * Compute eigenvalue/eigenvector condition numbers
- * using computed eigenvectors.
- *
- CALL DLACPY( 'F', N, N, A, LDA, AI, LDA )
- CALL DLACPY( 'F', N, N, B, LDA, BI, LDA )
- *
- CALL DGGEVX( 'N', 'V', 'V', 'B', N, AI, LDA, BI,
- $ LDA, ALPHAR, ALPHAI, BETA, VL, LDA,
- $ VR, LDA, ILO, IHI, LSCALE, RSCALE,
- $ ANORM, BNORM, S, DIF, WORK, LWORK,
- $ IWORK, BWORK, LINFO )
- IF( LINFO.NE.0 ) THEN
- RESULT( 1 ) = ULPINV
- WRITE( NOUT, FMT = 9999 )'DGGEVX', LINFO, N,
- $ IPTYPE
- GO TO 30
- END IF
- *
- * Compute the norm(A, B)
- *
- CALL DLACPY( 'Full', N, N, AI, LDA, WORK, N )
- CALL DLACPY( 'Full', N, N, BI, LDA, WORK( N*N+1 ),
- $ N )
- ABNORM = DLANGE( 'Fro', N, 2*N, WORK, N, WORK )
- *
- * Tests (1) and (2)
- *
- RESULT( 1 ) = ZERO
- CALL DGET52( .TRUE., N, A, LDA, B, LDA, VL, LDA,
- $ ALPHAR, ALPHAI, BETA, WORK,
- $ RESULT( 1 ) )
- IF( RESULT( 2 ).GT.THRESH ) THEN
- WRITE( NOUT, FMT = 9998 )'Left', 'DGGEVX',
- $ RESULT( 2 ), N, IPTYPE, IWA, IWB, IWX, IWY
- END IF
- *
- RESULT( 2 ) = ZERO
- CALL DGET52( .FALSE., N, A, LDA, B, LDA, VR, LDA,
- $ ALPHAR, ALPHAI, BETA, WORK,
- $ RESULT( 2 ) )
- IF( RESULT( 3 ).GT.THRESH ) THEN
- WRITE( NOUT, FMT = 9998 )'Right', 'DGGEVX',
- $ RESULT( 3 ), N, IPTYPE, IWA, IWB, IWX, IWY
- END IF
- *
- * Test (3)
- *
- RESULT( 3 ) = ZERO
- DO 10 I = 1, N
- IF( S( I ).EQ.ZERO ) THEN
- IF( DTRU( I ).GT.ABNORM*ULP )
- $ RESULT( 3 ) = ULPINV
- ELSE IF( DTRU( I ).EQ.ZERO ) THEN
- IF( S( I ).GT.ABNORM*ULP )
- $ RESULT( 3 ) = ULPINV
- ELSE
- WORK( I ) = MAX( ABS( DTRU( I ) / S( I ) ),
- $ ABS( S( I ) / DTRU( I ) ) )
- RESULT( 3 ) = MAX( RESULT( 3 ), WORK( I ) )
- END IF
- 10 CONTINUE
- *
- * Test (4)
- *
- RESULT( 4 ) = ZERO
- IF( DIF( 1 ).EQ.ZERO ) THEN
- IF( DIFTRU( 1 ).GT.ABNORM*ULP )
- $ RESULT( 4 ) = ULPINV
- ELSE IF( DIFTRU( 1 ).EQ.ZERO ) THEN
- IF( DIF( 1 ).GT.ABNORM*ULP )
- $ RESULT( 4 ) = ULPINV
- ELSE IF( DIF( 5 ).EQ.ZERO ) THEN
- IF( DIFTRU( 5 ).GT.ABNORM*ULP )
- $ RESULT( 4 ) = ULPINV
- ELSE IF( DIFTRU( 5 ).EQ.ZERO ) THEN
- IF( DIF( 5 ).GT.ABNORM*ULP )
- $ RESULT( 4 ) = ULPINV
- ELSE
- RATIO1 = MAX( ABS( DIFTRU( 1 ) / DIF( 1 ) ),
- $ ABS( DIF( 1 ) / DIFTRU( 1 ) ) )
- RATIO2 = MAX( ABS( DIFTRU( 5 ) / DIF( 5 ) ),
- $ ABS( DIF( 5 ) / DIFTRU( 5 ) ) )
- RESULT( 4 ) = MAX( RATIO1, RATIO2 )
- END IF
- *
- NTESTT = NTESTT + 4
- *
- * Print out tests which fail.
- *
- DO 20 J = 1, 4
- IF( ( RESULT( J ).GE.THRSH2 .AND. J.GE.4 ) .OR.
- $ ( RESULT( J ).GE.THRESH .AND. J.LE.3 ) )
- $ THEN
- *
- * If this is the first test to fail,
- * print a header to the data file.
- *
- IF( NERRS.EQ.0 ) THEN
- WRITE( NOUT, FMT = 9997 )'DXV'
- *
- * Print out messages for built-in examples
- *
- * Matrix types
- *
- WRITE( NOUT, FMT = 9995 )
- WRITE( NOUT, FMT = 9994 )
- WRITE( NOUT, FMT = 9993 )
- *
- * Tests performed
- *
- WRITE( NOUT, FMT = 9992 )'''',
- $ 'transpose', ''''
- *
- END IF
- NERRS = NERRS + 1
- IF( RESULT( J ).LT.10000.0D0 ) THEN
- WRITE( NOUT, FMT = 9991 )IPTYPE, IWA,
- $ IWB, IWX, IWY, J, RESULT( J )
- ELSE
- WRITE( NOUT, FMT = 9990 )IPTYPE, IWA,
- $ IWB, IWX, IWY, J, RESULT( J )
- END IF
- END IF
- 20 CONTINUE
- *
- 30 CONTINUE
- *
- 40 CONTINUE
- 50 CONTINUE
- 60 CONTINUE
- 70 CONTINUE
- 80 CONTINUE
- *
- GO TO 150
- *
- 90 CONTINUE
- *
- * Read in data from file to check accuracy of condition estimation
- * Read input data until N=0
- *
- READ( NIN, FMT = *, END = 150 )N
- IF( N.EQ.0 )
- $ GO TO 150
- DO 100 I = 1, N
- READ( NIN, FMT = * )( A( I, J ), J = 1, N )
- 100 CONTINUE
- DO 110 I = 1, N
- READ( NIN, FMT = * )( B( I, J ), J = 1, N )
- 110 CONTINUE
- READ( NIN, FMT = * )( DTRU( I ), I = 1, N )
- READ( NIN, FMT = * )( DIFTRU( I ), I = 1, N )
- *
- NPTKNT = NPTKNT + 1
- *
- * Compute eigenvalues/eigenvectors of (A, B).
- * Compute eigenvalue/eigenvector condition numbers
- * using computed eigenvectors.
- *
- CALL DLACPY( 'F', N, N, A, LDA, AI, LDA )
- CALL DLACPY( 'F', N, N, B, LDA, BI, LDA )
- *
- CALL DGGEVX( 'N', 'V', 'V', 'B', N, AI, LDA, BI, LDA, ALPHAR,
- $ ALPHAI, BETA, VL, LDA, VR, LDA, ILO, IHI, LSCALE,
- $ RSCALE, ANORM, BNORM, S, DIF, WORK, LWORK, IWORK,
- $ BWORK, LINFO )
- *
- IF( LINFO.NE.0 ) THEN
- RESULT( 1 ) = ULPINV
- WRITE( NOUT, FMT = 9987 )'DGGEVX', LINFO, N, NPTKNT
- GO TO 140
- END IF
- *
- * Compute the norm(A, B)
- *
- CALL DLACPY( 'Full', N, N, AI, LDA, WORK, N )
- CALL DLACPY( 'Full', N, N, BI, LDA, WORK( N*N+1 ), N )
- ABNORM = DLANGE( 'Fro', N, 2*N, WORK, N, WORK )
- *
- * Tests (1) and (2)
- *
- RESULT( 1 ) = ZERO
- CALL DGET52( .TRUE., N, A, LDA, B, LDA, VL, LDA, ALPHAR, ALPHAI,
- $ BETA, WORK, RESULT( 1 ) )
- IF( RESULT( 2 ).GT.THRESH ) THEN
- WRITE( NOUT, FMT = 9986 )'Left', 'DGGEVX', RESULT( 2 ), N,
- $ NPTKNT
- END IF
- *
- RESULT( 2 ) = ZERO
- CALL DGET52( .FALSE., N, A, LDA, B, LDA, VR, LDA, ALPHAR, ALPHAI,
- $ BETA, WORK, RESULT( 2 ) )
- IF( RESULT( 3 ).GT.THRESH ) THEN
- WRITE( NOUT, FMT = 9986 )'Right', 'DGGEVX', RESULT( 3 ), N,
- $ NPTKNT
- END IF
- *
- * Test (3)
- *
- RESULT( 3 ) = ZERO
- DO 120 I = 1, N
- IF( S( I ).EQ.ZERO ) THEN
- IF( DTRU( I ).GT.ABNORM*ULP )
- $ RESULT( 3 ) = ULPINV
- ELSE IF( DTRU( I ).EQ.ZERO ) THEN
- IF( S( I ).GT.ABNORM*ULP )
- $ RESULT( 3 ) = ULPINV
- ELSE
- WORK( I ) = MAX( ABS( DTRU( I ) / S( I ) ),
- $ ABS( S( I ) / DTRU( I ) ) )
- RESULT( 3 ) = MAX( RESULT( 3 ), WORK( I ) )
- END IF
- 120 CONTINUE
- *
- * Test (4)
- *
- RESULT( 4 ) = ZERO
- IF( DIF( 1 ).EQ.ZERO ) THEN
- IF( DIFTRU( 1 ).GT.ABNORM*ULP )
- $ RESULT( 4 ) = ULPINV
- ELSE IF( DIFTRU( 1 ).EQ.ZERO ) THEN
- IF( DIF( 1 ).GT.ABNORM*ULP )
- $ RESULT( 4 ) = ULPINV
- ELSE IF( DIF( 5 ).EQ.ZERO ) THEN
- IF( DIFTRU( 5 ).GT.ABNORM*ULP )
- $ RESULT( 4 ) = ULPINV
- ELSE IF( DIFTRU( 5 ).EQ.ZERO ) THEN
- IF( DIF( 5 ).GT.ABNORM*ULP )
- $ RESULT( 4 ) = ULPINV
- ELSE
- RATIO1 = MAX( ABS( DIFTRU( 1 ) / DIF( 1 ) ),
- $ ABS( DIF( 1 ) / DIFTRU( 1 ) ) )
- RATIO2 = MAX( ABS( DIFTRU( 5 ) / DIF( 5 ) ),
- $ ABS( DIF( 5 ) / DIFTRU( 5 ) ) )
- RESULT( 4 ) = MAX( RATIO1, RATIO2 )
- END IF
- *
- NTESTT = NTESTT + 4
- *
- * Print out tests which fail.
- *
- DO 130 J = 1, 4
- IF( RESULT( J ).GE.THRSH2 ) THEN
- *
- * If this is the first test to fail,
- * print a header to the data file.
- *
- IF( NERRS.EQ.0 ) THEN
- WRITE( NOUT, FMT = 9997 )'DXV'
- *
- * Print out messages for built-in examples
- *
- * Matrix types
- *
- WRITE( NOUT, FMT = 9996 )
- *
- * Tests performed
- *
- WRITE( NOUT, FMT = 9992 )'''', 'transpose', ''''
- *
- END IF
- NERRS = NERRS + 1
- IF( RESULT( J ).LT.10000.0D0 ) THEN
- WRITE( NOUT, FMT = 9989 )NPTKNT, N, J, RESULT( J )
- ELSE
- WRITE( NOUT, FMT = 9988 )NPTKNT, N, J, RESULT( J )
- END IF
- END IF
- 130 CONTINUE
- *
- 140 CONTINUE
- *
- GO TO 90
- 150 CONTINUE
- *
- * Summary
- *
- CALL ALASVM( 'DXV', NOUT, NERRS, NTESTT, 0 )
- *
- WORK( 1 ) = MAXWRK
- *
- RETURN
- *
- 9999 FORMAT( ' DDRGVX: ', A, ' returned INFO=', I6, '.', / 9X, 'N=',
- $ I6, ', JTYPE=', I6, ')' )
- *
- 9998 FORMAT( ' DDRGVX: ', A, ' Eigenvectors from ', A, ' incorrectly ',
- $ 'normalized.', / ' Bits of error=', 0P, G10.3, ',', 9X,
- $ 'N=', I6, ', JTYPE=', I6, ', IWA=', I5, ', IWB=', I5,
- $ ', IWX=', I5, ', IWY=', I5 )
- *
- 9997 FORMAT( / 1X, A3, ' -- Real Expert Eigenvalue/vector',
- $ ' problem driver' )
- *
- 9996 FORMAT( ' Input Example' )
- *
- 9995 FORMAT( ' Matrix types: ', / )
- *
- 9994 FORMAT( ' TYPE 1: Da is diagonal, Db is identity, ',
- $ / ' A = Y^(-H) Da X^(-1), B = Y^(-H) Db X^(-1) ',
- $ / ' YH and X are left and right eigenvectors. ', / )
- *
- 9993 FORMAT( ' TYPE 2: Da is quasi-diagonal, Db is identity, ',
- $ / ' A = Y^(-H) Da X^(-1), B = Y^(-H) Db X^(-1) ',
- $ / ' YH and X are left and right eigenvectors. ', / )
- *
- 9992 FORMAT( / ' Tests performed: ', / 4X,
- $ ' a is alpha, b is beta, l is a left eigenvector, ', / 4X,
- $ ' r is a right eigenvector and ', A, ' means ', A, '.',
- $ / ' 1 = max | ( b A - a B )', A, ' l | / const.',
- $ / ' 2 = max | ( b A - a B ) r | / const.',
- $ / ' 3 = max ( Sest/Stru, Stru/Sest ) ',
- $ ' over all eigenvalues', /
- $ ' 4 = max( DIFest/DIFtru, DIFtru/DIFest ) ',
- $ ' over the 1st and 5th eigenvectors', / )
- *
- 9991 FORMAT( ' Type=', I2, ',', ' IWA=', I2, ', IWB=', I2, ', IWX=',
- $ I2, ', IWY=', I2, ', result ', I2, ' is', 0P, F8.2 )
- 9990 FORMAT( ' Type=', I2, ',', ' IWA=', I2, ', IWB=', I2, ', IWX=',
- $ I2, ', IWY=', I2, ', result ', I2, ' is', 1P, D10.3 )
- 9989 FORMAT( ' Input example #', I2, ', matrix order=', I4, ',',
- $ ' result ', I2, ' is', 0P, F8.2 )
- 9988 FORMAT( ' Input example #', I2, ', matrix order=', I4, ',',
- $ ' result ', I2, ' is', 1P, D10.3 )
- 9987 FORMAT( ' DDRGVX: ', A, ' returned INFO=', I6, '.', / 9X, 'N=',
- $ I6, ', Input example #', I2, ')' )
- *
- 9986 FORMAT( ' DDRGVX: ', A, ' Eigenvectors from ', A, ' incorrectly ',
- $ 'normalized.', / ' Bits of error=', 0P, G10.3, ',', 9X,
- $ 'N=', I6, ', Input Example #', I2, ')' )
- *
- *
- * End of DDRGVX
- *
- END