228 SUBROUTINE dptsvx( FACT, N, NRHS, D, E, DF, EF, B, LDB, X, LDX,
229 $ rcond, ferr, berr, work, info )
238 INTEGER info, ldb, ldx, n, nrhs
239 DOUBLE PRECISION rcond
242 DOUBLE PRECISION b( ldb, * ), berr( * ), d( * ), df( * ),
243 $ e( * ), ef( * ), ferr( * ), work( * ),
250 DOUBLE PRECISION zero
251 parameter( zero = 0.0d+0 )
255 DOUBLE PRECISION anorm
274 nofact =
lsame( fact,
'N' )
275 IF( .NOT.nofact .AND. .NOT.
lsame( fact,
'F' ) )
THEN
277 ELSE IF( n.LT.0 )
THEN
279 ELSE IF( nrhs.LT.0 )
THEN
281 ELSE IF( ldb.LT.max( 1, n ) )
THEN
283 ELSE IF( ldx.LT.max( 1, n ) )
THEN
287 CALL
xerbla(
'DPTSVX', -info )
295 CALL
dcopy( n, d, 1, df, 1 )
297 $ CALL
dcopy( n-1, e, 1, ef, 1 )
298 CALL
dpttrf( n, df, ef, info )
310 anorm =
dlanst(
'1', n, d, e )
314 CALL
dptcon( n, df, ef, anorm, rcond, work, info )
318 CALL
dlacpy(
'Full', n, nrhs,
b, ldb, x, ldx )
319 CALL
dpttrs( n, nrhs, df, ef, x, ldx, info )
324 CALL
dptrfs( n, nrhs, d, e, df, ef,
b, ldb, x, ldx, ferr, berr,
329 IF( rcond.LT.
dlamch(
'Epsilon' ) )
subroutine dpttrf(N, D, E, INFO)
DPTTRF
subroutine dptrfs(N, NRHS, D, E, DF, EF, B, LDB, X, LDX, FERR, BERR, WORK, INFO)
DPTRFS
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dptsvx(FACT, N, NRHS, D, E, DF, EF, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, INFO)
DPTSVX computes the solution to system of linear equations A * X = B for PT matrices ...
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
logical function lsame(CA, CB)
LSAME
subroutine dpttrs(N, NRHS, D, E, B, LDB, INFO)
DPTTRS
double precision function dlanst(NORM, N, D, E)
DLANST returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a real symmetric tridiagonal matrix.
subroutine dptcon(N, D, E, ANORM, RCOND, WORK, INFO)
DPTCON
double precision function dlamch(CMACH)
DLAMCH
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.