subroutine aptfdav (fd, np, noptfd, tol, nlim, nerr)
ccbeg.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c SUBROUTINE APTFDAV
c
c call aptfdav (fd, np, noptfd, tol, nlim, nerr)
c
c Version: aptfdav Updated 1990 November 27 14:00.
c aptfdav Originated 1989 November 2 14:10.
c
c Author: Arthur L. Edwards, LLNL, L-298, Telephone (925) 422-4123.
c
c
c Purpose: To adjust the np values of fd, relative to the limits 0 and 1,
c based on the option noptfd and the numerical tolerance limit
c tol. Values of fd initially in the range from -tol to 1 + tol
c may be adjusted to the range from tol to 1 - tol. Values of fd
c outside the range from 0 to 1 may be adjusted to that range.
c The flag nlim indicates if and how fd was adjusted.
c Flag nerr indicates any error in noptfd.
c
c Input: fd, np, noptfd, tol.
c
c Output: fd, nlim, nerr.
c
c Glossary:
c
c fd Input Fractional distance. Size np.
c
c fd Output Fractional distance, with range limited if noptfd
c is 1 or 2. Size np.
c
c nerr Output Indicates an input error, if not 0.
c 1 if np is not positive.
c 2 if noptfd is not between 0 and 2.
c
c nlim Output 0 if no limit imposed on fd, 1 if the limit of
c noptfd = 1 is imposed, 2 if the limit of noptfd = 2
c is imposed. Size np.
c
c noptfd Input Option to limit range of fd: 0 for no limit;
c 1 to increase fd to tol, if in the range from
c -tol to tol, and decrease fd to 1.0 - tol, if in
c the range from 1.0 - tol to 1.0 + tol; and
c 2 to impose the limits for noptfd = 1, and then
c limit fd to the range from 0.0 to 1.0.
c
c np Input Size of arrays fd, nlim.
c
c tol Input Numerical tolerance limit. Needed if noptfd = 1 or 2.
c On Cray computers, recommend 1.e-5 to 1.e-11.
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
ccend.
c.... Dimensioned arguments.
c---- fractional distance.
dimension fd (1)
c---- 1 or 2 if fd limited.
dimension nlim (1)
c.... Local variables.
c---- Initial value of fd(n).
common /laptfdav/ fds
c---- Index in arrays fd, nlim.
common /laptfdav/ n
cbugc***DEBUG begins.
cbug 9901 format (/ 'aptfdav adjusting fd with noptfd=',i2,
cbug & ' tol=',1pe13.5 /
cbug & (i3,' fd=',1pe22.14))
cbug write ( 3, 9901) noptfd, tol, (n, fd(n), n = 1, np)
cbugc***DEBUG ends.
c.... Initialize.
nerr = 0
c.... Test for input errors.
if (np .le. 0) then
nerr = 1
go to 210
endif
c++++ Bad input.
if ((noptfd .lt. 0) .or. (noptfd .gt. 2)) then
nerr = 2
go to 210
endif
c.... Initialize.
c---- Loop over fractional distances.
do 110 n = 1, np
nlim(n) = 0
c---- End of loop over fractional distances.
110 continue
c.... If noptfd is 1 or 2, increase values of fd between -tol and tol to tol,
c.... and decrease values of fd between 1.0 - tol and 1.0 + tol
c.... to 1.0 - tol.
c---- Adjust fd near ends of line segment.
if (noptfd .ne. 0) then
c---- See if adjustment needed.
if (tol .gt. 0.0) then
c---- Loop over fractional distances.
do 120 n = 1, np
fds = fd(n)
if ((fd(n) .gt. -tol) .and. (fd(n) .lt. tol)) then
fd(n) = tol
endif
if ((fd(n) .gt. (1.0 - tol)) .and.
& (fd(n) .lt. (1.0 + tol))) then
fd(n) = 1.0 - tol
endif
if (fd(n) .ne. fds) then
nlim(n) = 1
endif
c---- End of loop over fractional distance
120 continue
c---- Tested tol.
endif
endif
c.... If noptfd is 2, limit fd to range from 0.0 to 1.0.
c---- Limit fd to the range 0.0 - 1.0.
if (noptfd .eq. 2) then
c---- Loop over fractional distances.
do 130 n = 1, np
fds = fd(n)
if (fd(n) .lt. 0.0) then
fd(n) = 0.0
endif
if (fd(n) .gt. 1.0) then
fd(n) = 1.0
endif
if (fd(n) .ne. fds) then
nlim(n) = 2
endif
c---- End of loop over fractional distances.
130 continue
c---- Tested noptfd.
endif
cbugc***DEBUG begins.
cbug 9902 format (/ 'aptfdav results:' /
cbug & (i3,' fd=',1pe22.14,' nlim=',i3))
cbug write ( 3, 9902) (n, fd(n), nlim(n), n = 1, np)
cbugc***DEBUG ends.
210 return
c.... End of subroutine aptfdav. (+1 line.)
end
UCRL-WEB-209832