lals0 Interface

public interface lals0

LALS0 applies back the multiplying factors of either the left or the right singular vector matrix of a diagonal matrix appended by a row to the right hand side matrix B in solving the least squares problem using the divide-and-conquer SVD approach. For the left singular vector matrix, three types of orthogonal matrices are involved: (1L) Givens rotations: the number of such rotations is GIVPTR; the pairs of columns/rows they were applied to are stored in GIVCOL; and the C- and S-values of these rotations are stored in GIVNUM. (2L) Permutation. The (NL+1)-st row of B is to be moved to the first row, and for J=2:N, PERM(J)-th row of B is to be moved to the J-th row. (3L) The left singular vector matrix of the remaining matrix. For the right singular vector matrix, four types of orthogonal matrices are involved: (1R) The right singular vector matrix of the remaining matrix. (2R) If SQRE = 1, one extra Givens rotation to generate the right null space. (3R) The inverse transformation of (2L). (4R) The inverse transformation of (1L).


Subroutines

public pure subroutine clals0(icompq, nl, nr, sqre, nrhs, b, ldb, bx, ldbx, perm, givptr, givcol, ldgcol, givnum, ldgnum, poles, difl, difr, z, k, c, s, rwork, info)

Arguments

Type IntentOptional Attributes Name
integer(kind=ilp), intent(in) :: icompq
integer(kind=ilp), intent(in) :: nl
integer(kind=ilp), intent(in) :: nr
integer(kind=ilp), intent(in) :: sqre
integer(kind=ilp), intent(in) :: nrhs
complex(kind=sp), intent(inout) :: b(ldb,*)
integer(kind=ilp), intent(in) :: ldb
complex(kind=sp), intent(out) :: bx(ldbx,*)
integer(kind=ilp), intent(in) :: ldbx
integer(kind=ilp), intent(in) :: perm(*)
integer(kind=ilp), intent(in) :: givptr
integer(kind=ilp), intent(in) :: givcol(ldgcol,*)
integer(kind=ilp), intent(in) :: ldgcol
real(kind=sp), intent(in) :: givnum(ldgnum,*)
integer(kind=ilp), intent(in) :: ldgnum
real(kind=sp), intent(in) :: poles(ldgnum,*)
real(kind=sp), intent(in) :: difl(*)
real(kind=sp), intent(in) :: difr(ldgnum,*)
real(kind=sp), intent(in) :: z(*)
integer(kind=ilp), intent(in) :: k
real(kind=sp), intent(in) :: c
real(kind=sp), intent(in) :: s
real(kind=sp), intent(out) :: rwork(*)
integer(kind=ilp), intent(out) :: info

public pure subroutine dlals0(icompq, nl, nr, sqre, nrhs, b, ldb, bx, ldbx, perm, givptr, givcol, ldgcol, givnum, ldgnum, poles, difl, difr, z, k, c, s, work, info)

Arguments

Type IntentOptional Attributes Name
integer(kind=ilp), intent(in) :: icompq
integer(kind=ilp), intent(in) :: nl
integer(kind=ilp), intent(in) :: nr
integer(kind=ilp), intent(in) :: sqre
integer(kind=ilp), intent(in) :: nrhs
real(kind=dp), intent(inout) :: b(ldb,*)
integer(kind=ilp), intent(in) :: ldb
real(kind=dp), intent(out) :: bx(ldbx,*)
integer(kind=ilp), intent(in) :: ldbx
integer(kind=ilp), intent(in) :: perm(*)
integer(kind=ilp), intent(in) :: givptr
integer(kind=ilp), intent(in) :: givcol(ldgcol,*)
integer(kind=ilp), intent(in) :: ldgcol
real(kind=dp), intent(in) :: givnum(ldgnum,*)
integer(kind=ilp), intent(in) :: ldgnum
real(kind=dp), intent(in) :: poles(ldgnum,*)
real(kind=dp), intent(in) :: difl(*)
real(kind=dp), intent(in) :: difr(ldgnum,*)
real(kind=dp), intent(in) :: z(*)
integer(kind=ilp), intent(in) :: k
real(kind=dp), intent(in) :: c
real(kind=dp), intent(in) :: s
real(kind=dp), intent(out) :: work(*)
integer(kind=ilp), intent(out) :: info

