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 cgerfs(TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
CGERFS
subroutine cgetrs(TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
CGETRS
subroutine cgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
CGEMV
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine clacn2(N, V, X, EST, KASE, ISAVE)
CLACN2 estimates the 1-norm of a square matrix, using reverse communication for evaluating matrix-vec...
subroutine ccopy(N, CX, INCX, CY, INCY)
CCOPY
subroutine caxpy(N, CA, CX, INCX, CY, INCY)
CAXPY