LAPACK 3.11.0 LAPACK: Linear Algebra PACKage
Searching...
No Matches

## ◆ zlaein()

 subroutine zlaein ( logical RIGHTV, logical NOINIT, integer N, complex*16, dimension( ldh, * ) H, integer LDH, complex*16 W, complex*16, dimension( * ) V, complex*16, dimension( ldb, * ) B, integer LDB, double precision, dimension( * ) RWORK, double precision EPS3, double precision SMLNUM, integer INFO )

ZLAEIN computes a specified right or left eigenvector of an upper Hessenberg matrix by inverse iteration.

Purpose:
``` ZLAEIN uses inverse iteration to find a right or left eigenvector
corresponding to the eigenvalue W of a complex upper Hessenberg
matrix H.```
Parameters
 [in] RIGHTV ``` RIGHTV is LOGICAL = .TRUE. : compute right eigenvector; = .FALSE.: compute left eigenvector.``` [in] NOINIT ``` NOINIT is LOGICAL = .TRUE. : no initial vector supplied in V = .FALSE.: initial vector supplied in V.``` [in] N ``` N is INTEGER The order of the matrix H. N >= 0.``` [in] H ``` H is COMPLEX*16 array, dimension (LDH,N) The upper Hessenberg matrix H.``` [in] LDH ``` LDH is INTEGER The leading dimension of the array H. LDH >= max(1,N).``` [in] W ``` W is COMPLEX*16 The eigenvalue of H whose corresponding right or left eigenvector is to be computed.``` [in,out] V ``` V is COMPLEX*16 array, dimension (N) On entry, if NOINIT = .FALSE., V must contain a starting vector for inverse iteration; otherwise V need not be set. On exit, V contains the computed eigenvector, normalized so that the component of largest magnitude has magnitude 1; here the magnitude of a complex number (x,y) is taken to be |x| + |y|.``` [out] B ` B is COMPLEX*16 array, dimension (LDB,N)` [in] LDB ``` LDB is INTEGER The leading dimension of the array B. LDB >= max(1,N).``` [out] RWORK ` RWORK is DOUBLE PRECISION array, dimension (N)` [in] EPS3 ``` EPS3 is DOUBLE PRECISION A small machine-dependent value which is used to perturb close eigenvalues, and to replace zero pivots.``` [in] SMLNUM ``` SMLNUM is DOUBLE PRECISION A machine-dependent value close to the underflow threshold.``` [out] INFO ``` INFO is INTEGER = 0: successful exit = 1: inverse iteration did not converge; V is set to the last iterate.```

Definition at line 147 of file zlaein.f.