public pure subroutine slals0(icompq, nl, nr, sqre, nrhs, b, ldb, bx, ldbx, perm, givptr, givcol, ldgcol, givnum, ldgnum, poles, difl, difr, z, k, c, s, work, info)

Arguments

Type IntentOptional Attributes Name
integer(kind=ilp), intent(in) :: icompq
integer(kind=ilp), intent(in) :: nl
integer(kind=ilp), intent(in) :: nr
integer(kind=ilp), intent(in) :: sqre
integer(kind=ilp), intent(in) :: nrhs
real(kind=sp), intent(inout) :: b(ldb,*)
integer(kind=ilp), intent(in) :: ldb
real(kind=sp), intent(out) :: bx(ldbx,*)
integer(kind=ilp), intent(in) :: ldbx
integer(kind=ilp), intent(in) :: perm(*)
integer(kind=ilp), intent(in) :: givptr
integer(kind=ilp), intent(in) :: givcol(ldgcol,*)
integer(kind=ilp), intent(in) :: ldgcol
real(kind=sp), intent(in) :: givnum(ldgnum,*)
integer(kind=ilp), intent(in) :: ldgnum
real(kind=sp), intent(in) :: poles(ldgnum,*)
real(kind=sp), intent(in) :: difl(*)
real(kind=sp), intent(in) :: difr(ldgnum,*)
real(kind=sp), intent(in) :: z(*)
integer(kind=ilp), intent(in) :: k
real(kind=sp), intent(in) :: c
real(kind=sp), intent(in) :: s
real(kind=sp), intent(out) :: work(*)
integer(kind=ilp), intent(out) :: info

public pure subroutine zlals0(icompq, nl, nr, sqre, nrhs, b, ldb, bx, ldbx, perm, givptr, givcol, ldgcol, givnum, ldgnum, poles, difl, difr, z, k, c, s, rwork, info)

Arguments

Type IntentOptional Attributes Name
integer(kind=ilp), intent(in) :: icompq
integer(kind=ilp), intent(in) :: nl
integer(kind=ilp), intent(in) :: nr
integer(kind=ilp), intent(in) :: sqre
integer(kind=ilp), intent(in) :: nrhs
complex(kind=dp), intent(inout) :: b(ldb,*)
integer(kind=ilp), intent(in) :: ldb
complex(kind=dp), intent(out) :: bx(ldbx,*)
integer(kind=ilp), intent(in) :: ldbx
integer(kind=ilp), intent(in) :: perm(*)
integer(kind=ilp), intent(in) :: givptr
integer(kind=ilp), intent(in) :: givcol(ldgcol,*)
integer(kind=ilp), intent(in) :: ldgcol
real(kind=dp), intent(in) :: givnum(ldgnum,*)
integer(kind=ilp), intent(in) :: ldgnum
real(kind=dp), intent(in) :: poles(ldgnum,*)
real(kind=dp), intent(in) :: difl(*)
real(kind=dp), intent(in) :: difr(ldgnum,*)
real(kind=dp), intent(in) :: z(*)
integer(kind=ilp), intent(in) :: k
real(kind=dp), intent(in) :: c
real(kind=dp), intent(in) :: s
real(kind=dp), intent(out) :: rwork(*)
integer(kind=ilp), intent(out) :: info

Module Procedures

public interface stdlib_clals0()

Arguments

None

public interface stdlib_dlals0()

Arguments

None

public interface stdlib_slals0()

Arguments

None

public interface stdlib_zlals0()

Arguments

None