|
LAPACK 3.3.0
|
|
LAPACK 3.3.0
|
00001 SUBROUTINE ZGET23( COMP, ISRT, BALANC, JTYPE, THRESH, ISEED, 00002 $ NOUNIT, N, A, LDA, H, W, W1, VL, LDVL, VR, 00003 $ LDVR, LRE, LDLRE, RCONDV, RCNDV1, RCDVIN, 00004 $ RCONDE, RCNDE1, RCDEIN, SCALE, SCALE1, RESULT, 00005 $ WORK, LWORK, RWORK, INFO ) 00006 * 00007 * -- LAPACK test routine (version 3.1) -- 00008 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. 00009 * November 2006 00010 * 00011 * .. Scalar Arguments .. 00012 LOGICAL COMP 00013 CHARACTER BALANC 00014 INTEGER INFO, ISRT, JTYPE, LDA, LDLRE, LDVL, LDVR, 00015 $ LWORK, N, NOUNIT 00016 DOUBLE PRECISION THRESH 00017 * .. 00018 * .. Array Arguments .. 00019 INTEGER ISEED( 4 ) 00020 DOUBLE PRECISION RCDEIN( * ), RCDVIN( * ), RCNDE1( * ), 00021 $ RCNDV1( * ), RCONDE( * ), RCONDV( * ), 00022 $ RESULT( 11 ), RWORK( * ), SCALE( * ), 00023 $ SCALE1( * ) 00024 COMPLEX*16 A( LDA, * ), H( LDA, * ), LRE( LDLRE, * ), 00025 $ VL( LDVL, * ), VR( LDVR, * ), W( * ), W1( * ), 00026 $ WORK( * ) 00027 * .. 00028 * 00029 * Purpose 00030 * ======= 00031 * 00032 * ZGET23 checks the nonsymmetric eigenvalue problem driver CGEEVX. 00033 * If COMP = .FALSE., the first 8 of the following tests will be 00034 * performed on the input matrix A, and also test 9 if LWORK is 00035 * sufficiently large. 00036 * if COMP is .TRUE. all 11 tests will be performed. 00037 * 00038 * (1) | A * VR - VR * W | / ( n |A| ulp ) 00039 * 00040 * Here VR is the matrix of unit right eigenvectors. 00041 * W is a diagonal matrix with diagonal entries W(j). 00042 * 00043 * (2) | A**H * VL - VL * W**H | / ( n |A| ulp ) 00044 * 00045 * Here VL is the matrix of unit left eigenvectors, A**H is the 00046 * conjugate transpose of A, and W is as above. 00047 * 00048 * (3) | |VR(i)| - 1 | / ulp and largest component real 00049 * 00050 * VR(i) denotes the i-th column of VR. 00051 * 00052 * (4) | |VL(i)| - 1 | / ulp and largest component real 00053 * 00054 * VL(i) denotes the i-th column of VL. 00055 * 00056 * (5) 0 if W(full) = W(partial), 1/ulp otherwise 00057 * 00058 * W(full) denotes the eigenvalues computed when VR, VL, RCONDV 00059 * and RCONDE are also computed, and W(partial) denotes the 00060 * eigenvalues computed when only some of VR, VL, RCONDV, and 00061 * RCONDE are computed. 00062 * 00063 * (6) 0 if VR(full) = VR(partial), 1/ulp otherwise 00064 * 00065 * VR(full) denotes the right eigenvectors computed when VL, RCONDV 00066 * and RCONDE are computed, and VR(partial) denotes the result 00067 * when only some of VL and RCONDV are computed. 00068 * 00069 * (7) 0 if VL(full) = VL(partial), 1/ulp otherwise 00070 * 00071 * VL(full) denotes the left eigenvectors computed when VR, RCONDV 00072 * and RCONDE are computed, and VL(partial) denotes the result 00073 * when only some of VR and RCONDV are computed. 00074 * 00075 * (8) 0 if SCALE, ILO, IHI, ABNRM (full) = 00076 * SCALE, ILO, IHI, ABNRM (partial) 00077 * 1/ulp otherwise 00078 * 00079 * SCALE, ILO, IHI and ABNRM describe how the matrix is balanced. 00080 * (full) is when VR, VL, RCONDE and RCONDV are also computed, and 00081 * (partial) is when some are not computed. 00082 * 00083 * (9) 0 if RCONDV(full) = RCONDV(partial), 1/ulp otherwise 00084 * 00085 * RCONDV(full) denotes the reciprocal condition numbers of the 00086 * right eigenvectors computed when VR, VL and RCONDE are also 00087 * computed. RCONDV(partial) denotes the reciprocal condition 00088 * numbers when only some of VR, VL and RCONDE are computed. 00089 * 00090 * (10) |RCONDV - RCDVIN| / cond(RCONDV) 00091 * 00092 * RCONDV is the reciprocal right eigenvector condition number 00093 * computed by ZGEEVX and RCDVIN (the precomputed true value) 00094 * is supplied as input. cond(RCONDV) is the condition number of 00095 * RCONDV, and takes errors in computing RCONDV into account, so 00096 * that the resulting quantity should be O(ULP). cond(RCONDV) is 00097 * essentially given by norm(A)/RCONDE. 00098 * 00099 * (11) |RCONDE - RCDEIN| / cond(RCONDE) 00100 * 00101 * RCONDE is the reciprocal eigenvalue condition number 00102 * computed by ZGEEVX and RCDEIN (the precomputed true value) 00103 * is supplied as input. cond(RCONDE) is the condition number 00104 * of RCONDE, and takes errors in computing RCONDE into account, 00105 * so that the resulting quantity should be O(ULP). cond(RCONDE) 00106 * is essentially given by norm(A)/RCONDV. 00107 * 00108 * Arguments 00109 * ========= 00110 * 00111 * COMP (input) LOGICAL 00112 * COMP describes which input tests to perform: 00113 * = .FALSE. if the computed condition numbers are not to 00114 * be tested against RCDVIN and RCDEIN 00115 * = .TRUE. if they are to be compared 00116 * 00117 * ISRT (input) INTEGER 00118 * If COMP = .TRUE., ISRT indicates in how the eigenvalues 00119 * corresponding to values in RCDVIN and RCDEIN are ordered: 00120 * = 0 means the eigenvalues are sorted by 00121 * increasing real part 00122 * = 1 means the eigenvalues are sorted by 00123 * increasing imaginary part 00124 * If COMP = .FALSE., ISRT is not referenced. 00125 * 00126 * BALANC (input) CHARACTER 00127 * Describes the balancing option to be tested. 00128 * = 'N' for no permuting or diagonal scaling 00129 * = 'P' for permuting but no diagonal scaling 00130 * = 'S' for no permuting but diagonal scaling 00131 * = 'B' for permuting and diagonal scaling 00132 * 00133 * JTYPE (input) INTEGER 00134 * Type of input matrix. Used to label output if error occurs. 00135 * 00136 * THRESH (input) DOUBLE PRECISION 00137 * A test will count as "failed" if the "error", computed as 00138 * described above, exceeds THRESH. Note that the error 00139 * is scaled to be O(1), so THRESH should be a reasonably 00140 * small multiple of 1, e.g., 10 or 100. In particular, 00141 * it should not depend on the precision (single vs. double) 00142 * or the size of the matrix. It must be at least zero. 00143 * 00144 * ISEED (input) INTEGER array, dimension (4) 00145 * If COMP = .FALSE., the random number generator seed 00146 * used to produce matrix. 00147 * If COMP = .TRUE., ISEED(1) = the number of the example. 00148 * Used to label output if error occurs. 00149 * 00150 * NOUNIT (input) INTEGER 00151 * The FORTRAN unit number for printing out error messages 00152 * (e.g., if a routine returns INFO not equal to 0.) 00153 * 00154 * N (input) INTEGER 00155 * The dimension of A. N must be at least 0. 00156 * 00157 * A (input/output) COMPLEX*16 array, dimension (LDA,N) 00158 * Used to hold the matrix whose eigenvalues are to be 00159 * computed. 00160 * 00161 * LDA (input) INTEGER 00162 * The leading dimension of A, and H. LDA must be at 00163 * least 1 and at least N. 00164 * 00165 * H (workspace) COMPLEX*16 array, dimension (LDA,N) 00166 * Another copy of the test matrix A, modified by ZGEEVX. 00167 * 00168 * W (workspace) COMPLEX*16 array, dimension (N) 00169 * Contains the eigenvalues of A. 00170 * 00171 * W1 (workspace) COMPLEX*16 array, dimension (N) 00172 * Like W, this array contains the eigenvalues of A, 00173 * but those computed when ZGEEVX only computes a partial 00174 * eigendecomposition, i.e. not the eigenvalues and left 00175 * and right eigenvectors. 00176 * 00177 * VL (workspace) COMPLEX*16 array, dimension (LDVL,N) 00178 * VL holds the computed left eigenvectors. 00179 * 00180 * LDVL (input) INTEGER 00181 * Leading dimension of VL. Must be at least max(1,N). 00182 * 00183 * VR (workspace) COMPLEX*16 array, dimension (LDVR,N) 00184 * VR holds the computed right eigenvectors. 00185 * 00186 * LDVR (input) INTEGER 00187 * Leading dimension of VR. Must be at least max(1,N). 00188 * 00189 * LRE (workspace) COMPLEX*16 array, dimension (LDLRE,N) 00190 * LRE holds the computed right or left eigenvectors. 00191 * 00192 * LDLRE (input) INTEGER 00193 * Leading dimension of LRE. Must be at least max(1,N). 00194 * 00195 * RCONDV (workspace) DOUBLE PRECISION array, dimension (N) 00196 * RCONDV holds the computed reciprocal condition numbers 00197 * for eigenvectors. 00198 * 00199 * RCNDV1 (workspace) DOUBLE PRECISION array, dimension (N) 00200 * RCNDV1 holds more computed reciprocal condition numbers 00201 * for eigenvectors. 00202 * 00203 * RCDVIN (input) DOUBLE PRECISION array, dimension (N) 00204 * When COMP = .TRUE. RCDVIN holds the precomputed reciprocal 00205 * condition numbers for eigenvectors to be compared with 00206 * RCONDV. 00207 * 00208 * RCONDE (workspace) DOUBLE PRECISION array, dimension (N) 00209 * RCONDE holds the computed reciprocal condition numbers 00210 * for eigenvalues. 00211 * 00212 * RCNDE1 (workspace) DOUBLE PRECISION array, dimension (N) 00213 * RCNDE1 holds more computed reciprocal condition numbers 00214 * for eigenvalues. 00215 * 00216 * RCDEIN (input) DOUBLE PRECISION array, dimension (N) 00217 * When COMP = .TRUE. RCDEIN holds the precomputed reciprocal 00218 * condition numbers for eigenvalues to be compared with 00219 * RCONDE. 00220 * 00221 * SCALE (workspace) DOUBLE PRECISION array, dimension (N) 00222 * Holds information describing balancing of matrix. 00223 * 00224 * SCALE1 (workspace) DOUBLE PRECISION array, dimension (N) 00225 * Holds information describing balancing of matrix. 00226 * 00227 * RESULT (output) DOUBLE PRECISION array, dimension (11) 00228 * The values computed by the 11 tests described above. 00229 * The values are currently limited to 1/ulp, to avoid 00230 * overflow. 00231 * 00232 * WORK (workspace) COMPLEX*16 array, dimension (LWORK) 00233 * 00234 * LWORK (input) INTEGER 00235 * The number of entries in WORK. This must be at least 00236 * 2*N, and 2*N+N**2 if tests 9, 10 or 11 are to be performed. 00237 * 00238 * RWORK (workspace) DOUBLE PRECISION array, dimension (2*N) 00239 * 00240 * INFO (output) INTEGER 00241 * If 0, successful exit. 00242 * If <0, input parameter -INFO had an incorrect value. 00243 * If >0, ZGEEVX returned an error code, the absolute 00244 * value of which is returned. 00245 * 00246 * ===================================================================== 00247 * 00248 * .. Parameters .. 00249 DOUBLE PRECISION ZERO, ONE, TWO 00250 PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0, TWO = 2.0D0 ) 00251 DOUBLE PRECISION EPSIN 00252 PARAMETER ( EPSIN = 5.9605D-8 ) 00253 * .. 00254 * .. Local Scalars .. 00255 LOGICAL BALOK, NOBAL 00256 CHARACTER SENSE 00257 INTEGER I, IHI, IHI1, IINFO, ILO, ILO1, ISENS, ISENSM, 00258 $ J, JJ, KMIN 00259 DOUBLE PRECISION ABNRM, ABNRM1, EPS, SMLNUM, TNRM, TOL, TOLIN, 00260 $ ULP, ULPINV, V, VMAX, VMX, VRICMP, VRIMIN, 00261 $ VRMX, VTST 00262 COMPLEX*16 CTMP 00263 * .. 00264 * .. Local Arrays .. 00265 CHARACTER SENS( 2 ) 00266 DOUBLE PRECISION RES( 2 ) 00267 COMPLEX*16 CDUM( 1 ) 00268 * .. 00269 * .. External Functions .. 00270 LOGICAL LSAME 00271 DOUBLE PRECISION DLAMCH, DZNRM2 00272 EXTERNAL LSAME, DLAMCH, DZNRM2 00273 * .. 00274 * .. External Subroutines .. 00275 EXTERNAL XERBLA, ZGEEVX, ZGET22, ZLACPY 00276 * .. 00277 * .. Intrinsic Functions .. 00278 INTRINSIC ABS, DBLE, DIMAG, MAX, MIN 00279 * .. 00280 * .. Data statements .. 00281 DATA SENS / 'N', 'V' / 00282 * .. 00283 * .. Executable Statements .. 00284 * 00285 * Check for errors 00286 * 00287 NOBAL = LSAME( BALANC, 'N' ) 00288 BALOK = NOBAL .OR. LSAME( BALANC, 'P' ) .OR. 00289 $ LSAME( BALANC, 'S' ) .OR. LSAME( BALANC, 'B' ) 00290 INFO = 0 00291 IF( ISRT.NE.0 .AND. ISRT.NE.1 ) THEN 00292 INFO = -2 00293 ELSE IF( .NOT.BALOK ) THEN 00294 INFO = -3 00295 ELSE IF( THRESH.LT.ZERO ) THEN 00296 INFO = -5 00297 ELSE IF( NOUNIT.LE.0 ) THEN 00298 INFO = -7 00299 ELSE IF( N.LT.0 ) THEN 00300 INFO = -8 00301 ELSE IF( LDA.LT.1 .OR. LDA.LT.N ) THEN 00302 INFO = -10 00303 ELSE IF( LDVL.LT.1 .OR. LDVL.LT.N ) THEN 00304 INFO = -15 00305 ELSE IF( LDVR.LT.1 .OR. LDVR.LT.N ) THEN 00306 INFO = -17 00307 ELSE IF( LDLRE.LT.1 .OR. LDLRE.LT.N ) THEN 00308 INFO = -19 00309 ELSE IF( LWORK.LT.2*N .OR. ( COMP .AND. LWORK.LT.2*N+N*N ) ) THEN 00310 INFO = -30 00311 END IF 00312 * 00313 IF( INFO.NE.0 ) THEN 00314 CALL XERBLA( 'ZGET23', -INFO ) 00315 RETURN 00316 END IF 00317 * 00318 * Quick return if nothing to do 00319 * 00320 DO 10 I = 1, 11 00321 RESULT( I ) = -ONE 00322 10 CONTINUE 00323 * 00324 IF( N.EQ.0 ) 00325 $ RETURN 00326 * 00327 * More Important constants 00328 * 00329 ULP = DLAMCH( 'Precision' ) 00330 SMLNUM = DLAMCH( 'S' ) 00331 ULPINV = ONE / ULP 00332 * 00333 * Compute eigenvalues and eigenvectors, and test them 00334 * 00335 IF( LWORK.GE.2*N+N*N ) THEN 00336 SENSE = 'B' 00337 ISENSM = 2 00338 ELSE 00339 SENSE = 'E' 00340 ISENSM = 1 00341 END IF 00342 CALL ZLACPY( 'F', N, N, A, LDA, H, LDA ) 00343 CALL ZGEEVX( BALANC, 'V', 'V', SENSE, N, H, LDA, W, VL, LDVL, VR, 00344 $ LDVR, ILO, IHI, SCALE, ABNRM, RCONDE, RCONDV, WORK, 00345 $ LWORK, RWORK, IINFO ) 00346 IF( IINFO.NE.0 ) THEN 00347 RESULT( 1 ) = ULPINV 00348 IF( JTYPE.NE.22 ) THEN 00349 WRITE( NOUNIT, FMT = 9998 )'ZGEEVX1', IINFO, N, JTYPE, 00350 $ BALANC, ISEED 00351 ELSE 00352 WRITE( NOUNIT, FMT = 9999 )'ZGEEVX1', IINFO, N, ISEED( 1 ) 00353 END IF 00354 INFO = ABS( IINFO ) 00355 RETURN 00356 END IF 00357 * 00358 * Do Test (1) 00359 * 00360 CALL ZGET22( 'N', 'N', 'N', N, A, LDA, VR, LDVR, W, WORK, RWORK, 00361 $ RES ) 00362 RESULT( 1 ) = RES( 1 ) 00363 * 00364 * Do Test (2) 00365 * 00366 CALL ZGET22( 'C', 'N', 'C', N, A, LDA, VL, LDVL, W, WORK, RWORK, 00367 $ RES ) 00368 RESULT( 2 ) = RES( 1 ) 00369 * 00370 * Do Test (3) 00371 * 00372 DO 30 J = 1, N 00373 TNRM = DZNRM2( N, VR( 1, J ), 1 ) 00374 RESULT( 3 ) = MAX( RESULT( 3 ), 00375 $ MIN( ULPINV, ABS( TNRM-ONE ) / ULP ) ) 00376 VMX = ZERO 00377 VRMX = ZERO 00378 DO 20 JJ = 1, N 00379 VTST = ABS( VR( JJ, J ) ) 00380 IF( VTST.GT.VMX ) 00381 $ VMX = VTST 00382 IF( DIMAG( VR( JJ, J ) ).EQ.ZERO .AND. 00383 $ ABS( DBLE( VR( JJ, J ) ) ).GT.VRMX ) 00384 $ VRMX = ABS( DBLE( VR( JJ, J ) ) ) 00385 20 CONTINUE 00386 IF( VRMX / VMX.LT.ONE-TWO*ULP ) 00387 $ RESULT( 3 ) = ULPINV 00388 30 CONTINUE 00389 * 00390 * Do Test (4) 00391 * 00392 DO 50 J = 1, N 00393 TNRM = DZNRM2( N, VL( 1, J ), 1 ) 00394 RESULT( 4 ) = MAX( RESULT( 4 ), 00395 $ MIN( ULPINV, ABS( TNRM-ONE ) / ULP ) ) 00396 VMX = ZERO 00397 VRMX = ZERO 00398 DO 40 JJ = 1, N 00399 VTST = ABS( VL( JJ, J ) ) 00400 IF( VTST.GT.VMX ) 00401 $ VMX = VTST 00402 IF( DIMAG( VL( JJ, J ) ).EQ.ZERO .AND. 00403 $ ABS( DBLE( VL( JJ, J ) ) ).GT.VRMX ) 00404 $ VRMX = ABS( DBLE( VL( JJ, J ) ) ) 00405 40 CONTINUE 00406 IF( VRMX / VMX.LT.ONE-TWO*ULP ) 00407 $ RESULT( 4 ) = ULPINV 00408 50 CONTINUE 00409 * 00410 * Test for all options of computing condition numbers 00411 * 00412 DO 200 ISENS = 1, ISENSM 00413 * 00414 SENSE = SENS( ISENS ) 00415 * 00416 * Compute eigenvalues only, and test them 00417 * 00418 CALL ZLACPY( 'F', N, N, A, LDA, H, LDA ) 00419 CALL ZGEEVX( BALANC, 'N', 'N', SENSE, N, H, LDA, W1, CDUM, 1, 00420 $ CDUM, 1, ILO1, IHI1, SCALE1, ABNRM1, RCNDE1, 00421 $ RCNDV1, WORK, LWORK, RWORK, IINFO ) 00422 IF( IINFO.NE.0 ) THEN 00423 RESULT( 1 ) = ULPINV 00424 IF( JTYPE.NE.22 ) THEN 00425 WRITE( NOUNIT, FMT = 9998 )'ZGEEVX2', IINFO, N, JTYPE, 00426 $ BALANC, ISEED 00427 ELSE 00428 WRITE( NOUNIT, FMT = 9999 )'ZGEEVX2', IINFO, N, 00429 $ ISEED( 1 ) 00430 END IF 00431 INFO = ABS( IINFO ) 00432 GO TO 190 00433 END IF 00434 * 00435 * Do Test (5) 00436 * 00437 DO 60 J = 1, N 00438 IF( W( J ).NE.W1( J ) ) 00439 $ RESULT( 5 ) = ULPINV 00440 60 CONTINUE 00441 * 00442 * Do Test (8) 00443 * 00444 IF( .NOT.NOBAL ) THEN 00445 DO 70 J = 1, N 00446 IF( SCALE( J ).NE.SCALE1( J ) ) 00447 $ RESULT( 8 ) = ULPINV 00448 70 CONTINUE 00449 IF( ILO.NE.ILO1 ) 00450 $ RESULT( 8 ) = ULPINV 00451 IF( IHI.NE.IHI1 ) 00452 $ RESULT( 8 ) = ULPINV 00453 IF( ABNRM.NE.ABNRM1 ) 00454 $ RESULT( 8 ) = ULPINV 00455 END IF 00456 * 00457 * Do Test (9) 00458 * 00459 IF( ISENS.EQ.2 .AND. N.GT.1 ) THEN 00460 DO 80 J = 1, N 00461 IF( RCONDV( J ).NE.RCNDV1( J ) ) 00462 $ RESULT( 9 ) = ULPINV 00463 80 CONTINUE 00464 END IF 00465 * 00466 * Compute eigenvalues and right eigenvectors, and test them 00467 * 00468 CALL ZLACPY( 'F', N, N, A, LDA, H, LDA ) 00469 CALL ZGEEVX( BALANC, 'N', 'V', SENSE, N, H, LDA, W1, CDUM, 1, 00470 $ LRE, LDLRE, ILO1, IHI1, SCALE1, ABNRM1, RCNDE1, 00471 $ RCNDV1, WORK, LWORK, RWORK, IINFO ) 00472 IF( IINFO.NE.0 ) THEN 00473 RESULT( 1 ) = ULPINV 00474 IF( JTYPE.NE.22 ) THEN 00475 WRITE( NOUNIT, FMT = 9998 )'ZGEEVX3', IINFO, N, JTYPE, 00476 $ BALANC, ISEED 00477 ELSE 00478 WRITE( NOUNIT, FMT = 9999 )'ZGEEVX3', IINFO, N, 00479 $ ISEED( 1 ) 00480 END IF 00481 INFO = ABS( IINFO ) 00482 GO TO 190 00483 END IF 00484 * 00485 * Do Test (5) again 00486 * 00487 DO 90 J = 1, N 00488 IF( W( J ).NE.W1( J ) ) 00489 $ RESULT( 5 ) = ULPINV 00490 90 CONTINUE 00491 * 00492 * Do Test (6) 00493 * 00494 DO 110 J = 1, N 00495 DO 100 JJ = 1, N 00496 IF( VR( J, JJ ).NE.LRE( J, JJ ) ) 00497 $ RESULT( 6 ) = ULPINV 00498 100 CONTINUE 00499 110 CONTINUE 00500 * 00501 * Do Test (8) again 00502 * 00503 IF( .NOT.NOBAL ) THEN 00504 DO 120 J = 1, N 00505 IF( SCALE( J ).NE.SCALE1( J ) ) 00506 $ RESULT( 8 ) = ULPINV 00507 120 CONTINUE 00508 IF( ILO.NE.ILO1 ) 00509 $ RESULT( 8 ) = ULPINV 00510 IF( IHI.NE.IHI1 ) 00511 $ RESULT( 8 ) = ULPINV 00512 IF( ABNRM.NE.ABNRM1 ) 00513 $ RESULT( 8 ) = ULPINV 00514 END IF 00515 * 00516 * Do Test (9) again 00517 * 00518 IF( ISENS.EQ.2 .AND. N.GT.1 ) THEN 00519 DO 130 J = 1, N 00520 IF( RCONDV( J ).NE.RCNDV1( J ) ) 00521 $ RESULT( 9 ) = ULPINV 00522 130 CONTINUE 00523 END IF 00524 * 00525 * Compute eigenvalues and left eigenvectors, and test them 00526 * 00527 CALL ZLACPY( 'F', N, N, A, LDA, H, LDA ) 00528 CALL ZGEEVX( BALANC, 'V', 'N', SENSE, N, H, LDA, W1, LRE, 00529 $ LDLRE, CDUM, 1, ILO1, IHI1, SCALE1, ABNRM1, 00530 $ RCNDE1, RCNDV1, WORK, LWORK, RWORK, IINFO ) 00531 IF( IINFO.NE.0 ) THEN 00532 RESULT( 1 ) = ULPINV 00533 IF( JTYPE.NE.22 ) THEN 00534 WRITE( NOUNIT, FMT = 9998 )'ZGEEVX4', IINFO, N, JTYPE, 00535 $ BALANC, ISEED 00536 ELSE 00537 WRITE( NOUNIT, FMT = 9999 )'ZGEEVX4', IINFO, N, 00538 $ ISEED( 1 ) 00539 END IF 00540 INFO = ABS( IINFO ) 00541 GO TO 190 00542 END IF 00543 * 00544 * Do Test (5) again 00545 * 00546 DO 140 J = 1, N 00547 IF( W( J ).NE.W1( J ) ) 00548 $ RESULT( 5 ) = ULPINV 00549 140 CONTINUE 00550 * 00551 * Do Test (7) 00552 * 00553 DO 160 J = 1, N 00554 DO 150 JJ = 1, N 00555 IF( VL( J, JJ ).NE.LRE( J, JJ ) ) 00556 $ RESULT( 7 ) = ULPINV 00557 150 CONTINUE 00558 160 CONTINUE 00559 * 00560 * Do Test (8) again 00561 * 00562 IF( .NOT.NOBAL ) THEN 00563 DO 170 J = 1, N 00564 IF( SCALE( J ).NE.SCALE1( J ) ) 00565 $ RESULT( 8 ) = ULPINV 00566 170 CONTINUE 00567 IF( ILO.NE.ILO1 ) 00568 $ RESULT( 8 ) = ULPINV 00569 IF( IHI.NE.IHI1 ) 00570 $ RESULT( 8 ) = ULPINV 00571 IF( ABNRM.NE.ABNRM1 ) 00572 $ RESULT( 8 ) = ULPINV 00573 END IF 00574 * 00575 * Do Test (9) again 00576 * 00577 IF( ISENS.EQ.2 .AND. N.GT.1 ) THEN 00578 DO 180 J = 1, N 00579 IF( RCONDV( J ).NE.RCNDV1( J ) ) 00580 $ RESULT( 9 ) = ULPINV 00581 180 CONTINUE 00582 END IF 00583 * 00584 190 CONTINUE 00585 * 00586 200 CONTINUE 00587 * 00588 * If COMP, compare condition numbers to precomputed ones 00589 * 00590 IF( COMP ) THEN 00591 CALL ZLACPY( 'F', N, N, A, LDA, H, LDA ) 00592 CALL ZGEEVX( 'N', 'V', 'V', 'B', N, H, LDA, W, VL, LDVL, VR, 00593 $ LDVR, ILO, IHI, SCALE, ABNRM, RCONDE, RCONDV, 00594 $ WORK, LWORK, RWORK, IINFO ) 00595 IF( IINFO.NE.0 ) THEN 00596 RESULT( 1 ) = ULPINV 00597 WRITE( NOUNIT, FMT = 9999 )'ZGEEVX5', IINFO, N, ISEED( 1 ) 00598 INFO = ABS( IINFO ) 00599 GO TO 250 00600 END IF 00601 * 00602 * Sort eigenvalues and condition numbers lexicographically 00603 * to compare with inputs 00604 * 00605 DO 220 I = 1, N - 1 00606 KMIN = I 00607 IF( ISRT.EQ.0 ) THEN 00608 VRIMIN = DBLE( W( I ) ) 00609 ELSE 00610 VRIMIN = DIMAG( W( I ) ) 00611 END IF 00612 DO 210 J = I + 1, N 00613 IF( ISRT.EQ.0 ) THEN 00614 VRICMP = DBLE( W( J ) ) 00615 ELSE 00616 VRICMP = DIMAG( W( J ) ) 00617 END IF 00618 IF( VRICMP.LT.VRIMIN ) THEN 00619 KMIN = J 00620 VRIMIN = VRICMP 00621 END IF 00622 210 CONTINUE 00623 CTMP = W( KMIN ) 00624 W( KMIN ) = W( I ) 00625 W( I ) = CTMP 00626 VRIMIN = RCONDE( KMIN ) 00627 RCONDE( KMIN ) = RCONDE( I ) 00628 RCONDE( I ) = VRIMIN 00629 VRIMIN = RCONDV( KMIN ) 00630 RCONDV( KMIN ) = RCONDV( I ) 00631 RCONDV( I ) = VRIMIN 00632 220 CONTINUE 00633 * 00634 * Compare condition numbers for eigenvectors 00635 * taking their condition numbers into account 00636 * 00637 RESULT( 10 ) = ZERO 00638 EPS = MAX( EPSIN, ULP ) 00639 V = MAX( DBLE( N )*EPS*ABNRM, SMLNUM ) 00640 IF( ABNRM.EQ.ZERO ) 00641 $ V = ONE 00642 DO 230 I = 1, N 00643 IF( V.GT.RCONDV( I )*RCONDE( I ) ) THEN 00644 TOL = RCONDV( I ) 00645 ELSE 00646 TOL = V / RCONDE( I ) 00647 END IF 00648 IF( V.GT.RCDVIN( I )*RCDEIN( I ) ) THEN 00649 TOLIN = RCDVIN( I ) 00650 ELSE 00651 TOLIN = V / RCDEIN( I ) 00652 END IF 00653 TOL = MAX( TOL, SMLNUM / EPS ) 00654 TOLIN = MAX( TOLIN, SMLNUM / EPS ) 00655 IF( EPS*( RCDVIN( I )-TOLIN ).GT.RCONDV( I )+TOL ) THEN 00656 VMAX = ONE / EPS 00657 ELSE IF( RCDVIN( I )-TOLIN.GT.RCONDV( I )+TOL ) THEN 00658 VMAX = ( RCDVIN( I )-TOLIN ) / ( RCONDV( I )+TOL ) 00659 ELSE IF( RCDVIN( I )+TOLIN.LT.EPS*( RCONDV( I )-TOL ) ) THEN 00660 VMAX = ONE / EPS 00661 ELSE IF( RCDVIN( I )+TOLIN.LT.RCONDV( I )-TOL ) THEN 00662 VMAX = ( RCONDV( I )-TOL ) / ( RCDVIN( I )+TOLIN ) 00663 ELSE 00664 VMAX = ONE 00665 END IF 00666 RESULT( 10 ) = MAX( RESULT( 10 ), VMAX ) 00667 230 CONTINUE 00668 * 00669 * Compare condition numbers for eigenvalues 00670 * taking their condition numbers into account 00671 * 00672 RESULT( 11 ) = ZERO 00673 DO 240 I = 1, N 00674 IF( V.GT.RCONDV( I ) ) THEN 00675 TOL = ONE 00676 ELSE 00677 TOL = V / RCONDV( I ) 00678 END IF 00679 IF( V.GT.RCDVIN( I ) ) THEN 00680 TOLIN = ONE 00681 ELSE 00682 TOLIN = V / RCDVIN( I ) 00683 END IF 00684 TOL = MAX( TOL, SMLNUM / EPS ) 00685 TOLIN = MAX( TOLIN, SMLNUM / EPS ) 00686 IF( EPS*( RCDEIN( I )-TOLIN ).GT.RCONDE( I )+TOL ) THEN 00687 VMAX = ONE / EPS 00688 ELSE IF( RCDEIN( I )-TOLIN.GT.RCONDE( I )+TOL ) THEN 00689 VMAX = ( RCDEIN( I )-TOLIN ) / ( RCONDE( I )+TOL ) 00690 ELSE IF( RCDEIN( I )+TOLIN.LT.EPS*( RCONDE( I )-TOL ) ) THEN 00691 VMAX = ONE / EPS 00692 ELSE IF( RCDEIN( I )+TOLIN.LT.RCONDE( I )-TOL ) THEN 00693 VMAX = ( RCONDE( I )-TOL ) / ( RCDEIN( I )+TOLIN ) 00694 ELSE 00695 VMAX = ONE 00696 END IF 00697 RESULT( 11 ) = MAX( RESULT( 11 ), VMAX ) 00698 240 CONTINUE 00699 250 CONTINUE 00700 * 00701 END IF 00702 * 00703 9999 FORMAT( ' ZGET23: ', A, ' returned INFO=', I6, '.', / 9X, 'N=', 00704 $ I6, ', INPUT EXAMPLE NUMBER = ', I4 ) 00705 9998 FORMAT( ' ZGET23: ', A, ' returned INFO=', I6, '.', / 9X, 'N=', 00706 $ I6, ', JTYPE=', I6, ', BALANC = ', A, ', ISEED=(', 00707 $ 3( I5, ',' ), I5, ')' ) 00708 * 00709 RETURN 00710 * 00711 * End of ZGET23 00712 * 00713 END
1.7.3 
