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 )
integer function isamax(N, SX, INCX)
ISAMAX
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
logical function lsame(CA, CB)
LSAME
subroutine saxpy(N, SA, SX, INCX, SY, INCY)
SAXPY
subroutine stpmv(UPLO, TRANS, DIAG, N, AP, X, INCX)
STPMV
real function slamch(CMACH)
SLAMCH
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