c*** PSATSA

      subroutine psatsa(numcol,numrow,numlay,igrid,icell,jcell,kcell,
     &                  nspc,delcon,nprec_soap,yfac,dcprec,CG_part,
     &                  fcsoa,convfac,lrepart)
      use grid
      use chmstry
      use tracer
      implicit none
c
c----CAMx v7.40 260801
c
c-----------------------------------------------------------------------
c   Description:
c     This routine makes the "chemistry" adjustments to the tracer 
c     species for PSAT.  The adjustments are based on the differences in 
c     concentrations of the regular model species before and after
c     the regular model chemistry.  This is essentially an adjustment
c     for production or decay.
c
c      Copyright Ramboll
c
c   Argument descriptions:
c     Inputs:
c       numcol     I number of columns in this slice
c       numrow     I number of rows in this slice
c       numlay     I number of layers in this slice
c       igrid      I  grid number
c       icell      I  the X grid location of current cell
c       jcell      I  the X grid location of current cell
c       kcell      I  the vertical grid location of current layer
c       nspc       I  number of model species
c       delcon     R  array of change in concentrations total
c       nprec_soap I  number of SOA precursors
c       yfac       R  array of 3 weighted yields, yh, yn for each precursor
c       dcprec     R  array of SOA precursor changes (-ve) [ppm]
c       CG_part    R  array of CG partition ratios [dimensionless]
c       fcsoa      R  SOA chem factors: fphot, fpoly, fra, cgly, csoac
c       convfac    R  conversion factor: umol/m3 = ppm * convfac
c       lrepart    L  repartition gas/aerosol SOA when true
c
c-----------------------------------------------------------------------
c   LOG:
c-----------------------------------------------------------------------
c
c     09/28/03   --gwilson--  Original development
c     12/29/06   --bkoo--     Revised for the updated SOA scheme
c     05/04/07   --gwilson--  Changed call to cyctpnsa so that conversion
c                             factor is set for lower bound values -
c                             the conversion is passed here from chemdriv
c     03/18/14   --bkoo--     Revised for benzene SOA
c     08/25/16   --bkoo--     Updated for new SOAP
c     10/16/17   --bkoo--     Fixed DELARO that was missing IVOA changes
c                             Updated for SOA photolysis
c     01/12/18   --bkoo--     Removed BNZA/TOLA/XYLA/ISP/TRP
c     01/09/19   --cemery--   Added DMS
c     06/18/19   --bkoo--     Updated delARO/delTRP/delSQT for SAPRC07T
c     06/18/25   --gy--       Re-engineer SOA using dcprec & CG_part
c
c-----------------------------------------------------------------------
c   Include files:
c-----------------------------------------------------------------------
c
      include 'camx.prm'
      include 'soap.inc'
      include 'soap3.inc'
c
c-----------------------------------------------------------------------
c    Argument declarations:
c-----------------------------------------------------------------------
c
      integer   numcol
      integer   numrow
      integer   numlay
      integer   igrid
      integer   icell
      integer   jcell
      integer   kcell
      integer   nspc
      real      delcon(4,nspc+1)
      integer   nprec_soap
      real      yfac(5,nprec_soap)
      real      dcprec(nprec_soap)
      real      CG_part(NCG)
      real      fcsoa(6)
      real      convfac
      logical   lrepart
c
c-----------------------------------------------------------------------
c    Local variables:
c-----------------------------------------------------------------------
c
      integer   iaro, iiva, isva, iag2, iag1 
      integer   ipa2, ipa1, ipa0, ihoa
      integer   iisp, itrp, iapn, isqt, ibg1, ibg2, ifc1
      integer   ipb2, ipb1, ipb0
      integer   iso2, idms, ihg0, i
      integer*8 idxcel, idx, jdx, kdx, ldx, mdx, ndx
      integer*8 idx0, idx2, n0dx, n1dx, n2dx, ng1dx, ng2dx
      real      delARO, delISP, delTRP, delSQT, delso2, delps4, deldms, delhg2
      real      delIVA, delSVA, delHOA, delAPN, delFC1
      real      delBNZA, delTOLA, delXYLA, delIVOA, delIVC1, delIVC2, delHPAR
      real      sumARO, sumISP, sumTRP, sumSQT, sumso2, sumps4, sumdms
      real      sumhg0, sumhg2, sumIVA, sumSVA, sumHOA, sumAPN, sumFC1
      real      sumBG2, sumBG1, sumPA2, sumPA1, sumPB2, sumPB1
      real      sumPA0, sumPB0, wtdARO, wtdIVA, wtdTRP, sumpair
      real      fphot, fpolya, fpolyb, apoly1, apoly2, fra, frb, cgly, csoac
      real      dcpum(NPREC_S)
