185 SUBROUTINE dgerfs( TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB,
186 $ x, ldx, ferr, berr, work, iwork, info )
195 INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS
198 INTEGER IPIV( * ), IWORK( * )
199 DOUBLE PRECISION A( lda, * ), AF( ldaf, * ), B( ldb, * ),
200 $ berr( * ), ferr( * ), work( * ), x( ldx, * )
207 parameter ( itmax = 5 )
208 DOUBLE PRECISION ZERO
209 parameter ( zero = 0.0d+0 )
211 parameter ( one = 1.0d+0 )
213 parameter ( two = 2.0d+0 )
214 DOUBLE PRECISION THREE
215 parameter ( three = 3.0d+0 )
220 INTEGER COUNT, I, J, K, KASE, NZ
221 DOUBLE PRECISION EPS, LSTRES, S, SAFE1, SAFE2, SAFMIN, XK
234 DOUBLE PRECISION DLAMCH
235 EXTERNAL lsame, dlamch
242 notran = lsame( trans,
'N' )
243 IF( .NOT.notran .AND. .NOT.lsame( trans,
'T' ) .AND. .NOT.
244 $ lsame( trans,
'C' ) )
THEN
246 ELSE IF( n.LT.0 )
THEN
248 ELSE IF( nrhs.LT.0 )
THEN
250 ELSE IF( lda.LT.max( 1, n ) )
THEN
252 ELSE IF( ldaf.LT.max( 1, n ) )
THEN
254 ELSE IF( ldb.LT.max( 1, n ) )
THEN
256 ELSE IF( ldx.LT.max( 1, n ) )
THEN
260 CALL xerbla(
'DGERFS', -info )
266 IF( n.EQ.0 .OR. nrhs.EQ.0 )
THEN
283 eps = dlamch(
'Epsilon' )
284 safmin = dlamch(
'Safe minimum' )
301 CALL dcopy( n, b( 1, j ), 1, work( n+1 ), 1 )
302 CALL dgemv( trans, n, n, -one, a, lda, x( 1, j ), 1, one,
315 work( i ) = abs( b( i, j ) )
322 xk = abs( x( k, j ) )
324 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 dgetrs( trans, n, 1, af, ldaf, ipiv, work( n+1 ), n,
360 CALL daxpy( n, one, work( n+1 ), 1, x( 1, j ), 1 )
389 IF( work( i ).GT.safe2 )
THEN
390 work( i ) = abs( work( n+i ) ) + nz*eps*work( i )
392 work( i ) = abs( work( n+i ) ) + nz*eps*work( i ) + safe1
398 CALL dlacn2( n, work( 2*n+1 ), work( n+1 ), iwork, ferr( j ),
405 CALL dgetrs( transt, n, 1, af, ldaf, ipiv, work( n+1 ),
408 work( n+i ) = work( i )*work( n+i )
415 work( n+i ) = work( i )*work( n+i )
417 CALL dgetrs( trans, n, 1, af, ldaf, ipiv, work( n+1 ), n,
427 lstres = max( lstres, abs( x( i, j ) ) )
430 $ ferr( j ) = ferr( j ) / lstres
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
subroutine dgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
DGEMV
subroutine dgerfs(TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
DGERFS
subroutine daxpy(N, DA, DX, INCX, DY, INCY)
DAXPY
subroutine dgetrs(TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
DGETRS
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...
subroutine xerbla(SRNAME, INFO)
XERBLA