c-----------------------------------------------------------------------
c --- RISEPOST -- Examines CALPUFF Numerical Rise Output
c-----------------------------------------------------------------------
c
c --- RISEPOST  Version: 1.02           Level: 110225              MAIN
c
c     Copyright (c) 2008-2011 by TRC Environmental Corporation
c               D. Strimaitis
c
c --- PURPOSE: Processor for the RISE.DAT output file from CALPUFF that
c              contains the plume-average properties computed in
c              NUMRISE at all integration steps along the plume axis
c              during the rise phase.  Based on user inputs, RISEPOST
c              summarizes aspects of the rise data.
c
c --- UPDATES:
c
c --- V 1.01  Level 090511  ====> V 1.02  Level 110225 (D.Strimaitis)
c     - CALUTILS from v2.571 Level 090511 to v2.58 Level 110225
c         Add control file variable type 5 (character array) and
c         retain commas in string returned so that array of
c         variable values can be parsed
c       Modified: READIN, ALTONU, SETVAR
c --- V 1.0  Level 080512  ====> V 1.01  Level 090511 (D.Strimaitis)
c     - CALUTILS from v2.56 Level 080407 to v2.571 Level 090511
c       Increase control file line length to 200 characters
c       Activate CPU clock using F95 system routine
c       Add routine to reformat a date string
c       New     : FMT_DATE
c       Modified: PARAMS.CAL, READIN, DATETM
c     - Reformat date reported to list file
c       Modified: FIN
c
c --- RISEPOST calls:     SETUP, COMP, FIN
c-----------------------------------------------------------------------
      Program RISEPOST

c --- Include parameters
      include 'params.nprise'
c --- Include common blocks
      include 'qa.nprise'

c --- Set version and level number of program (stored in /QA/ and
c --- checked against values set in PARAMS.NPRISE)
      ver='1.02'
      level='110225'

c --- SETUP PHASE -- read control file information
      call SETUP

c --- COMPUTATIONAL PHASE -- process data files
      call COMP

c --- TERMINATION PHASE -- program termination functions
      call FIN

      stop
      end

c----------------------------------------------------------------------
      BLOCK DATA
c----------------------------------------------------------------------
c
c --- RISEPOST  Version: 1.02           Level: 080512        BLOCK DATA
c               D. Strimaitis
c
c----------------------------------------------------------------------

c --- Include parameter statements
      include 'params.nprise'

c --- Include common blocks
      include 'filnam.nprise'
      include 'control.nprise'

c --- FILNAM common block
      data filectl/'risepost.inp'/,filelst/'risepost.lst'/,
     &     filedat/'rise.dat'/
c --- FILLOG common block
      data lcfiles/.true./

c --- CONTROL common block
      data wxmin/0.0/,wxmax/10.0/
      data nxbin/10/

      end

c----------------------------------------------------------------------
c --- BRING IN CALPUFF SYSTEM UTILITY SUBROUTINES
      include 'calutils.for'
c----------------------------------------------------------------------

c----------------------------------------------------------------------
      subroutine setup
c----------------------------------------------------------------------
c
c --- RISEPOST  Version: 1.02           Level: 080512             SETUP
c               D. Strimaitis
c
c PURPOSE:     SETUP calls routines to read and check the control data
c              provided, to set logicals, and it reports the control
c              data, and opens the data files if inputs are valid.
c
c --- INPUTS:
c ---    Common block /QA/ variables:
c           VER, LEVEL
c        Parameters: ICTL, ILST, IOMESG
c
c --- OUTPUT:  
c ---    Common block /CONTROL/ variables:
c           (all)
c
c --- SETUP called by:  MAIN
c --- SETUP calls:      DATETM, COMLINE, READCF, READHD
c----------------------------------------------------------------------
c --- Include file of parameters and commons
      include 'params.nprise'
      include 'control.nprise'
      include 'filnam.nprise'
      include 'qa.nprise'

c --- Get date and time from system
      call DATETM(rdate,rtime,rcpu)

