latbs Interface

public interface latbs

LATBS solves one of the triangular systems A * x = sb, AT * x = sb, or AH * x = s*b, with scaling to prevent overflow, where A is an upper or lower triangular band matrix. Here AT denotes the transpose of A, x and b are n-element vectors, and s is a scaling factor, usually less than or equal to 1, chosen so that the components of x will be less than the overflow threshold. If the unscaled problem will not cause overflow, the Level 2 BLAS routine CTBSV is called. If the matrix A is singular (A(j,j) = 0 for some j), then s is set to 0 and a non-trivial solution to A*x = 0 is returned.


Subroutines

public pure subroutine clatbs(uplo, trans, diag, normin, n, kd, ab, ldab, x, scale, cnorm, info)

Arguments

Type IntentOptional Attributes Name
character(len=1), intent(in) :: uplo
character(len=1), intent(in) :: trans
character(len=1), intent(in) :: diag
character(len=1), intent(in) :: normin
integer(kind=ilp), intent(in) :: n
integer(kind=ilp), intent(in) :: kd
complex(kind=sp), intent(in) :: ab(ldab,*)
integer(kind=ilp), intent(in) :: ldab
complex(kind=sp), intent(inout) :: x(*)
real(kind=sp), intent(out) :: scale
real(kind=sp), intent(inout) :: cnorm(*)
integer(kind=ilp), intent(out) :: info

public pure subroutine dlatbs(uplo, trans, diag, normin, n, kd, ab, ldab, x, scale, cnorm, info)

Arguments

Type IntentOptional Attributes Name
character(len=1), intent(in) :: uplo
character(len=1), intent(in) :: trans
character(len=1), intent(in) :: diag
character(len=1), intent(in) :: normin
integer(kind=ilp), intent(in) :: n
integer(kind=ilp), intent(in) :: kd
real(kind=dp), intent(in) :: ab(ldab,*)
integer(kind=ilp), intent(in) :: ldab
real(kind=dp), intent(inout) :: x(*)
real(kind=dp), intent(out) :: scale
real(kind=dp), intent(inout) :: cnorm(*)
integer(kind=ilp), intent(out) :: info

public pure subroutine slatbs(uplo, trans, diag, normin, n, kd, ab, ldab, x, scale, cnorm, info)

Arguments

Type IntentOptional Attributes Name
character(len=1), intent(in) :: uplo
character(len=1), intent(in) :: trans
character(len=1), intent(in) :: diag
character(len=1), intent(in) :: normin
integer(kind=ilp), intent(in) :: n
integer(kind=ilp), intent(in) :: kd
real(kind=sp), intent(in) :: ab(ldab,*)
integer(kind=ilp), intent(in) :: ldab
real(kind=sp), intent(inout) :: x(*)
real(kind=sp), intent(out) :: scale
real(kind=sp), intent(inout) :: cnorm(*)
integer(kind=ilp), intent(out) :: info

public pure subroutine zlatbs(uplo, trans, diag, normin, n, kd, ab, ldab, x, scale, cnorm, info)

Arguments

Type IntentOptional Attributes Name
character(len=1), intent(in) :: uplo
character(len=1), intent(in) :: trans
character(len=1), intent(in) :: diag
character(len=1), intent(in) :: normin
integer(kind=ilp), intent(in) :: n
integer(kind=ilp), intent(in) :: kd
complex(kind=dp), intent(in) :: ab(ldab,*)
integer(kind=ilp), intent(in) :: ldab
complex(kind=dp), intent(inout) :: x(*)
real(kind=dp), intent(out) :: scale
real(kind=dp), intent(inout) :: cnorm(*)
integer(kind=ilp), intent(out) :: info

Module Procedures

public interface stdlib_clatbs()

Arguments

None

public interface stdlib_dlatbs()

Arguments

None

public interface stdlib_slatbs()

Arguments

None

public interface stdlib_zlatbs()

Arguments

None