c     program leadpost
c     This program reads AERMOD monthly output and calculates
c     a rolling 3-month average for each receptor and source group
c     in the model output.
c     Rolling 3-month averages are calculated for the period modeled in AERMOD
c     and are not tied to the 3-year period as required for modeling
c     AERMOD concentrations
c
c     AERMOD output can be input into the program by two methods:
c     1) AERMOD monthly POSTFILE or POSTFILES
c       this can be one file or several
c     2) user supplied text file or files
c
c     version 13262 September 18, 2013
c     corrected do while loop in subroutine summary, see line 2186
c     variable in do while loop was originally g1 and reset to g3
c     version 12114 April 23, 2012
c     added option to allow user to output monthly contributions to
c     3-month average concentrations
c     program will output monthly contributions in the summary file
c     and output window
c     added checks on input dates and prompts to re-prompt user for inputs if entered
c     values are badly formatted
c     version 11237 August 25, 2011
c     changed output format of concentrations to exponential format
c     similar to that of AERMOD exponential format
c     to retain all decimal places
c     version 11096 April 6, 2011
c     updated output file to remove reference to no background concentrations
c     as new AERMOD will allow background concentrations
c     version 09152 June 1, 2009
c     correct receptor number check for user created files with only one source group
c
c     version 09096 April 6, 2009
c     change output format for rolling 3-month averages, maximum rolling 3-month averages,
c     and overall maximum rolling 3-month average from 2 places past the decimal to 3 places.
c
c     version 09041 February 23, 2009
c     original version
c     Programmer:  James Thurman EPA/OAQPS/AQAD/AQMG
c***********************************************************************************************

c***********************************************************************************************
c     module of variables to be used throughout program

      module main1
      implicit none

c startyr (integer):        first year of modeled period and is entered by user
c startyr2 (integer):       last 2 digits of startyr
c startmon (integer):       first month of first year being modeled and is entered by user
c endyr (integer):          last year of modeled period
c endmon (integer):         last month of last year being modeled and is entered by user
c endyr2 (integer):         last 2 digits of endyr
c maxrec (integer):         array index of maximum concentration receptor
c maxdate (integer):        array of the maximum concentration's dates (nrec)
c inunit (integer):         file unit of input monthly concentrations directly from AERMOD or user-supplied file(12)
c outunit1 (integer):       file unit of output 3-monthly concentrations (13)
c maxunit (integer):        file unit of max 3-month concentration by receptor (14)
c maxrec (integer):         Receptor number corresponding to location of overall maximum rolling 3-month
c                           concentration (1 dimensional array with one element)
c inpfil (integer):         file unit of inputfiles.txt, a file containing the name(s) of AERMOD output (11)
c nfiles (integer):         number of AERMOD output files
c ilog (integer):           file unit of LEADPOST log file. log file is named lead.log  (15)
c idate (integer):          1D array of months with year (max dimension is nmonth) 
c maxdate:                  Array of dates of maximum 3-month concentration for each receptor
c maxgrp:                   Group # of maximum 3-month concentration for each receptor  
c years:                    Array of 2 digit years for the period
c nyears:                   # of years modeled 
c isum:                     file unit of summary file
      integer nrec,ngrp,nmonth,startyr,startyr2,startmon,endmon,
     +  endyr,endyr2,inunit,outunit1,maxunit,maxrec(1),inpfil,nfiles,
     +  ilog,nyears,isum
     
      integer, allocatable, dimension(:) :: idate
      integer, allocatable, dimension(:) :: maxdate
      integer, allocatable, dimension(:) :: maxgrp
      integer, allocatable, dimension(:) :: years
c laermod (logical):        logical variable denoting if AERMOD POSTFILES being read 
c ltext (logical):          logical variable denoting if AERMOD output is a simple text file (ltext=true)
c lall:                     Source group ALL is present in AERMOD output.  
c                           If lall is true, then ALL is assumed to be total concentration (all sources) group
c ltotgrp:                  logical variable denoting that another group other than ALL is the total group
c                           is set to true only if ALL is not found in AERMOD output and the group is in the AERMOD output
c lcalcgrp:                 logical variable denoting that the designated total group is not present and will be calculated 
c                           is only true if lall and ltotgrp are both false.
c lnewgrp:                  logical variable denonting that source group in file is not in source group array
c lmissall: logical variable denoting that total source group has missing concentrations
c           this is only used when total group is already present in output 
c lmonthly:  Output monthly contributions to rolling 3-month averages (true)
      logical laermod,ltext,lall,lcalcgrp,ltotgrp,lnewgrp,lmissall,
     + lmonthly
 
c infillist (character):    name of file containing the name or names of AERMOD output files (inputfiles.txt)
c infile (character):       array of filename(s) of concentration file(s).
c outfile3 (character):     output file of 3-monthly average concentrations
c maxfile (character):      output file of maximum 3 month average concentrations
c months (character):       array of month names
c grp (character):          array of source group identifiers 
c groupall:                 Group corresponding to name of total source group
c versn:                    LEADPOST version # (2 digit year and 3-digit Julian day)  
      character infile*250,outfile3*250,maxfile*250,infillist*14,
     +  months(12)*10,grp*8,groupall*8,grpsrt*8,versn*5


      allocatable :: grp(:)
      allocatable :: grpsrt(:)
      allocatable :: infile(:)     
      
c xrec (real) :             one dimensional array of receptor x-coordinates
c yrec (real) :             one dimensional array of receptor y-coordinates
c zelev:                    one dimensional array of receptor elevations
c zhill:                    one dimensional array of receptor hill height scales
c zflag:                    one dimensional array of receptor flagpole heights
c mconc (real):             array of monthly concentrations of dimension nrec x x ngrp x nmonth
c conc3 (real):             array of 3 month average concentrations calculated from mconc
c                           of dimension nrec x mmonth-2
c maxconc (real):           array of maximum 3 month average concentrations by receptor
c                           of dimension nrec
c maxall (real):            overall maximum 3 month average concentration across all receptors 
      real maxall
      real, allocatable, dimension (:) :: xrec
      real, allocatable, dimension (:) :: yrec
      real, allocatable, dimension(:) :: zelev
      real, allocatable, dimension(:) :: zhill
      real, allocatable, dimension(:) :: zflag
      real, allocatable, dimension(:) :: concsrt
      real, allocatable, dimension(:,:,:) :: mconc
      real, allocatable, dimension(:,:,:) :: conc3
      real, allocatable, dimension(:) :: maxconc
      
c     assign month names to months array
      data months /'January','February','March','April','May','June',
     +  'July','August','September','October','November','December'/

c     assign file unit numbers, infillist, and version number
      parameter (inpfil=11,inunit=12,outunit1=13,maxunit=14,
     + ilog=15,isum=16)
!      parameter(infillist='inputfiles.txt',versn='11096')
!      parameter(infillist='inputfiles.txt',versn='11237')
c      parameter(infillist='inputfiles.txt',versn='12114')
      parameter(infillist='inputfiles.txt',versn='13262')
      end module main1
c***********************************************************************   
c     begin main program   
      program leadpost
      use main1
      
c     open log file
      open(unit=ilog,file='lead.log',status='unknown')  
                
c     begin processing

c     get start date and time
      call datetime(1)
      
c     get user inputs

      call userinp
      
      if (laermod) then
        call readpost
      else
        call readtext
      endif

c     check to make sure all dates in the model output
c     range have been processed
      call checkdates

c     calculate rolling 3 month averages
      call calcavg

c     write output files and overall maximum to screen
      call summary

c     write ending date and time
      call datetime(2)
      close(ilog)

      end
c*********************************************************************************
      subroutine datetime(iflag)
c subroutine to write starting and ending times to screen and log file
c subroutine calls the intrinsic FORTRAN subroutine date_and_time
c inputs are iflag which tells the subroutine if the program starts (iflag=1)
c or ends (iflag not equal to 1)

c variables
c iflag:    integer denoting if it is program start time (iflag=1) or end time (2)
c idattim:  array of date/time returned by date_and_time with 8 elements
c           elements are:
c           (1) 4-digit year
c           (2) month of year (1 to 12)
c           (3) day of month
c           (4) time difference with respect to GMT in minutes
c           (5) hour of day (0 to 23) in local time
c           (6) minute of time
c           (7) second of time
c           (8) milliseconds of time
c hr:       integer hour of day
c cdate:    character variable of date
c ctime:    character variable of time
c czone:    character variable of time zone from GMT
c ampm:     character variable with value of 'AM' or 'PM'     
    
      use main1
      implicit none
      integer iflag,idattim(8),hr
      character cdate*8,ctime*10,czone*5,ampm*2
      
      call date_and_time(cdate,ctime,czone,idattim)
      
      if (idattim(5) .le. 12) then
        hr=idattim(5)
        ampm='AM'
      else
        hr=idattim(5)-12
        ampm='PM'
      endif
c program starting      
      if (iflag .eq. 1) then 
        write(*,10)versn,trim(adjustl(months(idattim(2)))),idattim(3),
     + idattim(1),hr,idattim(6),idattim(7),ampm
        write(ilog,10)versn,trim(adjustl(months(idattim(2)))),
     + idattim(3),idattim(1),hr,idattim(6),idattim(7),ampm
c program ending
      else
        write(*,15)trim(adjustl(months(idattim(2)))),idattim(3),
     + idattim(1),hr,idattim(6),idattim(7),ampm
        write(ilog,15)trim(adjustl(months(idattim(2)))),idattim(3),
     + idattim(1),hr,idattim(6),idattim(7),ampm
      endif
 10   format(1x,'LEADPOST VERSION ',a5/1x,'Program start date & time: ',
     +  a,1x,i2.2,', ',i4,2x,i2,':',i2.2,':',i2.2,1x,a2)
 15   format(/1x,'Program end date & time: ',a,1x,i2.2,', ',i4,2x,i2,
     +  ':',i2.2,':',i2.2,1x,a2)
      return
      end
c*********************************************************************************
      subroutine userinp
c subroutine to get user inputs
c     this subroutine gets various user inputs, such as filenames and formats
c variables
c answer:       character variable of answer to type of input file 
c inexist:      logical variable denoting if inputfiles.txt exists

      use main1
      implicit none
      integer i,ii,ifield,i1,k,startdate,enddate,nmonth1
      character answer*1,amon1*15,ayr1*15,amon2*15,ayr2*15,response*15,
     + str(4)*12,astr*250,fields(4)*15,str1*15
      logical inexist,lblank1(4),lbaddate(4),lprompt,l1,lwarn,lblank,
     + lbad1
      
      str(1)='Start month'
      str(2)='Start year'
      str(3)='End month'
      str(4)='End year'
