ggqrf Interface

public interface ggqrf

GGQRF computes a generalized QR factorization of an N-by-M matrix A and an N-by-P matrix B: A = QR, B = QTZ, 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 N >= M, R = ( R11 ) M , or if N < M, R = ( R11 R12 ) N, ( 0 ) N-M N M-N M where R11 is upper triangular, and if N <= P, T = ( 0 T12 ) N, or if N > P, T = ( T11 ) N-P, P-N N ( T21 ) P P where T12 or T21 is upper triangular. In particular, if B is square and nonsingular, the GQR factorization of A and B implicitly gives the QR factorization of inv(B)A: inv(B)A = ZH * (inv(T)R) where inv(B) denotes the inverse of the matrix B, and Z' denotes the conjugate transpose of matrix Z.


Subroutines

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

Arguments

Type IntentOptional Attributes Name
integer(kind=ilp), intent(in) :: n
integer(kind=ilp), intent(in) :: m
integer(kind=ilp), intent(in) :: p
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 dggqrf(n, m, p, a, lda, taua, b, ldb, taub, work, lwork, info)

Arguments

Type IntentOptional Attributes Name
integer(kind=ilp), intent(in) :: n
integer(kind=ilp), intent(in) :: m
integer(kind=ilp), intent(in) :: p
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 sggqrf(n, m, p, a, lda, taua, b, ldb, taub, work, lwork, info)

Arguments

Type IntentOptional Attributes Name
integer(kind=ilp), intent(in) :: n
integer(kind=ilp), intent(in) :: m
integer(kind=ilp), intent(in) :: p
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 zggqrf(n, m, p, a, lda, taua, b, ldb, taub, work, lwork, info)

Arguments

Type IntentOptional Attributes Name
integer(kind=ilp), intent(in) :: n
integer(kind=ilp), intent(in) :: m
integer(kind=ilp), intent(in) :: p
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_cggqrf()

Arguments

None

public interface stdlib_dggqrf()

Arguments

None

public interface stdlib_sggqrf()

Arguments

None

public interface stdlib_zggqrf()

Arguments

None