subroutine aptfdad (fd, noptfd, tol, nlim, nerr) ccbeg. cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c SUBROUTINE APTFDAD c c call aptfdad (fd, noptfd, tol, nlim, nerr) c c Version: aptfdad Updated 1990 January 18 16:40. c aptfdad 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 value 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, noptfd, tol. c c Output: fd, nlim, nerr. c c Glossary: c c fd Input Fractional distance. c c fd Output Fractional distance, with range limited if noptfd c is 1 or 2. c c nerr Output Indicates an input error, if not 0. c 1 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. 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 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.... (None.) c.... Local variables. c.... (None.) cbugc***DEBUG begins. cbug 9901 format (/ 'aptfdad adjusting with noptfd=',i2,', tol=',1pe13.5 / cbug & ' fd=',1pe22.14) cbug write ( 3, 9901) noptfd, tol, fd cbugc***DEBUG ends. c.... Initialize. nerr = 0 nlim = 0 c.... Test for input errors. c++++ Bad input. if ((noptfd .lt. 0) .or. (noptfd .gt. 2)) then nerr = 1 go to 210 endif 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 if ((fd .gt. -tol) .and. (fd .lt. tol)) then nlim = 1 fd = tol elseif ((fd .gt. (1.0 - tol)) .and. (fd .lt. (1.0 + tol))) then nlim = 1 fd = 1.0 - 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 if (fd .lt. 0.0) then nlim = 2 fd = 0.0 elseif (fd .gt. 1.0) then nlim = 2 fd = 1.0 endif c---- Tested noptfd. endif cbugc***DEBUG begins. cbug 9902 format (/ 'aptfdad results:' / cbug & ' fd=',1pe22.14,' nlim=',i2) cbug write ( 3, 9902) fd, nlim cbugc***DEBUG ends. 210 return c.... End of subroutine aptfdad. (+1 line.) end UCRL-WEB-209832