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