*** EMPREPRT
c
      subroutine empreprt(idate,btim,igrid)
      use filunit
      use grid
      use chmstry
      use ptemiss
      use rtracchm
      use tracer
c
c----CAMx v7Beta6 190902
c
c-----------------------------------------------------------------------
c    Description:
c-----------------------------------------------------------------------
c
c   This routine reads the emissions files for the RTRAC and moves the 
c   file pointer to the first hour to be used in this run.
c
c     Copyright 1996 - 2018
c     Ramboll
c
c-----------------------------------------------------------------------
c    LOG:
c-----------------------------------------------------------------------
c
c      01/16/02   --gwilson-- original development
c      11/12/03   --cemery -- Changed to handle optional area/pt files, 
c                             and to check Rtrac point source file against 
c                             regular model pt file
c
c-----------------------------------------------------------------------
c    Include files:
c-----------------------------------------------------------------------
c
      include 'camx.prm'
      include 'flags.inc'
c
c-----------------------------------------------------------------------
c    Arguement declarations:
c-----------------------------------------------------------------------
c
      integer   idate
      real      btim
      integer   igrid
c
c-----------------------------------------------------------------------
c    Local parameters:
c-----------------------------------------------------------------------
c
      integer MXOUT
c
      parameter (MXOUT = MAX(MXSPEC,MXTRSP))
c
c-----------------------------------------------------------------------
c    Local variables:
c-----------------------------------------------------------------------
c
      character*200 fname
      character*10  namein
      character*4   ifname(10), ifnote(60)
      integer       nseg, nspect
      integer       ispc, ibgdat, iendat
      integer       idateb, idatee, nxcelt, nycelt, nzcelt
      integer       idum, izonet, iounit, isegm, npoint
      integer       i, j, ndate, seg4(4)
      real          tutmx, tutmy, tdxcel, tdycel
      real          tbegti, tendti, begtim, endtim, dum
      real          txorig, tyorig, ttime
      logical       luse
c
      character*4 iname(10,MXOUT)
      real        txloc(MXPTSRC)
      real        tyloc(MXPTSRC)
      real        tdiam(MXPTSRC)
c
c-----------------------------------------------------------------------
c    Entry point:
c-----------------------------------------------------------------------
c
c   --- set the date and time ---
c
      ndate = idate
      ttime = btim/100.0
      if( ttime .EQ. 24.0 ) then
         ndate = ndate + 1
         ttime = 0.
         if( MOD(ndate,1000) .GT. 365 ) then
            if( MOD(INT(ndate/1000),4) .EQ. 0 ) then
               if( MOD(ndate,1000) .EQ. 367 )
     &                     ndate = (INT(ndate/1000)+1)*1000 + 1
            else
               ndate = (INT(ndate/1000)+1)*1000 + 1
            endif
         endif
      endif
c
c   --- initialize the flag for PiG sources ---
c
      if( igrid .EQ. 1 ) then
         do 15 i=1,nptsrc
            lpigsa(i) = .FALSE.
   15    continue
      endif 
c
c   --- only read if surface emissions file is supplied ---
c
      if( .NOT. is_netcdf_iortem(igrid,1,1) .AND. ltemfl(igrid,1,1) 
     &                                           .AND. larsrc ) then
        iounit = iortem(igrid,1,1)
        fname = temfil(igrid,1,1)
c
c   --- rewind the file ----
c
        rewind(iounit,ERR=7005)
c
c   --- read the header of the emissions file ---
c
        read(iounit,ERR=7000) ifname, ifnote, nseg, nspect, idateb, 
     &                                        tbegti, idatee, tendti
        if( nspect .GT. MXSPEC ) then
          write(iout,'(//,A)') 'ERROR in EMPREPRT:'
          write(iout,*) 'A parameter in the camx.prm is not ',
     &                                        'sufficiently large.'
          write(iout,*)
     &                    'Please change the value for parameter: MXTRSP'
          write(iout,*) 'It should be set to a value of at least: ',
     &                                                             nspect
          call flush(iout)
          call camxerr()
        endif

c
        read(iounit,ERR=7000) tutmx, tutmy, izonet, txorig,tyorig, 
     &                           tdxcel, tdycel, nxcelt, nycelt, nzcelt
        read(iounit,ERR=7000) seg4
        read(iounit,ERR=7000) ((iname(i,ispc),i=1,10),ispc=1,nspect)
c
c   --- set up index for species names ---
c
        nspcem(igrid,1,1) = nspect
        do 20 ispc=1,nspcem(igrid,1,1)
           write(namein,'(10A1)') (iname(i,ispc),i=1,10)
           luse = .FALSE.
           do 30 j=1,ntotsp
             if(namein .EQ. ptname(j) ) then
                 idxems(igrid,1,1,ispc) = j
                 luse = .TRUE.
             endif
  30       continue
c
c  --- if not found in model species list, write a message ----     
c   
           if( .NOT. luse ) then
                write(idiag,'(1X,4A)') 'Species in RTRAC ',
     &              'surface emissions file: ',namein(:istrln(namein)),
     &                      ' not found in species list ... Skipping.'
           endif
  20    continue
c
c   --- read the data until the correct position in the file is reached ---
c
  111   continue
        read(iounit,ERR=7002,END=7003) ibgdat, begtim, iendat, endtim
        if( le1day ) then
           if( INT(begtim) .EQ. INT(ttime) ) goto 222
        else
           if( ibgdat .EQ. ndate .AND. 
     &                    INT(begtim) .EQ. INT(ttime) ) goto 222
        endif
        do 40 ispc=1,nspcem(igrid,1,1)
            read(iounit,ERR=7002,END=7003) idum, 
     &              (dum,i=1,10),((dum,i=1,ncol(igrid)),j=1,nrow(igrid))
   40   continue
        goto 111
  222   continue
        backspace(iounit)
c
      endif
c
c   --- point sources are only for the coarse grid -- grid #1 ---
c
      if( igrid .GT. 1 ) goto 9999
c
c   --- only read if elevated point source emissions file is supplied ---
c
      if( ltptfl(1,1) .AND. lptsrc ) then
        do ifile = 0,1
          if( ifile .EQ. 0 ) then
             iounit = iptem(1)
             write(fname,'(A,I3)') 'PTSOURCE -- UNIT ',iptem(1)
          else
             iounit = iortpt(1,1)
             fname = tptfil(1,1)
          endif
c
c   --- rewind the file ----
c
          rewind(iounit,ERR=7005)
c
c   --- read the header of the emissions file ---
c
          read(iounit,ERR=7000) ifname, ifnote, nseg, nspect, idateb, 
     &                                         tbegti, idatee, tendti
          if( nspect .GT. MXSPEC ) then
            write(iout,'(//,A)') 'ERROR in EMPREPRT:'
            write(iout,*) 'A parameter in the camx.prm is not ',
     &                                        'sufficiently large.'
            write(iout,*)
     &                    'Please change the value for parameter: MXSPEC'
            write(iout,*) 'It should be set to a value of at least: ',
     &                                                             nspect
            call flush(iout)
            call camxerr()
          endif
c
          read(iounit,ERR=7000) tutmx, tutmy, izonet, txorig, tyorig, 
     &                          tdxcel, tdycel, nxcelt, nycelt, nzcelt
          read(iounit,ERR=7000) seg4
          read(iounit,ERR=7000) ((iname(i,ispc),i=1,10),ispc=1,nspect)
c
c   --- set up index for species names ---
c
          nspcpt(1,1) = nspect
          do 50 ispc=1,nspcpt(1,1)
             write(namein,'(10A1)') (iname(i,ispc),i=1,10)
             luse = .FALSE.
             do 60 j=1,ntotsp
               if(namein .EQ. ptname(j) ) then
                   idxpts(1,1,ispc) = j
                   luse = .TRUE.
               endif
  60         continue
c
c  --- if not found in model species list, write a message ----
c  
             if( .NOT. luse ) then
                  write(idiag,'(1X,4A)') 'Species in RTRAC ',
     &              'point emissions file: ',namein(:istrln(namein)),
     &                      ' not found in species list ... Skipping.'
             endif
  50      continue
          read(iounit,ERR=7000) isegm, npoint
          if( npoint .GT. nptsrc ) goto 7006
          read(iounit,ERR=7002) (txloc(i),tyloc(i),idum,tdiam(i),
     &                                        dum,dum,i=1,npoint)
          do 80 i=1,npoint
             if( ifile .EQ. 0 ) then
                 xlocpt(i) = txloc(i)
                 ylocpt(i) = tyloc(i)
             endif
             if( txloc(i) .NE. xlocpt(i) .OR.
     &                             tyloc(i) .NE. ylocpt(i) ) goto 7004
             if( ipigflg .EQ. IRONPIG .AND. tdiam(i) .LT. 0. ) 
     &           lpigsa(i) = .TRUE.
   80     continue
c
c   --- read the data until the correct position in the file is reached ---
c
  333     continue
          read(iounit,ERR=7002,END=7003) ibgdat, begtim, iendat, endtim
          if( le1day ) then
             if( begtim .EQ. ttime ) goto 444
          else
             if( ibgdat .EQ. ndate .AND. begtim .EQ. ttime ) goto 444
          endif
          read(iounit,ERR=7002) isegm, npoint
          read(iounit,ERR=7002) (idum,idum,idum,dum,dum,i=1,npoint)
          do 90 ispc=1,nspcpt(1,1)
              read(iounit,ERR=7002,END=7003) idum,(dum,i=1,10),
     &                                                (dum,i=1,npoint)
   90     continue
          goto 333
  444     continue
          backspace(iounit)
        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 EMPREPRT:'
      write(iout,'(/,1X,3A)') 'Reading header of ',
     &                     'emissions file: ',fname(:istrln(fname))
      call camxerr()
c
 7002 continue
      write(iout,'(//,A)') 'ERROR in EMPREPRT:'
      write(iout,'(/,1X,2A)') 'Reading emissions grid in file: ',
     &                                        fname(:istrln(fname))
      call camxerr()
c
 7003 continue
      write(iout,'(//,A)') 'ERROR in EMPREPRT:'
      write(iout,'(/,1X,3A)') 'Premature end-of-file reading ',
     &                     'emissions file: ',fname(:istrln(fname))
      call camxerr()
c
 7004 continue
      write(iout,'(//,A)') 'ERROR in EMPREPRT:'
      write(iout,'(1X,A,I10,2A)') 'Location for point: ',i,
     &     ' is not consistent with regular emissions in file: ',
     &                                        fname(:istrln(fname))
      call camxerr()
c
 7005 continue
      write(iout,'(//,A)') 'ERROR in EMPREPRT:'
      write(iout,'(/,1X,3A)') 'Cannot access emissions file',
     &     ' provided for OSAT processing: ',fname(:istrln(fname))
      call camxerr()
c
 7006 continue
      write(iout,'(//,a)') 'ERROR in EMPREPRT:'
      write(iout,'(/,1X,A,I10,2A)') 'Number of points: ',npoint,
     &     ' is not consistent with regular emissions in file: ',
     &                                            fname(:istrln(fname))
      call camxerr()
c
c-----------------------------------------------------------------------
c    Format statements:
c-----------------------------------------------------------------------
c
c-----------------------------------------------------------------------
c    Return point:
c-----------------------------------------------------------------------
c
 9999 continue
c
      return
      end
