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 BALANC, JOBVL, JOBVR, SENSE
381 INTEGER IHI, ILO, INFO, 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, WANTSE, WANTSN, WANTSV
407 INTEGER I, ICOLS, IERR, IJOBVL, IJOBVR, IN, IROWS,
408 $ ITAU, IWRK, IWRK1, J, JC, JR, M, MAXWRK, MINWRK
409 DOUBLE PRECISION ANRM, ANRMTO, BIGNUM, BNRM, BNRMTO, EPS,
424 DOUBLE PRECISION DLAMCH, ZLANGE
425 EXTERNAL lsame, ilaenv, dlamch, zlange
428 INTRINSIC abs, dble, dimag, max, sqrt
431 DOUBLE PRECISION ABS1
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 IF( anrm.GT.zero .AND. anrm.LT.smlnum )
THEN
559 ELSE IF( anrm.GT.bignum )
THEN
564 $
CALL zlascl(
'G', 0, 0, anrm, anrmto, n, n, a, lda, ierr )
568 bnrm = zlange(
'M', n, n, b, ldb, rwork )
570 IF( bnrm.GT.zero .AND. bnrm.LT.smlnum )
THEN
573 ELSE IF( bnrm.GT.bignum )
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 IF( ilv .OR. .NOT.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 IF( irows.GT.1 )
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 IF( ilv .OR. .NOT.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 IF( ilv .OR. .NOT.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 IF( ierr.GT.0 .AND. ierr.LE.n )
THEN
673 ELSE IF( ierr.GT.n .AND. ierr.LE.2*n )
THEN
687 IF( ilv .OR. .NOT.wantsn )
THEN
699 CALL ztgevc( chtemp,
'B', ldumma, n, a, lda, b, ldb, vl,
700 $ ldvl, vr, ldvr, n, in, work( iwrk ), rwork,
708 IF( .NOT.wantsn )
THEN
729 IF( wantse .OR. 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 zggbal(JOB, N, A, LDA, B, LDB, ILO, IHI, LSCALE, RSCALE, WORK, INFO)
ZGGBAL
subroutine zggbak(JOB, SIDE, N, ILO, IHI, LSCALE, RSCALE, M, V, LDV, INFO)
ZGGBAK
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 zungqr(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
ZUNGQR
subroutine ztgsna(JOB, HOWMNY, SELECT, N, A, LDA, B, LDB, VL, LDVL, VR, LDVR, S, DIF, MM, M, WORK, LWORK, IWORK, INFO)
ZTGSNA
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 zgeqrf(M, N, A, LDA, TAU, WORK, LWORK, INFO)
ZGEQRF VARIANT: left-looking Level 3 BLAS of the algorithm.