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
259 DOUBLE PRECISION DLAMCH, DLANST
260 EXTERNAL lsame, dlamch, dlanst
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 dcopy(N, DX, INCX, DY, INCY)
DCOPY
subroutine dpttrf(N, D, E, INFO)
DPTTRF
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 xerbla(SRNAME, INFO)
XERBLA
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