c     initialize inexist to false
      inexist=.false.
      lblank1=.false.
      lbaddate=.false.
      l1=.false.
      lblank=.false.
      lbad1=.false.

c     prompt for start month and year and end month and year of model output
11    write(*,7)
      lprompt=.false.
      lwarn=.false.
      read(*,'(a250)')astr
      do ii=1,15
        str1(ii:ii)=' '
      enddo
      k=0
      ifield=1
      i=1

      do while(ifield .le. 4 .and. i .le. 250)
        i1=ichar(astr(i:i))
       
        if (i1 .ne. 32) then
          l1=.true.
          k=k+1
          str1(k:k)=astr(i:i)
        else
          if (l1) then
            fields(ifield)=str1
            
            ifield=ifield+1
            l1=.false.
            k=0
            do ii=1,15
              str1(ii:ii)=' '
            enddo
          endif
        endif
       i=i+1
      enddo
c      read(*,*)amon1,ayr1,amon2,ayr2
      do i=1,4
        
        call checkanswer(fields(i),lblank1(i),lbaddate(i),2)
        if (lblank1(i) .or. lbaddate(i)) then
           write(*,60)trim(adjustl(str(i)))
           lprompt=.true.
        else
          if (i .eq. 1) then
            read(fields(i),*)startmon
          elseif (i .eq. 2) then
            read(fields(i),*)startyr
          elseif (i .eq. 3) then
            read(fields(i),*)endmon
          else
            read(fields(i),*)endyr
          endif
        endif
      enddo
      if (lprompt) then
        goto 11
      else
        if (startmon .lt. 0 .or. startmon .gt. 12) then
          write(*,61)str(1)
          lprompt=.true.
        endif
        if (startyr .lt. 0) then
          write(*,59)str(2)
          lprompt=.true.
        endif
        if (startyr .ge. 0 .and. startyr .lt. 1000)  write(*,62)str(2)
        if (endmon .lt. 0 .or. endmon .gt. 12) then
          write(*,61)str(3)
          lprompt=.true.
        endif
        if (endyr .lt. 0) then
          write(*,59)str(4)
          lprompt=.true.
        endif
        if (endyr .ge. 0 .and. endyr .lt. 1000)  write(*,62)str(3)
        if ((startyr .ge. 0 .and. startyr .lt. 1000) .or. 
     +  (endyr .ge. 0 .and. endyr .lt. 1000)) lwarn=.true.
!        if (startyr .gt. 1000 .and. endyr .gt. 1000 .and. endyr 
!     +  .lt. startyr) then
!          write(*,63)
!          lprompt=.true.
!        endif
!        if (startyr .eq. endyr .and. endmon .lt. startmon) then
!          write(*,64)
!          lprompt=.true.
!        endif
        if (.not. lprompt) then
          startdate=startyr*100+startmon
          enddate=endyr*100+endmon
          nmonth1=(12-startmon+1)+((endyr-startyr-1)*12)+endmon
          if (startdate .ge. enddate) then
            write(*,63)
            lprompt=.true.
          else
            if (nmonth1 .le. 2) then
              write(*,64)
              lprompt=.true.
            endif
          endif
        endif
        if (lprompt) then
          goto 11
        endif
      endif
      
   
 12     write(*,70)
        read(*,'(a)')response
        
        call checkanswer(response,lblank,lbad1,1)
        
        if (.not. lblank) then
          answer=trim(adjustl(response))
          call upcase(answer) 
          if (answer .eq. 'Y') then
            goto 11
          else
            goto 12
          endif
       endif
           
        
c      read(*,*)startmon,startyr,endmon,endyr

     
c     get 2 digit years of start and years

      startyr2=startyr-(int(startyr/100)*100)
      endyr2=endyr-(int(endyr/100)*100)


c     write model period to screen and log file
      write(ilog,30)trim(adjustl(months(startmon))),startyr,
     +  trim(adjustl(months(endmon))),endyr
      write(*,30)trim(adjustl(months(startmon))),startyr,
     +  trim(adjustl(months(endmon))),endyr

c     prompt user if monthly contributions to 3-month averages is desired (version 12107)
67    write(*,66)
      read(*,'(a)')response
      answer=trim(adjustl(response))
      call upcase(answer)
      if (answer .eq. 'Y') then
        lmonthly=.true.
      elseif (answer .eq. 'N') then
        lmonthly=.false.
      else
        goto 67
      endif
      
c     prompt for file type: AERMOD POSTFILE, or simple text file
      write(*,1)
      write(ilog,1)

 2    write(*,3)
 
c      read(*,4)answer
      read(*,*)response
     
      answer=trim(adjustl(response))
      call upcase(answer)
      if (answer .eq. 'U') then
        laermod=.false.
        ltext=.true.
        write(*,40)
        write(ilog,40)
      elseif (answer .eq. 'A') then
        laermod=.true.
        ltext=.false.
        write(*,35)
        write(ilog,35)
      else   !invalid response
        goto 2
      endif   
     
c     input concentration file or files should be listed in the file, inputfiles.txt
c     which is in the same directory as the executable
c     check for presence of file

      inquire(file=infillist,exist=inexist)
      if (.not. inexist) then
        write(*,6)
        write(ilog,6)
        stop
      endif     
     
c     get the names of the concentration files
      call getfiles
      write(*,5)
      write(ilog,5)

c     formats
  1   format(/1x,'##############################',
     +  ' INPUT FILES ','#############################')
  3    format(/1x,'Enter A or a',
     +   ' for AERMOD POSTFILE'/1x,'or U or u for ',
     +   'user-created text file')    
c  4   format(a1)
  5    format(/1x,'###################################################',
     +  '#####################') 
  6   format(1x,'File inputfiles.txt does not exist...stop program')
  7   format(/1x,'Enter first month & year (4-digit) and end month ',
     +   /1x,'& year (4-digit) of model output'/1x,
     +  'Example:  1 2003 12 2007')
  30  format(/1x,'Period of rolling averages:  ',a,1x,i4,' to ',a,1x,i4)
  35  format(/1x,'Input concentration file type:  AERMOD POSTFILE')
  40  format(/1x,'Input concentration file type:  user-supplied')
  59  format(/1x,a,' is negative')
  60  format(/1x,a,' is blank or badly formatted')
  61  format(/1x,a,' is not between 1 and 12')
  62  format(/1x,a,' is not a 4-digit year')
  63  format(/1x,'Start date is the same as the end date',
     + ' or after the end date')
  64  format(/1x,'Data period is less than 3 months')
  66  format(/1x,'Output monthly contributions to rolling 3-month ',
     +  'averages?'/1x,'Enter Y or y to output monthly contributions',
     +  /1x,'Otherwise enter N or n'//1x,
     +  'Note, monthly contributions will be output for the overall ',
     +  /1x,'maximum design value in the summary file')
  70  format(/1x,'Accept start date and end date?'/1x,
     + 'Enter Y or y to re-enter dates or enter <return> to accept ',
     + 'dates'/)
      return
      end
c **************************************************************************************
      subroutine checkanswer(a,lblank,lflag,icode)
c     check answers to prompts to determine if response has invalid
c     character, i.e. response is <return> or numeric
c     routine also processes variables that should be character length 1
      use main1
      implicit none

c a:        response entered by user
c b:        left-justified version of a
c lflag:    logical variable denoting if response is bad (true) or acceptable (false)
c lblank:   logical variable denoting if response is all blanks (true) or not (false)
c ldecimal: 
c i:        integer code of character in ASCII table  
c i1:       loop counter for character string a
c idash:    number of dashes read from response
c idecimal: number decimals read from response
c iblank:   number of blanks read from response
c icode:    code indicating what type of final response is
c           icode=1 then final answer is a character, such as a Y or N, or blank
c           icode=2 then final answer is a number
c ie:       number of upper or lowercase E's in string.  E represents exponential format
c iplus:    number of plus signs read from response
c ichar1:   2 element array of number of characters before and after blank
c charstr:  15 element array of integer ASCII codes of response

c lenb:       length of string b without blanks
      character a*15,b*15
      logical lflag,lblank
      integer i,i1,idash,idecimal,iblank,icode,ie,iplus,
     + ichar1(2),charstr(15),lenb
     
  
c initialize variables
      idash=0
      ie=0
      iplus=0
      ichar1=0
      idecimal=0
      iblank=0
      charstr=32
      lflag=.false.
      lblank=.false.
      lenb=0

      b=trim(adjustl(a))
      lenb=len_trim(b)
      if (lenb .eq. 0) then
        lblank=.true.
        goto 100
      else 
        do i1=1,lenb
          call upcase(b(i1:i1))  !convert to upper case
        enddo
      endif
      

      if (icode .eq. 1) then  !final response is a character string, usually blank, y, or n 
        if (lenb .gt. 1) then
          lflag=.true.
          goto 100
        endif
      else  !numeric
        do i1=1,lenb
          i=ichar(b(i1:i1))
          charstr(i1)=i
          if ((i .ge. 48 .and. i .le. 57) .or. i .eq. 45 .or. i .eq. 46 
     +    .or. i .eq. 69 .or. i .eq. 43) then
            if (i .eq. 45) idash=idash+1
            if (i .eq. 46) then 
              idecimal=idecimal+1
              if (ie .gt. 0)lflag=.true.
            endif
            if (i .eq. 69) ie=ie+1
            if (i .eq. 43) iplus=iplus+1
c          lflag=.false.
          else
            lflag=.true.
          endif
          if (idash .gt. 2 .or. idecimal .gt. 1 .or. ie .gt. 1 .or. 
     +    iplus .gt. 2)! .or. (ichar1(1) .ne. 0 .and. ichar1(2) .ne. 0)) 
     +    lflag=.true.
        enddo
      
        if (lflag) goto 100
c     need to look for specific placements of characterics if there were no bad characters
c         if first character is an e or last character is not a blank, number, or e
c         then string is bad
        if ((charstr(1) .eq. 69) .or. 
     +  ((charstr(lenb) .lt. 48 .and. charstr(lenb) .ne. 46)
     +   .or. (charstr(lenb) .gt. 57 .and. charstr(lenb) .ne. 69))) then
          lflag=.true.
          goto 100
        endif
c       check for a blank character between the first and last occurrence of non-blank character
        i=1 
        do while (i .le. lenb .and. .not. lflag)
          if (charstr(i) .eq. 32) lflag=.true.
          i=i+1
        enddo
        if (lflag) goto 100        
