285 SUBROUTINE zgeevx( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, W, VL,
286 $ LDVL, VR, LDVR, ILO, IHI, SCALE, ABNRM, RCONDE,
287 $ RCONDV, WORK, LWORK, RWORK, INFO )
295 CHARACTER , JOBVL, JOBVR, SENSE
296 INTEGER IHI, ILO, INFO, LDA, LDVL, LDVR, LWORK, N
297 DOUBLE PRECISION ABNRM
300 DOUBLE PRECISION RCONDE( * ), RCONDV( * ), RWORK( * ),
302 COMPLEX*16 A( LDA, * ), VL( LDVL, * ), VR( LDVR, * ),
309 DOUBLE PRECISION ZERO, ONE
310 PARAMETER ( ZERO = 0.0d0, one = 1.0d0 )
313 LOGICAL LQUERY, SCALEA, WANTVL, WANTVR, WNTSNB, WNTSNE,
316 INTEGER HSWORK, I, ICOND, , ITAU, IWRK, K,
317 $ lwork_trevc, maxwrk, minwrk, nout
318 DOUBLE PRECISION ANRM, BIGNUM, CSCALE, EPS, SCL, SMLNUM
323 DOUBLE PRECISION DUM( 1 )
332 INTEGER IDAMAX, ILAENV
333 DOUBLE PRECISION DLAMCH, DZNRM2, ZLANGE
334 EXTERNAL lsame, idamax, ilaenv, dlamch, dznrm2, zlange
337 INTRINSIC dble, dcmplx, conjg, aimag,
max, sqrt
344 lquery = ( lwork.EQ.-1 )
345 wantvl = lsame( jobvl,
'V' )
346 wantvr = lsame( jobvr,
'V' )
347 wntsnn = lsame( sense,
'N' )
348 wntsne = lsame( sense,
'E' )
349 wntsnv = lsame( sense,
'V' )
350 wntsnb = lsame( sense,
'B' )
351 IF( .NOT.( lsame( balanc,
'N' ) .OR. lsame( balanc,
'S' ) .OR.
352 $ lsame( balanc,
'P' ) .OR. lsame( balanc, 'b
' ) ) ) THEN
354.NOT..AND..NOT.
ELSE IF( ( WANTVL ) ( LSAME( JOBVL, 'n
' ) ) ) THEN
356.NOT..AND..NOT.
ELSE IF( ( WANTVR ) ( LSAME( JOBVR, 'n
' ) ) ) THEN
358.NOT..OR..OR..OR..OR.
ELSE IF( ( WNTSNN WNTSNE WNTSNB WNTSNV )
359.OR..AND..NOT..AND.
$ ( ( WNTSNE WNTSNB ) ( WANTVL
362.LT.
ELSE IF( N0 ) THEN
364.LT.
ELSE IF( LDAMAX( 1, N ) ) THEN
366.LT..OR..AND..LT.
ELSE IF( LDVL1 ( WANTVL LDVLN ) ) THEN
368.LT..OR..AND..LT.
ELSE IF( LDVR1 ( WANTVR LDVRN ) ) THEN
388 MAXWRK = N + N*ILAENV( 1, 'zgehrd', ' ', N, 1, N, 0 )
391 CALL ZTREVC3( 'l
', 'b
', SELECT, N, A, LDA,
392 $ VL, LDVL, VR, LDVR,
393 $ N, NOUT, WORK, -1, RWORK, -1, IERR )
394 LWORK_TREVC = INT( WORK(1) )
395 MAXWRK = MAX( MAXWRK, LWORK_TREVC )
396 CALL ZHSEQR( 's
', 'v
', N, 1, N, A, LDA, W, VL, LDVL,
398 ELSE IF( WANTVR ) THEN
399 CALL ZTREVC3( 'r
', 'b
', SELECT, N, A, LDA,
400 $ VL, LDVL, VR, LDVR,
401 $ N, NOUT, WORK, -1, RWORK, -1, IERR )
402 LWORK_TREVC = INT( WORK(1) )
403 MAXWRK = MAX( MAXWRK, LWORK_TREVC )
404 CALL ZHSEQR( 's
', 'v
', N, 1, N, A, LDA, W, VR, LDVR,
408 CALL ZHSEQR( 'e
', 'n
', N, 1, N, A, LDA, W, VR, LDVR,
411 CALL ZHSEQR( 's
', 'n
', N, 1, N, A, LDA, W, VR, LDVR,
415 HSWORK = INT( WORK(1) )
417.NOT..AND..NOT.
IF( ( WANTVL ) ( WANTVR ) ) THEN
419.NOT..OR.
IF( ( WNTSNN WNTSNE ) )
420 $ MINWRK = MAX( MINWRK, N*N + 2*N )
421 MAXWRK = MAX( MAXWRK, HSWORK )
422.NOT..OR.
IF( ( WNTSNN WNTSNE ) )
423 $ MAXWRK = MAX( MAXWRK, N*N + 2*N )
426.NOT..OR.
IF( ( WNTSNN WNTSNE ) )
427 $ MINWRK = MAX( MINWRK, N*N + 2*N )
428 MAXWRK = MAX( MAXWRK, HSWORK )
429 MAXWRK = MAX( MAXWRK, N + ( N - 1 )*ILAENV( 1, 'zunghr',
430 $ ' ', N, 1, N, -1 ) )
431.NOT..OR.
IF( ( WNTSNN WNTSNE ) )
432 $ MAXWRK = MAX( MAXWRK, N*N + 2*N )
433 MAXWRK = MAX( MAXWRK, 2*N )
435 MAXWRK = MAX( MAXWRK, MINWRK )
439.LT..AND..NOT.
IF( LWORKMINWRK LQUERY ) THEN
445 CALL XERBLA( 'zgeevx', -INFO )
447 ELSE IF( LQUERY ) THEN
459 SMLNUM = DLAMCH( 's
' )
460 BIGNUM = ONE / SMLNUM
461 CALL DLABAD( SMLNUM, BIGNUM )
462 SMLNUM = SQRT( SMLNUM ) / EPS
463 BIGNUM = ONE / SMLNUM
468 ANRM = ZLANGE( 'm
', N, N, A, LDA, DUM )
470.GT..AND..LT.
IF( ANRMZERO ANRMSMLNUM ) THEN
473.GT.
ELSE IF( ANRMBIGNUM ) THEN
478 $ CALL ZLASCL( 'g
', 0, 0, ANRM, CSCALE, N, N, A, LDA, IERR )
482 CALL ZGEBAL( BALANC, N, A, LDA, ILO, IHI, SCALE, IERR )
483 ABNRM = ZLANGE( '1
', N, N, A, LDA, DUM )
486 CALL DLASCL( 'g
', 0, 0, CSCALE, ANRM, 1, 1, DUM, 1, IERR )
496 CALL ZGEHRD( N, ILO, IHI, A, LDA, WORK( ITAU ), WORK( IWRK ),
497 $ LWORK-IWRK+1, IERR )
505 CALL ZLACPY( 'l
', N, N, A, LDA, VL, LDVL )
511 CALL ZUNGHR( N, ILO, IHI, VL, LDVL, WORK( ITAU ), WORK( IWRK ),
512 $ LWORK-IWRK+1, IERR )
519 CALL ZHSEQR( 's
', 'v
', N, ILO, IHI, A, LDA, W, VL, LDVL,
520 $ WORK( IWRK ), LWORK-IWRK+1, INFO )
528 CALL ZLACPY( 'f
', N, N, VL, LDVL, VR, LDVR )
531 ELSE IF( WANTVR ) THEN
537 CALL ZLACPY( 'l
', N, N, A, LDA, VR, LDVR )
543 CALL ZUNGHR( N, ILO, IHI, VR, LDVR, WORK( ITAU ), WORK( IWRK ),
544 $ LWORK-IWRK+1, IERR )
551 CALL ZHSEQR( 's
', 'v
', N, ILO, IHI, A, LDA, W, VR, LDVR,
552 $ WORK( IWRK ), LWORK-IWRK+1, INFO )
569 CALL ZHSEQR( JOB, 'n
', N, ILO, IHI, A, LDA, W, VR, LDVR,
570 $ WORK( IWRK ), LWORK-IWRK+1, INFO )
578.OR.
IF( WANTVL WANTVR ) THEN
584 CALL ZTREVC3( SIDE, 'b
', SELECT, N, A, LDA, VL, LDVL, VR, LDVR,
585 $ N, NOUT, WORK( IWRK ), LWORK-IWRK+1,
593.NOT.
IF( WNTSNN ) THEN
594 CALL ZTRSNA( SENSE, 'a
', SELECT, N, A, LDA, VL, LDVL, VR, LDVR,
595 $ RCONDE, RCONDV, N, NOUT, WORK( IWRK ), N, RWORK,
603 CALL ZGEBAK( BALANC, 'l
', N, ILO, IHI, SCALE, N, VL, LDVL,
609 SCL = ONE / DZNRM2( N, VL( 1, I ), 1 )
610 CALL ZDSCAL( N, SCL, VL( 1, I ), 1 )
612 RWORK( K ) = DBLE( VL( K, I ) )**2 +
613 $ AIMAG( VL( K, I ) )**2
615 K = IDAMAX( N, RWORK, 1 )
616 TMP = CONJG( VL( K, I ) ) / SQRT( RWORK( K ) )
617 CALL ZSCAL( N, TMP, VL( 1, I ), 1 )
618 VL( K, I ) = DCMPLX( DBLE( VL( K, I ) ), ZERO )
626 CALL ZGEBAK( BALANC, 'r
', N, ILO, IHI, SCALE, N, VR, LDVR,
632 SCL = ONE / DZNRM2( N, VR( 1, I ), 1 )
633 CALL ZDSCAL( N, SCL, VR( 1, I ), 1 )
635 RWORK( K ) = DBLE( VR( K, I ) )**2 +
636 $ AIMAG( VR( K, I ) )**2
638 K = IDAMAX( N, RWORK, 1 )
639 TMP = CONJG( VR( K, I ) ) / SQRT( RWORK( K ) )
640 CALL ZSCAL( N, TMP, VR( 1, I ), 1 )
641 VR( K, I ) = DCMPLX( DBLE( VR( K, I ) ), ZERO )
649 CALL ZLASCL( 'g
', 0, 0, CSCALE, ANRM, N-INFO, 1, W( INFO+1 ),
650 $ MAX( N-INFO, 1 ), IERR )
652.OR..AND..EQ.
IF( ( WNTSNV WNTSNB ) ICOND0 )
653 $ CALL DLASCL( 'g
', 0, 0, CSCALE, ANRM, N, 1, RCONDV, N,
656 CALL ZLASCL( 'g
', 0, 0, CSCALE, ANRM, ILO-1, 1, W, N, IERR )
subroutine dlabad(small, large)
DLABAD
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 xerbla(srname, info)
XERBLA
subroutine zgebal(job, n, a, lda, ilo, ihi, scale, info)
ZGEBAL
subroutine zgehrd(n, ilo, ihi, a, lda, tau, work, lwork, info)
ZGEHRD
subroutine zgebak(job, side, n, ilo, ihi, scale, m, v, ldv, info)
ZGEBAK
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 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 zhseqr(job, compz, n, ilo, ihi, h, ldh, w, z, ldz, work, lwork, info)
ZHSEQR
subroutine zunghr(n, ilo, ihi, a, lda, tau, work, lwork, info)
ZUNGHR
subroutine ztrsna(job, howmny, select, n, t, ldt, vl, ldvl, vr, ldvr, s, sep, mm, m, work, ldwork, rwork, info)
ZTRSNA
subroutine ztrevc3(side, howmny, select, n, t, ldt, vl, ldvl, vr, ldvr, mm, m, work, lwork, rwork, lrwork, info)
ZTREVC3
subroutine zdscal(n, da, zx, incx)
ZDSCAL
subroutine zscal(n, za, zx, incx)
ZSCAL