00001
00002 c
00003 c Copyright (c) 1986,1987,1988,1989,1990,1991,1992,1993,
00004 c by Steve McMillan, Drexel University, Philadelphia, PA.
00005 c
00006 c All rights reserved.
00007 c
00008 c Redistribution and use in source and binary forms are permitted
00009 c provided that the above copyright notice and this paragraph are
00010 c duplicated in all such forms and that any documentation,
00011 c advertising materials, and other materials related to such
00012 c distribution and use acknowledge that the software was developed
00013 c by the author named above.
00014 c
00015 c THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
00016 c IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
00017 c WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
00018 c
00019
00020 subroutine fr lnfnc(x1, x2, dx, mode, first, npost)
00021 save
00022 data eps/0.001/
00023
00024 c mode = 1: Establish fenceposts between x1 and x2, at interval dx
00025 c mode = 2: Move posts out to contain x1 and x2
00026
00027 if (x2.lt.x1) then
00028 small = x2
00029 big = x1
00030 else
00031 small = x1
00032 big = x2
00033 end if
00034
00035 c Note attempts to deal with real to integer conversion!
00036
00037 dxg = abs(dx)
00038 fs = small/dxg
00039 if (fs .gt. 0) then
00040 ns = fs + eps
00041 else
00042 ns = fs - eps
00043 endif
00044
00045 if (abs(fs-ns).gt.eps) then
00046 if (small.gt.0.) ns = ns + 1
00047 if (mode.eq.2) ns = ns - 1
00048 end if
00049
00050 fb = big/dxg
00051 if (fb .gt. 0) then
00052 nb = fb + eps
00053 else
00054 nb = fb - eps
00055 endif
00056
00057 if (abs(fb-nb).gt.eps) then
00058 if (big.lt.0.) nb = nb - 1
00059 if (mode.eq.2) nb = nb + 1
00060 end if
00061
00062 if (x2.le.x1) then
00063 i = nb
00064 nb = ns
00065 ns = i
00066 end if
00067
00068 first = ns*dxg
00069 npost = abs(nb-ns) + 1
00070
00071 if (mode.eq.2) then
00072 x1 = first
00073 x2 = nb*dxg
00074 end if
00075
00076 end
