       PROGRAM qaelev
C
      PARAMETER (MAXP=400000)
      CHARACTER*4  IFILE(10), NOTE(60), MSPEC(10,130)
      CHARACTER*4  SPNAME(10,130)
      character*10 cspec
      DIMENSION EMISS(400000,130)
      REAL*4     DUMX(MAXP),DUMY(MAXP),IDUMX(MAXP),IDUMY(MAXP)
      REAL*4     DUMXX(MAXP),DUMYY(MAXP),
     $ FLOW(MAXP),PLUMHT(MAXP)
      INTEGER  ICELL(MAXP),JCELL(MAXP),KCELL(MAXP)
      common/scale/facnox,facso2,facvoc,facpm

      REAL sum(90),HRLY(90,25),nsum(90)
      REAL sumsp(290,290,90),ping(290,290)
      REAL sumsox(290,290),ammonia(290,290)
      REAL fine(290,290),coar(290,290),pec(290,290)
      REAL sumnox(290,290),sumrhc(290,290),poa(290,290)
      REAL noxsum,qsum,rhcsum,psum,osum
      REAL rsum,ssum,pasum,pbsum,layer(30,200,25)
      integer l,hr
      character*1 comma
      character*2 hrh
      character*4 nox(10),rhc(10),zco(7)
      character*80 header,head2
      character*180 filnam,fil2
      character*4 zname(10),pcsum(10),pfsum(10),nosum(10)
      character*4 rhsum(10),pingn(10),amsum(10),sosum(10)
      character*4 ppec(10),ppoa(10)
      data nox/'N','O','X',' ',' ',' ',' ',' ',' ',' '/
      data rhc/'R','H','C',' ',' ',' ',' ',' ',' ',' '/
      data zco/'-','-','-','-','-','-','-'/
      data comma/','/
      data zname/'A','V','E','R','A','G','E',' ',' ',' '/
      data pcsum/'P','M','C','S','U','M',' ',' ',' ',' '/
      data pfsum/'P','M','F','S','U','M',' ',' ',' ',' '/
      data nosum/'N','O','X','S','U','M',' ',' ',' ',' '/
      data rhsum/'R','H','C','S','U','M',' ',' ',' ',' '/
      data sosum/'S','O','X','S','U','M',' ',' ',' ',' '/
      data amsum/'N','H','3','S','U','M',' ',' ',' ',' '/
      data pingn/'P','I','G','S','U','M',' ',' ',' ',' '/
      data ppoa/'P','O','A','S','U','M',' ',' ',' ',' '/
      data ppec/'P','E','C','S','U','M',' ',' ',' ',' '/
      data zero /0./
      data ione /1/
      data izero /0/
C
      write(*,*)'enter the name of input file'
      read(*,'(a160)')filnam
      OPEN (7,FILE=filnam,FORM='UNFORMATTED',STATUS='OLD')
      write(*,*)'enter the name of output totals file'
      read(*,'(a160)')fil2
      OPEN (9,FILE=fil2,FORM='FORMATTED',STATUS='UNKNOWN')
      write(*,*)'enter the name of output hourly file'
      read(*,'(a160)')fil2
      OPEN (10,FILE=fil2,FORM='FORMATTED',STATUS='UNKNOWN')
      write(*,*)'enter the name of output PAVE file'
      read(*,'(a160)')fil2
      open(8,file=fil2,form='unformatted',status='unknown')

      IOUT=6
C
C   READ AND WRITE OUT FILE HEADER INFORMATION
C
      IDONE=1
      READ (7) IFILE,NOTE,NSEG,NSPECS,IDATE,BEGTIM,JDATE,ENDTIM
      WRITE (IOUT,1007) IDATE, BEGTIM, JDATE, ENDTIM
      READ  (7) ORGX,ORGY,IZONE,UTMX,UTMY,DELTAX,DELTAY,NX,NY,
     $ NZ,NZLOWR,NZUPPR,HTSUR,HTLOW,HTUPP
      write(*,*)'SEGMENTS=',NSEG
      IF (NSEG.EQ.0) GO TO 11
