226 SUBROUTINE dptsvx( FACT, N, NRHS, D, E, DF, EF, B, LDB, X, LDX,
227 $ RCOND, FERR, BERR, WORK, INFO )
235 INTEGER INFO, LDB, LDX, N, NRHS
236 DOUBLE PRECISION RCOND
239 DOUBLE PRECISION B( LDB, * ), BERR( * ), D( * ), DF( * ),
240 $ e( * ), ef( * ), ferr( * ), work( * ),
247 DOUBLE PRECISION ZERO
248 parameter( zero = 0.0d+0 )
252 DOUBLE PRECISION ANORM
256 DOUBLE PRECISION DLAMCH, DLANST
257 EXTERNAL lsame, dlamch, dlanst
271 nofact = lsame( fact,
'N' )
272 IF( .NOT.nofact .AND. .NOT.lsame( fact,
'F' ) )
THEN
274 ELSE IF( n.LT.0 )
THEN
276 ELSE IF( nrhs.LT.0 )
THEN
278 ELSE IF( ldb.LT.max( 1, n ) )
THEN
280 ELSE IF( ldx.LT.max( 1, n ) )
THEN
284 CALL xerbla(
'DPTSVX', -info )
292 CALL dcopy( n, d, 1, df, 1 )
294 $
CALL dcopy( n-1, e, 1, ef, 1 )
295 CALL dpttrf( n, df, ef, info )
307 anorm = dlanst(
'1', n, d, e )
311 CALL dptcon( n, df, ef, anorm, rcond, work, info )
315 CALL dlacpy(
'Full', n, nrhs, b, ldb, x, ldx )
316 CALL dpttrs( n, nrhs, df, ef, x, ldx, info )
321 CALL dptrfs( n, nrhs, d, e, df, ef, b, ldb, x, ldx, ferr, berr,
326 IF( rcond.LT.dlamch(
'Epsilon' ) )
subroutine xerbla(srname, info)
subroutine dcopy(n, dx, incx, dy, incy)
DCOPY
subroutine dlacpy(uplo, m, n, a, lda, b, ldb)
DLACPY copies all or part of one two-dimensional array to another.
subroutine dptcon(n, d, e, anorm, rcond, work, info)
DPTCON
subroutine dptrfs(n, nrhs, d, e, df, ef, b, ldb, x, ldx, ferr, berr, work, info)
DPTRFS
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
subroutine dpttrf(n, d, e, info)
DPTTRF
subroutine dpttrs(n, nrhs, d, e, b, ldb, info)
DPTTRS