subroutine aptrnds (nopt, x, dx, nsig, np, tol, nerr)
ccbeg.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c SUBROUTINE APTRNDS
c
c call aptrnds (nopt, x, dx, nsig, np, tol, nerr)
c
c Version: aptrnds Updated 1990 December 3 14:20.
c aptrnds Originated 1990 February 2 10:40.
c
c Author: Arthur L. Edwards, LLNL, L-298, Telephone (925) 422-4123.
c
c
c Purpose: To find, for each of np values of x, the new value of x after
c rounding off to the nearest multiple of dx in the first nsig
c significant figures (nopt = 0), or in the absolute value
c (nopt = 1).
c Flag nerr indicates any input error.
c
c Input: nopt, x, dx, nsig, np.
c
c Output: x, nerr.
c
c Glossary:
c
c dx Input Precision of rounded result in significant figure
c nsig (nopt = 0), or in absolute value (nopt = 1).
c Must not be zero. Normally from 1.0 to 5.0.
c Size np.
c
c nerr Output Indicates an input error, if not 0.
c 1 if np is not positive.
c 2 if nopt is not 0 or 1.
c
c nopt Input Indicates type of rounding off to be done.
c 0 to round off to the nearest multiple of dx in the
c first nsig significant figures of x.
c 1 to round off to the nearest multiple of dx in the
c absolute value of x.
c
c np Input Size of arrays x, dx, and if nopt = 0, nsig.
c
c nsig Input Number of significant figures to be rounded off to the
c nearest multiple of dx (nopt = 0).
c Values less than 1 will be equivalent to 1.
c Values greater than the machine limit will have
c no effect.
c Size np, if nopt = 0. Otherwise, undimensioned.
c
c tol Input Precision of mixed integer and floating point
c operations on machine.
c Recommend 1.e-11 on Cray.
c
c x In/Out Value to be rounded off, and rounded result. Size np.
c Method fails if it tries to use an integer larger
c than the biggest machine integer, which can happen if
c x is too big or dx is too small. In that case, the
c original value of x is returned.
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
ccend.
c.... Dimensioned arguments.
c---- Precision in rounded x.
dimension dx (1)
c---- Significant figure with dx.
dimension nsig (1)
c---- Initial and rounded value.
dimension x (1)
c.... Local variables.
c---- Factor dx + tol * x.
common /laptrnds/ dxab
c---- Round-off factor.
common /laptrnds/ fmul
c---- Multiplier to integerize x.
common /laptrnds/ fsig
c---- Index in external array.
common /laptrnds/ n
c---- Integer nsig - 1 - npow.
common /laptrnds/ nexp
c---- Integer value of xpow.
common /laptrnds/ npow
c---- Log (base 10) of fsig.
common /laptrnds/ xpow
c---- Temporary new value of x.
common /laptrnds/ xnew
cbugc***DEBUG begins.
cbug 9901 format (/ 'aptrnds rounding off. nopt=',i2,' np=',i3,
cbug & ' tol=',1pe22.14 /
cbug & (i3,' x,dx=',1p2e22.14,' nsig=',i2))
cbug write ( 3, 9901) nopt, np, tol, (n, x(n), dx(n), nsig(n),
cbug & n = 1, np)
cbugc***DEBUG ends.
c.... Test for input errors.
nerr = 0
if (np .le. 0) then
nerr = 1
go to 210
endif
if ((nopt .lt. 0) .or. (nopt .gt. 1)) then
nerr = 2
go to 210
endif
c.... See which rounding option is to be used.
c---- Rel error in nsig figures dx.
if (nopt .eq. 0) then
c---- Loop over data.
do 120 n = 1, np
xpow = alog10 (abs (x(n)))
if (abs (x(n)) .lt. 1.0) then
xpow = xpow - 1.0
endif
npow = xpow
nexp = max0 (1, min0 (nsig(n), 99)) - npow - 1
fsig = 10.0**nexp
dxab = abs (dx(n)) + tol * abs (x(n))
fmul = sign (dxab / fsig, x(n))
xnew = fmul * nint (x(n) / fmul)
if (abs (xnew - x(n)) .le. 0.5 * fmul) then
x(n) = xnew
endif
c---- End of loop over data.
120 continue
c---- Abs error dx.
else
c---- Loop over data.
do 130 n = 1, np
dxab = abs (dx(n)) + tol * abs (x(n))
fmul = sign (dxab, x(n))
xnew = fmul * nint (x(n) / fmul)
if (abs (xnew - x(n)) .le. 0.5 * fmul) then
x(n) = xnew
endif
c---- End of loop over data.
130 continue
c---- Tested nopt.
endif
cbugc***DEBUG begins.
cbug 9902 format (/ 'aptrnds results:' /
cbug & (i3,' x= ',1pe22.14))
cbug write ( 3, 9902) (n, x(n), n = 1, np)
cbugc***DEBUG ends.
210 return
c.... End of subroutine aptrnds. (+1 line.)
end
UCRL-WEB-209832