diff --git a/route/build/src/historyFile.f90 b/route/build/src/historyFile.f90 index 96d841d1..ea03ff8f 100644 --- a/route/build/src/historyFile.f90 +++ b/route/build/src/historyFile.f90 @@ -310,15 +310,17 @@ SUBROUTINE write_loc_rch(this, reach_id, ierr, message) ! --------------------------------- ! writing time variables ! --------------------------------- - SUBROUTINE write_time(this, hvars_local, ierr, message) + SUBROUTINE write_time(this, hVars_local, time_stamp_Local, ierr, message) implicit none ! Argument variables class(histFile), intent(inout) :: this - type(histVars), intent(in) :: hVars_local + type(histVars), intent(in) :: hVars_local ! history variable structure + character(len=strLen), intent(in) :: time_stamp_local ! time stamp for time variable: front, end, or middle integer(i4b), intent(out) :: ierr ! error code character(*), intent(out) :: message ! error message ! local variables + real(dp) :: timeVar_write ! time variable [time_unit] character(len=strLen) :: cmessage ! error message of downwind routine ierr=0; message='write_time/' @@ -326,7 +328,13 @@ SUBROUTINE write_time(this, hvars_local, ierr, message) this%iTime = this%iTime + 1 ! this is only line to increment time step index ! write time -- note time is just carried across from the input - call write_netcdf(this%pioFileDesc, 'time', [hVars_local%timeVar(1)], [this%iTime], [1], ierr, cmessage) + select case(trim(time_stamp_local)) + case('front'); timeVar_write = hVars_local%timeVar(1) + case('end'); timeVar_write = hVars_local%timeVar(2) + case('middle'); timeVar_write = (hVars_local%timeVar(1)+hVars_local%timeVar(2))/2.0 + end select + + call write_netcdf(this%pioFileDesc, 'time', [timeVar_write], [this%iTime], [1], ierr, cmessage) if(ierr/=0)then; message=trim(message)//trim(cmessage); return; endif call write_netcdf(this%pioFileDesc, 'time_bounds', hVars_local%timeVar, [1,this%iTime], [2,1], ierr, cmessage) diff --git a/route/build/src/mc_route.f90 b/route/build/src/mc_route.f90 index eac4164a..2e4e859d 100644 --- a/route/build/src/mc_route.f90 +++ b/route/build/src/mc_route.f90 @@ -302,7 +302,7 @@ SUBROUTINE muskingum_cunge(rch_param, & ! input: river parameter data struct C2 = (1-X-Cn*Y)/(1-X+Cn*(1-Y)) QoutLocal(ix) = C0* QinLocal(ix)+ C1* QinLocal(ix-1)+ C2* QoutLocal(ix-1) - QoutLocal(ix) = max(0.0, QoutLocal(ix)) + QoutLocal(ix) = max(0.0_dp, QoutLocal(ix)) ! -- EBK 06/26/2023 -- comment out isnan check, doesn't seem to be needed. !if (isnan(QoutLocal(ix))) then diff --git a/route/build/src/nr_utils.f90 b/route/build/src/nr_utils.f90 index 81998088..94ccfd62 100644 --- a/route/build/src/nr_utils.f90 +++ b/route/build/src/nr_utils.f90 @@ -365,7 +365,7 @@ pure SUBROUTINE unique_i8b(array, unq, idx) integer(i4b),allocatable,intent(out) :: idx(:) ! integer array including unique element index ! local integer(i4b) :: ranked(size(array)) ! - integer(i4b) :: unq_tmp(size(array)) ! + integer(i8b) :: unq_tmp(size(array)) ! logical(lgt) :: flg_tmp(size(array)) ! integer(i4b) :: ix ! loop index, counter integer(i8b) :: last_unique ! last unique element diff --git a/route/build/src/public_var.f90 b/route/build/src/public_var.f90 index 26f44220..dc0c1573 100644 --- a/route/build/src/public_var.f90 +++ b/route/build/src/public_var.f90 @@ -137,6 +137,7 @@ MODULE public_var real(dp) ,public :: input_fillvalue = realMissing ! fillvalue used for input variables (runoff, precipitation, evaporation) character(len=strLen),public :: ro_time_units = charMissing ! time units used in ro netcdf. format should be since yyyy-mm-dd (hh:mm:ss). () can be omitted character(len=strLen),public :: ro_calendar = charMissing ! calendar used in ro netcdf + character(len=strLen),public :: ro_time_stamp = 'front' ! time stamp used for I/O - front (default), middle, or end, otherwise error ! Water-management input netCDF - water abstraction/infjection or lake target volume character(len=strLen),public :: fname_wm = '' ! the txt file name that includes nc files holesing the abstraction, injection, target volume values character(len=strLen),public :: vname_flux_wm = '' ! variable name for abstraction or injection from or to a river segment diff --git a/route/build/src/read_control.f90 b/route/build/src/read_control.f90 index cd72ee48..9fe5df35 100644 --- a/route/build/src/read_control.f90 +++ b/route/build/src/read_control.f90 @@ -124,6 +124,7 @@ SUBROUTINE read_control(ctl_fname, err, message) case(''); read(cData,*,iostat=io_error) continue_run ! logical; T-> append output in existing history files. F-> write output in new history file case(''); routOpt = trim(cData) ! routing scheme options 0-> accumRunoff, 1->IRF, 2->KWT, 3-> KW, 4->MC, 5->DW case(''); read(cData,*,iostat=io_error) doesBasinRoute ! basin routing options 0-> no, 1->IRF, otherwise error + case(''); read(cData,*,iostat=io_error) dt ! time interval of the simulation [sec] (To-do: change dt to dt_sim) case(''); read(cData,*,iostat=io_error) is_lake_sim ! logical; lakes are simulated case(''); read(cData,*,iostat=io_error) is_flux_wm ! logical; provided fluxes to or from seg/lakes should be considered case(''); read(cData,*,iostat=io_error) is_vol_wm ! logical; provided target volume for managed lakes are considered @@ -135,7 +136,6 @@ SUBROUTINE read_control(ctl_fname, err, message) case(''); read(cData,*,iostat=io_error) is_Ep_upward_negative ! logical; flip evaporation in case upward direction is negative in input values convention case(''); read(cData,*,iostat=io_error) scale_factor_prec ! float; factor to scale the precipitation values case(''); read(cData,*,iostat=io_error) offset_value_prec ! float; offset for precipitation values - case(''); read(cData,*,iostat=io_error) dt ! time interval of the simulation [sec] (To-do: change dt to dt_sim) ! RIVER NETWORK TOPOLOGY case(''); fname_ntopOld = trim(cData) ! name of file containing stream network topology information case(''); read(cData,*,iostat=io_error) ntopAugmentMode ! option for river network augmentation mode. terminate the program after writing augmented ntopo. @@ -158,6 +158,7 @@ SUBROUTINE read_control(ctl_fname, err, message) case(''); read(cData,*,iostat=io_error) input_fillvalue ! fillvalue used for input variable case(''); ro_calendar = trim(cData) ! name of calendar used in runoff input netcdfs case(''); ro_time_units = trim(cData) ! time units used in runoff input netcdfs + case(''); ro_time_stamp = trim(cData) ! time stamp used input - front, middle, or end, otherwise error ! Water-management input netCDF - water abstraction/infjection or lake target volume case(''); fname_wm = trim(cData) ! name of text file containing ordered nc file names case(''); vname_flux_wm = trim(cData) ! name of varibale for fluxes to and from seg (reachs/lakes) @@ -434,6 +435,18 @@ SUBROUTINE read_control(ctl_fname, err, message) err=81; return end select + ! ---------- I/O time stamp ------- + if (masterproc) then + write(iulog,'(2a)') new_line('a'), '---- input time stamp --- ' + write(iulog,'(2A)') ' Input time stamp : ', trim(ro_time_stamp) + if (trim(ro_time_stamp)=='front' .or. trim(ro_time_stamp)=='end' .or. trim(ro_time_stamp)=='middle') then + write(iulog,'(2A)') ' The same time stamp is used for history output' + else + write(message, '(2A)') trim(message), 'ERROR: Input time stamp must be front, end, or middle' + err=81; return + end if + end if + ! ---------- simulation time step, output frequency, file frequency ------- if (masterproc) then write(iulog,'(2a)') new_line('a'), '---- output/simulation time steps --- ' diff --git a/route/build/src/standalone/get_basin_runoff.f90 b/route/build/src/standalone/get_basin_runoff.f90 index 73003f54..5218e449 100644 --- a/route/build/src/standalone/get_basin_runoff.f90 +++ b/route/build/src/standalone/get_basin_runoff.f90 @@ -70,7 +70,7 @@ SUBROUTINE get_hru_runoff(ierr, message) runoff_data%basinRunoff = 0._dp ! replacing with zeros else ! time step mapping from runoff time step to simulation time step - call timeMap_sim_forc(tmap_sim_ro, begDatetime, robegDatetime, dt_ro, iTime, inFileInfo_ro, ierr, cmessage) + call timeMap_sim_forc(tmap_sim_ro, begDatetime, roBegDatetime, dt_ro, iTime, inFileInfo_ro, ierr, cmessage) if(ierr/=0) then; message=trim(message)//trim(cmessage); return; endif ! get the simulated runoff for the current time step - runoff_data%sim(:) or %sim2D(:,:) diff --git a/route/build/src/standalone/model_setup.f90 b/route/build/src/standalone/model_setup.f90 index 16874ba0..3a4cde79 100644 --- a/route/build/src/standalone/model_setup.f90 +++ b/route/build/src/standalone/model_setup.f90 @@ -319,13 +319,18 @@ END SUBROUTINE inFile_pop ! private subroutine: initialize time data ! ********************************************************************* SUBROUTINE init_time(ierr, message) + ! purpose: Save the following time related global variables - ! - time_units - ! - calendar - ! - timeVar - ! - iTime - ! - begDatetime, endDatetime: simulationg start and end datetime - ! - restDatetime, dropDatetime + ! - dt_ro: forcing time step [sec] + ! - dt_wm: water-management data time step [sec] + ! - time_units: time units used for simulation datetime. format=" since yyyy-mm-dd hh:mm:ss" + ! - calendar: calendar used for simulation datetime + ! - timeVar: time variable [sec] for simulation (since referece datetime + ! - iTime: time index of simulation time step + ! - begDatetime: datetime at front of 1st simulation time step period + ! - endDatetime: datetime at front of last simulation time step period + ! - restDatetime: datetime at front of restart simulation time step period + ! - dropDatetime: datetime at front of simulation time step period when restart file is written USE ascii_utils, ONLY: lower ! convert string to lower case USE datetime_data, ONLY: datetime ! datetime data @@ -346,15 +351,16 @@ SUBROUTINE init_time(ierr, message) USE public_var, ONLY: restart_day ! periodic restart day USE public_var, ONLY: restart_hour ! periodic restart hr USE public_var, ONLY: maxTimeDiff ! time difference tolerance for input checks + USE public_var, ONLY: ro_time_stamp ! time stamp for runoff input: front, end or middle of time step USE globalData, ONLY: timeVar ! time variables at time step endpoints (unit given by runoff data) USE globalData, ONLY: iTime ! time index at simulation time step USE globalData, ONLY: sec2tunit ! seconds per time unit USE globalData, ONLY: simDatetime ! model time data (yyyy:mm:dd:hh:mm:ss) - USE globalData, ONLY: begDatetime ! simulation begin datetime data (yyyy:mm:dd:hh:mm:sec) - USE globalData, ONLY: endDatetime ! simulation end datetime data (yyyy:mm:dd:hh:mm:sec) - USE globalData, ONLY: restDatetime ! restart time data (yyyy:mm:dd:hh:mm:sec) - USE globalData, ONLY: dropDatetime ! restart dropoff calendar date/time - USE globalData, ONLY: roBegDatetime ! forcing data start datetime data (yyyy:mm:dd:hh:mm:sec) + USE globalData, ONLY: begDatetime ! simulation begin datetime data (yyyy:mm:dd:hh:mm:sec). front of time step + USE globalData, ONLY: endDatetime ! simulation end datetime data (yyyy:mm:dd:hh:mm:sec). front of time step + USE globalData, ONLY: restDatetime ! restart time data (yyyy:mm:dd:hh:mm:sec). front of time step + USE globalData, ONLY: dropDatetime ! restart dropoff calendar date/time. front of time step + USE globalData, ONLY: roBegDatetime ! forcing data start datetime data (yyyy:mm:dd:hh:mm:sec) front of time step USE globalData, ONLY: wmBegDatetime ! water-managment data start datetime data (yyyy:mm:dd:hh:mm:sec) USE globalData, ONLY: infileinfo_ro ! the information of the input files USE globalData, ONLY: infileinfo_wm ! the information of the input files @@ -433,14 +439,22 @@ SUBROUTINE init_time(ierr, message) end if endif - ! runoff data time step [sec] + ! runoff data time step [sec]- dt_ro is saved dt_ro = roTimeVar_diff(1) - ! datetime at end of last runoff data time step - roDatetime_end = roCal(nTime)%add_sec(dt_ro, ierr, cmessage) - - ! datetime at start of first runoff data time step - roBegDatetime = roCal(1) + ! datetime of runoff time at front of the 1st time step: roBegDatetime (global data) + ! datetime of runoff time at end of last time step: roDatetime_end (local data) + select case(trim(ro_time_stamp)) + case('front') + roBegDatetime = roCal(1) + roDatetime_end = roCal(nTime)%add_sec(dt_ro, ierr, cmessage) + case('end') + roBegDatetime = roCal(1)%add_sec(-dt_ro, ierr, cmessage) + roDatetime_end = roCal(nTime) + case('middle') + roBegDatetime = roCal(1)%add_sec(-dt_ro/2.0, ierr, cmessage) + roDatetime_end = roCal(nTime)%add_sec(dt_ro/2.0, ierr, cmessage) + end select call begDatetime%str2datetime(simStart, calendar, ierr, cmessage) if(ierr/=0) then; message=trim(message)//trim(cmessage)//' [begDatetime]'; return; endif @@ -463,7 +477,7 @@ SUBROUTINE init_time(ierr, message) endif ! Compare sim_start vs. time at first time step in runoff data - if (begDatetime < roCal(1)) then + if (begDatetime < roBegDatetime) then write(iulog,'(2a)') new_line('a'),'WARNING: is before the first time step in input runoff' write(iulog,fmt1) ' runoff_start: ', roCal(1)%year(),'-',roCal(1)%month(),'-',roCal(1)%day(), roCal(1)%hour(),':', roCal(1)%minute(),':',roCal(1)%sec() write(iulog,fmt1) ' : ', begDatetime%year(),'-',begDatetime%month(),'-',begDatetime%day(), begDatetime%hour(),':', begDatetime%minute(),':',begDatetime%sec() diff --git a/route/build/src/write_simoutput_pio.f90 b/route/build/src/write_simoutput_pio.f90 index 3e1becd6..d34577a5 100644 --- a/route/build/src/write_simoutput_pio.f90 +++ b/route/build/src/write_simoutput_pio.f90 @@ -131,20 +131,21 @@ END FUNCTION newFileAlarm ! ********************************************************************* SUBROUTINE output(ierr, message) - USE public_var, ONLY: outputAtGage ! ascii containing last restart and history files - USE public_var, ONLY: nOutFreq ! - USE public_var, ONLY: outputFrequency ! - USE globalData, ONLY: simDatetime ! previous,current and next model datetime - USE globalData, ONLY: timeVar ! current simulation time variable - USE globalData, ONLY: sec2tunit ! seconds per time unit - USE globalData, ONLY: RCHFLX_trib ! reach flux data structure containing current flux variables - USE globalData, ONLY: rch_per_proc ! number of reaches assigned to each proc (size = num of procs+1) - USE globalData, ONLY: nRch_mainstem ! number of mainstem reach - USE globalData, ONLY: nTribOutlet ! number of - USE globalData, ONLY: index_write_gage ! reach index (w.r.t. global domain) corresponding gauge location - USE globalData, ONLY: ioDesc_hru_float ! pio decomposition descriptor for hru - USE globalData, ONLY: ioDesc_rch_float ! pio decomposition descriptor for reaches - USE globalData, ONLY: ioDesc_gauge_float ! pio decomposition descriptor for gauges + USE public_var, ONLY: outputAtGage ! ascii containing last restart and history files + USE public_var, ONLY: nOutFreq ! integer output frequency, i.e, written at every "nOutFreq" of simulation step + USE public_var, ONLY: outputFrequency ! writing frequency + USE public_var, ONLY: time_stamp => ro_time_stamp ! + USE globalData, ONLY: simDatetime ! previous,current and next model datetime + USE globalData, ONLY: timeVar ! current simulation time variable + USE globalData, ONLY: sec2tunit ! seconds per time unit + USE globalData, ONLY: RCHFLX_trib ! reach flux data structure containing current flux variables + USE globalData, ONLY: rch_per_proc ! number of reaches assigned to each proc (size = num of procs+1) + USE globalData, ONLY: nRch_mainstem ! number of mainstem reach + USE globalData, ONLY: nTribOutlet ! number of + USE globalData, ONLY: index_write_gage ! reach index (w.r.t. global domain) corresponding gauge location + USE globalData, ONLY: ioDesc_hru_float ! pio decomposition descriptor for hru + USE globalData, ONLY: ioDesc_rch_float ! pio decomposition descriptor for reaches + USE globalData, ONLY: ioDesc_gauge_float ! pio decomposition descriptor for gauges USE nr_utils, ONLY: arth implicit none @@ -203,7 +204,7 @@ SUBROUTINE output(ierr, message) end if ! write time variables (time and time bounds) - call hist_all_network%write_time(hVars, ierr, cmessage) + call hist_all_network%write_time(hVars, time_stamp, ierr, cmessage) if(ierr/=0)then; message=trim(message)//trim(cmessage); return; endif ! write out output variables in history files @@ -220,7 +221,7 @@ SUBROUTINE output(ierr, message) if (outputAtGage) then ! write time variables (time and time bounds) - call hist_gage%write_time(hVars, ierr, cmessage) + call hist_gage%write_time(hVars, time_stamp, ierr, cmessage) if(ierr/=0)then; message=trim(message)//trim(cmessage); return; endif call hist_gage%write_flux_rch(hVars, ioDesc_gauge_float, index_write_gage, ierr, cmessage)