      subroutine sum1pnt(numcols,numrows,nspmod,nsptrac,igroup,idxfile,
     &             idx,nptsrc,emsbas,emsoth,emslft,emstot,
     &                             emspnt,emssum,izcel,idcompact,lemit)
      use grid
      use chmstry
      use pigsty
      use filunit
      use tracer
c
c     Copyright 1996 - 2018
c     Ramboll
c
c
c----CAMx v7Beta6 190902
c
c     SUM1PNT sums up the point emission of one species for a given group
c
c       07/19/02  --gwilson-- Added seperate source area map for each grid.
c       08/25/05  --cemery--  Revamped PiG pointer arrays for source group
c                             and region
c       11/16/06  --gwilson-- fixed bug in point source override for PiG sources
c       11/27/06  --gwilson-- fixed bug in calculating emissions table
c       10/28/09  --gwilson-- Changed dimension of variables to accomodate 
c                             the dynamic memory allocation
c       12/20/13  --gwilson-- Added compact point source file
c       03/01/16  --gwilson-- Added partial source area map
c
c     Input argument:
c        numcols           max number of columns in any grid
c        numrows           max number of columns in any grid
c        nspmod            number of model species
c        nsptrac           number of tracer species
c        igroup            group ID
c        idxfile           file number
c        idx               specie ID
c        emspnt            the species emission for the group
c        idcompact         index of the source in master list
c
c     Output arguments:
c        emssum            emission summed over grid
c        emsbas            base emission
c        emsoth            "otherwise" emission
c        emslft            leftover emission
c        emstot            total emission
c        lemit             flag to determine if tracer class is emitted
c
      include "camx.prm"
      include "flags.inc"
c
      character*200 fname
      integer   numcols
      integer   numrows
      integer   nspmod
      integer   nsptrac
      integer   igroup
      integer   idxfile
      integer   idx
      integer   nptsrc
      real      emsbas(nspmod,nsptrac)
      real      emsoth(nspmod,nsptrac)
      real*8    emslft(numcols,numrows,nspmod)
      real*8    emstot(numcols,numrows,nspmod)
      real      emspnt(MXPTSRC)
      real      emssum(nspmod,nsptrac)
      integer   izcel(*)
      integer   idcompact(*)
      logical   lemit(*)
      logical   luse
      integer   ipart
      real      frac
c
      real, allocatable, dimension(:) :: xloctmp
      real, allocatable, dimension(:) :: yloctmp
c
c  --- allocate the local arrays ---
c
      allocate( xloctmp(nptsrc) )
      allocate( yloctmp(nptsrc) )
c
c   --- set the file name for elevated points emissions file ---
c
      num_ptsfiles = num_iortpt(igroup)
      if( igroup .EQ. 0 ) num_ptsfiles = npoint_files
      if( igroup .EQ. 0 ) then
        write(fname,'(A,I3)') 'PTSOURCE -- UNIT ',iptem(idxfile)
      else
        fname = tptfil(igroup,idxfile)
      endif
c
c  --- make sure this species is needed ---
c
      luse = .FALSE.
      do icls=1,ntrcls
        if( trspmap(idx,icls) .NE. 0.  .OR.
     &                         yhratmap(idx,icls) .NE. 0. .OR.
     &                        ylratmap(idx,icls) .NE. 0. ) then
          if( trspmap(idx,icls) .NE. 0. ) lemit(icls) = .TRUE.
          luse = .TRUE.
        endif
      enddo
      if( .NOT. luse ) goto 9999
c
c   --- sum up the emissions for each point ---
c
      if (llatlon) then
        do n = 1,nptsrc
          idxpt = idcompact(n)
          idxbase = idx_point_in_list(igroup,idxfile,idxpt)
          xloctmp(n) = xlocpt(idxbase) - xorg
          yloctmp(n) = ylocpt(idxbase) - yorg
        enddo
      else
        do n = 1,nptsrc
          idxpt = idcompact(n)
          idxbase = idx_point_in_list(igroup,idxfile,idxpt)
          xloctmp(n) = xlocpt(idxbase)/1000. - xorg
          yloctmp(n) = ylocpt(idxbase)/1000. - yorg
        enddo
      endif
c
      do 70 i=1,nptsrc
         idxbase = idx_point_in_list(igroup,idxfile,i)
         idxpt = idcompact(i)
         icel = 1 + FLOOR( xloctmp(i)/delx )
         jcel = 1 + FLOOR( yloctmp(i)/dely )
         if(icel .LE. 0 .OR. icel .GT. ncol(1)) goto 70
         if(jcel .LE. 0 .OR. jcel .GT. nrow(1)) goto 70
         icrs = icel
         jcrs = jcel
c
c   --- find out if a nest contains this source  ---
c
         igrd = 1
         do ig = 2,ngrid
           xlocnst = xloctmp(i) - (inst1(ig)-1)*delx
           ylocnst = yloctmp(i) - (jnst1(ig)-1)*dely
           ii = 2 + FLOOR( xlocnst/delx * FLOAT( meshold(ig) ) )
           jj = 2 + FLOOR( ylocnst/dely * FLOAT( meshold(ig) ) )
           if( ii .GT. 1 .AND. jj .GT. 1 .AND. ii .LT. ncol(ig) .AND.
     &                                           jj .LT. nrow(ig) ) then
              igrd = ig
              icel = ii
              jcel = jj
            endif
         enddo
