161 SUBROUTINE stpt03( 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 REAL resid, scale, tscal
175 REAL ap( * ),
b( ldb, * ), cnorm( * ), work( * ),
183 parameter( one = 1.0e+0, zero = 0.0e+0 )
187 REAL bignum, eps, err, smlnum, tnorm, xnorm, xscal
199 INTRINSIC abs, max, real
205 IF( n.LE.0 .OR. nrhs.LE.0 )
THEN
210 smlnum =
slamch(
'Safe minimum' )
211 bignum = one / smlnum
212 CALL
slabad( 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
scopy( n,
x( 1,
j ), 1, work, 1 )
245 xnorm = max( one, abs(
x( ix,
j ) ) )
246 xscal = ( one / xnorm ) /
REAL( n )
247 CALL
sscal( n, xscal, work, 1 )
248 CALL
stpmv( uplo, trans, diag, n, ap, work, 1 )
249 CALL
saxpy( 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
INTEGER function isamax(N, SX, INCX)
ISAMAX
REAL function slamch(CMACH)
SLAMCH
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY
subroutine saxpy(N, SA, SX, INCX, SY, INCY)
SAXPY
subroutine stpmv(UPLO, TRANS, DIAG, N, AP, X, INCX)
STPMV
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine slabad(SMALL, LARGE)
SLABAD
subroutine stpt03(UPLO, TRANS, DIAG, N, NRHS, AP, SCALE, CNORM, TSCAL, X, LDX, B, LDB, WORK, RESID)
STPT03
subroutine sscal(N, SA, SX, INCX)
SSCAL