224 SUBROUTINE dptsvx( FACT, N, NRHS, D, E, DF, EF, B, LDB, X, LDX,
225 $ RCOND, FERR, BERR, WORK, INFO )
233 INTEGER INFO, LDB, LDX, N, NRHS
234 DOUBLE PRECISION RCOND
237 DOUBLE PRECISION B( LDB, * ), BERR( * ), D( * ), DF( * ),
238 $ e( * ), ef( * ), ferr( * ), work( * ),
245 DOUBLE PRECISION ZERO
246 parameter( zero = 0.0d+0 )
250 DOUBLE PRECISION ANORM
254 DOUBLE PRECISION DLAMCH, DLANST
255 EXTERNAL lsame, dlamch, dlanst
270 nofact = lsame( fact,
'N' )
271 IF( .NOT.nofact .AND. .NOT.lsame( fact,
'F' ) )
THEN
273 ELSE IF( n.LT.0 )
THEN
275 ELSE IF( nrhs.LT.0 )
THEN
277 ELSE IF( ldb.LT.max( 1, n ) )
THEN
279 ELSE IF( ldx.LT.max( 1, n ) )
THEN
283 CALL xerbla(
'DPTSVX', -info )
291 CALL dcopy( n, d, 1, df, 1 )
293 $
CALL dcopy( n-1, e, 1, ef, 1 )
294 CALL dpttrf( n, df, ef, info )
306 anorm = dlanst(
'1', n, d, e )
310 CALL dptcon( n, df, ef, anorm, rcond, work, info )
314 CALL dlacpy(
'Full', n, nrhs, b, ldb, x, ldx )
315 CALL dpttrs( n, nrhs, df, ef, x, ldx, info )
320 CALL dptrfs( n, nrhs, d, e, df, ef, b, ldb, x, ldx, ferr, berr,
325 IF( rcond.LT.dlamch(
'Epsilon' ) )
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 dpttrs(n, nrhs, d, e, b, ldb, info)
DPTTRS