 LAPACK  3.10.0 LAPACK: Linear Algebra PACKage

◆ zgeev()

 subroutine zgeev ( character JOBVL, character JOBVR, integer N, complex*16, dimension( lda, * ) A, integer LDA, complex*16, dimension( * ) W, complex*16, dimension( ldvl, * ) VL, integer LDVL, complex*16, dimension( ldvr, * ) VR, integer LDVR, complex*16, dimension( * ) WORK, integer LWORK, double precision, dimension( * ) RWORK, integer INFO )

ZGEEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices

Purpose:
ZGEEV computes for an N-by-N complex nonsymmetric matrix A, the
eigenvalues and, optionally, the left and/or right eigenvectors.

The right eigenvector v(j) of A satisfies
A * v(j) = lambda(j) * v(j)
where lambda(j) is its eigenvalue.
The left eigenvector u(j) of A satisfies
u(j)**H * A = lambda(j) * u(j)**H
where u(j)**H denotes the conjugate transpose of u(j).

The computed eigenvectors are normalized to have Euclidean norm
equal to 1 and largest component real.
Parameters
 [in] JOBVL JOBVL is CHARACTER*1 = 'N': left eigenvectors of A are not computed; = 'V': left eigenvectors of are computed. [in] JOBVR JOBVR is CHARACTER*1 = 'N': right eigenvectors of A are not computed; = 'V': right eigenvectors of A are computed. [in] N N is INTEGER The order of the matrix A. N >= 0. [in,out] A A is COMPLEX*16 array, dimension (LDA,N) On entry, the N-by-N matrix A. On exit, A has been overwritten. [in] LDA LDA is INTEGER The leading dimension of the array A. LDA >= max(1,N). [out] W W is COMPLEX*16 array, dimension (N) W contains the computed eigenvalues. [out] VL VL is COMPLEX*16 array, dimension (LDVL,N) If JOBVL = 'V', the left eigenvectors u(j) are stored one after another in the columns of VL, in the same order as their eigenvalues. If JOBVL = 'N', VL is not referenced. u(j) = VL(:,j), the j-th column of VL. [in] LDVL LDVL is INTEGER The leading dimension of the array VL. LDVL >= 1; if JOBVL = 'V', LDVL >= N. [out] VR VR is COMPLEX*16 array, dimension (LDVR,N) If JOBVR = 'V', the right eigenvectors v(j) are stored one after another in the columns of VR, in the same order as their eigenvalues. If JOBVR = 'N', VR is not referenced. v(j) = VR(:,j), the j-th column of VR. [in] LDVR LDVR is INTEGER The leading dimension of the array VR. LDVR >= 1; if JOBVR = 'V', LDVR >= N. [out] WORK WORK is COMPLEX*16 array, dimension (MAX(1,LWORK)) On exit, if INFO = 0, WORK(1) returns the optimal LWORK. [in] LWORK LWORK is INTEGER The dimension of the array WORK. LWORK >= max(1,2*N). For good performance, LWORK must generally be larger. If LWORK = -1, then a workspace query is assumed; the routine only calculates the optimal size of the WORK array, returns this value as the first entry of the WORK array, and no error message related to LWORK is issued by XERBLA. [out] RWORK RWORK is DOUBLE PRECISION array, dimension (2*N) [out] INFO INFO is INTEGER = 0: successful exit < 0: if INFO = -i, the i-th argument had an illegal value. > 0: if INFO = i, the QR algorithm failed to compute all the eigenvalues, and no eigenvectors have been computed; elements i+1:N of W contain eigenvalues which have converged.

Definition at line 178 of file zgeev.f.

