372 SUBROUTINE cggevx( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, B, LDB,
373 $ ALPHA, BETA, VL, LDVL, VR, LDVR, ILO, IHI,
374 $ LSCALE, RSCALE, ABNRM, BBNRM, RCONDE, RCONDV,
375 $ WORK, LWORK, RWORK, IWORK, BWORK, INFO )
383 CHARACTER BALANC, JOBVL, JOBVR, SENSE
384 INTEGER IHI, ILO, INFO, LDA, LDB, LDVL, LDVR, LWORK, N
390 REAL LSCALE( * ), RCONDE( * ), RCONDV( * ),
391 $ rscale( * ), rwork( * )
392 COMPLEX A( lda, * ), ALPHA( * ), B( ldb, * ),
393 $ beta( * ), vl( ldvl, * ), vr( ldvr, * ),
401 parameter( zero = 0.0e+0, one = 1.0e+0 )
403 parameter( czero = ( 0.0e+0, 0.0e+0 ),
404 $ cone = ( 1.0e+0, 0.0e+0 ) )
407 LOGICAL ILASCL, ILBSCL, ILV, ILVL, ILVR, LQUERY, NOSCL,
408 $ wantsb, wantse, wantsn, wantsv
410 INTEGER I, ICOLS, IERR, IJOBVL, IJOBVR, IN, IROWS,
411 $ itau, iwrk, iwrk1, j, jc, jr, m, maxwrk, minwrk
412 REAL ANRM, ANRMTO, BIGNUM, BNRM, BNRMTO, EPS,
428 EXTERNAL lsame, ilaenv, clange, slamch
431 INTRINSIC abs, aimag, max,
REAL, SQRT
437 abs1( x ) = abs(
REAL( X ) ) + abs( AIMAG( x ) )
443 IF( lsame( jobvl,
'N' ) )
THEN 446 ELSE IF( lsame( jobvl,
'V' ) )
THEN 454 IF( lsame( jobvr,
'N' ) )
THEN 457 ELSE IF( lsame( jobvr,
'V' ) )
THEN 466 noscl = lsame( balanc,
'N' ) .OR. lsame( balanc,
'P' )
467 wantsn = lsame( sense,
'N' )
468 wantse = lsame( sense,
'E' )
469 wantsv = lsame( sense,
'V' )
470 wantsb = lsame( sense,
'B' )
475 lquery = ( lwork.EQ.-1 )
476 IF( .NOT.( noscl .OR. lsame( balanc,
'S' ) .OR.
477 $ lsame( balanc,
'B' ) ) )
THEN 479 ELSE IF( ijobvl.LE.0 )
THEN 481 ELSE IF( ijobvr.LE.0 )
THEN 483 ELSE IF( .NOT.( wantsn .OR. wantse .OR. wantsb .OR. wantsv ) )
486 ELSE IF( n.LT.0 )
THEN 488 ELSE IF( lda.LT.max( 1, n ) )
THEN 490 ELSE IF( ldb.LT.max( 1, n ) )
THEN 492 ELSE IF( ldvl.LT.1 .OR. ( ilvl .AND. ldvl.LT.n ) )
THEN 494 ELSE IF( ldvr.LT.1 .OR. ( ilvr .AND. ldvr.LT.n ) )
THEN 514 ELSE IF( wantsv .OR. wantsb )
THEN 515 minwrk = 2*n*( n + 1)
518 maxwrk = max( maxwrk,
519 $ n + n*ilaenv( 1,
'CGEQRF',
' ', n, 1, n, 0 ) )
520 maxwrk = max( maxwrk,
521 $ n + n*ilaenv( 1,
'CUNMQR',
' ', n, 1, n, 0 ) )
523 maxwrk = max( maxwrk, n +
524 $ n*ilaenv( 1,
'CUNGQR',
' ', n, 1, n, 0 ) )
529 IF( lwork.LT.minwrk .AND. .NOT.lquery )
THEN 535 CALL xerbla(
'CGGEVX', -info )
537 ELSE IF( lquery )
THEN 549 smlnum = slamch(
'S' )
550 bignum = one / smlnum
551 CALL slabad( smlnum, bignum )
552 smlnum = sqrt( smlnum ) / eps
553 bignum = one / smlnum
557 anrm = clange(
'M', n, n, a, lda, rwork )
559 IF( anrm.GT.zero .AND. anrm.LT.smlnum )
THEN 562 ELSE IF( anrm.GT.bignum )
THEN 567 $
CALL clascl(
'G', 0, 0, anrm, anrmto, n, n, a, lda, ierr )
571 bnrm = clange(
'M', n, n, b, ldb, rwork )
573 IF( bnrm.GT.zero .AND. bnrm.LT.smlnum )
THEN 576 ELSE IF( bnrm.GT.bignum )
THEN 581 $
CALL clascl(
'G', 0, 0, bnrm, bnrmto, n, n, b, ldb, ierr )
586 CALL cggbal( balanc, n, a, lda, b, ldb, ilo, ihi, lscale, rscale,
591 abnrm = clange(
'1', n, n, a, lda, rwork( 1 ) )
594 CALL slascl(
'G', 0, 0, anrmto, anrm, 1, 1, rwork( 1 ), 1,
599 bbnrm = clange(
'1', n, n, b, ldb, rwork( 1 ) )
602 CALL slascl(
'G', 0, 0, bnrmto, bnrm, 1, 1, rwork( 1 ), 1,
610 irows = ihi + 1 - ilo
611 IF( ilv .OR. .NOT.wantsn )
THEN 618 CALL cgeqrf( irows, icols, b( ilo, ilo ), ldb, work( itau ),
619 $ work( iwrk ), lwork+1-iwrk, ierr )
624 CALL cunmqr(
'L',
'C', irows, icols, irows, b( ilo, ilo ), ldb,
625 $ work( itau ), a( ilo, ilo ), lda, work( iwrk ),
626 $ lwork+1-iwrk, ierr )
632 CALL claset(
'Full', n, n, czero, cone, vl, ldvl )
633 IF( irows.GT.1 )
THEN 634 CALL clacpy(
'L', irows-1, irows-1, b( ilo+1, ilo ), ldb,
635 $ vl( ilo+1, ilo ), ldvl )
637 CALL cungqr( irows, irows, irows, vl( ilo, ilo ), ldvl,
638 $ work( itau ), work( iwrk ), lwork+1-iwrk, ierr )
642 $
CALL claset(
'Full', n, n, czero, cone, vr, ldvr )
647 IF( ilv .OR. .NOT.wantsn )
THEN 651 CALL cgghrd( jobvl, jobvr, n, ilo, ihi, a, lda, b, ldb, vl,
652 $ ldvl, vr, ldvr, ierr )
654 CALL cgghrd(
'N',
'N', irows, 1, irows, a( ilo, ilo ), lda,
655 $ b( ilo, ilo ), ldb, vl, ldvl, vr, ldvr, ierr )
664 IF( ilv .OR. .NOT.wantsn )
THEN 670 CALL chgeqz( chtemp, jobvl, jobvr, n, ilo, ihi, a, lda, b, ldb,
671 $ alpha, beta, vl, ldvl, vr, ldvr, work( iwrk ),
672 $ lwork+1-iwrk, rwork, ierr )
674 IF( ierr.GT.0 .AND. ierr.LE.n )
THEN 676 ELSE IF( ierr.GT.n .AND. ierr.LE.2*n )
THEN 690 IF( ilv .OR. .NOT.wantsn )
THEN 702 CALL ctgevc( chtemp,
'B', ldumma, n, a, lda, b, ldb, vl,
703 $ ldvl, vr, ldvr, n, in, work( iwrk ), rwork,
711 IF( .NOT.wantsn )
THEN 732 IF( wantse .OR. wantsb )
THEN 733 CALL ctgevc(
'B',
'S', bwork, n, a, lda, b, ldb,
734 $ work( 1 ), n, work( iwrk ), n, 1, m,
735 $ work( iwrk1 ), rwork, ierr )
742 CALL ctgsna( sense,
'S', bwork, n, a, lda, b, ldb,
743 $ work( 1 ), n, work( iwrk ), n, rconde( i ),
744 $ rcondv( i ), 1, m, work( iwrk1 ),
745 $ lwork-iwrk1+1, iwork, ierr )
755 CALL cggbak( balanc,
'L', n, ilo, ihi, lscale, rscale, n, vl,
761 temp = max( temp, abs1( vl( jr, jc ) ) )
767 vl( jr, jc ) = vl( jr, jc )*temp
773 CALL cggbak( balanc,
'R', n, ilo, ihi, lscale, rscale, n, vr,
778 temp = max( temp, abs1( vr( jr, jc ) ) )
784 vr( jr, jc ) = vr( jr, jc )*temp
794 $
CALL clascl(
'G', 0, 0, anrmto, anrm, n, 1, alpha, n, ierr )
797 $
CALL clascl(
'G', 0, 0, bnrmto, bnrm, n, 1, beta, n, ierr )
subroutine ctgsna(JOB, HOWMNY, SELECT, N, A, LDA, B, LDB, VL, LDVL, VR, LDVR, S, DIF, MM, M, WORK, LWORK, IWORK, INFO)
CTGSNA
subroutine ctgevc(SIDE, HOWMNY, SELECT, N, S, LDS, P, LDP, VL, LDVL, VR, LDVR, MM, M, WORK, RWORK, INFO)
CTGEVC
subroutine cggbal(JOB, N, A, LDA, B, LDB, ILO, IHI, LSCALE, RSCALE, WORK, INFO)
CGGBAL
subroutine claset(UPLO, M, N, ALPHA, BETA, A, LDA)
CLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
subroutine cungqr(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
CUNGQR
subroutine clascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
CLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
subroutine chgeqz(JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT, ALPHA, BETA, Q, LDQ, Z, LDZ, WORK, LWORK, RWORK, INFO)
CHGEQZ
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine cggevx(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)
CGGEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices ...
subroutine cgeqrf(M, N, A, LDA, TAU, WORK, LWORK, INFO)
CGEQRF
subroutine slascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
SLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
subroutine slabad(SMALL, LARGE)
SLABAD
subroutine cgghrd(COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, LDQ, Z, LDZ, INFO)
CGGHRD
subroutine cggbak(JOB, SIDE, N, ILO, IHI, LSCALE, RSCALE, M, V, LDV, INFO)
CGGBAK
subroutine cunmqr(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
CUNMQR