C  SEGMENT ORIGIN AND SEGMENT SIZE
      DO 10 I=1,NSEG
      READ  (7) IX,IY,NXCLL,NYCLL
      WRITE (IOUT,1002) IX,IY,NXCLL,NYCLL
  10  CONTINUE
  11  CONTINUE
      IF (NSPECS.LE.0) GO TO 21
C  NAMES OF ALL SPECIES PRESENT
      READ  (7) ((SPNAME(I,J),I=1,10),J=1,NSPECS)
      write  (*,'(10a1)') ((SPNAME(I,J),I=1,10),J=1,NSPECS)
  21  CONTINUE
c
      IF (NSEG.LE.0) GO TO 131
C
C  TIME INVARIANT DATA
C
      DO 130 I=1,NSEG
         READ (7) ISEGM,NPMAX
         write(*,*)'npmax is ',npmax
         IF (NPMAX.LE.0) GO TO 125
C
C  FOR EACH POINT SOURCE LOCATION AND STACK PARAMETERS
C
         write(*,*)'Read over stack parameters'
         READ (7) (DUMX(II),DUMY(II),IDUMX(II),IDUMY(II),
     &        DUMXX(II),DUMYY(II),II=1,NPMAX)
C
 125     CONTINUE
 130  CONTINUE
 131  CONTINUE
C
c         do II=1,NPMAX
c         write(14,889)II,DUMX(II),DUMY(II),IDUMX(II),IDUMY(II),
c     &        DUMXX(II),DUMYY(II)
c         enddo

 889     format(i5,1x,f20.3,1x,f20.3,f6.2,f6.2,1x,f6.2,1x,f6.2)

c----- Conversion factors

      cfac = 1./1000.
      cfac2 = .001102293

c----- Zero out sum arrays

      qsum=0.
      rsum=0.
      ssum=0.

      do l = 1,nspecs
       do hr = 1,24
        HRLY(l,hr)=0.
        do i=1,20
        layer(i,l,hr)=0.
        enddo
       enddo
      enddo

      do l = 1,nspecs
       do i = 1, nx
        do j = 1, ny
         sumsp(i,j,l) = 0.
        enddo
       enddo
      enddo

      do i = 1, nx
       do j = 1, ny
        fine(i,j)=0.
        coar(i,j)=0.
        sumnox(i,j)=0.
        sumrhc(i,j)=0.
        sumsox(i,j)=0.
        ammonia(i,j)=0.
        ping(i,j)=0.
       enddo
      enddo
c

c-----Write UAM-file header
c
      write(*,*)orgx,orgy,utmx,utmy,deltax,deltay

      nspec = 9
      write(8) zname,note,ione,nspec,idate,float(0),jdate,
     &          float(1)
      write(8) orgx,orgy,izero,utmx,utmy,deltax,
     &          deltay,nx,ny,ione,izero,izero,zero,zero,zero
      write(8) izero,izero,nx,ny
      write(8) pcsum,pfsum,nosum,rhsum,sosum,amsum,pingn,
     &           ppoa,ppec
C
C---------------------------------------------
C    LARGE LOOP FOR 24 HOURS OF PT SOURCE DATA
C
      write(*,*)'Starting to loop over hours'

      DO 1000 IH = 1,24
          READ  (7,END=999) IBGDAT, BEGTIM, IENDAT, ENDTIM
          WRITE(IOUT,1007) IBGDAT,BEGTIM,IENDAT,ENDTIM,IH
C
C    NOW GO THROUGH NUMBER OF SEGMENTS
C
      write(*,*)'Going through number of segments'
          IF (NSEG.LE.0) GO TO 1000
          READ (7) ISEGNM,NUMPTS
          IF (NUMPTS.LE.0) GO TO 999
          READ(7) (ICELL(II),JCELL(II),KCELL(II),FLOW(II),
     &         PLUMHT(II),II=1,NUMPTS)

