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