c*** PIGDUMPSA
c
      subroutine pigdumpsa(ncolx,nrowy,nlays,nrad,nspc,ntrac,
     &                     icell,jcell,kclbeg,kclend,idxpig,
     &                     delconc,saconc)
      use grid
      use pigsty
      use tracer
      implicit none
c
c----CAMx v7Beta6 190902
c
c-----------------------------------------------------------------------
c   Description:
c     This routine puts the mass from the PiG into the tracer
c     concentration array.  The mass is added to the tracer species
c     from the region/group from which the PiG originated.
c
c     Copyright 1996 - 2018
c     Ramboll
c
c   Argument descriptions:
c     Inputs:
c       ncolx   I  number of columns
c       nrowy   I  number of rows
c       nlays   I  number of layers
c       nrad    I  number of radical species
c       nspc    I  number of model species
c       ntrac   I  number of tracers
c       icell   I  the X grid location of current cell
c       jcell   I  the X grid location of current cell
c       kclbeg  I  the bottom vertical layer in the affected column
c       kclend  I  the top vertical layer in the affected column
c       idxpig  I  the index of the puff in PiG arrays
c       delconc R  change in model concentrations 
c       saconc  R  gridded array of tracer concentrations
c
c-----------------------------------------------------------------------
c   LOG:
c-----------------------------------------------------------------------
c
c       12/08/96  --gwilson--   Original development
c       11/10/97  --gwilson--   Removed unused argument: IGRID
c       08/25/05  --cemery--    Revamped to use puff-specific source 
c                               region/group pointers
c       02/10/16  --bkoo--      Updated for OSAT3
c
c-----------------------------------------------------------------------
c   Include files:
c-----------------------------------------------------------------------
c
      include 'camx.prm'
c
c-----------------------------------------------------------------------
c    Argument declarations:
c-----------------------------------------------------------------------
c
      integer   ncolx
      integer   nrowy
      integer   nlays
      integer   nrad
      integer   nspc
      integer   ntrac
      integer   icell
      integer   jcell
      integer   kclbeg
      integer   kclend
      integer   idxpig
      real      delconc(MXLAYER,MXSPEC+1)
      real      saconc(ncolx,nrowy,nlays,ntrac)
c
c-----------------------------------------------------------------------
c    Local variables:
c-----------------------------------------------------------------------
c
      integer icls, ispc, itrc, i, kcel
      integer iOO, iO3
      real    delcls(MXALCLS)
      real    sumcls
      real    sumO3, sumOO, prodOO, destOO, OOtoO3
c
c-----------------------------------------------------------------------
c    Entry point:
c-----------------------------------------------------------------------
c
c  --- loop over all layers in the affected column ---
c  
      do kcel = kclbeg, kclend
c
c  --- get concentration change for model species of each tracer class
c
         do icls = 1, ntrcls
            delcls(icls) = 0.
            do ispc = nrad+1, nspc
               delcls(icls) = delcls(icls)
     &                      + delconc(kcel,ispc) * fluxmap(ispc,icls)
            enddo
         enddo
c
c  --- update O3 & OO tracers
c
         if ( lozone ) then

            sumO3 = 0.
            do i = iptcls(idxipt(ITRO3N)), nptcls(idxipt(ITRO3V))
               sumO3 = sumO3 + saconc(icell,jcell,kcel,i)
            enddo
            sumO3 = MAX(BNDLPT, sumO3)

            sumOO = 0.
            do i = iptcls(idxipt(ITROON)), nptcls(idxipt(ITROOV))
               sumOO = sumOO + saconc(icell,jcell,kcel,i)
            enddo
            sumOO = MAX(BNDLPT, sumOO)

            prodOO = MAX( 0.,  delcls(idxipt(ITRRGN)) )
            destOO = MAX( 0., -delcls(idxipt(ITRRGN)) )

            if ( delcls(idxipt(ITRO3V)) .GT. 0. ) then
