182 SUBROUTINE ctrrfs( UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, X,
183 $ ldx, ferr, berr, work, rwork, info )
191 CHARACTER DIAG, TRANS, UPLO
192 INTEGER INFO, LDA, LDB, LDX, N, NRHS
195 REAL BERR( * ), FERR( * ), RWORK( * )
196 COMPLEX A( lda, * ), B( ldb, * ), WORK( * ),
204 parameter ( zero = 0.0e+0 )
206 parameter ( one = ( 1.0e+0, 0.0e+0 ) )
209 LOGICAL NOTRAN, NOUNIT, UPPER
210 CHARACTER TRANSN, TRANST
211 INTEGER I, J, K, KASE, NZ
212 REAL EPS, LSTRES, S, SAFE1, SAFE2, SAFMIN, XK
222 INTRINSIC abs, aimag, max, real
227 EXTERNAL lsame, slamch
233 cabs1( zdum ) = abs(
REAL( ZDUM ) ) + abs( AIMAG( zdum ) )
240 upper = lsame( uplo,
'U' )
241 notran = lsame( trans,
'N' )
242 nounit = lsame( diag,
'N' )
244 IF( .NOT.upper .AND. .NOT.lsame( uplo,
'L' ) )
THEN
246 ELSE IF( .NOT.notran .AND. .NOT.lsame( trans,
'T' ) .AND. .NOT.
247 $ lsame( trans,
'C' ) )
THEN
249 ELSE IF( .NOT.nounit .AND. .NOT.lsame( diag,
'U' ) )
THEN
251 ELSE IF( n.LT.0 )
THEN
253 ELSE IF( nrhs.LT.0 )
THEN
255 ELSE IF( lda.LT.max( 1, n ) )
THEN
257 ELSE IF( ldb.LT.max( 1, n ) )
THEN
259 ELSE IF( ldx.LT.max( 1, n ) )
THEN
263 CALL xerbla(
'CTRRFS', -info )
269 IF( n.EQ.0 .OR. nrhs.EQ.0 )
THEN
288 eps = slamch(
'Epsilon' )
289 safmin = slamch(
'Safe minimum' )
300 CALL ccopy( n, x( 1, j ), 1, work, 1 )
301 CALL ctrmv( uplo, trans, diag, n, a, lda, work, 1 )
302 CALL caxpy( n, -one, b( 1, j ), 1, work, 1 )
314 rwork( i ) = cabs1( b( i, j ) )
324 xk = cabs1( x( k, j ) )
326 rwork( i ) = rwork( i ) + cabs1( a( i, k ) )*xk
331 xk = cabs1( x( k, j ) )
333 rwork( i ) = rwork( i ) + cabs1( a( i, k ) )*xk
335 rwork( k ) = rwork( k ) + xk
341 xk = cabs1( x( k, j ) )
343 rwork( i ) = rwork( i ) + cabs1( a( i, k ) )*xk
348 xk = cabs1( x( k, j ) )
350 rwork( i ) = rwork( i ) + cabs1( a( i, k ) )*xk
352 rwork( k ) = rwork( k ) + xk
365 s = s + cabs1( a( i, k ) )*cabs1( x( i, j ) )
367 rwork( k ) = rwork( k ) + s
371 s = cabs1( x( k, j ) )
373 s = s + cabs1( a( i, k ) )*cabs1( x( i, j ) )
375 rwork( k ) = rwork( k ) + s
383 s = s + cabs1( a( i, k ) )*cabs1( x( i, j ) )
385 rwork( k ) = rwork( k ) + s
389 s = cabs1( x( k, j ) )
391 s = s + cabs1( a( i, k ) )*cabs1( x( i, j ) )
393 rwork( k ) = rwork( k ) + s
400 IF( rwork( i ).GT.safe2 )
THEN
401 s = max( s, cabs1( work( i ) ) / rwork( i ) )
403 s = max( s, ( cabs1( work( i ) )+safe1 ) /
404 $ ( rwork( i )+safe1 ) )
432 IF( rwork( i ).GT.safe2 )
THEN
433 rwork( i ) = cabs1( work( i ) ) + nz*eps*rwork( i )
435 rwork( i ) = cabs1( work( i ) ) + nz*eps*rwork( i ) +
442 CALL clacn2( n, work( n+1 ), work, ferr( j ), kase, isave )
448 CALL ctrsv( uplo, transt, diag, n, a, lda, work, 1 )
450 work( i ) = rwork( i )*work( i )
457 work( i ) = rwork( i )*work( i )
459 CALL ctrsv( uplo, transn, diag, n, a, lda, work, 1 )
468 lstres = max( lstres, cabs1( x( i, j ) ) )
471 $ ferr( j ) = ferr( j ) / lstres
subroutine ctrrfs(UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
CTRRFS
subroutine ctrsv(UPLO, TRANS, DIAG, N, A, LDA, X, INCX)
CTRSV
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine ctrmv(UPLO, TRANS, DIAG, N, A, LDA, X, INCX)
CTRMV
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