370 SUBROUTINE zggevx( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, B, LDB,
371 $ ALPHA, BETA, VL, LDVL, VR, LDVR, ILO, IHI,
372 $ LSCALE, RSCALE, ABNRM, BBNRM, RCONDE, RCONDV,
373 $ WORK, LWORK, RWORK, IWORK, BWORK, INFO )
380 CHARACTER , JOBVL, JOBVR, SENSE
381 INTEGER IHI, ILO, , LDA, LDB, LDVL, LDVR, LWORK, N
382 DOUBLE PRECISION ABNRM, BBNRM
387 DOUBLE PRECISION LSCALE( * ), RCONDE( * ), RCONDV( * ),
388 $ rscale( * ), rwork( * )
389 COMPLEX*16 A( LDA, * ), ALPHA( * ), B( LDB, * ),
390 $ beta( * ), vl( ldvl, * ), vr( ldvr, * ),
397 DOUBLE PRECISION ZERO, ONE
398 PARAMETER ( ZERO = 0.0d+0, one = 1.0d+0 )
399 COMPLEX*16 CZERO, CONE
400 parameter( czero = ( 0.0d+0, 0.0d+0 ),
401 $ cone = ( 1.0d+0, 0.0d+0 ) )
404 LOGICAL ILASCL, ILBSCL, ILV, ILVL, ILVR, LQUERY, NOSCL,
405 $ WANTSB, , WANTSN, WANTSV
407 INTEGER I, ICOLS, IERR, IJOBVL, IJOBVR, IN, IROWS,
408 $ ITAU, IWRK, , J, JC, JR, M, MAXWRK, MINWRK
409 DOUBLE PRECISION ANRM, ANRMTO, BIGNUM, , BNRMTO, EPS,
425 EXTERNAL lsame, ilaenv, dlamch,
zlange
428 INTRINSIC abs, dble, dimag,
max, sqrt
434 abs1( x ) = abs( dble( x ) ) + abs( dimag( x ) )
440 IF( lsame( jobvl,
'N' ) )
THEN
443 ELSE IF( lsame( jobvl,
'V' ) )
THEN
451 IF( lsame( jobvr,
'N' ) )
THEN
454 ELSE IF( lsame( jobvr,
'V' ) )
THEN
463 noscl = lsame( balanc,
'N' ) .OR. lsame( balanc,
'P' )
464 wantsn = lsame( sense,
'N' )
465 wantse = lsame( sense,
'E' )
466 wantsv = lsame( sense,
'V' )
467 wantsb = lsame( sense,
'B' )
472 lquery = ( lwork.EQ.-1 )
473 IF( .NOT.( noscl .OR. lsame( balanc,
'S' ) .OR.
474 $ lsame( balanc,
'B' ) ) )
THEN
476 ELSE IF( ijobvl.LE.0 )
THEN
478 ELSE IF( ijobvr.LE.0 )
THEN
480 ELSE IF( .NOT.( wantsn .OR. wantse .OR. wantsb .OR. wantsv ) )
483 ELSE IF( n.LT.0 )
THEN
485 ELSE IF( lda.LT.
max( 1, n ) )
THEN
487 ELSE IF( ldb.LT.
max( 1, n ) )
THEN
489 ELSE IF( ldvl.LT.1 .OR. ( ilvl .AND. ldvl.LT.n ) )
THEN
491 ELSE IF( ldvr.LT.1 .OR. ( ilvr .AND. ldvr.LT.n ) )
THEN
511 ELSE IF( wantsv .OR. wantsb )
THEN
512 minwrk = 2*n*( n + 1)
515 maxwrk =
max( maxwrk,
516 $ n + n*ilaenv( 1,
'ZGEQRF',
' ', n, 1, n, 0 ) )
517 maxwrk =
max( maxwrk,
518 $ n + n*ilaenv( 1,
'ZUNMQR',
' ', n, 1, n, 0 ) )
520 maxwrk =
max( maxwrk, n +
521 $ n*ilaenv( 1,
'ZUNGQR',
' ', n, 1, n, 0 ) )
526 IF( lwork.LT.minwrk .AND. .NOT.lquery )
THEN
532 CALL xerbla(
'ZGGEVX', -info )
534 ELSE IF( lquery )
THEN
546 smlnum = dlamch(
'S' )
547 bignum = one / smlnum
548 CALL dlabad( smlnum, bignum )
549 smlnum = sqrt( smlnum ) / eps
550 bignum = one / smlnum
554 anrm =
zlange( 'm
', N, N, A, LDA, RWORK )
556.GT..AND..LT.
IF( ANRMZERO ANRMSMLNUM ) THEN
559.GT.
ELSE IF( ANRMBIGNUM ) THEN
564 $ CALL ZLASCL( 'g
', 0, 0, ANRM, ANRMTO, N, N, A, LDA, IERR )
568 BNRM = ZLANGE( 'm
', N, N, B, LDB, RWORK )
570.GT..AND..LT.
IF( BNRMZERO BNRMSMLNUM ) THEN
573.GT.
ELSE IF( BNRMBIGNUM ) THEN
578 $ CALL ZLASCL( 'g
', 0, 0, BNRM, BNRMTO, N, N, B, LDB, IERR )
583 CALL ZGGBAL( BALANC, N, A, LDA, B, LDB, ILO, IHI, LSCALE, RSCALE,
588 ABNRM = ZLANGE( '1
', N, N, A, LDA, RWORK( 1 ) )
591 CALL DLASCL( 'g
', 0, 0, ANRMTO, ANRM, 1, 1, RWORK( 1 ), 1,
596 BBNRM = ZLANGE( '1
', N, N, B, LDB, RWORK( 1 ) )
599 CALL DLASCL( 'g
', 0, 0, BNRMTO, BNRM, 1, 1, RWORK( 1 ), 1,
607 IROWS = IHI + 1 - ILO
608.OR..NOT.
IF( ILV WANTSN ) THEN
615 CALL ZGEQRF( IROWS, ICOLS, B( ILO, ILO ), LDB, WORK( ITAU ),
616 $ WORK( IWRK ), LWORK+1-IWRK, IERR )
621 CALL ZUNMQR( 'l
', 'c
', IROWS, ICOLS, IROWS, B( ILO, ILO ), LDB,
622 $ WORK( ITAU ), A( ILO, ILO ), LDA, WORK( IWRK ),
623 $ LWORK+1-IWRK, IERR )
629 CALL ZLASET( 'full
', N, N, CZERO, CONE, VL, LDVL )
630.GT.
IF( IROWS1 ) THEN
631 CALL ZLACPY( 'l
', IROWS-1, IROWS-1, B( ILO+1, ILO ), LDB,
632 $ VL( ILO+1, ILO ), LDVL )
634 CALL ZUNGQR( IROWS, IROWS, IROWS, VL( ILO, ILO ), LDVL,
635 $ WORK( ITAU ), WORK( IWRK ), LWORK+1-IWRK, IERR )
639 $ CALL ZLASET( 'full
', N, N, CZERO, CONE, VR, LDVR )
644.OR..NOT.
IF( ILV WANTSN ) THEN
648 CALL ZGGHRD( JOBVL, JOBVR, N, ILO, IHI, A, LDA, B, LDB, VL,
649 $ LDVL, VR, LDVR, IERR )
651 CALL ZGGHRD( 'n
', 'n
', IROWS, 1, IROWS, A( ILO, ILO ), LDA,
652 $ B( ILO, ILO ), LDB, VL, LDVL, VR, LDVR, IERR )
661.OR..NOT.
IF( ILV WANTSN ) THEN
667 CALL ZHGEQZ( CHTEMP, JOBVL, JOBVR, N, ILO, IHI, A, LDA, B, LDB,
668 $ ALPHA, BETA, VL, LDVL, VR, LDVR, WORK( IWRK ),
669 $ LWORK+1-IWRK, RWORK, IERR )
671.GT..AND..LE.
IF( IERR0 IERRN ) THEN
673.GT..AND..LE.
ELSE IF( IERRN IERR2*N ) THEN
687.OR..NOT.
IF( ILV WANTSN ) THEN
699 CALL ZTGEVC( CHTEMP, 'b
', LDUMMA, N, A, LDA, B, LDB, VL,
700 $ LDVL, VR, LDVR, N, IN, WORK( IWRK ), RWORK,
708.NOT.
IF( WANTSN ) THEN
729.OR.
IF( WANTSE WANTSB ) THEN
730 CALL ZTGEVC( 'b
', 's
', BWORK, N, A, LDA, B, LDB,
731 $ WORK( 1 ), N, WORK( IWRK ), N, 1, M,
732 $ WORK( IWRK1 ), RWORK, IERR )
739 CALL ZTGSNA( SENSE, 's
', BWORK, N, A, LDA, B, LDB,
740 $ WORK( 1 ), N, WORK( IWRK ), N, RCONDE( I ),
741 $ RCONDV( I ), 1, M, WORK( IWRK1 ),
742 $ LWORK-IWRK1+1, IWORK, IERR )
752 CALL ZGGBAK( BALANC, 'l
', N, ILO, IHI, LSCALE, RSCALE, N, VL,
758 TEMP = MAX( TEMP, ABS1( VL( JR, JC ) ) )
764 VL( JR, JC ) = VL( JR, JC )*TEMP
770 CALL ZGGBAK( BALANC, 'r
', N, ILO, IHI, LSCALE, RSCALE, N, VR,
775 TEMP = MAX( TEMP, ABS1( VR( JR, JC ) ) )
781 VR( JR, JC ) = VR( JR, JC )*TEMP
791 $ CALL ZLASCL( 'g
', 0, 0, ANRMTO, ANRM, N, 1, ALPHA, N, IERR )
794 $ CALL ZLASCL( 'g
', 0, 0, BNRMTO, BNRM, N, 1, BETA, 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 zggbak(job, side, n, ilo, ihi, lscale, rscale, m, v, ldv, info)
ZGGBAK
subroutine zggbal(job, n, a, lda, b, ldb, ilo, ihi, lscale, rscale, work, info)
ZGGBAL
double precision function zlange(norm, m, n, a, lda, work)
ZLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
subroutine ztgevc(side, howmny, select, n, s, lds, p, ldp, vl, ldvl, vr, ldvr, mm, m, work, rwork, info)
ZTGEVC
subroutine zhgeqz(job, compq, compz, n, ilo, ihi, h, ldh, t, ldt, alpha, beta, q, ldq, z, ldz, work, lwork, rwork, info)
ZHGEQZ
subroutine zggevx(balanc, jobvl, jobvr, sense, n, a, lda, b, ldb, alpha, beta, vl, ldvl, vr, ldvr, ilo, ihi, lscale, rscale, abnrm, bbnrm, rconde, rcondv, work, lwork, rwork, iwork, bwork, info)
ZGGEVX 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 zlaset(uplo, m, n, alpha, beta, a, lda)
ZLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values.
subroutine zgghrd(compq, compz, n, ilo, ihi, a, lda, b, ldb, q, ldq, z, ldz, info)
ZGGHRD
subroutine zunmqr(side, trans, m, n, k, a, lda, tau, c, ldc, work, lwork, info)
ZUNMQR
subroutine ztgsna(job, howmny, select, n, a, lda, b, ldb, vl, ldvl, vr, ldvr, s, dif, mm, m, work, lwork, iwork, info)
ZTGSNA
subroutine zungqr(m, n, k, a, lda, tau, work, lwork, info)
ZUNGQR
subroutine zgeqrf(m, n, a, lda, tau, work, lwork, info)
ZGEQRF VARIANT: left-looking Level 3 BLAS of the algorithm.