c*** REPARTSA.F
c
      subroutine repartsa(numcol,numrow,numlay,igrid,
     &                                  icell,jcell,kcell,modcon)
      use grid
      use chmstry
      use tracer
c
c----CAMx v7.40 260801
c
c-----------------------------------------------------------------------
c   Description:
c     This routine repartitions the particulate and gaseous portions
c     nitric acid and ammonia tracers based on the ratio found in the
c     regular model.
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       modcon  R  array of model species concentrations
c
c-----------------------------------------------------------------------
c   LOG:
c-----------------------------------------------------------------------
c
c     09/28/03   --gwilson--  Original development
c     05/05/07   --gwilson--  Added code to make an adjustment to
c                             tracer species if there is stray from 
c                             the regular - added to handle mass errors
c                             in regular model chemistry routines
c
c-----------------------------------------------------------------------
c   Include files:
c-----------------------------------------------------------------------
c
      include 'camx.prm'
c
c-----------------------------------------------------------------------
c    Argument declarations:
c-----------------------------------------------------------------------
c
      integer numcol
      integer numrow
      integer numlay
      integer igrid
      integer icell
      integer jcell
      integer kcell
      real    modcon(*)
c
c-----------------------------------------------------------------------
c    Local parameters:
c-----------------------------------------------------------------------
c
c    FUZZ  - fuzz value for comparing against lower bound
c    SMALL - small real value
c
      real FUZZ, SMALL
c
      parameter( FUZZ  = 10.0 )
      parameter( SMALL = 1.e-16 )
c
c-----------------------------------------------------------------------
c    Local variables:
c-----------------------------------------------------------------------
c
      integer*8 idxcel, idxhno3, idxpno3, idxnh3, idxpnh4
      integer*8 idxpo1, idxpo2, idxpo3, idxpo4
      integer   i, ipno3, ipnh4, ipo1, ipo2, ipo3, ipo4
      real      wthno3, wtnh3, conhno3, conpno3, connh3, conpnh4
      real      ratio, sumtrac, contrac, conadjust
c
c-----------------------------------------------------------------------
c
      data wtnh3  /18.0/
      data wthno3 /62.0/
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 * numrow *(kcell-1))
c
      if( lnitrate ) then
c
c  --- calculate the ratio of gas to  particluate nitric acid ---
c
         conhno3 = modcon(khno3) * wthno3
         conpno3 = modcon(kpno3)
         ratio = 0.
         if( conhno3+conpno3 .GT. SMALL )
     &                    ratio = conhno3 / (conpno3 + conhno3)
c
c  --- get the sum of all tracer species ---
c
         contrac = SMALL
         ipno3 = iptcls(idxipt(ITRPN3)) - 1
         do i=iptcls(idxipt(ITRHN3)),nptcls(idxipt(ITRHN3))
            idxhno3 = idxcel + DBLE(numcol) * DBLE(numrow) * 
     &                                  DBLE(numlay) * DBLE(i-1)
            ipno3 = ipno3 + 1
            idxpno3 = idxcel + DBLE(numcol) * DBLE(numrow) * 
     &                              DBLE(numlay) * DBLE(ipno3-1)
            sumtrac = ptconc(idxhno3)*wthno3 + ptconc(idxpno3)
            if( sumtrac .GT. FUZZ*BNDLPT ) contrac = contrac + sumtrac
         enddo
         if( contrac .GT. SMALL ) then
             conadjust = (conhno3+conpno3) / contrac
         else
             conadjust = 1.0
         endif
c
c  --- adjust the nitric acid tracers ----
c
         ipno3 = iptcls(idxipt(ITRPN3)) - 1
         do i=iptcls(idxipt(ITRHN3)),nptcls(idxipt(ITRHN3))
            idxhno3 = idxcel + DBLE(numcol) * DBLE(numrow) * 
     &                                  DBLE(numlay) * DBLE(i-1)
            ipno3 = ipno3 + 1
            idxpno3 = idxcel + DBLE(numcol) * DBLE(numrow) * 
     &                              DBLE(numlay) * DBLE(ipno3-1)
c
c  --- adjust for mass imbalance, if needed ---
c
            sumtrac = ptconc(idxhno3)*wthno3 + ptconc(idxpno3)
            if( sumtrac .GT. FUZZ*BNDLPT ) sumtrac = conadjust * sumtrac
c
c  --- redistribute the gas and particulates ---
c
            ptconc(idxhno3) = (ratio * sumtrac ) / wthno3
            ptconc(idxhno3) = MAX(ptconc(idxhno3),BNDLPT)
            ptconc(idxpno3) = sumtrac - ptconc(idxhno3) * wthno3
            ptconc(idxpno3) = MAX(ptconc(idxpno3),BNDLPT)
         enddo
c
c  --- calculate the ratio of gas to particluate ammonia ---
c
         connh3 = modcon(knh3) * wtnh3
         conpnh4 = modcon(kpnh4)
         ratio = 0.
         if( connh3+conpnh4 .GT. SMALL )
     &                    ratio = connh3 / (conpnh4 + connh3)
c
c  --- get the sum of all tracer species ---
c
         contrac = SMALL
         ipnh4 = iptcls(idxipt(ITRPN4)) - 1
         do i=iptcls(idxipt(ITRNH3)),nptcls(idxipt(ITRNH3))
            idxnh3 = idxcel + DBLE(numcol) * DBLE(numrow) * 
     &                                 DBLE(numlay) * DBLE(i-1)
            ipnh4 = ipnh4 + 1
            idxpnh4 = idxcel + DBLE(numcol) * DBLE(numrow) * 
     &                             DBLE(numlay) * DBLE(ipnh4-1)
            sumtrac = ptconc(idxnh3)*wtnh3 + ptconc(idxpnh4)
            if( sumtrac .GT. FUZZ*BNDLPT ) contrac = contrac + sumtrac
         enddo
         if( contrac .GT. SMALL ) then
             conadjust = (connh3+conpnh4) / contrac
         else
             conadjust = 1.0
         endif
c
c  --- adjust the ammonia tracers ----
c
         ipnh4 = iptcls(idxipt(ITRPN4)) - 1
         do i=iptcls(idxipt(ITRNH3)),nptcls(idxipt(ITRNH3))
            idxnh3 = idxcel + DBLE(numcol) * DBLE(numrow) * 
     &                                     DBLE(numlay) * DBLE(i-1)
            ipnh4 = ipnh4 + 1
            idxpnh4 = idxcel + DBLE(numcol) * DBLE(numrow) * 
     &                                 DBLE(numlay) * DBLE(ipnh4-1)	
c        
c  --- adjust for mass imbalance, if needed ---
c  
            sumtrac = ptconc(idxnh3)*wtnh3 + ptconc(idxpnh4)
            if( sumtrac .GT. FUZZ*BNDLPT ) sumtrac = conadjust * sumtrac
c
c  --- redistribute the gas and particulates ---
c
            ptconc(idxnh3) = ratio * sumtrac / wtnh3
            ptconc(idxnh3) = MAX(ptconc(idxnh3),BNDLPT)
            ptconc(idxpnh4) = sumtrac - ptconc(idxnh3) * wtnh3
            ptconc(idxpnh4) = MAX(ptconc(idxpnh4),BNDLPT)
         enddo
      endif
c
c-----------------------------------------------------------------------
c    Return point:
c-----------------------------------------------------------------------
c
      return
      end
