273 SUBROUTINE cspsvx( FACT, UPLO, N, NRHS, AP, AFP, IPIV, B, LDB,
275 $ LDX, RCOND, FERR, BERR, WORK, RWORK, INFO )
283 INTEGER INFO, LDB, LDX, N, NRHS
288 REAL BERR( * ), FERR( * ), RWORK( * )
289 COMPLEX AFP( * ), AP( * ), B( LDB, * ), WORK( * ),
297 PARAMETER ( ZERO = 0.0e+0 )
306 EXTERNAL lsame, clansp, slamch
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(
'CSPSVX', -info )
346 CALL ccopy( n*( n+1 ) / 2, ap, 1, afp, 1 )
347 CALL csptrf( uplo, n, afp, ipiv, info )
359 anorm = clansp(
'I', uplo, n, ap, rwork )
363 CALL cspcon( uplo, n, afp, ipiv, anorm, rcond, work, info )
367 CALL clacpy(
'Full', n, nrhs, b, ldb, x, ldx )
368 CALL csptrs( uplo, n, nrhs, afp, ipiv, x, ldx, info )
373 CALL csprfs( uplo, n, nrhs, ap, afp, ipiv, b, ldb, x, ldx,
375 $ berr, work, rwork, info )
379 IF( rcond.LT.slamch(
'Epsilon' ) )
subroutine cspcon(uplo, n, ap, ipiv, anorm, rcond, work, info)
CSPCON
subroutine csprfs(uplo, n, nrhs, ap, afp, ipiv, b, ldb, x, ldx, ferr, berr, work, rwork, info)
CSPRFS
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.