187 SUBROUTINE ssyrfs( UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B,
189 $ X, LDX, FERR, BERR, WORK, IWORK, INFO )
197 INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS
200 INTEGER IPIV( * ), IWORK( * )
201 REAL A( LDA, * ), AF( LDAF, * ), B( LDB, * ),
202 $ berr( * ), ferr( * ), work( * ), x( ldx, * )
209 PARAMETER ( ITMAX = 5 )
211 parameter( zero = 0.0e+0 )
213 parameter( one = 1.0e+0 )
215 parameter( two = 2.0e+0 )
217 parameter( three = 3.0e+0 )
221 INTEGER COUNT, I, J, K, KASE, NZ
222 REAL EPS, LSTRES, S, SAFE1, SAFE2, SAFMIN, XK
237 EXTERNAL lsame, slamch
244 upper = lsame( uplo,
'U' )
245 IF( .NOT.upper .AND. .NOT.lsame( uplo,
'L' ) )
THEN
247 ELSE IF( n.LT.0 )
THEN
249 ELSE IF( nrhs.LT.0 )
THEN
251 ELSE IF( lda.LT.max( 1, n ) )
THEN
253 ELSE IF( ldaf.LT.max( 1, n ) )
THEN
255 ELSE IF( ldb.LT.max( 1, n ) )
THEN
257 ELSE IF( ldx.LT.max( 1, n ) )
THEN
261 CALL xerbla(
'SSYRFS', -info )
267 IF( n.EQ.0 .OR. nrhs.EQ.0 )
THEN
278 eps = slamch(
'Epsilon' )
279 safmin = slamch(
'Safe minimum' )
280 safe1 = real( nz )*safmin
295 CALL scopy( n, b( 1, j ), 1, work( n+1 ), 1 )
296 CALL ssymv( uplo, n, -one, a, lda, x( 1, j ), 1, one,
309 work( i ) = abs( b( i, j ) )
317 xk = abs( x( k, j ) )
319 work( i ) = work( i ) + abs( a( i, k ) )*xk
320 s = s + abs( a( i, k ) )*abs( x( i, j ) )
322 work( k ) = work( k ) + abs( a( k, k ) )*xk + s
327 xk = abs( x( k, j ) )
328 work( k ) = work( k ) + abs( a( k, k ) )*xk
330 work( i ) = work( i ) + abs( a( i, k ) )*xk
331 s = s + abs( a( i, k ) )*abs( x( i, j ) )
333 work( k ) = work( k ) + s
338 IF( work( i ).GT.safe2 )
THEN
339 s = max( s, abs( work( n+i ) ) / work( i ) )
341 s = max( s, ( abs( work( n+i ) )+safe1 ) /
342 $ ( work( i )+safe1 ) )
353 IF( berr( j ).GT.eps .AND. two*berr( j ).LE.lstres .AND.
354 $ count.LE.itmax )
THEN
358 CALL ssytrs( uplo, n, 1, af, ldaf, ipiv, work( n+1 ), n,
360 CALL saxpy( n, one, work( n+1 ), 1, x( 1, j ), 1 )
389 IF( work( i ).GT.safe2 )
THEN
390 work( i ) = abs( work( n+i ) ) + real( nz )*eps*work( i )
392 work( i ) = abs( work( n+i ) ) + real( nz )*eps*work( i )
399 CALL slacn2( n, work( 2*n+1 ), work( n+1 ), iwork,
407 CALL ssytrs( uplo, n, 1, af, ldaf, ipiv, work( n+1 ),
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 ),
431 lstres = max( lstres, abs( x( i, j ) ) )
434 $ ferr( j ) = ferr( j ) / lstres
subroutine ssyrfs(uplo, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb, x, ldx, ferr, berr, work, iwork, info)
SSYRFS