tgevc Interface

public interface tgevc

TGEVC computes some or all of the right and/or left eigenvectors of a pair of complex matrices (S,P), where S and P are upper triangular. Matrix pairs of this type are produced by the generalized Schur factorization of a complex matrix pair (A,B): A = QSZH, B = QPZH as computed by CGGHRD + CHGEQZ. The right eigenvector x and the left eigenvector y of (S,P) corresponding to an eigenvalue w are defined by: Sx = wPx, (yH)S = w(yH)P, where yH denotes the conjugate tranpose of y. The eigenvalues are not input to this routine, but are computed directly from the diagonal elements of S and P. This routine returns the matrices X and/or Y of right and left eigenvectors of (S,P), or the products ZX and/or QY, where Z and Q are input matrices. If Q and Z are the unitary factors from the generalized Schur factorization of a matrix pair (A,B), then ZX and QY are the matrices of right and left eigenvectors of (A,B).


Subroutines

public pure subroutine ctgevc(side, howmny, select, n, s, lds, p, ldp, vl, ldvl, vr, ldvr, mm, m, work, rwork, info)

Arguments

Type IntentOptional Attributes Name
character(len=1), intent(in) :: side
character(len=1), intent(in) :: howmny
logical(kind=lk), intent(in) :: select(*)
integer(kind=ilp), intent(in) :: n
complex(kind=sp), intent(in) :: s(lds,*)
integer(kind=ilp), intent(in) :: lds
complex(kind=sp), intent(in) :: p(ldp,*)
integer(kind=ilp), intent(in) :: ldp
complex(kind=sp), intent(inout) :: vl(ldvl,*)
integer(kind=ilp), intent(in) :: ldvl
complex(kind=sp), intent(inout) :: vr(ldvr,*)
integer(kind=ilp), intent(in) :: ldvr
integer(kind=ilp), intent(in) :: mm
integer(kind=ilp), intent(out) :: m
complex(kind=sp), intent(out) :: work(*)
real(kind=sp), intent(out) :: rwork(*)
integer(kind=ilp), intent(out) :: info

public pure subroutine dtgevc(side, howmny, select, n, s, lds, p, ldp, vl, ldvl, vr, ldvr, mm, m, work, info)

Arguments

Type IntentOptional Attributes Name
character(len=1), intent(in) :: side
character(len=1), intent(in) :: howmny
logical(kind=lk), intent(in) :: select(*)
integer(kind=ilp), intent(in) :: n
real(kind=dp), intent(in) :: s(lds,*)
integer(kind=ilp), intent(in) :: lds
real(kind=dp), intent(in) :: p(ldp,*)
integer(kind=ilp), intent(in) :: ldp
real(kind=dp), intent(inout) :: vl(ldvl,*)
integer(kind=ilp), intent(in) :: ldvl
real(kind=dp), intent(inout) :: vr(ldvr,*)
integer(kind=ilp), intent(in) :: ldvr
integer(kind=ilp), intent(in) :: mm
integer(kind=ilp), intent(out) :: m
real(kind=dp), intent(out) :: work(*)
integer(kind=ilp), intent(out) :: info

public pure subroutine stgevc(side, howmny, select, n, s, lds, p, ldp, vl, ldvl, vr, ldvr, mm, m, work, info)

Arguments

Type IntentOptional Attributes Name
character(len=1), intent(in) :: side
character(len=1), intent(in) :: howmny
logical(kind=lk), intent(in) :: select(*)
integer(kind=ilp), intent(in) :: n
real(kind=sp), intent(in) :: s(lds,*)
integer(kind=ilp), intent(in) :: lds
real(kind=sp), intent(in) :: p(ldp,*)
integer(kind=ilp), intent(in) :: ldp
real(kind=sp), intent(inout) :: vl(ldvl,*)
integer(kind=ilp), intent(in) :: ldvl
real(kind=sp), intent(inout) :: vr(ldvr,*)
integer(kind=ilp), intent(in) :: ldvr
integer(kind=ilp), intent(in) :: mm
integer(kind=ilp), intent(out) :: m
real(kind=sp), intent(out) :: work(*)
integer(kind=ilp), intent(out) :: info

public pure subroutine ztgevc(side, howmny, select, n, s, lds, p, ldp, vl, ldvl, vr, ldvr, mm, m, work, rwork, info)

Arguments

Type IntentOptional Attributes Name
character(len=1), intent(in) :: side
character(len=1), intent(in) :: howmny
logical(kind=lk), intent(in) :: select(*)
integer(kind=ilp), intent(in) :: n
complex(kind=dp), intent(in) :: s(lds,*)
integer(kind=ilp), intent(in) :: lds
complex(kind=dp), intent(in) :: p(ldp,*)
integer(kind=ilp), intent(in) :: ldp
complex(kind=dp), intent(inout) :: vl(ldvl,*)
integer(kind=ilp), intent(in) :: ldvl
complex(kind=dp), intent(inout) :: vr(ldvr,*)
integer(kind=ilp), intent(in) :: ldvr
integer(kind=ilp), intent(in) :: mm
integer(kind=ilp), intent(out) :: m
complex(kind=dp), intent(out) :: work(*)
real(kind=dp), intent(out) :: rwork(*)
integer(kind=ilp), intent(out) :: info

Module Procedures

public interface stdlib_ctgevc()

Arguments

None

public interface stdlib_dtgevc()

Arguments

None

public interface stdlib_stgevc()

Arguments

None

public interface stdlib_ztgevc()

Arguments

None