c**** SPECSA
c
      subroutine specsa(idate,begtim,jdate,endtim)
      use filunit
      use tracer
      use grid
c
c----CAMx v7Beta6 190902
c
c-----------------------------------------------------------------------
c    Description:
c-----------------------------------------------------------------------
c
c   This routine sets up the species names and pointers into the species
c   for all of the tracer species.  Pointers will be set up for both the
c   concentration array and the emissions array.
c
c     Copyright 1996 - 2018
c     Ramboll
c
c     Argument descriptions:
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-----------------------------------------------------------------------
c    LOG:
c-----------------------------------------------------------------------
c
c     05/26/96   --gwilson--    Original development
c     12/12/97   --gwilson--    Fixed bug in initializing the timing
c                               tracers
c     11/06/01   --cemery--     Input dates are now Julian
c     12/29/06   --bkoo--       Revised for the updated SOA scheme
c     11/4/09    -cemery-       Removed reference to input top conc array
c     11/12/09   --gwilson--    Added initialization of factor for
c                               applying new type of top boundary 
c     03/18/14   --bkoo--       Added tracer for SOAH
c     08/25/16   --bkoo--       Updated for new SOAP
c     01/06/19   --cemery--     Added PFE/PMN/PMG/PK/PCA/PAL/PSI/PTI
c     01/09/19   --cemery-      Added DMS
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 variables:
c-----------------------------------------------------------------------
c
      character*10 name
      integer*8    mvsa3d, idxsa
      integer      ibegdt, ienddt
      integer      ncount, ioff, idtnow, nhours, numic_spcs, numbc_spcs
      integer      numrt_spcs, num_icbc_specs, i, j, k, l
      real         timnow, btim, etim
      logical      lgasflg(MXALCLS), lwrtcls(MXALCLS), lfound_class
c
c-----------------------------------------------------------------------
c    Entry point:
c-----------------------------------------------------------------------
c
      ibegdt = idate
      btim = begtim/100.
      ienddt = jdate
      etim = endtim/100.
c
c   --- set flags for whether this class should be 
c       written to average file ---
c
      do i=1,MXALCLS
        lwrtcls(i) = .FALSE.
      enddo
      lwrtcls(ITRO3N) = .TRUE.
      lwrtcls(ITRO3V) = .TRUE.
      lwrtcls(ITRPS4) = .TRUE.
      lwrtcls(ITRPN3) = .TRUE.
      lwrtcls(ITRPN4) = .TRUE.
      lwrtcls(ITRPO1) = .TRUE.
      lwrtcls(ITRPO2) = .TRUE.
      lwrtcls(ITRPO3) = .TRUE.
      lwrtcls(ITRPO4) = .TRUE.
      lwrtcls(ITRPPA) = .TRUE.
      lwrtcls(ITRPPB) = .TRUE.
      lwrtcls(ITRPEC) = .TRUE.
      lwrtcls(ITRPOA) = .TRUE.
      lwrtcls(ITRPFC) = .TRUE.
      lwrtcls(ITRPFN) = .TRUE.
      lwrtcls(ITRPCC) = .TRUE.
      lwrtcls(ITRPCS) = .TRUE.
      lwrtcls(ITRPFE) = .TRUE.
      lwrtcls(ITRPMN) = .TRUE.
      lwrtcls(ITRPMG) = .TRUE.
      lwrtcls(ITRPK)  = .TRUE.
      lwrtcls(ITRPCA) = .TRUE.
      lwrtcls(ITRPAL) = .TRUE.
      lwrtcls(ITRPSI) = .TRUE.
      lwrtcls(ITRPTI) = .TRUE.
      lwrtcls(ITRHG0) = .TRUE.
      lwrtcls(ITRHG2) = .TRUE.
      lwrtcls(ITRPHG) = .TRUE.
c
c  --- define the names of the tracer clasess ---
c
      clsnam(ITRVOC) = 'VOC'
      lgasflg(ITRVOC) = .TRUE.
c
      clsnam(ITRO3N) = 'O3N'
      lgasflg(ITRO3N) = .TRUE.
c
      clsnam(ITRO3V) = 'O3V'
      lgasflg(ITRO3V) = .TRUE.
c
      clsnam(ITROON) = 'OON'
      lgasflg(ITROON) = .TRUE.
c
      clsnam(ITROOV) = 'OOV'
      lgasflg(ITROOV) = .TRUE.
c
      clsnam(ITRSO2) = 'SO2'
      lgasflg(ITRSO2) = .TRUE.
c
      clsnam(ITRPS4) = 'PS4'
      lgasflg(ITRPS4) = .FALSE.
c
      clsnam(ITRDMS) = 'DMS'
      lgasflg(ITRDMS) = .TRUE.
c
      clsnam(ITRNIT) = 'NIT'
      lgasflg(ITRNIT) = .TRUE.
c
      clsnam(ITRRGN) = 'RGN'
      lgasflg(ITRRGN) = .TRUE.
c
      clsnam(ITRTPN) = 'TPN'
      lgasflg(ITRTPN) = .TRUE.
c
      clsnam(ITRNTR) = 'NTR'
      lgasflg(ITRNTR) = .TRUE.
c
      clsnam(ITRHN3) = 'HN3'
      lgasflg(ITRHN3) = .TRUE.
c
      clsnam(ITRPN3) = 'PN3'
      lgasflg(ITRPN3) = .FALSE.
c
      clsnam(ITRNH3) = 'NH3'
      lgasflg(ITRNH3) = .TRUE.
c
      clsnam(ITRPN4) = 'PN4'
      lgasflg(ITRPN4) = .FALSE.
c
      clsnam(ITRARO) = 'ARO'
      lgasflg(ITRARO) = .TRUE.
c
      clsnam(ITRISP) = 'ISP'
      lgasflg(ITRISP) = .TRUE.
c
      clsnam(ITRTRP) = 'TRP'
      lgasflg(ITRTRP) = .TRUE.
c
      clsnam(ITRSQT) = 'SQT'
      lgasflg(ITRSQT) = .TRUE.
c
      clsnam(ITRCG1) = 'CG1'
      lgasflg(ITRCG1) = .TRUE.
c
      clsnam(ITRCG2) = 'CG2'
      lgasflg(ITRCG2) = .TRUE.
c
      clsnam(ITRCG3) = 'CG3'
      lgasflg(ITRCG3) = .TRUE.
c
      clsnam(ITRCG4) = 'CG4'
      lgasflg(ITRCG4) = .TRUE.
c
      clsnam(ITRPO1) = 'PO1'
      lgasflg(ITRPO1) = .FALSE.
c
      clsnam(ITRPO2) = 'PO2'
      lgasflg(ITRPO2) = .FALSE.
c
      clsnam(ITRPO3) = 'PO3'
      lgasflg(ITRPO3) = .FALSE.
c
      clsnam(ITRPO4) = 'PO4'
      lgasflg(ITRPO4) = .FALSE.
c
      clsnam(ITRPPA) = 'PPA'
      lgasflg(ITRPPA) = .FALSE.
c
      clsnam(ITRPPB) = 'PPB'
      lgasflg(ITRPPB) = .FALSE.
c
      clsnam(ITRPEC) = 'PEC'
      lgasflg(ITRPEC) = .FALSE.
c
      clsnam(ITRPOA) = 'POA'
      lgasflg(ITRPOA) = .FALSE.
c
      clsnam(ITRPFC) = 'PFC'
      lgasflg(ITRPFC) = .FALSE.
c
      clsnam(ITRPFN) = 'PFN'
      lgasflg(ITRPFN) = .FALSE.
c
      clsnam(ITRPCC) = 'PCC'
      lgasflg(ITRPCC) = .FALSE.
c
      clsnam(ITRPCS) = 'PCS'
      lgasflg(ITRPCS) = .FALSE.
c
      clsnam(ITRPFE) = 'PFE'
      lgasflg(ITRPFE) = .FALSE.
c
      clsnam(ITRPMN) = 'PMN'
      lgasflg(ITRPMN) = .FALSE.
c
      clsnam(ITRPMG) = 'PMG'
      lgasflg(ITRPMG) = .FALSE.
c
      clsnam(ITRPK) = 'PK_'
      lgasflg(ITRPK) = .FALSE.
c
      clsnam(ITRPCA) = 'PCA'
      lgasflg(ITRPCA) = .FALSE.
c
      clsnam(ITRPAL) = 'PAL'
      lgasflg(ITRPAL) = .FALSE.
c
      clsnam(ITRPSI) = 'PSI'
      lgasflg(ITRPSI) = .FALSE.
c
      clsnam(ITRPTI) = 'PTI'
      lgasflg(ITRPTI) = .FALSE.
c
      clsnam(ITRHG0) = 'HG0'
      lgasflg(ITRHG0) = .TRUE.
c
      clsnam(ITRHG2) = 'HG2'
      lgasflg(ITRHG2) = .TRUE.
c
      clsnam(ITRPHG) = 'PHG'
      lgasflg(ITRPHG) = .FALSE.
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
          do icls=1,ntrcls
            lfound_class = .FALSE.
            do ispc=1,num_ioric
               if( spc_ioric(ispc)(1:3) .EQ. clsnam(idxcls(icls)) ) 
     &                                        lfound_class = .TRUE.
            enddo
            if( .NOT. lfound_class ) goto 7000
          enddo
          numic_spcs = ncls_ioric
      else
          numic_spcs = 1
          ncls_ioric = 1
      endif
      if( lsa_iorbc ) then
          do icls=1,ntrcls
            lfound_class = .FALSE.
            do ispc=1,num_iorbc
               if( spc_iorbc(ispc)(1:3) .EQ. clsnam(idxcls(icls)) ) 
     &                                        lfound_class = .TRUE.
            enddo
            if( .NOT. lfound_class ) goto 7001
          enddo
          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
      num_icbc_specs = 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  --- set the flag for gaseous species ---
c
      do i=1,ntrcls
        do j=iptcls(i),nptcls(i)
           lsagas(j) = lgasflg(idxcls(i))
        enddo
      enddo
c
c   --- load the species from the initial conditions file ---
c
      if( lsa_ioric ) then
         do icls=1,ntrcls
           ioff = 0
           do ispc=1,num_ioric
             if( spc_ioric(ispc)(1:3) .EQ. clsnam(idxcls(icls)) ) then
                ptname(iptcls(icls)+ioff) = spc_ioric(ispc)
                ptop_fac(iptcls(icls)+ioff) = 0.0
                ioff = ioff + 1
             endif
           enddo
         enddo
c
c   --- set the names for the initial condition tracers ---
c
      else
         do i=1,ntrcls
            ptname(iptcls(i)) = clsnam(idxcls(i))//'000IC  '
            ptop_fac(iptcls(i)) = 0.0
         enddo
         num_ioric = 1
      endif
c
c   --- load the species from the initial conditions file ---
c
      if( lsa_iorbc ) then
         do icls=1,ntrcls
           ioff = numic_spcs
           do ispc=1,num_iorbc
             if( spc_iorbc(ispc)(1:3) .EQ. clsnam(idxcls(icls)) ) then
                ptname(iptcls(icls)+ioff) = spc_iorbc(ispc)
                if( lsa_iortc ) then 
                    ptop_fac(iptcls(icls)+ioff) = 1.0
                else
                    ptop_fac(iptcls(icls)+ioff) = 0.0
                endif
                ioff = ioff + 1
             endif
           enddo
           if( .NOT. lsa_iortc ) then
             ptname(iptcls(icls)+ioff) = clsnam(idxcls(icls))//'TOPBC  '
             ptop_fac(iptcls(icls)+ioff) = 1.0
           endif
         enddo
c
c   --- if stratifying by boundary there will be 5 boundary condition
c       tracers, otherwise there will be only one ---
c
      else
          if( lbndry ) then
              do i=1,ntrcls
                 ptname(iptcls(i) + numic_spcs-1 + IDXBNT) = clsnam(idxcls(i))//'NTHBC  '
                 ptname(iptcls(i) + numic_spcs-1 + IDXBES) = clsnam(idxcls(i))//'ESTBC  '
                 ptname(iptcls(i) + numic_spcs-1 + IDXBST) = clsnam(idxcls(i))//'STHBC  '
                 ptname(iptcls(i) + numic_spcs-1 + IDXBWS) = clsnam(idxcls(i))//'WSTBC  '
                 ptname(iptcls(i) + numic_spcs-1 + IDXBTP) = clsnam(idxcls(i))//'TOPBC  '
                 ptop_fac(iptcls(i) + numic_spcs-1 + IDXBNT) = 0.0
                 ptop_fac(iptcls(i) + numic_spcs-1 + IDXBES) = 0.0
                 ptop_fac(iptcls(i) + numic_spcs-1 + IDXBST) = 0.0
                 ptop_fac(iptcls(i) + numic_spcs-1 + IDXBWS) = 0.0
                 ptop_fac(iptcls(i) + numic_spcs-1 + IDXBTP) = 1.0
              enddo
          else
              do i=1,ntrcls
                 ptname(iptcls(i)+numic_spcs) = clsnam(idxcls(i))//'000BC  '
                 ptop_fac(iptcls(i)+numic_spcs) = 1.0
              enddo
          endif
      endif
