lib
/
LAPACK-3.11.0
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
Cloned library LAPACK-3.11.0 with extra build files for internal package management.
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
3 Commits
1 Branch
0 Tags
5.8 MiB
Tag: Branch: Tree: main
Branches Tags
${ item.name }
Create tag ${ searchTerm }
Create branch ${ searchTerm }
from 'main'
${ noResults }
LAPACK-3.11.0/TESTING/EIG/ddrgvx.f

760 lines
25 KiB
Raw Permalink Normal View History Unescape

Initial commit
2 years ago
*> \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 transpose 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