c --- Get the name of the control file from the command line
      call COMLINE(filectl)

c --- Open the control file
      open(ictl,file=filectl,status='old')

c --- Report progress
      write(iomesg,*)'RISEPOST Processor'
      write(iomesg,*)'SETUP PHASE'

c --- Check that the version and level number in the parameter
c --- file matches those in the code itself
      if(ver.ne.mver.or.level.ne.mlevel)then
         write(iomesg,10) ver,level,mver,mlevel
10       format(/1x,'ERROR in SUBR. SETUP -- The RISEPOST version ',
     1   'and level numbers do not match those in the parameter file'/
     2   5x,'    Model Code - Version: ',a12,' Level: ',a12/
     3   5x,'Parameter File - Version: ',a12,' Level: ',a12)
         stop
      endif

c --- Read control file (open files)
      call READCF

c --- Write header lines to list-file

      write(ilst,*)
      write(ilst,*) '--------------------------'
      write(ilst,*) '    SETUP Information'
      write(ilst,*) '--------------------------'

c -----------------------------
c --- Report control data
c -----------------------------

      write(ilst,*)
      write(ilst,*) '         Control File Used: '//filectl
      write(ilst,*) ' Input Numerical Rise File: '//filedat
      write(ilst,*) 'Output Results (List) File: '//filelst

      write(ilst,*)
      write(ilst,*) 'Processing Options -----'
      write(ilst,*)
      write(ilst,*) '     Exceedence Counts are requested between'
      write(ilst,*) '     a minimum vertical velcity     = ',wxmin
      write(ilst,*) '     and a maximum vertical velcity = ',wxmax
      write(ilst,*) '     using a total number of bins   = ',nxbin
      write(ilst,*)
      write(ilst,*) 'Analysis performed for the following heights (m)'
      do n=1,nht
         write(ilst,*)'     ZHT = ',zht(n)
      enddo
      write(ilst,*)

c --- Process RISE.DAT header
      call READHD

      return
      end
c----------------------------------------------------------------------
      subroutine readcf
c----------------------------------------------------------------------
c
c --- RISEPOST  Version: 1.02           Level: 080512            READCF
c               D. Strimaitis
c
c --- PURPOSE:  Read the control file containing the file names of
c               the input and output files of the run, and associated
c               control variables, place into program variables,
c               and QA information.
c
c --- INPUTS:
c
c ---    Common block /QA/ variables:
c           VER, LEVEL
c
c        Parameters: ICTL, ILST, IOMESG, MXVAR
c
c --- OUTPUT:
c
c ---    Common block /FILNAM/ variables:
c           filelst,filedat
c           lcfiles
c ---    Common block /CONTROL/ variables:
c           wxmin, wxmax, nxbin, nht, zht(mxht)
c
c --- READCF called by:  SETUP
c --- READCF calls:      READIN, FILCASE
c----------------------------------------------------------------------
c
c --- Include parameter statements and commons
      include 'params.nprise'
      include 'params.cal'
c
c --- Include common blocks
      include 'control.nprise'
      include 'filnam.nprise'
      include 'qa.nprise'
c
c --- Local variables
      character*4 ctemp(132,2)
      character*12 cvdic(mxvar,4)
      integer ivleng(mxvar,4),ivtype(mxvar,4)
      logical lecho,lerrcf

c --- Initialize local variables
      data lecho/.false./, lerrcf/.false./
      data names/2/

c --- Set Dictionary

      data cvdic/
     a  'FILELST','FILEDAT','LCFILES', 57*' ',
     b  'MTYPE','NXBIN','WXMIN','WXMAX',  56*' ',
     c  'NHT',  59*' ',
     d  'ZHT',  59*' '/

      data ivleng/
     a  2*132,1, 57*0,
     b  4*1, 56*0,
     c  1, 59*0,
     d  mxhts, 59*0/

