 |
LAPACK 3.3.1
Linear Algebra PACKage
|
|
LAPACK 3.3.1
Linear Algebra PACKage
|
00001 SUBROUTINE ZDRVEV( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, 00002 $ NOUNIT, A, LDA, H, W, W1, VL, LDVL, VR, LDVR, 00003 $ LRE, LDLRE, RESULT, WORK, NWORK, RWORK, IWORK, 00004 $ 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 INFO, LDA, LDLRE, LDVL, LDVR, NOUNIT, NSIZES, 00012 $ NTYPES, NWORK 00013 DOUBLE PRECISION THRESH 00014 * .. 00015 * .. Array Arguments .. 00016 LOGICAL DOTYPE( * ) 00017 INTEGER ISEED( 4 ), IWORK( * ), NN( * ) 00018 DOUBLE PRECISION RESULT( 7 ), RWORK( * ) 00019 COMPLEX*16 A( LDA, * ), H( LDA, * ), LRE( LDLRE, * ), 00020 $ VL( LDVL, * ), VR( LDVR, * ), W( * ), W1( * ), 00021 $ WORK( * ) 00022 * .. 00023 * 00024 * Purpose 00025 * ======= 00026 * 00027 * ZDRVEV checks the nonsymmetric eigenvalue problem driver ZGEEV. 00028 * 00029 * When ZDRVEV is called, a number of matrix "sizes" ("n's") and a 00030 * number of matrix "types" are specified. For each size ("n") 00031 * and each type of matrix, one matrix will be generated and used 00032 * to test the nonsymmetric eigenroutines. For each matrix, 7 00033 * tests will be performed: 00034 * 00035 * (1) | A * VR - VR * W | / ( n |A| ulp ) 00036 * 00037 * Here VR is the matrix of unit right eigenvectors. 00038 * W is a diagonal matrix with diagonal entries W(j). 00039 * 00040 * (2) | A**H * VL - VL * W**H | / ( n |A| ulp ) 00041 * 00042 * Here VL is the matrix of unit left eigenvectors, A**H is the 00043 * conjugate-transpose of A, and W is as above. 00044 * 00045 * (3) | |VR(i)| - 1 | / ulp and whether largest component real 00046 * 00047 * VR(i) denotes the i-th column of VR. 00048 * 00049 * (4) | |VL(i)| - 1 | / ulp and whether largest component real 00050 * 00051 * VL(i) denotes the i-th column of VL. 00052 * 00053 * (5) W(full) = W(partial) 00054 * 00055 * W(full) denotes the eigenvalues computed when both VR and VL 00056 * are also computed, and W(partial) denotes the eigenvalues 00057 * computed when only W, only W and VR, or only W and VL are 00058 * computed. 00059 * 00060 * (6) VR(full) = VR(partial) 00061 * 00062 * VR(full) denotes the right eigenvectors computed when both VR 00063 * and VL are computed, and VR(partial) denotes the result 00064 * when only VR is computed. 00065 * 00066 * (7) VL(full) = VL(partial) 00067 * 00068 * VL(full) denotes the left eigenvectors computed when both VR 00069 * and VL are also computed, and VL(partial) denotes the result 00070 * when only VL is computed. 00071 * 00072 * The "sizes" are specified by an array NN(1:NSIZES); the value of 00073 * each element NN(j) specifies one size. 00074 * The "types" are specified by a logical array DOTYPE( 1:NTYPES ); 00075 * if DOTYPE(j) is .TRUE., then matrix type "j" will be generated. 00076 * Currently, the list of possible types is: 00077 * 00078 * (1) The zero matrix. 00079 * (2) The identity matrix. 00080 * (3) A (transposed) Jordan block, with 1's on the diagonal. 00081 * 00082 * (4) A diagonal matrix with evenly spaced entries 00083 * 1, ..., ULP and random complex angles. 00084 * (ULP = (first number larger than 1) - 1 ) 00085 * (5) A diagonal matrix with geometrically spaced entries 00086 * 1, ..., ULP and random complex angles. 00087 * (6) A diagonal matrix with "clustered" entries 1, ULP, ..., ULP 00088 * and random complex angles. 00089 * 00090 * (7) Same as (4), but multiplied by a constant near 00091 * the overflow threshold 00092 * (8) Same as (4), but multiplied by a constant near 00093 * the underflow threshold 00094 * 00095 * (9) A matrix of the form U' T U, where U is unitary and 00096 * T has evenly spaced entries 1, ..., ULP with random complex 00097 * angles on the diagonal and random O(1) entries in the upper 00098 * triangle. 00099 * 00100 * (10) A matrix of the form U' T U, where U is unitary and 00101 * T has geometrically spaced entries 1, ..., ULP with random 00102 * complex angles on the diagonal and random O(1) entries in 00103 * the upper triangle. 00104 * 00105 * (11) A matrix of the form U' T U, where U is unitary and 00106 * T has "clustered" entries 1, ULP,..., ULP with random 00107 * complex angles on the diagonal and random O(1) entries in 00108 * the upper triangle. 00109 * 00110 * (12) A matrix of the form U' T U, where U is unitary and 00111 * T has complex eigenvalues randomly chosen from 00112 * ULP < |z| < 1 and random O(1) entries in the upper 00113 * triangle. 00114 * 00115 * (13) A matrix of the form X' T X, where X has condition 00116 * SQRT( ULP ) and T has evenly spaced entries 1, ..., ULP 00117 * with random complex angles on the diagonal and random O(1) 00118 * entries in the upper triangle. 00119 * 00120 * (14) A matrix of the form X' T X, where X has condition 00121 * SQRT( ULP ) and T has geometrically spaced entries 00122 * 1, ..., ULP with random complex angles on the diagonal 00123 * and random O(1) entries in the upper triangle. 00124 * 00125 * (15) A matrix of the form X' T X, where X has condition 00126 * SQRT( ULP ) and T has "clustered" entries 1, ULP,..., ULP 00127 * with random complex angles on the diagonal and random O(1) 00128 * entries in the upper triangle. 00129 * 00130 * (16) A matrix of the form X' T X, where X has condition 00131 * SQRT( ULP ) and T has complex eigenvalues randomly chosen 00132 * from ULP < |z| < 1 and random O(1) entries in the upper 00133 * triangle. 00134 * 00135 * (17) Same as (16), but multiplied by a constant 00136 * near the overflow threshold 00137 * (18) Same as (16), but multiplied by a constant 00138 * near the underflow threshold 00139 * 00140 * (19) Nonsymmetric matrix with random entries chosen from |z| < 1 00141 * If N is at least 4, all entries in first two rows and last 00142 * row, and first column and last two columns are zero. 00143 * (20) Same as (19), but multiplied by a constant 00144 * near the overflow threshold 00145 * (21) Same as (19), but multiplied by a constant 00146 * near the underflow threshold 00147 * 00148 * Arguments 00149 * ========== 00150 * 00151 * NSIZES (input) INTEGER 00152 * The number of sizes of matrices to use. If it is zero, 00153 * ZDRVEV does nothing. It must be at least zero. 00154 * 00155 * NN (input) INTEGER array, dimension (NSIZES) 00156 * An array containing the sizes to be used for the matrices. 00157 * Zero values will be skipped. The values must be at least 00158 * zero. 00159 * 00160 * NTYPES (input) INTEGER 00161 * The number of elements in DOTYPE. If it is zero, ZDRVEV 00162 * does nothing. It must be at least zero. If it is MAXTYP+1 00163 * and NSIZES is 1, then an additional type, MAXTYP+1 is 00164 * defined, which is to use whatever matrix is in A. This 00165 * is only useful if DOTYPE(1:MAXTYP) is .FALSE. and 00166 * DOTYPE(MAXTYP+1) is .TRUE. . 00167 * 00168 * DOTYPE (input) LOGICAL array, dimension (NTYPES) 00169 * If DOTYPE(j) is .TRUE., then for each size in NN a 00170 * matrix of that size and of type j will be generated. 00171 * If NTYPES is smaller than the maximum number of types 00172 * defined (PARAMETER MAXTYP), then types NTYPES+1 through 00173 * MAXTYP will not be generated. If NTYPES is larger 00174 * than MAXTYP, DOTYPE(MAXTYP+1) through DOTYPE(NTYPES) 00175 * will be ignored. 00176 * 00177 * ISEED (input/output) INTEGER array, dimension (4) 00178 * On entry ISEED specifies the seed of the random number 00179 * generator. The array elements should be between 0 and 4095; 00180 * if not they will be reduced mod 4096. Also, ISEED(4) must 00181 * be odd. The random number generator uses a linear 00182 * congruential sequence limited to small integers, and so 00183 * should produce machine independent random numbers. The 00184 * values of ISEED are changed on exit, and can be used in the 00185 * next call to ZDRVEV to continue the same random number 00186 * sequence. 00187 * 00188 * THRESH (input) DOUBLE PRECISION 00189 * A test will count as "failed" if the "error", computed as 00190 * described above, exceeds THRESH. Note that the error 00191 * is scaled to be O(1), so THRESH should be a reasonably 00192 * small multiple of 1, e.g., 10 or 100. In particular, 00193 * it should not depend on the precision (single vs. double) 00194 * or the size of the matrix. It must be at least zero. 00195 * 00196 * NOUNIT (input) INTEGER 00197 * The FORTRAN unit number for printing out error messages 00198 * (e.g., if a routine returns INFO not equal to 0.) 00199 * 00200 * A (workspace) COMPLEX*16 array, dimension (LDA, max(NN)) 00201 * Used to hold the matrix whose eigenvalues are to be 00202 * computed. On exit, A contains the last matrix actually used. 00203 * 00204 * LDA (input) INTEGER 00205 * The leading dimension of A, and H. LDA must be at 00206 * least 1 and at least max(NN). 00207 * 00208 * H (workspace) COMPLEX*16 array, dimension (LDA, max(NN)) 00209 * Another copy of the test matrix A, modified by ZGEEV. 00210 * 00211 * W (workspace) COMPLEX*16 array, dimension (max(NN)) 00212 * The eigenvalues of A. On exit, W are the eigenvalues of 00213 * the matrix in A. 00214 * 00215 * W1 (workspace) COMPLEX*16 array, dimension (max(NN)) 00216 * Like W, this array contains the eigenvalues of A, 00217 * but those computed when ZGEEV only computes a partial 00218 * eigendecomposition, i.e. not the eigenvalues and left 00219 * and right eigenvectors. 00220 * 00221 * VL (workspace) COMPLEX*16 array, dimension (LDVL, max(NN)) 00222 * VL holds the computed left eigenvectors. 00223 * 00224 * LDVL (input) INTEGER 00225 * Leading dimension of VL. Must be at least max(1,max(NN)). 00226 * 00227 * VR (workspace) COMPLEX*16 array, dimension (LDVR, max(NN)) 00228 * VR holds the computed right eigenvectors. 00229 * 00230 * LDVR (input) INTEGER 00231 * Leading dimension of VR. Must be at least max(1,max(NN)). 00232 * 00233 * LRE (workspace) COMPLEX*16 array, dimension (LDLRE, max(NN)) 00234 * LRE holds the computed right or left eigenvectors. 00235 * 00236 * LDLRE (input) INTEGER 00237 * Leading dimension of LRE. Must be at least max(1,max(NN)). 00238 * 00239 * RESULT (output) DOUBLE PRECISION array, dimension (7) 00240 * The values computed by the seven tests described above. 00241 * The values are currently limited to 1/ulp, to avoid 00242 * overflow. 00243 * 00244 * WORK (workspace) COMPLEX*16 array, dimension (NWORK) 00245 * 00246 * NWORK (input) INTEGER 00247 * The number of entries in WORK. This must be at least 00248 * 5*NN(j)+2*NN(j)**2 for all j. 00249 * 00250 * RWORK (workspace) DOUBLE PRECISION array, dimension (2*max(NN)) 00251 * 00252 * IWORK (workspace) INTEGER array, dimension (max(NN)) 00253 * 00254 * INFO (output) INTEGER 00255 * If 0, then everything ran OK. 00256 * -1: NSIZES < 0 00257 * -2: Some NN(j) < 0 00258 * -3: NTYPES < 0 00259 * -6: THRESH < 0 00260 * -9: LDA < 1 or LDA < NMAX, where NMAX is max( NN(j) ). 00261 * -14: LDVL < 1 or LDVL < NMAX, where NMAX is max( NN(j) ). 00262 * -16: LDVR < 1 or LDVR < NMAX, where NMAX is max( NN(j) ). 00263 * -18: LDLRE < 1 or LDLRE < NMAX, where NMAX is max( NN(j) ). 00264 * -21: NWORK too small. 00265 * If ZLATMR, CLATMS, CLATME or ZGEEV returns an error code, 00266 * the absolute value of it is returned. 00267 * 00268 *----------------------------------------------------------------------- 00269 * 00270 * Some Local Variables and Parameters: 00271 * ---- ----- --------- --- ---------- 00272 * 00273 * ZERO, ONE Real 0 and 1. 00274 * MAXTYP The number of types defined. 00275 * NMAX Largest value in NN. 00276 * NERRS The number of tests which have exceeded THRESH 00277 * COND, CONDS, 00278 * IMODE Values to be passed to the matrix generators. 00279 * ANORM Norm of A; passed to matrix generators. 00280 * 00281 * OVFL, UNFL Overflow and underflow thresholds. 00282 * ULP, ULPINV Finest relative precision and its inverse. 00283 * RTULP, RTULPI Square roots of the previous 4 values. 00284 * 00285 * The following four arrays decode JTYPE: 00286 * KTYPE(j) The general type (1-10) for type "j". 00287 * KMODE(j) The MODE value to be passed to the matrix 00288 * generator for type "j". 00289 * KMAGN(j) The order of magnitude ( O(1), 00290 * O(overflow^(1/2) ), O(underflow^(1/2) ) 00291 * KCONDS(j) Selectw whether CONDS is to be 1 or 00292 * 1/sqrt(ulp). (0 means irrelevant.) 00293 * 00294 * ===================================================================== 00295 * 00296 * .. Parameters .. 00297 COMPLEX*16 CZERO 00298 PARAMETER ( CZERO = ( 0.0D+0, 0.0D+0 ) ) 00299 COMPLEX*16 CONE 00300 PARAMETER ( CONE = ( 1.0D+0, 0.0D+0 ) ) 00301 DOUBLE PRECISION ZERO, ONE 00302 PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 ) 00303 DOUBLE PRECISION TWO 00304 PARAMETER ( TWO = 2.0D+0 ) 00305 INTEGER MAXTYP 00306 PARAMETER ( MAXTYP = 21 ) 00307 * .. 00308 * .. Local Scalars .. 00309 LOGICAL BADNN 00310 CHARACTER*3 PATH 00311 INTEGER IINFO, IMODE, ITYPE, IWK, J, JCOL, JJ, JSIZE, 00312 $ JTYPE, MTYPES, N, NERRS, NFAIL, NMAX, NNWORK, 00313 $ NTEST, NTESTF, NTESTT 00314 DOUBLE PRECISION ANORM, COND, CONDS, OVFL, RTULP, RTULPI, TNRM, 00315 $ ULP, ULPINV, UNFL, VMX, VRMX, VTST 00316 * .. 00317 * .. Local Arrays .. 00318 INTEGER IDUMMA( 1 ), IOLDSD( 4 ), KCONDS( MAXTYP ), 00319 $ KMAGN( MAXTYP ), KMODE( MAXTYP ), 00320 $ KTYPE( MAXTYP ) 00321 DOUBLE PRECISION RES( 2 ) 00322 COMPLEX*16 DUM( 1 ) 00323 * .. 00324 * .. External Functions .. 00325 DOUBLE PRECISION DLAMCH, DZNRM2 00326 EXTERNAL DLAMCH, DZNRM2 00327 * .. 00328 * .. External Subroutines .. 00329 EXTERNAL DLABAD, DLASUM, XERBLA, ZGEEV, ZGET22, ZLACPY, 00330 $ ZLASET, ZLATME, ZLATMR, ZLATMS 00331 * .. 00332 * .. Intrinsic Functions .. 00333 INTRINSIC ABS, DBLE, DCMPLX, DIMAG, MAX, MIN, SQRT 00334 * .. 00335 * .. Data statements .. 00336 DATA KTYPE / 1, 2, 3, 5*4, 4*6, 6*6, 3*9 / 00337 DATA KMAGN / 3*1, 1, 1, 1, 2, 3, 4*1, 1, 1, 1, 1, 2, 00338 $ 3, 1, 2, 3 / 00339 DATA KMODE / 3*0, 4, 3, 1, 4, 4, 4, 3, 1, 5, 4, 3, 00340 $ 1, 5, 5, 5, 4, 3, 1 / 00341 DATA KCONDS / 3*0, 5*0, 4*1, 6*2, 3*0 / 00342 * .. 00343 * .. Executable Statements .. 00344 * 00345 PATH( 1: 1 ) = 'Zomplex precision' 00346 PATH( 2: 3 ) = 'EV' 00347 * 00348 * Check for errors 00349 * 00350 NTESTT = 0 00351 NTESTF = 0 00352 INFO = 0 00353 * 00354 * Important constants 00355 * 00356 BADNN = .FALSE. 00357 NMAX = 0 00358 DO 10 J = 1, NSIZES 00359 NMAX = MAX( NMAX, NN( J ) ) 00360 IF( NN( J ).LT.0 ) 00361 $ BADNN = .TRUE. 00362 10 CONTINUE 00363 * 00364 * Check for errors 00365 * 00366 IF( NSIZES.LT.0 ) THEN 00367 INFO = -1 00368 ELSE IF( BADNN ) THEN 00369 INFO = -2 00370 ELSE IF( NTYPES.LT.0 ) THEN 00371 INFO = -3 00372 ELSE IF( THRESH.LT.ZERO ) THEN 00373 INFO = -6 00374 ELSE IF( NOUNIT.LE.0 ) THEN 00375 INFO = -7 00376 ELSE IF( LDA.LT.1 .OR. LDA.LT.NMAX ) THEN 00377 INFO = -9 00378 ELSE IF( LDVL.LT.1 .OR. LDVL.LT.NMAX ) THEN 00379 INFO = -14 00380 ELSE IF( LDVR.LT.1 .OR. LDVR.LT.NMAX ) THEN 00381 INFO = -16 00382 ELSE IF( LDLRE.LT.1 .OR. LDLRE.LT.NMAX ) THEN 00383 INFO = -28 00384 ELSE IF( 5*NMAX+2*NMAX**2.GT.NWORK ) THEN 00385 INFO = -21 00386 END IF 00387 * 00388 IF( INFO.NE.0 ) THEN 00389 CALL XERBLA( 'ZDRVEV', -INFO ) 00390 RETURN 00391 END IF 00392 * 00393 * Quick return if nothing to do 00394 * 00395 IF( NSIZES.EQ.0 .OR. NTYPES.EQ.0 ) 00396 $ RETURN 00397 * 00398 * More Important constants 00399 * 00400 UNFL = DLAMCH( 'Safe minimum' ) 00401 OVFL = ONE / UNFL 00402 CALL DLABAD( UNFL, OVFL ) 00403 ULP = DLAMCH( 'Precision' ) 00404 ULPINV = ONE / ULP 00405 RTULP = SQRT( ULP ) 00406 RTULPI = ONE / RTULP 00407 * 00408 * Loop over sizes, types 00409 * 00410 NERRS = 0 00411 * 00412 DO 270 JSIZE = 1, NSIZES 00413 N = NN( JSIZE ) 00414 IF( NSIZES.NE.1 ) THEN 00415 MTYPES = MIN( MAXTYP, NTYPES ) 00416 ELSE 00417 MTYPES = MIN( MAXTYP+1, NTYPES ) 00418 END IF 00419 * 00420 DO 260 JTYPE = 1, MTYPES 00421 IF( .NOT.DOTYPE( JTYPE ) ) 00422 $ GO TO 260 00423 * 00424 * Save ISEED in case of an error. 00425 * 00426 DO 20 J = 1, 4 00427 IOLDSD( J ) = ISEED( J ) 00428 20 CONTINUE 00429 * 00430 * Compute "A" 00431 * 00432 * Control parameters: 00433 * 00434 * KMAGN KCONDS KMODE KTYPE 00435 * =1 O(1) 1 clustered 1 zero 00436 * =2 large large clustered 2 identity 00437 * =3 small exponential Jordan 00438 * =4 arithmetic diagonal, (w/ eigenvalues) 00439 * =5 random log symmetric, w/ eigenvalues 00440 * =6 random general, w/ eigenvalues 00441 * =7 random diagonal 00442 * =8 random symmetric 00443 * =9 random general 00444 * =10 random triangular 00445 * 00446 IF( MTYPES.GT.MAXTYP ) 00447 $ GO TO 90 00448 * 00449 ITYPE = KTYPE( JTYPE ) 00450 IMODE = KMODE( JTYPE ) 00451 * 00452 * Compute norm 00453 * 00454 GO TO ( 30, 40, 50 )KMAGN( JTYPE ) 00455 * 00456 30 CONTINUE 00457 ANORM = ONE 00458 GO TO 60 00459 * 00460 40 CONTINUE 00461 ANORM = OVFL*ULP 00462 GO TO 60 00463 * 00464 50 CONTINUE 00465 ANORM = UNFL*ULPINV 00466 GO TO 60 00467 * 00468 60 CONTINUE 00469 * 00470 CALL ZLASET( 'Full', LDA, N, CZERO, CZERO, A, LDA ) 00471 IINFO = 0 00472 COND = ULPINV 00473 * 00474 * Special Matrices -- Identity & Jordan block 00475 * 00476 * Zero 00477 * 00478 IF( ITYPE.EQ.1 ) THEN 00479 IINFO = 0 00480 * 00481 ELSE IF( ITYPE.EQ.2 ) THEN 00482 * 00483 * Identity 00484 * 00485 DO 70 JCOL = 1, N 00486 A( JCOL, JCOL ) = DCMPLX( ANORM ) 00487 70 CONTINUE 00488 * 00489 ELSE IF( ITYPE.EQ.3 ) THEN 00490 * 00491 * Jordan Block 00492 * 00493 DO 80 JCOL = 1, N 00494 A( JCOL, JCOL ) = DCMPLX( ANORM ) 00495 IF( JCOL.GT.1 ) 00496 $ A( JCOL, JCOL-1 ) = CONE 00497 80 CONTINUE 00498 * 00499 ELSE IF( ITYPE.EQ.4 ) THEN 00500 * 00501 * Diagonal Matrix, [Eigen]values Specified 00502 * 00503 CALL ZLATMS( N, N, 'S', ISEED, 'H', RWORK, IMODE, COND, 00504 $ ANORM, 0, 0, 'N', A, LDA, WORK( N+1 ), 00505 $ IINFO ) 00506 * 00507 ELSE IF( ITYPE.EQ.5 ) THEN 00508 * 00509 * Hermitian, eigenvalues specified 00510 * 00511 CALL ZLATMS( N, N, 'S', ISEED, 'H', RWORK, IMODE, COND, 00512 $ ANORM, N, N, 'N', A, LDA, WORK( N+1 ), 00513 $ IINFO ) 00514 * 00515 ELSE IF( ITYPE.EQ.6 ) THEN 00516 * 00517 * General, eigenvalues specified 00518 * 00519 IF( KCONDS( JTYPE ).EQ.1 ) THEN 00520 CONDS = ONE 00521 ELSE IF( KCONDS( JTYPE ).EQ.2 ) THEN 00522 CONDS = RTULPI 00523 ELSE 00524 CONDS = ZERO 00525 END IF 00526 * 00527 CALL ZLATME( N, 'D', ISEED, WORK, IMODE, COND, CONE, ' ', 00528 $ 'T', 'T', 'T', RWORK, 4, CONDS, N, N, ANORM, 00529 $ A, LDA, WORK( 2*N+1 ), IINFO ) 00530 * 00531 ELSE IF( ITYPE.EQ.7 ) THEN 00532 * 00533 * Diagonal, random eigenvalues 00534 * 00535 CALL ZLATMR( N, N, 'D', ISEED, 'N', WORK, 6, ONE, CONE, 00536 $ 'T', 'N', WORK( N+1 ), 1, ONE, 00537 $ WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, 0, 0, 00538 $ ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO ) 00539 * 00540 ELSE IF( ITYPE.EQ.8 ) THEN 00541 * 00542 * Symmetric, random eigenvalues 00543 * 00544 CALL ZLATMR( N, N, 'D', ISEED, 'H', WORK, 6, ONE, CONE, 00545 $ 'T', 'N', WORK( N+1 ), 1, ONE, 00546 $ WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, N, N, 00547 $ ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO ) 00548 * 00549 ELSE IF( ITYPE.EQ.9 ) THEN 00550 * 00551 * General, random eigenvalues 00552 * 00553 CALL ZLATMR( N, N, 'D', ISEED, 'N', WORK, 6, ONE, CONE, 00554 $ 'T', 'N', WORK( N+1 ), 1, ONE, 00555 $ WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, N, N, 00556 $ ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO ) 00557 IF( N.GE.4 ) THEN 00558 CALL ZLASET( 'Full', 2, N, CZERO, CZERO, A, LDA ) 00559 CALL ZLASET( 'Full', N-3, 1, CZERO, CZERO, A( 3, 1 ), 00560 $ LDA ) 00561 CALL ZLASET( 'Full', N-3, 2, CZERO, CZERO, 00562 $ A( 3, N-1 ), LDA ) 00563 CALL ZLASET( 'Full', 1, N, CZERO, CZERO, A( N, 1 ), 00564 $ LDA ) 00565 END IF 00566 * 00567 ELSE IF( ITYPE.EQ.10 ) THEN 00568 * 00569 * Triangular, random eigenvalues 00570 * 00571 CALL ZLATMR( N, N, 'D', ISEED, 'N', WORK, 6, ONE, CONE, 00572 $ 'T', 'N', WORK( N+1 ), 1, ONE, 00573 $ WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, N, 0, 00574 $ ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO ) 00575 * 00576 ELSE 00577 * 00578 IINFO = 1 00579 END IF 00580 * 00581 IF( IINFO.NE.0 ) THEN 00582 WRITE( NOUNIT, FMT = 9993 )'Generator', IINFO, N, JTYPE, 00583 $ IOLDSD 00584 INFO = ABS( IINFO ) 00585 RETURN 00586 END IF 00587 * 00588 90 CONTINUE 00589 * 00590 * Test for minimal and generous workspace 00591 * 00592 DO 250 IWK = 1, 2 00593 IF( IWK.EQ.1 ) THEN 00594 NNWORK = 2*N 00595 ELSE 00596 NNWORK = 5*N + 2*N**2 00597 END IF 00598 NNWORK = MAX( NNWORK, 1 ) 00599 * 00600 * Initialize RESULT 00601 * 00602 DO 100 J = 1, 7 00603 RESULT( J ) = -ONE 00604 100 CONTINUE 00605 * 00606 * Compute eigenvalues and eigenvectors, and test them 00607 * 00608 CALL ZLACPY( 'F', N, N, A, LDA, H, LDA ) 00609 CALL ZGEEV( 'V', 'V', N, H, LDA, W, VL, LDVL, VR, LDVR, 00610 $ WORK, NNWORK, RWORK, IINFO ) 00611 IF( IINFO.NE.0 ) THEN 00612 RESULT( 1 ) = ULPINV 00613 WRITE( NOUNIT, FMT = 9993 )'ZGEEV1', IINFO, N, JTYPE, 00614 $ IOLDSD 00615 INFO = ABS( IINFO ) 00616 GO TO 220 00617 END IF 00618 * 00619 * Do Test (1) 00620 * 00621 CALL ZGET22( 'N', 'N', 'N', N, A, LDA, VR, LDVR, W, WORK, 00622 $ RWORK, RES ) 00623 RESULT( 1 ) = RES( 1 ) 00624 * 00625 * Do Test (2) 00626 * 00627 CALL ZGET22( 'C', 'N', 'C', N, A, LDA, VL, LDVL, W, WORK, 00628 $ RWORK, RES ) 00629 RESULT( 2 ) = RES( 1 ) 00630 * 00631 * Do Test (3) 00632 * 00633 DO 120 J = 1, N 00634 TNRM = DZNRM2( N, VR( 1, J ), 1 ) 00635 RESULT( 3 ) = MAX( RESULT( 3 ), 00636 $ MIN( ULPINV, ABS( TNRM-ONE ) / ULP ) ) 00637 VMX = ZERO 00638 VRMX = ZERO 00639 DO 110 JJ = 1, N 00640 VTST = ABS( VR( JJ, J ) ) 00641 IF( VTST.GT.VMX ) 00642 $ VMX = VTST 00643 IF( DIMAG( VR( JJ, J ) ).EQ.ZERO .AND. 00644 $ ABS( DBLE( VR( JJ, J ) ) ).GT.VRMX ) 00645 $ VRMX = ABS( DBLE( VR( JJ, J ) ) ) 00646 110 CONTINUE 00647 IF( VRMX / VMX.LT.ONE-TWO*ULP ) 00648 $ RESULT( 3 ) = ULPINV 00649 120 CONTINUE 00650 * 00651 * Do Test (4) 00652 * 00653 DO 140 J = 1, N 00654 TNRM = DZNRM2( N, VL( 1, J ), 1 ) 00655 RESULT( 4 ) = MAX( RESULT( 4 ), 00656 $ MIN( ULPINV, ABS( TNRM-ONE ) / ULP ) ) 00657 VMX = ZERO 00658 VRMX = ZERO 00659 DO 130 JJ = 1, N 00660 VTST = ABS( VL( JJ, J ) ) 00661 IF( VTST.GT.VMX ) 00662 $ VMX = VTST 00663 IF( DIMAG( VL( JJ, J ) ).EQ.ZERO .AND. 00664 $ ABS( DBLE( VL( JJ, J ) ) ).GT.VRMX ) 00665 $ VRMX = ABS( DBLE( VL( JJ, J ) ) ) 00666 130 CONTINUE 00667 IF( VRMX / VMX.LT.ONE-TWO*ULP ) 00668 $ RESULT( 4 ) = ULPINV 00669 140 CONTINUE 00670 * 00671 * Compute eigenvalues only, and test them 00672 * 00673 CALL ZLACPY( 'F', N, N, A, LDA, H, LDA ) 00674 CALL ZGEEV( 'N', 'N', N, H, LDA, W1, DUM, 1, DUM, 1, 00675 $ WORK, NNWORK, RWORK, IINFO ) 00676 IF( IINFO.NE.0 ) THEN 00677 RESULT( 1 ) = ULPINV 00678 WRITE( NOUNIT, FMT = 9993 )'ZGEEV2', IINFO, N, JTYPE, 00679 $ IOLDSD 00680 INFO = ABS( IINFO ) 00681 GO TO 220 00682 END IF 00683 * 00684 * Do Test (5) 00685 * 00686 DO 150 J = 1, N 00687 IF( W( J ).NE.W1( J ) ) 00688 $ RESULT( 5 ) = ULPINV 00689 150 CONTINUE 00690 * 00691 * Compute eigenvalues and right eigenvectors, and test them 00692 * 00693 CALL ZLACPY( 'F', N, N, A, LDA, H, LDA ) 00694 CALL ZGEEV( 'N', 'V', N, H, LDA, W1, DUM, 1, LRE, LDLRE, 00695 $ WORK, NNWORK, RWORK, IINFO ) 00696 IF( IINFO.NE.0 ) THEN 00697 RESULT( 1 ) = ULPINV 00698 WRITE( NOUNIT, FMT = 9993 )'ZGEEV3', IINFO, N, JTYPE, 00699 $ IOLDSD 00700 INFO = ABS( IINFO ) 00701 GO TO 220 00702 END IF 00703 * 00704 * Do Test (5) again 00705 * 00706 DO 160 J = 1, N 00707 IF( W( J ).NE.W1( J ) ) 00708 $ RESULT( 5 ) = ULPINV 00709 160 CONTINUE 00710 * 00711 * Do Test (6) 00712 * 00713 DO 180 J = 1, N 00714 DO 170 JJ = 1, N 00715 IF( VR( J, JJ ).NE.LRE( J, JJ ) ) 00716 $ RESULT( 6 ) = ULPINV 00717 170 CONTINUE 00718 180 CONTINUE 00719 * 00720 * Compute eigenvalues and left eigenvectors, and test them 00721 * 00722 CALL ZLACPY( 'F', N, N, A, LDA, H, LDA ) 00723 CALL ZGEEV( 'V', 'N', N, H, LDA, W1, LRE, LDLRE, DUM, 1, 00724 $ WORK, NNWORK, RWORK, IINFO ) 00725 IF( IINFO.NE.0 ) THEN 00726 RESULT( 1 ) = ULPINV 00727 WRITE( NOUNIT, FMT = 9993 )'ZGEEV4', IINFO, N, JTYPE, 00728 $ IOLDSD 00729 INFO = ABS( IINFO ) 00730 GO TO 220 00731 END IF 00732 * 00733 * Do Test (5) again 00734 * 00735 DO 190 J = 1, N 00736 IF( W( J ).NE.W1( J ) ) 00737 $ RESULT( 5 ) = ULPINV 00738 190 CONTINUE 00739 * 00740 * Do Test (7) 00741 * 00742 DO 210 J = 1, N 00743 DO 200 JJ = 1, N 00744 IF( VL( J, JJ ).NE.LRE( J, JJ ) ) 00745 $ RESULT( 7 ) = ULPINV 00746 200 CONTINUE 00747 210 CONTINUE 00748 * 00749 * End of Loop -- Check for RESULT(j) > THRESH 00750 * 00751 220 CONTINUE 00752 * 00753 NTEST = 0 00754 NFAIL = 0 00755 DO 230 J = 1, 7 00756 IF( RESULT( J ).GE.ZERO ) 00757 $ NTEST = NTEST + 1 00758 IF( RESULT( J ).GE.THRESH ) 00759 $ NFAIL = NFAIL + 1 00760 230 CONTINUE 00761 * 00762 IF( NFAIL.GT.0 ) 00763 $ NTESTF = NTESTF + 1 00764 IF( NTESTF.EQ.1 ) THEN 00765 WRITE( NOUNIT, FMT = 9999 )PATH 00766 WRITE( NOUNIT, FMT = 9998 ) 00767 WRITE( NOUNIT, FMT = 9997 ) 00768 WRITE( NOUNIT, FMT = 9996 ) 00769 WRITE( NOUNIT, FMT = 9995 )THRESH 00770 NTESTF = 2 00771 END IF 00772 * 00773 DO 240 J = 1, 7 00774 IF( RESULT( J ).GE.THRESH ) THEN 00775 WRITE( NOUNIT, FMT = 9994 )N, IWK, IOLDSD, JTYPE, 00776 $ J, RESULT( J ) 00777 END IF 00778 240 CONTINUE 00779 * 00780 NERRS = NERRS + NFAIL 00781 NTESTT = NTESTT + NTEST 00782 * 00783 250 CONTINUE 00784 260 CONTINUE 00785 270 CONTINUE 00786 * 00787 * Summary 00788 * 00789 CALL DLASUM( PATH, NOUNIT, NERRS, NTESTT ) 00790 * 00791 9999 FORMAT( / 1X, A3, ' -- Complex Eigenvalue-Eigenvector ', 00792 $ 'Decomposition Driver', / 00793 $ ' Matrix types (see ZDRVEV for details): ' ) 00794 * 00795 9998 FORMAT( / ' Special Matrices:', / ' 1=Zero matrix. ', 00796 $ ' ', ' 5=Diagonal: geometr. spaced entries.', 00797 $ / ' 2=Identity matrix. ', ' 6=Diagona', 00798 $ 'l: clustered entries.', / ' 3=Transposed Jordan block. ', 00799 $ ' ', ' 7=Diagonal: large, evenly spaced.', / ' ', 00800 $ '4=Diagonal: evenly spaced entries. ', ' 8=Diagonal: s', 00801 $ 'mall, evenly spaced.' ) 00802 9997 FORMAT( ' Dense, Non-Symmetric Matrices:', / ' 9=Well-cond., ev', 00803 $ 'enly spaced eigenvals.', ' 14=Ill-cond., geomet. spaced e', 00804 $ 'igenals.', / ' 10=Well-cond., geom. spaced eigenvals. ', 00805 $ ' 15=Ill-conditioned, clustered e.vals.', / ' 11=Well-cond', 00806 $ 'itioned, clustered e.vals. ', ' 16=Ill-cond., random comp', 00807 $ 'lex ', A6, / ' 12=Well-cond., random complex ', A6, ' ', 00808 $ ' 17=Ill-cond., large rand. complx ', A4, / ' 13=Ill-condi', 00809 $ 'tioned, evenly spaced. ', ' 18=Ill-cond., small rand.', 00810 $ ' complx ', A4 ) 00811 9996 FORMAT( ' 19=Matrix with random O(1) entries. ', ' 21=Matrix ', 00812 $ 'with small random entries.', / ' 20=Matrix with large ran', 00813 $ 'dom entries. ', / ) 00814 9995 FORMAT( ' Tests performed with test threshold =', F8.2, 00815 $ / / ' 1 = | A VR - VR W | / ( n |A| ulp ) ', 00816 $ / ' 2 = | conj-trans(A) VL - VL conj-trans(W) | /', 00817 $ ' ( n |A| ulp ) ', / ' 3 = | |VR(i)| - 1 | / ulp ', 00818 $ / ' 4 = | |VL(i)| - 1 | / ulp ', 00819 $ / ' 5 = 0 if W same no matter if VR or VL computed,', 00820 $ ' 1/ulp otherwise', / 00821 $ ' 6 = 0 if VR same no matter if VL computed,', 00822 $ ' 1/ulp otherwise', / 00823 $ ' 7 = 0 if VL same no matter if VR computed,', 00824 $ ' 1/ulp otherwise', / ) 00825 9994 FORMAT( ' N=', I5, ', IWK=', I2, ', seed=', 4( I4, ',' ), 00826 $ ' type ', I2, ', test(', I2, ')=', G10.3 ) 00827 9993 FORMAT( ' ZDRVEV: ', A, ' returned INFO=', I6, '.', / 9X, 'N=', 00828 $ I6, ', JTYPE=', I6, ', ISEED=(', 3( I5, ',' ), I5, ')' ) 00829 * 00830 RETURN 00831 * 00832 * End of ZDRVEV 00833 * 00834 END
1.7.3 
