c**** STABSA
c
      subroutine stabsa(idate,begtim,jdate,endtim)
      use filunit
      use chmstry
      use tracer
      use rtracchm
      use grid
c
c----CAMx v7Beta6 190902
c
c-----------------------------------------------------------------------
c    Description:
c-----------------------------------------------------------------------
c
c   This routine sets the flags that determine if each species in the
c   species list should be added to the VOC or NOx tracers.  The carbon
c   number for the VOC species is also put into the appropriate place
c   in the array.
c      Inputs:
c        idate  I   date of the beginning of the simulation (YYJJJ)
c        begtim R   hour of the begining of simulation
c        jdate  I   date of the ending of the simulation (YYJJJ)
c        endtim R   hour of the endng of simulation
c
c     Copyright 1996 - 2018
c     Ramboll
c
c-----------------------------------------------------------------------
c    LOG:
c-----------------------------------------------------------------------
c
c     05/27/96   --gwilson--    Original development
c     09/20/03   --gwilson--    Completely changed the way tracer classes
c                               are identified to deal with PSAT
c     08/20/06   --bkoo--       Added ETOH, MTBE & MBUT for updated SAPRC99
c                               Fixed rkohsprc & rmirsprc
c     09/01/06   --bkoo--       Updated rkohcbiv for ISOP, MEOH & ETOH
c     12/29/06   --bkoo--       Revised for the updated SOA scheme
c     01/08/07   --bkoo--       Added Mechanism 6 (CB05)
c     07/16/07   --bkoo--       Added HRVOC
c     10/25/07   --gyarwood-    Make MIR and kOH values per carbon
c     10/25/09   --gwilson--    Fixed coded related to timing tracers
c     07/30/10   --jjung--      Added Mechanism 7 (CB6)
c     08/23/13   --bkoo--       Set LVOCSP flags of SOA precursors for DDM-PM
c     03/18/14   --bkoo--       Added BNZA
c     06/24/16   --bkoo--       Updated Mechanism 4 (CB6r4)
c     08/25/16   --bkoo--       Updated for new SOAP
c     11/27/17   --bkoo--       Updated for CB6r2h
c     01/12/18   --bkoo--       Removed BNZA/TOLA/XYLA/ISP/TRP
c     01/16/18   --bkoo--       Updated for SAPRC07T
c     06/18/19   --bkoo--       Expanded spcsoap & rkohsoap for SAPRC07T
c
c-----------------------------------------------------------------------
c    Include files:
c-----------------------------------------------------------------------
c
      include 'camx.prm'
c
c-----------------------------------------------------------------------
c    Argument declarations:
c-----------------------------------------------------------------------
c
      integer   idate
      integer   jdate
      real      begtim
      real      endtim
c
c-----------------------------------------------------------------------
c    Local parameters:
c-----------------------------------------------------------------------
c
c   NSACBIV    I    the number of VOC species names to be checked (CBIV)
c   NSASPRC    I    the number of VOC species names to be checked (SAPRC)
c   NSACB05    I    the number of VOC species names to be checked (CB05)
c   NSACB6     I    the number of VOC species names to be checked (CB6)
c   NSASOAP    I    the number of SOA-producing VOC species for PSAT
c   MXSANAM    I    maximum size of the arrays
c   NHRVCBIV   I    the number of HRVOC species names (CBIV)
c   NHRVSPRC   I    the number of HRVOC species names (SAPRC)
c   NHRVCB05   I    the number of HRVOC species names (CB05)
c   NHRVCB6    I    the number of HRVOC species names (CB6)
c   MXHRVNAM   I    maximum size of the HRVOC arrays
c
      integer   NSACBIV, NSASPRC, NSACB05, NSACB6, MXSANAM
      integer   NSASOAP
      integer   NHRVCBIV, NHRVSPRC, NHRVCB05, NHRVCB6, MXHRVNAM