c          if(IH.eq.1) then
c          do II = 1, NUMPTS
c         write(14,888)IH,II,ICELL(II),JCELL(II),KCELL(II),FLOW(II),PLUMHT(II)
c          enddo
c          endif

 888      format(i3,1x,i5,1x,i3,1x,i3,1x,i4,1x,f5.2,1x,f20.3)

          IF (NSPECS.LE.0) GO TO 999
      write(*,*)'Reading emissions'
          DO 380 l=1,NSPECS
             READ (7) ISEGNM,(MSPEC(II,l),II=1,10),(EMISS(II,l),
     &            II=1,NUMPTS)
             do II = 1, NUMPTS
                   sum(l)=sum(l)+EMISS(II,l)
                   HRLY(l,IH)=HRLY(l,IH)+EMISS(II,l)
                   i=1+((DUMX(II)-UTMX)/DELTAX)
                   j=1+((DUMY(II)-UTMY)/DELTAY)
C                   write(*,*)i,j
c                   if (i.lt.1.or.i.gt.nx.or.j.lt.1.or.j.gt.ny) then 
c                    write(*,*)'Outsite grid, dropping emissions'
c              write(*,*)'I,J,X,Y -> ',i,j,DUMX(II),DUMY(II),UTMX,UTMY
c                   else
                   sumsp(i,j,l)=sumsp(i,j,l)+EMISS(II,l)
             layer((KCELL(II)),l,IH)=layer((KCELL(II)),l,IH)+EMISS(II,l)
                    if (IDUMY(II).lt.0) then
                    ping(i,j)=ping(i,j)+(EMISS(II,l)*46.*cfac)
                    endif
