gelsd Interface

public interface gelsd

GELSD computes the minimum-norm solution to a real linear least squares problem: minimize 2-norm(| b - A*x |) using the singular value decomposition (SVD) of A. A is an M-by-N matrix which may be rank-deficient. Several right hand side vectors b and solution vectors x can be handled in a single call; they are stored as the columns of the M-by-NRHS right hand side matrix B and the N-by-NRHS solution matrix X. The problem is solved in three steps: (1) Reduce the coefficient matrix A to bidiagonal form with Householder transformations, reducing the original problem into a "bidiagonal least squares problem" (BLS) (2) Solve the BLS using a divide and conquer approach. (3) Apply back all the Householder transformations to solve the original least squares problem. The effective rank of A is determined by treating as zero those singular values which are less than RCOND times the largest singular value. The divide and conquer algorithm makes very mild assumptions about floating point arithmetic. It will work on machines with a guard digit in add/subtract, or on those binary machines without guard digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or Cray-2. It could conceivably fail on hexadecimal or decimal machines without guard digits, but we know of none.


Subroutines

public subroutine cgelsd(m, n, nrhs, a, lda, b, ldb, s, rcond, rank, work, lwork, rwork, iwork, info)

Arguments

Type IntentOptional Attributes Name
integer(kind=ilp), intent(in) :: m
integer(kind=ilp), intent(in) :: n
integer(kind=ilp), intent(in) :: nrhs
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
real(kind=sp), intent(out) :: s(*)
real(kind=sp), intent(in) :: rcond
integer(kind=ilp), intent(out) :: rank
complex(kind=sp), intent(out) :: work(*)
integer(kind=ilp), intent(in) :: lwork
real(kind=sp), intent(out) :: rwork(*)
integer(kind=ilp), intent(out) :: iwork(*)
integer(kind=ilp), intent(out) :: info

public subroutine dgelsd(m, n, nrhs, a, lda, b, ldb, s, rcond, rank, work, lwork, iwork, info)

Arguments

Type IntentOptional Attributes Name
integer(kind=ilp), intent(in) :: m
integer(kind=ilp), intent(in) :: n
integer(kind=ilp), intent(in) :: nrhs
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) :: s(*)
real(kind=dp), intent(in) :: rcond
integer(kind=ilp), intent(out) :: rank
real(kind=dp), intent(out) :: work(*)
integer(kind=ilp), intent(in) :: lwork
integer(kind=ilp), intent(out) :: iwork(*)
integer(kind=ilp), intent(out) :: info

public subroutine sgelsd(m, n, nrhs, a, lda, b, ldb, s, rcond, rank, work, lwork, iwork, info)

Arguments

Type IntentOptional Attributes Name
integer(kind=ilp), intent(in) :: m
integer(kind=ilp), intent(in) :: n
integer(kind=ilp), intent(in) :: nrhs
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) :: s(*)
real(kind=sp), intent(in) :: rcond
integer(kind=ilp), intent(out) :: rank
real(kind=sp), intent(out) :: work(*)
integer(kind=ilp), intent(in) :: lwork
integer(kind=ilp), intent(out) :: iwork(*)
integer(kind=ilp), intent(out) :: info

public subroutine zgelsd(m, n, nrhs, a, lda, b, ldb, s, rcond, rank, work, lwork, rwork, iwork, info)

Arguments

Type IntentOptional Attributes Name
integer(kind=ilp), intent(in) :: m
integer(kind=ilp), intent(in) :: n
integer(kind=ilp), intent(in) :: nrhs
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
real(kind=dp), intent(out) :: s(*)
real(kind=dp), intent(in) :: rcond
integer(kind=ilp), intent(out) :: rank
complex(kind=dp), intent(out) :: work(*)
integer(kind=ilp), intent(in) :: lwork
real(kind=dp), intent(out) :: rwork(*)
integer(kind=ilp), intent(out) :: iwork(*)
integer(kind=ilp), intent(out) :: info

Module Procedures

public interface stdlib_cgelsd()

Arguments

None

public interface stdlib_dgelsd()

Arguments

None

public interface stdlib_sgelsd()

Arguments

None

public interface stdlib_zgelsd()

Arguments

None