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