182 SUBROUTINE strrfs( UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, X,
183 $ ldx, ferr, berr, work, iwork, info )
191 CHARACTER diag, trans, uplo
192 INTEGER info, lda, ldb, ldx, n, nrhs
196 REAL a( lda, * ),
b( ldb, * ), berr( * ), ferr( * ),
197 $ work( * ),
x( ldx, * )
204 parameter( zero = 0.0e+0 )
206 parameter( one = 1.0e+0 )
209 LOGICAL notran, nounit, upper
211 INTEGER i,
j, k, kase, nz
212 REAL eps, lstres, s, safe1, safe2, safmin, xk
233 upper =
lsame( uplo,
'U' )
234 notran =
lsame( trans,
'N' )
235 nounit =
lsame( diag,
'N' )
237 IF( .NOT.upper .AND. .NOT.
lsame( uplo,
'L' ) )
THEN
239 ELSE IF( .NOT.notran .AND. .NOT.
lsame( trans,
'T' ) .AND. .NOT.
240 $
lsame( trans,
'C' ) )
THEN
242 ELSE IF( .NOT.nounit .AND. .NOT.
lsame( diag,
'U' ) )
THEN
244 ELSE IF( n.LT.0 )
THEN
246 ELSE IF( nrhs.LT.0 )
THEN
248 ELSE IF( lda.LT.max( 1, n ) )
THEN
250 ELSE IF( ldb.LT.max( 1, n ) )
THEN
252 ELSE IF( ldx.LT.max( 1, n ) )
THEN
256 CALL
xerbla(
'STRRFS', -info )
262 IF( n.EQ.0 .OR. nrhs.EQ.0 )
THEN
280 safmin =
slamch(
'Safe minimum' )
291 CALL
scopy( n,
x( 1,
j ), 1, work( n+1 ), 1 )
292 CALL
strmv( uplo, trans, diag, n, a, lda, work( n+1 ), 1 )
293 CALL
saxpy( n, -one,
b( 1,
j ), 1, work( n+1 ), 1 )
305 work( i ) = abs(
b( i,
j ) )
315 xk = abs(
x( k,
j ) )
317 work( i ) = work( i ) + abs( a( i, k ) )*xk
322 xk = abs(
x( k,
j ) )
324 work( i ) = work( i ) + abs( a( i, k ) )*xk
326 work( k ) = work( k ) + xk
332 xk = abs(
x( k,
j ) )
334 work( i ) = work( i ) + abs( a( i, k ) )*xk
339 xk = abs(
x( k,
j ) )
341 work( i ) = work( i ) + abs( a( i, k ) )*xk
343 work( k ) = work( k ) + xk
356 s = s + abs( a( i, k ) )*abs(
x( i,
j ) )
358 work( k ) = work( k ) + s
364 s = s + abs( a( i, k ) )*abs(
x( i,
j ) )
366 work( k ) = work( k ) + s
374 s = s + abs( a( i, k ) )*abs(
x( i,
j ) )
376 work( k ) = work( k ) + s
382 s = s + abs( a( i, k ) )*abs(
x( i,
j ) )
384 work( k ) = work( k ) + s
391 IF( work( i ).GT.safe2 )
THEN
392 s = max( s, abs( work( n+i ) ) / work( i ) )
394 s = max( s, ( abs( work( n+i ) )+safe1 ) /
395 $ ( work( i )+safe1 ) )
423 IF( work( i ).GT.safe2 )
THEN
424 work( i ) = abs( work( n+i ) ) + nz*eps*work( i )
426 work( i ) = abs( work( n+i ) ) + nz*eps*work( i ) + safe1
432 CALL
slacn2( n, work( 2*n+1 ), work( n+1 ), iwork, ferr(
j ),
439 CALL
strsv( uplo, transt, diag, n, a, lda, work( n+1 ),
442 work( n+i ) = work( i )*work( n+i )
449 work( n+i ) = work( i )*work( n+i )
451 CALL
strsv( uplo, trans, diag, n, a, lda, work( n+1 ),
461 lstres = max( lstres, abs(
x( i,
j ) ) )
464 $ ferr(
j ) = ferr(
j ) / lstres
LOGICAL function lsame(CA, CB)
LSAME
REAL function slamch(CMACH)
SLAMCH
subroutine xerbla(SRNAME, INFO)
XERBLA
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine strmv(UPLO, TRANS, DIAG, N, A, LDA, X, INCX)
STRMV
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY
subroutine saxpy(N, SA, SX, INCX, SY, INCY)
SAXPY
subroutine strsv(UPLO, TRANS, DIAG, N, A, LDA, X, INCX)
STRSV
subroutine slacn2(N, V, X, ISGN, EST, KASE, ISAVE)
SLACN2 estimates the 1-norm of a square matrix, using reverse communication for evaluating matrix-vec...
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine strrfs(UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
STRRFS