c                   endif
             enddo
 380      CONTINUE

 1000  CONTINUE

  999 header = 'Species          gmoles/day       kg/day       tons/day'
      head2  = 'Species             Hour    g-moles/hr'
      hrh    = 'HR'
      write(9,2002)filnam
      write(9,2002)"       "
      write(9,2002)header
 2002 format(80a)

      do l =1,nspecs

      write(cspec,'(10a1)') (MSPEC(i,L),i=1,10)

       if (cspec .eq. 'NO        ') nsum(l)=sum(l)*30.*cfac  
       if (cspec .eq. 'NO2       ') nsum(l)=sum(l)*46.*cfac
       if (cspec .eq. 'SO2       ') nsum(l)=sum(l)*64.*cfac
       if (cspec .eq. 'CO        ') nsum(l)=sum(l)*28.*cfac
       if (cspec .eq. 'NH3       ') nsum(l)=sum(l)*17.*cfac
       if (cspec .eq. 'TERPB     ') nsum(l)=sum(l)*56.*cfac
       if (cspec .eq. 'TERP      ') nsum(l)=sum(l)*56.*cfac

       if (cspec .eq. 'ALD2      ') nsum(l)=sum(l)*32.*cfac
       if (cspec .eq. 'ETH       ') nsum(l)=sum(l)*32.*cfac
       if (cspec .eq. 'ALDX      ') nsum(l)=sum(l)*32.*cfac
       if (cspec .eq. 'ETHA      ') nsum(l)=sum(l)*32.*cfac
       if (cspec .eq. 'FORM      ') nsum(l)=sum(l)*16.*cfac
       if (cspec .eq. 'HCHO      ') nsum(l)=sum(l)*16.*cfac
       if (cspec .eq. 'ISOP      ') nsum(l)=sum(l)*80.*cfac 
       if (cspec .eq. 'MEOH      ') nsum(l)=sum(l)*16.*cfac
       if (cspec .eq. 'NR        ') nsum(l)=sum(l)*16.*cfac
       if (cspec .eq. 'UNR       ') nsum(l)=sum(l)*16.*cfac
       if (cspec .eq. 'CH4       ') nsum(l)=sum(l)*16.*cfac
       if (cspec .eq. 'OLE       ') nsum(l)=sum(l)*32.*cfac
       if (cspec .eq. 'IOLE      ') nsum(l)=sum(l)*32.*cfac
       if (cspec .eq. 'OLE2      ') nsum(l)=sum(l)*32.*cfac
       if (cspec .eq. 'PAR       ') nsum(l)=sum(l)*16.*cfac
       if (cspec .eq. 'ETOH      ') nsum(l)=sum(l)*32.*cfac
       if (cspec .eq. 'TOL       ') nsum(l)=sum(l)*112.*cfac
       if (cspec .eq. 'XYL       ') nsum(l)=sum(l)*128.*cfac
       if (cspec .eq. 'MTBE      ') nsum(l)=sum(l)*30.*cfac

       if (cspec .eq. 'NO        ') osum=sum(l)*46.*cfac 
       if (cspec .eq. 'NO2       ') psum=sum(l)*46.*cfac

        if (cspec .eq. 'AERO      '.or.
     &      cspec .eq. 'PM10      '.or.
     &      cspec .eq. 'PM25      '.or.
     &      cspec .eq. 'SULF      '.or.
     &      cspec .eq. 'PMF       '.or.
     &      cspec .eq. 'PEC       '.or.
     &      cspec .eq. 'PNO3      '.or.
     &      cspec .eq. 'PSO4      '.or.
     &      cspec .eq. 'POA       '.or.
     &      cspec .eq. 'PSO4      '.or.
     &      cspec .eq. 'PMCOARS   '.or.
     &      cspec .eq. 'PMFINE    '.or.
     &      cspec .eq. 'FCRS      '.or.
     &      cspec .eq. 'GSO4      '.or.
     &      cspec .eq. 'FPRM      '.or.
     &      cspec .eq. 'CPRM      '.or.
     &      cspec .eq. 'CCRS      '.or.
     &      cspec .eq. 'PMC       ') then
          nsum(l)=sum(l)*1.*cfac
          else
          endif           

        if (cspec .eq. 'PM10      '.or.
     &      cspec .eq. 'PMCOARS   '.or.
     &      cspec .eq. 'CPRM      '.or.
     &      cspec .eq. 'CCRS      '.or.
     &      cspec .eq. 'PMC       ') then
          rsum=rsum+sum(l)*1.*cfac
          else
          endif          

        if (cspec .eq. 'PM25      '.or.
     &      cspec .eq. 'PMF       '.or.
     &      cspec .eq. 'PEC       '.or.
     &      cspec .eq. 'PNO3      '.or.
     &      cspec .eq. 'PSO4      '.or.
     &      cspec .eq. 'POA       '.or.
     &      cspec .eq. 'PSO4      '.or.
     &      cspec .eq. 'PMFINE    '.or.
     &      cspec .eq. 'FCRS      '.or.
     &      cspec .eq. 'GSO4      '.or.
     &      cspec .eq. 'FPRM      ') then
          ssum=ssum+sum(l)*1.*cfac
          else
          endif          

       if (cspec .eq. 'ALD2      ') qsum=qsum+2.*sum(l)*16.*cfac
       if (cspec .eq. 'ETH       ') qsum=qsum+2.*sum(l)*16.*cfac
       if (cspec .eq. 'ALDX      ') qsum=qsum+2.*sum(l)*16.*cfac
       if (cspec .eq. 'ETHA      ') qsum=qsum+2.*sum(l)*16.*cfac
       if (cspec .eq. 'FORM      ') qsum=qsum+1.*sum(l)*16.*cfac
       if (cspec .eq. 'HCHO      ') qsum=qsum+1.*sum(l)*16.*cfac
       if (cspec .eq. 'ISOP      ') qsum=qsum+5.*sum(l)*16.*cfac
       if (cspec .eq. 'MEOH      ') qsum=qsum+1.*sum(l)*16.*cfac
       if (cspec .eq. 'OLE       ') qsum=qsum+2.*sum(l)*16.*cfac
       if (cspec .eq. 'OLE2      ') qsum=qsum+2.*sum(l)*16.*cfac
       if (cspec .eq. 'IOLE      ') qsum=qsum+2.*sum(l)*16.*cfac
       if (cspec .eq. 'PAR       ') qsum=qsum+1.*sum(l)*16.*cfac
       if (cspec .eq. 'ETOH      ') qsum=qsum+2.*sum(l)*16.*cfac
       if (cspec .eq. 'TOL       ') qsum=qsum+7.*sum(l)*16.*cfac
       if (cspec .eq. 'XYL       ') qsum=qsum+8.*sum(l)*16.*cfac
       if (cspec .eq. 'MTBE      ') qsum=qsum+5.*sum(l)*16.*cfac

         write(9,1001)(mspec(m,l),m=1,10),sum(l),nsum(l),
     &     (nsum(l)*cfac2)
