180 SUBROUTINE ctrrfs( UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, X,
181 $ LDX, FERR, BERR, WORK, RWORK, INFO )
188 CHARACTER DIAG, TRANS, UPLO
189 INTEGER INFO, LDA, LDB, LDX, N, NRHS
192 REAL BERR( * ), FERR( * ), RWORK( * )
193 COMPLEX A( LDA, * ), B( LDB, * ), WORK( * ),
201 parameter( zero = 0.0e+0 )
203 parameter( one = ( 1.0e+0, 0.0e+0 ) )
206 LOGICAL NOTRAN, NOUNIT, UPPER
207 CHARACTER TRANSN, TRANST
208 INTEGER I, J, K, KASE, NZ
209 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' )
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 ) ) + nz*eps*rwork( i )
432 rwork( i ) = cabs1( work( i ) ) + nz*eps*rwork( i ) +
439 CALL clacn2( n, work( n+1 ), work, ferr( j ), kase, isave )
445 CALL ctrsv( uplo, transt, diag, n, a, lda, work, 1 )
447 work( i ) = rwork( i )*work( i )
454 work( i ) = rwork( i )*work( i )
456 CALL ctrsv( uplo, transn, diag, n, a, lda, work, 1 )
465 lstres = max( lstres, cabs1( x( i, j ) ) )
468 $ ferr( j ) = ferr( j ) / lstres
subroutine xerbla(srname, info)
subroutine caxpy(n, ca, cx, incx, cy, incy)
CAXPY
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...
subroutine ctrmv(uplo, trans, diag, n, a, lda, x, incx)
CTRMV
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