Skip to content
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
25 changes: 24 additions & 1 deletion build/FUSE_SRC/driver/fuse_evaluate.f90
Original file line number Diff line number Diff line change
Expand Up @@ -21,6 +21,7 @@ SUBROUTINE fuse_evaluate(XPAR, info, work, domain, OUTPUT_FLAG, METRIC_VAL)
! Modified by Cyril Thébault to allow different metrics as objective function, 2024
! Modified by Martyn Clark to call differentiable modeling routines, 12/2025
! Modified by Martyn Clark to simplify/refactor, 02/2026
! Modified by Cyril Thébault to include interception, 7/2026
! ---------------------------------------------------------------------------------------
! Purpose:
! --------
Expand Down Expand Up @@ -374,7 +375,7 @@ subroutine advance_one_cell(work, sub_idx, iSpat1, iSpat2, dt_sub, dt_full, err,
use multistate, only: gState_3d, FSTATE, MSTATE
use multiroute, only: MROUTE, AROUTE_3d
use multibands
use multi_flux, only: W_FLUX, W_FLUX_3d
use multi_flux, only: W_FLUX, W_FLUX_3d, M_FLUX
use set_all_module, only: SET_STATE, SET_FLUXES, SET_ROUTE

! state vector conversions
Expand Down Expand Up @@ -485,6 +486,28 @@ subroutine advance_one_cell(work, sub_idx, iSpat1, iSpat2, dt_sub, dt_full, err,

end select

! -------------------------
! interception
! -------------------------
select case(diff_mode)

case(original)
M_FLUX%PIN0 = M_FLUX%EFF_PPT
call UPDATE_INTERCEPTION(DELTIM)

case(differentiable)
if (SMODL%iINTRC /= iopt_no_intrcep) then
err = 1
message = 'advance_one_cell: interception not yet implemented for differentiable mode'
return
end if

case default
err = 1
message = 'advance_one_cell: cannot identify diff_mode (interception)'
return

end select
! -------------------------
! soil physics
! -------------------------
Expand Down
9 changes: 7 additions & 2 deletions build/FUSE_SRC/physics_orig/evap_lower.f90
Original file line number Diff line number Diff line change
Expand Up @@ -20,6 +20,11 @@ SUBROUTINE EVAP_LOWER()
USE multistate ! model states
USE multi_flux ! model fluxes
IMPLICIT NONE
REAL(WP) :: PET_SOIL

! Potential evaporation remaining after interception evaporation
PET_SOIL = MAX(0._wp, MFORCE%PET - M_FLUX%EVAP_0)

! ---------------------------------------------------------------------------------------
SELECT CASE(SMODL%iARCH2) ! lower layer architecture
CASE(iopt_tens2pll_2,iopt_fixedsiz_2)
Expand All @@ -32,9 +37,9 @@ SUBROUTINE EVAP_LOWER()
! -----------------------------------------------------
SELECT CASE(SMODL%iESOIL)
CASE(iopt_sequential)
M_FLUX%EVAP_2 = (MFORCE%PET-M_FLUX%EVAP_1) * (TSTATE%TENS_2/DPARAM%MAXTENS_2)
M_FLUX%EVAP_2 = MAX(0._wp, PET_SOIL-M_FLUX%EVAP_1) * (TSTATE%TENS_2/DPARAM%MAXTENS_2)
CASE(iopt_rootweight)
M_FLUX%EVAP_2 = MFORCE%PET * DPARAM%RTFRAC2 * (TSTATE%TENS_2/DPARAM%MAXTENS_2)
M_FLUX%EVAP_2 = PET_SOIL * DPARAM%RTFRAC2 * (TSTATE%TENS_2/DPARAM%MAXTENS_2)
CASE DEFAULT
print *, "SMODL%iESOIL must be either iopt_sequential or iopt_rootweight"
END SELECT ! (evaporation schemes)
Expand Down
17 changes: 11 additions & 6 deletions build/FUSE_SRC/physics_orig/evap_upper.f90
Original file line number Diff line number Diff line change
Expand Up @@ -20,6 +20,11 @@ SUBROUTINE EVAP_UPPER()
USE multistate ! model states
USE multi_flux ! model fluxes
IMPLICIT NONE
REAL(WP) :: PET_SOIL

! Potential evaporation remaining after interception evaporation
PET_SOIL = MAX(0._wp, MFORCE%PET - M_FLUX%EVAP_0)

! ---------------------------------------------------------------------------------------
SELECT CASE(SMODL%iARCH1) ! upper layer architecture
! --------------------------------------------------------------------------------------
Expand All @@ -29,12 +34,12 @@ SUBROUTINE EVAP_UPPER()
! -----------------------------------------------------
SELECT CASE(SMODL%iESOIL)
CASE(iopt_sequential)
M_FLUX%EVAP_1A = MFORCE%PET * TSTATE%TENS_1A/DPARAM%MAXTENS_1A
M_FLUX%EVAP_1B = (MFORCE%PET - M_FLUX%EVAP_1A) * TSTATE%TENS_1B/DPARAM%MAXTENS_1B
M_FLUX%EVAP_1A = PET_SOIL * TSTATE%TENS_1A/DPARAM%MAXTENS_1A
M_FLUX%EVAP_1B = MAX(0._wp, PET_SOIL - M_FLUX%EVAP_1A) * TSTATE%TENS_1B/DPARAM%MAXTENS_1B
M_FLUX%EVAP_1 = M_FLUX%EVAP_1A + M_FLUX%EVAP_1B
CASE(iopt_rootweight)
M_FLUX%EVAP_1A = MFORCE%PET * MPARAM%RTFRAC1 * TSTATE%TENS_1A/DPARAM%MAXTENS_1A
M_FLUX%EVAP_1B = MFORCE%PET * DPARAM%RTFRAC2 * TSTATE%TENS_1B/DPARAM%MAXTENS_1B
M_FLUX%EVAP_1A = PET_SOIL * MPARAM%RTFRAC1 * TSTATE%TENS_1A/DPARAM%MAXTENS_1A
M_FLUX%EVAP_1B = PET_SOIL * DPARAM%RTFRAC2 * TSTATE%TENS_1B/DPARAM%MAXTENS_1B
M_FLUX%EVAP_1 = M_FLUX%EVAP_1A + M_FLUX%EVAP_1B
CASE DEFAULT
print *, "SMODL%iESOIL must be either iopt_sequential or iopt_rootweight"
Expand All @@ -49,11 +54,11 @@ SUBROUTINE EVAP_UPPER()
CASE(iopt_sequential)
M_FLUX%EVAP_1A = 0._wp
M_FLUX%EVAP_1B = 0._wp
M_FLUX%EVAP_1 = MFORCE%PET * TSTATE%TENS_1/DPARAM%MAXTENS_1
M_FLUX%EVAP_1 = PET_SOIL * TSTATE%TENS_1/DPARAM%MAXTENS_1
CASE(iopt_rootweight)
M_FLUX%EVAP_1A = 0._wp
M_FLUX%EVAP_1B = 0._wp
M_FLUX%EVAP_1 = MFORCE%PET * MPARAM%RTFRAC1 * TSTATE%TENS_1/DPARAM%MAXTENS_1
M_FLUX%EVAP_1 = PET_SOIL * MPARAM%RTFRAC1 * TSTATE%TENS_1/DPARAM%MAXTENS_1
CASE DEFAULT
print *, "SMODL%iESOIL must be either iopt_sequential or iopt_rootweight"
END SELECT ! (evaporation schemes)
Expand Down
84 changes: 84 additions & 0 deletions build/FUSE_SRC/physics_orig/update_interception.f90
Original file line number Diff line number Diff line change
@@ -0,0 +1,84 @@
SUBROUTINE UPDATE_INTERCEPTION(DT)

Copy link
Copy Markdown
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I really think we need to formulate this as an ODE for consistency with the FUSE soil model.

Consider
dS/dt = P - P_thru - E_can
where
S = canopy storage
P = precipitation (mm/day)
E_thru = throughfall (mm/day)
E_can = canopy evaporation (mm/day)
t = time (days)

Your throughfall formulation was
P_thru = 0 if S < Smax
P_thru = P otherwise

This is equivalent to
P_thru = P * phi(S)
where phi(S) = P_thru/P is the fraction of precipitation that passes through the canopy without being intercepted.

phi(S) can be parameterized as a logistic function:
phi(S) = sigma((S-Smax)/k)
where sigma(x) = 1/(1+exp(-x)) and x= (S-Smax)/k

here
Smax is defined as the characteristic interception storage at which half of the incident precipitation becomes throughfall (phi=0.5)
k is a smoothing parameter (units of storage) that controls the sharpness of the transition between complete interception and complete throughfall.

Your canopy evaporation formulation was
E_can = 0 if S=0
E_can = PET otherwise

This is equivalent to
E_can = w(S) * PET
where in your formulation w(S)=0 when S=0 and w(S)=1 otherwise.

We interpret w(S) as the wetted fraction of the canopy, where w(S) partitions potential ET into the energy available for canopy evaporation and soil transpiration (transpiration occurs over the dry fraction of the leaves).

Similar to your formulation, we can replace this discontinuous wetness function with a smooth function of interception storage,
w(S)=S/(S+eps)
where eps is a storage scale parameter controlling the transition from a dry to a fully wetted canopy. Very small values of eps are essentially equivalent to your original step function everywhere except very close to S=0.

since this is a scalar equation it can be solved easily using a safe newton raphson algorithm with bi-section. you can also do this with explicit euler in a way that handles solution constraints.

Note in this formulation that S can be a little bit more than Smax (the amount controlled by the width of the logistic function). Hence we view Smax more of a scaling parameter.

! ---------------------------------------------------------------------------------------
! Creator:
! --------
! Cyril Thebault, 2026
! ---------------------------------------------------------------------------------------
! Purpose:
! --------
! Updates the interception store over one forcing interval.
!
! PIN0 : precipitation entering the interception store [depth/time]
! EVAP_0 : evaporation from the interception store [depth/time]
! PTHRU : throughfall leaving the interception store [depth/time]
! SINT_0 : interception storage [depth]
! MAXSINT_0 : maximum interception storage [depth]
! ---------------------------------------------------------------------------------------

USE nrtype
USE model_defn
USE model_defnames
USE multiparam
USE multiforce, ONLY: MFORCE
USE multistate
USE multi_flux

IMPLICIT NONE

REAL(WP), INTENT(IN) :: DT

REAL(WP) :: WATER_AVAILABLE
REAL(WP) :: WATER_REMAIN
REAL(WP) :: EVAP_AMOUNT
REAL(WP) :: PTHRU_AMOUNT

IF (DT <= 0._wp) THEN
PRINT *, 'UPDATE_INTERCEPTION: DT must be greater than zero'
STOP
END IF

SELECT CASE(SMODL%iINTRC)

CASE(iopt_no_intrcep)

M_FLUX%EVAP_0 = 0._wp
M_FLUX%PTHRU = M_FLUX%PIN0
FSTATE%SINT_0 = 0._wp

CASE(iopt_gr5h_intrc)

IF (MPARAM%MAXSINT_0 < 0._wp) THEN
PRINT *, 'UPDATE_INTERCEPTION: MAXSINT_0 must not be negative'
STOP
END IF

WATER_AVAILABLE = MAX(0._wp, FSTATE%SINT_0) &
+ MAX(0._wp, M_FLUX%PIN0) * DT

EVAP_AMOUNT = MIN( &
MAX(0._wp, MFORCE%PET) * DT, &
WATER_AVAILABLE &
)

WATER_REMAIN = WATER_AVAILABLE - EVAP_AMOUNT

PTHRU_AMOUNT = MAX( &
0._wp, &
WATER_REMAIN - MPARAM%MAXSINT_0 &
)

FSTATE%SINT_0 = WATER_REMAIN - PTHRU_AMOUNT

M_FLUX%EVAP_0 = EVAP_AMOUNT / DT
M_FLUX%PTHRU = PTHRU_AMOUNT / DT

CASE DEFAULT

PRINT *, 'SMODL%iINTRC must be iopt_no_intrcep or iopt_gr5h_intrc'
STOP

END SELECT

M_FLUX%EFF_PPT = M_FLUX%PTHRU

END SUBROUTINE UPDATE_INTERCEPTION
22 changes: 19 additions & 3 deletions build/FUSE_SRC/prelim/assign_flx.f90
Original file line number Diff line number Diff line change
Expand Up @@ -31,11 +31,29 @@ SUBROUTINE ASSIGN_FLX()
N_FLUX=0
C_FLUX(:)%FNAME = ' '
! ---------------------------------------------------------------------------------------
! (0) INTERCEPTION
! ---------------------------------------------------------------------------------------
SELECT CASE(SMODL%iINTRC)

CASE(iopt_no_intrcep)
N_FLUX=N_FLUX+1; C_FLUX(N_FLUX)%FNAME = 'EFF_PPT '

CASE(iopt_gr5h_intrc)
N_FLUX=N_FLUX+1; C_FLUX(N_FLUX)%FNAME = 'PIN0 '
N_FLUX=N_FLUX+1; C_FLUX(N_FLUX)%FNAME = 'PTHRU '
N_FLUX=N_FLUX+1; C_FLUX(N_FLUX)%FNAME = 'EVAP_0 '
N_FLUX=N_FLUX+1; C_FLUX(N_FLUX)%FNAME = 'EFF_PPT '

CASE DEFAULT
print *, "SMODL%iINTRC must be iopt_no_intrcep or iopt_gr5h_intrc"
STOP

END SELECT
! ---------------------------------------------------------------------------------------
! (1) DEFINE STATE VARIABLES IN THE UPPER LAYER
! ---------------------------------------------------------------------------------------
SELECT CASE(SMODL%iARCH1)
CASE(iopt_tension2_1)
N_FLUX=N_FLUX+1; C_FLUX(N_FLUX)%FNAME = 'EFF_PPT '
N_FLUX=N_FLUX+1; C_FLUX(N_FLUX)%FNAME = 'EVAP_1A '
N_FLUX=N_FLUX+1; C_FLUX(N_FLUX)%FNAME = 'EVAP_1B '
N_FLUX=N_FLUX+1; C_FLUX(N_FLUX)%FNAME = 'RCHR2EXCS '
Expand All @@ -45,15 +63,13 @@ SUBROUTINE ASSIGN_FLX()
N_FLUX=N_FLUX+1; C_FLUX(N_FLUX)%FNAME = 'OFLOW_1 '
N_FLUX=N_FLUX+1; C_FLUX(N_FLUX)%FNAME = 'QSURF '
CASE(iopt_tension1_1)
N_FLUX=N_FLUX+1; C_FLUX(N_FLUX)%FNAME = 'EFF_PPT '
N_FLUX=N_FLUX+1; C_FLUX(N_FLUX)%FNAME = 'EVAP_1 '
N_FLUX=N_FLUX+1; C_FLUX(N_FLUX)%FNAME = 'TENS2FREE_1'
N_FLUX=N_FLUX+1; C_FLUX(N_FLUX)%FNAME = 'QPERC_12 '
N_FLUX=N_FLUX+1; C_FLUX(N_FLUX)%FNAME = 'QINTF_1 '
N_FLUX=N_FLUX+1; C_FLUX(N_FLUX)%FNAME = 'OFLOW_1 '
N_FLUX=N_FLUX+1; C_FLUX(N_FLUX)%FNAME = 'QSURF '
CASE(iopt_onestate_1)
N_FLUX=N_FLUX+1; C_FLUX(N_FLUX)%FNAME = 'EFF_PPT '
N_FLUX=N_FLUX+1; C_FLUX(N_FLUX)%FNAME = 'EVAP_1 '
N_FLUX=N_FLUX+1; C_FLUX(N_FLUX)%FNAME = 'QPERC_12 '
N_FLUX=N_FLUX+1; C_FLUX(N_FLUX)%FNAME = 'QINTF_1 '
Expand Down
27 changes: 20 additions & 7 deletions build/FUSE_SRC/prelim/assign_par.f90
Original file line number Diff line number Diff line change
Expand Up @@ -11,6 +11,7 @@ SUBROUTINE ASSIGN_PAR()
! --------
! Martyn Clark, 2007
! Modified by Brian Henn to include snow model, 6/2013
! Modified by Cyril Thebault to include interception, 7/2026
! ---------------------------------------------------------------------------------------
! Purpose:
! --------
Expand Down Expand Up @@ -80,7 +81,19 @@ SUBROUTINE ASSIGN_PAR()
STOP
END SELECT
! ---------------------------------------------------------------------------------------
! (3) UPPER-LAYER ARCHITECTURE
! (3) INTERCEPTION
! ---------------------------------------------------------------------------------------
SELECT CASE(SMODL%iINTRC)
CASE(iopt_no_intrcep) ! no interception store
CASE(iopt_gr5h_intrc) ! grh5 interception store
MPAR=MPAR+1; LPARAM(MPAR)%PARNAME = 'MAXSINT_0' ! maximum interception storage (mm)
CASE DEFAULT
print *, "SMODL%iINTRC must be either iopt_no_intrcep or iopt_gr5h_intrc"
STOP

END SELECT
! ---------------------------------------------------------------------------------------
! (4) UPPER-LAYER ARCHITECTURE
! ---------------------------------------------------------------------------------------
SELECT CASE(SMODL%iARCH1)
CASE(iopt_tension2_1) ! tension storage sub-divided into recharge and excess
Expand All @@ -96,7 +109,7 @@ SUBROUTINE ASSIGN_PAR()
STOP
END SELECT ! (different upper-layer architechure)
! ---------------------------------------------------------------------------------------
! (4) LOWER-LAYER ARCHITECTURE / BASEFLOW
! (5) LOWER-LAYER ARCHITECTURE / BASEFLOW
! ---------------------------------------------------------------------------------------
SELECT CASE(SMODL%iARCH2)
CASE(iopt_tens2pll_2) ! tension reservoir plus two parallel tanks
Expand Down Expand Up @@ -127,7 +140,7 @@ SUBROUTINE ASSIGN_PAR()
STOP
END SELECT ! different lower-layer architecture / baseflow parameterizations)
! ---------------------------------------------------------------------------------------
! (5) EVAPORATION
! (6) EVAPORATION
! ---------------------------------------------------------------------------------------
SELECT CASE(SMODL%iESOIL)
CASE(iopt_sequential)
Expand All @@ -138,7 +151,7 @@ SUBROUTINE ASSIGN_PAR()
print *, "SMODL%iESOIL must be either iopt_sequential or iopt_rootweight'"
END SELECT ! (different evaporation schemes)
! ---------------------------------------------------------------------------------------
! (6) PERCOLATION
! (7) PERCOLATION
! ---------------------------------------------------------------------------------------
SELECT CASE(SMODL%iQPERC)
CASE(iopt_perc_f2sat,iopt_perc_w2sat) ! standard equation k(theta)**c
Expand All @@ -152,7 +165,7 @@ SUBROUTINE ASSIGN_PAR()
STOP
END SELECT ! (different percolation options)
! ---------------------------------------------------------------------------------------
! (7) INTERFLOW
! (8) INTERFLOW
! ---------------------------------------------------------------------------------------
SELECT CASE(SMODL%iQINTF)
CASE(iopt_intflwsome) ! interflow
Expand All @@ -164,7 +177,7 @@ SUBROUTINE ASSIGN_PAR()
STOP
END SELECT ! (different interflow options)
! ---------------------------------------------------------------------------------------
! (8) SURFACE RUNOFF
! (9) SURFACE RUNOFF
! ---------------------------------------------------------------------------------------
SELECT CASE(SMODL%iQSURF)
CASE(iopt_arno_x_vic) ! ARNO/Xzang/VIC parameterization (upper zone control)
Expand All @@ -188,7 +201,7 @@ SUBROUTINE ASSIGN_PAR()
STOP
END SELECT ! (different surface runoff options)
! ---------------------------------------------------------------------------------------
! (9) TIME DELAY IN RUNOFF
! (10) TIME DELAY IN RUNOFF
! ---------------------------------------------------------------------------------------
SELECT CASE(SMODL%iQ_TDH)
CASE(iopt_rout_gamma) ! use a Gamma distribution with shape parameter = 2.5
Expand Down
3 changes: 3 additions & 0 deletions build/FUSE_SRC/prelim/init_state.f90
Original file line number Diff line number Diff line change
Expand Up @@ -4,6 +4,7 @@ SUBROUTINE INIT_STATE(FRAC)
! --------
! Martyn Clark, 2007
! Modified by Brian Henn to include snow model, 6/2013
! Modified by Cyril Thebault to include interception, 7/2026
! ---------------------------------------------------------------------------------------
! Purpose:
! --------
Expand All @@ -22,6 +23,8 @@ SUBROUTINE INIT_STATE(FRAC)
REAL(WP), INTENT(IN) :: FRAC ! fraction of capacity
INTEGER(I4B) :: ISNW ! snow band index
! ---------------------------------------------------------------------------------------
! interception layer
FSTATE%SINT_0 = 0._wp
! (upper layer)
FSTATE%TENS_1A = DPARAM%MAXTENS_1A * FRAC
FSTATE%TENS_1B = DPARAM%MAXTENS_1B * FRAC
Expand Down
Loading