191 SUBROUTINE ssyrfs( UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB,
192 $
x, ldx, ferr, berr, work, iwork, info )
201 INTEGER info, lda, ldaf, ldb, ldx, n, nrhs
204 INTEGER ipiv( * ), iwork( * )
205 REAL a( lda, * ), af( ldaf, * ),
b( ldb, * ),
206 $ berr( * ), ferr( * ), work( * ),
x( ldx, * )
213 parameter( itmax = 5 )
215 parameter( zero = 0.0e+0 )
217 parameter( one = 1.0e+0 )
219 parameter( two = 2.0e+0 )
221 parameter( three = 3.0e+0 )
225 INTEGER count, i,
j, k, kase, nz
226 REAL eps, lstres, s, safe1, safe2, safmin, xk
247 upper =
lsame( uplo,
'U' )
248 IF( .NOT.upper .AND. .NOT.
lsame( uplo,
'L' ) )
THEN
250 ELSE IF( n.LT.0 )
THEN
252 ELSE IF( nrhs.LT.0 )
THEN
254 ELSE IF( lda.LT.max( 1, n ) )
THEN
256 ELSE IF( ldaf.LT.max( 1, n ) )
THEN
258 ELSE IF( ldb.LT.max( 1, n ) )
THEN
260 ELSE IF( ldx.LT.max( 1, n ) )
THEN
264 CALL
xerbla(
'SSYRFS', -info )
270 IF( n.EQ.0 .OR. nrhs.EQ.0 )
THEN
282 safmin =
slamch(
'Safe minimum' )
298 CALL
scopy( n,
b( 1,
j ), 1, work( n+1 ), 1 )
299 CALL
ssymv( uplo, n, -one, a, lda,
x( 1,
j ), 1, one,
312 work( i ) = abs(
b( i,
j ) )
320 xk = abs(
x( k,
j ) )
322 work( i ) = work( i ) + abs( a( i, k ) )*xk
323 s = s + abs( a( i, k ) )*abs(
x( i,
j ) )
325 work( k ) = work( k ) + abs( a( k, k ) )*xk + s
330 xk = abs(
x( k,
j ) )
331 work( k ) = work( k ) + abs( a( k, k ) )*xk
333 work( i ) = work( i ) + abs( a( i, k ) )*xk
334 s = s + abs( a( i, k ) )*abs(
x( i,
j ) )
336 work( k ) = work( k ) + s
341 IF( work( i ).GT.safe2 )
THEN
342 s = max( s, abs( work( n+i ) ) / work( i ) )
344 s = max( s, ( abs( work( n+i ) )+safe1 ) /
345 $ ( work( i )+safe1 ) )
356 IF( berr(
j ).GT.eps .AND. two*berr(
j ).LE.lstres .AND.
357 $ count.LE.itmax )
THEN
361 CALL
ssytrs( uplo, n, 1, af, ldaf, ipiv, work( n+1 ), n,
363 CALL
saxpy( n, one, work( n+1 ), 1,
x( 1,
j ), 1 )
392 IF( work( i ).GT.safe2 )
THEN
393 work( i ) = abs( work( n+i ) ) + nz*eps*work( i )
395 work( i ) = abs( work( n+i ) ) + nz*eps*work( i ) + safe1
401 CALL
slacn2( n, work( 2*n+1 ), work( n+1 ), iwork, ferr(
j ),
408 CALL
ssytrs( uplo, n, 1, af, ldaf, ipiv, work( n+1 ), n,
411 work( n+i ) = work( i )*work( n+i )
413 ELSE IF( kase.EQ.2 )
THEN
418 work( n+i ) = work( i )*work( n+i )
420 CALL
ssytrs( uplo, n, 1, af, ldaf, ipiv, work( n+1 ), n,
430 lstres = max( lstres, abs(
x( i,
j ) ) )
433 $ ferr(
j ) = ferr(
j ) / lstres
LOGICAL function lsame(CA, CB)
LSAME
subroutine ssymv(UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
SSYMV
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 saxpy(N, SA, SX, INCX, SY, INCY)
SAXPY
subroutine ssyrfs(UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
SSYRFS
subroutine ssytrs(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
SSYTRS
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