c       begin looking at the string beginning with position 2 through position 14
        i=2
        do while (i .le. lenb-1 .and. .not. lflag)
c           if character is an E, make sure that character before that is
c           a number or . sign and character afterwards is a number
c           or + or - sign or blank
          if (charstr(i) .eq. 69) then  !character is an e
            if (((charstr(i-1) .lt. 48 .and. charstr(i-1) .ne. 46) 
     +      .or. charstr(i-1) .gt. 57) .or. (charstr(i+1) .lt. 48 
     +      .and. charstr(i+1) .ne. 43 .and. charstr(i+1) .ne. 45)
     +      .or. charstr(i+1) .gt. 57) 
     +      lflag=.true. 
          endif     
c         if character is a - sign, preceding character should be a
c         number or blank or lower/uppercase e and proceeding character
c         should be a number
          if (charstr(i) .eq. 45 .and. (charstr(i-1) .ne. 69 .or. 
     +    (charstr(i+1) .lt. 48 .or. charstr(i+1) .gt. 57)))lflag=.true.      
c         if character is a + sign, preceding character should be a
c         number or blank or lower/uppercase e and proceeding character
c         should be a number
          if (charstr(i) .eq. 43 .and. (charstr(i-1) .ne. 69 .or. 
     +    (charstr(i+1) .lt. 48 .or. charstr(i+1) .gt. 57)))lflag=.true. 
          i=i+1
        enddo
      endif

100   return
c     return
      end
c **************************************************************************************
      subroutine getfiles
c subroutine to read in list of input files and determine of existence      
      use main1
      implicit none
      
c variables
c eof:      integer end of file indicator
c ifiles:   integer file counter loop
c i and n:  integer file counters when checking for duplicates
c line:     character variable read in inputfiles.txt when getting # of concentration files
c fname:    character variable of filename 
c lexist:   logical variable to determine if individual concentration file exists
c ldup:     logical variable denoting duplicate filenames exist (true)
c ldup1:    logical variable set equal to ldup when ldup is true (used for writing duplicate file message)
      integer eof,ifiles,i,n
      character line*10,fname*250
      logical lexist,ldup,ldup1
      lexist=.false.
      ldup1=.false.
    
            
c     open and read inputfiles.txt to get # of files
      nfiles=0
      open(unit=inpfil,file=infillist,status='old')
      read(inpfil,*,iostat=eof)line
  15  if (eof .eq. 0) then
        nfiles=nfiles+1
        read(inpfil,*,iostat=eof)line
        goto 15
      endif
      
      rewind(inpfil)
      allocate(infile(nfiles))
!      ifiles=1
      ifiles=0
c     get file names and check for existence
      write(*,30)nfiles
      write(ilog,30)nfiles
!      read(inpfil,*,iostat=eof)infile(ifiles)
      read(inpfil,*,iostat=eof)fname
  25  if (eof .eq. 0) then
        ifiles=ifiles+1
        infile(ifiles)=fname
        inquire(file=infile(ifiles),exist=lexist)
        if (.not. lexist) then
          write(*,20)trim(adjustl(infile(ifiles)))
          write(ilog,20)trim(adjustl(infile(ifiles)))
          stop
        endif   
        write(*,35)trim(adjustl(infile(ifiles)))
        write(ilog,35)trim(adjustl(infile(ifiles)))  
!        ifiles=ifiles+1
!        read(inpfil,*,iostat=eof)infile(ifiles)
        read(inpfil,*,iostat=eof)fname
        goto 25
      endif
      
c     check for duplicates, warn user if there are duplicates
      write(*,45)
      write(ilog,45)
      
      do i=2,nfiles
          ldup=.false.
          n=1
          do while (n .lt. i .and. .not. ldup)
             if (infile(i) .eq. infile(n)) ldup=.true.  !duplicate filename
             n=n+1
           enddo 
           if (ldup) then
             write(*,40)trim(adjustl(infile(i)))
             write(ilog,40)trim(adjustl(infile(i)))
             ldup1=ldup
             stop
           endif
       enddo
       
c     write message that there are no duplicate filenames       
       if (.not. ldup1) then
         write(*,50)
         write(ilog,50)
       endif
       

c 5    format(1x,'More than 1 file exists for user-supplied files'/1x,
c     +  'There can only be one file')
 20   format(1x,a,' does not exist...stop program')
 30   format(/1x,i3,' input concentration files:'/)
 35   format(1x,a)
 40   format(/1x,'ERROR: Concentration file ',a,' is a duplicate'/1x,
     +  'Correct inputfiles.txt')
 45   format(/1x,'Checking for duplicate filenames')
 50   format(/1x,'No duplicate filenames found')
 
      close(inpfil)
   
      return
      end
c*****************************************************************************************************
      subroutine readpost
c subroutine to read ASCII output
c     this subroutine reads the ASCII POSTFILE output from AERMOD
c     this subroutine will determine the format to be used in reading the file, i.e deposition variables are present
c     and how many receptors

      use main1
      implicit none

c variables
c line:     character variable read in when reading header information of AERMOD POSTFILE
c form:     character string of AERMOD POSTFILE format
c avg:      character string of AERMOD averaging period (should only be MONTHLY)
c grp1:     character string of source group when reading concentration records
c           value is assigned to grp array
c net:      character string of receptor network id. Is blank for discrete receptors
c           has value for polar and gridded receptors
c eof:      integer end of file indicator
c iform:    integer denoting location of FORMAT string in AERMOD header line
c idep:     integer denoting if deposition output
c           if greater than 0, deposition calculated and output
c irec:     integer receptor counter (ranges from 1 to nrec)
c j:        integer counter used for reading deposition values when present
c n:        integer variable denoting month relative to beginning of model period (ranges from 1 to nmonth)
c date1:    integer date read from POSTFILE
c iyr:      integer year relative to start year (start year=1)
c imonth:   integer of calendar month (ranges from 1 to 12)
c igrp:     integer representing group array index
c ifile:    integer used in looping through inputfiles when reading
c iyr2:     2 digit year of date1.  this is actual year, not year relative to start year
c iline:    integer line counter
c d:        real array of dimension 1 with 3 elements representing wet, dry, and total deposition
c aconc:    real variable of monthly concentration read from POSTFILE and assigned to mconc
c zh:       real variable of hill height scale and assigned to zhill
c x:        real variable of receptor x coordinate and assigned to xrec
c y:        real variable of receptor y coordinate and assigned to yrec
c ze:       real variable of receptor elevation and assigned to zelev
c zf:       real variable of receptor flagpole height and assigned to zflag
c lfound:   logical variable denoting that source group in file is in source group array
 
      character line*120,form*100,avg*6,grp1*8,net*8
      integer eof,iform,idep,j,irec,n,date1,iyr,imonth,igrp,ifile,iyr2,
     +  iline
      real d(3),aconc,x,y,ze,zf,zh
      logical lfound
            
c     get # of unique groups and # of receptors
      call groupreceptor

c     allocate arrays
      call allocarrays
      
c     loop through input files
      write(*,1)
      write(ilog,1)
      do ifile=1,nfiles
      
        write(*,35)trim(adjustl(infile(ifile)))
        write(ilog,35)trim(adjustl(infile(ifile)))
c       open file
        open(unit=inunit,file=infile(ifile),status='old')
        idep=0
c       read header lines
c       once those have been read
c       will go to actual data lines
        read(inunit,10,iostat=eof)line
 15     if (eof .eq. 0) then
          if (line(1:1) .eq. '*') then
c          get format of concentration records
           if (index(line,'FORMAT:') .gt. 0) then  
             iform=index(line,'FORMAT:')
             form=trim(adjustl(line(iform+7:120)))
           endif
            read(inunit,10,iostat=eof)line
            goto 15
          else
            goto 20       
          endif
        endif
        
c       backspace to first line of receptors and concentrations
20      backspace(inunit) 
       
c       initialize receptor counter (irec), month counter (n), and group counter (igrp)
        irec=1
        n=1
        igrp=1
       
c       check for number of deposition values (dry, wet, and total) calculated and subtract 3 from answer.  The 3
c       represents x-coordinate, y-coordinate, and concentration
        write(*,*)' Checking for deposition output'
        write(ilog,*)' Checking for deposition output'
        read(form(2:2),'(i1)')idep
        idep=idep-3
        
c       read receptors and concentrations
        if (idep .gt. 0) then
          read(inunit,form,iostat=eof)x,y,aconc,
     +    (d(j),j=1,idep),ze,zh,zf,avg,
     +    grp1,date1,net
        else                ! no deposition calculated
          read(inunit,form,iostat=eof)x,y,aconc,
     +    ze,zh,zf,avg,grp1,date1,
     +    net
        endif
        
 30     if (eof .eq. 0) then
          if (trim(adjustl(avg)) .ne. 'MONTH') then
            write(*,25)trim(adjustl(avg))
            stop
          endif
c          get month and year as well as month relative to start period
          call monthyear(date1,iyr,imonth,n,iyr2)
        
          if (n .gt. 0 .and. n .le. nmonth) then       !process record
            igrp=1
            lfound=.false.
c           search for the just read group in the group array
            do while(.not. lfound .and. igrp .le. ngrp)
               if (trim(adjustl(grp1)) .eq. trim(adjustl(grp(igrp))))
     +         then
                 lfound=.true.
               else 
                igrp=igrp+1
               endif
            enddo
             
c           assign coordinates, elevation, flagpole height, concentration, and date to arrays
c           date is yymm, i.e. January 2001 is 101
            if (lfound) then
              xrec(irec)=x
              yrec(irec)=y
              zelev(irec)=ze
              zflag(irec)=zf
              zhill(irec)=zh
              mconc(irec,igrp,n)=aconc
              idate(n)=(iyr2*100)+imonth
c           reset receptor counter to 1 if nrec reached, otherwise increase by 1             
              if (irec .eq. nrec) then        
               irec=1
              else                              
               irec=irec+1
              endif       
            else
              lnewgrp=.true.
            endif

            if (idep .gt. 0) then
              read(inunit,form,iostat=eof)x,y,aconc,
     +        (d(j),j=1,idep),ze,zh,zf,avg,
     +        grp1,date1,net
            else  
              read(inunit,form,iostat=eof)x,y,aconc,
     +        ze,zh,zf,avg,grp1,date1,
     +        net
            endif
          else
            if (n .gt. nmonth) then 
              eof=1
            else
              if (idep .gt. 0) then
                read(inunit,form,iostat=eof)x,y,aconc,
     +          (d(j),j=1,idep),ze,zh,zf,avg,
     +          grp1,date1,net
              else  
                read(inunit,form,iostat=eof)x,y,aconc,
     +          ze,zh,zf,avg,grp1,date1,
     +          net
              endif
            endif
          endif
          goto 30
        endif
        close(inunit)
      enddo   
       
      write(*,40)
      write(ilog,40)

