#include <misc.h>#include <preproc.h>module histHandlerMod  use precision, only: r8  use clm_varpar, only : maxhist  implicit none! Variables  logical, private :: lrestwrt           !true => write restart file at this time step   integer, public  :: mcdate_i(maxhist)  !start of history interval date (yyyymmdd format)  integer, public  :: mcsec_i(maxhist)   !start of history interval seconds of current date  integer, public  :: mdcur_i(maxhist)   !start of history interval day   integer, public  :: mscur_i(maxhist)   !start of history interval seconds of current day         ! Methods   public  :: histhandler         !main history and restart handler   public  :: histend             !determines if end of history interval   public  :: do_restwrite        !returns logical setting if time to write restart data   private :: close_and_disp      !determine if file needs to be closed and archived   private :: set_hist_filename   !sets history dataset filenames  SAVE!=======================================================================CONTAINS!=======================================================================  subroutine histhandler ()!----------------------------------------------------------------------- ! ! Purpose: ! History file handler!! Method: ! This code does the following for every time step:!   o increments history field accumulation counters!   o determines if next time step is beginning of history interval!! This code does the following at the end of a history interval:!   o increments the current time sample counter: ntim <= hist_mfilt!   o opens a new history file if needed (i.e., when ntim = 1)!   o writes history data to current history file!   o resets field accumulation counters to zero!! This code does the following when a history file is full! (i.e., ntim = hist_mfilt) or at the last time step of the simulation:!   o closes history file and disposes to mass store if appropriate!   o resets time sample counter to zero if file is full!! This code does the following when the primary history file is full! (i.e., ntim = hist_mfilt) or at the last time step of the simulation:!   o writes restart file and disposes to mass store if appropriate! ! Author: Gordon Bonan! !-----------------------------------------------------------------------! $Id: histHandlerMod.F90,v 1.13.2.5 2002/04/27 15:38:48 erik Exp $!-----------------------------------------------------------------------    use clm_varctl, only : locfnh, hist_nhtfrq, hist_mfilt, &                           archive_dir, mss_wpass, mss_irt    use histFileMod, only : nhist, nbeghis, ntim, timcom, ncid, ehi, &                            histcrt, histwrt, histcls , histzero     use fileutils, only : set_filename, putfil    use spmdMod, only : masterproc    use time_manager, only : get_nstep, get_curr_date, get_curr_time    use shr_const_mod, only: SHR_CONST_CDAY    include 'netcdf.inc'! ------------------------ local variables ------------------------    integer  :: i                          !loop index    integer  :: m                          !history file do loop counter    integer  :: ier                        !error code    integer  :: day                        !current day (1 -> 31)    integer  :: mon                        !current month (1 -> 12)    integer  :: yr                         !current year (0 -> ...)    integer  :: mcsec                      !seconds of current date    integer  :: mdcur                      !current day     integer  :: mscur                      !seconds of current day    integer  :: mcdate                     !current date     logical  :: lhisdisp(nhist)            !true => save and dispose history file     logical  :: lremovh(nhist)             !true => remove local history file after dispose    logical  :: lstop                      !true => last time step of run     real(r8) :: frac_i                     !fractional day, start of time sample    real(r8) :: frac                       !current fractional day     real(r8) :: hour_i                     !fractional hour,start of time sample    real(r8) :: hour                       !current fractional hour     character(len=256) :: loc_fn           !local and remote filenames    character(len=256) :: rem_dir          !remote (archive) directory    character(len=256) :: rem_fn           !remote (archive) filename! -----------------------------------------------------------------! -----------------------------------------------------------------! Loop over history files: Increment history field counters, ! create new history files if necessary and write data to history ! files if end of history interval.! -----------------------------------------------------------------    do m = 1, nhist! Set [nbeghis] to one to indicate next time step is start of time sample       if (ehi(m)) then          nbeghis(m) = 1       else          nbeghis(m) = 0       end if! End of history interval?       if (ehi(m)) then! Increment current time sample counter.  If first time sample ! generate unique history file name and open netCDF file.          ntim(m) = ntim(m) + 1          if (masterproc) then             if (ntim(m) == 1) then                locfnh(m) = set_hist_filename (hist_freq=hist_nhtfrq(m), hist_file=m)                write(6,*)'(HISTHANDLER): Creating history file ', &                     trim(locfnh(m)),' at nstep = ',get_nstep()                call histcrt (m)             endif          end if! Build time comment for current time sample based on start of ! time slice calendar info and  current time calendar info           if (masterproc) then             call get_curr_time (mdcur, mscur)               call get_curr_date (yr, mon, day, mcsec)              mcdate = yr*10000 + mon*100 + day             frac_i = float(mscur_i(m))/SHR_CONST_CDAY             frac   = float(mscur     )/SHR_CONST_CDAY             hour_i = float(mcsec_i(m))/SHR_CONST_CDAY*24. !/3600. s per hr             hour   = float(mcsec     )/SHR_CONST_CDAY*24. !/3600. s per hr             write(timcom(m),200) &                  mdcur_i(m),frac_i,mdcur,frac,hour_i,mcdate_i(m),hour,mcdate200          format ('TIME AVG FOR DAYS: ',i6.6,f4.3,'-',i6.6,f4.3, &                  ' DATES:',f6.3,'Z ',i8.8,'-',f6.3,'Z ',i8.8)             write(6,*)             write(6,*)'(HISTHANDLER): Writing current time sample to local history file ',&                  trim(locfnh(m)),' at nstep = ',get_nstep()             write(6,*) trim(timcom(m))             write(6,*)          endif! Write history time sample          call histwrt(m)! Zero necessary history buffer information          call histzero(m)       end if    end do  ! end loop over history tapes! -----------------------------------------------------------------! Loop over history files and if history file is full ! (ntim = hist_mfilt) or if last time step ! o close history file and dispose to mass store if appropriate! o reset [ntim] time sample counter to zero (only if file is full)! -----------------------------------------------------------------! determine if file needs to be closed and disposed    call close_and_disp (lhisdisp, lstop, lremovh) ! loop over history files    do m = 1, nhist       if (lhisdisp(m)) then! Close open history file and dispose to mass store! Auxilary files may have been closed and saved off without being full,! must reopen the files          if (masterproc) then             if (ntim(m) /= 0) then                write(6,*)                write(6,*) '(HISTHANDLER): Closing local history file ',&                     trim(locfnh(m)),' at nstep = ', get_nstep()                write(6,*)                call histcls(m)                rem_dir = trim(archive_dir) // '/hist/'                rem_fn = set_filename(rem_dir, locfnh(m))                call putfil (locfnh(m), rem_fn, mss_wpass, mss_irt, lremovh(m))                if (.not.lstop .and. (ntim(m)/=hist_mfilt(m))) then                   call wrap_open (trim(locfnh(m)), NF_WRITE, ncid(m))                end if             else                write(6,*)'(HISTHANDLER): history file ',m,': no open file to close'             end if          endif! reset number of time samples to zero if file is full          if (ntim(m) == hist_mfilt(m)) then             ntim(m) = 0                            locfnh(m) = ' '          end if       end if  ! end of if-dispose block    end do     ! end of loop over tapes    return  end subroutine histhandler!=======================================================================  subroutine histend ()!----------------------------------------------------------------------- ! ! Purpose: ! Determine if end of history interval!! Method: !! Daily-averaged data for the first day in September ! are written on mcdate = 00/09/02 with mscur = 0! ! In general: daily-averaged data for the first day in! month mm are written on mcdate = yyyy/mm/02 with mscur = 0! ! Daily-averaged data for the 30th day (last day in September)! are written on mcdate = 0000/10/01 mscur = 0! ! In general: daily-averaged data for the last day in! month mm are written on mcdate = yyyy/mm+1/01 with mscur = 0!! Author: Gordon Bonan! !-----------------------------------------------------------------------    use clm_varctl , only : hist_mfilt, hist_nhtfrq, hist_crtinic    use histFileMod, only : ehi, nhist, nbeghis    use time_manager, only : get_nstep, get_curr_date, get_prev_date, get_curr_time! ------------------------ local variables ------------------------    integer :: m          !history file (1, ..., maxhist)    integer :: nstep      !current step    integer :: day        !nstep day (1 -> 31)    integer :: mon        !nstep month (1 -> 12)    integer :: yr         !nstep year (0 -> ...)    integer :: mcsec      !nstep time of day [seconds]    integer :: daym1      !nstep-1 day (1 -> 31)    integer :: monm1      !nstep-1 month (1 -> 12)    integer :: yrm1       !nstep-1 year (0 -> ...)    integer :: mcsecm1    !nstep-1 time of day [seconds]    integer :: mcdate     !nstep date in integer format [yyyymmdd]    integer :: mcdatem1   !nstep-1 date in integer format [yyyymmdd]    integer :: mdcur      !day for current nstep    integer :: mscur      !seconds of current day! -----------------------------------------------------------------! -----------------------------------------------------------------