284 SUBROUTINE zgeevx( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, W, VL,
285 $ ldvl, vr, ldvr, ilo, ihi, scale, abnrm, rconde,
286 $ rcondv, work, lwork, rwork, info )
294 CHARACTER BALANC, JOBVL, JOBVR, SENSE
295 INTEGER IHI, ILO, INFO, LDA, LDVL, LDVR, LWORK, N
296 DOUBLE PRECISION ABNRM
299 DOUBLE PRECISION RCONDE( * ), RCONDV( * ), RWORK( * ),
301 COMPLEX*16 A( lda, * ), VL( ldvl, * ), VR( ldvr, * ),
308 DOUBLE PRECISION ZERO, ONE
309 parameter( zero = 0.0d0, one = 1.0d0 )
312 LOGICAL LQUERY, SCALEA, WANTVL, WANTVR, WNTSNB, WNTSNE,
315 INTEGER HSWORK, I, ICOND, IERR, ITAU, IWRK, K, MAXWRK,
317 DOUBLE PRECISION ANRM, BIGNUM, CSCALE, EPS, SCL, SMLNUM
322 DOUBLE PRECISION DUM( 1 )
331 INTEGER IDAMAX, ILAENV
332 DOUBLE PRECISION DLAMCH, DZNRM2, ZLANGE
333 EXTERNAL lsame, idamax, ilaenv, dlamch, dznrm2, zlange
336 INTRINSIC dble, dcmplx, dconjg, dimag, max, sqrt
343 lquery = ( lwork.EQ.-1 )
344 wantvl = lsame( jobvl,
'V' )
345 wantvr = lsame( jobvr,
'V' )
346 wntsnn = lsame( sense,
'N' )
347 wntsne = lsame( sense,
'E' )
348 wntsnv = lsame( sense,
'V' )
349 wntsnb = lsame( sense,
'B' )
350 IF( .NOT.( lsame( balanc,
'N' ) .OR. lsame( balanc,
'S' ) .OR.
351 $ lsame( balanc,
'P' ) .OR. lsame( balanc,
'B' ) ) )
THEN
353 ELSE IF( ( .NOT.wantvl ) .AND. ( .NOT.lsame( jobvl,
'N' ) ) )
THEN
355 ELSE IF( ( .NOT.wantvr ) .AND. ( .NOT.lsame( jobvr,
'N' ) ) )
THEN
357 ELSE IF( .NOT.( wntsnn .OR. wntsne .OR. wntsnb .OR. wntsnv ) .OR.
358 $ ( ( wntsne .OR. wntsnb ) .AND. .NOT.( wantvl .AND.
361 ELSE IF( n.LT.0 )
THEN
363 ELSE IF( lda.LT.max( 1, n ) )
THEN
365 ELSE IF( ldvl.LT.1 .OR. ( wantvl .AND. ldvl.LT.n ) )
THEN
367 ELSE IF( ldvr.LT.1 .OR. ( wantvr .AND. ldvr.LT.n ) )
THEN
387 maxwrk = n + n*ilaenv( 1,
'ZGEHRD',
' ', n, 1, n, 0 )
390 CALL zhseqr(
'S',
'V', n, 1, n, a, lda, w, vl, ldvl,
392 ELSE IF( wantvr )
THEN
393 CALL zhseqr(
'S',
'V', n, 1, n, a, lda, w, vr, ldvr,
397 CALL zhseqr(
'E',
'N', n, 1, n, a, lda, w, vr, ldvr,
400 CALL zhseqr(
'S',
'N', n, 1, n, a, lda, w, vr, ldvr,
406 IF( ( .NOT.wantvl ) .AND. ( .NOT.wantvr ) )
THEN
408 IF( .NOT.( wntsnn .OR. wntsne ) )
409 $ minwrk = max( minwrk, n*n + 2*n )
410 maxwrk = max( maxwrk, hswork )
411 IF( .NOT.( wntsnn .OR. wntsne ) )
412 $ maxwrk = max( maxwrk, n*n + 2*n )
415 IF( .NOT.( wntsnn .OR. wntsne ) )
416 $ minwrk = max( minwrk, n*n + 2*n )
417 maxwrk = max( maxwrk, hswork )
418 maxwrk = max( maxwrk, n + ( n - 1 )*ilaenv( 1,
'ZUNGHR',
419 $
' ', n, 1, n, -1 ) )
420 IF( .NOT.( wntsnn .OR. wntsne ) )
421 $ maxwrk = max( maxwrk, n*n + 2*n )
422 maxwrk = max( maxwrk, 2*n )
424 maxwrk = max( maxwrk, minwrk )
428 IF( lwork.LT.minwrk .AND. .NOT.lquery )
THEN
434 CALL xerbla(
'ZGEEVX', -info )
436 ELSE IF( lquery )
THEN
448 smlnum = dlamch(
'S' )
449 bignum = one / smlnum
450 CALL dlabad( smlnum, bignum )
451 smlnum = sqrt( smlnum ) / eps
452 bignum = one / smlnum
457 anrm = zlange(
'M', n, n, a, lda, dum )
459 IF( anrm.GT.zero .AND. anrm.LT.smlnum )
THEN
462 ELSE IF( anrm.GT.bignum )
THEN
467 $
CALL zlascl(
'G', 0, 0, anrm, cscale, n, n, a, lda, ierr )
471 CALL zgebal( balanc, n, a, lda, ilo, ihi, scale, ierr )
472 abnrm = zlange(
'1', n, n, a, lda, dum )
475 CALL dlascl(
'G', 0, 0, cscale, anrm, 1, 1, dum, 1, ierr )
485 CALL zgehrd( n, ilo, ihi, a, lda, work( itau ), work( iwrk ),
486 $ lwork-iwrk+1, ierr )
494 CALL zlacpy(
'L', n, n, a, lda, vl, ldvl )
500 CALL zunghr( n, ilo, ihi, vl, ldvl, work( itau ), work( iwrk ),
501 $ lwork-iwrk+1, ierr )
508 CALL zhseqr(
'S',
'V', n, ilo, ihi, a, lda, w, vl, ldvl,
509 $ work( iwrk ), lwork-iwrk+1, info )
517 CALL zlacpy(
'F', n, n, vl, ldvl, vr, ldvr )
520 ELSE IF( wantvr )
THEN
526 CALL zlacpy(
'L', n, n, a, lda, vr, ldvr )
532 CALL zunghr( n, ilo, ihi, vr, ldvr, work( itau ), work( iwrk ),
533 $ lwork-iwrk+1, ierr )
540 CALL zhseqr(
'S',
'V', n, ilo, ihi, a, lda, w, vr, ldvr,
541 $ work( iwrk ), lwork-iwrk+1, info )
558 CALL zhseqr( job,
'N', n, ilo, ihi, a, lda, w, vr, ldvr,
559 $ work( iwrk ), lwork-iwrk+1, info )
567 IF( wantvl .OR. wantvr )
THEN
573 CALL ztrevc( side,
'B',
SELECT, n, a, lda, vl, ldvl, vr, ldvr,
574 $ n, nout, work( iwrk ), rwork, ierr )
581 IF( .NOT.wntsnn )
THEN
582 CALL ztrsna( sense,
'A',
SELECT, n, a, lda, vl, ldvl, vr, ldvr,
583 $ rconde, rcondv, n, nout, work( iwrk ), n, rwork,
591 CALL zgebak( balanc,
'L', n, ilo, ihi, scale, n, vl, ldvl,
597 scl = one / dznrm2( n, vl( 1, i ), 1 )
598 CALL zdscal( n, scl, vl( 1, i ), 1 )
600 rwork( k ) = dble( vl( k, i ) )**2 +
601 $ dimag( vl( k, i ) )**2
603 k = idamax( n, rwork, 1 )
604 tmp = dconjg( vl( k, i ) ) / sqrt( rwork( k ) )
605 CALL zscal( n, tmp, vl( 1, i ), 1 )
606 vl( k, i ) = dcmplx( dble( vl( k, i ) ), zero )
614 CALL zgebak( balanc,
'R', n, ilo, ihi, scale, n, vr, ldvr,
620 scl = one / dznrm2( n, vr( 1, i ), 1 )
621 CALL zdscal( n, scl, vr( 1, i ), 1 )
623 rwork( k ) = dble( vr( k, i ) )**2 +
624 $ dimag( vr( k, i ) )**2
626 k = idamax( n, rwork, 1 )
627 tmp = dconjg( vr( k, i ) ) / sqrt( rwork( k ) )
628 CALL zscal( n, tmp, vr( 1, i ), 1 )
629 vr( k, i ) = dcmplx( dble( vr( k, i ) ), zero )
637 CALL zlascl(
'G', 0, 0, cscale, anrm, n-info, 1, w( info+1 ),
638 $ max( n-info, 1 ), ierr )
640 IF( ( wntsnv .OR. wntsnb ) .AND. icond.EQ.0 )
641 $
CALL dlascl(
'G', 0, 0, cscale, anrm, n, 1, rcondv, n,
644 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 dlascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
DLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
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 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 ztrsna(JOB, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, LDVR, S, SEP, MM, M, WORK, LDWORK, RWORK, INFO)
ZTRSNA
subroutine zgeevx(BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, W, VL, LDVL, VR, LDVR, ILO, IHI, SCALE, ABNRM, RCONDE, RCONDV, WORK, LWORK, RWORK, INFO)
ZGEEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices ...
subroutine zgebak(JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV, INFO)
ZGEBAK
subroutine zscal(N, ZA, ZX, INCX)
ZSCAL