c     inform user that a group not in the source group array was found      
      if (lnewgrp) then
        write(*,41)
        write(ilog,41)
      endif
      
      write(*,2)
      write(ilog,2)
      
 1     format(/1x,'#########################',
     +  ' INPUT CONCENTRATIONS ','#########################')
2     format(/1x,'###################################################',
     +  '#####################')

 10   format(a120)
 25   format(/1x,'CONCENTRATIONS ARE NOT MONTHLY AVERAGES'/1x,
     +  'AVERAGES ARE:',1x,a/1x,'STOPPING PROGRAM')
 35   format(/1x,'Reading concentration file: ',a)    
 40   format(/1x,'All concentrations read')
 41   format(/1x,'WARNING!  A SOURCE GROUP WAS FOUND IN THE INPUT ',
     +  'CONCENTRATION FILES'/1x,'THAT IS NOT IN THE SOURCE GROUP LIST'
     +  /1x,'CHECK SOURCE GROUP LIST AND INPUTFILES.TXT')      
      return
      end
c **********************************************************************
      subroutine readtext
c subroutine to read simple text files (free formatted)
c assumes monthly average      
      use main1
      implicit none
      
c variables
c eof:      integer end of file indicator
c iyear:    integer 2 digit year from concentration file
c imonth:   integer calendar month from concentration file
c irec:     integer receptor counter (ranges from 1 to nrec)
c n:        integer variable denoting month relative to beginning of model period (ranges from 1 to nmonth)
c igrp:     integer representing group array index
c date1:    integer date created from iyear and imonth (similar format to date from AERMOD POSTFILE)
c iyr:      integer year relative to start year (start year=1)
c ifile:    integer used in looping through inputfiles when reading
c iyr2:     2 digit year of date1.  this is actual year, not year relative to start year
c aconc:    real variable of monthly concentration read from POSTFILE and assigned to mconc
c zh   :    real variable of hill height scale and assigned to zhill
c x:        real variable of receptor x coordinate and assigned to xrec
c y:        real variable of receptor y coordinate and assigned to yrec
c ze:       real variable of receptor elevation and assigned to zelev
c zf:       real variable of receptor flagpole height and assigned to zflag
c zh:       real variable of receptor hill height and assigned to zhill
c g:        character string of source group
c lfound:   logical variable denoting that source group in file is in source group array

      integer eof,iyear,imonth,irec,n,igrp,date1,iyr,
     + ifiles,iyr2
      real x,y,aconc,zh,ze,zf
      character g*8,a*1
      logical lfound
      
      lnewgrp=.false.
c     get # of unique groups and # of receptors
      call groupreceptor

c     allocate arrays
      call allocarrays
      
c     loop through input files
      write(*,1)
      write(ilog,1)
      
      do ifiles=1,nfiles
        write(*,35)trim(adjustl(infile(ifiles)))
        write(ilog,35)trim(adjustl(infile(ifiles)))
        open(unit=inunit,file=infile(ifiles),status='old')
c       initialize receptor counter (irec), month counter (n), and group counter (igrp)
        irec=1
        n=1
        igrp=1
        read(inunit,*,iostat=eof)x,y,aconc,ze,
     +    zh,zf,g,iyear,imonth
 10     if (eof .eq. 0) then
c       calculate date1 for input into routine monthyear
        date1=(iyear*1000000)+(imonth*10000)
c       get month and year as well as month relative to start period  
        call monthyear(date1,iyr,imonth,n,iyr2)
c       if n is within the model period process
        if (n .gt. 0 .and. n .le. nmonth) then   
          igrp=1
          lfound=.false.
c         search for the just read group in the group array
          do while(.not. lfound .and. igrp .le. ngrp)
              if (trim(adjustl(g)) .eq. trim(adjustl(grp(igrp)))) then 
               lfound=.true.
              else
                igrp=igrp+1
              endif
          enddo
c         assign coordinates, elevation, flagpole height, concentration, and date to arrays
c         date is yymm, i.e. January 2001 is 101  
          if (lfound) then  
c          write(*,*)g,irec,igrp,n
          
            xrec(irec)=x
            yrec(irec)=y
            zelev(irec)=ze
            zflag(irec)=zf
            zhill(irec)=zh
            mconc(irec,igrp,n)=aconc
c         reset receptor counter to 1 if nrec reached, otherwise increase by 1            
            if (irec .eq. nrec) then
              irec=1
            else
              irec=irec+1
            endif
          else
            lnewgrp=.true.
          endif
          idate(n)=(iyr2*100)+imonth        
          read(inunit,*,iostat=eof)x,y,aconc,
     +    ze,zh,zf,g,iyear,imonth
       else  !if outside period, stop reading file
         if (n .gt. nmonth) then 
            eof=1
         else
           read(inunit,*,iostat=eof)x,y,aconc,
     +      ze,zh,zf,g,iyear,imonth
         endif
       endif
        goto 10
      endif
      close(inunit)
      enddo
      write(*,40)
      write(ilog,40)

c     inform user that a group not in the source group array was found      
      if (lnewgrp) then
        write(*,41)
        write(ilog,41)
      endif
      
      write(*,2)
      write(ilog,2)
      
 1     format(/1x,'#########################',
     +  ' INPUT CONCENTRATIONS ','#########################')
2     format(/1x,'###################################################',
     +  '#####################')
35    format(/1x,'Reading concentration file: ',a)
40    format(/1x,'All concentrations read')
41    format(/1x,'WARNING!  A SOURCE GROUP WAS FOUND IN THE INPUT ',
     +  'CONCENTRATION FILES'/1x,'THAT IS NOT IN THE SOURCE GROUP LIST'
     +  /1x,'CHECK SOURCE GROUP LIST AND INPUTFILES.TXT')
      return
      end       
c***********************************************************************
      subroutine monthyear(date,iyr,imonth,n,iyr2)
c subroutine to extract month and year (relative to startyr) of date
c and get the number of months (1 to nmonth) needed for averaging
c input is: date (from concentration file)
c outputs are:  iyr, imonth, n, and iyr2
      use main1
      implicit none

c variables
c date:     integer date
c           if AERMOD POSTFILE format is YYMMDD24, where DD is last day of month
c           if user-supplied text file format is YYMM0000
c           example:  Monthly average for January 2001 is 1013124 for POSTFILE, 101 for textfile
c iyr:      integer variable of year relative to start year
c imonth:   calendar month of year
c n:        month relative to start month (ranges from 1 to nmonth)
c iyr2:     2 digit year of date
c i:        years array counter
c adate:    character string of date variable
c lyear:    logical variable denoting if 2 digit year is in years array
    
      integer date,iyr,imonth,n,iyr2,i
      character adate*8
      logical lyear
c     initially set n to 0
      n=0
      
c     convert date to character
c     date is YYMMDDHH
c     if date =4013124 then adate=04013124
      write(adate,'(i8.8)')date
      
c     get year and month from adate
      read(adate(1:2),'(i2)')iyr2
      read(adate(3:4),'(i2)')imonth

c     get year relative to start year.  if y is start year then iyr=1
c     if 2 digit year is less than start year, add 100 to account for century crossover

c     check to see if year is in years array, if so and less than start year
c     then add 100 to account for century crossover
      i=1
      lyear=.false.
c      if (iyr2 .lt. startyr2) then           
        do while(i .le. nyears .and. .not. lyear)
          if (iyr2 .eq. years(i)) lyear=.true.
          i=i+1
        enddo
c      endif
c     JAT  need to fix logic here
      if (lyear) then
        if (iyr2 .lt. startyr2) then
           iyr=(iyr2+100)-startyr2+1
        else
           iyr=iyr2-startyr2+1
        endif
      else
        iyr=0
      endif
             
c      if (iyr2 .lt. startyr2 .and. endyr2-iyr2 .gt. 0) then 
c     2-digit year is less than start year and is being included in averages
c     i.e. start year is 1999 and year of concentration file's record is 2000
c     or record year is 1998 and averages start with 1999
c        iyr=(iyr2+100)-startyr2+1
c      else if (iyr2 .gt. startyr2 .and. endyr2-iyr2 .lt. 0) then
c       century has been crossed, but record year is before crossover and start year is after
c       i.e. record year is 1999 but averages start for 2000
c        iyr=iyr2-(startyr2+100)+1
c      else
c       record year is greater than or equal to start year
c        iyr=iyr2-startyr2+1
c      endif
c      n=(iyr-1)*12+imonth
      n=(iyr-1)*12+imonth-(startmon)+1
c      write(*,*)startyr2,iyr2,iyr,n,lyear
c      pause
 10   return
      end
c*******************************************************************

      subroutine groupreceptor
c subroutine to get # of unique groups and # of receptors    
c when reading POSTFILE, check for string "SOURCE GROUP" in POST FILE header
c when reading user supplied file, check records for only first month and year  
      use main1
      implicit none

c local variables
c eof:      integer end of file indicator
c ngrp1:    integer of number of groups read from file (may include duplicate groups)
c           these are not unique groups
c iyear:    year read from user-supplied file
c imonth:   calendar month read from user-supplied file
c maxnrec:  integer of maximum number of receptors read from POSTFILES
c maxnrec:  integer of minimum number of receptors read from POSTFILES
c ifiles:   input concentration file loop counter
c nrec1:    integer 1-dimensional array of # of receptors read from POSTFILE
c iyr1:     integer reference year for user-supplied files (first year in each file)
c imon1:    integer reference month for user-supplied files (first month of first year in each file)
c iopt:         integer variable of choice of user to proceed or not through program
c iline:    integer line counter
c x:        real value of receptor x-coordinate from user-supplied file
c y:        real value of receptor y-coordinate from user-supplied file
c z1,z2,z3: real elevation, hill height, and flagpole of receptor from user-supplied file
c g:        character string of group read from user-supplied file
c line:     character string read from header lines when reading POSTFILE
c a:        character string to check user file 
      integer eof,ngrp1,iyear,imonth,maxnrec,minnrec,ifiles,iyr1,imon1,
     + iopt,iline
      integer, allocatable, dimension (:):: nrec1
      
      real x,y,aconc,z1,z2,z3 
      character g*8,line*120,a,response*15
      logical lblank,lbad1
      allocate(nrec1(nfiles))
 
      write(*,1)
      write(ilog,1)
c temporary file to store source ids for POSTFILE or first month for user-text     
      open(unit=99,file='testfile.txt',status='unknown')
      
c get # of groups and receptors
      ngrp1=0
      if (laermod) then
         do ifiles=1,nfiles
           open(unit=inunit,file=infile(ifiles),status='old')
           read(inunit,10,iostat=eof)line
           iline=1
 15        if (eof .eq. 0) then
             if (line(1:1) .eq. '*') then
c               source group line
                if (index(line,'SOURCE GROUP') .gt. 0) then
                    ngrp1=ngrp1+1
                    write(99,10)line
                endif
c               receptor line for concentration file being read
                if (index(line,'RECEPTORS') .gt. 0) then 
                   read(line(25:31),'(i7)')nrec1(ifiles)
                endif
             else        !into actual concentrations or bad file
                if (iline .eq. 1) then
                  write(*,6)trim(adjustl(infile(ifiles)))
                  write(ilog,6)trim(adjustl(infile(ifiles)))
                  stop
                else
                  goto 20
                endif
             endif
             iline=iline+1
             read(inunit,10,iostat=eof)line
             goto 15
           endif
  20       close(inunit)
         enddo
         close(99)
      else   !user-supplied text files
         do ifiles=1,nfiles
           open(unit=inunit,file=infile(ifiles),status='old')
c          read first line
           read(inunit,3,iostat=eof)a
           if (a .eq. '*') then
             write(*,7)trim(adjustl(infile(ifiles)))
             write(ilog,7)trim(adjustl(infile(ifiles)))
             stop
           else
             rewind(inunit)
             eof=0
           endif
           read(inunit,*,iostat=eof)x,y,aconc,z1,z2,z3,g,iyear,imonth
c          set reference year and month to first date in file
c          keep all records that are equal to this date or
c          equal to start date or end date.
           iyr1=iyear
           imon1=imonth
  5        if (eof .eq. 0) then
             if ((iyear .eq. iyr1 .and. imonth .eq. imon1) .or.
     +          (iyear .eq. startyr2 .and. imonth .eq. startmon) .or.
     +          (iyear .eq. endyr2 .and. imonth .eq. endmon)) then
               write(99,25)g,iyear,imonth
               ngrp1=ngrp1+1
              endif
               read(inunit,*,iostat=eof)x,y,aconc,z1,z2,z3,g,iyear,
     +         imonth
c             else
c               eof=1
c             endif
             goto 5
           endif
           close(inunit)
         enddo
         close(99)
      endif
    
c     get minimum and maximum number of receptors from POSTFILES
c     they should be equal for every file
c     if not, tell user and stop program
      if (laermod) then
        maxnrec=maxval(nrec1)
        minnrec=minval(nrec1)
        if (minnrec .ne. maxnrec) then
          write(*,30)minnrec,maxnrec
          stop
        else
          nrec=maxnrec
        endif
      endif
      
c     need to get unique groups
      
      call uniquegroups(ngrp1)
c     calculate # of receptors for user-supplied text file
c      if (ltext) nrec=ngrp1/ngrp
c     read testfile.txt and look at first source group
 
      
c      if (ltext) then  
c        if (nfiles .gt. 1) then 
c          nrec=ngrp1/nfiles
c          nrec=ngrp1/ngrp
c        else
c          nrec=ngrp1/ngrp
c        endif
c      endif   

      write(*,35)nrec
      write(ilog,35)nrec
c prompt user to verify source groups and # of receptors
 90   write(*,60)
      read(*,*)response
      call checkanswer(response,lblank,lbad1,2)
      if (lblank .or. lbad1) then
        goto 90
      else
        read(response,*)iopt
      endif
c      read(*,*)iopt
      
      if (iopt .eq. 1) then
        write(*,65)
      else if (iopt .eq. 2) then
        write(*,70)
        write(ilog,70)
        stop
      else
        write(*,80)
        goto 90
      endif          
      write(*,45)
      write(ilog,45)
 
    1   format(/1x,'#############################',
     +  ' SOURCE GROUPS ','############################')  
    3 format(a1) 
   6    format(/1x,a,' is not an AERMOD POSTFILE'/1x,'Check files'/1x,
     + 'Stopping program') 
   7    format(/1x,a,' is not a user-created file'/1x,'Check files'/1x,
     + 'Stopping program')  
 10   format(a120)
 25   format('* ',a8,1x,i2,i2)
 30   format(/1x,'The number of receptors differ in the POSTFILES'/1x,
     + 'One or more files has ',i10,' receptors'/1x, 'and'/1x,
     + 'One or more files has ',i10,' receptors'/1x,'Stopping program')
 35   format(/1x,'The number of receptors is:',1x,i9)
 45   format(/1x,'###################################################',
     +  '#####################')
 60   format(/1x,'Verify source groups and receptors and enter one of',
     +  /1x,'the following options:'//1x,'1) Proceed with calculations',
     +  /1x,'2) Stop program and check input concentration files')
 65   format(/1x,'Proceeding with program ...')
 70   format(/1x,'Stopping program, check input files...'/1x,
     + '###################################################',
     +  '#####################')
 80   format(/1x,'Invalid option, choose again...')
      return
      end
c****************************************************************
      subroutine uniquegroups(ngrp1)
c subroutine to get unique groups and allocate arrays for groups
c input is the # of groups read by groupreceptor
c subroutine also calculates the number of receptors for
c user-supplied files
      use main1
      implicit none
 
c variables
c ngrp1:        integer variable of non-unique groups from POSTFILEs or user-supplied files
c eof:          integer end of file indicator
c i and n:      integer counter variables used when checking for duplicate groups
c igrp1:        integer counter for non-unique groups
c igrp:         integer counter of unique groups
c istep:        integer variable set to 1 if total group has to be calculated, otherwise it is 0
c iall:         integer variable set to location of total group in array
c nrecs:        integer array with 3 elements representing number of receptors for:
c               1) first group and first date in files, 2)middle group and start date of period
c               3) last group and last date of period
c grptemp:      character string array of duplicate source groups of size ngrp1
c flag:         character string read from testfile.txt when processing POSTFILEs
c agrp:         character string for source group read from testfile.txt
c ldup:         logical variable denoting duplicate source groups exist (true)    
      integer ngrp1,eof,i,n,igrp,igrp1,istep,iall,iyr1,imon1,nrecs(3),
     + ngrp2
      character grptemp*8,flag*1,agrp*8
      allocatable :: grptemp(:)
      logical ldup
      
      integer, allocatable, dimension(:) :: iyr
      integer, allocatable, dimension(:) :: imon
     
      allocate(grptemp(ngrp1))
      allocate(iyr(ngrp1))
      allocate(imon(ngrp1))
      iyr=0
      imon=0
      open(unit=99,file='testfile.txt',status='old')
c     get # of groups in file (including duplicates)
      igrp1=0
      if (laermod) then
        read(99,10,iostat=eof)flag,agrp
        iyr1=1
        imon1=1
      else
        read(99,11,iostat=eof)flag,agrp,iyr1,imon1
      endif
      
  15  if (eof .eq. 0) then
          if (flag .eq. '*') then
            igrp1=igrp1+1
            grptemp(igrp1)=agrp
            iyr(igrp1)=iyr1
            imon(igrp1)=imon1
          endif
          if (laermod) then
             read(99,10,iostat=eof)flag,agrp
             iyr1=1
             imon1=1
          else
             read(99,11,iostat=eof)flag,agrp,iyr1,imon1
          endif
          goto 15
      endif
    
      close(99,status='delete')
      
 
c     get # of unique groups by searching through duplicates list
c     when reading a particular group, read array upto its location
c     if a duplicate found, set ldup to true
c     if no duplicate found, increase igrp by 1, meaning a unique group found 
      igrp=1  
      do i=2,ngrp1
          ldup=.false.
           n=1
           do while (n .lt. i .and. .not. ldup)
              if (grptemp(i) .eq. grptemp(n)) ldup=.true.
              n=n+1
           enddo 
           if (.not. ldup) igrp=igrp+1
      enddo
            
c     allocate final group array (non-duplicates) and assign values
c     go ahead and give the array one extra element to account for a total groupt
c     that may need to be calculated. 

      ngrp=igrp
      allocate(grp(ngrp+1))

      grp(1)=grptemp(1)
      igrp=1
      do i=2,ngrp1
         ldup=.false.
         n=1
         do while (n .lt. i .and. .not. ldup)
            if (grptemp(i) .eq. grptemp(n)) ldup=.true.
            n=n+1
         enddo 
         if (.not. ldup) then
            igrp=igrp+1
            grp(igrp)=grptemp(i)
         endif
      enddo     
     
c     check for a total group if there is more than one group
c     first check for group ALL
c     if not found, prompt user for group and check for that one
c     if that group is not present, inform user that it will be calculated 
      lall=.false.
      ltotgrp=.false.
      lcalcgrp=.false.
      iall=0
      if (ngrp .gt. 1) then 
        groupall='ALL'   
        call findall(groupall,lall,iall)
      
        if (lall) then    
c         ALL has been found and will be the total group
          write(*,20)
          write(ilog,20)
        else 
c         group ALL not found, user prompted for name of total group             
          write(*,25)
          write(ilog,25)
          write(*,30)
          read(*,*)groupall
c         convert groupall to upper case
          do i=1,8        
           call upcase(groupall(i:i))
          enddo
c         look for user entered total group
          call findall(groupall,ltotgrp,iall)
c         if user-entered group not found, inform user it will be calculated
          if (.not. ltotgrp) then
            lcalcgrp=.true.
            write(*,35)trim(adjustl(groupall)),trim(adjustl(groupall))
            write(ilog,35)trim(adjustl(groupall)),
     +       trim(adjustl(groupall))
            iall=ngrp+1
          else
            write(*,40)trim(adjustl(groupall))
            write(ilog,40)trim(adjustl(groupall))
          endif
        endif
      else
        write(*,55)
        write(ilog,55)
        lcalcgrp=.false.
      endif
      
c     assign groupall to group array
c     if this is not needed, then the last element of grp is empty (blank)
      if (lcalcgrp) grp(ngrp+1)=groupall
c      deallocate(grptemp)
    
c     reassign the total group to the last element of the group array
c     if not already

      if (.not. lcalcgrp) then
        if (iall .ne. ngrp .and. ngrp .gt. 1) then
          agrp=grp(ngrp)
          grp(ngrp)=groupall
          grp(iall)=agrp
        endif
      endif
      
c     write the groups out
c     add 1 if a total group is being processed
      if (lcalcgrp) then
        istep=1
      else
        istep=0
      endif
      
      write(*,45)ngrp+istep
      write(ilog,45)ngrp+istep
      do igrp=1,ngrp+istep
        if (grp(igrp) .ne. groupall) then
          flag=' '
        else
          flag='*'
        endif
        write(*,50)flag,grp(igrp)
        write(ilog,50)flag,grp(igrp)
      enddo
      if (ngrp .gt. 1) then
        write(*,51)
        write(ilog,51)
      endif

c     get number of receptors if using user-supplied files
c     use the first source group in source group array
c     and first year and month in data
c     also check the middle group and first date of period
c     also check last source group and last date of period
c     if values are not equal, stop program
      if (ltext) then
        nrecs=0
        if (real(ngrp/2) .lt. 1.0) then
          ngrp2=1
        else
          ngrp2=ngrp/2
        endif
        do igrp=1,ngrp1
           if (grptemp(igrp) .eq. grp(1) .and.
     +    iyr(igrp) .eq. iyr(1) .and. imon(igrp) .eq. 
     +    imon(1)) nrecs(1)=nrecs(1)+1
           if (grptemp(igrp) .eq. grp(ngrp2) .and.
     +    iyr(igrp) .eq. startyr2 .and. imon(igrp) .eq. 
     +    startmon) nrecs(2)=nrecs(2)+1
           if (grptemp(igrp) .eq. grp(ngrp) .and.
     +    iyr(igrp) .eq. endyr2 .and. imon(igrp) .eq. 
     +    endmon) nrecs(3)=nrecs(3)+1
         enddo
         if (ngrp .eq. 1 .and. nrecs(1) .eq. nrecs(3)) then
           nrec=nrecs(1)
           
         elseif (ngrp .gt. 1 .and. nrecs(1) .eq. nrecs(2) 
     +     .and. nrecs(1) .eq. nrecs(3)) then
           nrec=nrecs(1)
         else 
           write(*, 56)nrecs(1),nrecs(2),nrecs(3)
           stop
         endif
      endif
 
  10  format(a1,t71,a8)
 11   format(a1,1x,a8,1x,i2,i2)        
  20  format(/1x,'Source group ALL has been found in group array'
     +  /1x,'It will be assumed this the group that represents ',/1x,
     +  'contributions from all sources')
  25  format(/1x,'Source group ALL was not found in the group array')
  30  format(/1x,'Enter the name for the source group that will be a ',
     + 'total ',/1x,'from all individual sources'1x,
     + 'with a maximum of 8 characters')
  35  format(/1x,'Source group ',a,' was not found in the ',
     +  'concentration files'/1x,'It will be calculated by the program'/
     +  /1x,'** NOTE:  Calculation of group ',a,' assumes that ',
     +  'individual ',/11x,'emission sources in the model are not in ',
     +  'multiple groups,'
     +  /11x,'i.e. source groups are mutually exclusive **')
  40  format(/1x,'Source group ',a,' was found in the ',
     +  'concentration files'/1x,'It will be the group that represents',
     +  ' contributions from all sources')      
 45   format(/1x,i5,' groups will be processed'/3x,'Groups are:')
 50   format(1x,a1,1x,a8)
 51   format(/1x,'* denotes total group')
 55   format(/1x,'Only one source group is present, ',
     +  'do not calculate a total group')
 56   format(/1x,'The number of receptors differ for user-supplied',
     +  /1x,'text files: ',3(i5,1x))

      return
      end
c***********************************************************************************


      subroutine findall(group1,lgrp,iall)
c subroutine to find the group that represents total concentration at each receptor in the 
c concentration files
c inputs are group1, which is the source group to search for
c output is a logical variable, lgrp denoting if that group has been found (lgrp=.true.)  
c and location of the total group in the array of source groups        
      use main1
      implicit none
      integer iall
  
c variables
c igrp:     integer group counter
c group1:   character string representing group to search for
c lgrp:     logical variable denoting if group1 has been found in group array

      integer igrp
      character group1*8
      logical lgrp
      
c     initialize lgrp
      lgrp=.false.
         
c check source groupings for designated total group
c if found stop searching
      igrp=1
      do while (.not. lgrp .and. igrp .le. ngrp)
        if (grp(igrp) .eq. group1) then
           lgrp=.true.
           iall=igrp
        endif
        igrp=igrp+1
      enddo
      return     
      end
c***************************************************************************************

      subroutine allocarrays
c     subroutine to allocate other arrays      
      use main1
      implicit none

c variables
c i     integer for year counter
c irec  integer receptor counter
c g     integer group counter
c n     integer month counter
c istep integer denoting if total group calculated (for group loop when initializing mconc)
      integer i,irec,g,n,istep
c allocate arrays

c     calculate number of months in model output
      
      nmonth=(12-startmon+1)+((endyr-startyr-1)*12)+endmon
      
c     create an array of 2 digit years
c     this is to help with century crossover
c     and if the model results start with a year
c     before the period
      nyears=endyr-startyr+1
      
c     if group ALL or the designated total group is not in the output file, add 1 to the # of groups
c     when allocating the concentration arrays
      if (lcalcgrp) then   
c       need to increase # of groups by 1 in allocation
        allocate(mconc(nrec,ngrp+1,nmonth))
        allocate(conc3(nrec,ngrp+1,nmonth-2))
        istep=1
      else
        allocate(mconc(nrec,ngrp,nmonth))
        allocate(conc3(nrec,ngrp,nmonth-2))
        istep=0
      endif
      
c     allocate x and y coordinate arrays, date array, elevation, and flagpole height    
      allocate(xrec(nrec))
      allocate(yrec(nrec))
      allocate(zelev(nrec))
      allocate(zhill(nrec))
      allocate(zflag(nrec))
      allocate(idate(nmonth))
      allocate(years(nyears))
      allocate(maxconc(nrec))
      allocate(maxdate(nrec))
      allocate(maxgrp(nrec))
      
c     initialize arrays.  initialize mconc to -1 for later checking for missing dates
c     initialize maxconc to -1 upto ngrp since some concentrations may be 0 for a receptor
    
      
      do irec=1,nrec
        do g=1,ngrp+istep
          do n=1,nmonth
            if (g .eq. ngrp+1) then 
               mconc(irec,g,n)=0.0
            else
               mconc(irec,g,n)=-1.0
            endif
          enddo
        enddo
      enddo
      conc3=0.0
      maxconc=-1.0
      idate=0 
c     add values to years array
      do i=startyr,endyr
        years(i-startyr+1)=i-(int(i/100)*100)
      enddo
      
      return
      end
c******************************************************************************************
      subroutine checkdates
c subroutine to ensure that all dates and groups in the range from start month and start year 
c to end month and end year have been processed in readpost or readtext
c if not, give an error
      use main1
      implicit none

c variables
c i:        integer calendar year
c m:        integer month counter (ranges from 1 to nmonth)
c imon:     integer calendar month
c igrp:     integer group loop counter (ranges from 1 to ngrp)
c irec:     integer receptor loop counter (ranges from 1 to nrec)
c iopt:     integer option selected by user on whether to proceed
c minconc:  real minimum concentration from mconc array
c b:        real variable to denote how to calculate calendar year
c agrp:     character group string
c lmiss:    logical variable denoting that at least one source group has missing concentrations
c lzero:    logical variable denoting whether to set missing concentrations to zero (lzero=true)
      integer i,m,imon,igrp,irec,iopt
      real minconc,b
      character agrp*8
      logical lmiss,lzero

      lmiss=.false.
      lzero=.false.
      lmissall=.false.
     
c     check to see if there is a negative concentration
      minconc=0.0
      minconc=minval(mconc)

      
c     if monconc .lt. 0 then check to see which groups/dates are missing
c     use first receptor
      if (minconc .lt. 0.0) then
        write(*,1)
        write(ilog,1)
        do igrp=1,ngrp
            do m=1,nmonth
              b=mod(real(m+startmon-1),12.0)
              if (b .eq. 0) then 
               i=((m+startmon-1)/12)+startyr-1
              else
               i=((m+startmon-1)/12)+startyr
              endif
              imon=(m+startmon-1)-(i-startyr)*12
              if (idate(m) .eq. 0) then
                idate(m)=(i-(int(i/100)*100))*100+imon
              endif
              if (mconc(1,igrp,m) .lt. 0.0) then
                agrp=grp(igrp)
                if (grp(igrp) .eq. groupall) lmissall=.true.
                write(*,2)trim(adjustl(months(imon))),i,agrp
                write(ilog,2)trim(adjustl(months(imon))),i,agrp
                lmiss=.true.
              endif
            enddo
        enddo
      endif
      
c     prompt user for further instructions
      if (lmiss) then
 10       if (.not. lmissall) then
            write(*,3)
          else
            write(*,4)
          endif
        read(*,*)iopt
        if (iopt .eq. 1) then
          lzero=.true.
          write(*,5)
        else if (iopt .eq. 2) then
          write(*,6)
          write(ilog,6)
          stop
        else
          write(*,7)
          goto 10
        endif
      endif
      
c     set missing concentrations to zero if user selected to do so
      if (lzero) then
          do igrp=1,ngrp-1
            do m=1,nmonth
              do irec=1,nrec
                if (mconc(irec,igrp,m) .eq. -1.0) mconc(irec,igrp,m)=0.0
              enddo
            enddo
          enddo
      endif
      
 1    format(/1x,'WARNING'/)
 2    format(1x,a,1x,i4,' concentrations are missing for group ',a8)
 3    format(/1x,'Missing group/date combinations have been found'/
     +  1x,'Choose one of the following options:'//1x,
     +  '1) Set missing concentrations to zero and proceed with ',
     +  'calculations',/1x,'2) Stop program and check input files or ',
     +  'dates')
 4    format(/1x,'Missing group/date combinations have been found'/
     +  1x,'Choose one of the following options:'//1x,
     +  '1) Set missing concentrations to zero and calculate ',/5x,
     +   'concentrations for total group and proceed with ',/5x,
     +   'calculations',/1x,
     +  '2) Stop program and check input files or dates')
 5    format(/1x,'Missing concentrations will be set to zero, proceed')
 6    format(/1x,'Stopping program, check inputs and dates')
 7    format(/1x,'Invalid option')
c 3    format(/1x,'check input files or start'/
c     + 1x,'dates and end dates'//1x,
c     + 'Missing concentrations set to zero, ...')

     
      end
c******************************************************************************************
      subroutine calcavg
c subroutine to calculate 3 month rolling averages for each receptor
c and get maximum by receptor and overall maximum average
      use main1
      implicit none