c
      real, parameter :: SMALL = 1.e-15
c
c-----------------------------------------------------------------------
c    Entry point:
c-----------------------------------------------------------------------
c
c   --- calculate the index of the cell in the grid ---
c
      idxcel =  DBLE(ipsa3d(igrid)-1) + DBLE(icell) + 
     &            DBLE(numcol) * DBLE(jcell-1) + 
     &                 DBLE(numcol) * DBLE(numrow) * DBLE(kcell-1)
c
c----------------------------------------------------------------------
c  ---  SOA tracers ----
c----------------------------------------------------------------------
c
      if( lsoa ) then
         dcpum = dcprec * convfac  ! array of precursor changes (-ve) in umol/m3
         fphot  = fcsoa(1)
         fpolya = fcsoa(2)
         fpolyb = fcsoa(3)
         fra    = fcsoa(4)
         frb    = MAX(0., 1.0 - fra)
         cgly   = fcsoa(5)
         csoac  = fcsoa(6)
         apoly1 = 0.
         apoly2 = 0.
c
c --- compute concentration changes for any mechanism ---
c     safe because inactive species have kSPC=nspc+1 and delcon(*,nspc+1)=0.0
c
         delBNZA = delcon(1,kbenz)                                      !CB & SAPRC
     &           + delcon(1,kben )                                      !RACM2
         delTOLA = delcon(1,ktol )                                      !CB & RACM2
     &           + delcon(1,ktolu) + delcon(1,karo1)                    !SAPRC
         delXYLA = delcon(1,kxyl )                                      !CB
     &           + delcon(1,kmxyl) + delcon(1,koxyl) + delcon(1,kpxyl)  !SAPRC
     &           + delcon(1,kb124) + delcon(1,karo2)                    !SAPRC
     &           + delcon(1,kxym ) + delcon(1,kxyo ) + delcon(1,kxyp )  !RACM2
         delARO  = delBNZA + delTOLA + delXYLA

         delIVOA = delcon(1,kivoa)                                      !SOAP3
         delIVC1 = delcon(1,kivc1)                                      !SOAP3
         delIVC2 = delcon(1,kivc2)                                      !SOAP3
         delHPAR = delcon(1,khpar)                                      !CB7r2
         delIVA  = delIVOA + delIVC1 + delIVC2 + delHPAR 

         delSVA = delcon(1,ksvoa)                                       !SOAP3
         delHOA = delcon(3,khoa )                                       !SOAP3

         delISP = delcon(1,kisop)                                       !CB & SAPRC
     &          + delcon(1,kiso )                                       !RACM2

         delTRP = delcon(1,kterp)                                       !CB & SAPRC
     &          + delcon(1,klim)                                        !RACM2

         delAPN = delcon(1,kapin)                                       !CB7 & SAPRC
     &          + delcon(1,kapi)                                        !RACM2
c
         delFC1 = delcon(1,kfvc1)                                       !CB7
c
         delSQT = delcon(1,ksqt )                                       !CB & RACM2(in SOACHEM)
     &          + delcon(1,ksesq)                                       !SAPRC
c
c  --- sum the Anthropogenic tracer species ---
c
         sumARO = SMALL
         wtdARO = SMALL
         do i=iptcls(idxipt(ITRARO)),nptcls(idxipt(ITRARO))
            idx = idxcel + DBLE(numcol) * DBLE(numrow) * 
     &                                DBLE(numlay) * DBLE(i-1)
            sumARO = sumARO + ptconc(idx)
            wtdARO = wtdARO + ptconc(idx)*wtkoh(i)
         enddo

         sumIVA = SMALL
         wtdIVA = SMALL
         do i=iptcls(idxipt(ITRIVA)),nptcls(idxipt(ITRIVA))
            idx = idxcel + DBLE(numcol) * DBLE(numrow) * 
     &                              DBLE(numlay) * DBLE(i-1)
            sumIVA = sumIVA + ptconc(idx)
            wtdIVA = wtdIVA + ptconc(idx)*wtkoh(i)
         enddo

         sumSVA = SMALL
