lalsd Interface

public interface lalsd

LALSD uses the singular value decomposition of A to solve the least squares problem of finding X to minimize the Euclidean norm of each column of A*X-B, where A is N-by-N upper bidiagonal, and X and B are N-by-NRHS. The solution X overwrites B. The singular values of A smaller than RCOND times the largest singular value are treated as zero in solving the least squares problem; in this case a minimum norm solution is returned. The actual singular values are returned in D in ascending order. This code 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 XMP, Cray YMP, 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 pure subroutine clalsd(uplo, smlsiz, n, nrhs, d, e, b, ldb, rcond, rank, work, rwork, iwork, info)

Arguments

Type IntentOptional Attributes Name
character(len=1), intent(in) :: uplo
integer(kind=ilp), intent(in) :: smlsiz
integer(kind=ilp), intent(in) :: n
integer(kind=ilp), intent(in) :: nrhs
real(kind=sp), intent(inout) :: d(*)
real(kind=sp), intent(inout) :: e(*)
complex(kind=sp), intent(inout) :: b(ldb,*)
integer(kind=ilp), intent(in) :: ldb
real(kind=sp), intent(in) :: rcond
integer(kind=ilp), intent(out) :: rank
complex(kind=sp), intent(out) :: work(*)
real(kind=sp), intent(out) :: rwork(*)
integer(kind=ilp), intent(out) :: iwork(*)
integer(kind=ilp), intent(out) :: info

public pure subroutine dlalsd(uplo, smlsiz, n, nrhs, d, e, b, ldb, rcond, rank, work, iwork, info)

Arguments

Type IntentOptional Attributes Name
character(len=1), intent(in) :: uplo
integer(kind=ilp), intent(in) :: smlsiz
integer(kind=ilp), intent(in) :: n
integer(kind=ilp), intent(in) :: nrhs
real(kind=dp), intent(inout) :: d(*)
real(kind=dp), intent(inout) :: e(*)
real(kind=dp), intent(inout) :: b(ldb,*)
integer(kind=ilp), intent(in) :: ldb
real(kind=dp), intent(in) :: rcond
integer(kind=ilp), intent(out) :: rank
real(kind=dp), intent(out) :: work(*)
integer(kind=ilp), intent(out) :: iwork(*)
integer(kind=ilp), intent(out) :: info

public pure subroutine slalsd(uplo, smlsiz, n, nrhs, d, e, b, ldb, rcond, rank, work, iwork, info)

Arguments

Type IntentOptional Attributes Name
character(len=1), intent(in) :: uplo
integer(kind=ilp), intent(in) :: smlsiz
integer(kind=ilp), intent(in) :: n
integer(kind=ilp), intent(in) :: nrhs
real(kind=sp), intent(inout) :: d(*)
real(kind=sp), intent(inout) :: e(*)
real(kind=sp), intent(inout) :: b(ldb,*)
integer(kind=ilp), intent(in) :: ldb
real(kind=sp), intent(in) :: rcond
integer(kind=ilp), intent(out) :: rank
real(kind=sp), intent(out) :: work(*)
integer(kind=ilp), intent(out) :: iwork(*)
integer(kind=ilp), intent(out) :: info

public pure subroutine zlalsd(uplo, smlsiz, n, nrhs, d, e, b, ldb, rcond, rank, work, rwork, iwork, info)

Arguments

Type IntentOptional Attributes Name
character(len=1), intent(in) :: uplo
integer(kind=ilp), intent(in) :: smlsiz
integer(kind=ilp), intent(in) :: n
integer(kind=ilp), intent(in) :: nrhs
real(kind=dp), intent(inout) :: d(*)
real(kind=dp), intent(inout) :: e(*)
complex(kind=dp), intent(inout) :: b(ldb,*)
integer(kind=ilp), intent(in) :: ldb
real(kind=dp), intent(in) :: rcond
integer(kind=ilp), intent(out) :: rank
complex(kind=dp), intent(out) :: work(*)
real(kind=dp), intent(out) :: rwork(*)
integer(kind=ilp), intent(out) :: iwork(*)
integer(kind=ilp), intent(out) :: info

Module Procedures

public interface stdlib_clalsd()

Arguments

None

public interface stdlib_dlalsd()

Arguments

None

public interface stdlib_slalsd()

Arguments

None

public interface stdlib_zlalsd()

Arguments

None