|
LAPACK 3.3.0
|
|
LAPACK 3.3.0
|
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
1.7.3 
