273 SUBROUTINE zspsvx( FACT, UPLO, N, NRHS, AP, AFP, IPIV, B, LDB,
275 $ LDX, RCOND, FERR, BERR, WORK, RWORK, INFO )
283 INTEGER INFO, LDB, LDX, N, NRHS
284 DOUBLE PRECISION RCOND
288 DOUBLE PRECISION BERR( * ), FERR( * ), RWORK( * )
289 COMPLEX*16 AFP( * ), AP( * ), B( LDB, * ), WORK( * ),
296 DOUBLE PRECISION ZERO
297 PARAMETER ( ZERO = 0.0d+0 )
301 DOUBLE PRECISION ANORM
305 DOUBLE PRECISION DLAMCH, ZLANSP
306 EXTERNAL lsame, dlamch, zlansp
321 nofact = lsame( fact,
'N' )
322 IF( .NOT.nofact .AND. .NOT.lsame( fact,
'F' ) )
THEN
324 ELSE IF( .NOT.lsame( uplo,
'U' ) .AND.
325 $ .NOT.lsame( uplo,
'L' ) )
328 ELSE IF( n.LT.0 )
THEN
330 ELSE IF( nrhs.LT.0 )
THEN
332 ELSE IF( ldb.LT.max( 1, n ) )
THEN
334 ELSE IF( ldx.LT.max( 1, n ) )
THEN
338 CALL xerbla(
'ZSPSVX', -info )
346 CALL zcopy( n*( n+1 ) / 2, ap, 1, afp, 1 )
347 CALL zsptrf( uplo, n, afp, ipiv, info )
359 anorm = zlansp(
'I', uplo, n, ap, rwork )
363 CALL zspcon( uplo, n, afp, ipiv, anorm, rcond, work, info )
367 CALL zlacpy(
'Full', n, nrhs, b, ldb, x, ldx )
368 CALL zsptrs( uplo, n, nrhs, afp, ipiv, x, ldx, info )
373 CALL zsprfs( uplo, n, nrhs, ap, afp, ipiv, b, ldb, x, ldx,
375 $ berr, work, rwork, info )
379 IF( rcond.LT.dlamch(
'Epsilon' ) )
subroutine zspcon(uplo, n, ap, ipiv, anorm, rcond, work, info)
ZSPCON
subroutine zsprfs(uplo, n, nrhs, ap, afp, ipiv, b, ldb, x, ldx, ferr, berr, work, rwork, info)
ZSPRFS
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 zsptrs(uplo, n, nrhs, ap, ipiv, b, ldb, info)
ZSPTRS
subroutine zlacpy(uplo, m, n, a, lda, b, ldb)
ZLACPY copies all or part of one two-dimensional array to another.