c        wtdSVA not needed because SVA isn't a combined tracer
         do i=iptcls(idxipt(ITRSVA)),nptcls(idxipt(ITRSVA))
            idx = idxcel + DBLE(numcol) * DBLE(numrow) * 
     &                              DBLE(numlay) * DBLE(i-1)
            sumSVA = sumSVA + ptconc(idx)
         enddo

         sumHOA = SMALL
         do i=iptcls(idxipt(ITRHOA)),nptcls(idxipt(ITRHOA))
            idx = idxcel + DBLE(numcol) * DBLE(numrow) *
     &                              DBLE(numlay) * DBLE(i-1)
            sumHOA = sumHOA + ptconc(idx)
         enddo

c
c  --- Adjust the Anthropogenic tracer species ---
c      dcpum values are negative because precursors are destroyed
c      SPECIAL CASE: adjust PA0 directly (skip CG)
c
         iaro  = iptcls(idxipt(ITRARO)) - 1
         iiva  = iptcls(idxipt(ITRIVA)) - 1
         isva  = iptcls(idxipt(ITRSVA)) - 1
         iag2  = iptcls(idxipt(ITRAG2)) - 1
         iag1  = iptcls(idxipt(ITRAG1)) - 1
         ipa2  = iptcls(idxipt(ITRPA2)) - 1
         ipa1  = iptcls(idxipt(ITRPA1)) - 1
         ipa0  = iptcls(idxipt(ITRPA0)) - 1
         ihoa  = iptcls(idxipt(ITRHOA)) - 1

         do i=iptcls(idxipt(ITRPA0)),nptcls(idxipt(ITRPA0))

            iaro = iaro + 1
            jdx  = idxcel + DBLE(numcol) * DBLE(numrow) *
     &                               DBLE(numlay) * DBLE(iaro-1)
            iiva = iiva + 1
            kdx  = idxcel + DBLE(numcol) * DBLE(numrow) *
     &                               DBLE(numlay) * DBLE(iiva-1)
            isva = isva + 1
            ldx  = idxcel + DBLE(numcol) * DBLE(numrow) *
     &                               DBLE(numlay) * DBLE(isva-1)
            iag2 = iag2 + 1
            ng2dx = idxcel + DBLE(numcol) * DBLE(numrow) *
     &                               DBLE(numlay) * DBLE(iag2-1)
            iag1 = iag1 + 1
            ng1dx = idxcel + DBLE(numcol) * DBLE(numrow) *
     &                               DBLE(numlay) * DBLE(iag1-1)
            ipa2 = ipa2 + 1
            n2dx = idxcel + DBLE(numcol) * DBLE(numrow) *
     &                               DBLE(numlay) * DBLE(ipa2-1)
            ipa1 = ipa1 + 1
            n1dx = idxcel + DBLE(numcol) * DBLE(numrow) *
     &                               DBLE(numlay) * DBLE(ipa1-1)
            ipa0 = ipa0 + 1
            n0dx = idxcel + DBLE(numcol) * DBLE(numrow) *
     &                               DBLE(numlay) * DBLE(ipa0-1)
            ihoa = ihoa + 1
            mdx  = idxcel + DBLE(numcol) * DBLE(numrow) *
     &                               DBLE(numlay) * DBLE(ihoa-1)

c --- PA2 & AG2
            ptconc(ng2dx) = ptconc(ng2dx) -
     &                    ( dcpum(ISOAP_BNZA) * yfac(1,ISOAP_BNZA)  
     &                    + dcpum(ISOAP_TOLA) * yfac(1,ISOAP_TOLA)  
     &                    + dcpum(ISOAP_XYLA) * yfac(1,ISOAP_XYLA) )
     &                                          * ptconc(jdx) / sumARO
            ptconc(ng2dx) = ptconc(ng2dx) -
     &                    ( dcpum(ISOAP_IVOA) * yfac(1,ISOAP_IVOA)  
     &                    + dcpum(ISOAP_IVC1) * yfac(1,ISOAP_IVC1)  
     &                    + dcpum(ISOAP_IVC2) * yfac(1,ISOAP_IVC2)  
     &                    + dcpum(ISOAP_HPAR) * yfac(1,ISOAP_HPAR) )
     &                                          * ptconc(kdx) / sumIVA
            ptconc(ng2dx) = ptconc(ng2dx) 
     &                    - dcpum(ISOAP_SVOA) * yfac(1,ISOAP_SVOA) *
     &                                            ptconc(ldx) / sumSVA
            if( lrepart ) then
               sumpair = ptconc(ng2dx)*mwsoap(1) + ptconc(n2dx)
     &                                                         + SMALL
               ptconc(ng2dx) = (CG_part(1) * sumpair ) / mwsoap(1)
               ptconc(n2dx)  = (1.0-CG_part(1)) * sumpair

               ptconc(n2dx)  = ptconc(n2dx) * (1.0-fphot)
               apoly2        = ptconc(n2dx) * fpolya
               ptconc(n2dx)  = ptconc(n2dx) - apoly2
            endif

            ptconc(ng2dx) = MAX(BNDLPT,ptconc(ng2dx))
            ptconc(n2dx)  = MAX(BNDLPT,ptconc(n2dx))

