161 SUBROUTINE dtpt03( UPLO, TRANS, DIAG, N, NRHS, AP, SCALE, CNORM,
162 $ tscal,
x, ldx,
b, ldb, work, resid )
170 CHARACTER diag, trans, uplo
171 INTEGER ldb, ldx, n, nrhs
172 DOUBLE PRECISION resid, scale, tscal
175 DOUBLE PRECISION ap( * ),
b( ldb, * ), cnorm( * ), work( * ),
182 DOUBLE PRECISION one, zero
183 parameter( one = 1.0d+0, zero = 0.0d+0 )
187 DOUBLE PRECISION bignum, eps, err, smlnum, tnorm, xnorm, xscal
199 INTRINSIC abs, dble, max
205 IF( n.LE.0 .OR. nrhs.LE.0 )
THEN
210 smlnum =
dlamch(
'Safe minimum' )
211 bignum = one / smlnum
212 CALL
dlabad( smlnum, bignum )
218 IF(
lsame( diag,
'N' ) )
THEN
219 IF(
lsame( uplo,
'U' ) )
THEN
222 tnorm = max( tnorm, tscal*abs( ap( jj ) )+cnorm(
j ) )
228 tnorm = max( tnorm, tscal*abs( ap( jj ) )+cnorm(
j ) )
234 tnorm = max( tnorm, tscal+cnorm(
j ) )
243 CALL
dcopy( n,
x( 1,
j ), 1, work, 1 )
245 xnorm = max( one, abs(
x( ix,
j ) ) )
246 xscal = ( one / xnorm ) / dble( n )
247 CALL
dscal( n, xscal, work, 1 )
248 CALL
dtpmv( uplo, trans, diag, n, ap, work, 1 )
249 CALL
daxpy( n, -scale*xscal,
b( 1,
j ), 1, work, 1 )
251 err = tscal*abs( work( ix ) )
253 xnorm = abs(
x( ix,
j ) )
254 IF( err*smlnum.LE.xnorm )
THEN
261 IF( err*smlnum.LE.tnorm )
THEN
268 resid = max( resid, err )
LOGICAL function lsame(CA, CB)
LSAME
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
subroutine dtpmv(UPLO, TRANS, DIAG, N, AP, X, INCX)
DTPMV
subroutine dtpt03(UPLO, TRANS, DIAG, N, NRHS, AP, SCALE, CNORM, TSCAL, X, LDX, B, LDB, WORK, RESID)
DTPT03
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
INTEGER function idamax(N, DX, INCX)
IDAMAX