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
240 EXTERNAL lsame, slamch
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
281 eps = slamch(
'Epsilon' )
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
subroutine ssytrs(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
SSYTRS
subroutine xerbla(SRNAME, INFO)
XERBLA
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...
subroutine ssymv(UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
SSYMV
subroutine ssyrfs(UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
SSYRFS
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY