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 zsptrs(UPLO, N, NRHS, AP, IPIV, B, LDB, INFO)
ZSPTRS
subroutine zsptrf(UPLO, N, AP, IPIV, INFO)
ZSPTRF
subroutine zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
subroutine zspcon(UPLO, N, AP, IPIV, ANORM, RCOND, WORK, INFO)
ZSPCON
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 zsprfs(UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZSPRFS