      subroutine rdpthdr(begtim,begdate,endtim,enddate)
      use filunit
      use grid
      use chmstry
      use bndary
      use ptemiss
      use tracer
c 
c----CAMx v7Beta6 190902
c 
c     RDPTHDR reads the header of binary point source emissions file,
c     initializes time-invariant point source variables, and maps the point
c     source species list to the internal CAMx species list
c                           
c     Copyright 1996 - 2018
c     Ramboll
c           
c     Modifications: 
c        10/24/01  Removed BSWAP and converted integer strings to character*4
c        11/06/01  Input dates are now Julian
c        02/09/02  Added code to handle end of year dates
c        12/21/13  Added compact point source file
c        12/07/14  Revised for VBS emissions
c        01/08/16  Updated for Revised VBS emissions
c        11/22/17  Added checks for PFE/PMN/PK/PCA/PMG emissions (disabled)
c 
c     Input arguments: 
c        begtim              model start time (HHMM) 
c        begdate             model start date (YYJJJ) 
c        endtim              model end time (HHMM) 
c        enddate             model end date (YYJJJ)
c             
c     Output arguments: 
c             
c     Routines Called: 
c        none
c             
c     Called by: 
c        PNTPREP
c 
      include 'camx.prm'
      include 'flags.inc'
      include 'vbs.inc'
c
      integer begdate
      integer enddate
c
      character*10 ptfil, infil, ptspc, ptcompact
      character*4  ifile(10), note(60)
c
      character*4 ptspec(10,MXSPEC)
c
      logical l_exist_ivoc, l_exist_poa_xx
      integer ifle
c
      integer, parameter :: num_elem = 5
      integer :: idx_elem(num_elem)
      integer, allocatable, dimension(:) :: idxpnt
      integer idx_start
c
      data ptfil /'PTSOURCE  '/
      data ptcompact /'PTSOURCECP'/
c
c-----Entry point
c
c-----Initialize the mapping array ---
c
      do ifle=1,npoint_files
c
c-----skip if this is a NetCDF file ---
c
        if( is_netcdf_iptem(ifle) ) cycle
c
c-----Read 1st PT header record and check inputs 
c             
        rewind(iptem(ifle))
        read(iptem(ifle)) ifile,note,nseg,nptspc(ifle),idat1,tim1,idat2,tim2
        allocate( idxpnt(nptspc(ifle)) )
c
        if(INT(tim2) .EQ. 24) then
          tim2 = 0.
          idat2 = idat2 + 1
          if( MOD(idat2,1000) .GT. 365 ) then
             if( MOD(INT(idat2/1000),4) .EQ. 0 ) then
                if( MOD(idat2,1000) .EQ. 367 ) 
     &                       idat2 = (INT(idat2/1000)+1)*1000 + 1
             else
                idat2 = (INT(idat2/1000)+1)*1000 + 1
             endif
          endif
        endif
        write(infil,'(10a1)') (ifile(n),n=1,10) 
        if (infil.ne.ptfil .AND. infil .ne. ptcompact) then 
          write(iout,'(//,a)') 'ERROR in RDPTHDR:'
          write(iout,*)'PT input file is not labelled PTSOURCE or PTSOURCECP' 
          call camxerr()
        endif   
        tim1 = 100.*tim1
        tim2 = 100.*tim2
        if (idat1.gt.begdate) then 
          write(iout,'(//,a)') 'WARNING in RDPTHDR:'
          write(iout,*)'PT start date > simulation start date' 
          write(iout,*)'  PT file: ',idat1 
          write(iout,*)'Sim start: ',begdate 
          if (.not.le1day) then
            write(iout,*)'CAMx expecting day-specific emissions: Stopping'
            call camxerr()
          endif
        elseif (idat1.eq.begdate .and. tim1.gt.begtim) then 
          write(iout,'(//,a)') 'WARNING in RDPTHDR:'
          write(iout,*)'PT start time > simulation start time' 
          write(iout,*)'  PT file: ',tim1 
          write(iout,*)'Sim start: ',begtim 
          call camxerr()
        elseif (idat2.lt.enddate) then 
          write(iout,'(//,a)') 'WARNING in RDPTHDR:'
          write(iout,*)'PT end date < simulation end date' 
          write(iout,*)'PT file: ',idat2
          write(iout,*)'Sim end: ',enddate 
          if (.not.le1day) then
            write(iout,*)'CAMx expecting day-specific emissions: Stopping'
            call camxerr()
          endif
        elseif (idat2.eq.enddate .and. tim2.lt.endtim) then 
          write(iout,'(//,a)') 'ERROR in RDPTHDR:'
          write(iout,*)'PT end time < simulation end time' 
          write(iout,*)'PT file: ',tim2
          write(iout,*)'Sim end: ',endtim 
          call camxerr()
        endif 
c 
c-----Read 2nd PT header
c 
        read(iptem(ifle)) orgx,orgy,izone,utmx,utmy,dx,dy,nx,ny,nz 
c 
c-----Read 3rd & 4th PT header 
c 
        read(iptem(ifle))
        read(iptem(ifle)) ((ptspec(n,l),n=1,10),l=1,nptspc(ifle)) 
