171 SUBROUTINE spprfs( UPLO, N, NRHS, AP, AFP, B, LDB, X, LDX, FERR,
172 $ berr, work, iwork, info )
181 INTEGER info, ldb, ldx, n, nrhs
185 REAL afp( * ), ap( * ),
b( ldb, * ), berr( * ),
186 $ ferr( * ), work( * ), x( ldx, * )
193 parameter( itmax = 5 )
195 parameter( zero = 0.0e+0 )
197 parameter( one = 1.0e+0 )
199 parameter( two = 2.0e+0 )
201 parameter( three = 3.0e+0 )
205 INTEGER count, i, ik,
j, k, kase, kk, nz
206 REAL eps, lstres, s, safe1, safe2, safmin, xk
227 upper =
lsame( uplo,
'U' )
228 IF( .NOT.upper .AND. .NOT.
lsame( uplo,
'L' ) )
THEN
230 ELSE IF( n.LT.0 )
THEN
232 ELSE IF( nrhs.LT.0 )
THEN
234 ELSE IF( ldb.LT.max( 1, n ) )
THEN
236 ELSE IF( ldx.LT.max( 1, n ) )
THEN
240 CALL
xerbla(
'SPPRFS', -info )
246 IF( n.EQ.0 .OR. nrhs.EQ.0 )
THEN
258 safmin =
slamch(
'Safe minimum' )
274 CALL
scopy( n,
b( 1,
j ), 1, work( n+1 ), 1 )
275 CALL
sspmv( uplo, n, -one, ap, x( 1,
j ), 1, one, work( n+1 ),
288 work( i ) = abs(
b( i,
j ) )
297 xk = abs( x( k,
j ) )
300 work( i ) = work( i ) + abs( ap( ik ) )*xk
301 s = s + abs( ap( ik ) )*abs( x( i,
j ) )
304 work( k ) = work( k ) + abs( ap( kk+k-1 ) )*xk + s
310 xk = abs( x( k,
j ) )
311 work( k ) = work( k ) + abs( ap( kk ) )*xk
314 work( i ) = work( i ) + abs( ap( ik ) )*xk
315 s = s + abs( ap( ik ) )*abs( x( i,
j ) )
318 work( k ) = work( k ) + s
324 IF( work( i ).GT.safe2 )
THEN
325 s = max( s, abs( work( n+i ) ) / work( i ) )
327 s = max( s, ( abs( work( n+i ) )+safe1 ) /
328 $ ( work( i )+safe1 ) )
339 IF( berr(
j ).GT.eps .AND. two*berr(
j ).LE.lstres .AND.
340 $ count.LE.itmax )
THEN
344 CALL
spptrs( uplo, n, 1, afp, work( n+1 ), n, info )
345 CALL
saxpy( n, one, work( n+1 ), 1, x( 1,
j ), 1 )
374 IF( work( i ).GT.safe2 )
THEN
375 work( i ) = abs( work( n+i ) ) + nz*eps*work( i )
377 work( i ) = abs( work( n+i ) ) + nz*eps*work( i ) + safe1
383 CALL
slacn2( n, work( 2*n+1 ), work( n+1 ), iwork, ferr(
j ),
390 CALL
spptrs( uplo, n, 1, afp, work( n+1 ), n, info )
392 work( n+i ) = work( i )*work( n+i )
394 ELSE IF( kase.EQ.2 )
THEN
399 work( n+i ) = work( i )*work( n+i )
401 CALL
spptrs( uplo, n, 1, afp, work( n+1 ), n, info )
410 lstres = max( lstres, abs( x( i,
j ) ) )
413 $ ferr(
j ) = ferr(
j ) / lstres
subroutine sspmv(UPLO, N, ALPHA, AP, X, INCX, BETA, Y, INCY)
SSPMV
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
logical function lsame(CA, CB)
LSAME
subroutine saxpy(N, SA, SX, INCX, SY, INCY)
SAXPY
subroutine spprfs(UPLO, N, NRHS, AP, AFP, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
SPPRFS
real function slamch(CMACH)
SLAMCH
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 spptrs(UPLO, N, NRHS, AP, B, LDB, INFO)
SPPTRS