ggev Interface

public interface ggev

GGEV computes for a pair of N-by-N complex nonsymmetric matrices (A,B), the generalized eigenvalues, and optionally, the left and/or right generalized eigenvectors. A generalized eigenvalue for a pair of matrices (A,B) is a scalar lambda or a ratio alpha/beta = lambda, such that A - lambdaB 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. The right generalized eigenvector v(j) corresponding to the generalized eigenvalue lambda(j) of (A,B) satisfies A * v(j) = lambda(j) * B * v(j). The left generalized eigenvector u(j) corresponding to the generalized eigenvalues lambda(j) of (A,B) satisfies u(j)H * A = lambda(j) * u(j)H * B where u(j)*H is the conjugate-transpose of u(j).


Subroutines

public subroutine cggev(jobvl, jobvr, n, a, lda, b, ldb, alpha, beta, vl, ldvl, vr, ldvr, work, lwork, rwork, info)

Arguments

Type IntentOptional Attributes Name
character(len=1), intent(in) :: jobvl
character(len=1), intent(in) :: jobvr
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
complex(kind=sp), intent(out) :: alpha(*)
complex(kind=sp), intent(out) :: beta(*)
complex(kind=sp), intent(out) :: vl(ldvl,*)
integer(kind=ilp), intent(in) :: ldvl
complex(kind=sp), intent(out) :: vr(ldvr,*)
integer(kind=ilp), intent(in) :: ldvr
complex(kind=sp), intent(out) :: work(*)
integer(kind=ilp), intent(in) :: lwork
real(kind=sp), intent(out) :: rwork(*)
integer(kind=ilp), intent(out) :: info

public subroutine dggev(jobvl, jobvr, n, a, lda, b, ldb, alphar, alphai, beta, vl, ldvl, vr, ldvr, work, lwork, info)

Arguments

Type IntentOptional Attributes Name
character(len=1), intent(in) :: jobvl
character(len=1), intent(in) :: jobvr
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
real(kind=dp), intent(out) :: alphar(*)
real(kind=dp), intent(out) :: alphai(*)
real(kind=dp), intent(out) :: beta(*)
real(kind=dp), intent(out) :: vl(ldvl,*)
integer(kind=ilp), intent(in) :: ldvl
real(kind=dp), intent(out) :: vr(ldvr,*)
integer(kind=ilp), intent(in) :: ldvr
real(kind=dp), intent(out) :: work(*)
integer(kind=ilp), intent(in) :: lwork
integer(kind=ilp), intent(out) :: info

public subroutine sggev(jobvl, jobvr, n, a, lda, b, ldb, alphar, alphai, beta, vl, ldvl, vr, ldvr, work, lwork, info)

Arguments

Type IntentOptional Attributes Name
character(len=1), intent(in) :: jobvl
character(len=1), intent(in) :: jobvr
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
real(kind=sp), intent(out) :: alphar(*)
real(kind=sp), intent(out) :: alphai(*)
real(kind=sp), intent(out) :: beta(*)
real(kind=sp), intent(out) :: vl(ldvl,*)
integer(kind=ilp), intent(in) :: ldvl
real(kind=sp), intent(out) :: vr(ldvr,*)
integer(kind=ilp), intent(in) :: ldvr
real(kind=sp), intent(out) :: work(*)
integer(kind=ilp), intent(in) :: lwork
integer(kind=ilp), intent(out) :: info

public subroutine zggev(jobvl, jobvr, n, a, lda, b, ldb, alpha, beta, vl, ldvl, vr, ldvr, work, lwork, rwork, info)

Arguments

Type IntentOptional Attributes Name
character(len=1), intent(in) :: jobvl
character(len=1), intent(in) :: jobvr
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
complex(kind=dp), intent(out) :: alpha(*)
complex(kind=dp), intent(out) :: beta(*)
complex(kind=dp), intent(out) :: vl(ldvl,*)
integer(kind=ilp), intent(in) :: ldvl
complex(kind=dp), intent(out) :: vr(ldvr,*)
integer(kind=ilp), intent(in) :: ldvr
complex(kind=dp), intent(out) :: work(*)
integer(kind=ilp), intent(in) :: lwork
real(kind=dp), intent(out) :: rwork(*)
integer(kind=ilp), intent(out) :: info

Module Procedures

public interface stdlib_cggev()

Arguments

None

public interface stdlib_dggev()

Arguments

None

public interface stdlib_sggev()

Arguments

None

public interface stdlib_zggev()

Arguments

None