c 
c-----Map PT species to model species 
c 
        if (lvbs .and. LVBSPREPROC) then ! assign fake positive idx to count all the primary VBS spc in
          do l = 0, NVOLBIN
            lemmap(kpap_c(l)) = nptspc(ifle) + 1
            lemmap(kpfp_c(l)) = nptspc(ifle) + 1
          enddo
          l_exist_ivoc   = .false.
          l_exist_poa_xx = .false.
        endif
        do 15 lpt = 1,nptspc(ifle) 
           write(ptspc,'(10a1)') (ptspec(n,lpt),n=1,10) 
           if (ptspc.eq.'HNO2      ') ptspc = 'HONO      '
           if (ptspc.eq.'HCHO      ' .and. kHCHO.eq.nspec+1)
     &                                        ptspc = 'FORM      '
cgwilson           if (lvbs .and. LVBSPREPROC) then
cgwilson             if (ptspc.eq.'IVOA      ' .or.
cgwilson     &        ptspc.eq.'IVOB      ') l_exist_ivoc = .true.
cgwilson             if (ptspc.eq.'POA_OP    ') then
cgwilson               l_exist_poa_xx = .true.
cgwilson               lemmap(kpap_c(0)) = lpt ! temporarily assign to PAP0
cgwilson               write(idiag,'(a,i5,2x,2a)') 'Point source species ',
cgwilson     &           lpt,ptspc,' mapped to model species PAP0-PAP5 (VBS)'
cgwilson               goto 15
cgwilson             endif
cgwilson             if (ptspc.eq.'POA_BB    ') then
cgwilson               l_exist_poa_xx = .true.
cgwilson               lemmap(kpfp_c(0)) = lpt ! temporarily assign to PFP0
cgwilson               write(idiag,'(a,i5,2x,2a)') 'Point source species ',
cgwilson     &           lpt,ptspc,' mapped to model species PFP0-PFP5 (VBS)'
cgwilson               goto 15
cgwilson             endif
cgwilson           endif
c
c  --- check if species is not modelled ---
   
           idxpnt(lpt) = 0
           do 20 l = 1,nspec 
             if (ptspc.eq.spname(l)) then 
               idxpnt(lpt) = l
               write(idiag,'(2(a,i5,2x,a))')
     &                   'Point source species ',lpt,ptspc, 
     &                   ' mapped to model species ',l,spname(l) 
               goto 15 
             endif 
 20        continue
           write(idiag,*)'PT species: ',ptspc,' not modeled'
 15      continue 
c
c----Find this species in master list ---
c
         do lpt=1,nptspc(ifle)
           idxpnt_files(ifle,lpt) = 0
           if( idxpnt(lpt) .LE. 0 ) cycle
           write(ptspc,'(10a1)') (ptspec(n,lpt),n=1,10) 
           do k=1,nemspc
              if(ptspc .EQ. emspcname(k) ) then
                  idxpnt_files(ifle,lpt) = k
              endif
            enddo
            if( idxpnt_files(ifle,lpt) .EQ. 0 ) then
              nemspc = nemspc + 1
              emspcname(nemspc) = ptspc
              idxpnt_files(ifle,lpt) = nemspc
            endif
            lemmap(idxpnt(lpt)) = idxpnt_files(ifle,lpt) 
         enddo
c
cgwilson         if (lvbs .and. LVBSPREPROC) then
cgwilson           if ( .not.l_exist_ivoc .or. .not.l_exist_poa_xx ) then
cgwilson             write(iout,'(//,a)') 'ERROR in RDPTHDR:'
cgwilson             write(iout,'(2A)')'Point source species are not compatible',
cgwilson     &                      ' with VBS.'
cgwilson             write(iout,'(2A)')'VBS requires IVOC and sector-specific',
cgwilson     &                      ' POA emissions.'
cgwilson             call camxerr()
cgwilson           endif
cgwilson         endif
c
c-----Read time invariant data (assume nseg=1)
c     check number of sources against max 
c
         read(iptem(ifle)) idum,nptsrc_files(ifle)
         if( allocated(idxpnt) ) deallocate( idxpnt )
      enddo
c
c-----Allocate the arrays ---
c
      allocate( xloc(nptsrc) )
      allocate( yloc(nptsrc) )
c
c----Call routine to allocate the arrays 
c
      call alloc_ptemiss(nspec,ngrid,nptsrc)
c
c  --- read rest of each file ---
c
      do ifle=1,npoint_files
c
c-----skip if this is a NerCDF file ---
c
         if( is_netcdf_iptem(ifle) ) cycle
         idx_start = idx_start_pts(ifle)
         read(iptem(ifle)) (xloc(n),yloc(n),hstk(n),dstk(n),tstk(n),
     &                     vstk(n),n=idx_start+1,idx_start+nptsrc_files(ifle))
         do 30 n = idx_start+1,idx_start+nptsrc_files(ifle)
           if (dstk(n).lt.0.) then
             lpiglet(n) = .true.
c            dstk(n) = -dstk(n)
           else
             lpiglet(n) = .false.
           endif
           vstk(n) = vstk(n)/3600.
c
c========================= Source Apportion End ========================
c
  30     continue
      enddo
      write(idiag,*)
c
      return
      end