c --- PA1 & AG1
            ptconc(ng1dx) = ptconc(ng1dx) -
     &                    ( dcpum(ISOAP_BNZA) * yfac(2,ISOAP_BNZA)  
     &                    + dcpum(ISOAP_TOLA) * yfac(2,ISOAP_TOLA)  
     &                    + dcpum(ISOAP_XYLA) * yfac(2,ISOAP_XYLA) )
     &                                          * ptconc(jdx) / sumARO
            ptconc(ng1dx) = ptconc(ng1dx) -
     &                    ( dcpum(ISOAP_IVOA) * yfac(2,ISOAP_IVOA)  
     &                    + dcpum(ISOAP_IVC1) * yfac(2,ISOAP_IVC1)  
     &                    + dcpum(ISOAP_IVC2) * yfac(2,ISOAP_IVC2)  
     &                    + dcpum(ISOAP_HPAR) * yfac(2,ISOAP_HPAR) )
     &                                          * ptconc(kdx) / sumIVA
            ptconc(ng1dx) = ptconc(ng1dx)
     &                    - dcpum(ISOAP_SVOA) * yfac(2,ISOAP_SVOA) *
     &                                            ptconc(ldx) / sumSVA

            if( lrepart ) then
               sumpair = ptconc(ng1dx)*mwsoap(1) + ptconc(n1dx)
               ptconc(ng1dx) = (CG_part(2) * sumpair ) / mwsoap(2)
     &                                                         + SMALL
               ptconc(n1dx)  = (1.0-CG_part(2)) * sumpair

               ptconc(n1dx)  = ptconc(n1dx) * (1.0-fphot)
               apoly1        = ptconc(n1dx) * fpolya
               ptconc(n1dx)  = ptconc(n1dx) - apoly1
            endif

            ptconc(ng1dx) = MAX(BNDLPT,ptconc(ng1dx))
            ptconc(n1dx)  = MAX(BNDLPT,ptconc(n1dx))


c --- PA0 (SPECIAL CASE: convert dcpum to ug/m3)
            ptconc(n0dx) = ptconc(n0dx) - mwaoa0 * 
     &                   ( dcpum(ISOAP_BNZA) * yfac(3,ISOAP_BNZA)  
     &                   + dcpum(ISOAP_TOLA) * yfac(3,ISOAP_TOLA)  
     &                   + dcpum(ISOAP_XYLA) * yfac(3,ISOAP_XYLA) )
     &                                          * ptconc(jdx) / sumARO
            ptconc(n0dx) = ptconc(n0dx) - mwaoa0 *
     &                   ( dcpum(ISOAP_IVOA) * yfac(3,ISOAP_IVOA)  
     &                   + dcpum(ISOAP_IVC1) * yfac(3,ISOAP_IVC1)  
     &                   + dcpum(ISOAP_IVC2) * yfac(3,ISOAP_IVC2)  
     &                   + dcpum(ISOAP_HPAR) * yfac(3,ISOAP_HPAR) )
     &                                          * ptconc(kdx) / sumIVA
            ptconc(n0dx) = ptconc(n0dx) - mwaoa0 *
     &                   ( dcpum(ISOAP_SVOA) * yfac(3,ISOAP_SVOA) )
     &                                          * ptconc(ldx) / sumSVA  

            if( lrepart ) then
               ptconc(n0dx)  = ptconc(n0dx) * (1.0-fphot)
               ptconc(n0dx)  = ptconc(n0dx) + apoly1 + apoly2
            endif

            ptconc(n0dx)  = ptconc(n0dx) 
     &                    + cgly * fra * mwaoa0 * ptconc(jdx) / sumARO

            ptconc(n0dx) = MAX(BNDLPT,ptconc(n0dx))

c --- ARO (SPECIAL CASE: combination tracer)
            ptconc(jdx) = ptconc(jdx) + delARO *
     &                               ptconc(jdx)*wtkoh(iaro) / wtdARO
            ptconc(jdx) = MAX(BNDLPT,ptconc(jdx))

c --- IVA (SPECIAL CASE: combination tracer)
            ptconc(kdx) = ptconc(kdx) + delIVA *
     &                               ptconc(kdx)*wtkoh(iiva) / wtdIVA
            ptconc(kdx) = MAX(BNDLPT,ptconc(kdx))

