1 SUBROUTINE dsyrfs( UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB,
2 $ X, LDX, FERR, BERR, WORK, IWORK, INFO )
11 INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS
14 INTEGER IPIV( * ), IWORK( * )
15 DOUBLE PRECISION A( LDA, * ), AF( LDAF, * ), B( LDB, * ),
16 $ berr( * ), ferr( * ), work( * ), x( ldx, * )
110 parameter( itmax = 5 )
111 DOUBLE PRECISION ZERO
112 parameter( zero = 0.0d+0 )
114 parameter( one = 1.0d+0 )
116 parameter( two = 2.0d+0 )
117 DOUBLE PRECISION THREE
118 parameter( three = 3.0d+0 )
122 INTEGER COUNT, I, J, K, KASE, NZ
123 DOUBLE PRECISION EPS, LSTRES, S, SAFE1, SAFE2, SAFMIN, XK
133 DOUBLE PRECISION DLAMCH
134 EXTERNAL lsame, dlamch
141 upper = lsame( uplo,
'U' )
142 IF( .NOT.upper .AND. .NOT.lsame( uplo,
'L' ) )
THEN
144 ELSE IF( n.LT.0 )
THEN
146 ELSE IF( nrhs.LT.0 )
THEN
148 ELSE IF( lda.LT.max( 1, n ) )
THEN
150 ELSE IF( ldaf.LT.max( 1, n ) )
THEN
152 ELSE IF( ldb.LT.max( 1, n ) )
THEN
154 ELSE IF( ldx.LT.max( 1, n ) )
THEN
158 CALL xerbla(
'DSYRFS', -info )
164 IF( n.EQ.0 .OR. nrhs.EQ.0 )
THEN
175 eps = dlamch(
'Epsilon' )
176 safmin = dlamch(
'Safe minimum' )
192 CALL dcopy( n, b( 1, j ), 1, work( n+1 ), 1 )
193 CALL dsymv( uplo, n, -one, a, lda, x( 1, j ), 1, one,
206 work( i ) = abs( b( i, j ) )
214 xk = abs( x( k, j ) )
216 work( i ) = work( i ) + abs( a( i, k ) )*xk
217 s = s + abs( a( i, k ) )*abs( x( i, j ) )
219 work( k ) = work( k ) + abs( a( k, k ) )*xk + s
224 xk = abs( x( k, j ) )
225 work( k ) = work( k ) + abs( a( k, k ) )*xk
227 work( i ) = work( i ) + abs( a( i, k ) )*xk
228 s = s + abs( a( i, k ) )*abs( x( i, j ) )
230 work( k ) = work( k ) + s
235 IF( work( i ).GT.safe2 )
THEN
236 s = max( s, abs( work( n+i ) ) / work( i ) )
238 s = max( s, ( abs( work( n+i ) )+safe1 ) /
239 $ ( work( i )+safe1 ) )
250 IF( berr( j ).GT.eps .AND. two*berr( j ).LE.lstres .AND.
251 $ count.LE.itmax )
THEN
255 CALL dsytrs( uplo, n, 1, af, ldaf, ipiv, work( n+1 ), n,
257 CALL daxpy( n, one, work( n+1 ), 1, x( 1, j ), 1 )
286 IF( work( i ).GT.safe2 )
THEN
287 work( i ) = abs( work( n+i ) ) + nz*eps*work( i )
289 work( i ) = abs( work( n+i ) ) + nz*eps*work( i ) + safe1
295 CALL dlacon( n, work( 2*n+1 ), work( n+1 ), iwork, ferr( j ),
302 CALL dsytrs( uplo, n, 1, af, ldaf, ipiv, work( n+1 ), n,
305 work( n+i ) = work( i )*work( n+i )
307 ELSE IF( kase.EQ.2 )
THEN
312 work( n+i ) = work( i )*work( n+i )
314 CALL dsytrs( uplo, n, 1, af, ldaf, ipiv, work( n+1 ), n,
324 lstres = max( lstres, abs( x( i, j ) ) )
327 $ ferr( j ) = ferr( j ) / lstres
subroutine daxpy(n, da, dx, incx, dy, incy)
subroutine dcopy(n, dx, incx, dy, incy)
subroutine dlacon(N, V, X, ISGN, EST, KASE)
subroutine dsymv(UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
subroutine dsyrfs(UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
subroutine xerbla(SRNAME, INFO)