ggrqf Interface

public interface ggrqf

GGRQF computes a generalized RQ factorization of an M-by-N matrix A and a P-by-N matrix B: A = RQ, B = ZTQ, where Q is an N-by-N unitary matrix, Z is a P-by-P unitary matrix, and R and T assume one of the forms: if M <= N, R = ( 0 R12 ) M, or if M > N, R = ( R11 ) M-N, N-M M ( R21 ) N N where R12 or R21 is upper triangular, and if P >= N, T = ( T11 ) N , or if P < N, T = ( T11 T12 ) P, ( 0 ) P-N P N-P N where T11 is upper triangular. In particular, if B is square and nonsingular, the GRQ factorization of A and B implicitly gives the RQ factorization of Ainv(B): Ainv(B) = (Rinv(T))ZH where inv(B) denotes the inverse of the matrix B, and Z*H denotes the conjugate transpose of the matrix Z.


Subroutines

public pure subroutine cggrqf(m, p, n, a, lda, taua, b, ldb, taub, work, lwork, info)

Arguments

Type IntentOptional Attributes Name
integer(kind=ilp), intent(in) :: m
integer(kind=ilp), intent(in) :: p
integer(kind=ilp), intent(in) :: n
complex(kind=sp), intent(inout) :: a(lda,*)
integer(kind=ilp), intent(in) :: lda
complex(kind=sp), intent(out) :: taua(*)
complex(kind=sp), intent(inout) :: b(ldb,*)
integer(kind=ilp), intent(in) :: ldb
complex(kind=sp), intent(out) :: taub(*)
complex(kind=sp), intent(out) :: work(*)
integer(kind=ilp), intent(in) :: lwork
integer(kind=ilp), intent(out) :: info

public pure subroutine dggrqf(m, p, n, a, lda, taua, b, ldb, taub, work, lwork, info)

Arguments

Type IntentOptional Attributes Name
integer(kind=ilp), intent(in) :: m
integer(kind=ilp), intent(in) :: p
integer(kind=ilp), intent(in) :: n
real(kind=dp), intent(inout) :: a(lda,*)
integer(kind=ilp), intent(in) :: lda
real(kind=dp), intent(out) :: taua(*)
real(kind=dp), intent(inout) :: b(ldb,*)
integer(kind=ilp), intent(in) :: ldb
real(kind=dp), intent(out) :: taub(*)
real(kind=dp), intent(out) :: work(*)
integer(kind=ilp), intent(in) :: lwork
integer(kind=ilp), intent(out) :: info

public pure subroutine sggrqf(m, p, n, a, lda, taua, b, ldb, taub, work, lwork, info)

Arguments

Type IntentOptional Attributes Name
integer(kind=ilp), intent(in) :: m
integer(kind=ilp), intent(in) :: p
integer(kind=ilp), intent(in) :: n
real(kind=sp), intent(inout) :: a(lda,*)
integer(kind=ilp), intent(in) :: lda
real(kind=sp), intent(out) :: taua(*)
real(kind=sp), intent(inout) :: b(ldb,*)
integer(kind=ilp), intent(in) :: ldb
real(kind=sp), intent(out) :: taub(*)
real(kind=sp), intent(out) :: work(*)
integer(kind=ilp), intent(in) :: lwork
integer(kind=ilp), intent(out) :: info

public pure subroutine zggrqf(m, p, n, a, lda, taua, b, ldb, taub, work, lwork, info)

Arguments

Type IntentOptional Attributes Name
integer(kind=ilp), intent(in) :: m
integer(kind=ilp), intent(in) :: p
integer(kind=ilp), intent(in) :: n
complex(kind=dp), intent(inout) :: a(lda,*)
integer(kind=ilp), intent(in) :: lda
complex(kind=dp), intent(out) :: taua(*)
complex(kind=dp), intent(inout) :: b(ldb,*)
integer(kind=ilp), intent(in) :: ldb
complex(kind=dp), intent(out) :: taub(*)
complex(kind=dp), intent(out) :: work(*)
integer(kind=ilp), intent(in) :: lwork
integer(kind=ilp), intent(out) :: info

Module Procedures

public interface stdlib_cggrqf()

Arguments

None

public interface stdlib_dggrqf()

Arguments

None

public interface stdlib_sggrqf()

Arguments

None

public interface stdlib_zggrqf()

Arguments

None