c --- SVA
            ptconc(ldx) = ptconc(ldx) + delSVA * ptconc(ldx) / sumSVA
            ptconc(ldx) = MAX(BNDLPT,ptconc(ldx))

c --- HOA (expect delHOA=0 but adjustment is safe)
            ptconc(mdx) = ptconc(mdx) + delHOA * ptconc(mdx) / sumHOA
            ptconc(mdx) = MAX(BNDLPT,ptconc(mdx))

         enddo  ! end Anthropogenic

c
c  --- sum the Biogenic tracer species ---
c
         sumISP = SMALL
         do i=iptcls(idxipt(ITRISP)),nptcls(idxipt(ITRISP))
            idx = idxcel + DBLE(numcol) * DBLE(numrow) * 
     &                                DBLE(numlay) * DBLE(i-1)
            sumISP = sumISP + ptconc(idx)
         enddo

         sumTRP = SMALL
         wtdTRP = SMALL
         do i=iptcls(idxipt(ITRTRP)),nptcls(idxipt(ITRTRP))
            idx = idxcel + DBLE(numcol) * DBLE(numrow) * 
     &                              DBLE(numlay) * DBLE(i-1)
            sumTRP = sumTRP + ptconc(idx)
            wtdTRP = wtdTRP + ptconc(idx)*wtkoh(i)
         enddo

         sumAPN = SMALL
         do i=iptcls(idxipt(ITRAPN)),nptcls(idxipt(ITRAPN))
            idx = idxcel + DBLE(numcol) * DBLE(numrow) * 
     &                              DBLE(numlay) * DBLE(i-1)
            sumAPN = sumAPN + ptconc(idx)
         enddo

         sumFC1 = SMALL
         do i=iptcls(idxipt(ITRFC1)),nptcls(idxipt(ITRFC1))
            idx = idxcel + DBLE(numcol) * DBLE(numrow) * 
     &                              DBLE(numlay) * DBLE(i-1)
            sumFC1 = sumFC1 + ptconc(idx)
         enddo

         sumSQT = SMALL
         do i=iptcls(idxipt(ITRSQT)),nptcls(idxipt(ITRSQT))
            idx = idxcel + DBLE(numcol) * DBLE(numrow) * 
     &                              DBLE(numlay) * DBLE(i-1)
            sumSQT = sumSQT + ptconc(idx)
         enddo

c
c  --- Adjust the Biogenic tracer species ---
c      dcpum values are negative because precursors are destroyed
c      SPECIAL CASE: adjust PB0 directly (skip CG)
c

         iisp  = iptcls(idxipt(ITRISP)) - 1
         itrp  = iptcls(idxipt(ITRTRP)) - 1
         iapn  = iptcls(idxipt(ITRAPN)) - 1
         ifc1  = iptcls(idxipt(ITRFC1)) - 1
         isqt  = iptcls(idxipt(ITRSQT)) - 1
         ibg2  = iptcls(idxipt(ITRBG2)) - 1
         ibg1  = iptcls(idxipt(ITRBG1)) - 1
         ipb2  = iptcls(idxipt(ITRPB2)) - 1
         ipb1  = iptcls(idxipt(ITRPB1)) - 1
         ipb0  = iptcls(idxipt(ITRPB0)) - 1

         do i=iptcls(idxipt(ITRPB0)),nptcls(idxipt(ITRPB0))

            iisp = iisp + 1
            jdx  = idxcel + DBLE(numcol) * DBLE(numrow) * 
     &                               DBLE(numlay) * DBLE(iisp-1)
            itrp = itrp + 1
            kdx  = idxcel + DBLE(numcol) * DBLE(numrow) * 
     &                               DBLE(numlay) * DBLE(itrp-1)
            isqt = isqt + 1
            ldx  = idxcel + DBLE(numcol) * DBLE(numrow) * 
     &                               DBLE(numlay) * DBLE(isqt-1)
            iapn = iapn + 1
            mdx  = idxcel + DBLE(numcol) * DBLE(numrow) * 
     &                               DBLE(numlay) * DBLE(iapn-1)
            ifc1 = ifc1 + 1
            ndx  = idxcel + DBLE(numcol) * DBLE(numrow) * 
     &                               DBLE(numlay) * DBLE(ifc1-1)
            ibg2 = ibg2 + 1
            ng2dx = idxcel + DBLE(numcol) * DBLE(numrow) * 
     &                               DBLE(numlay) * DBLE(ibg2-1)
            ibg1 = ibg1 + 1
            ng1dx = idxcel + DBLE(numcol) * DBLE(numrow) * 
     &                               DBLE(numlay) * DBLE(ibg1-1)
            ipb2 = ipb2 + 1
            n2dx = idxcel + DBLE(numcol) * DBLE(numrow) * 
     &                               DBLE(numlay) * DBLE(ipb2-1)
            ipb1 = ipb1 + 1
            n1dx = idxcel + DBLE(numcol) * DBLE(numrow) * 
     &                               DBLE(numlay) * DBLE(ipb1-1)
            ipb0 = ipb0 + 1
            n0dx = idxcel + DBLE(numcol) * DBLE(numrow) * 
     &                               DBLE(numlay) * DBLE(ipb0-1)

c --- PB2 & BG2
            ptconc(ng2dx) = ptconc(ng2dx)  
     &                    - dcpum(ISOAP_ISP) * yfac(1,ISOAP_ISP) *
     &                                            ptconc(jdx) / sumISP
     &                    - dcpum(ISOAP_TRP) * yfac(1,ISOAP_TRP) *
     &                                            ptconc(kdx) / sumTRP
     &                    - dcpum(ISOAP_SQT) * yfac(1,ISOAP_SQT) *
     &                                            ptconc(ldx) / sumSQT
     &                    - dcpum(ISOAP_APN) * yfac(1,ISOAP_APN) *
     &                                            ptconc(mdx) / sumAPN 
     &                    - dcpum(ISOAP_FVC1) * yfac(1,ISOAP_FVC1) *
     &                                            ptconc(ndx) / sumFC1 

            if( lrepart ) then
               sumpair = ptconc(ng2dx)*mwsoap(3) + ptconc(n2dx)
     &                                                         + SMALL
               ptconc(ng2dx) = (CG_part(3) * sumpair ) / mwsoap(3)
               ptconc(n2dx)  = (1.0-CG_part(3)) * sumpair

               ptconc(n2dx)  = ptconc(n2dx) * (1.0-fphot)
               apoly2        = ptconc(n2dx) * fpolyb
               ptconc(n2dx)  = ptconc(n2dx) - apoly2
            endif

            ptconc(ng2dx) = MAX(BNDLPT,ptconc(ng2dx))
            ptconc(n2dx)  = MAX(BNDLPT,ptconc(n2dx))

c --- PB1 & BG1
            ptconc(ng1dx) = ptconc(ng1dx)
     &                    - dcpum(ISOAP_ISP) * yfac(2,ISOAP_ISP) *
     &                                            ptconc(jdx) / sumISP
     &                    - dcpum(ISOAP_TRP) * yfac(2,ISOAP_TRP) *
     &                                            ptconc(kdx) / sumTRP
     &                    - dcpum(ISOAP_SQT) * yfac(2,ISOAP_SQT) *
     &                                            ptconc(ldx) / sumSQT
     &                    - dcpum(ISOAP_APN) * yfac(2,ISOAP_APN) *
     &                                            ptconc(mdx) / sumAPN 
     &                    - dcpum(ISOAP_FVC1) * yfac(2,ISOAP_FVC1) *
     &                                            ptconc(ndx) / sumFC1 

            if( lrepart ) then
               sumpair = ptconc(ng1dx)*mwsoap(4) + ptconc(n1dx)
     &                                                         + SMALL
               ptconc(ng1dx) = (CG_part(4) * sumpair ) / mwsoap(4)
               ptconc(n1dx)  = (1.0-CG_part(4)) * sumpair

               ptconc(n1dx)  = ptconc(n1dx) * (1.0-fphot)
               apoly1        = ptconc(n1dx) * fpolyb
               ptconc(n1dx)  = ptconc(n1dx) - apoly1
            endif

            ptconc(ng1dx) = MAX(BNDLPT,ptconc(ng1dx))
            ptconc(n1dx)  = MAX(BNDLPT,ptconc(n1dx))

