https://github.com/cran/LatticeKrig
Revision 313a59201254ffc2d7fca3c3e87b2e4e10d04d3b authored by Douglas Nychka on 30 April 2018, 17:39:37 UTC, committed by cran-robot on 30 April 2018, 17:39:37 UTC
1 parent 4f58b50
Tip revision: 313a59201254ffc2d7fca3c3e87b2e4e10d04d3b authored by Douglas Nychka on 30 April 2018, 17:39:37 UTC
version 7.0
version 7.0
Tip revision: 313a592
dfind1d.f
c**** # LatticeKrig is a package for analysis of spatial data written for
c**** # the R software environment .
c**** # Copyright (C) 2016
c**** # University Corporation for Atmospheric Research (UCAR)
c**** # Contact: Douglas Nychka, nychka@ucar.edu,
c**** # National Center for Atmospheric Research, PO Box 3000, Boulder, CO 80307-3000
c**** #
c**** # This program is free software; you can redistribute it and/or modify
c**** # it under the terms of the GNU General Public License as published by
c**** # the Free Software Foundation; either version 2 of the License, or
c**** # (at your option) any later version.
c**** # This program is distributed in the hope that it will be useful,
c**** # but WITHOUT ANY WARRANTY; without even the implied warranty of
c**** # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
c**** # GNU General Public License for more details.
subroutine dfind1d( x1, n1, x2, n2, delta2, ind, rd, Nmax, iflag)
integer n1,n2,ind(Nmax,2)
integer kk, i,j
double precision x1(n1), x2(n2), delta2(n2), rd(Nmax), dtemp
c**** counter for accumulating close points
kk=0
do 15 i= 1, n1
kksave= kk
do 10 j =1,n2
c**** accumulate squared differences
dtemp= (x1(i) - x2(j))**2
if( dtemp.gt.delta2(j)) goto 10
c**** dtemp is less than delta2 so save it as a close point
kk=kk+1
c**** check if there is still array space
if( kk .gt. Nmax) then
iflag= -1
return
else
ind(kk,1)= i
ind(kk,2)= j
rd(kk)= sqrt( dtemp)
endif
10 continue
15 continue
iflag=1
Nmax=kk
end
Computing file changes ...