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