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
LOGICAL function lsame(CA, CB)
LSAME
subroutine cgetrs(TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
CGETRS
REAL function slamch(CMACH)
SLAMCH
subroutine caxpy(N, CA, CX, INCX, CY, INCY)
CAXPY
subroutine xerbla(SRNAME, INFO)
XERBLA
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
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
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
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...