Revision 69b0f9dca8eb051f132725ecc679fe1997246e50 authored by Adrian Baddeley on 18 January 2006, 21:47:25 UTC, committed by cran-robot on 18 January 2006, 21:47:25 UTC
1 parent cb2215f
dppll.f
subroutine dppll(x,y,l1,l2,l3,l4,np,nl,eps,mint,rslt,xmin,jmin)
implicit double precision(a-h,o-z)
dimension x(1), y(1), rslt(np,1), xmin(1), jmin(1)
double precision l1(1), l2(1), l3(1), l4(1)
one = 1.d0
zero = 0.d0
do 23000 j = 1,nl
dx = l3(j) - l1(j)
dy = l4(j) - l2(j)
alen = sqrt(dx**2 + dy**2)
if(.not.(alen .gt. eps))goto 23002
co = dx/alen
si = dy/alen
23002 continue
do 23004 i = 1, np
xpx1 = x(i) - l1(j)
ypy1 = y(i) - l2(j)
xpx2 = x(i) - l3(j)
ypy2 = y(i) - l4(j)
d1 = xpx1**2 + ypy1**2
d2 = xpx2**2 + ypy2**2
dd = min(d1,d2)
if(.not.(alen .gt. eps))goto 23006
xpr = xpx1*co + ypy1*si
if(.not.(xpr .lt. zero .or. xpr .gt. alen))goto 23008
d3 = -one
goto 23009
23008 continue
ypr = - xpx1*si + ypy1*co
d3 = ypr**2
23009 continue
goto 23007
23006 continue
d3 = -one
23007 continue
if(.not.(d3 .gt. zero))goto 23010
dd = min(dd,d3)
23010 continue
sd =sqrt(dd)
rslt(i,j) = sd
if(.not.(mint.gt.0))goto 23012
if(.not.(sd .lt. xmin(i)))goto 23014
xmin(i) = sd
if(.not.(mint.gt.1))goto 23016
jmin(i) = j
23016 continue
23014 continue
23012 continue
23004 continue
23000 continue
return
end
Computing file changes ...