180  implicit none
181 *
182 * -- LAPACK driver routine --
183 * -- LAPACK is a software package provided by Univ. of Tennessee, --
184 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
185 *
186 * .. Scalar Arguments ..
187  CHARACTER JOBVL, JOBVR
188  INTEGER INFO, LDA, LDVL, LDVR, LWORK, N
189 * ..
190 * .. Array Arguments ..
191  DOUBLE PRECISION RWORK( * )
192  COMPLEX*16 A( LDA, * ), VL( LDVL, * ), VR( LDVR, * ),
193  \$ W( * ), WORK( * )
194 * ..
195 *
196 * =====================================================================
197 *
198 * .. Parameters ..
199  DOUBLE PRECISION ZERO, ONE
200  parameter( zero = 0.0d0, one = 1.0d0 )
201 * ..
202 * .. Local Scalars ..
203  LOGICAL LQUERY, SCALEA, WANTVL, WANTVR
204  CHARACTER SIDE
205  INTEGER HSWORK, I, IBAL, IERR, IHI, ILO, IRWORK, ITAU,
206  \$ IWRK, K, LWORK_TREVC, MAXWRK, MINWRK, NOUT
207  DOUBLE PRECISION ANRM, BIGNUM, CSCALE, EPS, SCL, SMLNUM
208  COMPLEX*16 TMP
209 * ..
210 * .. Local Arrays ..
211  LOGICAL SELECT( 1 )
212  DOUBLE PRECISION DUM( 1 )
213 * ..
214 * .. External Subroutines ..
215  EXTERNAL dlabad, xerbla, zdscal, zgebak, zgebal, zgehrd,
217 * ..
218 * .. External Functions ..
219  LOGICAL LSAME
220  INTEGER IDAMAX, ILAENV
221  DOUBLE PRECISION DLAMCH, DZNRM2, ZLANGE
222  EXTERNAL lsame, idamax, ilaenv, dlamch, dznrm2, zlange
223 * ..
224 * .. Intrinsic Functions ..
225  INTRINSIC dble, dcmplx, conjg, aimag, max, sqrt
226 * ..
227 * .. Executable Statements ..
228 *
229 * Test the input arguments
230 *
231  info = 0
232  lquery = ( lwork.EQ.-1 )
233  wantvl = lsame( jobvl, 'V' )
234  wantvr = lsame( jobvr, 'V' )
235  IF( ( .NOT.wantvl ) .AND. ( .NOT.lsame( jobvl, 'N' ) ) ) THEN
236  info = -1
237  ELSE IF( ( .NOT.wantvr ) .AND. ( .NOT.lsame( jobvr, 'N' ) ) ) THEN
238  info = -2
239  ELSE IF( n.LT.0 ) THEN
240  info = -3
241  ELSE IF( lda.LT.max( 1, n ) ) THEN
242  info = -5
243  ELSE IF( ldvl.LT.1 .OR. ( wantvl .AND. ldvl.LT.n ) ) THEN
244  info = -8
245  ELSE IF( ldvr.LT.1 .OR. ( wantvr .AND. ldvr.LT.n ) ) THEN
246  info = -10
247  END IF
248 *
249 * Compute workspace
250 * (Note: Comments in the code beginning "Workspace:" describe the
251 * minimal amount of workspace needed at that point in the code,
252 * as well as the preferred amount for good performance.
253 * CWorkspace refers to complex workspace, and RWorkspace to real
254 * workspace. NB refers to the optimal block size for the
255 * immediately following subroutine, as returned by ILAENV.
256 * HSWORK refers to the workspace preferred by ZHSEQR, as
257 * calculated below. HSWORK is computed assuming ILO=1 and IHI=N,
258 * the worst case.)
259 *
260  IF( info.EQ.0 ) THEN
261  IF( n.EQ.0 ) THEN
262  minwrk = 1
263  maxwrk = 1
264  ELSE
265  maxwrk = n + n*ilaenv( 1, 'ZGEHRD', ' ', n, 1, n, 0 )
266  minwrk = 2*n
267  IF( wantvl ) THEN
268  maxwrk = max( maxwrk, n + ( n - 1 )*ilaenv( 1, 'ZUNGHR',
269  \$ ' ', n, 1, n, -1 ) )
270  CALL ztrevc3( 'L', 'B', SELECT, n, a, lda,
271  \$ vl, ldvl, vr, ldvr,
272  \$ n, nout, work, -1, rwork, -1, ierr )
273  lwork_trevc = int( work(1) )
274  maxwrk = max( maxwrk, n + lwork_trevc )
275  CALL zhseqr( 'S', 'V', n, 1, n, a, lda, w, vl, ldvl,
276  \$ work, -1, info )
277  ELSE IF( wantvr ) THEN
278  maxwrk = max( maxwrk, n + ( n - 1 )*ilaenv( 1, 'ZUNGHR',
279  \$ ' ', n, 1, n, -1 ) )
280  CALL ztrevc3( 'R', 'B', SELECT, n, a, lda,
281  \$ vl, ldvl, vr, ldvr,
282  \$ n, nout, work, -1, rwork, -1, ierr )
283  lwork_trevc = int( work(1) )
284  maxwrk = max( maxwrk, n + lwork_trevc )
285  CALL zhseqr( 'S', 'V', n, 1, n, a, lda, w, vr, ldvr,
286  \$ work, -1, info )
287  ELSE
288  CALL zhseqr( 'E', 'N', n, 1, n, a, lda, w, vr, ldvr,
289  \$ work, -1, info )
290  END IF
291  hswork = int( work(1) )
292  maxwrk = max( maxwrk, hswork, minwrk )
293  END IF
294  work( 1 ) = maxwrk
295 *
296  IF( lwork.LT.minwrk .AND. .NOT.lquery ) THEN
297  info = -12
298  END IF
299  END IF
300 *
301  IF( info.NE.0 ) THEN
302  CALL xerbla( 'ZGEEV ', -info )
303  RETURN
304  ELSE IF( lquery ) THEN
305  RETURN
306  END IF
307 *
308 * Quick return if possible
309 *
310  IF( n.EQ.0 )
311  \$ RETURN
312 *
313 * Get machine constants
314 *
315  eps = dlamch( 'P' )
316  smlnum = dlamch( 'S' )
317  bignum = one / smlnum
318  CALL dlabad( smlnum, bignum )
319  smlnum = sqrt( smlnum ) / eps
320  bignum = one / smlnum
321 *
322 * Scale A if max element outside range [SMLNUM,BIGNUM]
323 *
324  anrm = zlange( 'M', n, n, a, lda, dum )
325  scalea = .false.
326  IF( anrm.GT.zero .AND. anrm.LT.smlnum ) THEN
327  scalea = .true.
328  cscale = smlnum
329  ELSE IF( anrm.GT.bignum ) THEN
330  scalea = .true.
331  cscale = bignum
332  END IF
333  IF( scalea )
334  \$ CALL zlascl( 'G', 0, 0, anrm, cscale, n, n, a, lda, ierr )
335 *
336 * Balance the matrix
337 * (CWorkspace: none)
338 * (RWorkspace: need N)
339 *
340  ibal = 1
341  CALL zgebal( 'B', n, a, lda, ilo, ihi, rwork( ibal ), ierr )
342 *
343 * Reduce to upper Hessenberg form
344 * (CWorkspace: need 2*N, prefer N+N*NB)
345 * (RWorkspace: none)
346 *
347  itau = 1
348  iwrk = itau + n
349  CALL zgehrd( n, ilo, ihi, a, lda, work( itau ), work( iwrk ),
350  \$ lwork-iwrk+1, ierr )
351 *
352  IF( wantvl ) THEN
353 *
354 * Want left eigenvectors
355 * Copy Householder vectors to VL
356 *
357  side = 'L'
358  CALL zlacpy( 'L', n, n, a, lda, vl, ldvl )
359 *
360 * Generate unitary matrix in VL
361 * (CWorkspace: need 2*N-1, prefer N+(N-1)*NB)
362 * (RWorkspace: none)
363 *
364  CALL zunghr( n, ilo, ihi, vl, ldvl, work( itau ), work( iwrk ),
365  \$ lwork-iwrk+1, ierr )
366 *
367 * Perform QR iteration, accumulating Schur vectors in VL
368 * (CWorkspace: need 1, prefer HSWORK (see comments) )
369 * (RWorkspace: none)
370 *
371  iwrk = itau
372  CALL zhseqr( 'S', 'V', n, ilo, ihi, a, lda, w, vl, ldvl,
373  \$ work( iwrk ), lwork-iwrk+1, info )
374 *
375  IF( wantvr ) THEN
376 *
377 * Want left and right eigenvectors
378 * Copy Schur vectors to VR
379 *
380  side = 'B'
381  CALL zlacpy( 'F', n, n, vl, ldvl, vr, ldvr )
382  END IF
383 *
384  ELSE IF( wantvr ) THEN
385 *
386 * Want right eigenvectors
387 * Copy Householder vectors to VR
388 *
389  side = 'R'
390  CALL zlacpy( 'L', n, n, a, lda, vr, ldvr )
391 *
392 * Generate unitary matrix in VR
393 * (CWorkspace: need 2*N-1, prefer N+(N-1)*NB)
394 * (RWorkspace: none)
395 *
396  CALL zunghr( n, ilo, ihi, vr, ldvr, work( itau ), work( iwrk ),
397  \$ lwork-iwrk+1, ierr )
398 *
399 * Perform QR iteration, accumulating Schur vectors in VR
400 * (CWorkspace: need 1, prefer HSWORK (see comments) )
401 * (RWorkspace: none)
402 *
403  iwrk = itau
404  CALL zhseqr( 'S', 'V', n, ilo, ihi, a, lda, w, vr, ldvr,
405  \$ work( iwrk ), lwork-iwrk+1, info )
406 *
407  ELSE
408 *
409 * Compute eigenvalues only
410 * (CWorkspace: need 1, prefer HSWORK (see comments) )
411 * (RWorkspace: none)
412 *
413  iwrk = itau
414  CALL zhseqr( 'E', 'N', n, ilo, ihi, a, lda, w, vr, ldvr,
415  \$ work( iwrk ), lwork-iwrk+1, info )
416  END IF
417 *
418 * If INFO .NE. 0 from ZHSEQR, then quit
419 *
420  IF( info.NE.0 )
421  \$ GO TO 50
422 *
423  IF( wantvl .OR. wantvr ) THEN
424 *
425 * Compute left and/or right eigenvectors
426 * (CWorkspace: need 2*N, prefer N + 2*N*NB)
427 * (RWorkspace: need 2*N)
428 *
429  irwork = ibal + n
430  CALL ztrevc3( side, 'B', SELECT, n, a, lda, vl, ldvl, vr, ldvr,
431  \$ n, nout, work( iwrk ), lwork-iwrk+1,
432  \$ rwork( irwork ), n, ierr )
433  END IF
434 *
435  IF( wantvl ) THEN
436 *
437 * Undo balancing of left eigenvectors
438 * (CWorkspace: none)
439 * (RWorkspace: need N)
440 *
441  CALL zgebak( 'B', 'L', n, ilo, ihi, rwork( ibal ), n, vl, ldvl,
442  \$ ierr )
443 *
444 * Normalize left eigenvectors and make largest component real
445 *
446  DO 20 i = 1, n
447  scl = one / dznrm2( n, vl( 1, i ), 1 )
448  CALL zdscal( n, scl, vl( 1, i ), 1 )
449  DO 10 k = 1, n
450  rwork( irwork+k-1 ) = dble( vl( k, i ) )**2 +
451  \$ aimag( vl( k, i ) )**2
452  10 CONTINUE
453  k = idamax( n, rwork( irwork ), 1 )
454  tmp = conjg( vl( k, i ) ) / sqrt( rwork( irwork+k-1 ) )
455  CALL zscal( n, tmp, vl( 1, i ), 1 )
456  vl( k, i ) = dcmplx( dble( vl( k, i ) ), zero )
457  20 CONTINUE
458  END IF
459 *
460  IF( wantvr ) THEN
461 *
462 * Undo balancing of right eigenvectors
463 * (CWorkspace: none)
464 * (RWorkspace: need N)
465 *
466  CALL zgebak( 'B', 'R', n, ilo, ihi, rwork( ibal ), n, vr, ldvr,
467  \$ ierr )
468 *
469 * Normalize right eigenvectors and make largest component real
470 *
471  DO 40 i = 1, n
472  scl = one / dznrm2( n, vr( 1, i ), 1 )
473  CALL zdscal( n, scl, vr( 1, i ), 1 )
474  DO 30 k = 1, n
475  rwork( irwork+k-1 ) = dble( vr( k, i ) )**2 +
476  \$ aimag( vr( k, i ) )**2
477  30 CONTINUE
478  k = idamax( n, rwork( irwork ), 1 )
479  tmp = conjg( vr( k, i ) ) / sqrt( rwork( irwork+k-1 ) )
480  CALL zscal( n, tmp, vr( 1, i ), 1 )
481  vr( k, i ) = dcmplx( dble( vr( k, i ) ), zero )
482  40 CONTINUE
483  END IF
484 *
485 * Undo scaling if necessary
486 *
487  50 CONTINUE
488  IF( scalea ) THEN
489  CALL zlascl( 'G', 0, 0, cscale, anrm, n-info, 1, w( info+1 ),
490  \$ max( n-info, 1 ), ierr )
491  IF( info.GT.0 ) THEN
492  CALL zlascl( 'G', 0, 0, cscale, anrm, ilo-1, 1, w, n, ierr )
493  END IF
494  END IF
495 *
496  work( 1 ) = maxwrk
497  RETURN
498 *
499 * End of ZGEEV
500 *
double precision function dlamch(CMACH)
DLAMCH
Definition: dlamch.f:69
integer function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
ILAENV
Definition: ilaenv.f:162
integer function idamax(N, DX, INCX)
IDAMAX
Definition: idamax.f:71
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:53
subroutine zdscal(N, DA, ZX, INCX)
ZDSCAL
Definition: zdscal.f:78
subroutine zscal(N, ZA, ZX, INCX)
ZSCAL
Definition: zscal.f:78
double precision function zlange(NORM, M, N, A, LDA, WORK)
ZLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition: zlange.f:115
subroutine zgebal(JOB, N, A, LDA, ILO, IHI, SCALE, INFO)
ZGEBAL
Definition: zgebal.f:162
subroutine zgehrd(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
ZGEHRD
Definition: zgehrd.f:167
subroutine zgebak(JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV, INFO)
ZGEBAK
Definition: zgebak.f:131
subroutine zlascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
ZLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
Definition: zlascl.f:143
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
Definition: zlacpy.f:103
subroutine zhseqr(JOB, COMPZ, N, ILO, IHI, H, LDH, W, Z, LDZ, WORK, LWORK, INFO)
ZHSEQR
Definition: zhseqr.f:299
subroutine ztrevc3(SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, LDVR, MM, M, WORK, LWORK, RWORK, LRWORK, INFO)
ZTREVC3
Definition: ztrevc3.f:244
subroutine zunghr(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
ZUNGHR
Definition: zunghr.f:126
real(wp) function dznrm2(n, x, incx)
DZNRM2
Definition: dznrm2.f90:90
Here is the call graph for this function:
Here is the caller graph for this function: