c*** FND_POINT
c
      function fnd_point(stk_xloc,stk_yloc,stk_height,stk_diam,
     &                                   stk_temper,already_found)
      use ptemiss
      use tracer
      implicit none
      integer fnd_point
c
c----CAMx v7Beta6 190902
c
c-----------------------------------------------------------------------
c   Description:
c     This routine looks through the list of all of the stacks 
c     for the regular model point source inventory and checks 
c     for a match with the locations and stack parameters passed 
c     in the argument list.
c
c     Copyright 1996 - 2018
c     Ramboll
c
c    Argument description:
c      stk_xloc      R X-location of source
c      stk_yloc      R Y-location of source
c      stk_height    R stack height 
c      stk_diam      R stack diameter
c      stk_temper    R stack temperature
c      already_found L flag set to true if the source in list was already found
c
c-----------------------------------------------------------------------
c    LOG:
c-----------------------------------------------------------------------
c
c      1/21/19   Original devlopment
c
c-----------------------------------------------------------------------
c   Include files:
c-----------------------------------------------------------------------
c
      include 'camx.prm'
c
c-----------------------------------------------------------------------
c    Argument declarations:
c-----------------------------------------------------------------------
c
      real    stk_xloc
      real    stk_yloc
      real    stk_height
      real    stk_diam
      real    stk_temper
      logical already_found(*)
c
c-----------------------------------------------------------------------
c    Local parameters:
c-----------------------------------------------------------------------
c
c      FUZZ_LOC    R fuzz factor for comparing location coordinates
c      FUZZ_HEIGHT R fuzz factor for comparing stack height
c      FUZZ_DIAM   R fuzz factor for comparing stack diameter
c      FUZZ_TEMPER R fuzz factor for comparing stack temperature
c
      real FUZZ_LOC
      real FUZZ_HEIGHT
      real FUZZ_DIAM
      real FUZZ_TEMPER
c
      parameter( FUZZ_LOC    = 0.5 )
      parameter( FUZZ_HEIGHT = 0.5 )
      parameter( FUZZ_DIAM   = 0.5 )
      parameter( FUZZ_TEMPER = 0.5 )
c
c-----------------------------------------------------------------------
c    Local variables:
c-----------------------------------------------------------------------
c
      integer idxpt, istart, iend
      logical second_pass
c
c-----------------------------------------------------------------------
c    Entry point:
c-----------------------------------------------------------------------
c
c  --- set the return false to not found ---
c 
      fnd_point = -9
c
c  --- set the location to loop through ---
c
      istart = idx_last_found
      iend = nptsrc
      second_pass = .FALSE.
      fnd_point = -9
c
c  --- loop over all stacks in master list ---
c
  111 continue
      do 10 idxpt=istart,iend
      fnd_point = -9
c
c  --- skip if this is already found ---
c
          if( already_found(idxpt) ) cycle
c
c  --- check values and skip if not within tolerance ---
c
          if( ABS(xlocpt(idxpt) - stk_xloc ) .GT. FUZZ_LOC ) goto 10
          if( ABS(ylocpt(idxpt) - stk_yloc ) .GT. FUZZ_LOC ) goto 10
          if( ABS(hstk(idxpt) - stk_height ) .GT. FUZZ_HEIGHT ) goto 10
          if( ABS(dstk(idxpt) - stk_diam ) .GT. FUZZ_DIAM ) goto 10
          if( ABS(tstk(idxpt) - stk_temper ) .GT. FUZZ_TEMPER ) goto 10
c
c  --- if it was the right stack set return value and leave ---
c
          fnd_point = idxpt
          idx_last_found = idxpt
          goto 9999
c
c  ---- next source ---
c
 10   continue
c
c  --- check if another pass is needed ---
c
      if( .NOT. second_pass ) then
         second_pass = .TRUE.
         istart = 1
         iend = idx_last_found
         goto 111
      endif 
c
c  --- didn't find it, return value is negative ---
c
      goto 9999
c
c-----------------------------------------------------------------------
c    Error messages:
c-----------------------------------------------------------------------
c
c-----------------------------------------------------------------------
c    Format statements:
c-----------------------------------------------------------------------
c
 9000 format(/,1X,2A)
c
c-----------------------------------------------------------------------
c    Return point:
c-----------------------------------------------------------------------
c
 9999 continue
      return
      end
c