gghrd Interface

public interface gghrd

GGHRD reduces a pair of complex matrices (A,B) to generalized upper Hessenberg form using unitary transformations, where A is a general matrix and B is upper triangular. The form of the generalized eigenvalue problem is Ax = lambdaBx, and B is typically made upper triangular by computing its QR factorization and moving the unitary matrix Q to the left side of the equation. This subroutine simultaneously reduces A to a Hessenberg matrix H: QHAZ = H and transforms B to another upper triangular matrix T: QHBZ = T in order to reduce the problem to its standard form Hy = lambdaTy where y = ZH*x. The unitary matrices Q and Z are determined as products of Givens rotations. They may either be formed explicitly, or they may be postmultiplied into input matrices Q1 and Z1, so that Q1 * A * Z1H = (Q1Q) * H * (Z1Z)H Q1 * B * Z1H = (Q1Q) * T * (Z1Z)H If Q1 is the unitary matrix from the QR factorization of B in the original equation Ax = lambdaB*x, then GGHRD reduces the original problem to generalized Hessenberg form.


Subroutines

public pure subroutine cgghrd(compq, compz, n, ilo, ihi, a, lda, b, ldb, q, ldq, z, ldz, info)

Arguments

Type IntentOptional Attributes Name
character(len=1), intent(in) :: compq
character(len=1), intent(in) :: compz
integer(kind=ilp), intent(in) :: n
integer(kind=ilp), intent(in) :: ilo
integer(kind=ilp), intent(in) :: ihi
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(inout) :: q(ldq,*)
integer(kind=ilp), intent(in) :: ldq
complex(kind=sp), intent(inout) :: z(ldz,*)
integer(kind=ilp), intent(in) :: ldz
integer(kind=ilp), intent(out) :: info

public pure subroutine dgghrd(compq, compz, n, ilo, ihi, a, lda, b, ldb, q, ldq, z, ldz, info)

Arguments

Type IntentOptional Attributes Name
character(len=1), intent(in) :: compq
character(len=1), intent(in) :: compz
integer(kind=ilp), intent(in) :: n
integer(kind=ilp), intent(in) :: ilo
integer(kind=ilp), intent(in) :: ihi
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(inout) :: q(ldq,*)
integer(kind=ilp), intent(in) :: ldq
real(kind=dp), intent(inout) :: z(ldz,*)
integer(kind=ilp), intent(in) :: ldz
integer(kind=ilp), intent(out) :: info

public pure subroutine sgghrd(compq, compz, n, ilo, ihi, a, lda, b, ldb, q, ldq, z, ldz, info)

Arguments

Type IntentOptional Attributes Name
character(len=1), intent(in) :: compq
character(len=1), intent(in) :: compz
integer(kind=ilp), intent(in) :: n
integer(kind=ilp), intent(in) :: ilo
integer(kind=ilp), intent(in) :: ihi
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(inout) :: q(ldq,*)
integer(kind=ilp), intent(in) :: ldq
real(kind=sp), intent(inout) :: z(ldz,*)
integer(kind=ilp), intent(in) :: ldz
integer(kind=ilp), intent(out) :: info

public pure subroutine zgghrd(compq, compz, n, ilo, ihi, a, lda, b, ldb, q, ldq, z, ldz, info)

Arguments

Type IntentOptional Attributes Name
character(len=1), intent(in) :: compq
character(len=1), intent(in) :: compz
integer(kind=ilp), intent(in) :: n
integer(kind=ilp), intent(in) :: ilo
integer(kind=ilp), intent(in) :: ihi
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(inout) :: q(ldq,*)
integer(kind=ilp), intent(in) :: ldq
complex(kind=dp), intent(inout) :: z(ldz,*)
integer(kind=ilp), intent(in) :: ldz
integer(kind=ilp), intent(out) :: info

Module Procedures

public interface stdlib_cgghrd()

Arguments

None

public interface stdlib_dgghrd()

Arguments

None

public interface stdlib_sgghrd()

Arguments

None

public interface stdlib_zgghrd()

Arguments

None