c variables
c i:        integer month loop counter
c j:        integer month counter for 3 month averages (ranges from 1 to nmonth-2)
c irec:     integer receptor loop counter (ranges from 1 to nrec)
c iyr:      integer year relative to start year
c imon:     integer month (ranges from 1 to 12)
c g:        integer group counter
c step:     integer to add 1 to group loop if total group has to be calculated
c lmax:     logical variable denoting that a maximum value for a receptor has been found
c           this is used in case the maximum value for a receptor is 0 and never found
c adate:    character string of idate
      integer i,j,irec,iyr,imon,m,g,step
      logical lmax
      character adate*4
c      character ayr1*4,ayr2*4
      
     
c     inform user that calculations beginning

      write(*,10)nrec
      write(ilog,10)nrec      
      
c     initialize maxconc to -1 and maxall to all zeros
      maxconc=-1
      maxall=0
      
c     add 1 to ngrp if total group needs to be calculated
      if (lcalcgrp) then
        step=1
      else
        step=0
      endif


c     need to calculate a total group monthly calculation before averaging if necessary
      if (lcalcgrp) then
        do irec=1,nrec
          do g=1,ngrp
            do i=1,nmonth
              mconc(irec,ngrp+1,i)=mconc(irec,ngrp+1,i)+mconc(irec,g,i)
            enddo
          enddo
        enddo    
      endif
      
c     need to calculate a total group monthly calculation before averaging if necessary
c     if group was missing
      if (lmissall) then
        do irec=1,nrec
          do i=1,nmonth
             if (mconc(irec,ngrp,i) .eq. -1.0) then
               mconc(irec,ngrp,i) = 0.0
               do g=1,ngrp-1
                 mconc(irec,ngrp,i)=mconc(irec,ngrp,i)+mconc(irec,g,i)
               enddo
             endif
          enddo
       enddo    
      endif
      
c     begin averaging, start with month 3
c     there will not be a 3 month average for first 2 months of model output
      do i=3,nmonth
       write(adate,'(i4.4)')idate(i)
c      set j for 3 month averages 
       j=i-2
c      determine year of concentrations relative to start year (start year=1)
       read(adate(1:2),'(i2)')iyr
       if (iyr .lt. startyr2) iyr=iyr+100
       iyr=iyr-startyr2+1
c      get calendar month of year       
       read(adate(3:4),'(i2)')imon
c      calculate the 3-month rolling average for each receptor and group (including calculated total if needed)
       do irec=1,nrec              
        do g=1,ngrp+step                          
          conc3(irec,g,j)=(mconc(irec,g,i)+mconc(irec,g,i-1)+
     +    mconc(irec,g,i-2))/3.0
c         as rolling averages calculated, keep running overall maximum for each receptor
          if (conc3(irec,g,j) .gt. maxconc(irec)) then
c           assign the rolling average of the receptor to the maximum concentration for the receptor
c           and assign the associated group's group index to the maximum group index for the receptor
c           also assign the date of the concentration to the maxdate array for the receptor
            maxconc(irec)=conc3(irec,g,j)
            maxgrp(irec)=g
            maxdate(irec)=idate(i)
          endif
        enddo
       enddo
c       inform user that the month has been calculated
        write(*,12)trim(adjustl(months(imon))),startyr+iyr-1
        write(ilog,12)trim(adjustl(months(imon))),startyr+iyr-1
      enddo 

c     get the overall maximum concentration across all receptors
c     and the associated receptor index

      maxall=maxval(maxconc)
      maxrec=maxloc(maxconc)

c      write(*,11)
      write(ilog,11)
      
 10   format(/1x,'#############################',
     +  ' CALCULATIONS ','#############################'
     + //1x,'Calculating 3-month rolling averages for: ',i12,
     +  ' receptors'/)
 11   format(/1x,'###################################################',
     +  '#####################')
 12   format(1x,'Calculating 3-month average for:',1x,a,1x,i4)
      return
      end
c****************************************************************************
      subroutine summary
c subroutine to write 3-month average concentrations to text file
c and write maximum concentration by receptor to text file
c write overall maximum to screen and lead.log
c version 09096, changed concentration output format from 2 places past the decimal
c to 3 places past the decimal.

      use main1
      implicit none

c variables
c i:            integer month loop counter
c j:            integer month counter for 3 month averages (ranges from 1 to nmonth-2)
c irec:         integer receptor loop counter (ranges from 1 to nrec)
c iyr:          integer year relative to start year
c imon:         integer month (ranges from 1 to 12)
c maxyear:      integer calendar year of maximum concentration
c maxyear1:     integer year of maximum concenration relative to start year
c maxmonth:     integer calendar month of maximum concentration
c maxmonth1:    integer month (relative to start month) of maximum concentration
c m:            integer month of maximum date of individual receptor    
c g:            integer group counter
c y:            integer year of maximum date of individual receptor
c g1:           integer group index for total group
c istep:        integer to add 1 to group loop if total group has to be calculated
c g2:           integer group index of overall maximum group
c maxrec1:      integer value of maxrec(1)
c ayr1:         character string of 4 digit start year
c ayr2:         character string of 4 digit end year
c amon1:        character string of 2 digit start month
c amon2:        character string of 2 digit end month
c adate:        character string of date (used in various places in subroutine)
c groupmax:     character string of maximum overall group

      integer i,j,irec,iyr,imon,maxyear,maxmonth,m,g,y,g1,istep,
     +  maxyear1,maxmonth1,g2(1),maxrec1,imonths(3),iyrs(3),i1,maxindx,
     +  g3,mm(3)
      character ayr1*4,ayr2*4,adate*4,amon1*2,amon2*2,groupmax*8
      real concs(3)
      logical ldate,lgrp
c     open lead.out, summary file      
      open(unit=isum,file='lead.out',status='unknown')
      
      write(*,1)
      write(ilog,3)
      write(isum,1)
      ldate=.false.
c     create output filenames
c     write character strings of 4-digit start year and end year
c     and 2 digit months
      write(ayr1,'(i4.4)')startyr
      write(ayr2,'(i4.4)')endyr
      write(amon1,'(i2.2)')startmon
      write(amon2,'(i2.2)')endmon
      outfile3=amon1//'_'//ayr1//'_'//amon2//'_'//ayr2
     +  //'_3_month_concs.txt'
      maxfile=amon1//'_'//ayr1//'_'//amon2//'_'//ayr2
     +  //'_3_month_max_concs_rec.txt'
       maxrec1=maxrec(1)
c     create a character variable of the maximum date
      write(adate,'(i4.4)')maxdate(maxrec1)
      read(adate(1:2),'(i2)')y
c     account for century crossover because of 2-digit year
      if (y .lt. startyr2) y=y+100 
        
c     find the maximum year and add the leading 2 digits to the year
      maxyear=int(startyr/100)*100+y
c     get maxyear relative to start year
      maxyear1=y-startyr2+1
      
c     find the maximum month
      read(adate(3:4),'(i2)')maxmonth
c     get maximum months location in nmonth
      maxmonth1=(maxyear1-1)*12+maxmonth-startmon+1


c     assign value to istep for later group looping        
      if (lcalcgrp) then 
        istep=1
      else
        istep=0
      endif

c     open output files and write out the rolling averages for each 
c     receptor and also the max concentration by receptor/group
      open(unit=outunit1,file=outfile3,status='unknown')
      open(unit=maxunit,file=maxfile,status='unknown')
      
      
c     write out maximum concentration by receptor
c     write out x & y coordinates, elevation, flagpole height, max concentration,
c     group of maximum concentration, month, and 4 digit year

      do irec=1,nrec
        write(adate,'(i4.4)')maxdate(irec)
        read(adate(3:4),'(i2)')m
        read(adate(1:2),'(i2)')y
        if (lmonthly) then
          call getmonths(maxdate(irec),irec,maxgrp(irec),concs,imonths,
     +    iyrs)
          do i=1,3
            if (iyrs(i) .lt. startyr2) iyrs(i)=iyrs(i)+100
          enddo
        endif
        
c       account for century crossover
        if (y .lt. startyr2) y=y+100
        
!        write(maxunit,10)xrec(irec),yrec(irec),zelev(irec),zhill(irec),
!     +     zflag(irec),maxconc(irec),grp(maxgrp(irec)),
!     +    trim(adjustl(months(m))),int(startyr/100)*100+y
c new output statement
        if (lmonthly) then
          write(maxunit,11)xrec(irec),yrec(irec),zelev(irec),
     +     zhill(irec),zflag(irec),maxconc(irec),grp(maxgrp(irec)),
     +    trim(adjustl(months(m))),int(startyr/100)*100+y,
     +    concs(1),months(imonths(1)),int(startyr/100)*100+iyrs(1),
     +    concs(2),months(imonths(2)),int(startyr/100)*100+iyrs(2),
     +    concs(3),months(imonths(3)),int(startyr/100)*100+iyrs(3)
        else 
          write(maxunit,10)xrec(irec),yrec(irec),zelev(irec),
     +     zhill(irec),zflag(irec),maxconc(irec),grp(maxgrp(irec)),
     +    trim(adjustl(months(m))),int(startyr/100)*100+y
        endif
      enddo
      
c     write out the rolling averages
c     main loop is month loop, followed by receptor loop, and then group loop, with total group always
c     listed last for the group so that the sum of the individual groups can be easily compared to the 
c     total
c     begin writing file with month 3, first month to have rolling average
      do j=3,nmonth
c      determine year of concentrations relative to start year (start year=1)
        write(adate,'(i4.4)')idate(j)
        read(adate(1:2),'(i2)')iyr
       if (iyr .lt. startyr2) iyr=iyr+100
       iyr=iyr-startyr2+1
       
c      get calendar month of year       
       read(adate(3:4),'(i2)')imon
c      get 3 months of average
        if (lmonthly) then
          i1=0
          do i=j-2,j
            i1=i1+1
            write(adate,'(i4.4)')idate(i)
            read(adate(1:2),'(i2)')iyrs(i1)
            if (iyrs(i1) .lt. startyr2) iyrs(i1)=iyrs(i1)+100
            iyrs(i1)=iyrs(i1)-startyr2+1
            read(adate(3:4),'(i2)')imonths(i1)
          enddo
        endif
c       begin receptor loop
        do irec=1,nrec
c         begin group loop
          do g=1,ngrp+istep
c          skip the total group and put at end of groups for month and receptor combination
           if (grp(g) .eq. groupall) then         
             g1=g
           else
