ggglm Interface

public interface ggglm

GGGLM solves a general Gauss-Markov linear model (GLM) problem: minimize || y ||_2 subject to d = Ax + By x where A is an N-by-M matrix, B is an N-by-P matrix, and d is a given N-vector. It is assumed that M <= N <= M+P, and rank(A) = M and rank( A B ) = N. Under these assumptions, the constrained equation is always consistent, and there is a unique solution x and a minimal 2-norm solution y, which is obtained using a generalized QR factorization of the matrices (A, B) given by A = Q(R), B = QTZ. (0) In particular, if matrix B is square nonsingular, then the problem GLM is equivalent to the following weighted linear least squares problem minimize || inv(B)(d-A*x) ||_2 x where inv(B) denotes the inverse of B.


Subroutines

public pure subroutine cggglm(n, m, p, a, lda, b, ldb, d, x, y, 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(inout) :: b(ldb,*)
integer(kind=ilp), intent(in) :: ldb
complex(kind=sp), intent(inout) :: d(*)
complex(kind=sp), intent(out) :: x(*)
complex(kind=sp), intent(out) :: y(*)
complex(kind=sp), intent(out) :: work(*)
integer(kind=ilp), intent(in) :: lwork
integer(kind=ilp), intent(out) :: info

public pure subroutine dggglm(n, m, p, a, lda, b, ldb, d, x, y, 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(inout) :: b(ldb,*)
integer(kind=ilp), intent(in) :: ldb
real(kind=dp), intent(inout) :: d(*)
real(kind=dp), intent(out) :: x(*)
real(kind=dp), intent(out) :: y(*)
real(kind=dp), intent(out) :: work(*)
integer(kind=ilp), intent(in) :: lwork
integer(kind=ilp), intent(out) :: info

public pure subroutine sggglm(n, m, p, a, lda, b, ldb, d, x, y, 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(inout) :: b(ldb,*)
integer(kind=ilp), intent(in) :: ldb
real(kind=sp), intent(inout) :: d(*)
real(kind=sp), intent(out) :: x(*)
real(kind=sp), intent(out) :: y(*)
real(kind=sp), intent(out) :: work(*)
integer(kind=ilp), intent(in) :: lwork
integer(kind=ilp), intent(out) :: info

public pure subroutine zggglm(n, m, p, a, lda, b, ldb, d, x, y, 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(inout) :: b(ldb,*)
integer(kind=ilp), intent(in) :: ldb
complex(kind=dp), intent(inout) :: d(*)
complex(kind=dp), intent(out) :: x(*)
complex(kind=dp), intent(out) :: y(*)
complex(kind=dp), intent(out) :: work(*)
integer(kind=ilp), intent(in) :: lwork
integer(kind=ilp), intent(out) :: info

Module Procedures

public interface stdlib_cggglm()

Arguments

None

public interface stdlib_dggglm()

Arguments

None

public interface stdlib_sggglm()

Arguments

None

public interface stdlib_zggglm()

Arguments

None