277 SUBROUTINE cspsvx( 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
292 REAL BERR( * ), FERR( * ), RWORK( * )
293 COMPLEX AFP( * ), AP( * ), B( ldb, * ), WORK( * ),
301 parameter ( zero = 0.0e+0 )
310 EXTERNAL lsame, clansp, slamch
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(
'CSPSVX', -info )
348 CALL ccopy( n*( n+1 ) / 2, ap, 1, afp, 1 )
349 CALL csptrf( uplo, n, afp, ipiv, info )
361 anorm = clansp(
'I', uplo, n, ap, rwork )
365 CALL cspcon( uplo, n, afp, ipiv, anorm, rcond, work, info )
369 CALL clacpy(
'Full', n, nrhs, b, ldb, x, ldx )
370 CALL csptrs( uplo, n, nrhs, afp, ipiv, x, ldx, info )
375 CALL csprfs( uplo, n, nrhs, ap, afp, ipiv, b, ldb, x, ldx, ferr,
376 $ berr, work, rwork, info )
380 IF( rcond.LT.slamch(
'Epsilon' ) )
subroutine cspcon(UPLO, N, AP, IPIV, ANORM, RCOND, WORK, INFO)
CSPCON
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine csptrf(UPLO, N, AP, IPIV, INFO)
CSPTRF
subroutine cspsvx(FACT, UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, RWORK, INFO)
CSPSVX computes the solution to system of linear equations A * X = B for OTHER matrices ...
subroutine csptrs(UPLO, N, NRHS, AP, IPIV, B, LDB, INFO)
CSPTRS
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
subroutine csprfs(UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
CSPRFS
subroutine ccopy(N, CX, INCX, CY, INCY)
CCOPY