subroutine time_process_day(mo1, iday)
!**** CALLED IN MAIN
!**** THIS SUBROUTINE COMPUTES ONE DAY
!****
!**** CALLED: IN MAIN
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
! PARAMETERS & VARIABLES
!
! ida - current day
! ieap - index for GRASS output in subbasin (yield)
! ieapu - index for GRASS output in subbasin (annual sums)
! xxswind - soil water index for basin
! xwysb - water yield for basin
! xnflow() - N flows for a chosen hydrotop
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
use catchment, only : bSubcatch, da, da9, subcatch_id, wy
use crop, only : icc, mfe
use erosion, only : &
chc, &
chxk, &
conn, &
cpp, &
er, &
xcklsp, &
xnorg, &
xnorgp, &
xporg, &
xpsedp
use evapotranspiration, only : &
canev, &
ecal, &
evapotranspiration_radiation, &
humi, &
omega, &
pit, &
ra, &
radiation_switch, &
snoev, &
tmn, &
ylc, &
yls
use groundwater, only : &
additionalGwUptake, &
revapst, &
xet
use hydrotope, only : smm
#ifdef with_netcdf
use input, only : input_nc_read_climate
#endif
use management, only : &
bWAM_Module, &
management_external_supply, &
management_is_transfer_subbasin, &
management_total_demand, &
wam_d, &
wam_y
use nutrient, only : &
degNgrw, &
degNsub, &
degNsur, &
degPsur, &
retNgrw, &
retNsub, &
retNsur, &
retPsur, &
xnflow, &
yon, &
yph
use output, only : &
area_tot_glacier, &
area_tot_snow, &
depth_ave_glacier, &
depth_ave_snow, &
ieapu, &
nsb, &
nvsub, &
output_day
use reservoir, only : &
bRsvModule, &
bRsvHydrograph, &
reservoir_is_operational, &
reservoir_process, &
reservoir_subbasin, &
rsvSubbasin, &
xwysb, &
xxswind
use river, only : &
accf, &
river_route, &
river_route_add, &
river_transfer, &
varoute
use snow, only : &
bSnowModule, &
sml, &
snowVal, &
tmx, &
ieapg
use soil, only : pr, psp, rtn, xqd
use subbasin, only : &
aff, &
dart, &
flu, &
icodes, &
ihouts, &
inum1s, &
inum2s, &
mb, &
mhyd, &
neap, &
nqobs, &
obs_discharge, &
obssb, &
precip, &
qtl, &
runs, &
runsubbasin, &
sbar, &
sbp, &
sda, &
smq, &
smsq, &
sub, &
subbasin_initialise_subbasin, &
subbasin_read_climate, &
subouthyd, &
subp, &
sumcn, &
susb, &
tx, &
wysb, &
xeo, &
xpercn, &
xqi, &
xsep, &
xssf, &
xssfn, &
xswind, &
xyno3
use subbasin, only : &
xysp, &
yd, &
bRunoffdat
use vegetation, only : daylen
integer, intent(in) :: mo1, iday
integer ii, iik, k
integer inum1, inum2
integer idum
integer icode, icodep, ihout
logical :: bRoute = .true. !#### RESERVOIR MODULE ####
!ls** compute day number in the year
if (mo1 .gt. 2) then
ida = iday + nc(mo1) - nt
else
ida = iday + nc(mo1)
endif
daycounter = daycounter + 1
area_tot_snow = 0.
depth_ave_snow = 0.
!###########################
!#### SNOW MODULE ####
!###########################
if (bSnowModule) then
ieapg = 1
area_tot_glacier = 0.
depth_ave_glacier = 0.
end if
!###########################
xxswind = 0.
xwysb = 0.
ieap = 1
ieapu = 1
do ii = 1, 20
xnflow(ii) = 0.
end do
do k = 1, nsb
sub(k) = 0.
end do
!#### CALL (NC_) READCLI - to read climate data daily
#ifdef with_netcdf
call input_nc_read_climate(flu, humi, mb, ra, subp, tmn, tmx, tx)
#else
call subbasin_read_climate(humi, mb, ra, subp, tmn, tmx, tx)
#endif
call time_day_length(daylen, ida, mb, pit, ylc, yls)
!### VA
!*********** For Radiation Data generated by Hargreaves Samani
if (radiation_switch > 0) then
call evapotranspiration_radiation(ida, mb, tmx)
end if
!### VA
!ls ndmo(mo) = ndmo(mo) + 1
!ls dtot = dtot + 1.
snoev = 0.
pr = 0.
!########################################################### START ROUTING
!#### CALL subbasin, route, transfer, add
do idum = 1, mhyd
icode = icodes(idum)
ihout = ihouts(idum)
inum1 = inum1s(idum)
inum2 = inum2s(idum)
if (icode .gt. 0) then
select case (icode)
case (1) ! SUBBASIN command
!#################################
!#### WATER MANAGEMENT MODULE ####
!#################################
if (bWAM_Module) then
if (ihout == 1) then
wam_y(daycounter) = iyr
wam_d(daycounter) = ida
end if
if (management_is_transfer_subbasin(inum1) ) then
! Summarise total inflow only from external sources and transmission losses
! Current day inflows from external sources are added to subbasins %inflow
! NOTE: Adding to routing variables sda(2, j) takes place in subroutine subbasin
call management_external_supply(inum1, daycounter, ida, iyr)
! calculate total water demand of water user(s)
! NOTE: nothing is removed here, just computation of total demand
call management_total_demand(inum1, daycounter, ida, iyr)
! Depending on whether the subbasin is a headwater or not
! inputs and outputs are added/removed in subroutines:
! 'subbasin' or 'add'
end if
end if
!###########################
!###########################
!#### RESERVOIR MODULE ####
!###########################
if (bRsvModule) then
! if actual subbasin is reservoir skip subbasin call
! TODO: include res_active function
if (rsvSubbasin(inum1) == 0 ) then
if (subcatch_id(inum1) .ne. 0) then
!write(*,*) 'Inside swim.f95::: olai(1, 1) = ', olai(1, 1)
call runsubbasin(ihout, inum1, bSubcatch, da, da9, daycounter, ida, ieap, iy, iyr, mo, nbyr, nd)
!write(*,*) 'Inside swim.f95::: olai(1, 1) After = ', olai(1,1)
end if
else
if (reservoir_is_operational(iyr, ida, inum1) ) then
call subbasin_initialise_subbasin(canev, sml, xcklsp, xet, xnorg, xnorgp, xporg, xpsedp, xqd, yon, yph)
call reservoir_subbasin(inum1, da, aff, dart, flu, neap, precip, qtl, sbp, sda, smq, smsq, snowval, sub, subp, sumcn, susb, tx, varoute, wysb, xeo, xpercn, xqi, xsep, xssf, xssfn, xswind, xyno3, xysp, yd, yon, yph)
else if (subcatch_id(inum1) .ne. 0) then
call runsubbasin(ihout, inum1, bSubcatch, da, da9, daycounter, ida, ieap, iy, iyr, mo, nbyr, nd)
end if
end if
! calculate subbasin but only if subbasin is listed in subcatch.def
! for convenient subsetting of model eg. by subcatchment
else if (subcatch_id(inum1) .ne. 0) then
call runsubbasin(ihout, inum1, bSubcatch, da, da9, daycounter, ida, ieap, iy, iyr, mo, nbyr, nd)
end if
!###########################
case (2) ! ROUTE command
bRoute = .true.
!###########################
!#### RESERVOIR MODULE ####
!###########################
if (bRsvModule) then
! If inum1 is a reservoir subbasin then...
if (bRsvHydrograph(ihout) ) then
! reservoir input is stored in varoute(2, inum2) and varoute(8, inum2)
! skip routing
! modify varoute(2, inum1), varoute(8, inum1) in reservoir functions
! DO NOT call route(icode, ihout, inum1, inum2)
if (reservoir_is_operational(iyr, ida, inum1) ) then
call reservoir_process(ihout, inum1, inum2, ecal, humi, ida, iyr, mo, nc, omega, ra, subp, tx, varoute)
bRoute = .false.
end if
else
bRoute = .true.
!call route(icode, ihout, inum1, inum2)
end if
end if
!###########################
if (bRoute) then
call river_route(ihout, inum1, inum2, chc, chxk, conn, cpp, da9, dart, er, flu, ida, iy, iyr, revapst, runs, sbar, sub, susb, xysp, yd, yon, yph)
end if
case (3) ! not implemented
! do nothing
case (4) ! not implemented
ihout = ihouts (idum - 1)
icodep = icodes (idum - 1)
call river_transfer() ! not implemented
case (5) ! ADD command
call river_route_add(bRunoffdat, ihout, inum1, inum2, additionalGwUptake, bWAM_Module, daycounter, ida, iyr, mb, nqobs, obssb, obs_discharge, runs, subouthyd, inum1s, bRsvModule, reservoir_is_operational(iyr, ida, inum2), rsvSubbasin)
case default ! do nothing
end select
end if ! (icode .gt. 0)
end do ! do idum = 1, mhyd
!########################################################### END ROUTING
!**** Calc wy - water yield
wy = sub(8) + sub(9) - sub(10) + sub(15) + 1.e-20
!**** Correction - sediment yield
sub(21) = sub(21) / da9
!**** Calculation of monthly sums
do iik = 1, nvsub
smm(iik) = smm(iik) + sub(iik)
end do
!**** Calc monthly water discharge
if (bRunoffdat) accf(7) = accf(7) + obs_discharge(ida, 1)
accf(8) = accf(8) + runs(ida)
call output_day(iyr, mo1, iday)
call log_progress('time_process_day', ida, nd)
call log_debug("time_process_day", "Completed day =", int=iday)
return
end subroutine time_process_day