c --- Variable types (ivtype) are coded as:
c          0 = null
c          1 = real
c          2 = integer
c          3 = logical
c          4 = character
      data ivtype/
     a  2*4,3, 57*0,
     b  2*2,2*1, 56*0,
     c  2, 59*0,
     d  1, 59*0/

c ------------------
c --- Input Group 0
c ------------------

c --- Initialize the temporary arrays
      do i=1,names
         do j=1,132
            ctemp(j,i)(1:1)=' '
         enddo
      enddo

c --- Read the group data
       call READIN(cvdic(1,1),ivleng(1,1),ivtype(1,1),ictl,iomesg,
     & lecho,
     1 ctemp(1,1),ctemp(1,2),lcfiles,
     2 idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,
     3 idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,
     4 idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,
     5 idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,
     6 idum,idum,idum,idum,idum,idum,idum,idum,idum)

c --- Prepare any filenames included in the I/O file by erasing
c --- the default filename set above
      if(ctemp(1,1)(1:1).ne.' ')filelst=' '
      if(ctemp(1,2)(1:1).ne.' ')filedat=' '

c --- Transfer the char*4 data into the char*132 variables
      do j=1,132
         if(ctemp(j,1)(1:1).ne.' ')filelst(j:j)=ctemp(j,1)(1:1)
         if(ctemp(j,2)(1:1).ne.' ')filedat(j:j)=ctemp(j,2)(1:1)
      enddo

c --- Convert the file names to the proper case
      call FILCASE(lcfiles,filelst)
      call FILCASE(lcfiles,filedat)

c --- Open listfile
      open(ilst,file=filelst,status='unknown')
c --- Open datafile
      open(idat,file=filedat,status='old')

c --- Write banner to list file
      write(ilst,5) ver,level
