From b5ab0fbaf9785d80ffc8481119fb5e0845f881cb Mon Sep 17 00:00:00 2001 From: Apolline El-Baz Date: Fri, 12 Apr 2024 12:01:26 +0200 Subject: [PATCH] write fluxes one by on all times --- smash/_constant.py | 11 + smash/core/simulation/_doc.py | 88 ++++++ smash/core/simulation/run/run.py | 7 +- smash/fcore/derived_type/mwd_returns.f90 | 171 ++++++++++- smash/fcore/forward/forward_db.f90 | 331 +++++++++++++++------ smash/fcore/forward/md_simulation.f90 | 10 +- smash/fcore/operator/md_gr_operator.f90 | 47 ++- smash/fcore/operator/md_vic3l_operator.f90 | 9 +- 8 files changed, 565 insertions(+), 109 deletions(-) diff --git a/smash/_constant.py b/smash/_constant.py index 64f1d981..8233506e 100644 --- a/smash/_constant.py +++ b/smash/_constant.py @@ -826,6 +826,17 @@ def get_rr_states_from_structure(structure: str) -> list[str]: "jobs": False, "qt": False, "stats": False, + "ei": False, + "pn": False, + "en": False, + "pr": False, + "perc": False, + "lexc": False, + "prr": False, + "prd": False, + "qr": False, + "qd": False, + "qb": False, }, "optimize": { "time_step": "all", diff --git a/smash/core/simulation/_doc.py b/smash/core/simulation/_doc.py index 95bb3233..a02628a3 100644 --- a/smash/core/simulation/_doc.py +++ b/smash/core/simulation/_doc.py @@ -523,6 +523,94 @@ Whether to return stats : mean, var, min, max, med on internal fluxes. """, ), + "pn": ( + """ + `bool`, default False + """, + """ + Whether to return internal flux pn. + """, + ), + "ei": ( + """ + `bool`, default False + """, + """ + Whether to return internal flux ei. + """, + ), + "en": ( + """ + `bool`, default False + """, + """ + Whether to return internal flux en. + """, + ), + "pr": ( + """ + `bool`, default False + """, + """ + Whether to return internal flux pr. + """, + ), + "perc": ( + """ + `bool`, default False + """, + """ + Whether to return internal flux perc. + """, + ), + "lexc": ( + """ + `bool`, default False + """, + """ + Whether to return internal flux lexc. + """, + ), + "prr": ( + """ + `bool`, default False + """, + """ + Whether to return internal flux prr. + """, + ), + "prd": ( + """ + `bool`, default False + """, + """ + Whether to return internal flux prd. + """, + ), + "qr": ( + """ + `bool`, default False + """, + """ + Whether to return internal flux qr. + """, + ), + "qd": ( + """ + `bool`, default False + """, + """ + Whether to return internal flux qd. + """, + ), + "qb": ( + """ + `bool`, default False + """, + """ + Whether to return internal flux qb. + """, + ), "iter_cost": ( """ `bool`, default False diff --git a/smash/core/simulation/run/run.py b/smash/core/simulation/run/run.py index 82b51b3f..9bffb116 100644 --- a/smash/core/simulation/run/run.py +++ b/smash/core/simulation/run/run.py @@ -164,9 +164,10 @@ def _forward_run( return_options["nmts"], return_options["fkeys"], ) - - wrap_returns.stats.fluxes_keys = INTERNAL_FLUXES[model.setup.hydrological_module] - wrap_returns.stats.rr_states_keys = STRUCTURE_RR_STATES[model.setup.structure] + + if wrap_returns.stats_flag: + wrap_returns.stats.fluxes_keys = INTERNAL_FLUXES[model.setup.hydrological_module] + wrap_returns.stats.rr_states_keys = STRUCTURE_RR_STATES[model.setup.structure] # % Map cost_options dict to derived type _map_dict_to_fortran_derived_type(cost_options, wrap_options.cost) diff --git a/smash/fcore/derived_type/mwd_returns.f90 b/smash/fcore/derived_type/mwd_returns.f90 index 1fb3d39a..8aa5a7b0 100644 --- a/smash/fcore/derived_type/mwd_returns.f90 +++ b/smash/fcore/derived_type/mwd_returns.f90 @@ -103,9 +103,42 @@ module mwd_returns real(sp), dimension(:, :, :), allocatable :: qt logical :: qt_flag = .false. - ! internal fluxes + ! stats target on fluxes and states type (StatsDT) :: stats logical :: stats_flag = .false. + + real(sp), dimension(:, :, :), allocatable :: ei + logical :: ei_flag = .false. + + real(sp), dimension(:, :, :), allocatable :: pn + logical :: pn_flag = .false. + + real(sp), dimension(:, :, :), allocatable :: en + logical :: en_flag = .false. + + real(sp), dimension(:, :, :), allocatable :: pr + logical :: pr_flag = .false. + + real(sp), dimension(:, :, :), allocatable :: perc + logical :: perc_flag = .false. + + real(sp), dimension(:, :, :), allocatable :: lexc + logical :: lexc_flag = .false. + + real(sp), dimension(:, :, :), allocatable :: prr + logical :: prr_flag = .false. + + real(sp), dimension(:, :, :), allocatable :: prd + logical :: prd_flag = .false. + + real(sp), dimension(:, :, :), allocatable :: qr + logical :: qr_flag = .false. + + real(sp), dimension(:, :, :), allocatable :: qd + logical :: qd_flag = .false. + + real(sp), dimension(:, :, :), allocatable :: qb + logical :: qb_flag = .false. end type ReturnsDT @@ -195,6 +228,142 @@ subroutine ReturnsDT_initialise(this, setup, mesh, nmts, keys) call StatsDT_initialise(this%stats, setup, mesh) end select + + if ((setup%hydrological_module == "gr4") .or. (setup%hydrological_module == "gr5")) then + select case (wkeys(i)) + case ("pn") + this%pn_flag = .true. + allocate (this%pn(mesh%nrow, mesh%ncol, setup%ntime_step)) + + case ("en") + this%en_flag = .true. + allocate (this%en(mesh%nrow, mesh%ncol, setup%ntime_step)) + + case ("pr") + this%pr_flag = .true. + allocate (this%pr(mesh%nrow, mesh%ncol, setup%ntime_step)) + + case ("perc") + this%perc_flag = .true. + allocate (this%perc(mesh%nrow, mesh%ncol, setup%ntime_step)) + + case ("lexc") + this%lexc_flag = .true. + allocate (this%lexc(mesh%nrow, mesh%ncol, setup%ntime_step)) + + case ("prr") + this%prr_flag = .true. + allocate (this%prr(mesh%nrow, mesh%ncol, setup%ntime_step)) + + case ("prd") + this%prd_flag = .true. + allocate (this%prd(mesh%nrow, mesh%ncol, setup%ntime_step)) + + case ("qr") + this%qr_flag = .true. + allocate (this%qr(mesh%nrow, mesh%ncol, setup%ntime_step)) + + case ("qd") + this%qd_flag = .true. + allocate (this%qd(mesh%nrow, mesh%ncol, setup%ntime_step)) + end select + end if + + if (setup%hydrological_module == "grd") then + select case (wkeys(i)) + case ("ei") + this%ei_flag = .true. + allocate (this%ei(mesh%nrow, mesh%ncol, setup%ntime_step)) + + case ("pn") + this%pn_flag = .true. + allocate (this%pn(mesh%nrow, mesh%ncol, setup%ntime_step)) + + case ("en") + this%en_flag = .true. + allocate (this%en(mesh%nrow, mesh%ncol, setup%ntime_step)) + + case ("pr") + this%pr_flag = .true. + allocate (this%pr(mesh%nrow, mesh%ncol, setup%ntime_step)) + + case ("perc") + this%perc_flag = .true. + allocate (this%perc(mesh%nrow, mesh%ncol, setup%ntime_step)) + + case ("prr") + this%prr_flag = .true. + allocate (this%prr(mesh%nrow, mesh%ncol, setup%ntime_step)) + + case ("qr") + this%qr_flag = .true. + allocate (this%qr(mesh%nrow, mesh%ncol, setup%ntime_step)) + + end select + end if + + if (setup%hydrological_module == "loieau") then + select case (wkeys(i)) + case ("ei") + this%ei_flag = .true. + allocate (this%ei(mesh%nrow, mesh%ncol, setup%ntime_step)) + + case ("pn") + this%pn_flag = .true. + allocate (this%pn(mesh%nrow, mesh%ncol, setup%ntime_step)) + + case ("en") + this%en_flag = .true. + allocate (this%en(mesh%nrow, mesh%ncol, setup%ntime_step)) + + case ("pr") + this%pr_flag = .true. + allocate (this%pr(mesh%nrow, mesh%ncol, setup%ntime_step)) + + case ("perc") + this%perc_flag = .true. + allocate (this%perc(mesh%nrow, mesh%ncol, setup%ntime_step)) + + case ("prr") + this%prr_flag = .true. + allocate (this%prr(mesh%nrow, mesh%ncol, setup%ntime_step)) + + case ("prd") + this%prd_flag = .true. + allocate (this%prd(mesh%nrow, mesh%ncol, setup%ntime_step)) + + case ("qr") + this%qr_flag = .true. + allocate (this%qr(mesh%nrow, mesh%ncol, setup%ntime_step)) + + case ("qd") + this%qd_flag = .true. + allocate (this%qd(mesh%nrow, mesh%ncol, setup%ntime_step)) + + end select + end if + + if (setup%hydrological_module == "vic3l") then + select case (wkeys(i)) + case ("pn") + this%pn_flag = .true. + allocate (this%pn(mesh%nrow, mesh%ncol, setup%ntime_step)) + + case ("en") + this%en_flag = .true. + allocate (this%en(mesh%nrow, mesh%ncol, setup%ntime_step)) + + case ("qr") + this%qr_flag = .true. + allocate (this%qr(mesh%nrow, mesh%ncol, setup%ntime_step)) + + case ("qb") + this%qb_flag = .true. + allocate (this%qb(mesh%nrow, mesh%ncol, setup%ntime_step)) + + end select + end if + end do end subroutine ReturnsDT_initialise diff --git a/smash/fcore/forward/forward_db.f90 b/smash/fcore/forward/forward_db.f90 index 228493a3..dbea66c5 100644 --- a/smash/fcore/forward/forward_db.f90 +++ b/smash/fcore/forward/forward_db.f90 @@ -3574,7 +3574,7 @@ MODULE MWD_RETURNS_DIFF !%only: StatsDT USE MWD_STATS IMPLICIT NONE -! internal fluxes +! stats target on fluxes and states TYPE RETURNSDT INTEGER :: nmts LOGICAL, DIMENSION(:), ALLOCATABLE :: mask_time_step @@ -3608,6 +3608,28 @@ MODULE MWD_RETURNS_DIFF LOGICAL :: qt_flag=.false. TYPE(STATSDT) :: stats LOGICAL :: stats_flag=.false. + REAL(sp), DIMENSION(:, :, :), ALLOCATABLE :: ei + LOGICAL :: ei_flag=.false. + REAL(sp), DIMENSION(:, :, :), ALLOCATABLE :: pn + LOGICAL :: pn_flag=.false. + REAL(sp), DIMENSION(:, :, :), ALLOCATABLE :: en + LOGICAL :: en_flag=.false. + REAL(sp), DIMENSION(:, :, :), ALLOCATABLE :: pr + LOGICAL :: pr_flag=.false. + REAL(sp), DIMENSION(:, :, :), ALLOCATABLE :: perc + LOGICAL :: perc_flag=.false. + REAL(sp), DIMENSION(:, :, :), ALLOCATABLE :: lexc + LOGICAL :: lexc_flag=.false. + REAL(sp), DIMENSION(:, :, :), ALLOCATABLE :: prr + LOGICAL :: prr_flag=.false. + REAL(sp), DIMENSION(:, :, :), ALLOCATABLE :: prd + LOGICAL :: prd_flag=.false. + REAL(sp), DIMENSION(:, :, :), ALLOCATABLE :: qr + LOGICAL :: qr_flag=.false. + REAL(sp), DIMENSION(:, :, :), ALLOCATABLE :: qd + LOGICAL :: qd_flag=.false. + REAL(sp), DIMENSION(:, :, :), ALLOCATABLE :: qb + LOGICAL :: qb_flag=.false. END TYPE RETURNSDT CONTAINS @@ -3673,6 +3695,110 @@ SUBROUTINE RETURNSDT_INITIALISE(this, setup, mesh, nmts, keys) this%stats_flag = .true. CALL STATSDT_INITIALISE(this%stats, setup, mesh) END SELECT + IF (setup%hydrological_module .EQ. 'gr4' .OR. setup%& +& hydrological_module .EQ. 'gr5') THEN + SELECT CASE (wkeys(i)) + CASE ('pn') + this%pn_flag = .true. + ALLOCATE(this%pn(mesh%nrow, mesh%ncol, setup%ntime_step)) + CASE ('en') + this%en_flag = .true. + ALLOCATE(this%en(mesh%nrow, mesh%ncol, setup%ntime_step)) + CASE ('pr') + this%pr_flag = .true. + ALLOCATE(this%pr(mesh%nrow, mesh%ncol, setup%ntime_step)) + CASE ('perc') + this%perc_flag = .true. + ALLOCATE(this%perc(mesh%nrow, mesh%ncol, setup%ntime_step)) + CASE ('lexc') + this%lexc_flag = .true. + ALLOCATE(this%lexc(mesh%nrow, mesh%ncol, setup%ntime_step)) + CASE ('prr') + this%prr_flag = .true. + ALLOCATE(this%prr(mesh%nrow, mesh%ncol, setup%ntime_step)) + CASE ('prd') + this%prd_flag = .true. + ALLOCATE(this%prd(mesh%nrow, mesh%ncol, setup%ntime_step)) + CASE ('qr') + this%qr_flag = .true. + ALLOCATE(this%qr(mesh%nrow, mesh%ncol, setup%ntime_step)) + CASE ('qd') + this%qd_flag = .true. + ALLOCATE(this%qd(mesh%nrow, mesh%ncol, setup%ntime_step)) + END SELECT + END IF + IF (setup%hydrological_module .EQ. 'grd') THEN + SELECT CASE (wkeys(i)) + CASE ('ei') + this%ei_flag = .true. + ALLOCATE(this%ei(mesh%nrow, mesh%ncol, setup%ntime_step)) + CASE ('pn') + this%pn_flag = .true. + ALLOCATE(this%pn(mesh%nrow, mesh%ncol, setup%ntime_step)) + CASE ('en') + this%en_flag = .true. + ALLOCATE(this%en(mesh%nrow, mesh%ncol, setup%ntime_step)) + CASE ('pr') + this%pr_flag = .true. + ALLOCATE(this%pr(mesh%nrow, mesh%ncol, setup%ntime_step)) + CASE ('perc') + this%perc_flag = .true. + ALLOCATE(this%perc(mesh%nrow, mesh%ncol, setup%ntime_step)) + CASE ('prr') + this%prr_flag = .true. + ALLOCATE(this%prr(mesh%nrow, mesh%ncol, setup%ntime_step)) + CASE ('qr') + this%qr_flag = .true. + ALLOCATE(this%qr(mesh%nrow, mesh%ncol, setup%ntime_step)) + END SELECT + END IF + IF (setup%hydrological_module .EQ. 'loieau') THEN + SELECT CASE (wkeys(i)) + CASE ('ei') + this%ei_flag = .true. + ALLOCATE(this%ei(mesh%nrow, mesh%ncol, setup%ntime_step)) + CASE ('pn') + this%pn_flag = .true. + ALLOCATE(this%pn(mesh%nrow, mesh%ncol, setup%ntime_step)) + CASE ('en') + this%en_flag = .true. + ALLOCATE(this%en(mesh%nrow, mesh%ncol, setup%ntime_step)) + CASE ('pr') + this%pr_flag = .true. + ALLOCATE(this%pr(mesh%nrow, mesh%ncol, setup%ntime_step)) + CASE ('perc') + this%perc_flag = .true. + ALLOCATE(this%perc(mesh%nrow, mesh%ncol, setup%ntime_step)) + CASE ('prr') + this%prr_flag = .true. + ALLOCATE(this%prr(mesh%nrow, mesh%ncol, setup%ntime_step)) + CASE ('prd') + this%prd_flag = .true. + ALLOCATE(this%prd(mesh%nrow, mesh%ncol, setup%ntime_step)) + CASE ('qr') + this%qr_flag = .true. + ALLOCATE(this%qr(mesh%nrow, mesh%ncol, setup%ntime_step)) + CASE ('qd') + this%qd_flag = .true. + ALLOCATE(this%qd(mesh%nrow, mesh%ncol, setup%ntime_step)) + END SELECT + END IF + IF (setup%hydrological_module .EQ. 'vic3l') THEN + SELECT CASE (wkeys(i)) + CASE ('pn') + this%pn_flag = .true. + ALLOCATE(this%pn(mesh%nrow, mesh%ncol, setup%ntime_step)) + CASE ('en') + this%en_flag = .true. + ALLOCATE(this%en(mesh%nrow, mesh%ncol, setup%ntime_step)) + CASE ('qr') + this%qr_flag = .true. + ALLOCATE(this%qr(mesh%nrow, mesh%ncol, setup%ntime_step)) + CASE ('qb') + this%qb_flag = .true. + ALLOCATE(this%qb(mesh%nrow, mesh%ncol, setup%ntime_step)) + END SELECT + END IF END DO END SUBROUTINE RETURNSDT_INITIALISE @@ -12334,12 +12460,13 @@ END SUBROUTINE GR_TRANSFER ! variations of useful results: qt hi hp ht ! with respect to varying inputs: kexc qt prcp hi hp ht ci cp ! ct - SUBROUTINE GR4_TIMESTEP_D(setup, mesh, options, prcp, prcp_d, pet, ci& -& , ci_d, cp, cp_d, ct, ct_d, kexc, kexc_d, hi, hi_d, hp, hp_d, ht, & + SUBROUTINE GR4_TIMESTEP_D(setup, mesh, t, options, prcp, prcp_d, pet, & +& ci, ci_d, cp, cp_d, ct, ct_d, kexc, kexc_d, hi, hi_d, hp, hp_d, ht, & & ht_d, qt, qt_d, returns) IMPLICIT NONE TYPE(SETUPDT), INTENT(IN) :: setup TYPE(MESHDT), INTENT(IN) :: mesh + INTEGER, INTENT(IN) :: t TYPE(OPTIONSDT), INTENT(IN) :: options TYPE(RETURNSDT), INTENT(INOUT) :: returns REAL(sp), DIMENSION(mesh%nrow, mesh%ncol), INTENT(IN) :: prcp, pet @@ -12417,12 +12544,13 @@ END SUBROUTINE GR4_TIMESTEP_D ! gradient of useful results: kexc qt hi hp ht ci cp ct ! with respect to varying inputs: kexc qt prcp hi hp ht ci cp ! ct - SUBROUTINE GR4_TIMESTEP_B(setup, mesh, options, prcp, prcp_b, pet, ci& -& , ci_b, cp, cp_b, ct, ct_b, kexc, kexc_b, hi, hi_b, hp, hp_b, ht, & + SUBROUTINE GR4_TIMESTEP_B(setup, mesh, t, options, prcp, prcp_b, pet, & +& ci, ci_b, cp, cp_b, ct, ct_b, kexc, kexc_b, hi, hi_b, hp, hp_b, ht, & & ht_b, qt, qt_b, returns) IMPLICIT NONE TYPE(SETUPDT), INTENT(IN) :: setup TYPE(MESHDT), INTENT(IN) :: mesh + INTEGER, INTENT(IN) :: t TYPE(OPTIONSDT), INTENT(IN) :: options TYPE(RETURNSDT), INTENT(INOUT) :: returns REAL(sp), DIMENSION(mesh%nrow, mesh%ncol), INTENT(IN) :: prcp, pet @@ -12558,11 +12686,12 @@ SUBROUTINE GR4_TIMESTEP_B(setup, mesh, options, prcp, prcp_b, pet, ci& !$OMP END PARALLEL END SUBROUTINE GR4_TIMESTEP_B - SUBROUTINE GR4_TIMESTEP(setup, mesh, options, prcp, pet, ci, cp, ct, & -& kexc, hi, hp, ht, qt, returns) + SUBROUTINE GR4_TIMESTEP(setup, mesh, t, options, prcp, pet, ci, cp, ct& +& , kexc, hi, hp, ht, qt, returns) IMPLICIT NONE TYPE(SETUPDT), INTENT(IN) :: setup TYPE(MESHDT), INTENT(IN) :: mesh + INTEGER, INTENT(IN) :: t TYPE(OPTIONSDT), INTENT(IN) :: options TYPE(RETURNSDT), INTENT(INOUT) :: returns REAL(sp), DIMENSION(mesh%nrow, mesh%ncol), INTENT(IN) :: prcp, pet @@ -12615,12 +12744,13 @@ END SUBROUTINE GR4_TIMESTEP ! variations of useful results: qt hi hp ht ! with respect to varying inputs: aexc kexc qt prcp hi hp ht ! ci cp ct - SUBROUTINE GR5_TIMESTEP_D(setup, mesh, options, prcp, prcp_d, pet, ci& -& , ci_d, cp, cp_d, ct, ct_d, kexc, kexc_d, aexc, aexc_d, hi, hi_d, hp& -& , hp_d, ht, ht_d, qt, qt_d, returns) + SUBROUTINE GR5_TIMESTEP_D(setup, mesh, t, options, prcp, prcp_d, pet, & +& ci, ci_d, cp, cp_d, ct, ct_d, kexc, kexc_d, aexc, aexc_d, hi, hi_d, & +& hp, hp_d, ht, ht_d, qt, qt_d, returns) IMPLICIT NONE TYPE(SETUPDT), INTENT(IN) :: setup TYPE(MESHDT), INTENT(IN) :: mesh + INTEGER, INTENT(IN) :: t TYPE(OPTIONSDT), INTENT(IN) :: options TYPE(RETURNSDT), INTENT(INOUT) :: returns REAL(sp), DIMENSION(mesh%nrow, mesh%ncol), INTENT(IN) :: prcp, pet @@ -12700,12 +12830,13 @@ END SUBROUTINE GR5_TIMESTEP_D ! ct ! with respect to varying inputs: aexc kexc qt prcp hi hp ht ! ci cp ct - SUBROUTINE GR5_TIMESTEP_B(setup, mesh, options, prcp, prcp_b, pet, ci& -& , ci_b, cp, cp_b, ct, ct_b, kexc, kexc_b, aexc, aexc_b, hi, hi_b, hp& -& , hp_b, ht, ht_b, qt, qt_b, returns) + SUBROUTINE GR5_TIMESTEP_B(setup, mesh, t, options, prcp, prcp_b, pet, & +& ci, ci_b, cp, cp_b, ct, ct_b, kexc, kexc_b, aexc, aexc_b, hi, hi_b, & +& hp, hp_b, ht, ht_b, qt, qt_b, returns) IMPLICIT NONE TYPE(SETUPDT), INTENT(IN) :: setup TYPE(MESHDT), INTENT(IN) :: mesh + INTEGER, INTENT(IN) :: t TYPE(OPTIONSDT), INTENT(IN) :: options TYPE(RETURNSDT), INTENT(INOUT) :: returns REAL(sp), DIMENSION(mesh%nrow, mesh%ncol), INTENT(IN) :: prcp, pet @@ -12844,11 +12975,12 @@ SUBROUTINE GR5_TIMESTEP_B(setup, mesh, options, prcp, prcp_b, pet, ci& !$OMP END PARALLEL END SUBROUTINE GR5_TIMESTEP_B - SUBROUTINE GR5_TIMESTEP(setup, mesh, options, prcp, pet, ci, cp, ct, & -& kexc, aexc, hi, hp, ht, qt, returns) + SUBROUTINE GR5_TIMESTEP(setup, mesh, t, options, prcp, pet, ci, cp, ct& +& , kexc, aexc, hi, hp, ht, qt, returns) IMPLICIT NONE TYPE(SETUPDT), INTENT(IN) :: setup TYPE(MESHDT), INTENT(IN) :: mesh + INTEGER, INTENT(IN) :: t TYPE(OPTIONSDT), INTENT(IN) :: options TYPE(RETURNSDT), INTENT(INOUT) :: returns REAL(sp), DIMENSION(mesh%nrow, mesh%ncol), INTENT(IN) :: prcp, pet @@ -12901,11 +13033,12 @@ END SUBROUTINE GR5_TIMESTEP ! Differentiation of grd_timestep in forward (tangent) mode (with options fixinterface noISIZE OpenMP context): ! variations of useful results: qt hp ht ! with respect to varying inputs: qt prcp hp ht cp ct - SUBROUTINE GRD_TIMESTEP_D(setup, mesh, options, prcp, prcp_d, pet, cp& -& , cp_d, ct, ct_d, hp, hp_d, ht, ht_d, qt, qt_d, returns) + SUBROUTINE GRD_TIMESTEP_D(setup, mesh, t, options, prcp, prcp_d, pet, & +& cp, cp_d, ct, ct_d, hp, hp_d, ht, ht_d, qt, qt_d, returns) IMPLICIT NONE TYPE(SETUPDT), INTENT(IN) :: setup TYPE(MESHDT), INTENT(IN) :: mesh + INTEGER, INTENT(IN) :: t TYPE(OPTIONSDT), INTENT(IN) :: options TYPE(RETURNSDT), INTENT(INOUT) :: returns REAL(sp), DIMENSION(mesh%nrow, mesh%ncol), INTENT(IN) :: prcp, pet @@ -12978,11 +13111,12 @@ END SUBROUTINE GRD_TIMESTEP_D ! Differentiation of grd_timestep in reverse (adjoint) mode (with options fixinterface noISIZE OpenMP context): ! gradient of useful results: qt hp ht cp ct ! with respect to varying inputs: qt prcp hp ht cp ct - SUBROUTINE GRD_TIMESTEP_B(setup, mesh, options, prcp, prcp_b, pet, cp& -& , cp_b, ct, ct_b, hp, hp_b, ht, ht_b, qt, qt_b, returns) + SUBROUTINE GRD_TIMESTEP_B(setup, mesh, t, options, prcp, prcp_b, pet, & +& cp, cp_b, ct, ct_b, hp, hp_b, ht, ht_b, qt, qt_b, returns) IMPLICIT NONE TYPE(SETUPDT), INTENT(IN) :: setup TYPE(MESHDT), INTENT(IN) :: mesh + INTEGER, INTENT(IN) :: t TYPE(OPTIONSDT), INTENT(IN) :: options TYPE(RETURNSDT), INTENT(INOUT) :: returns REAL(sp), DIMENSION(mesh%nrow, mesh%ncol), INTENT(IN) :: prcp, pet @@ -13116,11 +13250,12 @@ SUBROUTINE GRD_TIMESTEP_B(setup, mesh, options, prcp, prcp_b, pet, cp& !$OMP END PARALLEL END SUBROUTINE GRD_TIMESTEP_B - SUBROUTINE GRD_TIMESTEP(setup, mesh, options, prcp, pet, cp, ct, hp, & -& ht, qt, returns) + SUBROUTINE GRD_TIMESTEP(setup, mesh, t, options, prcp, pet, cp, ct, hp& +& , ht, qt, returns) IMPLICIT NONE TYPE(SETUPDT), INTENT(IN) :: setup TYPE(MESHDT), INTENT(IN) :: mesh + INTEGER, INTENT(IN) :: t TYPE(OPTIONSDT), INTENT(IN) :: options TYPE(RETURNSDT), INTENT(INOUT) :: returns REAL(sp), DIMENSION(mesh%nrow, mesh%ncol), INTENT(IN) :: prcp, pet @@ -13172,11 +13307,13 @@ END SUBROUTINE GRD_TIMESTEP ! Differentiation of loieau_timestep in forward (tangent) mode (with options fixinterface noISIZE OpenMP context): ! variations of useful results: qt ha hc ! with respect to varying inputs: kb qt ha hc prcp ca cc - SUBROUTINE LOIEAU_TIMESTEP_D(setup, mesh, options, prcp, prcp_d, pet, & -& ca, ca_d, cc, cc_d, kb, kb_d, ha, ha_d, hc, hc_d, qt, qt_d, returns) + SUBROUTINE LOIEAU_TIMESTEP_D(setup, mesh, t, options, prcp, prcp_d, & +& pet, ca, ca_d, cc, cc_d, kb, kb_d, ha, ha_d, hc, hc_d, qt, qt_d, & +& returns) IMPLICIT NONE TYPE(SETUPDT), INTENT(IN) :: setup TYPE(MESHDT), INTENT(IN) :: mesh + INTEGER, INTENT(IN) :: t TYPE(OPTIONSDT), INTENT(IN) :: options TYPE(RETURNSDT), INTENT(INOUT) :: returns REAL(sp), DIMENSION(mesh%nrow, mesh%ncol), INTENT(IN) :: prcp, pet @@ -13260,11 +13397,13 @@ END SUBROUTINE LOIEAU_TIMESTEP_D ! Differentiation of loieau_timestep in reverse (adjoint) mode (with options fixinterface noISIZE OpenMP context): ! gradient of useful results: kb qt ha hc ca cc ! with respect to varying inputs: kb qt ha hc prcp ca cc - SUBROUTINE LOIEAU_TIMESTEP_B(setup, mesh, options, prcp, prcp_b, pet, & -& ca, ca_b, cc, cc_b, kb, kb_b, ha, ha_b, hc, hc_b, qt, qt_b, returns) + SUBROUTINE LOIEAU_TIMESTEP_B(setup, mesh, t, options, prcp, prcp_b, & +& pet, ca, ca_b, cc, cc_b, kb, kb_b, ha, ha_b, hc, hc_b, qt, qt_b, & +& returns) IMPLICIT NONE TYPE(SETUPDT), INTENT(IN) :: setup TYPE(MESHDT), INTENT(IN) :: mesh + INTEGER, INTENT(IN) :: t TYPE(OPTIONSDT), INTENT(IN) :: options TYPE(RETURNSDT), INTENT(INOUT) :: returns REAL(sp), DIMENSION(mesh%nrow, mesh%ncol), INTENT(IN) :: prcp, pet @@ -13429,11 +13568,12 @@ SUBROUTINE LOIEAU_TIMESTEP_B(setup, mesh, options, prcp, prcp_b, pet, & !$OMP END PARALLEL END SUBROUTINE LOIEAU_TIMESTEP_B - SUBROUTINE LOIEAU_TIMESTEP(setup, mesh, options, prcp, pet, ca, cc, kb& -& , ha, hc, qt, returns) + SUBROUTINE LOIEAU_TIMESTEP(setup, mesh, t, options, prcp, pet, ca, cc& +& , kb, ha, hc, qt, returns) IMPLICIT NONE TYPE(SETUPDT), INTENT(IN) :: setup TYPE(MESHDT), INTENT(IN) :: mesh + INTEGER, INTENT(IN) :: t TYPE(OPTIONSDT), INTENT(IN) :: options TYPE(RETURNSDT), INTENT(INOUT) :: returns REAL(sp), DIMENSION(mesh%nrow, mesh%ncol), INTENT(IN) :: prcp, pet @@ -16100,13 +16240,14 @@ END SUBROUTINE VIC3L_BASEFLOW ! variations of useful results: hbsl qt hcl husl hmsl ! with respect to varying inputs: ws hbsl ds qt cusl hcl prcp ! cmsl ks cbsl pbc husl dsm hmsl b - SUBROUTINE VIC3L_TIMESTEP_D(setup, mesh, options, prcp, prcp_d, pet, b& -& , b_d, cusl, cusl_d, cmsl, cmsl_d, cbsl, cbsl_d, ks, ks_d, pbc, & + SUBROUTINE VIC3L_TIMESTEP_D(setup, mesh, t, options, prcp, prcp_d, pet& +& , b, b_d, cusl, cusl_d, cmsl, cmsl_d, cbsl, cbsl_d, ks, ks_d, pbc, & & pbc_d, dsm, dsm_d, ds, ds_d, ws, ws_d, hcl, hcl_d, husl, husl_d, & & hmsl, hmsl_d, hbsl, hbsl_d, qt, qt_d, returns) IMPLICIT NONE TYPE(SETUPDT), INTENT(IN) :: setup TYPE(MESHDT), INTENT(IN) :: mesh + INTEGER, INTENT(IN) :: t TYPE(OPTIONSDT), INTENT(IN) :: options TYPE(RETURNSDT), INTENT(INOUT) :: returns REAL(sp), DIMENSION(mesh%nrow, mesh%ncol), INTENT(IN) :: prcp, pet @@ -16183,13 +16324,14 @@ END SUBROUTINE VIC3L_TIMESTEP_D ! ks cbsl pbc husl dsm hmsl b ! with respect to varying inputs: ws hbsl ds qt cusl hcl prcp ! cmsl ks cbsl pbc husl dsm hmsl b - SUBROUTINE VIC3L_TIMESTEP_B(setup, mesh, options, prcp, prcp_b, pet, b& -& , b_b, cusl, cusl_b, cmsl, cmsl_b, cbsl, cbsl_b, ks, ks_b, pbc, & + SUBROUTINE VIC3L_TIMESTEP_B(setup, mesh, t, options, prcp, prcp_b, pet& +& , b, b_b, cusl, cusl_b, cmsl, cmsl_b, cbsl, cbsl_b, ks, ks_b, pbc, & & pbc_b, dsm, dsm_b, ds, ds_b, ws, ws_b, hcl, hcl_b, husl, husl_b, & & hmsl, hmsl_b, hbsl, hbsl_b, qt, qt_b, returns) IMPLICIT NONE TYPE(SETUPDT), INTENT(IN) :: setup TYPE(MESHDT), INTENT(IN) :: mesh + INTEGER, INTENT(IN) :: t TYPE(OPTIONSDT), INTENT(IN) :: options TYPE(RETURNSDT), INTENT(INOUT) :: returns REAL(sp), DIMENSION(mesh%nrow, mesh%ncol), INTENT(IN) :: prcp, pet @@ -16326,12 +16468,13 @@ SUBROUTINE VIC3L_TIMESTEP_B(setup, mesh, options, prcp, prcp_b, pet, b& !$OMP END PARALLEL END SUBROUTINE VIC3L_TIMESTEP_B - SUBROUTINE VIC3L_TIMESTEP(setup, mesh, options, prcp, pet, b, cusl, & -& cmsl, cbsl, ks, pbc, dsm, ds, ws, hcl, husl, hmsl, hbsl, qt, returns& -& ) + SUBROUTINE VIC3L_TIMESTEP(setup, mesh, t, options, prcp, pet, b, cusl& +& , cmsl, cbsl, ks, pbc, dsm, ds, ws, hcl, husl, hmsl, hbsl, qt, & +& returns) IMPLICIT NONE TYPE(SETUPDT), INTENT(IN) :: setup TYPE(MESHDT), INTENT(IN) :: mesh + INTEGER, INTENT(IN) :: t TYPE(OPTIONSDT), INTENT(IN) :: options TYPE(RETURNSDT), INTENT(INOUT) :: returns REAL(sp), DIMENSION(mesh%nrow, mesh%ncol), INTENT(IN) :: prcp, pet @@ -16919,17 +17062,17 @@ SUBROUTINE SIMULATION_D(setup, mesh, input_data, parameters, & SELECT CASE (setup%hydrological_module) CASE ('gr4') ! 'gr4' module - CALL GR4_TIMESTEP_D(setup, mesh, options, prcp, prcp_d, pet, ci& -& , ci_d, cp, cp_d, ct, ct_d, kexc, kexc_d, hi, hi_d& -& , hp, hp_d, ht, ht_d, qt(:, :, zq), qt_d(:, :, zq)& -& , returns) + CALL GR4_TIMESTEP_D(setup, mesh, t, options, prcp, prcp_d, pet, & +& ci, ci_d, cp, cp_d, ct, ct_d, kexc, kexc_d, hi, & +& hi_d, hp, hp_d, ht, ht_d, qt(:, :, zq), qt_d(:, :& +& , zq), returns) CALL SET_RR_STATES(output%rr_final_states, 'hi', hi) CALL SET_RR_STATES(output%rr_final_states, 'hp', hp) CALL SET_RR_STATES(output%rr_final_states, 'ht', ht) CASE ('gr5') ! 'gr5' module - CALL GR5_TIMESTEP_D(setup, mesh, options, prcp, prcp_d, pet, ci& -& , ci_d, cp, cp_d, ct, ct_d, kexc, kexc_d, aexc, & + CALL GR5_TIMESTEP_D(setup, mesh, t, options, prcp, prcp_d, pet, & +& ci, ci_d, cp, cp_d, ct, ct_d, kexc, kexc_d, aexc, & & aexc_d, hi, hi_d, hp, hp_d, ht, ht_d, qt(:, :, zq)& & , qt_d(:, :, zq), returns) CALL SET_RR_STATES(output%rr_final_states, 'hi', hi) @@ -16937,26 +17080,26 @@ SUBROUTINE SIMULATION_D(setup, mesh, input_data, parameters, & CALL SET_RR_STATES(output%rr_final_states, 'ht', ht) CASE ('grd') ! 'grd' module - CALL GRD_TIMESTEP_D(setup, mesh, options, prcp, prcp_d, pet, cp& -& , cp_d, ct, ct_d, hp, hp_d, ht, ht_d, qt(:, :, zq)& -& , qt_d(:, :, zq), returns) + CALL GRD_TIMESTEP_D(setup, mesh, t, options, prcp, prcp_d, pet, & +& cp, cp_d, ct, ct_d, hp, hp_d, ht, ht_d, qt(:, :, & +& zq), qt_d(:, :, zq), returns) CALL SET_RR_STATES(output%rr_final_states, 'hp', hp) CALL SET_RR_STATES(output%rr_final_states, 'ht', ht) CASE ('loieau') ! 'loieau' module - CALL LOIEAU_TIMESTEP_D(setup, mesh, options, prcp, prcp_d, pet, & -& ca, ca_d, cc, cc_d, kb, kb_d, ha, ha_d, hc, & -& hc_d, qt(:, :, zq), qt_d(:, :, zq), returns) + CALL LOIEAU_TIMESTEP_D(setup, mesh, t, options, prcp, prcp_d, & +& pet, ca, ca_d, cc, cc_d, kb, kb_d, ha, ha_d, hc& +& , hc_d, qt(:, :, zq), qt_d(:, :, zq), returns) CALL SET_RR_STATES(output%rr_final_states, 'ha', ha) CALL SET_RR_STATES(output%rr_final_states, 'hc', hc) CASE ('vic3l') ! 'vic3l' module - CALL VIC3L_TIMESTEP_D(setup, mesh, options, prcp, prcp_d, pet, b& -& , b_d, cusl, cusl_d, cmsl, cmsl_d, cbsl, cbsl_d& -& , ks, ks_d, pbc, pbc_d, ds, ds_d, dsm, dsm_d, ws& -& , ws_d, hcl, hcl_d, husl, husl_d, hmsl, hmsl_d, & -& hbsl, hbsl_d, qt(:, :, zq), qt_d(:, :, zq), & -& returns) + CALL VIC3L_TIMESTEP_D(setup, mesh, t, options, prcp, prcp_d, pet& +& , b, b_d, cusl, cusl_d, cmsl, cmsl_d, cbsl, & +& cbsl_d, ks, ks_d, pbc, pbc_d, ds, ds_d, dsm, & +& dsm_d, ws, ws_d, hcl, hcl_d, husl, husl_d, hmsl& +& , hmsl_d, hbsl, hbsl_d, qt(:, :, zq), qt_d(:, :& +& , zq), returns) CALL SET_RR_STATES(output%rr_final_states, 'hcl', hcl) CALL SET_RR_STATES(output%rr_final_states, 'husl', husl) CALL SET_RR_STATES(output%rr_final_states, 'hmsl', hmsl) @@ -17357,8 +17500,8 @@ SUBROUTINE SIMULATION_B(setup, mesh, input_data, parameters, & ELSE CALL PUSHCONTROL1B(0) END IF - CALL GR4_TIMESTEP(setup, mesh, options, prcp, pet, ci, cp, ct, & -& kexc, hi, hp, ht, qt(:, :, zq), returns) + CALL GR4_TIMESTEP(setup, mesh, t, options, prcp, pet, ci, cp, ct& +& , kexc, hi, hp, ht, qt(:, :, zq), returns) CALL PUSHCONTROL3B(1) CASE ('gr5') ! 'gr5' module @@ -17386,8 +17529,8 @@ SUBROUTINE SIMULATION_B(setup, mesh, input_data, parameters, & ELSE CALL PUSHCONTROL1B(0) END IF - CALL GR5_TIMESTEP(setup, mesh, options, prcp, pet, ci, cp, ct, & -& kexc, aexc, hi, hp, ht, qt(:, :, zq), returns) + CALL GR5_TIMESTEP(setup, mesh, t, options, prcp, pet, ci, cp, ct& +& , kexc, aexc, hi, hp, ht, qt(:, :, zq), returns) CALL PUSHCONTROL3B(2) CASE ('grd') ! 'grd' module @@ -17409,8 +17552,8 @@ SUBROUTINE SIMULATION_B(setup, mesh, input_data, parameters, & ELSE CALL PUSHCONTROL1B(0) END IF - CALL GRD_TIMESTEP(setup, mesh, options, prcp, pet, cp, ct, hp, & -& ht, qt(:, :, zq), returns) + CALL GRD_TIMESTEP(setup, mesh, t, options, prcp, pet, cp, ct, hp& +& , ht, qt(:, :, zq), returns) CALL PUSHCONTROL3B(3) CASE ('loieau') ! 'loieau' module @@ -17432,8 +17575,8 @@ SUBROUTINE SIMULATION_B(setup, mesh, input_data, parameters, & ELSE CALL PUSHCONTROL1B(0) END IF - CALL LOIEAU_TIMESTEP(setup, mesh, options, prcp, pet, ca, cc, kb& -& , ha, hc, qt(:, :, zq), returns) + CALL LOIEAU_TIMESTEP(setup, mesh, t, options, prcp, pet, ca, cc& +& , kb, ha, hc, qt(:, :, zq), returns) CALL PUSHCONTROL3B(4) CASE ('vic3l') ! 'vic3l' module @@ -17467,9 +17610,9 @@ SUBROUTINE SIMULATION_B(setup, mesh, input_data, parameters, & ELSE CALL PUSHCONTROL1B(0) END IF - CALL VIC3L_TIMESTEP(setup, mesh, options, prcp, pet, b, cusl, & -& cmsl, cbsl, ks, pbc, ds, dsm, ws, hcl, husl, hmsl& -& , hbsl, qt(:, :, zq), returns) + CALL VIC3L_TIMESTEP(setup, mesh, t, options, prcp, pet, b, cusl& +& , cmsl, cbsl, ks, pbc, ds, dsm, ws, hcl, husl, & +& hmsl, hbsl, qt(:, :, zq), returns) CALL PUSHCONTROL3B(5) CASE DEFAULT CALL PUSHCONTROL3B(0) @@ -17562,10 +17705,10 @@ SUBROUTINE SIMULATION_B(setup, mesh, input_data, parameters, & CALL POPCONTROL1B(branch) IF (branch .EQ. 1) CALL POPREAL4ARRAY(qt(:, :, zq), SIZE(qt, 1& & )*SIZE(qt, 2)) - CALL GR4_TIMESTEP_B(setup, mesh, options, prcp, prcp_b, pet, & -& ci, ci_b, cp, cp_b, ct, ct_b, kexc, kexc_b, hi, & -& hi_b, hp, hp_b, ht, ht_b, qt(:, :, zq), qt_b(:, & -& :, zq), returns) + CALL GR4_TIMESTEP_B(setup, mesh, t, options, prcp, prcp_b, pet& +& , ci, ci_b, cp, cp_b, ct, ct_b, kexc, kexc_b, hi& +& , hi_b, hp, hp_b, ht, ht_b, qt(:, :, zq), qt_b(:& +& , :, zq), returns) ELSE CALL POPCONTROL1B(branch) IF (branch .EQ. 1) CALL POPREAL4ARRAY(hi, SIZE(hi, 1)*SIZE(hi& @@ -17579,10 +17722,10 @@ SUBROUTINE SIMULATION_B(setup, mesh, input_data, parameters, & CALL POPCONTROL1B(branch) IF (branch .EQ. 1) CALL POPREAL4ARRAY(qt(:, :, zq), SIZE(qt, 1& & )*SIZE(qt, 2)) - CALL GR5_TIMESTEP_B(setup, mesh, options, prcp, prcp_b, pet, & -& ci, ci_b, cp, cp_b, ct, ct_b, kexc, kexc_b, aexc& -& , aexc_b, hi, hi_b, hp, hp_b, ht, ht_b, qt(:, :& -& , zq), qt_b(:, :, zq), returns) + CALL GR5_TIMESTEP_B(setup, mesh, t, options, prcp, prcp_b, pet& +& , ci, ci_b, cp, cp_b, ct, ct_b, kexc, kexc_b, & +& aexc, aexc_b, hi, hi_b, hp, hp_b, ht, ht_b, qt(:& +& , :, zq), qt_b(:, :, zq), returns) END IF ELSE IF (branch .EQ. 3) THEN CALL POPCONTROL1B(branch) @@ -17594,9 +17737,9 @@ SUBROUTINE SIMULATION_B(setup, mesh, input_data, parameters, & CALL POPCONTROL1B(branch) IF (branch .EQ. 1) CALL POPREAL4ARRAY(qt(:, :, zq), SIZE(qt, 1)*& & SIZE(qt, 2)) - CALL GRD_TIMESTEP_B(setup, mesh, options, prcp, prcp_b, pet, cp& -& , cp_b, ct, ct_b, hp, hp_b, ht, ht_b, qt(:, :, zq)& -& , qt_b(:, :, zq), returns) + CALL GRD_TIMESTEP_B(setup, mesh, t, options, prcp, prcp_b, pet, & +& cp, cp_b, ct, ct_b, hp, hp_b, ht, ht_b, qt(:, :, & +& zq), qt_b(:, :, zq), returns) ELSE IF (branch .EQ. 4) THEN CALL POPCONTROL1B(branch) IF (branch .EQ. 1) CALL POPREAL4ARRAY(ha, SIZE(ha, 1)*SIZE(ha, 2& @@ -17607,9 +17750,9 @@ SUBROUTINE SIMULATION_B(setup, mesh, input_data, parameters, & CALL POPCONTROL1B(branch) IF (branch .EQ. 1) CALL POPREAL4ARRAY(qt(:, :, zq), SIZE(qt, 1)*& & SIZE(qt, 2)) - CALL LOIEAU_TIMESTEP_B(setup, mesh, options, prcp, prcp_b, pet, & -& ca, ca_b, cc, cc_b, kb, kb_b, ha, ha_b, hc, & -& hc_b, qt(:, :, zq), qt_b(:, :, zq), returns) + CALL LOIEAU_TIMESTEP_B(setup, mesh, t, options, prcp, prcp_b, & +& pet, ca, ca_b, cc, cc_b, kb, kb_b, ha, ha_b, hc& +& , hc_b, qt(:, :, zq), qt_b(:, :, zq), returns) ELSE CALL POPCONTROL1B(branch) IF (branch .EQ. 1) CALL POPREAL4ARRAY(hcl, SIZE(hcl, 1)*SIZE(hcl& @@ -17626,12 +17769,12 @@ SUBROUTINE SIMULATION_B(setup, mesh, input_data, parameters, & CALL POPCONTROL1B(branch) IF (branch .EQ. 1) CALL POPREAL4ARRAY(qt(:, :, zq), SIZE(qt, 1)*& & SIZE(qt, 2)) - CALL VIC3L_TIMESTEP_B(setup, mesh, options, prcp, prcp_b, pet, b& -& , b_b, cusl, cusl_b, cmsl, cmsl_b, cbsl, cbsl_b& -& , ks, ks_b, pbc, pbc_b, ds, ds_b, dsm, dsm_b, ws& -& , ws_b, hcl, hcl_b, husl, husl_b, hmsl, hmsl_b, & -& hbsl, hbsl_b, qt(:, :, zq), qt_b(:, :, zq), & -& returns) + CALL VIC3L_TIMESTEP_B(setup, mesh, t, options, prcp, prcp_b, pet& +& , b, b_b, cusl, cusl_b, cmsl, cmsl_b, cbsl, & +& cbsl_b, ks, ks_b, pbc, pbc_b, ds, ds_b, dsm, & +& dsm_b, ws, ws_b, hcl, hcl_b, husl, husl_b, hmsl& +& , hmsl_b, hbsl, hbsl_b, qt(:, :, zq), qt_b(:, :& +& , zq), returns) END IF CALL POPCONTROL1B(branch) IF (branch .NE. 0) THEN @@ -18098,35 +18241,35 @@ SUBROUTINE SIMULATION(setup, mesh, input_data, parameters, output, & SELECT CASE (setup%hydrological_module) CASE ('gr4') ! 'gr4' module - CALL GR4_TIMESTEP(setup, mesh, options, prcp, pet, ci, cp, ct, & -& kexc, hi, hp, ht, qt(:, :, zq), returns) + CALL GR4_TIMESTEP(setup, mesh, t, options, prcp, pet, ci, cp, ct& +& , kexc, hi, hp, ht, qt(:, :, zq), returns) CALL SET_RR_STATES(output%rr_final_states, 'hi', hi) CALL SET_RR_STATES(output%rr_final_states, 'hp', hp) CALL SET_RR_STATES(output%rr_final_states, 'ht', ht) CASE ('gr5') ! 'gr5' module - CALL GR5_TIMESTEP(setup, mesh, options, prcp, pet, ci, cp, ct, & -& kexc, aexc, hi, hp, ht, qt(:, :, zq), returns) + CALL GR5_TIMESTEP(setup, mesh, t, options, prcp, pet, ci, cp, ct& +& , kexc, aexc, hi, hp, ht, qt(:, :, zq), returns) CALL SET_RR_STATES(output%rr_final_states, 'hi', hi) CALL SET_RR_STATES(output%rr_final_states, 'hp', hp) CALL SET_RR_STATES(output%rr_final_states, 'ht', ht) CASE ('grd') ! 'grd' module - CALL GRD_TIMESTEP(setup, mesh, options, prcp, pet, cp, ct, hp, & -& ht, qt(:, :, zq), returns) + CALL GRD_TIMESTEP(setup, mesh, t, options, prcp, pet, cp, ct, hp& +& , ht, qt(:, :, zq), returns) CALL SET_RR_STATES(output%rr_final_states, 'hp', hp) CALL SET_RR_STATES(output%rr_final_states, 'ht', ht) CASE ('loieau') ! 'loieau' module - CALL LOIEAU_TIMESTEP(setup, mesh, options, prcp, pet, ca, cc, kb& -& , ha, hc, qt(:, :, zq), returns) + CALL LOIEAU_TIMESTEP(setup, mesh, t, options, prcp, pet, ca, cc& +& , kb, ha, hc, qt(:, :, zq), returns) CALL SET_RR_STATES(output%rr_final_states, 'ha', ha) CALL SET_RR_STATES(output%rr_final_states, 'hc', hc) CASE ('vic3l') ! 'vic3l' module - CALL VIC3L_TIMESTEP(setup, mesh, options, prcp, pet, b, cusl, & -& cmsl, cbsl, ks, pbc, ds, dsm, ws, hcl, husl, hmsl& -& , hbsl, qt(:, :, zq), returns) + CALL VIC3L_TIMESTEP(setup, mesh, t, options, prcp, pet, b, cusl& +& , cmsl, cbsl, ks, pbc, ds, dsm, ws, hcl, husl, & +& hmsl, hbsl, qt(:, :, zq), returns) CALL SET_RR_STATES(output%rr_final_states, 'hcl', hcl) CALL SET_RR_STATES(output%rr_final_states, 'husl', husl) CALL SET_RR_STATES(output%rr_final_states, 'hmsl', hmsl) diff --git a/smash/fcore/forward/md_simulation.f90 b/smash/fcore/forward/md_simulation.f90 index 6473c8a4..95f74e03 100644 --- a/smash/fcore/forward/md_simulation.f90 +++ b/smash/fcore/forward/md_simulation.f90 @@ -428,7 +428,7 @@ subroutine simulation(setup, mesh, input_data, parameters, output, options, retu ! 'gr4' module case ("gr4") - call gr4_timestep(setup, mesh, options, prcp, pet, ci, cp, ct, kexc, hi, hp, ht, qt(:, :, zq), returns) + call gr4_timestep(setup, mesh, t, options, prcp, pet, ci, cp, ct, kexc, hi, hp, ht, qt(:, :, zq), returns) call set_rr_states(output%rr_final_states, "hi", hi) call set_rr_states(output%rr_final_states, "hp", hp) @@ -437,7 +437,7 @@ subroutine simulation(setup, mesh, input_data, parameters, output, options, retu ! 'gr5' module case ("gr5") - call gr5_timestep(setup, mesh, options, prcp, pet, ci, cp, ct, kexc, aexc, hi, hp, ht, qt(:, :, zq), returns) + call gr5_timestep(setup, mesh, t, options, prcp, pet, ci, cp, ct, kexc, aexc, hi, hp, ht, qt(:, :, zq), returns) call set_rr_states(output%rr_final_states, "hi", hi) call set_rr_states(output%rr_final_states, "hp", hp) @@ -446,7 +446,7 @@ subroutine simulation(setup, mesh, input_data, parameters, output, options, retu ! 'grd' module case ("grd") - call grd_timestep(setup, mesh, options, prcp, pet, cp, ct, hp, ht, qt(:, :, zq), returns) + call grd_timestep(setup, mesh, t, options, prcp, pet, cp, ct, hp, ht, qt(:, :, zq), returns) call set_rr_states(output%rr_final_states, "hp", hp) call set_rr_states(output%rr_final_states, "ht", ht) @@ -454,7 +454,7 @@ subroutine simulation(setup, mesh, input_data, parameters, output, options, retu ! 'loieau' module case ("loieau") - call loieau_timestep(setup, mesh, options, prcp, pet, ca, cc, kb, ha, hc, qt(:, :, zq), returns) + call loieau_timestep(setup, mesh, t, options, prcp, pet, ca, cc, kb, ha, hc, qt(:, :, zq), returns) call set_rr_states(output%rr_final_states, "ha", ha) call set_rr_states(output%rr_final_states, "hc", hc) @@ -462,7 +462,7 @@ subroutine simulation(setup, mesh, input_data, parameters, output, options, retu ! 'vic3l' module case ("vic3l") - call vic3l_timestep(setup, mesh, options, prcp, pet, b, cusl, cmsl, cbsl, ks, pbc, ds, dsm, ws, & + call vic3l_timestep(setup, mesh, t, options, prcp, pet, b, cusl, cmsl, cbsl, ks, pbc, ds, dsm, ws, & & hcl, husl, hmsl, hbsl, qt(:, :, zq), returns) call set_rr_states(output%rr_final_states, "hcl", hcl) diff --git a/smash/fcore/operator/md_gr_operator.f90 b/smash/fcore/operator/md_gr_operator.f90 index 66b3323a..33ac4a12 100644 --- a/smash/fcore/operator/md_gr_operator.f90 +++ b/smash/fcore/operator/md_gr_operator.f90 @@ -133,12 +133,13 @@ subroutine gr_transfer(n, prcp, pr, ct, ht, q) end subroutine gr_transfer - subroutine gr4_timestep(setup, mesh, options, prcp, pet, ci, cp, ct, kexc, hi, hp, ht, qt, returns) + subroutine gr4_timestep(setup, mesh, t, options, prcp, pet, ci, cp, ct, kexc, hi, hp, ht, qt, returns) implicit none type(SetupDT), intent(in) :: setup type(MeshDT), intent(in) :: mesh + integer, intent(in) :: t type(OptionsDT), intent(in) :: options type(ReturnsDT), intent(inout) :: returns real(sp), dimension(mesh%nrow, mesh%ncol), intent(in) :: prcp, pet @@ -198,6 +199,16 @@ subroutine gr4_timestep(setup, mesh, options, prcp, pet, ci, cp, ct, kexc, hi, h returns%stats%internal_fluxes(row, col, 8) = qr returns%stats%internal_fluxes(row, col, 9) = qd end if +!~ print *, returns%all_fluxes_flag + if (returns%pn_flag) returns%pn(row, col, t) = pn + if (returns%en_flag) returns%en(row, col, t) = en + if (returns%pr_flag) returns%pr(row, col, t) = pr + if (returns%perc_flag) returns%perc(row, col, t) = perc + if (returns%lexc_flag) returns%lexc(row, col, t) = l + if (returns%prr_flag) returns%prr(row, col, t) = prr + if (returns%prd_flag) returns%prd(row, col, t) = prd + if (returns%qr_flag) returns%qr(row, col, t) = qr + if (returns%qd_flag) returns%qd(row, col, t) = qd !$AD end-exclude end do end do @@ -205,12 +216,13 @@ subroutine gr4_timestep(setup, mesh, options, prcp, pet, ci, cp, ct, kexc, hi, h end subroutine gr4_timestep - subroutine gr5_timestep(setup, mesh, options, prcp, pet, ci, cp, ct, kexc, aexc, hi, hp, ht, qt, returns) + subroutine gr5_timestep(setup, mesh, t, options, prcp, pet, ci, cp, ct, kexc, aexc, hi, hp, ht, qt, returns) implicit none type(SetupDT), intent(in) :: setup type(MeshDT), intent(in) :: mesh + integer, intent(in) :: t type(OptionsDT), intent(in) :: options type(ReturnsDT), intent(inout) :: returns real(sp), dimension(mesh%nrow, mesh%ncol), intent(in) :: prcp, pet @@ -270,6 +282,15 @@ subroutine gr5_timestep(setup, mesh, options, prcp, pet, ci, cp, ct, kexc, aexc, returns%stats%internal_fluxes(row, col, 8) = qr returns%stats%internal_fluxes(row, col, 9) = qd end if + if (returns%pn_flag) returns%pn(row, col, t) = pn + if (returns%en_flag) returns%en(row, col, t) = en + if (returns%pr_flag) returns%pr(row, col, t) = pr + if (returns%perc_flag) returns%perc(row, col, t) = perc + if (returns%lexc_flag) returns%lexc(row, col, t) = l + if (returns%prr_flag) returns%prr(row, col, t) = prr + if (returns%prd_flag) returns%prd(row, col, t) = prd + if (returns%qr_flag) returns%qr(row, col, t) = qr + if (returns%qd_flag) returns%qd(row, col, t) = qd !$AD end-exclude end do end do @@ -277,12 +298,13 @@ subroutine gr5_timestep(setup, mesh, options, prcp, pet, ci, cp, ct, kexc, aexc, end subroutine gr5_timestep - subroutine grd_timestep(setup, mesh, options, prcp, pet, cp, ct, hp, ht, qt, returns) + subroutine grd_timestep(setup, mesh, t, options, prcp, pet, cp, ct, hp, ht, qt, returns) implicit none type(SetupDT), intent(in) :: setup type(MeshDT), intent(in) :: mesh + integer, intent(in) :: t type(OptionsDT), intent(in) :: options type(ReturnsDT), intent(inout) :: returns real(sp), dimension(mesh%nrow, mesh%ncol), intent(in):: prcp, pet @@ -338,6 +360,13 @@ subroutine grd_timestep(setup, mesh, options, prcp, pet, cp, ct, hp, ht, qt, ret returns%stats%internal_fluxes(row, col, 6) = prr returns%stats%internal_fluxes(row, col, 7) = qr end if + if (returns%ei_flag) returns%ei(row, col, t) = ei + if (returns%pn_flag) returns%pn(row, col, t) = pn + if (returns%en_flag) returns%en(row, col, t) = en + if (returns%pr_flag) returns%pr(row, col, t) = pr + if (returns%perc_flag) returns%perc(row, col, t) = perc + if (returns%prr_flag) returns%prr(row, col, t) = prr + if (returns%qr_flag) returns%qr(row, col, t) = qr !$AD end-exclude end do end do @@ -345,12 +374,13 @@ subroutine grd_timestep(setup, mesh, options, prcp, pet, cp, ct, hp, ht, qt, ret end subroutine grd_timestep - subroutine loieau_timestep(setup, mesh, options, prcp, pet, ca, cc, kb, ha, hc, qt, returns) + subroutine loieau_timestep(setup, mesh, t, options, prcp, pet, ca, cc, kb, ha, hc, qt, returns) implicit none type(SetupDT), intent(in) :: setup type(MeshDT), intent(in) :: mesh + integer, intent(in) :: t type(OptionsDT), intent(in) :: options type(ReturnsDT), intent(inout) :: returns real(sp), dimension(mesh%nrow, mesh%ncol), intent(in):: prcp, pet @@ -411,6 +441,15 @@ subroutine loieau_timestep(setup, mesh, options, prcp, pet, ca, cc, kb, ha, hc, returns%stats%internal_fluxes(row, col, 8) = qr returns%stats%internal_fluxes(row, col, 9) = qd end if + if (returns%ei_flag) returns%ei(row, col, t) = ei + if (returns%pn_flag) returns%pn(row, col, t) = pn + if (returns%en_flag) returns%en(row, col, t) = en + if (returns%pr_flag) returns%pr(row, col, t) = pr + if (returns%perc_flag) returns%perc(row, col, t) = perc + if (returns%prr_flag) returns%prr(row, col, t) = prr + if (returns%prd_flag) returns%prd(row, col, t) = prd + if (returns%qr_flag) returns%qr(row, col, t) = qr + if (returns%qd_flag) returns%qd(row, col, t) = qd !$AD end-exclude end do diff --git a/smash/fcore/operator/md_vic3l_operator.f90 b/smash/fcore/operator/md_vic3l_operator.f90 index 2a82bb52..142d7f7a 100644 --- a/smash/fcore/operator/md_vic3l_operator.f90 +++ b/smash/fcore/operator/md_vic3l_operator.f90 @@ -178,13 +178,14 @@ subroutine vic3l_baseflow(cbsl, ds, dsm, ws, hbsl, qb) end subroutine vic3l_baseflow - subroutine vic3l_timestep(setup, mesh, options, prcp, pet, b, cusl, & + subroutine vic3l_timestep(setup, mesh, t, options, prcp, pet, b, cusl, & & cmsl, cbsl, ks, pbc, dsm, ds, ws, hcl, husl, hmsl, hbsl, qt, returns) implicit none type(SetupDT), intent(in) :: setup type(MeshDT), intent(in) :: mesh + integer, intent(in) :: t type(OptionsDT), intent(in) :: options type(ReturnsDT), intent(inout) :: returns real(sp), dimension(mesh%nrow, mesh%ncol), intent(in) :: prcp, pet @@ -236,7 +237,11 @@ subroutine vic3l_timestep(setup, mesh, options, prcp, pet, b, cusl, & returns%stats%internal_fluxes(row, col, 2) = en returns%stats%internal_fluxes(row, col, 3) = qr returns%stats%internal_fluxes(row, col, 4) = qb - end if + end if + if (returns%pn_flag) returns%pn(row, col, t) = pn + if (returns%en_flag) returns%en(row, col, t) = en + if (returns%qr_flag) returns%qr(row, col, t) = qr + if (returns%qb_flag) returns%qb(row, col, t) = qb !$AD end-exclude end do end do