lasd7 Interface

public interface lasd7

LASD7 merges the two sets of singular values together into a single sorted set. Then it tries to deflate the size of the problem. There are two ways in which deflation can occur: when two or more singular values are close together or if there is a tiny entry in the Z vector. For each such occurrence the order of the related secular equation problem is reduced by one. LASD7 is called from DLASD6.


Subroutines

public pure subroutine dlasd7(icompq, nl, nr, sqre, k, d, z, zw, vf, vfw, vl, vlw, alpha, beta, dsigma, idx, idxp, idxq, perm, givptr, givcol, ldgcol, givnum, ldgnum, c, s, 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(out) :: k
real(kind=dp), intent(inout) :: d(*)
real(kind=dp), intent(out) :: z(*)
real(kind=dp), intent(out) :: zw(*)
real(kind=dp), intent(inout) :: vf(*)
real(kind=dp), intent(out) :: vfw(*)
real(kind=dp), intent(inout) :: vl(*)
real(kind=dp), intent(out) :: vlw(*)
real(kind=dp), intent(in) :: alpha
real(kind=dp), intent(in) :: beta
real(kind=dp), intent(out) :: dsigma(*)
integer(kind=ilp), intent(out) :: idx(*)
integer(kind=ilp), intent(out) :: idxp(*)
integer(kind=ilp), intent(inout) :: idxq(*)
integer(kind=ilp), intent(out) :: perm(*)
integer(kind=ilp), intent(out) :: givptr
integer(kind=ilp), intent(out) :: givcol(ldgcol,*)
integer(kind=ilp), intent(in) :: ldgcol
real(kind=dp), intent(out) :: givnum(ldgnum,*)
integer(kind=ilp), intent(in) :: ldgnum
real(kind=dp), intent(out) :: c
real(kind=dp), intent(out) :: s
integer(kind=ilp), intent(out) :: info

public pure subroutine slasd7(icompq, nl, nr, sqre, k, d, z, zw, vf, vfw, vl, vlw, alpha, beta, dsigma, idx, idxp, idxq, perm, givptr, givcol, ldgcol, givnum, ldgnum, c, s, 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(out) :: k
real(kind=sp), intent(inout) :: d(*)
real(kind=sp), intent(out) :: z(*)
real(kind=sp), intent(out) :: zw(*)
real(kind=sp), intent(inout) :: vf(*)
real(kind=sp), intent(out) :: vfw(*)
real(kind=sp), intent(inout) :: vl(*)
real(kind=sp), intent(out) :: vlw(*)
real(kind=sp), intent(in) :: alpha
real(kind=sp), intent(in) :: beta
real(kind=sp), intent(out) :: dsigma(*)
integer(kind=ilp), intent(out) :: idx(*)
integer(kind=ilp), intent(out) :: idxp(*)
integer(kind=ilp), intent(inout) :: idxq(*)
integer(kind=ilp), intent(out) :: perm(*)
integer(kind=ilp), intent(out) :: givptr
integer(kind=ilp), intent(out) :: givcol(ldgcol,*)
integer(kind=ilp), intent(in) :: ldgcol
real(kind=sp), intent(out) :: givnum(ldgnum,*)
integer(kind=ilp), intent(in) :: ldgnum
real(kind=sp), intent(out) :: c
real(kind=sp), intent(out) :: s
integer(kind=ilp), intent(out) :: info

Module Procedures

public interface stdlib_dlasd7()

Arguments

None

public interface stdlib_slasd7()

Arguments

None