5     format(///,26x,'RISEPOST OUTPUT SUMMARY',/,19x,'VERSION:  ',A12,
     1       ' LEVEL:  ',A12///)

c -----------------
c --- Input Group 1
c -----------------

      call READIN(cvdic(1,2),ivleng(1,2),ivtype(1,2),ictl,ilst,lecho,
     1 MTYPE,NXBIN,WXMIN,WXMAX,
     2 idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,
     3 idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,
     4 idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,
     5 idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,
     6 idum,idum,idum,idum,idum,idum,idum,idum)


c -------------------
c --- Input Group 2a
c -------------------

      call READIN(cvdic(1,3),ivleng(1,3),ivtype(1,3),ictl,ilst,lecho,
     1 NHT,
     2 idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,
     3 idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,
     4 idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,
     5 idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,
     6 idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum)

c -------------------
c --- Input Group 2b
c -------------------

c --- Expect NHT records
      do i=1,nht
         call READIN(cvdic(1,4),ivleng(1,4),ivtype(1,4),ictl,ilst,lecho,
     1    ZHT(i),
     2    idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,
     3    idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,
     4    idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,
     5    idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,
     6    idum,idum,idum,idum,idum,idum,idum,idum,idum,idum,idum)
      enddo

c ---------------------
c --- Perform QA checks
c ---------------------

c --- Test for valid MIN/MAX
      if(wxmin.GE.wxmax) then
         write(ilst,*)
         write(ilst,*) 'READCF:  Error in Input Group 1'
         write(ilst,*) 'WXMIN must be less than WXMAX'
         write(ilst,*) 'WXMIN, WXMAX = ',wxmin,wxmax
         lerrcf=.TRUE.
      endif

c --- Test for valid NXBIN
      if(nxbin.GT.mxbins) then
         write(ilst,*)
         write(ilst,*) 'READCF:  Error in Input Group 1'
         write(ilst,*) 'NXBIN must be less than MXBINS'
         write(ilst,*) 'NXBIN, MXBINS = ',nxbin,mxbins
         lerrcf=.TRUE.
      endif

c --- Test for valid NHT
      if(nht.LT.1 .OR. nht.GT.mxhts) then
         write(ilst,*)
         write(ilst,*) 'READCF:  Error in Input Group 2'
         write(ilst,*) 'NHT out of range         = ',nht
         write(ilst,*) 'NHT should be 1 to MXHTS = ',mxhts
         lerrcf=.TRUE.
      endif

c --- Heights must increase in the array
      do n=2,nht
         nm1=n-1
         if(zht(n).LE.zht(nm1)) then
            write(ilst,*)
            write(ilst,*) 'READCF:  Error in Input Group 2'
            write(ilst,*) 'Heights must increase in the array'
            write(ilst,*) '  i, zht(i) = ',n,zht(n)
            write(ilst,*) '  i, zht(i) = ',nm1,zht(nm1)
            lerrcf=.TRUE.
         endif
      enddo

c --- All heights must be greater than zero
      do n=1,nht
         if(zht(n).LE.0.0) then
            write(ilst,*)
            write(ilst,*) 'READCF:  Error in Input Group 2'
            write(ilst,*) 'All heights must be positive'
            write(ilst,*) '  i, zht(i) = ',n,zht(n)
            lerrcf=.TRUE.
         endif
      enddo

c --- STOP now if error exists in the control file
      if(LERRCF) then
         write(*,*)'ERRORS are found in the CONTROL file'
         write(*,*)'Review messages written to the LIST file'
         stop
      endif

c --- Set the minimum number of bins for exceedence-counts
      nxbin=MAX(nxbin,2)

      return
      end

c-----------------------------------------------------------------------
      subroutine readhd
c-----------------------------------------------------------------------
c
c --- RISEPOST  Version: 1.02           Level: 080512            READHD
c               D. Strimaitis
c
c PURPOSE:     READHD reads the header records of an input data file
c
c --- INPUTS:
c        Parameters: IDAT, ILST
c
c --- OUTPUT:
c             none
c
c --- READHD called by:  SETUP
c --- READHD calls:      ALLCAP
c-----------------------------------------------------------------------
c --- Include file of parameters and commons
      include 'params.nprise'
      include 'params.cal'

c --- Local Variables
      integer msrc(16)
      character*4 xyunitin,zunitin,utmhemin
      character*8 pmapin,datumin,atzin
      character*12 datenin
      character*16 dataset,dataver,cname16,blank16
      character*16 clat0in,clon0in,clat1in,clat2in
      character*16 stype(8)
      character*64 datamod
      character*132 comment1
      logical lutmin,llccin,lpsin,lemin,llazain,lttmin

      data nlim/1/
      data blank16/'                '/
      data stype/'Constant Point  ','Variable Point  ',
     &           'Constant Area   ','Variable Area   ',
     &           'Constant Line   ','Variable Line   ',
     &           'Constant Volume ','Variable Volume '/

      lutmin =.FALSE.
      llccin =.FALSE.
      lpsin  =.FALSE.
      lemin  =.FALSE.
      llazain=.FALSE.
      lttmin =.FALSE.

      clat0in=blank16
      clon0in=blank16
      clat1in=blank16
      clat2in=blank16


c --- Read header information
c ---------------------------
      write(ilst,*)
      write(ilst,*)'---------------------------------------------'
      write(ilst,*)'Selected header records from input data file:'
      write(ilst,*)'---------------------------------------------'
      write(ilst,*)

c --- Dataset, Version, Modifier
      read(idat,'(2a16,a64)') dataset,dataver,datamod
      write(ilst,'(2a16,a64)') dataset,dataver,datamod
c --- Convert Dataset to upper case
      do i=1,16
         call ALLCAP(dataset(i:i),nlim)
      enddo

c --- QA dataset type
      if(dataset.NE.'RISE.DAT') then
c ---    FATAL ERROR
         write(ilst,*)
         write(ilst,*)'RDHEAD: Invalid file DATASET type: ',dataset
         write(ilst,*)'        Expected RISE.DAT'
         stop 'Halted in READHD -- see list file'
      endif

c --- Number of comment records
      read(idat,*) ncomment
c --- Comments (optional/repeatable)
      do k=1,ncomment
         read(idat,'(a132)') comment1
      enddo

c --- Map projection
      read(idat,'(a8)') pmapin
      write(ilst,'(a8)') pmapin
      do i=1,8
         call ALLCAP(pmapin(i:i),nlim)
      enddo

      if(pmapin.EQ.'UTM     ')  lutmin =.TRUE.
      if(pmapin.EQ.'LCC     ')  llccin =.TRUE.
      if(pmapin.EQ.'PS      ')  lpsin  =.TRUE.
      if(pmapin.EQ.'EM      ')  lemin  =.TRUE.
      if(pmapin.EQ.'LAZA    ')  llazain=.TRUE.
      if(pmapin.EQ.'TTM     ')  lttmin =.TRUE.

c --- Map projection parameters
      if(LUTMIN) then
         read(idat,'(i4,a4)') izonein,utmhemin
         write(ilst,'(i4,a4)') izonein,utmhemin
      elseif(LLCCIN) then
         read(idat,'(4a16)') clat0in,clon0in,clat1in,clat2in
         write(ilst,'(4a16)') clat0in,clon0in,clat1in,clat2in
      elseif(LPSIN) then
         read(idat,'(3a16)') clat0in,clon0in,clat1in
         write(ilst,'(3a16)') clat0in,clon0in,clat1in
      elseif(LEMIN.or.LLAZAIN.or.LTTMIN) then
         read(idat,'(2a16)') clat0in,clon0in
         write(ilst,'(2a16)') clat0in,clon0in
      endif
c --- Map false Easting/Northing
      if(LLCCIN.or.LLAZAIN.or.LTTMIN) then
         read(idat,*) feastin,fnorthin
         write(ilst,*) feastin,fnorthin
      else
         feastin=0.0
         fnorthin=0.0
      endif
c --- Map DATUM
      read(idat,'(a8,a12)') datumin,datenin
      write(ilst,'(a8,a12)') datumin,datenin
      do i=1,8
         call ALLCAP(datumin(i:i),nlim)
      enddo
c --- XYUNIT
      read(idat,'(a4)') xyunitin
      write(ilst,'(a4)') xyunitin
c --- ATZIN (time zone)
      read(idat,'(a8)') atzin
      write(ilst,'(a8)') atzin

c --- Sources in file (8 pairs of type, number)
      read(idat,*) msrc
      write(ilst,*) msrc
c --- Loop over source types (8)
      nsrc=0
      do n=1,8
         k=2*n
         j=k-1
         if(n.NE.msrc(j)) then
c ---       FATAL ERROR
            write(ilst,*)
            write(ilst,*)'RDHEAD: Invalid source type in RISE.DAT file'
            write(ilst,*)'        Expected 1 through 8, found:'
            write(ilst,*)'        Type, Number '
            do nn=1,8
               kk=2*nn
               jj=kk-1
               write(ilst,*)'        ',msrc(jj),msrc(kk)
            enddo
            stop 'Halted in READHD -- see list file'
         endif
c ---    Require 1 source, of type 1,2, or 4 (numrise sources)
         if(n.EQ.1) nsrc=nsrc+msrc(k)
         if(n.EQ.2) nsrc=nsrc+msrc(k)
         if(n.EQ.4) nsrc=nsrc+msrc(k)
      enddo
      if(nsrc.NE.1) then
c ---    FATAL ERROR
         write(ilst,*)
         write(ilst,*)'RDHEAD: Invalid sources in RISE.DAT file'
         write(ilst,*)'        Expected 1 source, found: ',nsrc
         stop 'Halted in READHD -- see list file'
      endif
c --- Source Name
      read(idat,*) itype,cname16
      write(ilst,*) itype,cname16
      write(ilst,*)
      write(ilst,*)
      write(ilst,*)
      write(ilst,*)'---------------------------------------------'
      write(ilst,*)'Source Information'
      write(ilst,*)'---------------------------------------------'
      write(ilst,*)
      write(ilst,'(3x,a36)') stype(itype)//'    '//cname16
      write(ilst,*)
      write(ilst,*)'Data for last period processed:'

      return
      end

c----------------------------------------------------------------------
      subroutine comp
c----------------------------------------------------------------------
c
c --- RISEPOST  Version: 1.02           Level: 080512              COMP
c ---           D. Strimaitis
c
c --- PURPOSE:  Main computational routine
c
c --- INPUTS:
c       Parameters: IOMESG, IDAT, ILST
c
c --- OUTPUT:  none
c
c --- COMP called by:  MAIN
c --- COMP calls:      
c----------------------------------------------------------------------
c
c --- include parameters
      include 'params.nprise'

c --- include common blocks
      include 'control.nprise'
      include 'rise.nprise'

c --- Local variables
      character*6 txta,txtb,txtc
      real val(mxhts)
      real datarec(16)
c --- (s,x,y,z,rad,us,u,v,w,denp,tp,ua,dena,ta,dudz,dpdz)

c --- Establish initial max and min values
      data wmin0/10000./
      data wmax0/-1./

c --- Set output text
      data txta/'   #> '/
      data txtb/'   m/s'/
      data txtc/' -----'/

c --- Report progress
      write(iomesg,*)'COMPUTATIONAL PHASE'

c --- Create the threshold values for exceedence counts
      valexc(1)=wxmin
      valexc(nxbin)=wxmax
      if(nxbin.GT.2) then
         nstep=nxbin-1
         vstep=(wxmax-wxmin)/FLOAT(nstep)
         do n=2,nxbin-1
            valexc(n)=valexc(n-1)+vstep
         enddo
      endif

c --- Initial timestep set to zero
      nyrdhb0=0
      nsecb0=0
      nyrdhe0=0
      nsece0=0
c --- Initial emissions step set to zero
      nyrdhqb0=0
      nsecqb0=0
      nyrdhqe0=0
      nsecqe0=0
c --- Initialize stored values
      do k=1,mxhts
         val(k)=-999.
         numval(k)=0
         valsum(k)=0.0
         valmin(k)=wmin0
         valmax(k)=wmax0
         do j=1,mxbins
            numexc(j,k)=0
         enddo
      enddo

c --- Loop over data blocks in the RISE.DAT file
c ----------------------------------------------

c --- Block header records (skip the 4th record)
10    read(idat,*,end=99) nyrdhb,nsecb,nyrdhe,nsece
      read(idat,*) ityp,isrc,xs,ys,zelev,zs,tdegk,reff,weff,mprime
      read(idat,*) nyrdhqb,nsecqb,nyrdhqe,nsecqe,nrec
      read(idat,*)

c --- Is this a new block or a replacement?
c ---      iblock=0 ERROR
c ---      iblock=1 new
c ---      iblock=2 replacement
      iblock=0
      if(nyrdhb.GT.nyrdhb0 .OR.
     &  (nyrdhb.EQ.nyrdhb0 .AND. nsecb.GT.nsecb0)) then
c ---    New timestep
         iblock=1
      elseif(nyrdhb.EQ.nyrdhb0 .AND. nsecb.EQ.nsecb0) then
         if(mprime.EQ.1) then
c ---       Replacement timestep (PRIME call to numrise)
            iblock=2
         elseif(nyrdhqb.GT.nyrdhqb0 .OR.
     &         (nyrdhqb.EQ.nyrdhqb0 .AND. nsecqb.GT.nsecqb0)) then
c ---       New timestep (use every emissions substep)
            iblock=1
         endif
      endif

      if(iblock.LE.0 .OR. iblock.GT.2) then
c ---    Trap ERROR
         write(ilst,*)'ERROR in COMP:  invalid time period found'
         write(ilst,*)'Last timestep: ',nyrdhb0,nsecb0,nyrdhe0,nsece0
         write(ilst,*)'This timestep: ',nyrdhb,nsecb,nyrdhe,nsece
         write(ilst,*)'Last emission: ',nyrdhqb0,nsecqb0,nyrdhqe0,
     &                 nsecqe0
         write(ilst,*)'This emission: ',nyrdhqb,nsecqb,nyrdhqe,
     &                 nsecqe
         stop 'Halted in COMP -- See list file'
      endif

      if(iblock.EQ.1) then
c ---    New block is read, so process data from last block
c ---    Update stored values
         do k=1,nht
            if(val(k).GE.0.0) then
               numval(k)=numval(k)+1
               valsum(k)=valsum(k)+val(k)
               if(valmin(k).GT.val(k)) valmin(k)=val(k)
               if(valmax(k).LT.val(k)) valmax(k)=val(k)
c ---          Update exceedence counts
               do j=1,nxbin
                  if(val(k).GT.valexc(j)) numexc(j,k)=numexc(j,k)+1
               enddo
            endif
         enddo
      endif

c --- Update stored time periods
      nyrdhb0=nyrdhb
      nsecb0=nsecb
      nyrdhe0=nyrdhe
      nsece0=nsece
      nyrdhqb0=nyrdhqb
      nsecqb0=nsecqb
      nyrdhqe0=nyrdhqe
      nsecqe0=nsecqe

c --- Read data records and store w-speed at or just below requested
c --- levels
      do n=1,nrec
         read(idat,*) datarec
         do k=1,nht
c ---       Update stored w at heights greater than height just read
            if(datarec(4).LE.zht(k)) val(k)=datarec(9)
         enddo
      enddo

c --- Clear heights above the last height found
      do k=1,mxhts
         if(datarec(4).LT.zht(k)) val(k)=-999.
      enddo

c --- Check for another period in file
      goto 10

c --- All records in RISE.DAT have been scanned
99    continue

c --- Process the final period read from file
c --- Update stored values
      do k=1,nht
         if(val(k).GE.0.0) then
            numval(k)=numval(k)+1
            valsum(k)=valsum(k)+val(k)
            if(valmin(k).GT.val(k)) valmin(k)=val(k)
            if(valmax(k).LT.val(k)) valmax(k)=val(k)
c ---       Update exceedence counts
            do j=1,nxbin
               if(val(k).GT.valexc(j)) numexc(j,k)=numexc(j,k)+1
            enddo
         endif
      enddo

c --- Turn sum into average and condition missing levels
      do k=1,nht
         if(numval(k).GT.0) then
            valsum(k)=valsum(k)/FLOAT(numval(k))
         else
            valsum(k)=0.0
            valmin(k)=0.0
            valmax(k)=0.0
         endif
      enddo

c --- Report source information to list file
      write(ilst,*)'Location           ',xs,ys
      write(ilst,*)'Elevation (m MSL)  ',zelev
      write(ilst,*)'Release Height (m) ',zs
      write(ilst,*)'Temperature (K)    ',tdegk
      write(ilst,*)'Release Radius (m) ',reff
      write(ilst,*)'Exit Velocity (m/s)',weff
      write(ilst,*)
      write(ilst,*)


c --- Report results to list file
      write(ilst,*)
      write(ilst,*)'--------------------------------------------------'
      write(ilst,*)'Results for Vertical Velocity at Requested Heights'
      write(ilst,*)'--------------------------------------------------'
      write(ilst,*)
      write(ilst,*)'Vertical velocities are from the Numerical Plume'
      write(ilst,*)'Rise module within CALPUFF.  This module solves'
      write(ilst,*)'for plume rise incrementally along the trajectory'
      write(ilst,*)'using plume properties averaged across its'
      write(ilst,*)'cross-section.'
      write(ilst,*)
      write(ilst,*)
      write(ilst,*)'Height   Minimum W   Maximum W   Average W     #'
      write(ilst,*)'m(AGL)      m/s         m/s         m/s'
      write(ilst,*)'------   ---------   ---------   ---------   -----'
      write(ilst,*)
      do k=nht,1,-1
         write(ilst,'(f7.1,3x,f8.1,2(4x,f8.1),i9)') zht(k),valmin(k),
     &                                 valmax(k),valsum(k),numval(k)
      enddo
      write(ilst,*)
      write(ilst,*)
      write(ilst,'(7x,3x,40a6)')(txta,j=1,nxbin)
      write(ilst,'(1x,a6,3x,40f6.1)')'Height',(valexc(j),j=1,nxbin)
      write(ilst,'(1x,a6,3x,40a6)')'m(AGL)',(txtb,j=1,nxbin)
      write(ilst,'(1x,a6,3x,40a6)')'------',(txtc,j=1,nxbin)
      write(ilst,*)
      do k=nht,1,-1
         write(ilst,'(f7.1,3x,40i6)') zht(k),(numexc(j,k),j=1,nxbin)
      enddo

      return
      end

c----------------------------------------------------------------------
      subroutine fin
c----------------------------------------------------------------------
c
c --- RISEPOST Version: 1.02            Level: 090511               FIN
c ---          J. Scire, D. Strimaitis
c
c --- PURPOSE:  Run termination routine -- compute runtime
c
c --- UPDATE
c --- V1.0 (080512) to V1.01 (090511)  (DGS)
c        - Reformat date reported at end of run
c
c --- INPUTS:
c       Common block /QA/
c          rdate, rtime, rcpu
c       Parameters: ILST, IOMESG
c
c --- OUTPUT:  none
c
c --- FIN called by:  MAIN
c --- FIN calls:      DATETM, JULDAY, DELTT, FMT_DATE
c----------------------------------------------------------------------

c --- Include parameters
      include 'params.nprise'
      include 'qa.nprise'

      character*8 rtime2
      character*10 rdate2
      character*12 rdate12

      write(iomesg,*)'TERMINATION PHASE'

c --- Get system date & time at end of run
      call DATETM(rdate2,rtime2,rcpu)

c --- Compute runtime
      read(rtime(1:2),10)ihr1
      read(rtime(4:5),10)imin1
      read(rtime(7:8),10)isec1
10    format(i2)
      t1=ihr1*3600.+imin1*60.+isec1

      read(rtime2(1:2),10)ihr2
      read(rtime2(4:5),10)imin2
      read(rtime2(7:8),10)isec2
      t2=ihr2*3600.+imin2*60.+isec2

      if(rdate.eq.rdate2)then
         delt=t2-t1
      else
         read(rdate(1:2),10)imo1
         read(rdate(4:5),10)iday1
         read(rdate(7:10),'(i4)')iyr1
         call JULDAY(iomesg,iyr1,imo1,iday1,ijul1)

         read(rdate2(1:2),10)imo2
         read(rdate2(4:5),10)iday2
         read(rdate2(7:10),'(i4)')iyr2
         call JULDAY(iomesg,iyr2,imo2,iday2,ijul2)

c ---    Compute no. hours from beg. of first hour of run to
c ---    ending hour of ending day of the run
         call DELTT(iyr1,ijul1,ihr1,iyr2,ijul2,ihr2,idelhr)

c ---    Adjust for minutes and seconds
         delt=idelhr*3600.-imin1*60.-isec1+imin2*60.+isec2
      endif

c --- On the PC, the runtime and CPU time are the same
c --- (DATETM provides RCPU = 0.0 on the PC)
      if(rcpu.EQ.0.0)rcpu=delt

c --- Report current date
      rdate12=rdate2(1:10)//'  '
      call FMT_DATE(ilst,'MM-DD-YYYY','DD-MMM-YYYY',rdate12)
      write(ilst,1402)rtime2,rdate12,NINT(delt),NINT(rcpu)
1402  format(//2x,'End of run -- Clock time: ',a8/
     1         2x,'                    Date: ',a12//
     2         2x,'      Elapsed Clock Time: ',i12,' (seconds)'//
     3         2x,'                CPU Time: ',i12,' (seconds)')

      return
      end
