272 SUBROUTINE dspsvx( FACT, UPLO, N, NRHS, AP, AFP, IPIV, B, LDB,
274 $ LDX, RCOND, FERR, BERR, WORK, IWORK, INFO )
282 INTEGER INFO, LDB, LDX, N, NRHS
283 DOUBLE PRECISION RCOND
286 INTEGER IPIV( * ), IWORK( * )
287 DOUBLE PRECISION AFP( * ), AP( * ), B( LDB, * ), BERR( * ),
288 $ ferr( * ), work( * ), x( ldx, * )
294 DOUBLE PRECISION ZERO
295 PARAMETER ( ZERO = 0.0d+0 )
299 DOUBLE PRECISION ANORM
303 DOUBLE PRECISION DLAMCH, DLANSP
304 EXTERNAL lsame, dlamch, dlansp
319 nofact = lsame( fact,
'N' )
320 IF( .NOT.nofact .AND. .NOT.lsame( fact,
'F' ) )
THEN
322 ELSE IF( .NOT.lsame( uplo,
'U' ) .AND.
323 $ .NOT.lsame( uplo,
'L' ) )
326 ELSE IF( n.LT.0 )
THEN
328 ELSE IF( nrhs.LT.0 )
THEN
330 ELSE IF( ldb.LT.max( 1, n ) )
THEN
332 ELSE IF( ldx.LT.max( 1, n ) )
THEN
336 CALL xerbla(
'DSPSVX', -info )
344 CALL dcopy( n*( n+1 ) / 2, ap, 1, afp, 1 )
345 CALL dsptrf( uplo, n, afp, ipiv, info )
357 anorm = dlansp(
'I', uplo, n, ap, work )
361 CALL dspcon( uplo, n, afp, ipiv, anorm, rcond, work, iwork,
366 CALL dlacpy(
'Full', n, nrhs, b, ldb, x, ldx )
367 CALL dsptrs( uplo, n, nrhs, afp, ipiv, x, ldx, info )
372 CALL dsprfs( uplo, n, nrhs, ap, afp, ipiv, b, ldb, x, ldx,
374 $ berr, work, iwork, info )
378 IF( rcond.LT.dlamch(
'Epsilon' ) )
subroutine dspcon(uplo, n, ap, ipiv, anorm, rcond, work, iwork, info)
DSPCON
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 dsptrs(uplo, n, nrhs, ap, ipiv, b, ldb, info)
DSPTRS
subroutine dlacpy(uplo, m, n, a, lda, b, ldb)
DLACPY copies all or part of one two-dimensional array to another.