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
Raw File
Tip revision: 313a59201254ffc2d7fca3c3e87b2e4e10d04d3b authored by Douglas Nychka on 30 April 2018, 17:39:37 UTC
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

  
back to top