c          do n = 1,24
c         write(17,908) n,(mspec(m,l),m=1,10),(layer(k,l,n),k=1,NZ)
c          enddo
      enddo

 908  format(i3,1x,10a1,20(1x,f15.1))

         noxsum = osum + psum
         rhcsum = qsum
         pasum = rsum
         pbsum = ssum

         write(9,2002)zco,zco

         write(9,1001)(nox(m),m=1,10),a,noxsum,(noxsum*cfac2)
         write(9,1001)(rhc(m),m=1,10),a,rhcsum,(rhcsum*cfac2)
         write(9,1001)(pcsum(m),m=1,10),a,pasum,(pasum*cfac2)
         write(9,1001)(pfsum(m),m=1,10),a,pbsum,(pbsum*cfac2)

         write(10,2002)filnam
         write(10,1300)hrh,(comma,(mspec(m,l),m=1,10),l=1,nspecs)

          do hr=1,24
         write(10,1301)hr,(comma,HRLY(l,hr),l=1,nspecs)
          enddo

C       do l=1,nspecs
        do i=1,nx
         do j=1,ny
          do l=1,nspecs

      write(cspec,'(10a1)') (MSPEC(m,L),m=1,10)

       if (cspec .eq. 'SO2       ') sumsox(i,j)=sumsox(i,j)+
     &   sumsp(i,j,l)*64.*cfac

       if (cspec .eq. 'NH3       ') ammonia(i,j)=ammonia(i,j)+
     &   sumsp(i,j,l)*17.*cfac

       if (cspec .eq. 'POA       ') poa(i,j)=poa(i,j)+
     &   sumsp(i,j,l)*1.*cfac
       if (cspec .eq. 'PEC       ') pec(i,j)=pec(i,j)+
     &   sumsp(i,j,l)*1.*cfac

       if (cspec .eq. 'NO        ') sumnox(i,j)=sumnox(i,j)+
     &   sumsp(i,j,l)*46.*cfac
       if (cspec .eq. 'NO2       ') sumnox(i,j)=sumnox(i,j)+
     &   sumsp(i,j,l)*46.*cfac

       if (cspec .eq. 'ALD2      ') sumrhc(i,j)=sumrhc(i,j)+
     &   sumsp(i,j,l)*32.*cfac
       if (cspec .eq. 'ETH       ') sumrhc(i,j)=sumrhc(i,j)+
     &   sumsp(i,j,l)*32.*cfac
       if (cspec .eq. 'ALDX      ') sumrhc(i,j)=sumrhc(i,j)+
     &   sumsp(i,j,l)*32.*cfac
       if (cspec .eq. 'ETHA      ') sumrhc(i,j)=sumrhc(i,j)+
     &   sumsp(i,j,l)*32.*cfac
       if (cspec .eq. 'FORM      ') sumrhc(i,j)=sumrhc(i,j)+
     &   sumsp(i,j,l)*16.*cfac
       if (cspec .eq. 'HCHO      ') sumrhc(i,j)=sumrhc(i,j)+
     &   sumsp(i,j,l)*16.*cfac
       if (cspec .eq. 'ISOP      ') sumrhc(i,j)=sumrhc(i,j)+
     &   sumsp(i,j,l)*80.*cfac
       if (cspec .eq. 'MEOH      ') sumrhc(i,j)=sumrhc(i,j)+
     &   sumsp(i,j,l)*16.*cfac
       if (cspec .eq. 'NR        ') sumrhc(i,j)=sumrhc(i,j)+
     &   sumsp(i,j,l)*1.*cfac
       if (cspec .eq. 'UNR       ') sumrhc(i,j)=sumrhc(i,j)+
     &   sumsp(i,j,l)*1.*cfac
       if (cspec .eq. 'CH4       ') sumrhc(i,j)=sumrhc(i,j)+
     &   sumsp(i,j,l)*1.*cfac
       if (cspec .eq. 'OLE       ') sumrhc(i,j)=sumrhc(i,j)+
     &   sumsp(i,j,l)*32.*cfac
       if (cspec .eq. 'OLE2      ') sumrhc(i,j)=sumrhc(i,j)+
     &   sumsp(i,j,l)*32.*cfac
       if (cspec .eq. 'IOLE      ') sumrhc(i,j)=sumrhc(i,j)+
     &   sumsp(i,j,l)*32.*cfac
       if (cspec .eq. 'PAR       ') sumrhc(i,j)=sumrhc(i,j)+
     &   sumsp(i,j,l)*16.*cfac
       if (cspec .eq. 'ETOH      ') sumrhc(i,j)=sumrhc(i,j)+
     &   sumsp(i,j,l)*32.*cfac
       if (cspec .eq. 'TOL       ') sumrhc(i,j)=sumrhc(i,j)+
     &   sumsp(i,j,l)*112.*cfac
       if (cspec .eq. 'XYL       ') sumrhc(i,j)=sumrhc(i,j)+
     &   sumsp(i,j,l)*128.*cfac
       if (cspec .eq. 'MTBE      ') sumrhc(i,j)=sumrhc(i,j)+
     &   sumsp(i,j,l)*30.*cfac

        if (cspec .eq. 'PM10      '.or.
     &      cspec .eq. 'PMCOARS   '.or.
     &      cspec .eq. 'CPRM      '.or.
     &      cspec .eq. 'CCRS      '.or.
     &      cspec .eq. 'PMC       ') then
          coar(i,j)=coar(i,j)+sumsp(i,j,l)*1.*cfac
          else
          endif         

        if (cspec .eq. 'PM25      '.or.
     &      cspec .eq. 'PMF       '.or.
     &      cspec .eq. 'PEC       '.or.
     &      cspec .eq. 'PNO3      '.or.
     &      cspec .eq. 'PSO4      '.or.
     &      cspec .eq. 'POA       '.or.
     &      cspec .eq. 'PSO4      '.or.
     &      cspec .eq. 'PMFINE    '.or.
     &      cspec .eq. 'FCRS      '.or.
     &      cspec .eq. 'GSO4      '.or.
     &      cspec .eq. 'FPRM      ') then
          fine(i,j)=fine(i,j)+sumsp(i,j,l)*1.*cfac
          else
          endif

         enddo
        enddo
       enddo

        write(*,*)'Writing data at ',ibgdat,begtim
        write(8) ibgdat,float(0),ibgdat,float(1) 
        write(8) ione,pcsum,((coar(i,j),i=1,nx),j=1,ny)        
        write(8) ione,pfsum,((fine(i,j),i=1,nx),j=1,ny)
        write(8) ione,nosum,((sumnox(i,j),i=1,nx),j=1,ny)
        write(8) ione,rhsum,((sumrhc(i,j),i=1,nx),j=1,ny)
        write(8) ione,sosum,((sumsox(i,j),i=1,nx),j=1,ny)
        write(8) ione,amsum,((ammonia(i,j),i=1,nx),j=1,ny)
        write(8) ione,pingn,((ping(i,j),i=1,nx),j=1,ny)
        write(8) ione,ppoa,((poa(i,j),i=1,nx),j=1,ny)
        write(8) ione,ppec,((pec(i,j),i=1,nx),j=1,ny)

 1001 format(10a1,3f15.0)
 1009 format(10a1)
 1300 format(a2,50(a1,10a1))
 1301 format(i10,25(a,f10.0))
 1002 FORMAT(4I5)
 1003 FORMAT(10A1)
 1004 FORMAT(4I10)
 1005 FORMAT(6D20.7)
 1006 FORMAT(10A1,E18.9)
 1007 FORMAT(2(I10,F10.2),I10)
 1008 FORMAT(3I12,2E18.9)
 1010 FORMAT(9E14.9)
 1013 FORMAT(1X,10A1)
 1021 FORMAT(2I10)
 2001 FORMAT(F10.1,1X,F10.1,1X,I3,F10.1,1X,F10.1,1X,2F6.0,5I4,3F7.0)
 2100 FORMAT(10A1,60A1,/,I2,1X,I2,1X,I6,F6.0,I6,F6.0)
9999  stop
      END