c --- PB0 (SPECIAL CASE: convert dcpum to ug/m3)
            ptconc(n0dx) = ptconc(n0dx) + mwboa0 * (
     &                   - dcpum(ISOAP_ISP) * yfac(3,ISOAP_ISP) *
     &                                            ptconc(jdx) / sumISP
     &                   - dcpum(ISOAP_TRP) * yfac(3,ISOAP_TRP) *
     &                                            ptconc(kdx) / sumTRP
     &                   - dcpum(ISOAP_SQT) * yfac(3,ISOAP_SQT) *
     &                                            ptconc(ldx) / sumSQT
     &                   - dcpum(ISOAP_APN) * yfac(3,ISOAP_APN) *
     &                                            ptconc(mdx) / sumAPN
     &                   - dcpum(ISOAP_FVC1) * yfac(3,ISOAP_FVC1) *
     &                                            ptconc(ndx) / sumFC1 )

            if( lrepart ) then
               ptconc(n0dx)  = ptconc(n0dx) * (1.0-fphot)
               ptconc(n0dx)  = ptconc(n0dx) + apoly1 + apoly2
            endif

            ptconc(n0dx)  = ptconc(n0dx)
     &                    + cgly * frb * mwboa0 * ptconc(jdx) / sumISP
     &                    +               csoac * ptconc(jdx) / sumISP

            ptconc(n0dx) = MAX(BNDLPT,ptconc(n0dx))

c --- ISP
            ptconc(jdx) = ptconc(jdx) + delISP * ptconc(jdx) / sumISP
            ptconc(jdx) = MAX(BNDLPT,ptconc(jdx))

c --- TRP (SPECIAL CASE: might be combination tracer)
            ptconc(kdx) = ptconc(kdx) + delTRP *
     &                               ptconc(kdx)*wtkoh(itrp) / wtdTRP
            ptconc(kdx) = MAX(BNDLPT,ptconc(kdx))

c --- SQT
            ptconc(ldx) = ptconc(ldx) + delSQT * ptconc(ldx) / sumSQT
            ptconc(ldx) = MAX(BNDLPT,ptconc(ldx))

c --- APN
            ptconc(mdx) = ptconc(mdx) + delAPN * ptconc(mdx) / sumAPN
            ptconc(mdx) = MAX(BNDLPT,ptconc(mdx))

c --- FC1
            ptconc(ndx) = ptconc(ndx) + delFC1 * ptconc(ndx) / sumFC1
            ptconc(ndx) = MAX(BNDLPT,ptconc(ndx))

         enddo  ! end Biogenic

      endif
c
c----------------------------------------------------------------------
c  ---  Sulfate tracers ---
c----------------------------------------------------------------------
c
      if( lsulfate ) then
         delso2 = delcon(3,kso2)
         delps4 = delcon(3,kpso4)
c
c  --- sum the tracer species for SO2 ---
c
         sumso2 = SMALL
         do i=iptcls(idxipt(ITRSO2)),nptcls(idxipt(ITRSO2))
            idx = idxcel + DBLE(numcol) * DBLE(numrow) * 
     &                                   DBLE(numlay) * DBLE(i-1)
            sumso2 = sumso2 + ptconc(idx)
         enddo
c
c  --- sum the tracer species for DMS ---
c
         if( ldmschm ) then
            idms = iptcls(idxipt(ITRDMS)) - 1
            deldms = delcon(1,kdms)
            sumdms = SMALL
            do i=iptcls(idxipt(ITRDMS)),nptcls(idxipt(ITRDMS))
               idx = idxcel + numcol * numrow * numlay * (i-1)
               sumdms = sumdms + ptconc(idx)
            enddo
         endif
c
c  --- if PSO4 change is positive, adjust PS4 
c      tracers based on distribtion of SO2 ---
c
         if( delps4 .GT. 0. ) then
            iso2 = iptcls(idxipt(ITRSO2)) - 1
            do i=iptcls(idxipt(ITRPS4)),nptcls(idxipt(ITRPS4))
               idx = idxcel + DBLE(numcol) * DBLE(numrow) * 
     &                                  DBLE(numlay) * DBLE(i-1)
               iso2 = iso2 + 1
               jdx = idxcel + DBLE(numcol) * DBLE(numrow) * 
     &                               DBLE(numlay) * DBLE(iso2-1)
               ptconc(idx) = ptconc(idx) + delps4 * ptconc(jdx) / sumso2
               ptconc(idx) = MAX(BNDLPT,ptconc(idx))
            enddo
c
c  --- if PSO4 change is negative, adjust PS4 
c      tracers based on distribtion of PS4 ---
c
         else
c
c  --- sum the tracer species for PS4 ---
c
            sumps4 = SMALL
            do i=iptcls(idxipt(ITRPS4)),nptcls(idxipt(ITRPS4))
               idx = idxcel + DBLE(numcol) * DBLE(numrow) * 
     &                                   DBLE(numlay) * DBLE(i-1)
               sumps4 = sumps4 + ptconc(idx)
            enddo
            do i=iptcls(idxipt(ITRPS4)),nptcls(idxipt(ITRPS4))
               idx = idxcel + DBLE(numcol) * DBLE(numrow) * 
     &                                    DBLE(numlay) * DBLE(i-1)
               ptconc(idx) = ptconc(idx) + delps4 * ptconc(idx) / sumps4
               ptconc(idx) = MAX(BNDLPT,ptconc(idx))
            enddo
         endif
