lar1v Interface

public interface lar1v

LAR1V computes the (scaled) r-th column of the inverse of the sumbmatrix in rows B1 through BN of the tridiagonal matrix L D LT - sigma I. When sigma is close to an eigenvalue, the computed vector is an accurate eigenvector. Usually, r corresponds to the index where the eigenvector is largest in magnitude. The following steps accomplish this computation : (a) Stationary qd transform, L D LT - sigma I = L(+) D(+) L(+)T, (b) Progressive qd transform, L D LT - sigma I = U(-) D(-) U(-)T, (c) Computation of the diagonal elements of the inverse of L D LT - sigma I by combining the above transforms, and choosing r as the index where the diagonal of the inverse is (one of the) largest in magnitude. (d) Computation of the (scaled) r-th column of the inverse using the twisted factorization obtained by combining the top part of the the stationary and the bottom part of the progressive transform.


Subroutines

public pure subroutine clar1v(n, b1, bn, lambda, d, l, ld, lld, pivmin, gaptol, z, wantnc, negcnt, ztz, mingma, r, isuppz, nrminv, resid, rqcorr, work)

Arguments

Type IntentOptional Attributes Name
integer(kind=ilp), intent(in) :: n
integer(kind=ilp), intent(in) :: b1
integer(kind=ilp), intent(in) :: bn
real(kind=sp), intent(in) :: lambda
real(kind=sp), intent(in) :: d(*)
real(kind=sp), intent(in) :: l(*)
real(kind=sp), intent(in) :: ld(*)
real(kind=sp), intent(in) :: lld(*)
real(kind=sp), intent(in) :: pivmin
real(kind=sp), intent(in) :: gaptol
complex(kind=sp), intent(inout) :: z(*)
logical(kind=lk), intent(in) :: wantnc
integer(kind=ilp), intent(out) :: negcnt
real(kind=sp), intent(out) :: ztz
real(kind=sp), intent(out) :: mingma
integer(kind=ilp), intent(inout) :: r
integer(kind=ilp), intent(out) :: isuppz(*)
real(kind=sp), intent(out) :: nrminv
real(kind=sp), intent(out) :: resid
real(kind=sp), intent(out) :: rqcorr
real(kind=sp), intent(out) :: work(*)

public pure subroutine dlar1v(n, b1, bn, lambda, d, l, ld, lld, pivmin, gaptol, z, wantnc, negcnt, ztz, mingma, r, isuppz, nrminv, resid, rqcorr, work)

Arguments

Type IntentOptional Attributes Name
integer(kind=ilp), intent(in) :: n
integer(kind=ilp), intent(in) :: b1
integer(kind=ilp), intent(in) :: bn
real(kind=dp), intent(in) :: lambda
real(kind=dp), intent(in) :: d(*)
real(kind=dp), intent(in) :: l(*)
real(kind=dp), intent(in) :: ld(*)
real(kind=dp), intent(in) :: lld(*)
real(kind=dp), intent(in) :: pivmin
real(kind=dp), intent(in) :: gaptol
real(kind=dp), intent(inout) :: z(*)
logical(kind=lk), intent(in) :: wantnc
integer(kind=ilp), intent(out) :: negcnt
real(kind=dp), intent(out) :: ztz
real(kind=dp), intent(out) :: mingma
integer(kind=ilp), intent(inout) :: r
integer(kind=ilp), intent(out) :: isuppz(*)
real(kind=dp), intent(out) :: nrminv
real(kind=dp), intent(out) :: resid
real(kind=dp), intent(out) :: rqcorr
real(kind=dp), intent(out) :: work(*)

public pure subroutine slar1v(n, b1, bn, lambda, d, l, ld, lld, pivmin, gaptol, z, wantnc, negcnt, ztz, mingma, r, isuppz, nrminv, resid, rqcorr, work)

Arguments

Type IntentOptional Attributes Name
integer(kind=ilp), intent(in) :: n
integer(kind=ilp), intent(in) :: b1
integer(kind=ilp), intent(in) :: bn
real(kind=sp), intent(in) :: lambda
real(kind=sp), intent(in) :: d(*)
real(kind=sp), intent(in) :: l(*)
real(kind=sp), intent(in) :: ld(*)
real(kind=sp), intent(in) :: lld(*)
real(kind=sp), intent(in) :: pivmin
real(kind=sp), intent(in) :: gaptol
real(kind=sp), intent(inout) :: z(*)
logical(kind=lk), intent(in) :: wantnc
integer(kind=ilp), intent(out) :: negcnt
real(kind=sp), intent(out) :: ztz
real(kind=sp), intent(out) :: mingma
integer(kind=ilp), intent(inout) :: r
integer(kind=ilp), intent(out) :: isuppz(*)
real(kind=sp), intent(out) :: nrminv
real(kind=sp), intent(out) :: resid
real(kind=sp), intent(out) :: rqcorr
real(kind=sp), intent(out) :: work(*)

public pure subroutine zlar1v(n, b1, bn, lambda, d, l, ld, lld, pivmin, gaptol, z, wantnc, negcnt, ztz, mingma, r, isuppz, nrminv, resid, rqcorr, work)

Arguments

Type IntentOptional Attributes Name
integer(kind=ilp), intent(in) :: n
integer(kind=ilp), intent(in) :: b1
integer(kind=ilp), intent(in) :: bn
real(kind=dp), intent(in) :: lambda
real(kind=dp), intent(in) :: d(*)
real(kind=dp), intent(in) :: l(*)
real(kind=dp), intent(in) :: ld(*)
real(kind=dp), intent(in) :: lld(*)
real(kind=dp), intent(in) :: pivmin
real(kind=dp), intent(in) :: gaptol
complex(kind=dp), intent(inout) :: z(*)
logical(kind=lk), intent(in) :: wantnc
integer(kind=ilp), intent(out) :: negcnt
real(kind=dp), intent(out) :: ztz
real(kind=dp), intent(out) :: mingma
integer(kind=ilp), intent(inout) :: r
integer(kind=ilp), intent(out) :: isuppz(*)
real(kind=dp), intent(out) :: nrminv
real(kind=dp), intent(out) :: resid
real(kind=dp), intent(out) :: rqcorr
real(kind=dp), intent(out) :: work(*)

Module Procedures

public interface stdlib_clar1v()

Arguments

None

public interface stdlib_dlar1v()

Arguments

None

public interface stdlib_slar1v()

Arguments

None

public interface stdlib_zlar1v()

Arguments

None