186 SUBROUTINE zgerfs( 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 DOUBLE PRECISION BERR( * ), FERR( * ), RWORK( * )
201 COMPLEX*16 A( lda, * ), AF( ldaf, * ), B( ldb, * ),
202 $ work( * ), x( ldx, * )
209 parameter ( itmax = 5 )
210 DOUBLE PRECISION ZERO
211 parameter ( zero = 0.0d+0 )
213 parameter ( one = ( 1.0d+0, 0.0d+0 ) )
215 parameter ( two = 2.0d+0 )
216 DOUBLE PRECISION THREE
217 parameter ( three = 3.0d+0 )
221 CHARACTER TRANSN, TRANST
222 INTEGER COUNT, I, J, K, KASE, NZ
223 DOUBLE PRECISION EPS, LSTRES, S, SAFE1, SAFE2, SAFMIN, XK
231 DOUBLE PRECISION DLAMCH
232 EXTERNAL lsame, dlamch
238 INTRINSIC abs, dble, dimag, max
241 DOUBLE PRECISION CABS1
244 cabs1( zdum ) = abs( dble( zdum ) ) + abs( dimag( 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(
'ZGERFS', -info )
275 IF( n.EQ.0 .OR. nrhs.EQ.0 )
THEN
294 eps = dlamch(
'Epsilon' )
295 safmin = dlamch(
'Safe minimum' )
312 CALL zcopy( n, b( 1, j ), 1, work, 1 )
313 CALL zgemv( 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 zgetrs( trans, n, 1, af, ldaf, ipiv, work, n, info )
370 CALL zaxpy( 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 zlacn2( n, work( n+1 ), work, ferr( j ), kase, isave )
415 CALL zgetrs( transt, n, 1, af, ldaf, ipiv, work, n,
418 work( i ) = rwork( i )*work( i )
425 work( i ) = rwork( i )*work( i )
427 CALL zgetrs( transn, n, 1, af, ldaf, ipiv, work, n,
437 lstres = max( lstres, cabs1( x( i, j ) ) )
440 $ ferr( j ) = ferr( j ) / lstres
subroutine zgetrs(TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
ZGETRS
subroutine zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
subroutine zgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
ZGEMV
subroutine zlacn2(N, V, X, EST, KASE, ISAVE)
ZLACN2 estimates the 1-norm of a square matrix, using reverse communication for evaluating matrix-vec...
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine zgerfs(TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZGERFS
subroutine zaxpy(N, ZA, ZX, INCX, ZY, INCY)
ZAXPY