179 SUBROUTINE dsprfs( UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX,
180 $ ferr, berr, work, iwork, info )
189 INTEGER INFO, LDB, LDX, N, NRHS
192 INTEGER IPIV( * ), IWORK( * )
193 DOUBLE PRECISION AFP( * ), AP( * ), B( ldb, * ), BERR( * ),
194 $ ferr( * ), work( * ), x( ldx, * )
201 parameter ( itmax = 5 )
202 DOUBLE PRECISION ZERO
203 parameter ( zero = 0.0d+0 )
205 parameter ( one = 1.0d+0 )
207 parameter ( two = 2.0d+0 )
208 DOUBLE PRECISION THREE
209 parameter ( three = 3.0d+0 )
213 INTEGER COUNT, I, IK, J, K, KASE, KK, NZ
214 DOUBLE PRECISION EPS, LSTRES, S, SAFE1, SAFE2, SAFMIN, XK
227 DOUBLE PRECISION DLAMCH
228 EXTERNAL lsame, dlamch
235 upper = lsame( uplo,
'U' )
236 IF( .NOT.upper .AND. .NOT.lsame( uplo,
'L' ) )
THEN
238 ELSE IF( n.LT.0 )
THEN
240 ELSE IF( nrhs.LT.0 )
THEN
242 ELSE IF( ldb.LT.max( 1, n ) )
THEN
244 ELSE IF( ldx.LT.max( 1, n ) )
THEN
248 CALL xerbla(
'DSPRFS', -info )
254 IF( n.EQ.0 .OR. nrhs.EQ.0 )
THEN
265 eps = dlamch(
'Epsilon' )
266 safmin = dlamch(
'Safe minimum' )
282 CALL dcopy( n, b( 1, j ), 1, work( n+1 ), 1 )
283 CALL dspmv( uplo, n, -one, ap, x( 1, j ), 1, one, work( n+1 ),
296 work( i ) = abs( b( i, j ) )
305 xk = abs( x( k, j ) )
308 work( i ) = work( i ) + abs( ap( ik ) )*xk
309 s = s + abs( ap( ik ) )*abs( x( i, j ) )
312 work( k ) = work( k ) + abs( ap( kk+k-1 ) )*xk + s
318 xk = abs( x( k, j ) )
319 work( k ) = work( k ) + abs( ap( kk ) )*xk
322 work( i ) = work( i ) + abs( ap( ik ) )*xk
323 s = s + abs( ap( ik ) )*abs( x( i, j ) )
326 work( k ) = work( k ) + s
332 IF( work( i ).GT.safe2 )
THEN
333 s = max( s, abs( work( n+i ) ) / work( i ) )
335 s = max( s, ( abs( work( n+i ) )+safe1 ) /
336 $ ( work( i )+safe1 ) )
347 IF( berr( j ).GT.eps .AND. two*berr( j ).LE.lstres .AND.
348 $ count.LE.itmax )
THEN
352 CALL dsptrs( uplo, n, 1, afp, ipiv, work( n+1 ), n, info )
353 CALL daxpy( n, one, work( n+1 ), 1, x( 1, j ), 1 )
382 IF( work( i ).GT.safe2 )
THEN
383 work( i ) = abs( work( n+i ) ) + nz*eps*work( i )
385 work( i ) = abs( work( n+i ) ) + nz*eps*work( i ) + safe1
391 CALL dlacn2( n, work( 2*n+1 ), work( n+1 ), iwork, ferr( j ),
398 CALL dsptrs( uplo, n, 1, afp, ipiv, work( n+1 ), n,
401 work( n+i ) = work( i )*work( n+i )
403 ELSE IF( kase.EQ.2 )
THEN
408 work( n+i ) = work( i )*work( n+i )
410 CALL dsptrs( uplo, n, 1, afp, ipiv, work( n+1 ), n,
420 lstres = max( lstres, abs( x( i, j ) ) )
423 $ ferr( j ) = ferr( j ) / lstres
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
subroutine dsptrs(UPLO, N, NRHS, AP, IPIV, B, LDB, INFO)
DSPTRS
subroutine dspmv(UPLO, N, ALPHA, AP, X, INCX, BETA, Y, INCY)
DSPMV
subroutine daxpy(N, DA, DX, INCX, DY, INCY)
DAXPY
subroutine dsprfs(UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
DSPRFS
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dlacn2(N, V, X, ISGN, EST, KASE, ISAVE)
DLACN2 estimates the 1-norm of a square matrix, using reverse communication for evaluating matrix-vec...