312 SUBROUTINE sppsvx( FACT, UPLO, N, NRHS, AP, AFP, EQUED, S, B, LDB,
313 $ x, ldx, rcond, ferr, berr, work, iwork, info )
321 CHARACTER EQUED, FACT, UPLO
322 INTEGER INFO, LDB, LDX, N, NRHS
327 REAL AFP( * ), AP( * ), B( ldb, * ), BERR( * ),
328 $ ferr( * ), s( * ), work( * ), x( ldx, * )
335 parameter( zero = 0.0e+0, one = 1.0e+0 )
338 LOGICAL EQUIL, NOFACT, RCEQU
340 REAL AMAX, ANORM, BIGNUM, SCOND, SMAX, SMIN, SMLNUM
345 EXTERNAL lsame, slamch, slansp
357 nofact = lsame( fact,
'N' )
358 equil = lsame( fact,
'E' )
359 IF( nofact .OR. equil )
THEN
363 rcequ = lsame( equed,
'Y' )
364 smlnum = slamch(
'Safe minimum' )
365 bignum = one / smlnum
370 IF( .NOT.nofact .AND. .NOT.equil .AND. .NOT.lsame( fact,
'F' ) )
373 ELSE IF( .NOT.lsame( uplo,
'U' ) .AND. .NOT.lsame( uplo,
'L' ) )
376 ELSE IF( n.LT.0 )
THEN
378 ELSE IF( nrhs.LT.0 )
THEN
380 ELSE IF( lsame( fact,
'F' ) .AND. .NOT.
381 $ ( rcequ .OR. lsame( equed,
'N' ) ) )
THEN
388 smin = min( smin, s( j ) )
389 smax = max( smax, s( j ) )
391 IF( smin.LE.zero )
THEN
393 ELSE IF( n.GT.0 )
THEN
394 scond = max( smin, smlnum ) / min( smax, bignum )
400 IF( ldb.LT.max( 1, n ) )
THEN
402 ELSE IF( ldx.LT.max( 1, n ) )
THEN
409 CALL
xerbla(
'SPPSVX', -info )
417 CALL
sppequ( uplo, n, ap, s, scond, amax, infequ )
418 IF( infequ.EQ.0 )
THEN
422 CALL
slaqsp( uplo, n, ap, s, scond, amax, equed )
423 rcequ = lsame( equed,
'Y' )
432 b( i, j ) = s( i )*b( i, j )
437 IF( nofact .OR. equil )
THEN
441 CALL
scopy( n*( n+1 ) / 2, ap, 1, afp, 1 )
442 CALL
spptrf( uplo, n, afp, info )
454 anorm = slansp(
'I', uplo, n, ap, work )
458 CALL
sppcon( uplo, n, afp, anorm, rcond, work, iwork, info )
462 CALL
slacpy(
'Full', n, nrhs, b, ldb, x, ldx )
463 CALL
spptrs( uplo, n, nrhs, afp, x, ldx, info )
468 CALL
spprfs( uplo, n, nrhs, ap, afp, b, ldb, x, ldx, ferr, berr,
469 $ work, iwork, info )
477 x( i, j ) = s( i )*x( i, j )
481 ferr( j ) = ferr( j ) / scond
487 IF( rcond.LT.slamch(
'Epsilon' ) )
subroutine sppsvx(FACT, UPLO, N, NRHS, AP, AFP, EQUED, S, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, IWORK, INFO)
SPPSVX computes the solution to system of linear equations A * X = B for OTHER matrices ...
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY
subroutine spprfs(UPLO, N, NRHS, AP, AFP, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
SPPRFS
subroutine sppcon(UPLO, N, AP, ANORM, RCOND, WORK, IWORK, INFO)
SPPCON
subroutine slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
subroutine sppequ(UPLO, N, AP, S, SCOND, AMAX, INFO)
SPPEQU
subroutine slaqsp(UPLO, N, AP, S, SCOND, AMAX, EQUED)
SLAQSP scales a symmetric/Hermitian matrix in packed storage, using scaling factors computed by sppeq...
subroutine spptrf(UPLO, N, AP, INFO)
SPPTRF
subroutine spptrs(UPLO, N, NRHS, AP, B, LDB, INFO)
SPPTRS