c
      parameter( NSACBIV = 10 )
      parameter( NSASPRC = 30 )
      parameter( NSACB05 = 14 )
      parameter( NSACB6  = 19 )
      parameter( NSASOAP = 11 ) ! Only the precursors used for calculating
                                ! reactivity/yield weighting factors
      parameter( MXSANAM = MAX(NSACBIV, NSASPRC, NSACB05, NSACB6) )
      parameter( NHRVCBIV = 2 )
      parameter( NHRVSPRC = 5 )
      parameter( NHRVCB05 = 3 )
      parameter( NHRVCB6  = 3 )
      parameter( MXHRVNAM = MAX(NHRVCBIV, NHRVSPRC, NHRVCB05, NHRVCB6) )
c
c-----------------------------------------------------------------------
c    Local variables:
c-----------------------------------------------------------------------
c
      character*10 spcnam(MXSANAM), hrvnam(MXHRVNAM)
      character*10 spcsprc(NSASPRC),
     &             spccb05(NSACB05), spccb6(NSACB6)
      character*10 hrvsprc(NHRVSPRC),
     &             hrvcb05(NHRVCB05), hrvcb6(NHRVCB6)
      character*10 spcsoap(NSASOAP)
      character*10 nameyld(MXALCLS,MXSPEC)
      character*10 nonam, no2nam, o3name, namecls(MXALCLS,MXSPEC)
      integer      numcls(MXALCLS), ispc, nnames, i
      integer      idxo3n, idxo3v, idxoon, idxoov
      integer      numyld(MXALCLS), nhrvoc, mvecedge
      real         carbon(MXSANAM), rkoh(MXSANAM), rmir(MXSANAM)
      real         carbsprc(NSASPRC),rkohsprc(NSASPRC),rmirsprc(NSASPRC)
      real         carbcb05(NSACB05),rkohcb05(NSACB05),rmircb05(NSACB05)
      real         carbcb6(NSACB6),  rkohcb6(NSACB6),  rmircb6(NSACB6)
      real         rkohsoap(NSASOAP)
      real         coefcon(MXALCLS,MXSPEC), coeflux(MXALCLS,MXSPEC)
      real         yieldH(MXALCLS,MXSPEC),yieldL(MXALCLS,MXSPEC)
c
c-----------------------------------------------------------------------
c    Data statements:
c-----------------------------------------------------------------------
c
      data spcsprc /'HCHO      ','CCHO      ','RCHO      ',
     &              'ACET      ','MEK       ','MEOH      ',
     &              'ETHE      ','PRPE      ','BD13      ',
     &              'ISOP      ','APIN      ','ACYE      ',
     &              'BENZ      ','TOLU      ','MXYL      ',
     &              'OXYL      ','PXYL      ','B124      ',
     &              'ETOH      ','ALK1      ','ALK2      ',
     &              'ALK3      ','ALK4      ','ALK5      ',
     &              'OLE1      ','OLE2      ','ARO1      ',
     &              'ARO2      ','TERP      ','SESQ      '/
c
      data carbsprc /1.0,         2.0,         3.0,
     &               3.0,         4.0,         1.0,
     &               2.0,         3.0,         4.0,
     &               5.0,        10.0,         2.0,
     &               6.0,         7.0,         8.0,
     &               8.0,         8.0,         9.0,
     &               2.0,         2.0,         2.5,
     &               4.0,         5.4,         8.3,
     &               5.2,         5.4,         7.2,
     &               8.8,        10.0,        15.0/
c
      data rkohsprc  /1.25E4,     2.21E4,     2.93E4,
     &                2.77E2,     1.74E3,     1.32E3,
     &                1.21E4,     3.89E4,     9.83E4,
     &                1.49E5,     7.72E4,     1.12E3,
     &                1.80E3,     8.31E3,     3.41E4,
     &                2.01E4,     2.11E4,     4.80E4,
     &                4.74E3,     3.66E2,     1.62E3,
     &                3.40E3,     6.42E3,     1.40E4,
     &                5.33E4,     9.57E4,     1.16E4,
     &                4.56E4,     1.44E5,     1.44E5/