c
c  --- this is not supposed to happen, but just in case ...
c
c  --- allocate O3 from NO2 destruction based on relative contribution of OOX
c
               OOtoO3 = MIN( destOO, delcls(idxipt(ITRO3V)) )

               iOO = iptcls(idxipt(ITROON)) - 1
               do i = iptcls(idxipt(ITRO3N)), nptcls(idxipt(ITRO3V))
                  iOO = iOO + 1
                  saconc(icell,jcell,kcel,i) = saconc(icell,jcell,kcel,i)
     &                  + OOtoO3 * saconc(icell,jcell,kcel,iOO) / sumOO
               enddo
c
c  --- allocate any remaining O3 increase to O3V of this plume
c
               itrc = iemcls(idxipt(ITRO3V)) - 1 + 
     &                       ipufmap(idxpig) + ipufgrp(idxpig) * nregin

               saconc(icell,jcell,kcel,itrc) = saconc(icell,jcell,kcel,itrc)
     &                                + delcls(idxipt(ITRO3V)) - OOtoO3
            else
c
c  --- allocate O3 decrease based on relative contribution of O3X
c
               do i = iptcls(idxipt(ITRO3N)), nptcls(idxipt(ITRO3V))
                  saconc(icell,jcell,kcel,i) = saconc(icell,jcell,kcel,i)
     &                             + delcls(idxipt(ITRO3V))
     &                             * saconc(icell,jcell,kcel,i) / sumO3
                  saconc(icell,jcell,kcel,i) =
     &                          MAX(BNDLPT, saconc(icell,jcell,kcel,i))
               enddo
            endif
c
c  --- allocate OO increase based on relative contribution of O3X
c           and OO decrease based on relative contribution of OOX
c
            iO3 = iptcls(idxipt(ITRO3N)) - 1
            do i = iptcls(idxipt(ITROON)), nptcls(idxipt(ITROOV))
               iO3 = iO3 + 1
               saconc(icell,jcell,kcel,i) = saconc(icell,jcell,kcel,i)
     &                  + prodOO * saconc(icell,jcell,kcel,iO3) / sumO3
     &                    - destOO * saconc(icell,jcell,kcel,i) / sumOO
               saconc(icell,jcell,kcel,i) =
     &                          MAX(BNDLPT, saconc(icell,jcell,kcel,i))
            enddo
c
c  --- reset the conc change for the tracers already processed so that they will be skipped below
c
            delcls(idxipt(ITRO3N)) = 0.
            delcls(idxipt(ITRO3V)) = 0.
            delcls(idxipt(ITROON)) = 0.
            delcls(idxipt(ITROOV)) = 0.
         endif
c
c  --- loop over all tracer classes
c
         do icls = 1, ntrcls
c
c  --- skip if no change or already processed
c
            if ( ABS(delcls(icls)) .LT. BNDLPT ) CYCLE
c
c  --- for all other tracers
c
            if ( delcls(icls) .GT. 0. ) then
c
c  --- if positive change, allocate it to this plume
c
               itrc = iemcls(icls) - 1 + 
     &                       ipufmap(idxpig) + ipufgrp(idxpig) * nregin

               saconc(icell,jcell,kcel,itrc) = saconc(icell,jcell,kcel,itrc)
     &                                       + delcls(icls)
            else
c
c  --- if negative change, reduce the tracer based on its relative contribution
c
               sumcls = 0.
               do i = iptcls(icls), nptcls(icls)
                  sumcls = sumcls + saconc(icell,jcell,kcel,i)
               enddo
               sumcls = MAX(BNDLPT, sumcls)

               do i = iptcls(icls), nptcls(icls)
                  saconc(icell,jcell,kcel,i) = saconc(icell,jcell,kcel,i)
     &                            + delcls(icls)
     &                            * saconc(icell,jcell,kcel,i) / sumcls
                  saconc(icell,jcell,kcel,i) =
     &                          MAX(BNDLPT, saconc(icell,jcell,kcel,i))
               enddo
            endif
c
c  --- next tracer class ---
c
         enddo
c
c  --- next affected layer ---
c
      enddo
c
c-----------------------------------------------------------------------
c    Return point:
c-----------------------------------------------------------------------
c
      return
      end
