![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief <b> ZGEEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices</b> 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 *> \htmlonly 00009 *> Download ZGEEVX + dependencies 00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zgeevx.f"> 00011 *> [TGZ]</a> 00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zgeevx.f"> 00013 *> [ZIP]</a> 00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zgeevx.f"> 00015 *> [TXT]</a> 00016 *> \endhtmlonly 00017 * 00018 * Definition: 00019 * =========== 00020 * 00021 * SUBROUTINE ZGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, W, VL, 00022 * LDVL, VR, LDVR, ILO, IHI, SCALE, ABNRM, RCONDE, 00023 * RCONDV, WORK, LWORK, RWORK, INFO ) 00024 * 00025 * .. Scalar Arguments .. 00026 * CHARACTER BALANC, JOBVL, JOBVR, SENSE 00027 * INTEGER IHI, ILO, INFO, LDA, LDVL, LDVR, LWORK, N 00028 * DOUBLE PRECISION ABNRM 00029 * .. 00030 * .. Array Arguments .. 00031 * DOUBLE PRECISION RCONDE( * ), RCONDV( * ), RWORK( * ), 00032 * $ SCALE( * ) 00033 * COMPLEX*16 A( LDA, * ), VL( LDVL, * ), VR( LDVR, * ), 00034 * $ W( * ), WORK( * ) 00035 * .. 00036 * 00037 * 00038 *> \par Purpose: 00039 * ============= 00040 *> 00041 *> \verbatim 00042 *> 00043 *> ZGEEVX computes for an N-by-N complex nonsymmetric matrix A, the 00044 *> eigenvalues and, optionally, the left and/or right eigenvectors. 00045 *> 00046 *> Optionally also, it computes a balancing transformation to improve 00047 *> the conditioning of the eigenvalues and eigenvectors (ILO, IHI, 00048 *> SCALE, and ABNRM), reciprocal condition numbers for the eigenvalues 00049 *> (RCONDE), and reciprocal condition numbers for the right 00050 *> eigenvectors (RCONDV). 00051 *> 00052 *> The right eigenvector v(j) of A satisfies 00053 *> A * v(j) = lambda(j) * v(j) 00054 *> where lambda(j) is its eigenvalue. 00055 *> The left eigenvector u(j) of A satisfies 00056 *> u(j)**H * A = lambda(j) * u(j)**H 00057 *> where u(j)**H denotes the conjugate transpose of u(j). 00058 *> 00059 *> The computed eigenvectors are normalized to have Euclidean norm 00060 *> equal to 1 and largest component real. 00061 *> 00062 *> Balancing a matrix means permuting the rows and columns to make it 00063 *> more nearly upper triangular, and applying a diagonal similarity 00064 *> transformation D * A * D**(-1), where D is a diagonal matrix, to 00065 *> make its rows and columns closer in norm and the condition numbers 00066 *> of its eigenvalues and eigenvectors smaller. The computed 00067 *> reciprocal condition numbers correspond to the balanced matrix. 00068 *> Permuting rows and columns will not change the condition numbers 00069 *> (in exact arithmetic) but diagonal scaling will. For further 00070 *> explanation of balancing, see section 4.10.2 of the LAPACK 00071 *> Users' Guide. 00072 *> \endverbatim 00073 * 00074 * Arguments: 00075 * ========== 00076 * 00077 *> \param[in] BALANC 00078 *> \verbatim 00079 *> BALANC is CHARACTER*1 00080 *> Indicates how the input matrix should be diagonally scaled 00081 *> and/or permuted to improve the conditioning of its 00082 *> eigenvalues. 00083 *> = 'N': Do not diagonally scale or permute; 00084 *> = 'P': Perform permutations to make the matrix more nearly 00085 *> upper triangular. Do not diagonally scale; 00086 *> = 'S': Diagonally scale the matrix, ie. replace A by 00087 *> D*A*D**(-1), where D is a diagonal matrix chosen 00088 *> to make the rows and columns of A more equal in 00089 *> norm. Do not permute; 00090 *> = 'B': Both diagonally scale and permute A. 00091 *> 00092 *> Computed reciprocal condition numbers will be for the matrix 00093 *> after balancing and/or permuting. Permuting does not change 00094 *> condition numbers (in exact arithmetic), but balancing does. 00095 *> \endverbatim 00096 *> 00097 *> \param[in] JOBVL 00098 *> \verbatim 00099 *> JOBVL is CHARACTER*1 00100 *> = 'N': left eigenvectors of A are not computed; 00101 *> = 'V': left eigenvectors of A are computed. 00102 *> If SENSE = 'E' or 'B', JOBVL must = 'V'. 00103 *> \endverbatim 00104 *> 00105 *> \param[in] JOBVR 00106 *> \verbatim 00107 *> JOBVR is CHARACTER*1 00108 *> = 'N': right eigenvectors of A are not computed; 00109 *> = 'V': right eigenvectors of A are computed. 00110 *> If SENSE = 'E' or 'B', JOBVR must = 'V'. 00111 *> \endverbatim 00112 *> 00113 *> \param[in] SENSE 00114 *> \verbatim 00115 *> SENSE is CHARACTER*1 00116 *> Determines which reciprocal condition numbers are computed. 00117 *> = 'N': None are computed; 00118 *> = 'E': Computed for eigenvalues only; 00119 *> = 'V': Computed for right eigenvectors only; 00120 *> = 'B': Computed for eigenvalues and right eigenvectors. 00121 *> 00122 *> If SENSE = 'E' or 'B', both left and right eigenvectors 00123 *> must also be computed (JOBVL = 'V' and JOBVR = 'V'). 00124 *> \endverbatim 00125 *> 00126 *> \param[in] N 00127 *> \verbatim 00128 *> N is INTEGER 00129 *> The order of the matrix A. N >= 0. 00130 *> \endverbatim 00131 *> 00132 *> \param[in,out] A 00133 *> \verbatim 00134 *> A is COMPLEX*16 array, dimension (LDA,N) 00135 *> On entry, the N-by-N matrix A. 00136 *> On exit, A has been overwritten. If JOBVL = 'V' or 00137 *> JOBVR = 'V', A contains the Schur form of the balanced 00138 *> version of the matrix A. 00139 *> \endverbatim 00140 *> 00141 *> \param[in] LDA 00142 *> \verbatim 00143 *> LDA is INTEGER 00144 *> The leading dimension of the array A. LDA >= max(1,N). 00145 *> \endverbatim 00146 *> 00147 *> \param[out] W 00148 *> \verbatim 00149 *> W is COMPLEX*16 array, dimension (N) 00150 *> W contains the computed eigenvalues. 00151 *> \endverbatim 00152 *> 00153 *> \param[out] VL 00154 *> \verbatim 00155 *> VL is COMPLEX*16 array, dimension (LDVL,N) 00156 *> If JOBVL = 'V', the left eigenvectors u(j) are stored one 00157 *> after another in the columns of VL, in the same order 00158 *> as their eigenvalues. 00159 *> If JOBVL = 'N', VL is not referenced. 00160 *> u(j) = VL(:,j), the j-th column of VL. 00161 *> \endverbatim 00162 *> 00163 *> \param[in] LDVL 00164 *> \verbatim 00165 *> LDVL is INTEGER 00166 *> The leading dimension of the array VL. LDVL >= 1; if 00167 *> JOBVL = 'V', LDVL >= N. 00168 *> \endverbatim 00169 *> 00170 *> \param[out] VR 00171 *> \verbatim 00172 *> VR is COMPLEX*16 array, dimension (LDVR,N) 00173 *> If JOBVR = 'V', the right eigenvectors v(j) are stored one 00174 *> after another in the columns of VR, in the same order 00175 *> as their eigenvalues. 00176 *> If JOBVR = 'N', VR is not referenced. 00177 *> v(j) = VR(:,j), the j-th column of VR. 00178 *> \endverbatim 00179 *> 00180 *> \param[in] LDVR 00181 *> \verbatim 00182 *> LDVR is INTEGER 00183 *> The leading dimension of the array VR. LDVR >= 1; if 00184 *> JOBVR = 'V', LDVR >= N. 00185 *> \endverbatim 00186 *> 00187 *> \param[out] ILO 00188 *> \verbatim 00189 *> ILO is INTEGER 00190 *> \endverbatim 00191 *> 00192 *> \param[out] IHI 00193 *> \verbatim 00194 *> IHI is INTEGER 00195 *> ILO and IHI are integer values determined when A was 00196 *> balanced. The balanced A(i,j) = 0 if I > J and 00197 *> J = 1,...,ILO-1 or I = IHI+1,...,N. 00198 *> \endverbatim 00199 *> 00200 *> \param[out] SCALE 00201 *> \verbatim 00202 *> SCALE is DOUBLE PRECISION array, dimension (N) 00203 *> Details of the permutations and scaling factors applied 00204 *> when balancing A. If P(j) is the index of the row and column 00205 *> interchanged with row and column j, and D(j) is the scaling 00206 *> factor applied to row and column j, then 00207 *> SCALE(J) = P(J), for J = 1,...,ILO-1 00208 *> = D(J), for J = ILO,...,IHI 00209 *> = P(J) for J = IHI+1,...,N. 00210 *> The order in which the interchanges are made is N to IHI+1, 00211 *> then 1 to ILO-1. 00212 *> \endverbatim 00213 *> 00214 *> \param[out] ABNRM 00215 *> \verbatim 00216 *> ABNRM is DOUBLE PRECISION 00217 *> The one-norm of the balanced matrix (the maximum 00218 *> of the sum of absolute values of elements of any column). 00219 *> \endverbatim 00220 *> 00221 *> \param[out] RCONDE 00222 *> \verbatim 00223 *> RCONDE is DOUBLE PRECISION array, dimension (N) 00224 *> RCONDE(j) is the reciprocal condition number of the j-th 00225 *> eigenvalue. 00226 *> \endverbatim 00227 *> 00228 *> \param[out] RCONDV 00229 *> \verbatim 00230 *> RCONDV is DOUBLE PRECISION array, dimension (N) 00231 *> RCONDV(j) is the reciprocal condition number of the j-th 00232 *> right eigenvector. 00233 *> \endverbatim 00234 *> 00235 *> \param[out] WORK 00236 *> \verbatim 00237 *> WORK is COMPLEX*16 array, dimension (MAX(1,LWORK)) 00238 *> On exit, if INFO = 0, WORK(1) returns the optimal LWORK. 00239 *> \endverbatim 00240 *> 00241 *> \param[in] LWORK 00242 *> \verbatim 00243 *> LWORK is INTEGER 00244 *> The dimension of the array WORK. If SENSE = 'N' or 'E', 00245 *> LWORK >= max(1,2*N), and if SENSE = 'V' or 'B', 00246 *> LWORK >= N*N+2*N. 00247 *> For good performance, LWORK must generally be larger. 00248 *> 00249 *> If LWORK = -1, then a workspace query is assumed; the routine 00250 *> only calculates the optimal size of the WORK array, returns 00251 *> this value as the first entry of the WORK array, and no error 00252 *> message related to LWORK is issued by XERBLA. 00253 *> \endverbatim 00254 *> 00255 *> \param[out] RWORK 00256 *> \verbatim 00257 *> RWORK is DOUBLE PRECISION array, dimension (2*N) 00258 *> \endverbatim 00259 *> 00260 *> \param[out] INFO 00261 *> \verbatim 00262 *> INFO is INTEGER 00263 *> = 0: successful exit 00264 *> < 0: if INFO = -i, the i-th argument had an illegal value. 00265 *> > 0: if INFO = i, the QR algorithm failed to compute all the 00266 *> eigenvalues, and no eigenvectors or condition numbers 00267 *> have been computed; elements 1:ILO-1 and i+1:N of W 00268 *> contain eigenvalues which have converged. 00269 *> \endverbatim 00270 * 00271 * Authors: 00272 * ======== 00273 * 00274 *> \author Univ. of Tennessee 00275 *> \author Univ. of California Berkeley 00276 *> \author Univ. of Colorado Denver 00277 *> \author NAG Ltd. 00278 * 00279 *> \date November 2011 00280 * 00281 *> \ingroup complex16GEeigen 00282 * 00283 * ===================================================================== 00284 SUBROUTINE ZGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, W, VL, 00285 $ LDVL, VR, LDVR, ILO, IHI, SCALE, ABNRM, RCONDE, 00286 $ RCONDV, WORK, LWORK, RWORK, INFO ) 00287 * 00288 * -- LAPACK driver routine (version 3.4.0) -- 00289 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00290 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00291 * November 2011 00292 * 00293 * .. Scalar Arguments .. 00294 CHARACTER BALANC, JOBVL, JOBVR, SENSE 00295 INTEGER IHI, ILO, INFO, LDA, LDVL, LDVR, LWORK, N 00296 DOUBLE PRECISION ABNRM 00297 * .. 00298 * .. Array Arguments .. 00299 DOUBLE PRECISION RCONDE( * ), RCONDV( * ), RWORK( * ), 00300 $ SCALE( * ) 00301 COMPLEX*16 A( LDA, * ), VL( LDVL, * ), VR( LDVR, * ), 00302 $ W( * ), WORK( * ) 00303 * .. 00304 * 00305 * ===================================================================== 00306 * 00307 * .. Parameters .. 00308 DOUBLE PRECISION ZERO, ONE 00309 PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 ) 00310 * .. 00311 * .. Local Scalars .. 00312 LOGICAL LQUERY, SCALEA, WANTVL, WANTVR, WNTSNB, WNTSNE, 00313 $ WNTSNN, WNTSNV 00314 CHARACTER JOB, SIDE 00315 INTEGER HSWORK, I, ICOND, IERR, ITAU, IWRK, K, MAXWRK, 00316 $ MINWRK, NOUT 00317 DOUBLE PRECISION ANRM, BIGNUM, CSCALE, EPS, SCL, SMLNUM 00318 COMPLEX*16 TMP 00319 * .. 00320 * .. Local Arrays .. 00321 LOGICAL SELECT( 1 ) 00322 DOUBLE PRECISION DUM( 1 ) 00323 * .. 00324 * .. External Subroutines .. 00325 EXTERNAL DLABAD, DLASCL, XERBLA, ZDSCAL, ZGEBAK, ZGEBAL, 00326 $ ZGEHRD, ZHSEQR, ZLACPY, ZLASCL, ZSCAL, ZTREVC, 00327 $ ZTRSNA, ZUNGHR 00328 * .. 00329 * .. External Functions .. 00330 LOGICAL LSAME 00331 INTEGER IDAMAX, ILAENV 00332 DOUBLE PRECISION DLAMCH, DZNRM2, ZLANGE 00333 EXTERNAL LSAME, IDAMAX, ILAENV, DLAMCH, DZNRM2, ZLANGE 00334 * .. 00335 * .. Intrinsic Functions .. 00336 INTRINSIC DBLE, DCMPLX, DCONJG, DIMAG, MAX, SQRT 00337 * .. 00338 * .. Executable Statements .. 00339 * 00340 * Test the input arguments 00341 * 00342 INFO = 0 00343 LQUERY = ( LWORK.EQ.-1 ) 00344 WANTVL = LSAME( JOBVL, 'V' ) 00345 WANTVR = LSAME( JOBVR, 'V' ) 00346 WNTSNN = LSAME( SENSE, 'N' ) 00347 WNTSNE = LSAME( SENSE, 'E' ) 00348 WNTSNV = LSAME( SENSE, 'V' ) 00349 WNTSNB = LSAME( SENSE, 'B' ) 00350 IF( .NOT.( LSAME( BALANC, 'N' ) .OR. LSAME( BALANC, 'S' ) .OR. 00351 $ LSAME( BALANC, 'P' ) .OR. LSAME( BALANC, 'B' ) ) ) THEN 00352 INFO = -1 00353 ELSE IF( ( .NOT.WANTVL ) .AND. ( .NOT.LSAME( JOBVL, 'N' ) ) ) THEN 00354 INFO = -2 00355 ELSE IF( ( .NOT.WANTVR ) .AND. ( .NOT.LSAME( JOBVR, 'N' ) ) ) THEN 00356 INFO = -3 00357 ELSE IF( .NOT.( WNTSNN .OR. WNTSNE .OR. WNTSNB .OR. WNTSNV ) .OR. 00358 $ ( ( WNTSNE .OR. WNTSNB ) .AND. .NOT.( WANTVL .AND. 00359 $ WANTVR ) ) ) THEN 00360 INFO = -4 00361 ELSE IF( N.LT.0 ) THEN 00362 INFO = -5 00363 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN 00364 INFO = -7 00365 ELSE IF( LDVL.LT.1 .OR. ( WANTVL .AND. LDVL.LT.N ) ) THEN 00366 INFO = -10 00367 ELSE IF( LDVR.LT.1 .OR. ( WANTVR .AND. LDVR.LT.N ) ) THEN 00368 INFO = -12 00369 END IF 00370 * 00371 * Compute workspace 00372 * (Note: Comments in the code beginning "Workspace:" describe the 00373 * minimal amount of workspace needed at that point in the code, 00374 * as well as the preferred amount for good performance. 00375 * CWorkspace refers to complex workspace, and RWorkspace to real 00376 * workspace. NB refers to the optimal block size for the 00377 * immediately following subroutine, as returned by ILAENV. 00378 * HSWORK refers to the workspace preferred by ZHSEQR, as 00379 * calculated below. HSWORK is computed assuming ILO=1 and IHI=N, 00380 * the worst case.) 00381 * 00382 IF( INFO.EQ.0 ) THEN 00383 IF( N.EQ.0 ) THEN 00384 MINWRK = 1 00385 MAXWRK = 1 00386 ELSE 00387 MAXWRK = N + N*ILAENV( 1, 'ZGEHRD', ' ', N, 1, N, 0 ) 00388 * 00389 IF( WANTVL ) THEN 00390 CALL ZHSEQR( 'S', 'V', N, 1, N, A, LDA, W, VL, LDVL, 00391 $ WORK, -1, INFO ) 00392 ELSE IF( WANTVR ) THEN 00393 CALL ZHSEQR( 'S', 'V', N, 1, N, A, LDA, W, VR, LDVR, 00394 $ WORK, -1, INFO ) 00395 ELSE 00396 IF( WNTSNN ) THEN 00397 CALL ZHSEQR( 'E', 'N', N, 1, N, A, LDA, W, VR, LDVR, 00398 $ WORK, -1, INFO ) 00399 ELSE 00400 CALL ZHSEQR( 'S', 'N', N, 1, N, A, LDA, W, VR, LDVR, 00401 $ WORK, -1, INFO ) 00402 END IF 00403 END IF 00404 HSWORK = WORK( 1 ) 00405 * 00406 IF( ( .NOT.WANTVL ) .AND. ( .NOT.WANTVR ) ) THEN 00407 MINWRK = 2*N 00408 IF( .NOT.( WNTSNN .OR. WNTSNE ) ) 00409 $ MINWRK = MAX( MINWRK, N*N + 2*N ) 00410 MAXWRK = MAX( MAXWRK, HSWORK ) 00411 IF( .NOT.( WNTSNN .OR. WNTSNE ) ) 00412 $ MAXWRK = MAX( MAXWRK, N*N + 2*N ) 00413 ELSE 00414 MINWRK = 2*N 00415 IF( .NOT.( WNTSNN .OR. WNTSNE ) ) 00416 $ MINWRK = MAX( MINWRK, N*N + 2*N ) 00417 MAXWRK = MAX( MAXWRK, HSWORK ) 00418 MAXWRK = MAX( MAXWRK, N + ( N - 1 )*ILAENV( 1, 'ZUNGHR', 00419 $ ' ', N, 1, N, -1 ) ) 00420 IF( .NOT.( WNTSNN .OR. WNTSNE ) ) 00421 $ MAXWRK = MAX( MAXWRK, N*N + 2*N ) 00422 MAXWRK = MAX( MAXWRK, 2*N ) 00423 END IF 00424 MAXWRK = MAX( MAXWRK, MINWRK ) 00425 END IF 00426 WORK( 1 ) = MAXWRK 00427 * 00428 IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN 00429 INFO = -20 00430 END IF 00431 END IF 00432 * 00433 IF( INFO.NE.0 ) THEN 00434 CALL XERBLA( 'ZGEEVX', -INFO ) 00435 RETURN 00436 ELSE IF( LQUERY ) THEN 00437 RETURN 00438 END IF 00439 * 00440 * Quick return if possible 00441 * 00442 IF( N.EQ.0 ) 00443 $ RETURN 00444 * 00445 * Get machine constants 00446 * 00447 EPS = DLAMCH( 'P' ) 00448 SMLNUM = DLAMCH( 'S' ) 00449 BIGNUM = ONE / SMLNUM 00450 CALL DLABAD( SMLNUM, BIGNUM ) 00451 SMLNUM = SQRT( SMLNUM ) / EPS 00452 BIGNUM = ONE / SMLNUM 00453 * 00454 * Scale A if max element outside range [SMLNUM,BIGNUM] 00455 * 00456 ICOND = 0 00457 ANRM = ZLANGE( 'M', N, N, A, LDA, DUM ) 00458 SCALEA = .FALSE. 00459 IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN 00460 SCALEA = .TRUE. 00461 CSCALE = SMLNUM 00462 ELSE IF( ANRM.GT.BIGNUM ) THEN 00463 SCALEA = .TRUE. 00464 CSCALE = BIGNUM 00465 END IF 00466 IF( SCALEA ) 00467 $ CALL ZLASCL( 'G', 0, 0, ANRM, CSCALE, N, N, A, LDA, IERR ) 00468 * 00469 * Balance the matrix and compute ABNRM 00470 * 00471 CALL ZGEBAL( BALANC, N, A, LDA, ILO, IHI, SCALE, IERR ) 00472 ABNRM = ZLANGE( '1', N, N, A, LDA, DUM ) 00473 IF( SCALEA ) THEN 00474 DUM( 1 ) = ABNRM 00475 CALL DLASCL( 'G', 0, 0, CSCALE, ANRM, 1, 1, DUM, 1, IERR ) 00476 ABNRM = DUM( 1 ) 00477 END IF 00478 * 00479 * Reduce to upper Hessenberg form 00480 * (CWorkspace: need 2*N, prefer N+N*NB) 00481 * (RWorkspace: none) 00482 * 00483 ITAU = 1 00484 IWRK = ITAU + N 00485 CALL ZGEHRD( N, ILO, IHI, A, LDA, WORK( ITAU ), WORK( IWRK ), 00486 $ LWORK-IWRK+1, IERR ) 00487 * 00488 IF( WANTVL ) THEN 00489 * 00490 * Want left eigenvectors 00491 * Copy Householder vectors to VL 00492 * 00493 SIDE = 'L' 00494 CALL ZLACPY( 'L', N, N, A, LDA, VL, LDVL ) 00495 * 00496 * Generate unitary matrix in VL 00497 * (CWorkspace: need 2*N-1, prefer N+(N-1)*NB) 00498 * (RWorkspace: none) 00499 * 00500 CALL ZUNGHR( N, ILO, IHI, VL, LDVL, WORK( ITAU ), WORK( IWRK ), 00501 $ LWORK-IWRK+1, IERR ) 00502 * 00503 * Perform QR iteration, accumulating Schur vectors in VL 00504 * (CWorkspace: need 1, prefer HSWORK (see comments) ) 00505 * (RWorkspace: none) 00506 * 00507 IWRK = ITAU 00508 CALL ZHSEQR( 'S', 'V', N, ILO, IHI, A, LDA, W, VL, LDVL, 00509 $ WORK( IWRK ), LWORK-IWRK+1, INFO ) 00510 * 00511 IF( WANTVR ) THEN 00512 * 00513 * Want left and right eigenvectors 00514 * Copy Schur vectors to VR 00515 * 00516 SIDE = 'B' 00517 CALL ZLACPY( 'F', N, N, VL, LDVL, VR, LDVR ) 00518 END IF 00519 * 00520 ELSE IF( WANTVR ) THEN 00521 * 00522 * Want right eigenvectors 00523 * Copy Householder vectors to VR 00524 * 00525 SIDE = 'R' 00526 CALL ZLACPY( 'L', N, N, A, LDA, VR, LDVR ) 00527 * 00528 * Generate unitary matrix in VR 00529 * (CWorkspace: need 2*N-1, prefer N+(N-1)*NB) 00530 * (RWorkspace: none) 00531 * 00532 CALL ZUNGHR( N, ILO, IHI, VR, LDVR, WORK( ITAU ), WORK( IWRK ), 00533 $ LWORK-IWRK+1, IERR ) 00534 * 00535 * Perform QR iteration, accumulating Schur vectors in VR 00536 * (CWorkspace: need 1, prefer HSWORK (see comments) ) 00537 * (RWorkspace: none) 00538 * 00539 IWRK = ITAU 00540 CALL ZHSEQR( 'S', 'V', N, ILO, IHI, A, LDA, W, VR, LDVR, 00541 $ WORK( IWRK ), LWORK-IWRK+1, INFO ) 00542 * 00543 ELSE 00544 * 00545 * Compute eigenvalues only 00546 * If condition numbers desired, compute Schur form 00547 * 00548 IF( WNTSNN ) THEN 00549 JOB = 'E' 00550 ELSE 00551 JOB = 'S' 00552 END IF 00553 * 00554 * (CWorkspace: need 1, prefer HSWORK (see comments) ) 00555 * (RWorkspace: none) 00556 * 00557 IWRK = ITAU 00558 CALL ZHSEQR( JOB, 'N', N, ILO, IHI, A, LDA, W, VR, LDVR, 00559 $ WORK( IWRK ), LWORK-IWRK+1, INFO ) 00560 END IF 00561 * 00562 * If INFO > 0 from ZHSEQR, then quit 00563 * 00564 IF( INFO.GT.0 ) 00565 $ GO TO 50 00566 * 00567 IF( WANTVL .OR. WANTVR ) THEN 00568 * 00569 * Compute left and/or right eigenvectors 00570 * (CWorkspace: need 2*N) 00571 * (RWorkspace: need N) 00572 * 00573 CALL ZTREVC( SIDE, 'B', SELECT, N, A, LDA, VL, LDVL, VR, LDVR, 00574 $ N, NOUT, WORK( IWRK ), RWORK, IERR ) 00575 END IF 00576 * 00577 * Compute condition numbers if desired 00578 * (CWorkspace: need N*N+2*N unless SENSE = 'E') 00579 * (RWorkspace: need 2*N unless SENSE = 'E') 00580 * 00581 IF( .NOT.WNTSNN ) THEN 00582 CALL ZTRSNA( SENSE, 'A', SELECT, N, A, LDA, VL, LDVL, VR, LDVR, 00583 $ RCONDE, RCONDV, N, NOUT, WORK( IWRK ), N, RWORK, 00584 $ ICOND ) 00585 END IF 00586 * 00587 IF( WANTVL ) THEN 00588 * 00589 * Undo balancing of left eigenvectors 00590 * 00591 CALL ZGEBAK( BALANC, 'L', N, ILO, IHI, SCALE, N, VL, LDVL, 00592 $ IERR ) 00593 * 00594 * Normalize left eigenvectors and make largest component real 00595 * 00596 DO 20 I = 1, N 00597 SCL = ONE / DZNRM2( N, VL( 1, I ), 1 ) 00598 CALL ZDSCAL( N, SCL, VL( 1, I ), 1 ) 00599 DO 10 K = 1, N 00600 RWORK( K ) = DBLE( VL( K, I ) )**2 + 00601 $ DIMAG( VL( K, I ) )**2 00602 10 CONTINUE 00603 K = IDAMAX( N, RWORK, 1 ) 00604 TMP = DCONJG( VL( K, I ) ) / SQRT( RWORK( K ) ) 00605 CALL ZSCAL( N, TMP, VL( 1, I ), 1 ) 00606 VL( K, I ) = DCMPLX( DBLE( VL( K, I ) ), ZERO ) 00607 20 CONTINUE 00608 END IF 00609 * 00610 IF( WANTVR ) THEN 00611 * 00612 * Undo balancing of right eigenvectors 00613 * 00614 CALL ZGEBAK( BALANC, 'R', N, ILO, IHI, SCALE, N, VR, LDVR, 00615 $ IERR ) 00616 * 00617 * Normalize right eigenvectors and make largest component real 00618 * 00619 DO 40 I = 1, N 00620 SCL = ONE / DZNRM2( N, VR( 1, I ), 1 ) 00621 CALL ZDSCAL( N, SCL, VR( 1, I ), 1 ) 00622 DO 30 K = 1, N 00623 RWORK( K ) = DBLE( VR( K, I ) )**2 + 00624 $ DIMAG( VR( K, I ) )**2 00625 30 CONTINUE 00626 K = IDAMAX( N, RWORK, 1 ) 00627 TMP = DCONJG( VR( K, I ) ) / SQRT( RWORK( K ) ) 00628 CALL ZSCAL( N, TMP, VR( 1, I ), 1 ) 00629 VR( K, I ) = DCMPLX( DBLE( VR( K, I ) ), ZERO ) 00630 40 CONTINUE 00631 END IF 00632 * 00633 * Undo scaling if necessary 00634 * 00635 50 CONTINUE 00636 IF( SCALEA ) THEN 00637 CALL ZLASCL( 'G', 0, 0, CSCALE, ANRM, N-INFO, 1, W( INFO+1 ), 00638 $ MAX( N-INFO, 1 ), IERR ) 00639 IF( INFO.EQ.0 ) THEN 00640 IF( ( WNTSNV .OR. WNTSNB ) .AND. ICOND.EQ.0 ) 00641 $ CALL DLASCL( 'G', 0, 0, CSCALE, ANRM, N, 1, RCONDV, N, 00642 $ IERR ) 00643 ELSE 00644 CALL ZLASCL( 'G', 0, 0, CSCALE, ANRM, ILO-1, 1, W, N, IERR ) 00645 END IF 00646 END IF 00647 * 00648 WORK( 1 ) = MAXWRK 00649 RETURN 00650 * 00651 * End of ZGEEVX 00652 * 00653 END