c
      data rmirsprc  /5.92,       6.00,       8.57,
     &                0.43,       2.23,       0.45,
     &                5.26,      10.23,      14.21,
     &               15.05,      12.79,       0.52,
     &                1.17,       7.69,      21.57,
     &               16.90,      12.92,      22.22,
     &                1.46,       0.18,       0.45,
     &                1.44,       4.77,       3.01,
     &               10.53,      15.30,       5.97,
     &               20.88,      11.48,       5.74/
c
      data hrvsprc /'ETHE      ','PRPE      ','BD13      ',
     &              'OLE1      ','OLE2      '/
c
      data spccb05 /'PAR       ','ETHA      ','MEOH      ',
     &              'ETOH      ','ETH       ','OLE       ',
     &              'IOLE      ','ISOP      ','TERP      ',
     &              'FORM      ','ALD2      ','ALDX      ',
     &              'TOL       ','XYL       '/
c
      data carbcb05 /0.90625,     2.,          1.,
     &               2.,          2.,          2.,
     &               4.,          5.,         10.,
     &               1.,          2.,          2.,
     &               7.,          8./
c
      data rkohcb05 /1.20E3,      3.54E2,      1.35E3,
     &               4.71E3,      1.20E4,      4.73E4,
     &               9.35E4,      1.47E5,      1.00E5,
     &               1.33E4,      2.05E4,      2.93E4,
     &               8.75E3,      3.71E4/
c
      data rmircb05 /0.336,       0.135,       0.354,
     &               1.11,        4.26,        8.02,
     &               13.7,        12.1,        8.50,
     &               4.32,        4.68,        7.22,
     &               2.15,        14.2/
c
      data hrvcb05 /'ETH       ','IOLE      ','OLE       '/
c
      data spccb6  /'PAR       ','ETHA      ','MEOH      ',
     &              'ETOH      ','ETH       ','OLE       ',
     &              'IOLE      ','ISOP      ','TERP      ',
     &              'FORM      ','ALD2      ','ALDX      ',
     &              'TOL       ','XYL       ','PRPA      ',
     &              'BENZ      ','ETHY      ','ACET      ',
     &              'KET       '/
c
      data carbcb6  /1.,          2.,          1.,
     &               2.,          2.,          2.,
     &               4.,          5.,         10.,
     &               1.,          2.,          2.,
     &               7.,          8.,          3.,
     &               6.,          2.,          3.,
     &               1./
c
      data rkohcb6  /1.20E3,      3.56E2,      1.32E3,
     &               4.74E3,      1.16E4,      4.22E4,
     &               8.85E4,      1.48E5,      1.00E5,
     &               1.25E4,      2.21E4,      2.82E4,
     &               8.32E3,      2.73E4,      1.58E3,
     &               1.80E3,      1.11E3,      2.60E2,
     &               0.00E0/
c
      data rmircb6  /0.509,       0.135,       0.480,
     &               1.53,        4.95,        9.66,
     &               16.0,        12.7,        9.91,
     &               4.87,        5.80,        8.35,
     &               7.39,        20.5,        0.541,
     &               1.39,        0.487,       0.564,
     &               4.86/
c
      data hrvcb6  /'ETH       ','IOLE      ','OLE       '/
c
      data spcsoap /'BENZ      ',
     &              'TOL       ','TOLU      ','ARO1      ',
     &              'XYL       ','OXYL      ','MXYL      ',
     &              'PXYL      ','B124      ','ARO2      ',
     &              'IVOA      '/
c
      data rkohsoap / 1.80E3,
     &                8.32E3,     8.32E3,      8.32E3,
     &                2.73E4,     2.73E4,      2.73E4,
     &                2.73E4,     2.73E4,      2.73E4,
     &                1.98E4/
c
      data nonam  /'NO        '/
c
      data no2nam /'NO2       '/
c
      data o3name /'O3        '/