c
c  --- get the region for this cell from mapping array ----
c
        imap = igrmap(0,1,igrd,icel,jcel)
        frac = 1.0
c
c  --- change the region if the override is set ---
c
        if( izcel(idcompact(i)) .LT. 0 ) then
            if( .NOT. lptoverride ) then
               write(iout,'(//,a)') 'ERROR in SUM1PNT:'
               write(iout,'(/,1X,2A )') 'A source was read that has the point ',
     &                   'source override trigger turned on.'
               write(iout,'(1X,2A)') 'If you intend to use point source ',
     &                     'override please set the namelist variable'
               write(iout,'(1X,2A)') 'SA_PT_Override to TRUE in the CAMx_Control namelist.'
               write(iout,'(1X,2A)') 'If you do not want point source override ',
     &                         'you need to set the kcell variable '
               write(iout,'(1X,2A)') 'in your point source file to zero.'
               call camxerr()
            endif
            imap = ABS( izcel(idcompact(i)) )
            frac = 1.0
        endif
        if( imap .LE. 0 .OR. imap .GT. nregin ) then
           write(iout,'(//,a)') 'ERROR in SUM1PNT:'
           write(iout,'(/,1X,A,A,I4)') 'Invalid region found in',
     &             ' point source override when reading point source file.'
           write(iout,'(1X,A,I4)') 'Region code      : ',imap
           write(iout,'(1X,A,I4)') 'Number of regions: ',nregin
           write(iout,'(10X,A,/,A)') 'Point source filename: ',
     &                                                 fname(:istrln(fname))
           write(iout,'(1X,2A)') 'Check the values in the point ',
     &                                                     'source overide.'
           call camxerr()
        endif
c
c  --- calculate the index into the tracer species for this group/region ---
c
        if( ngroup .GT. 0 ) then
c
c   --- if group is base emissions, add to "leftover" group ----
c
           if( igroup .EQ. 0 ) then
              if( leftovr ) then
                 do icls=1,ntrcls
                    if( trspmap(idx,icls) .NE. 0.  .OR.
     &                                 yhratmap(idx,icls) .NE. 0. .OR.
     &                                 ylratmap(idx,icls) .NE. 0. ) then
                        ipt = iemcls(icls)-1 + imap+ngroup*nregin
                        emsbas(idx,ipt) = emsbas(idx,ipt) + emspnt(i) * frac
                    endif
                 enddo
              endif

c  --- if doing PiG and source is a PIG source, set the PiG map and group
c      pointers ---
c
              if( lpigsa(idxpt) .AND. emspnt(i) .GT. 0. ) then
                 ipigmap(idxpt) = imap
                 ipiggrp(idxpt) = ngroup
              endif
c
              do icls=1,ntrcls
                 if( trspmap(idx,icls) .NE. 0.  .OR.
     &                                 yhratmap(idx,icls) .NE. 0. .OR.
     &                                 ylratmap(idx,icls) .NE. 0. ) then
                    emstot(icrs,jcrs,idx) = 
     &                              emstot(icrs,jcrs,idx) +  emspnt(i) * frac
                 endif
              enddo
c
c   --- otherwise, add to this group/region and subtract from "leftover" ---
c
           else
c
c  --- if doing PiG and source is a PIG source, set the PiG map and group
c      pointers ---
c
              if( lpigsa(idxpt) .AND. emspnt(i) .GT. 0. ) then
                 ipigmap(idxpt) = imap
                 ipiggrp(idxpt) = igroup-1
              endif
c
              do icls=1,ntrcls
                 if( trspmap(idx,icls) .NE. 0.  .OR.
     &                                 yhratmap(idx,icls) .NE. 0. .OR.
     &                                 ylratmap(idx,icls) .NE. 0. ) then
                    ipt = iemcls(icls)-1 + imap +(igroup-1)*nregin
                    emssum(idx,ipt) = emssum(idx,ipt) + emspnt(i) * frac
                    if( leftovr ) then
                      ipt = iemcls(icls)-1 + imap+ngroup*nregin
                      emsoth(idx,ipt) = emsoth(idx,ipt) + emspnt(i) * frac
                    endif
                 endif
              enddo
              do icls=1,ntrcls
                  if( trspmap(idx,icls) .NE. 0.  .OR.
     &                                 yhratmap(idx,icls) .NE. 0. .OR.
     &                                 ylratmap(idx,icls) .NE. 0. ) then
                    emslft(icrs,jcrs,idx) = 
     &                         emslft(icrs,jcrs,idx) + emspnt(i) * frac
                 endif
              enddo
           endif

c   --- only using regular model emissions ---
c
        else
           do icls=1,ntrcls
              if( trspmap(idx,icls) .NE. 0.  .OR.
     &                                 yhratmap(idx,icls) .NE. 0. .OR.
     &                                 ylratmap(idx,icls) .NE. 0. ) then
                 ipt = iemcls(icls) - 1 + imap
                 emssum(idx,ipt) = emssum(idx,ipt) + emspnt(i) * frac
              endif
           enddo
c
c  --- if doing PiG and source is a PIG source, set the PiG map and group
c      pointers ---
c
           if( lpigsa(idxpt) .AND. emspnt(i) .GT. 0. ) then
              ipigmap(idxpt) = imap
              ipiggrp(idxpt) = 0
           endif
        endif
  70  continue
c
c  --- next file for this group ---
c
 9999 continue
c
c  --- deallocate the local arrays ---
c
      deallocate( xloctmp )
      deallocate( yloctmp )
c
      return
      end
