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