178 SUBROUTINE ctrrfs( UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB,
180 $ LDX, FERR, BERR, WORK, RWORK, INFO )
187 CHARACTER DIAG, TRANS, UPLO
188 INTEGER INFO, LDA, LDB, LDX, N, NRHS
191 REAL BERR( * ), FERR( * ), RWORK( * )
192 COMPLEX A( LDA, * ), B( LDB, * ), WORK( * ),
200 PARAMETER ( ZERO = 0.0e+0 )
202 parameter( one = ( 1.0e+0, 0.0e+0 ) )
205 LOGICAL NOTRAN, NOUNIT, UPPER
206 CHARACTER TRANSN, TRANST
207 INTEGER I, J, K, KASE, NZ
208 REAL EPS, LSTRES, S, SAFE1, SAFE2, SAFMIN, XK
219 INTRINSIC abs, aimag, max, real
224 EXTERNAL lsame, slamch
230 cabs1( zdum ) = abs( real( zdum ) ) + abs( aimag( zdum ) )
237 upper = lsame( uplo,
'U' )
238 notran = lsame( trans,
'N' )
239 nounit = lsame( diag,
'N' )
241 IF( .NOT.upper .AND. .NOT.lsame( uplo,
'L' ) )
THEN
243 ELSE IF( .NOT.notran .AND. .NOT.lsame( trans,
'T' ) .AND. .NOT.
244 $ lsame( trans,
'C' ) )
THEN
246 ELSE IF( .NOT.nounit .AND. .NOT.lsame( diag,
'U' ) )
THEN
248 ELSE IF( n.LT.0 )
THEN
250 ELSE IF( nrhs.LT.0 )
THEN
252 ELSE IF( lda.LT.max( 1, n ) )
THEN
254 ELSE IF( ldb.LT.max( 1, n ) )
THEN
256 ELSE IF( ldx.LT.max( 1, n ) )
THEN
260 CALL xerbla(
'CTRRFS', -info )
266 IF( n.EQ.0 .OR. nrhs.EQ.0 )
THEN
285 eps = slamch(
'Epsilon' )
286 safmin = slamch(
'Safe minimum' )
287 safe1 = real( nz )*safmin
297 CALL ccopy( n, x( 1, j ), 1, work, 1 )
298 CALL ctrmv( uplo, trans, diag, n, a, lda, work, 1 )
299 CALL caxpy( n, -one, b( 1, j ), 1, work, 1 )
311 rwork( i ) = cabs1( b( i, j ) )
321 xk = cabs1( x( k, j ) )
323 rwork( i ) = rwork( i ) + cabs1( a( i, k ) )*xk
328 xk = cabs1( x( k, j ) )
330 rwork( i ) = rwork( i ) + cabs1( a( i, k ) )*xk
332 rwork( k ) = rwork( k ) + xk
338 xk = cabs1( x( k, j ) )
340 rwork( i ) = rwork( i ) + cabs1( a( i, k ) )*xk
345 xk = cabs1( x( k, j ) )
347 rwork( i ) = rwork( i ) + cabs1( a( i, k ) )*xk
349 rwork( k ) = rwork( k ) + xk
362 s = s + cabs1( a( i, k ) )*cabs1( x( i, j ) )
364 rwork( k ) = rwork( k ) + s
368 s = cabs1( x( k, j ) )
370 s = s + cabs1( a( i, k ) )*cabs1( x( i, j ) )
372 rwork( k ) = rwork( k ) + s
380 s = s + cabs1( a( i, k ) )*cabs1( x( i, j ) )
382 rwork( k ) = rwork( k ) + s
386 s = cabs1( x( k, j ) )
388 s = s + cabs1( a( i, k ) )*cabs1( x( i, j ) )
390 rwork( k ) = rwork( k ) + s
397 IF( rwork( i ).GT.safe2 )
THEN
398 s = max( s, cabs1( work( i ) ) / rwork( i ) )
400 s = max( s, ( cabs1( work( i ) )+safe1 ) /
401 $ ( rwork( i )+safe1 ) )
429 IF( rwork( i ).GT.safe2 )
THEN
430 rwork( i ) = cabs1( work( i ) ) + real( nz )*
433 rwork( i ) = cabs1( work( i ) ) + real( nz )*
434 $ eps*rwork( i ) + safe1
440 CALL clacn2( n, work( n+1 ), work, ferr( j ), kase, isave )
446 CALL ctrsv( uplo, transt, diag, n, a, lda, work, 1 )
448 work( i ) = rwork( i )*work( i )
455 work( i ) = rwork( i )*work( i )
457 CALL ctrsv( uplo, transn, diag, n, a, lda, work, 1 )
466 lstres = max( lstres, cabs1( x( i, j ) ) )
469 $ ferr( j ) = ferr( j ) / lstres
subroutine ctrrfs(uplo, trans, diag, n, nrhs, a, lda, b, ldb, x, ldx, ferr, berr, work, rwork, info)
CTRRFS