186 SUBROUTINE cgerfs( TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB,
187 $ x, ldx, ferr, berr, work, rwork, info )
196 INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS
200 REAL BERR( * ), FERR( * ), RWORK( * )
201 COMPLEX A( lda, * ), AF( ldaf, * ), B( ldb, * ),
202 $ work( * ), x( ldx, * )
209 parameter( itmax = 5 )
211 parameter( zero = 0.0e+0 )
213 parameter( one = ( 1.0e+0, 0.0e+0 ) )
215 parameter( two = 2.0e+0 )
217 parameter( three = 3.0e+0 )
221 CHARACTER TRANSN, TRANST
222 INTEGER COUNT, I, J, K, KASE, NZ
223 REAL EPS, LSTRES, S, SAFE1, SAFE2, SAFMIN, XK
232 EXTERNAL lsame, slamch
238 INTRINSIC abs, aimag, max, real
244 cabs1( zdum ) = abs(
REAL( ZDUM ) ) + abs( AIMAG( zdum ) )
251 notran = lsame( trans,
'N' )
252 IF( .NOT.notran .AND. .NOT.lsame( trans,
'T' ) .AND. .NOT.
253 $ lsame( trans,
'C' ) )
THEN
255 ELSE IF( n.LT.0 )
THEN
257 ELSE IF( nrhs.LT.0 )
THEN
259 ELSE IF( lda.LT.max( 1, n ) )
THEN
261 ELSE IF( ldaf.LT.max( 1, n ) )
THEN
263 ELSE IF( ldb.LT.max( 1, n ) )
THEN
265 ELSE IF( ldx.LT.max( 1, n ) )
THEN
269 CALL
xerbla(
'CGERFS', -info )
275 IF( n.EQ.0 .OR. nrhs.EQ.0 )
THEN
294 eps = slamch(
'Epsilon' )
295 safmin = slamch(
'Safe minimum' )
312 CALL
ccopy( n, b( 1, j ), 1, work, 1 )
313 CALL
cgemv( trans, n, n, -one, a, lda, x( 1, j ), 1, one, work,
326 rwork( i ) = cabs1( b( i, j ) )
333 xk = cabs1( x( k, j ) )
335 rwork( i ) = rwork( i ) + cabs1( a( i, k ) )*xk
342 s = s + cabs1( a( i, k ) )*cabs1( x( i, j ) )
344 rwork( k ) = rwork( k ) + s
349 IF( rwork( i ).GT.safe2 )
THEN
350 s = max( s, cabs1( work( i ) ) / rwork( i ) )
352 s = max( s, ( cabs1( work( i ) )+safe1 ) /
353 $ ( rwork( i )+safe1 ) )
364 IF( berr( j ).GT.eps .AND. two*berr( j ).LE.lstres .AND.
365 $ count.LE.itmax )
THEN
369 CALL
cgetrs( trans, n, 1, af, ldaf, ipiv, work, n, info )
370 CALL
caxpy( n, one, work, 1, x( 1, j ), 1 )
399 IF( rwork( i ).GT.safe2 )
THEN
400 rwork( i ) = cabs1( work( i ) ) + nz*eps*rwork( i )
402 rwork( i ) = cabs1( work( i ) ) + nz*eps*rwork( i ) +
409 CALL
clacn2( n, work( n+1 ), work, ferr( j ), kase, isave )
415 CALL
cgetrs( transt, n, 1, af, ldaf, ipiv, work, n,
418 work( i ) = rwork( i )*work( i )
425 work( i ) = rwork( i )*work( i )
427 CALL
cgetrs( transn, n, 1, af, ldaf, ipiv, work, n,
437 lstres = max( lstres, cabs1( x( i, j ) ) )
440 $ ferr( j ) = ferr( j ) / lstres
subroutine cgetrs(TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
CGETRS
subroutine caxpy(N, CA, CX, INCX, CY, INCY)
CAXPY
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine cgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
CGEMV
subroutine cgerfs(TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
CGERFS
subroutine ccopy(N, CX, INCX, CY, INCY)
CCOPY
subroutine clacn2(N, V, X, EST, KASE, ISAVE)
CLACN2 estimates the 1-norm of a square matrix, using reverse communication for evaluating matrix-vec...