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