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
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 ...
REAL function slansp(NORM, UPLO, N, AP, WORK)
SLANSP returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a symmetric matrix supplied in packed form.
LOGICAL function lsame(CA, CB)
LSAME
REAL function slamch(CMACH)
SLAMCH
subroutine xerbla(SRNAME, INFO)
XERBLA
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
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
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
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