277 SUBROUTINE dspsvx( FACT, UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X,
278 $ ldx, rcond, ferr, berr, work, iwork, info )
287 INTEGER INFO, LDB, LDX, N, NRHS
288 DOUBLE PRECISION RCOND
291 INTEGER IPIV( * ), IWORK( * )
292 DOUBLE PRECISION AFP( * ), AP( * ), B( ldb, * ), BERR( * ),
293 $ ferr( * ), work( * ), x( ldx, * )
299 DOUBLE PRECISION ZERO
300 parameter( zero = 0.0d+0 )
304 DOUBLE PRECISION ANORM
308 DOUBLE PRECISION DLAMCH, DLANSP
309 EXTERNAL lsame, dlamch, dlansp
323 nofact = lsame( fact,
'N' )
324 IF( .NOT.nofact .AND. .NOT.lsame( fact,
'F' ) )
THEN
326 ELSE IF( .NOT.lsame( uplo,
'U' ) .AND. .NOT.lsame( uplo,
'L' ) )
329 ELSE IF( n.LT.0 )
THEN
331 ELSE IF( nrhs.LT.0 )
THEN
333 ELSE IF( ldb.LT.max( 1, n ) )
THEN
335 ELSE IF( ldx.LT.max( 1, n ) )
THEN
339 CALL
xerbla(
'DSPSVX', -info )
347 CALL
dcopy( n*( n+1 ) / 2, ap, 1, afp, 1 )
348 CALL
dsptrf( uplo, n, afp, ipiv, info )
360 anorm = dlansp(
'I', uplo, n, ap, work )
364 CALL
dspcon( uplo, n, afp, ipiv, anorm, rcond, work, iwork, info )
368 CALL
dlacpy(
'Full', n, nrhs, b, ldb, x, ldx )
369 CALL
dsptrs( uplo, n, nrhs, afp, ipiv, x, ldx, info )
374 CALL
dsprfs( uplo, n, nrhs, ap, afp, ipiv, b, ldb, x, ldx, ferr,
375 $ berr, work, iwork, info )
379 IF( rcond.LT.dlamch(
'Epsilon' ) )
subroutine dsptrs(UPLO, N, NRHS, AP, IPIV, B, LDB, INFO)
DSPTRS
subroutine dspcon(UPLO, N, AP, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
DSPCON
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dsprfs(UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
DSPRFS
subroutine dspsvx(FACT, UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, IWORK, INFO)
DSPSVX computes the solution to system of linear equations A * X = B for OTHER matrices ...
subroutine dsptrf(UPLO, N, AP, IPIV, INFO)
DSPTRF
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.