c
c  --- adjust SO2 tracers based on change in SO2 (and DMS) ---
c
         do i=iptcls(idxipt(ITRSO2)),nptcls(idxipt(ITRSO2))
            idx = idxcel + DBLE(numcol) * DBLE(numrow) * 
     &                                  DBLE(numlay) * DBLE(i-1)
            ptconc(idx) = ptconc(idx) + delso2 * ptconc(idx) / sumso2
            if( ldmschm ) then
               idms = idms + 1
               jdx = idxcel + numcol * numrow * numlay * (idms-1)
               ptconc(idx) = ptconc(idx) - deldms * ptconc(jdx) / sumdms
            endif
            ptconc(idx) = MAX(BNDLPT,ptconc(idx))
         enddo
c
c  --- adjust DMS tracers based on change in DMS ---
c
         if( ldmschm ) then
           do i=iptcls(idxipt(ITRDMS)),nptcls(idxipt(ITRDMS))
              idx = idxcel + numcol * numrow * numlay * (i-1)
              ptconc(idx) = ptconc(idx) + deldms * ptconc(idx) / sumdms
              ptconc(idx) = MAX(BNDLPT,ptconc(idx))
           enddo
         endif
      endif
c
c----------------------------------------------------------------------
c  ---  Mercury tracers ----
c----------------------------------------------------------------------
c
      if( lmercury ) then
         delhg2 = delcon(3,khg2)

c  --- sum the HG tracer species ---
c
         sumhg0 = SMALL
         do i=iptcls(idxipt(ITRHG0)),nptcls(idxipt(ITRHG0))
            idx0 = idxcel + DBLE(numcol) * DBLE(numrow) * 
     &                                   DBLE(numlay) * DBLE(i-1)
            sumhg0 = sumhg0 + ptconc(idx0)
         enddo
         sumhg2 = SMALL
         do i=iptcls(idxipt(ITRHG2)),nptcls(idxipt(ITRHG2))
            idx2 = idxcel + DBLE(numcol) * DBLE(numrow) * 
     &                                   DBLE(numlay) * DBLE(i-1)
            sumhg2 = sumhg2 + ptconc(idx2)
         enddo
c
c  --- HG0 being oxidized to HG2 ----
c
         if( delhg2 .GT. 0 ) then
            ihg0 = iptcls(idxipt(ITRHG0)) - 1
            do i=iptcls(idxipt(ITRHG2)),nptcls(idxipt(ITRHG2))
               idx2 = idxcel + DBLE(numcol) * DBLE(numrow) * 
     &                                   DBLE(numlay) * DBLE(i-1)
               ihg0 = ihg0 + 1
               idx0 = idxcel + DBLE(numcol) * DBLE(numrow) * 
     &                                DBLE(numlay) * DBLE(ihg0-1)
               ptconc(idx2) = ptconc(idx2) + 
     &                                   delhg2 * ptconc(idx0) / sumhg0
               ptconc(idx2) = MAX(BNDLPT,ptconc(idx2))
               ptconc(idx0) = ptconc(idx0) - 
     &                                   delhg2 * ptconc(idx2) / sumhg2
               ptconc(idx0) = MAX(BNDLPT,ptconc(idx0))
            enddo
c
c  --- HG2 beign reduced to HG0 ----
c
         else
            ihg0 = iptcls(idxipt(ITRHG0)) - 1
            do i=iptcls(idxipt(ITRHG2)),nptcls(idxipt(ITRHG2))
               idx2 = idxcel + DBLE(numcol) * DBLE(numrow) * 
     &                                      DBLE(numlay) * DBLE(i-1)
               ihg0 = ihg0 + 1
               idx0 = idxcel + DBLE(numcol) * DBLE(numrow) * 
     &                                   DBLE(numlay) * DBLE(ihg0-1)
               ptconc(idx2) = ptconc(idx2) + 
     &                                  delhg2 * ptconc(idx2) / sumhg2
               ptconc(idx2) = MAX(BNDLPT,ptconc(idx2))
               ptconc(idx0) = ptconc(idx0) - 
     &                                  delhg2 * ptconc(idx0) / sumhg0
               ptconc(idx0) = MAX(BNDLPT,ptconc(idx0))
            enddo
         endif
      endif
c
c-----------------------------------------------------------------------
c    Return point:
c-----------------------------------------------------------------------
c
      return
      end