c
c  --- construct the tracer names and put into names array ---
c
      if( ngroup .EQ. 0 ) then
          ioff = num_icbc_specs
          do i=1,nregin
             do k=1,ntrcls
                 write(name,'(A,I3.3,I3.3)') clsnam(idxcls(k)),1,i
                 ptname(iptcls(k)+ioff) = name
                 ptop_fac(iptcls(k)+ioff) = 0.0
             enddo
             ioff = ioff + 1
          enddo
      else
          ioff = num_icbc_specs
          if( leftovr ) then
             ncount = ngroup + 1
          else
             ncount = ngroup 
          endif
          do j=1,ncount
             do i=1,nregin
                do k=1,ntrcls
                   write(name,'(A,I3.3,I3.3)') clsnam(idxcls(k)),j,i
                   ptname(iptcls(k)+ioff) = name
                   ptop_fac(iptcls(k)+ioff) = 0.0
                enddo
                ioff = ioff + 1
             enddo
          enddo
      endif
c
c  --- calculate the number of timing tracers there will be and put
c      the names into the names array ---
c
      ntotsp = ipttim - 1 
      if( ntrtim .GT. 0 ) then
        if( etim .EQ. 0. ) then
            etim = 24.
            ienddt = ienddt - 1
        endif 
        timnow = btim
        idtnow = ibegdt
        nhours = (ienddt-ibegdt)*24 + INT( etim - btim ) 
        npttim = 1
        do i=1,nhours
           if( MOD( INT(timnow), 24/ntrtim ) .EQ. 0 .OR. i .EQ. 1) then
              do j=1,nregin
                  write(name,'(A,I3.3,I2.2,I3.3)') 'I',MOD(idtnow,1000),
     &                                                  INT(timnow),j
                  ptname(ntotsp+1) = name
                  ptop_fac(ntotsp+1) = 0.0
                  write(name,'(A,I3.3,I2.2,I3.3)') 'D',MOD(idtnow,1000),
     &                                                  INT(timnow),j
                  ptname(ntotsp+2) = name
                  ptop_fac(ntotsp+2) = 0.0
                  npttim = npttim + 2
                  ntotsp = ntotsp + 2
              enddo
           endif
           timnow = timnow + 1.0
           if( timnow .EQ. 24.0 ) then
               timnow = 0.
               idtnow = idtnow + 1
           endif
        enddo
      endif
c
c  --- initialize all of the tracers concs to zero to start off ---
c
      mvsa3d = 0
      do i=1,ngrid
         mvsa3d = mvsa3d + DBLE(ncol(i)) * DBLE(nrow(i)) * DBLE(nlay(i))
      enddo
      mvsa3d = DBLE(mvsa3d) * DBLE(ntotsp)
      do idxsa=1,mvsa3d
        ptconc(idxsa) = 0.
      enddo
      do l=1,ntotsp
         lsamap(l) = l
         do i=1,MXRECP
            conrcp(l,i) = 0.        
         enddo
      enddo
c
c  --- set the flag for outputting the species to average file
c      to true automatically for tracer species ---
c
      if( lallout ) then
         do i=1,ntotsp
            loutsa(i) = .TRUE.
         enddo
      else
         do i=1,ntotsp
            loutsa(i) = .FALSE.
         enddo
         do j=1,ntrcls
           if( lwrtcls(idxcls(j)) ) then
              do i=iptcls(j),nptcls(j)
                 loutsa(i) = .TRUE.
              enddo
           endif
         enddo
      endif
c      
c  --- return to calling routine ---
c
      goto 9999
c
c-----------------------------------------------------------------------
c    Error messages:
c-----------------------------------------------------------------------
c
 7000 continue
      write(iout,'(//,a)') 'ERROR in SPECSA:'
      write(iout,'(2A)',ERR=9999) 'You requested a tracer species ',
     &       'that is not included in your SA IC file.'
      write(iout,'(2A)',ERR=9999) 'Either disable the class or ',
     &       'supply the data in the SA IC file.'
      write(iout,'(10X,2A)',ERR=9999) 'SA species: ',clsnam(idxcls(icls))
      call camxerr()
c
 7001 continue
      write(iout,'(//,a)') 'ERROR in SPECSA:'
      write(iout,'(2A)',ERR=9999) 'You requested a tracer species ',
     &       'that is not included in your SA BC file.'
      write(iout,'(2A)',ERR=9999) 'Either disable the class or ',
     &       'supply the data in the SA BC file.'
      write(iout,'(10X,2A)',ERR=9999) 'SA species: ',clsnam(idxcls(icls))
      call camxerr()
c
c
c-----------------------------------------------------------------------
c    Return point:
c-----------------------------------------------------------------------
c
 9999 continue
      return
      end
