224 SUBROUTINE sptsvx( FACT, N, NRHS, D, E, DF, EF, B, LDB, X, LDX,
225 $ RCOND, FERR, BERR, WORK, INFO )
233 INTEGER INFO, LDB, LDX, N, NRHS
237 REAL B( LDB, * ), BERR( * ), D( * ), DF( * ),
238 $ e( * ), ef( * ), ferr( * ), work( * ),
246 parameter( zero = 0.0e+0 )
255 EXTERNAL lsame, slamch, slanst
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(
'SPTSVX', -info )
291 CALL scopy( n, d, 1, df, 1 )
293 $
CALL scopy( n-1, e, 1, ef, 1 )
294 CALL spttrf( n, df, ef, info )
306 anorm = slanst(
'1', n, d, e )
310 CALL sptcon( n, df, ef, anorm, rcond, work, info )
314 CALL slacpy(
'Full', n, nrhs, b, ldb, x, ldx )
315 CALL spttrs( n, nrhs, df, ef, x, ldx, info )
320 CALL sptrfs( n, nrhs, d, e, df, ef, b, ldb, x, ldx, ferr, berr,
325 IF( rcond.LT.slamch(
'Epsilon' ) )
subroutine slacpy(uplo, m, n, a, lda, b, ldb)
SLACPY copies all or part of one two-dimensional array to another.
subroutine sptcon(n, d, e, anorm, rcond, work, info)
SPTCON
subroutine sptrfs(n, nrhs, d, e, df, ef, b, ldb, x, ldx, ferr, berr, work, info)
SPTRFS
subroutine sptsvx(fact, n, nrhs, d, e, df, ef, b, ldb, x, ldx, rcond, ferr, berr, work, info)
SPTSVX computes the solution to system of linear equations A * X = B for PT matrices
subroutine spttrs(n, nrhs, d, e, b, ldb, info)
SPTTRS