277 SUBROUTINE zspsvx( FACT, UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X,
278 $ ldx, rcond, ferr, berr, work, rwork, info )
287 INTEGER INFO, LDB, LDX, N, NRHS
288 DOUBLE PRECISION RCOND
292 DOUBLE PRECISION BERR( * ), FERR( * ), RWORK( * )
293 COMPLEX*16 AFP( * ), AP( * ), B( ldb, * ), WORK( * ),
300 DOUBLE PRECISION ZERO
301 parameter( zero = 0.0d+0 )
305 DOUBLE PRECISION ANORM
309 DOUBLE PRECISION DLAMCH, ZLANSP
310 EXTERNAL lsame, dlamch, zlansp
324 nofact = lsame( fact,
'N' )
325 IF( .NOT.nofact .AND. .NOT.lsame( fact,
'F' ) )
THEN
327 ELSE IF( .NOT.lsame( uplo,
'U' ) .AND. .NOT.lsame( uplo,
'L' ) )
330 ELSE IF( n.LT.0 )
THEN
332 ELSE IF( nrhs.LT.0 )
THEN
334 ELSE IF( ldb.LT.max( 1, n ) )
THEN
336 ELSE IF( ldx.LT.max( 1, n ) )
THEN
340 CALL
xerbla(
'ZSPSVX', -info )
348 CALL
zcopy( n*( n+1 ) / 2, ap, 1, afp, 1 )
349 CALL
zsptrf( uplo, n, afp, ipiv, info )
361 anorm = zlansp(
'I', uplo, n, ap, rwork )
365 CALL
zspcon( uplo, n, afp, ipiv, anorm, rcond, work, info )
369 CALL
zlacpy(
'Full', n, nrhs, b, ldb, x, ldx )
370 CALL
zsptrs( uplo, n, nrhs, afp, ipiv, x, ldx, info )
375 CALL
zsprfs( uplo, n, nrhs, ap, afp, ipiv, b, ldb, x, ldx, ferr,
376 $ berr, work, rwork, info )
380 IF( rcond.LT.dlamch(
'Epsilon' ) )
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine zspsvx(FACT, UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, RWORK, INFO)
ZSPSVX computes the solution to system of linear equations A * X = B for OTHER matrices ...
subroutine zspcon(UPLO, N, AP, IPIV, ANORM, RCOND, WORK, INFO)
ZSPCON
subroutine zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
subroutine zsprfs(UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZSPRFS
subroutine zsptrf(UPLO, N, AP, IPIV, INFO)
ZSPTRF
subroutine zsptrs(UPLO, N, NRHS, AP, IPIV, B, LDB, INFO)
ZSPTRS