c
c-----------------------------------------------------------------------
c    Entry point:
c-----------------------------------------------------------------------
c
c  ---- initialize the arrays for reactivity ---
c
      do i=1,nspec
         crbnum(i) = 0.
         rkohrt(i) = 0.
         rmirrt(i) = 0.
         lusespc(i) = .FALSE.
      enddo
c
c  --- calculate the beginning of the various tracer types ---
c      there will be (ngroup+1) if there is an extra group for the
c      "leftover" group  ----
c      
      if( lsa_ioric ) then
          numic_spcs = ncls_ioric
      else
          numic_spcs = 1
      endif
      if( lsa_iorbc ) then
          numbc_spcs = ncls_iorbc
          numtc_spcs = 0
          if( .NOT. lsa_iortc ) numtc_spcs = 1
      else
          numtc_spcs = 0
          if( lbndry ) then
              numbc_spcs = 5
          else
              numbc_spcs = 1
          endif
      endif
      nbdic = numic_spcs + numbc_spcs + numtc_spcs 
      if( ngroup .EQ. 0 ) then
          ncount = nregin 
      else
          if( leftovr ) then
             ncount = (ngroup + 1) * nregin
          else
             ncount = ngroup * nregin
          endif
      endif
c
c  ---- load the local arrays based on the mechanism ---
c
      if( idmech .EQ. 2 .OR. idmech .EQ. 3 .OR. idmech .EQ. 4 ) then
         nnames = NSACB6
         if( idmech .EQ. 3 .OR. idmech .EQ. 4 ) then
            call spccb6r4sa(namecls,numcls,coefcon,coeflux,
     &                      nameyld,numyld,yieldH,yieldL,mwspec)
         else
            call spccb6r2sa(namecls,numcls,coefcon,coeflux,
     &                      nameyld,numyld,yieldH,yieldL,mwspec)
         endif
         do i=1,nnames
            spcnam(i) = spccb6(i)
            carbon(i) = carbcb6(i)
            rkoh(i) = rkohcb6(i)/carbon(i)
            rmir(i) = rmircb6(i)/carbon(i)
         enddo
         nhrvoc = NHRVCB6
         do i=1,nhrvoc
            hrvnam(i) = hrvcb6(i)
         enddo
      elseif( idmech .EQ. 5 ) then
         nnames = NSASPRC
         call spcsprcsa(namecls,numcls,coefcon,coeflux,
     &                  nameyld,numyld,yieldH,yieldL,mwspec)
         do i=1,nnames
            spcnam(i) = spcsprc(i)
            carbon(i) = carbsprc(i)
            rkoh(i) = rkohsprc(i)/carbon(i)
            rmir(i) = rmirsprc(i)/carbon(i)
         enddo
         nhrvoc = NHRVSPRC
         do i=1,nhrvoc
            hrvnam(i) = hrvsprc(i)
         enddo
      elseif( idmech .EQ. 6 ) then
         nnames = NSACB05
         call spccb05sa(namecls,numcls,coefcon,coeflux,
     &                  nameyld,numyld,yieldH,yieldL,mwspec)
         do i=1,nnames
            spcnam(i) = spccb05(i)
            carbon(i) = carbcb05(i)
            rkoh(i) = rkohcb05(i)/carbon(i)
            rmir(i) = rmircb05(i)/carbon(i)
         enddo
         nhrvoc = NHRVCB05
         do i=1,nhrvoc
            hrvnam(i) = hrvcb05(i)
         enddo
      else
         write(iout,'(//,a)') 'ERROR in STABSA:'
         write(iout,'(/,1X,A,I10)')
     &              'Unknown chemical mechanism ID number: ',idmech
         write(iout,'(/,1X,2A)')
     &              'Ozone source apportionment is not available ',
     &              'for this chemical mechanism'
         call camxerr()
      endif
c
c  --- make sure there is enough space ---
c
      ntrcls = 0
      do i=1,MXALCLS
        if( numcls(i) .GT. 0 ) ntrcls = ntrcls + 1
      enddo
