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 spptrs(UPLO, N, NRHS, AP, B, LDB, INFO)
SPPTRS
subroutine sppcon(UPLO, N, AP, ANORM, RCOND, WORK, IWORK, INFO)
SPPCON
subroutine sppequ(UPLO, N, AP, S, SCOND, AMAX, INFO)
SPPEQU
subroutine spptrf(UPLO, N, AP, INFO)
SPPTRF
subroutine spprfs(UPLO, N, NRHS, AP, AFP, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
SPPRFS
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 slaqsp(UPLO, N, AP, S, SCOND, AMAX, EQUED)
SLAQSP scales a symmetric/Hermitian matrix in packed storage, using scaling factors computed by sppeq...
subroutine slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY