laic1 Interface

public interface laic1

LAIC1 applies one step of incremental condition estimation in its simplest version: Let x, twonorm(x) = 1, be an approximate singular vector of an j-by-j lower triangular matrix L, such that twonorm(Lx) = sest Then LAIC1 computes sestpr, s, c such that the vector [ sx ] xhat = [ c ] is an approximate singular vector of [ L 0 ] Lhat = [ wH gamma ] in the sense that twonorm(Lhat*xhat) = sestpr. Depending on JOB, an estimate for the largest or smallest singular value is computed. Note that [s c]H and sestpr2 is an eigenpair of the system diag(sest*sest, 0) + [alpha gamma] * [ conjg(alpha) ] [ conjg(gamma) ] where alpha = xH*w.


Subroutines

public pure subroutine claic1(job, j, x, sest, w, gamma, sestpr, s, c)

Arguments

Type IntentOptional Attributes Name
integer(kind=ilp), intent(in) :: job
integer(kind=ilp), intent(in) :: j
complex(kind=sp), intent(in) :: x(j)
real(kind=sp), intent(in) :: sest
complex(kind=sp), intent(in) :: w(j)
complex(kind=sp), intent(in) :: gamma
real(kind=sp), intent(out) :: sestpr
complex(kind=sp), intent(out) :: s
complex(kind=sp), intent(out) :: c

public pure subroutine dlaic1(job, j, x, sest, w, gamma, sestpr, s, c)

Arguments

Type IntentOptional Attributes Name
integer(kind=ilp), intent(in) :: job
integer(kind=ilp), intent(in) :: j
real(kind=dp), intent(in) :: x(j)
real(kind=dp), intent(in) :: sest
real(kind=dp), intent(in) :: w(j)
real(kind=dp), intent(in) :: gamma
real(kind=dp), intent(out) :: sestpr
real(kind=dp), intent(out) :: s
real(kind=dp), intent(out) :: c

public pure subroutine slaic1(job, j, x, sest, w, gamma, sestpr, s, c)

Arguments

Type IntentOptional Attributes Name
integer(kind=ilp), intent(in) :: job
integer(kind=ilp), intent(in) :: j
real(kind=sp), intent(in) :: x(j)
real(kind=sp), intent(in) :: sest
real(kind=sp), intent(in) :: w(j)
real(kind=sp), intent(in) :: gamma
real(kind=sp), intent(out) :: sestpr
real(kind=sp), intent(out) :: s
real(kind=sp), intent(out) :: c

public pure subroutine zlaic1(job, j, x, sest, w, gamma, sestpr, s, c)

Arguments

Type IntentOptional Attributes Name
integer(kind=ilp), intent(in) :: job
integer(kind=ilp), intent(in) :: j
complex(kind=dp), intent(in) :: x(j)
real(kind=dp), intent(in) :: sest
complex(kind=dp), intent(in) :: w(j)
complex(kind=dp), intent(in) :: gamma
real(kind=dp), intent(out) :: sestpr
complex(kind=dp), intent(out) :: s
complex(kind=dp), intent(out) :: c

Module Procedures

public interface stdlib_claic1()

Arguments

None

public interface stdlib_dlaic1()

Arguments

None

public interface stdlib_slaic1()

Arguments

None

public interface stdlib_zlaic1()

Arguments

None