c
c  --- call routine to allocate arrays by class ---
c
      call alloc_tracer_class(nspec)
      call zeros(trspmap,nspec*ntrcls)
      call zeros(fluxmap,nspec*ntrcls)
      call zeros(yhratmap,nspec*ntrcls)
      call zeros(ylratmap,nspec*ntrcls)
c
c  --- initialize the pointers into the gridded conc array ---
c
      ntrcls = 0
      iptrbeg = 1
      idxo3n = 0
      idxo3v = 0
      idxoon = 0
      idxoov = 0
      do i=1,MXALCLS
        if( numcls(i) .GT. 0 ) then
           ntrcls = ntrcls + 1
           iptcls(ntrcls) = iptrbeg
           ipttrc(ntrcls) = iptrbeg
           iptrbeg = iptrbeg + ncount + nbdic
           nptcls(ntrcls) = iptrbeg - 1
           npttrc(ntrcls) = iptrbeg - 1
           iemcls(ntrcls) = iptcls(ntrcls) + nbdic
           idxcls(ntrcls) = i
           idxipt(i) = ntrcls
           if( i .EQ. ITRO3N ) idxo3n = ntrcls
           if( i .EQ. ITRO3V ) idxo3v = ntrcls
           if( i .EQ. ITROON ) idxoon = ntrcls
           if( i .EQ. ITROOV ) idxoov = ntrcls
        endif
      enddo
      ipttim = iptrbeg
      iemtim = ipttim
c
c   --- adjust the pointers for O3N and O3V (together make up O3)
c
      if( idxo3n .GT. 0 .AND. idxo3v .GT. 0 ) then
        ipttrc(idxo3v) = 0
        npttrc(idxo3n) = npttrc(idxo3v)
        npttrc(idxo3v) = 0
      endif
c
c   --- adjust the pointers for OON and OOV (together make up RGN)
c
      if( idxoon .GT. 0 .AND. idxoov .GT. 0 ) then
        ipttrc(idxoov) = 0
        npttrc(idxoon) = npttrc(idxoov)
        npttrc(idxoov) = 0
      endif
c
c   --- calculate the number of tracers at first time step
c       (1 timing release is updated later) ---
c
      nreles = 0
      ntotsp = ipttim-1
      notimespc = ipttim-1
      nsaspc = ipttim-1
c
c  --- calculate the number of timing tracers there will be and put
c      the names into the names array ---
c
      if( ntrtim .GT. 0 ) then
        ibegdt = idate
        btim = begtim/100.
        ienddt = jdate
        etim = endtim/100.
        if( etim .EQ. 0. ) then
            etim = 24.
            ienddt = ienddt - 1
        endif
        timnow = btim
        idtnow = ibegdt
        nhours = (ienddt-ibegdt)*24 + INT( etim - btim )
        do i=1,nhours
           if( MOD( INT(timnow), 24/ntrtim ) .EQ. 0 .OR. i .EQ. 1) then
              do j=1,nregin
                  ntotsp = ntotsp + 2
              enddo
           endif
           timnow = timnow + 1.0
           if( timnow .EQ. 24.0 ) then
               timnow = 0.
               idtnow = idtnow + 1
           endif
        enddo
        if( ntotsp .GT. MXTRSP ) goto 7000
      endif
c
c   --- call routine to allocate the arrays that depend on total
c       tracer species ---
c
      if( .NOT. lddm .AND. .NOT. lhddm ) then
         mvecedge = MAX(ncol(1),nrow(1))
         call alloc_tracer_specs(ngrid,ncol,nrow,nlay,nlayers_ems,
     &                                       tectyp,mvecedge,iout)
         call alloc_tracer_vdep(ngrid,ncol,nrow,ntotsp)
      endif
c
      if( ntrtim .EQ. 0 ) npttim = 0
