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
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
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