179 SUBROUTINE zgeev( JOBVL, JOBVR, N, A, LDA, W, VL, LDVL, VR, LDVR,
180 $ work, lwork, rwork, info )
189 CHARACTER JOBVL, JOBVR
190 INTEGER INFO, LDA, LDVL, LDVR, LWORK, N
193 DOUBLE PRECISION RWORK( * )
194 COMPLEX*16 A( lda, * ), VL( ldvl, * ), VR( ldvr, * ),
201 DOUBLE PRECISION ZERO, ONE
202 parameter ( zero = 0.0d0, one = 1.0d0 )
205 LOGICAL LQUERY, SCALEA, WANTVL, WANTVR
207 INTEGER HSWORK, I, IBAL, IERR, IHI, ILO, IRWORK, ITAU,
208 $ iwrk, k, lwork_trevc, maxwrk, minwrk, nout
209 DOUBLE PRECISION ANRM, BIGNUM, CSCALE, EPS, SCL, SMLNUM
214 DOUBLE PRECISION DUM( 1 )
222 INTEGER IDAMAX, ILAENV
223 DOUBLE PRECISION DLAMCH, DZNRM2, ZLANGE
224 EXTERNAL lsame, idamax, ilaenv, dlamch, dznrm2, zlange
227 INTRINSIC dble, dcmplx, conjg, aimag, max, sqrt
234 lquery = ( lwork.EQ.-1 )
235 wantvl = lsame( jobvl,
'V' )
236 wantvr = lsame( jobvr,
'V' )
237 IF( ( .NOT.wantvl ) .AND. ( .NOT.lsame( jobvl,
'N' ) ) )
THEN
239 ELSE IF( ( .NOT.wantvr ) .AND. ( .NOT.lsame( jobvr,
'N' ) ) )
THEN
241 ELSE IF( n.LT.0 )
THEN
243 ELSE IF( lda.LT.max( 1, n ) )
THEN
245 ELSE IF( ldvl.LT.1 .OR. ( wantvl .AND. ldvl.LT.n ) )
THEN
247 ELSE IF( ldvr.LT.1 .OR. ( wantvr .AND. ldvr.LT.n ) )
THEN
267 maxwrk = n + n*ilaenv( 1,
'ZGEHRD',
' ', n, 1, n, 0 )
270 maxwrk = max( maxwrk, n + ( n - 1 )*ilaenv( 1,
'ZUNGHR',
271 $
' ', n, 1, n, -1 ) )
272 CALL ztrevc3(
'L',
'B',
SELECT, n, a, lda,
273 $ vl, ldvl, vr, ldvr,
274 $ n, nout, work, -1, rwork, -1, ierr )
275 lwork_trevc = int( work(1) )
276 maxwrk = max( maxwrk, n + lwork_trevc )
277 CALL zhseqr(
'S',
'V', n, 1, n, a, lda, w, vl, ldvl,
279 ELSE IF( wantvr )
THEN
280 maxwrk = max( maxwrk, n + ( n - 1 )*ilaenv( 1,
'ZUNGHR',
281 $
' ', n, 1, n, -1 ) )
282 CALL ztrevc3(
'R',
'B',
SELECT, n, a, lda,
283 $ vl, ldvl, vr, ldvr,
284 $ n, nout, work, -1, rwork, -1, ierr )
285 lwork_trevc = int( work(1) )
286 maxwrk = max( maxwrk, n + lwork_trevc )
287 CALL zhseqr(
'S',
'V', n, 1, n, a, lda, w, vr, ldvr,
290 CALL zhseqr(
'E',
'N', n, 1, n, a, lda, w, vr, ldvr,
293 hswork = int( work(1) )
294 maxwrk = max( maxwrk, hswork, minwrk )
298 IF( lwork.LT.minwrk .AND. .NOT.lquery )
THEN
304 CALL xerbla(
'ZGEEV ', -info )
306 ELSE IF( lquery )
THEN
318 smlnum = dlamch(
'S' )
319 bignum = one / smlnum
320 CALL dlabad( smlnum, bignum )
321 smlnum = sqrt( smlnum ) / eps
322 bignum = one / smlnum
326 anrm = zlange(
'M', n, n, a, lda, dum )
328 IF( anrm.GT.zero .AND. anrm.LT.smlnum )
THEN
331 ELSE IF( anrm.GT.bignum )
THEN
336 $
CALL zlascl(
'G', 0, 0, anrm, cscale, n, n, a, lda, ierr )
343 CALL zgebal(
'B', n, a, lda, ilo, ihi, rwork( ibal ), ierr )
351 CALL zgehrd( n, ilo, ihi, a, lda, work( itau ), work( iwrk ),
352 $ lwork-iwrk+1, ierr )
360 CALL zlacpy(
'L', n, n, a, lda, vl, ldvl )
366 CALL zunghr( n, ilo, ihi, vl, ldvl, work( itau ), work( iwrk ),
367 $ lwork-iwrk+1, ierr )
374 CALL zhseqr(
'S',
'V', n, ilo, ihi, a, lda, w, vl, ldvl,
375 $ work( iwrk ), lwork-iwrk+1, info )
383 CALL zlacpy(
'F', n, n, vl, ldvl, vr, ldvr )
386 ELSE IF( wantvr )
THEN
392 CALL zlacpy(
'L', n, n, a, lda, vr, ldvr )
398 CALL zunghr( n, ilo, ihi, vr, ldvr, work( itau ), work( iwrk ),
399 $ lwork-iwrk+1, ierr )
406 CALL zhseqr(
'S',
'V', n, ilo, ihi, a, lda, w, vr, ldvr,
407 $ work( iwrk ), lwork-iwrk+1, info )
416 CALL zhseqr(
'E',
'N', n, ilo, ihi, a, lda, w, vr, ldvr,
417 $ work( iwrk ), lwork-iwrk+1, info )
425 IF( wantvl .OR. wantvr )
THEN
432 CALL ztrevc3( side,
'B',
SELECT, n, a, lda, vl, ldvl, vr, ldvr,
433 $ n, nout, work( iwrk ), lwork-iwrk+1,
434 $ rwork( irwork ), n, ierr )
443 CALL zgebak(
'B',
'L', n, ilo, ihi, rwork( ibal ), n, vl, ldvl,
449 scl = one / dznrm2( n, vl( 1, i ), 1 )
450 CALL zdscal( n, scl, vl( 1, i ), 1 )
452 rwork( irwork+k-1 ) = dble( vl( k, i ) )**2 +
453 $ aimag( vl( k, i ) )**2
455 k = idamax( n, rwork( irwork ), 1 )
456 tmp = conjg( vl( k, i ) ) / sqrt( rwork( irwork+k-1 ) )
457 CALL zscal( n, tmp, vl( 1, i ), 1 )
458 vl( k, i ) = dcmplx( dble( vl( k, i ) ), zero )
468 CALL zgebak(
'B',
'R', n, ilo, ihi, rwork( ibal ), n, vr, ldvr,
474 scl = one / dznrm2( n, vr( 1, i ), 1 )
475 CALL zdscal( n, scl, vr( 1, i ), 1 )
477 rwork( irwork+k-1 ) = dble( vr( k, i ) )**2 +
478 $ aimag( vr( k, i ) )**2
480 k = idamax( n, rwork( irwork ), 1 )
481 tmp = conjg( vr( k, i ) ) / sqrt( rwork( irwork+k-1 ) )
482 CALL zscal( n, tmp, vr( 1, i ), 1 )
483 vr( k, i ) = dcmplx( dble( vr( k, i ) ), zero )
491 CALL zlascl(
'G', 0, 0, cscale, anrm, n-info, 1, w( info+1 ),
492 $ max( n-info, 1 ), ierr )
494 CALL zlascl(
'G', 0, 0, cscale, anrm, ilo-1, 1, w, n, ierr )
subroutine zgebak(JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV, INFO)
ZGEBAK
subroutine zgehrd(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
ZGEHRD
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 zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
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 zunghr(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
ZUNGHR
subroutine zgebal(JOB, N, A, LDA, ILO, IHI, SCALE, INFO)
ZGEBAL
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dlabad(SMALL, LARGE)
DLABAD
subroutine zhseqr(JOB, COMPZ, N, ILO, IHI, H, LDH, W, Z, LDZ, WORK, LWORK, INFO)
ZHSEQR
subroutine zdscal(N, DA, ZX, INCX)
ZDSCAL
subroutine ztrevc3(SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, LDVR, MM, M, WORK, LWORK, RWORK, LRWORK, INFO)
ZTREVC3
subroutine zscal(N, ZA, ZX, INCX)
ZSCAL