gges Interface

public interface gges

GGES computes for a pair of N-by-N complex nonsymmetric matrices (A,B), the generalized eigenvalues, the generalized complex Schur form (S, T), and optionally left and/or right Schur vectors (VSL and VSR). This gives the generalized Schur factorization (A,B) = ( (VSL)S(VSR)H, (VSL)T(VSR)H ) where (VSR)*H is the conjugate-transpose of VSR. Optionally, it also orders the eigenvalues so that a selected cluster of eigenvalues appears in the leading diagonal blocks of the upper triangular matrix S and the upper triangular matrix T. The leading columns of VSL and VSR then form an unitary basis for the corresponding left and right eigenspaces (deflating subspaces). (If only the generalized eigenvalues are needed, use the driver CGGEV instead, which is faster.) A generalized eigenvalue for a pair of matrices (A,B) is a scalar w or a ratio alpha/beta = w, such that A - wB is singular. It is usually represented as the pair (alpha,beta), as there is a reasonable interpretation for beta=0, and even for both being zero. A pair of matrices (S,T) is in generalized complex Schur form if S and T are upper triangular and, in addition, the diagonal elements of T are non-negative real numbers.


Subroutines

public subroutine cgges(jobvsl, jobvsr, sort, selctg, n, a, lda, b, ldb, sdim, alpha, beta, vsl, ldvsl, vsr, ldvsr, work, lwork, rwork, bwork, info)

Arguments

Type IntentOptional Attributes Name
character(len=1), intent(in) :: jobvsl
character(len=1), intent(in) :: jobvsr
character(len=1), intent(in) :: sort
procedure(stdlib_selctg_c) :: selctg
integer(kind=ilp), intent(in) :: n
complex(kind=sp), intent(inout) :: a(lda,*)
integer(kind=ilp), intent(in) :: lda
complex(kind=sp), intent(inout) :: b(ldb,*)
integer(kind=ilp), intent(in) :: ldb
integer(kind=ilp), intent(out) :: sdim
complex(kind=sp), intent(out) :: alpha(*)
complex(kind=sp), intent(out) :: beta(*)
complex(kind=sp), intent(out) :: vsl(ldvsl,*)
integer(kind=ilp), intent(in) :: ldvsl
complex(kind=sp), intent(out) :: vsr(ldvsr,*)
integer(kind=ilp), intent(in) :: ldvsr
complex(kind=sp), intent(out) :: work(*)
integer(kind=ilp), intent(in) :: lwork
real(kind=sp), intent(out) :: rwork(*)
logical(kind=lk), intent(out) :: bwork(*)
integer(kind=ilp), intent(out) :: info

public subroutine dgges(jobvsl, jobvsr, sort, selctg, n, a, lda, b, ldb, sdim, alphar, alphai, beta, vsl, ldvsl, vsr, ldvsr, work, lwork, bwork, info)

Arguments

Type IntentOptional Attributes Name
character(len=1), intent(in) :: jobvsl
character(len=1), intent(in) :: jobvsr
character(len=1), intent(in) :: sort
procedure(stdlib_selctg_d) :: selctg
integer(kind=ilp), intent(in) :: n
real(kind=dp), intent(inout) :: a(lda,*)
integer(kind=ilp), intent(in) :: lda
real(kind=dp), intent(inout) :: b(ldb,*)
integer(kind=ilp), intent(in) :: ldb
integer(kind=ilp), intent(out) :: sdim
real(kind=dp), intent(out) :: alphar(*)
real(kind=dp), intent(out) :: alphai(*)
real(kind=dp), intent(out) :: beta(*)
real(kind=dp), intent(out) :: vsl(ldvsl,*)
integer(kind=ilp), intent(in) :: ldvsl
real(kind=dp), intent(out) :: vsr(ldvsr,*)
integer(kind=ilp), intent(in) :: ldvsr
real(kind=dp), intent(out) :: work(*)
integer(kind=ilp), intent(in) :: lwork
logical(kind=lk), intent(out) :: bwork(*)
integer(kind=ilp), intent(out) :: info

public subroutine sgges(jobvsl, jobvsr, sort, selctg, n, a, lda, b, ldb, sdim, alphar, alphai, beta, vsl, ldvsl, vsr, ldvsr, work, lwork, bwork, info)

Arguments

Type IntentOptional Attributes Name
character(len=1), intent(in) :: jobvsl
character(len=1), intent(in) :: jobvsr
character(len=1), intent(in) :: sort
procedure(stdlib_selctg_s) :: selctg
integer(kind=ilp), intent(in) :: n
real(kind=sp), intent(inout) :: a(lda,*)
integer(kind=ilp), intent(in) :: lda
real(kind=sp), intent(inout) :: b(ldb,*)
integer(kind=ilp), intent(in) :: ldb
integer(kind=ilp), intent(out) :: sdim
real(kind=sp), intent(out) :: alphar(*)
real(kind=sp), intent(out) :: alphai(*)
real(kind=sp), intent(out) :: beta(*)
real(kind=sp), intent(out) :: vsl(ldvsl,*)
integer(kind=ilp), intent(in) :: ldvsl
real(kind=sp), intent(out) :: vsr(ldvsr,*)
integer(kind=ilp), intent(in) :: ldvsr
real(kind=sp), intent(out) :: work(*)
integer(kind=ilp), intent(in) :: lwork
logical(kind=lk), intent(out) :: bwork(*)
integer(kind=ilp), intent(out) :: info

public subroutine zgges(jobvsl, jobvsr, sort, selctg, n, a, lda, b, ldb, sdim, alpha, beta, vsl, ldvsl, vsr, ldvsr, work, lwork, rwork, bwork, info)

Arguments

Type IntentOptional Attributes Name
character(len=1), intent(in) :: jobvsl
character(len=1), intent(in) :: jobvsr
character(len=1), intent(in) :: sort
procedure(stdlib_selctg_z) :: selctg
integer(kind=ilp), intent(in) :: n
complex(kind=dp), intent(inout) :: a(lda,*)
integer(kind=ilp), intent(in) :: lda
complex(kind=dp), intent(inout) :: b(ldb,*)
integer(kind=ilp), intent(in) :: ldb
integer(kind=ilp), intent(out) :: sdim
complex(kind=dp), intent(out) :: alpha(*)
complex(kind=dp), intent(out) :: beta(*)
complex(kind=dp), intent(out) :: vsl(ldvsl,*)
integer(kind=ilp), intent(in) :: ldvsl
complex(kind=dp), intent(out) :: vsr(ldvsr,*)
integer(kind=ilp), intent(in) :: ldvsr
complex(kind=dp), intent(out) :: work(*)
integer(kind=ilp), intent(in) :: lwork
real(kind=dp), intent(out) :: rwork(*)
logical(kind=lk), intent(out) :: bwork(*)
integer(kind=ilp), intent(out) :: info

Module Procedures

public interface stdlib_cgges()

Arguments

None

public interface stdlib_dgges()

Arguments

None

public interface stdlib_sgges()

Arguments

None

public interface stdlib_zgges()

Arguments

None