169 SUBROUTINE dtrt03( UPLO, TRANS, DIAG, N, NRHS, A, LDA, SCALE,
170 $ cnorm, tscal,
x, ldx,
b, ldb, work, resid )
178 CHARACTER diag, trans, uplo
179 INTEGER lda, ldb, ldx, n, nrhs
180 DOUBLE PRECISION resid, scale, tscal
183 DOUBLE PRECISION a( lda, * ),
b( ldb, * ), cnorm( * ),
184 $ work( * ),
x( ldx, * )
190 DOUBLE PRECISION one, zero
191 parameter( one = 1.0d+0, zero = 0.0d+0 )
195 DOUBLE PRECISION bignum, eps, err, smlnum, tnorm, xnorm, xscal
207 INTRINSIC abs, dble, max
213 IF( n.LE.0 .OR. nrhs.LE.0 )
THEN
218 smlnum =
dlamch(
'Safe minimum' )
219 bignum = one / smlnum
220 CALL
dlabad( smlnum, bignum )
226 IF(
lsame( diag,
'N' ) )
THEN
228 tnorm = max( tnorm, tscal*abs( a(
j,
j ) )+cnorm(
j ) )
232 tnorm = max( tnorm, tscal+cnorm(
j ) )
241 CALL
dcopy( n,
x( 1,
j ), 1, work, 1 )
243 xnorm = max( one, abs(
x( ix,
j ) ) )
244 xscal = ( one / xnorm ) / dble( n )
245 CALL
dscal( n, xscal, work, 1 )
246 CALL
dtrmv( uplo, trans, diag, n, a, lda, work, 1 )
247 CALL
daxpy( n, -scale*xscal,
b( 1,
j ), 1, work, 1 )
249 err = tscal*abs( work( ix ) )
251 xnorm = abs(
x( ix,
j ) )
252 IF( err*smlnum.LE.xnorm )
THEN
259 IF( err*smlnum.LE.tnorm )
THEN
266 resid = max( resid, err )
LOGICAL function lsame(CA, CB)
LSAME
subroutine dtrt03(UPLO, TRANS, DIAG, N, NRHS, A, LDA, SCALE, CNORM, TSCAL, X, LDX, B, LDB, WORK, RESID)
DTRT03
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
subroutine dlabad(SMALL, LARGE)
DLABAD
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine dscal(N, DA, DX, INCX)
DSCAL
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine daxpy(N, DA, DX, INCX, DY, INCY)
DAXPY
DOUBLE PRECISION function dlamch(CMACH)
DLAMCH
subroutine dtrmv(UPLO, TRANS, DIAG, N, A, LDA, X, INCX)
DTRMV
INTEGER function idamax(N, DX, INCX)
IDAMAX