177 SUBROUTINE zgeev( JOBVL, JOBVR, N, A, LDA, W, VL, LDVL, VR, LDVR,
178 $ work, lwork, rwork, info )
186 CHARACTER JOBVL, JOBVR
187 INTEGER INFO, LDA, LDVL, LDVR, LWORK, N
190 DOUBLE PRECISION RWORK( * )
191 COMPLEX*16 A( lda, * ), VL( ldvl, * ), VR( ldvr, * ),
198 DOUBLE PRECISION ZERO, ONE
199 parameter( zero = 0.0d0, one = 1.0d0 )
202 LOGICAL LQUERY, SCALEA, WANTVL, WANTVR
204 INTEGER HSWORK, I, IBAL, IERR, IHI, ILO, IRWORK, ITAU,
205 $ iwrk, k, maxwrk, minwrk, nout
206 DOUBLE PRECISION ANRM, BIGNUM, CSCALE, EPS, SCL, SMLNUM
211 DOUBLE PRECISION DUM( 1 )
219 INTEGER IDAMAX, ILAENV
220 DOUBLE PRECISION DLAMCH, DZNRM2, ZLANGE
221 EXTERNAL lsame, idamax, ilaenv, dlamch, dznrm2, zlange
224 INTRINSIC dble, dcmplx, dconjg, dimag, max, sqrt
231 lquery = ( lwork.EQ.-1 )
232 wantvl = lsame( jobvl,
'V' )
233 wantvr = lsame( jobvr,
'V' )
234 IF( ( .NOT.wantvl ) .AND. ( .NOT.lsame( jobvl,
'N' ) ) )
THEN
236 ELSE IF( ( .NOT.wantvr ) .AND. ( .NOT.lsame( jobvr,
'N' ) ) )
THEN
238 ELSE IF( n.LT.0 )
THEN
240 ELSE IF( lda.LT.max( 1, n ) )
THEN
242 ELSE IF( ldvl.LT.1 .OR. ( wantvl .AND. ldvl.LT.n ) )
THEN
244 ELSE IF( ldvr.LT.1 .OR. ( wantvr .AND. ldvr.LT.n ) )
THEN
264 maxwrk = n + n*ilaenv( 1,
'ZGEHRD',
' ', n, 1, n, 0 )
267 maxwrk = max( maxwrk, n + ( n - 1 )*ilaenv( 1,
'ZUNGHR',
268 $
' ', n, 1, n, -1 ) )
269 CALL
zhseqr(
'S',
'V', n, 1, n, a, lda, w, vl, ldvl,
271 ELSE IF( wantvr )
THEN
272 maxwrk = max( maxwrk, n + ( n - 1 )*ilaenv( 1,
'ZUNGHR',
273 $
' ', n, 1, n, -1 ) )
274 CALL
zhseqr(
'S',
'V', n, 1, n, a, lda, w, vr, ldvr,
277 CALL
zhseqr(
'E',
'N', n, 1, n, a, lda, w, vr, ldvr,
281 maxwrk = max( maxwrk, hswork, minwrk )
285 IF( lwork.LT.minwrk .AND. .NOT.lquery )
THEN
291 CALL
xerbla(
'ZGEEV ', -info )
293 ELSE IF( lquery )
THEN
305 smlnum = dlamch(
'S' )
306 bignum = one / smlnum
307 CALL
dlabad( smlnum, bignum )
308 smlnum = sqrt( smlnum ) / eps
309 bignum = one / smlnum
313 anrm = zlange(
'M', n, n, a, lda, dum )
315 IF( anrm.GT.zero .AND. anrm.LT.smlnum )
THEN
318 ELSE IF( anrm.GT.bignum )
THEN
323 $ CALL
zlascl(
'G', 0, 0, anrm, cscale, n, n, a, lda, ierr )
330 CALL
zgebal(
'B', n, a, lda, ilo, ihi, rwork( ibal ), ierr )
338 CALL
zgehrd( n, ilo, ihi, a, lda, work( itau ), work( iwrk ),
339 $ lwork-iwrk+1, ierr )
347 CALL
zlacpy(
'L', n, n, a, lda, vl, ldvl )
353 CALL
zunghr( n, ilo, ihi, vl, ldvl, work( itau ), work( iwrk ),
354 $ lwork-iwrk+1, ierr )
361 CALL
zhseqr(
'S',
'V', n, ilo, ihi, a, lda, w, vl, ldvl,
362 $ work( iwrk ), lwork-iwrk+1, info )
370 CALL
zlacpy(
'F', n, n, vl, ldvl, vr, ldvr )
373 ELSE IF( wantvr )
THEN
379 CALL
zlacpy(
'L', n, n, a, lda, vr, ldvr )
385 CALL
zunghr( n, ilo, ihi, vr, ldvr, work( itau ), work( iwrk ),
386 $ lwork-iwrk+1, ierr )
393 CALL
zhseqr(
'S',
'V', n, ilo, ihi, a, lda, w, vr, ldvr,
394 $ work( iwrk ), lwork-iwrk+1, info )
403 CALL
zhseqr(
'E',
'N', n, ilo, ihi, a, lda, w, vr, ldvr,
404 $ work( iwrk ), lwork-iwrk+1, info )
412 IF( wantvl .OR. wantvr )
THEN
419 CALL
ztrevc( side,
'B',
SELECT, n, a, lda, vl, ldvl, vr, ldvr,
420 $ n, nout, work( iwrk ), rwork( irwork ), ierr )
429 CALL
zgebak(
'B',
'L', n, ilo, ihi, rwork( ibal ), n, vl, ldvl,
435 scl = one / dznrm2( n, vl( 1, i ), 1 )
436 CALL
zdscal( n, scl, vl( 1, i ), 1 )
438 rwork( irwork+k-1 ) = dble( vl( k, i ) )**2 +
439 $ dimag( vl( k, i ) )**2
441 k = idamax( n, rwork( irwork ), 1 )
442 tmp = dconjg( vl( k, i ) ) / sqrt( rwork( irwork+k-1 ) )
443 CALL
zscal( n, tmp, vl( 1, i ), 1 )
444 vl( k, i ) = dcmplx( dble( vl( k, i ) ), zero )
454 CALL
zgebak(
'B',
'R', n, ilo, ihi, rwork( ibal ), n, vr, ldvr,
460 scl = one / dznrm2( n, vr( 1, i ), 1 )
461 CALL
zdscal( n, scl, vr( 1, i ), 1 )
463 rwork( irwork+k-1 ) = dble( vr( k, i ) )**2 +
464 $ dimag( vr( k, i ) )**2
466 k = idamax( n, rwork( irwork ), 1 )
467 tmp = dconjg( vr( k, i ) ) / sqrt( rwork( irwork+k-1 ) )
468 CALL
zscal( n, tmp, vr( 1, i ), 1 )
469 vr( k, i ) = dcmplx( dble( vr( k, i ) ), zero )
477 CALL
zlascl(
'G', 0, 0, cscale, anrm, n-info, 1, w( info+1 ),
478 $ max( n-info, 1 ), ierr )
480 CALL
zlascl(
'G', 0, 0, cscale, anrm, ilo-1, 1, w, n, ierr )
subroutine zgebal(JOB, N, A, LDA, ILO, IHI, SCALE, INFO)
ZGEBAL
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine zdscal(N, DA, ZX, INCX)
ZDSCAL
subroutine ztrevc(SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, LDVR, MM, M, WORK, RWORK, INFO)
ZTREVC
subroutine zhseqr(JOB, COMPZ, N, ILO, IHI, H, LDH, W, Z, LDZ, WORK, LWORK, INFO)
ZHSEQR
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine zgehrd(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
ZGEHRD
subroutine dlabad(SMALL, LARGE)
DLABAD
subroutine zunghr(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
ZUNGHR
subroutine zgeev(JOBVL, JOBVR, N, A, LDA, W, VL, LDVL, VR, LDVR, WORK, LWORK, RWORK, INFO)
ZGEEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices ...
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.
subroutine zgebak(JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV, INFO)
ZGEBAK
subroutine zscal(N, ZA, ZX, INCX)
ZSCAL