149*
150* -- LAPACK auxiliary routine --
151* -- LAPACK is a software package provided by Univ. of Tennessee, --
152* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
153*
154* .. Scalar Arguments ..
155 LOGICAL NOINIT, RIGHTV
156 INTEGER INFO, LDB, LDH, N
157 DOUBLE PRECISION EPS3, SMLNUM
158 COMPLEX*16 W
159* ..
160* .. Array Arguments ..
161 DOUBLE PRECISION RWORK( * )
162 COMPLEX*16 B( LDB, * ), H( LDH, * ), V( * )
163* ..
164*
165* =====================================================================
166*
167* .. Parameters ..
168 DOUBLE PRECISION ONE, TENTH
169 parameter( one = 1.0d+0, tenth = 1.0d-1 )
170 COMPLEX*16 ZERO
171 parameter( zero = ( 0.0d+0, 0.0d+0 ) )
172* ..
173* .. Local Scalars ..
174 CHARACTER NORMIN, TRANS
175 INTEGER I, IERR, ITS, J
176 DOUBLE PRECISION GROWTO, NRMSML, ROOTN, RTEMP, SCALE, VNORM
177 COMPLEX*16 CDUM, EI, EJ, TEMP, X
178* ..
179* .. External Functions ..
180 INTEGER IZAMAX
181 DOUBLE PRECISION DZASUM, DZNRM2
183 EXTERNAL izamax, dzasum, dznrm2, zladiv
184* ..
185* .. External Subroutines ..
186 EXTERNAL zdscal, zlatrs
187* ..
188* .. Intrinsic Functions ..
189 INTRINSIC abs, dble, dimag, max, sqrt
190* ..
191* .. Statement Functions ..
192 DOUBLE PRECISION CABS1
193* ..
194* .. Statement Function definitions ..
195 cabs1( cdum ) = abs( dble( cdum ) ) + abs( dimag( cdum ) )
196* ..
197* .. Executable Statements ..
198*
199 info = 0
200*
201* GROWTO is the threshold used in the acceptance test for an
202* eigenvector.
203*
204 rootn = sqrt( dble( n ) )
205 growto = tenth / rootn
206 nrmsml = max( one, eps3*rootn )*smlnum
207*
208* Form B = H - W*I (except that the subdiagonal elements are not
209* stored).
210*
211 DO 20 j = 1, n
212 DO 10 i = 1, j - 1
213 b( i, j ) = h( i, j )
214 10 CONTINUE
215 b( j, j ) = h( j, j ) - w
216 20 CONTINUE
217*
218 IF( noinit ) THEN
219*
220* Initialize V.
221*
222 DO 30 i = 1, n
223 v( i ) = eps3
224 30 CONTINUE
225 ELSE
226*
227* Scale supplied initial vector.
228*
229 vnorm = dznrm2( n, v, 1 )
230 CALL zdscal( n, ( eps3*rootn ) / max( vnorm, nrmsml ), v, 1 )
231 END IF
232*
233 IF( rightv ) THEN
234*
235* LU decomposition with partial pivoting of B, replacing zero
236* pivots by EPS3.
237*
238 DO 60 i = 1, n - 1
239 ei = h( i+1, i )
240 IF( cabs1( b( i, i ) ).LT.cabs1( ei ) ) THEN
241*
242* Interchange rows and eliminate.
243*
244 x = zladiv( b( i, i ), ei )
245 b( i, i ) = ei
246 DO 40 j = i + 1, n
247 temp = b( i+1, j )
248 b( i+1, j ) = b( i, j ) - x*temp
249 b( i, j ) = temp
250 40 CONTINUE
251 ELSE
252*
253* Eliminate without interchange.
254*
255 IF( b( i, i ).EQ.zero )
256 \$ b( i, i ) = eps3
257 x = zladiv( ei, b( i, i ) )
258 IF( x.NE.zero ) THEN
259 DO 50 j = i + 1, n
260 b( i+1, j ) = b( i+1, j ) - x*b( i, j )
261 50 CONTINUE
262 END IF
263 END IF
264 60 CONTINUE
265 IF( b( n, n ).EQ.zero )
266 \$ b( n, n ) = eps3
267*
268 trans = 'N'
269*
270 ELSE
271*
272* UL decomposition with partial pivoting of B, replacing zero
273* pivots by EPS3.
274*
275 DO 90 j = n, 2, -1
276 ej = h( j, j-1 )
277 IF( cabs1( b( j, j ) ).LT.cabs1( ej ) ) THEN
278*
279* Interchange columns and eliminate.
280*
281 x = zladiv( b( j, j ), ej )
282 b( j, j ) = ej
283 DO 70 i = 1, j - 1
284 temp = b( i, j-1 )
285 b( i, j-1 ) = b( i, j ) - x*temp
286 b( i, j ) = temp
287 70 CONTINUE
288 ELSE
289*
290* Eliminate without interchange.
291*
292 IF( b( j, j ).EQ.zero )
293 \$ b( j, j ) = eps3
294 x = zladiv( ej, b( j, j ) )
295 IF( x.NE.zero ) THEN
296 DO 80 i = 1, j - 1
297 b( i, j-1 ) = b( i, j-1 ) - x*b( i, j )
298 80 CONTINUE
299 END IF
300 END IF
301 90 CONTINUE
302 IF( b( 1, 1 ).EQ.zero )
303 \$ b( 1, 1 ) = eps3
304*
305 trans = 'C'
306*
307 END IF
308*
309 normin = 'N'
310 DO 110 its = 1, n
311*
312* Solve U*x = scale*v for a right eigenvector
313* or U**H *x = scale*v for a left eigenvector,
314* overwriting x on v.
315*
316 CALL zlatrs( 'Upper', trans, 'Nonunit', normin, n, b, ldb, v,
317 \$ scale, rwork, ierr )
318 normin = 'Y'
319*
320* Test for sufficient growth in the norm of v.
321*
322 vnorm = dzasum( n, v, 1 )
323 IF( vnorm.GE.growto*scale )
324 \$ GO TO 120
325*
326* Choose new orthogonal starting vector and try again.
327*
328 rtemp = eps3 / ( rootn+one )
329 v( 1 ) = eps3
330 DO 100 i = 2, n
331 v( i ) = rtemp
332 100 CONTINUE
333 v( n-its+1 ) = v( n-its+1 ) - eps3*rootn
334 110 CONTINUE
335*
336* Failure to find eigenvector in N iterations.
337*
338 info = 1
339*
340 120 CONTINUE
341*
342* Normalize eigenvector.
343*
344 i = izamax( n, v, 1 )
345 CALL zdscal( n, one / cabs1( v( i ) ), v, 1 )
346*
347 RETURN
348*
349* End of ZLAEIN
350*
integer function izamax(N, ZX, INCX)
IZAMAX
Definition: izamax.f:71
subroutine zdscal(N, DA, ZX, INCX)
ZDSCAL
Definition: zdscal.f:78
subroutine zlatrs(UPLO, TRANS, DIAG, NORMIN, N, A, LDA, X, SCALE, CNORM, INFO)
ZLATRS solves a triangular system of equations with the scale factor set to prevent overflow.
Definition: zlatrs.f:239