c            write output similar format to maximum concentration output file
             if (lmonthly) then
              write(outunit1,11)xrec(irec),yrec(irec),zelev(irec),
     +        zhill(irec),zflag(irec),conc3(irec,g,j-2),grp(g),
     +        trim(adjustl(months(imon))),startyr+(iyr-1),
     +        mconc(irec,g,j-2),months(imonths(1)),startyr+(iyrs(1)-1),
     +        mconc(irec,g,j-1),months(imonths(2)),startyr+(iyrs(2)-1),
     +        mconc(irec,g,j),months(imonths(3)),startyr+(iyrs(3)-1)
             else
              write(outunit1,10)xrec(irec),yrec(irec),zelev(irec),
     +        zhill(irec),zflag(irec),conc3(irec,g,j-2),grp(g),
     +        trim(adjustl(months(imon))),startyr+(iyr-1)
             endif
           endif
          enddo
c         write out total group concentration for month/receptor combination
          if (ngrp .gt. 1) then
            if (lmonthly) then
              write(outunit1,11)xrec(irec),yrec(irec),zelev(irec),
     +        zhill(irec),zflag(irec),conc3(irec,g1,j-2),grp(g1),
     +        trim(adjustl(months(imon))),startyr+(iyr-1),
     +        mconc(irec,g1,j-2),months(imonths(1)),startyr+(iyrs(1)-1),
     +        mconc(irec,g1,j-1),months(imonths(2)),startyr+(iyrs(2)-1),
     +        mconc(irec,g1,j),months(imonths(3)),startyr+(iyrs(3)-1)
            else
              write(outunit1,10)xrec(irec),yrec(irec),zelev(irec),
     +        zhill(irec),zflag(irec),conc3(irec,g1,j-2),grp(g1),
     +        trim(adjustl(months(imon))),startyr+(iyr-1)
            endif
          endif
        enddo
      enddo
         
c     get overall max across all groups  (this should always be equal to total group)
c     and write out overall maximum concentration
c     also write out group contributions for that concentration
      write(*,15)
      write(isum,15)

c     get index of maximum group and assign that group to groupmax
     
      g2=maxgrp(maxrec1)
      groupmax=grp(g2(1))
      if (groupmax .eq. groupall .and. ngrp .gt. 1) then
        write(*,16)
        write(isum,16)
      endif
      
      write(*,17)months(maxmonth),maxyear,
     + xrec(maxrec1),yrec(maxrec1),zelev(maxrec1),zhill(maxrec1),
     +  zflag(maxrec1),grp(maxgrp(maxrec1)),maxall
      write(isum,17)months(maxmonth),maxyear,xrec(maxrec1),
     + yrec(maxrec1),zelev(maxrec1),zhill(maxrec1),zflag(maxrec1),
     +  grp(maxgrp(maxrec1)),maxall

      
      call getmonths(maxdate(maxrec1),maxrec1,maxgrp(maxrec1),concs,
     +  imonths,iyrs)
      do i=1,3
          if (iyrs(i) .lt. startyr2) iyrs(i)=iyrs(i)+100
      enddo
c     find the index of maxmonth
      maxindx=1
      do while(maxindx .lt. nmonth .and. .not. ldate)
        if (maxdate(maxrec1) .eq. idate(maxindx)) ldate=.true.
        maxindx=maxindx+1
      enddo
      maxindx=maxindx-1
      mm(1)=maxindx-2
      mm(2)=maxindx-1
      mm(3)=maxindx
      if (groupmax .eq. groupall .and. ngrp .gt. 1) then
        call concsort(maxmonth1)

        do g=1,ngrp
          if (grpsrt(g) .ne. groupmax) then
            write(*,18)grpsrt(g),concsrt(g)
     
            write(isum,18)grpsrt(g),concsrt(g)
          endif
        enddo
      endif
c     version 12107 - add monthly contributions to average
c     version 13262 - corrected g3 variable on line 2186, originally was g1
      write(*,26)
      write(isum,26)
      do i=1,3
        write(*,27)grp(maxgrp(maxrec1)),concs(i),months(imonths(i)),
     +  int(startyr/100)*100+iyrs(i)
        write(isum,27)grp(maxgrp(maxrec1)),concs(i),months(imonths(i)),  
     +  int(startyr/100)*100+iyrs(i)
        if (groupmax .eq. groupall .and. ngrp .gt. 1) then
          do g=1,ngrp
            if (grpsrt(g) .ne. groupmax) then
              g3=1
              lgrp=.false.
              do while(g3 .le. ngrp .and. .not. lgrp)
                if (grpsrt(g) .eq. grp(g3)) lgrp=.true.
                g3=g3+1
              enddo
              g3=g3-1
              write(*,28)grpsrt(g),mconc(maxrec1,g3,mm(i)),
     +        months(imonths(i)),int(startyr/100)*100+iyrs(i)
              write(isum,28)grpsrt(g),mconc(maxrec1,g3,mm(i)),      
     +        months(imonths(i)),int(startyr/100)*100+iyrs(i)
            endif
          enddo
        endif
      enddo
c     write out names of output files      
      write(*,20)trim(adjustl(outfile3)),trim(adjustl(maxfile))
      write(ilog,20)trim(adjustl(outfile3)),trim(adjustl(maxfile))
      
c     if new group, not in the source group array was found in readtext or readpost
c     warn user again
      if (lnewgrp) then
        write(*,25)
        write(ilog,25)
      endif
      
      close(outunit1)
      close(maxunit)
      
      write(*,2)
      write(isum,2)
      close(isum)
      
 1    format(/1x,'################################',
     +  ' SUMMARY ','###############################')  
 2    format(//1x,'###################################################',
     +  '#####################')

! 2    format(//1x,'* Concentrations do not include background ',
!     +   'contributions'
!     +  //1x,'###################################################',
!     +  '#####################')
     
 3    format(/1x,'Calculating maximum concentrations')
c 10   format(2(f14.5,1x),3(f10.2,1x),f11.2,1x,a8,1x,a10,1x,i4)
! 10   format(2(f14.5,1x),3(f10.2,1x),f11.3,1x,a8,1x,a10,1x,i4)
 10   format(2(f14.5,1x),3(f10.2,1x),e13.6,1x,a8,1x,a10,1x,i4) !current version
 11   format(2(f14.5,1x),3(f10.2,1x),e13.6,1x,a8,1x,a10,1x,i4,1x,
     + 3(1x,e13.6,1x,a10,1x,i4))
 15   format(/1x,'Overall maximum 3-month averaged concentration')
 16   format(1x,'With individual source contributions')

 17   format(/,1x,'Month     Year              X              Y       ',
     + 'Elev    Hill ht   Flagpole'/
     + 1x,a10,i4,1x,2(f14.5,1x),3(f10.2,1x)
     + //1x,'Group     Concentration  '/1x,a8,1x,e13.6)
!     + //1x,'Group     Concentration  '/1x,a8,1x,f11.3)

c    + //1x,'Group     Concentration  '/1x,a8,1x,f11.2)

c 18   format(1x,a8,1x,f11.2)   
! 18   format(1x,a8,1x,f11.3)
 18   format(1x,a8,1x,e13.6)
 20   format(/' Rolling 3-month average concentrations by receptor ',
     +  'are in: '/1x,a//,' Maximum 3-month average concentrations by ',
     +  'receptor are in: '/1x,a//' End calculations')
 25   format(/1x,'WARNING!  A SOURCE GROUP WAS FOUND IN THE INPUT ',
     +  'CONCENTRATION FILES'/1x,'THAT IS NOT IN THE SOURCE GROUP LIST'
     +  /1x,'CHECK SOURCE GROUP LIST AND INPUTFILES.TXT') 
 26   format(/1x,'Monthly average concentrations for maximum 3-month ',
     + 'average concentration')
 27   format(/1x,a8,1x,e13.6,1x,a10,1x,i4)
 28   format(1x,a8,1x,e13.6,1x,a10,1x,i4)
      return
      end      
c********************************************************************
      subroutine getmonths(id,ir,ig,c,imons,iyears)
c     get monthly contributions to a rolling 3-month average
c     as well as the dates
      use main1
      implicit none
      integer n,n1,nn,imons(3),iyears(3),ir,ig,id
      real c(3)
      character adate*4
      logical ldate
      ldate=.false.
      c=0.0
      nn=0
      n=1
      do while(n .lt. nmonth .and. .not. ldate)
        if (id .eq. idate(n)) ldate=.true.
        n=n+1
      enddo
      n=n-1
      
      do n1=n-2,n
        nn=nn+1
        write(adate,'(i4.4)')idate(n1)
        read(adate(3:4),'(i2)')imons(nn)
        read(adate(1:2),'(i2)')iyears(nn)
        c(nn)=mconc(ir,ig,n1)
      enddo
      return
      end
c********************************************************************

      subroutine concsort(maxmnth)
c     this subroutine sorts the concentrations for the groups
c     associated with the overall maximum concentration
c     outputs are concentration and groups in descending order
c     by concentration
      use main1
      implicit none
      integer i,maxmnth,ig,j
      real max1
      character g*8
      
      allocate(grpsrt(ngrp+1))
      if (lcalcgrp) then
        allocate(concsrt(ngrp+1))
      else
        allocate(concsrt(ngrp))
      endif
c     initialize conc and grpsrt arrays
      do i=1,ngrp
        grpsrt(i)=grp(i)
        concsrt(i)=conc3(maxrec(1),i,maxmnth-2)
      enddo
      
      
      do i=1,ngrp-1
        max1=concsrt(i)
        g=grpsrt(i)
        ig=i
        do j=i+1,ngrp
          if (concsrt(j) .gt. max1) then
            max1=concsrt(j)
            ig=j
            g=grpsrt(j)
          endif
        enddo
        concsrt(ig)=concsrt(i)
        concsrt(i)=max1
        grpsrt(ig)=grpsrt(i)
        grpsrt(i)=g
      enddo
      return
      end
c********************************************************************
       subroutine upcase(a)
c subroutine to convert character strings to upper case
c input is lowercase character and output is uppercase written to same variable
c if input is non-alphabetic, then it is not changed

c variables
c i:        integer counter
c a:        character string being converted
c lower:    character string of lower case letters
c uppper:   character string of upper case letters

      integer i
      character a*1
      character lower*26,upper*26
      i=0
      lower='abcdefghijklmnopqrstuvwxyz'
      upper='ABCDEFGHIJKLMNOPQRSTUVWXYZ'
      
c     find location of string in lower case string
      i=index(lower,a)
c     find corresponding uppercase letter
      if (i .gt. 0) a=upper(i:i)
      return
      end     