179 SUBROUTINE ssprfs( UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX,
180 $ ferr, berr, work, iwork, info )
189 INTEGER info, ldb, ldx, n, nrhs
192 INTEGER ipiv( * ), iwork( * )
193 REAL afp( * ), ap( * ),
b( ldb, * ), berr( * ),
194 $ ferr( * ), work( * ),
x( ldx, * )
201 parameter( itmax = 5 )
203 parameter( zero = 0.0e+0 )
205 parameter( one = 1.0e+0 )
207 parameter( two = 2.0e+0 )
209 parameter( three = 3.0e+0 )
213 INTEGER count, i, ik,
j, k, kase, kk, nz
214 REAL eps, lstres, s, safe1, safe2, safmin, xk
235 upper =
lsame( uplo,
'U' )
236 IF( .NOT.upper .AND. .NOT.
lsame( uplo,
'L' ) )
THEN
238 ELSE IF( n.LT.0 )
THEN
240 ELSE IF( nrhs.LT.0 )
THEN
242 ELSE IF( ldb.LT.max( 1, n ) )
THEN
244 ELSE IF( ldx.LT.max( 1, n ) )
THEN
248 CALL
xerbla(
'SSPRFS', -info )
254 IF( n.EQ.0 .OR. nrhs.EQ.0 )
THEN
266 safmin =
slamch(
'Safe minimum' )
282 CALL
scopy( n,
b( 1,
j ), 1, work( n+1 ), 1 )
283 CALL
sspmv( uplo, n, -one, ap,
x( 1,
j ), 1, one, work( n+1 ),
296 work( i ) = abs(
b( i,
j ) )
305 xk = abs(
x( k,
j ) )
308 work( i ) = work( i ) + abs( ap( ik ) )*xk
309 s = s + abs( ap( ik ) )*abs(
x( i,
j ) )
312 work( k ) = work( k ) + abs( ap( kk+k-1 ) )*xk + s
318 xk = abs(
x( k,
j ) )
319 work( k ) = work( k ) + abs( ap( kk ) )*xk
322 work( i ) = work( i ) + abs( ap( ik ) )*xk
323 s = s + abs( ap( ik ) )*abs(
x( i,
j ) )
326 work( k ) = work( k ) + s
332 IF( work( i ).GT.safe2 )
THEN
333 s = max( s, abs( work( n+i ) ) / work( i ) )
335 s = max( s, ( abs( work( n+i ) )+safe1 ) /
336 $ ( work( i )+safe1 ) )
347 IF( berr(
j ).GT.eps .AND. two*berr(
j ).LE.lstres .AND.
348 $ count.LE.itmax )
THEN
352 CALL
ssptrs( uplo, n, 1, afp, ipiv, work( n+1 ), n, info )
353 CALL
saxpy( n, one, work( n+1 ), 1,
x( 1,
j ), 1 )
382 IF( work( i ).GT.safe2 )
THEN
383 work( i ) = abs( work( n+i ) ) + nz*eps*work( i )
385 work( i ) = abs( work( n+i ) ) + nz*eps*work( i ) + safe1
391 CALL
slacn2( n, work( 2*n+1 ), work( n+1 ), iwork, ferr(
j ),
398 CALL
ssptrs( uplo, n, 1, afp, ipiv, work( n+1 ), n,
401 work( n+i ) = work( i )*work( n+i )
403 ELSE IF( kase.EQ.2 )
THEN
408 work( n+i ) = work( i )*work( n+i )
410 CALL
ssptrs( uplo, n, 1, afp, ipiv, work( n+1 ), n,
420 lstres = max( lstres, abs(
x( i,
j ) ) )
423 $ ferr(
j ) = ferr(
j ) / lstres
LOGICAL function lsame(CA, CB)
LSAME
subroutine sspmv(UPLO, N, ALPHA, AP, X, INCX, BETA, Y, INCY)
SSPMV
REAL function slamch(CMACH)
SLAMCH
subroutine ssprfs(UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
SSPRFS
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 saxpy(N, SA, SX, INCX, SY, INCY)
SAXPY
subroutine slacn2(N, V, X, ISGN, EST, KASE, ISAVE)
SLACN2 estimates the 1-norm of a square matrix, using reverse communication for evaluating matrix-vec...
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine ssptrs(UPLO, N, NRHS, AP, IPIV, B, LDB, INFO)
SSPTRS