c
c   --- loop over the species in the chemparam file and 
c       intialize the flags ---
c
      do ispc=1,nspec
         lvocsp(ispc) = .FALSE.
         lnoxsp(ispc) = .FALSE.
         lo3sp(ispc) = .FALSE.
         lvocsoa(ispc) = .FALSE.
         lhrvoc(ispc) = .FALSE.
c
c   --- loop over the tracer classes ---
c
         do i=1,ntrcls
              itr = idxcls(i)
c
c   ---- loop over the model species making up this class ---
c
               do imod=1,numcls(itr)
c
c   --- check the name, if it matches load the global array ---
c
                 if( spname(ispc) .EQ. namecls(itr,imod) ) then
                     trspmap(ispc,i) = coefcon(itr,imod)
                     fluxmap(ispc,i) = coeflux(itr,imod)
                     lusespc(ispc) = .TRUE.
                 endif
               enddo
c
c   ---- loop over the model species for yields ---
c
               do imod=1,numyld(itr)
c
c   --- check the name, if it matches load the global array ---
c
                 if( spname(ispc) .EQ. nameyld(itr,imod) ) then
                     yhratmap(ispc,i) = yieldH(itr,imod)
                     ylratmap(ispc,i) = yieldL(itr,imod)
                 endif
               enddo
c
c   ---- next tracer class ---
c
         enddo
c
c   --- check for O3 species ----
c
         if( spname(ispc) .EQ. o3name ) then
              lo3sp(ispc) = .TRUE.
         endif
c
c   --- check for NOx species ----
c
         if( spname(ispc) .EQ. nonam .OR. spname(ispc) .EQ. no2nam) then
              lnoxsp(ispc) = .TRUE.
         endif
c
c   ---- check for reactive VOC species ---
c
         do i=1,nnames
            if( spname(ispc) .EQ. spcnam(i) ) then
               lvocsp(ispc) = .TRUE.
               crbnum(ispc) = carbon(i)
               rkohrt(ispc) = rkoh(i)
               rmirrt(ispc) = rmir(i)
            endif
         enddo
c
c
c   ---- check for SOA-producing VOC species for PSAT ---
c   NOTE: 1. Carbon numbers and MIR values are irrelevant to PSAT
c         2. Only needed for calculating reactivity/yield weighting factors
c
         if( lsoa ) then
           do i=1,NSASOAP
              if( spname(ispc) .EQ. spcsoap(i) ) then
                 lvocsoa(ispc) = .TRUE.
                 rkohrt(ispc) = rkohsoap(i)
              endif
           enddo
         endif
c
c   ---- check for additional VOC species that produce SOA ---
c   NOTE: only for DDM, otherwise they should NOT be added
c
         if ( lddm ) then
            if ( idmech .NE. 5 ) then
               if (spname(ispc).EQ.'SQT       ') lvocsp(ispc) = .TRUE.
            endif
            if( spname(ispc) .EQ. 'IVOA      ' ) lvocsp(ispc) = .TRUE.
         endif
c
c   ---- check for HRVOC species ---
c   NOTE: set for DDM
c
         do i=1,nhrvoc
            if( spname(ispc) .EQ. hrvnam(i) ) lhrvoc(ispc) = .TRUE.
         enddo
c
c  --- next simulation species ---
c
      enddo
c      
c  --- return to calling routine ---
c
      goto 9999
c
c-----------------------------------------------------------------------
c    Error Messages:
c-----------------------------------------------------------------------
c
 7000 continue
      write(iout,'(//,A)') 'ERROR in STABSA:'
      write(iout,*) 'A parameter in the camx.prm is not ',
     &                                        'sufficiently large.'
      write(iout,'(2A)') ' You are using timing tracers but have not ',
     &                       'allocated space for the timing releases.'
      write(iout,*) 'Please change the value for parameter MXTRSP.'
      write(iout,*) 'It should be set to a value of at least: ',ntotsp
      call flush(iout)
      call camxerr()
c
c-----------------------------------------------------------------------
c    Return point:
c-----------------------------------------------------------------------
c
 9999 continue
      return
      end
