From 42b595b6479a5559d522f153ad94e6d9a86a2de2 Mon Sep 17 00:00:00 2001 From: nicgedney <131251916+nicgedney@users.noreply.github.com> Date: Thu, 20 Aug 2026 16:00:22 +0100 Subject: [PATCH 01/16] added all the extra variables definitions and passed to most/all routines --- src/science/surface/fcdch.F90 | 12 +++++-- .../surface/jules_land_sf_explicit_jls.F90 | 32 +++++++++++++++++-- .../surface/jules_ssi_sf_explicit_jls.F90 | 17 +++++++--- src/science/surface/physiol_jls_mod.F90 | 26 ++++++++++++++- src/science/surface/sf_evap_jls.F90 | 3 ++ src/science/surface/sf_flux_mod.F90 | 15 ++++++++- src/science/surface/sf_resist_jls.F90 | 8 ++++- 7 files changed, 100 insertions(+), 13 deletions(-) diff --git a/src/science/surface/fcdch.F90 b/src/science/surface/fcdch.F90 index 9f460f7f..9549618c 100644 --- a/src/science/surface/fcdch.F90 +++ b/src/science/surface/fcdch.F90 @@ -33,10 +33,10 @@ SUBROUTINE fcdch ( & wind_profile_factor,ddmfx,i_surfalg,charnock, & charnock_w,l_vegdrag,canht,lai, & nsnow,n,l_mo_buoyancy_calc,cansnowtile,l_soil_point, & - canopy,catch,flake,gc,snowdep,snow,canhc, & + canopy,catch,flake,gc,gc_irr_surft,frac_irr_surft,snowdep,snow,canhc, & dzsurf,qstar,q_elev,radnet,snowdepth,timestep, & t_elev,tsurf,tstar,vfrac,emis,emis_soil, & - anthrop_heat,scaling_urban,alpha1,hcons,ashtf, & + anthrop_heat,scaling_urban,alpha1,hcons,ashtf,ashtf_irr,ashtf_nir, & rhostar,bq_1,bt_1, & cdv,chv,cdv_std,v_s,v_s_std,recip_l_mo,u_s_std & ) @@ -155,6 +155,8 @@ SUBROUTINE fcdch ( & ,gc(points) & ! IN Interactive canopy conductance ! ! to evaporation (m/s) +,gc_irr_surft(points) & +,frac_irr_surft(points) & ,snowdep(points) & ! IN Snow depth (m) ,snow(points) & @@ -207,6 +209,8 @@ SUBROUTINE fcdch ( & ! IN Soil thermal conductivity (W/m/K). ,ashtf(points) & ! IN Adjusted SEB coefficient +,ashtf_irr(points) & +,ashtf_nir(points) & ,rhostar(tdims%i_start:tdims%i_end,tdims%j_start:tdims%j_end) & ! IN Surface air density ,bq_1(tdims%i_start:tdims%i_end,tdims%j_start:tdims%j_end) & @@ -588,6 +592,7 @@ SUBROUTINE fcdch ( & CALL sf_resist ( & points,surft_pts,pts_index,surft_index,cansnowtile, & canopy,catch,chv_dim,dq,epdt,flake,gc,gc_stom_surft, & + gc_irr_surft,frac_irr_surft, & snowdep,snow,vshr,tstar,fracaero_t,fracaero_s, & resfs,resft,resfs_stom,.FALSE.,.FALSE.) @@ -620,6 +625,7 @@ SUBROUTINE fcdch ( & points,surft_pts, & pts_index,surft_index, & nsnow,n,canhc,dzsurf,hcons,ashtf, & + ashtf_irr,ashtf_nir,frac_irr_surft, & qstemp,q_elev, & radnet,resft,fracaero_s(:),rhokh,l_soil_point, & snowdepth,timestep,t_elev,tsurf, & @@ -1009,6 +1015,7 @@ SUBROUTINE fcdch ( & CALL sf_resist ( & points,surft_pts,pts_index,surft_index,cansnowtile, & canopy,catch,chv_dim,dq,epdt,flake,gc,gc_stom_surft, & + gc_irr_surft,frac_irr_surft, & snowdep,snow,vshr,tstar,fracaero_t,fracaero_s, & resfs,resft,resfs_stom,.FALSE.,.FALSE.) @@ -1041,6 +1048,7 @@ SUBROUTINE fcdch ( & points,surft_pts, & pts_index,surft_index, & nsnow,n,canhc,dzsurf,hcons,ashtf, & + ashtf,ashtf,frac_irr_surft, & qstemp,q_elev, & radnet,resft,fracaero_s(:),rhokh,l_soil_point, & snowdepth,timestep,t_elev,tsurf, & diff --git a/src/science/surface/jules_land_sf_explicit_jls.F90 b/src/science/surface/jules_land_sf_explicit_jls.F90 index 6cf33e11..0191bfb6 100644 --- a/src/science/surface/jules_land_sf_explicit_jls.F90 +++ b/src/science/surface/jules_land_sf_explicit_jls.F90 @@ -93,6 +93,7 @@ SUBROUTINE jules_land_sf_explicit ( & resfs_irr_surft, & !crop_vars_mod (OUT) gs_irr_surft, smc_irr_soilt, wt_ext_irr_surft, gc_irr_surft, & + gs_nir_surft, gc_nir_surft, & !p_s_parms (IN) bexp_soilt, sathh_soilt, v_close_pft, v_open_pft, & !urban_param (IN) @@ -806,12 +807,23 @@ SUBROUTINE jules_land_sf_explicit ( & ! Areal heat capacity of snow (J/K/m2) ,ksnow(land_pts,nsmax) & ! Thermal conductivity of snow (W/m/K) +,ashtf_irr_surft(land_pts,nsurft) & +,ashtf_nir_surft(land_pts,nsurft) & +,hcons_irr_surf(land_pts,nsurft) & +,hcons_nir_surf(land_pts,nsurft) & +,hcons_irr_soilt(land_pts,nsoilt) & +,hcons_nir_soilt(land_pts,nsoilt) & +,sthu1_nir_soilt(land_pts) & +,sthf1_nir_soilt(land_pts) & +,sthf1_irr_soilt(land_pts) & ,hcons_snow(land_pts,nsurft) & ! Snow thermal conductivity ,resp_frac(land_pts,dim_cslayer) & ! respired fraction of RESP_S ,gc_stom_surft(land_pts,nsurft) & ! canopy conductance +,gs_nir_surft(land_pts,nsurft) & +,gc_nir_surft(land_pts,nsurft) & ,sice_surft_tmp(land_pts,nsmax) & ! Ice content of snow layers (kg/m2) ,sliq_surft_tmp(land_pts,nsmax) & @@ -1247,6 +1259,7 @@ SUBROUTINE jules_land_sf_explicit ( & rootc_cpft, sthu_irr_soilt, frac_irr_soilt, frac_irr_surft, dvi_cpft, & !crop_vars_mod (OUT) gs_irr_surft, smc_irr_soilt, wt_ext_irr_surft, gc_irr_surft, & + gs_nir_surft, gc_nir_surft, & !p_s_parms (IN) bexp_soilt, sathh_soilt, v_close_pft, v_open_pft, & !ancil_info @@ -2023,9 +2036,13 @@ SUBROUTINE jules_land_sf_explicit ( & ! Set up surface soil condictivity ashtf_surft(l,n) = 2.0 * hcons_surf(l,n) / dzsurf(l,n) + ashtf_nir_surft(l,n) = ashtf_surft(l,n) + ashtf_irr_surft(l,n) = ashtf_surft(l,n) ! Except when n == urban_canyon when MORUSES is used ! scaling_urban(l) = 1.0 ashtf_surft(l,n) = ashtf_surft(l,n) * scaling_urban(l,n) + ashtf_nir_surft(l,n) = ashtf_surft(l,n) + ashtf_irr_surft(l,n) = ashtf_surft(l,n) ! Adjust surface soil condictivity for snow IF (snowdepth_surft(l,n) > 0.0 .AND. l_soil_point(l) & @@ -2247,7 +2264,8 @@ SUBROUTINE jules_land_sf_explicit ( & CALL sf_resist ( & land_pts,surft_pts(n),land_index,surft_index(:,n),cansnowtile(n), & canopy(:,n),catch(:,n),chn(:,n),dq(:,n),epdt,flake(:,n),gc_surft(:,n), & - gc_stom_surft(:,n),snowdep_surft(:,n),snow_surft(:,n),vshr_land, & + gc_stom_surft(:,n),gc_irr_surft(:,n),frac_irr_surft(:,n), & + snowdep_surft(:,n),snow_surft(:,n),vshr_land, & tstar_surft(:,n),fracaero_t(:,n),fracaero_s(:,n),resfs(:,n),resft(:,n), & sf_diag%resfs_stom(:,n_diag),sf_diag%l_et_stom,sf_diag%l_et_stom_surft) @@ -2306,11 +2324,13 @@ SUBROUTINE jules_land_sf_explicit ( & l_vegdrag_surft(n),canht_pft(:,n_veg),lai_pft(:,n_veg), & nsnow_surft(:,n),n,l_mo_buoyancy_calc,cansnowtile(n),l_soil_point, & canopy(:,n),catch(:,n),flake(:,n),gc_surft(:,n), & + gc_irr_surft(:,n),frac_irr_surft(:,n), & snowdep_surft(:,n),snow_surft(:,n),canhc_surf(:,n), & dzsurf(:,n),qstar_surft(:,n),q_elev(:,n),radnet_surft(:,n), & snowdepth_surft(:,n),timestep,t_elev(:,n),tsurf(:,n),tstar_surft(:,n), & vfrac_surft(:,n),emis_surft(:,n),emis_soil,anthrop_heat_surft(:,n), & scaling_urban(:,n),alpha1(:,n),hcons_surf(:,n),ashtf_surft(:,n), & + ashtf_irr_surft(:,n),ashtf_nir_surft(:,n), & rhostar,bq_1,bt_1, & cd_surft(:,n),ch_surft(:,n),cd_std(:,n), & v_s_surft(:,n),v_s_std(:,n),recip_l_mo_surft(:,n), & @@ -2409,11 +2429,13 @@ SUBROUTINE jules_land_sf_explicit ( & l_vegdrag_active_here,array_zero,array_zero, & nsnow_surft(:,n),n,.FALSE.,cansnowtile(n),l_soil_point, & canopy(:,n),catch(:,n),flake(:,n),gc_surft(:,n), & + gc_irr_surft(:,n),frac_irr_surft(:,n), & snowdep_surft(:,n),snow_surft(:,n),canhc_surf(:,n), & dzsurf(:,n),qstar_surft(:,n),q_elev(:,n),radnet_surft(:,n), & snowdepth_surft(:,n),timestep,t_elev(:,n),tsurf(:,n),tstar_surft(:,n), & vfrac_surft(:,n),emis_surft(:,n),emis_soil,anthrop_heat_surft(:,n), & scaling_urban(:,n),alpha1(:,n),hcons_surf(:,n),ashtf_surft(:,n), & + ashtf_irr_surft(:,n),ashtf_nir_surft(:,n), & rhostar,bq_1,bt_1, & ! Following tiled outputs (except v_s_std_soil and u_s_iter_soil) ! are dummy variables not needed from this call @@ -2475,11 +2497,13 @@ SUBROUTINE jules_land_sf_explicit ( & l_vegdrag_active_here,array_zero,array_zero, & nsnow_surft(:,n),n,.FALSE.,cansnowtile(n),l_soil_point, & canopy(:,n),catch(:,n),flake(:,n),gc_surft(:,n), & + gc_irr_surft(:,n),frac_irr_surft(:,n), & snowdep_surft(:,n),snow_surft(:,n),canhc_surf(:,n), & dzsurf(:,n),qstar_surft(:,n),q_elev(:,n),radnet_surft(:,n), & snowdepth_surft(:,n),timestep,t_elev(:,n),tsurf(:,n),tstar_surft(:,n), & vfrac_surft(:,n),emis_surft(:,n),emis_soil,anthrop_heat_surft(:,n), & scaling_urban(:,n),alpha1(:,n),hcons_surf(:,n),ashtf_surft(:,n), & + ashtf_irr_surft(:,n),ashtf_nir_surft(:,n), & rhostar,bq_1,bt_1, & ! Following tiled outputs (except cd_std_classic and ch_surft_classic) ! are dummy variables not needed from this call @@ -2601,7 +2625,8 @@ SUBROUTINE jules_land_sf_explicit ( & CALL sf_resist ( & land_pts,surft_pts(n),land_index,surft_index(:,n),cansnowtile(n), & canopy(:,n),catch(:,n),ch_surft(:,n),dq(:,n),epdt,flake(:,n),gc_surft(:,n), & - gc_stom_surft(:,n),snowdep_surft(:,n),snow_surft(:,n),vshr_land, & + gc_stom_surft(:,n),gc_irr_surft(:,n),frac_irr_surft(:,n), & + snowdep_surft(:,n),snow_surft(:,n),vshr_land, & tstar_surft(:,n),fracaero_t(:,n),fracaero_s(:,n),resfs(:,n),resft(:,n), & sf_diag%resfs_stom(:,n_diag),sf_diag%l_et_stom,sf_diag%l_et_stom_surft) @@ -2609,7 +2634,8 @@ SUBROUTINE jules_land_sf_explicit ( & land_pts,surft_pts(n), & land_index,surft_index(:,n), & nsnow_surft(:,n),n,canhc_surf(:,n),dzsurf(:,n),hcons_surf(:,n), & - ashtf_surft(:,n),qstar_surft(:,n),q_elev(:,n), & + ashtf_surft(:,n),ashtf_irr_surft(:,n),ashtf_nir_surft(:,n), & + frac_irr_surft(:,n),qstar_surft(:,n),q_elev(:,n), & radnet_surft(:,n),resft(:,n),fracaero_s(:,n),rhokh_surft(:,n),l_soil_point, & snowdepth_surft(:,n),timestep,t_elev(:,n),tsurf(:,n), & tstar_surft(:,n),vfrac_surft(:,n),rhokh_can(:,n),z0h_surft(:,n), & diff --git a/src/science/surface/jules_ssi_sf_explicit_jls.F90 b/src/science/surface/jules_ssi_sf_explicit_jls.F90 index 0c536dbb..3bd03add 100644 --- a/src/science/surface/jules_ssi_sf_explicit_jls.F90 +++ b/src/science/surface/jules_ssi_sf_explicit_jls.F90 @@ -1436,11 +1436,11 @@ SUBROUTINE jules_ssi_sf_explicit ( & l_vegdrag_ssi,array_zero,array_zero, & array_zero_int,0,.FALSE.,.FALSE.,array_false, & array_zero,array_zero,array_zero,array_zero, & - array_zero,array_zero,canhc_sea, & + array_zero,array_zero,array_zero,array_zero,canhc_sea, & dzssi,qstar_sea,qw_1,radnet_sea, & array_zero,timestep,tl_1,tstar_sea,tstar_sea, & array_zero,array_emis,array_one,array_zero, & - array_one,alpha1_sea,hcons_sea,ashtf_sea, & + array_one,alpha1_sea,hcons_sea,ashtf_sea,ashtf_sea,ashtf_sea, & rhostar,bq_1,bt_1, & cd_sea,ch_sea,cd_std_sea, & v_s_sea,v_s_std_sea,recip_l_mo_sea, & @@ -1461,11 +1461,12 @@ SUBROUTINE jules_ssi_sf_explicit ( & l_vegdrag_ssi,array_zero,array_zero, & array_zero_int,0,.FALSE.,.FALSE.,array_false, & array_zero,array_zero,array_zero,array_zero, & - array_zero,array_zero,array_zero, & + array_zero,array_zero,array_zero,array_zero,array_zero, & dzdummy,qstar_ice_cat(:,:,n),qw_1,radnet_sice(:,:,n), & array_zero,timestep,tl_1,ti_cat(:,:,n),tstar_sice_cat(:,:,n), & array_zero,array_emis,array_one,array_zero, & array_one,alpha1_sice(:,:,n),k_sice(:,:,n),ashtf(:,:,n), & + ashtf(:,:,n),ashtf(:,:,n), & rhostar,bq_1,bt_1, & cd_ice(:,:,n),ch_ice(:,:,n),cd_std_ice(:,n), & v_s_ice(:,:,n),v_s_std_ice(:,n),recip_l_mo_ice(:,:,n), & @@ -1484,11 +1485,12 @@ SUBROUTINE jules_ssi_sf_explicit ( & l_vegdrag_ssi,array_zero,array_zero, & array_zero_int,0,.FALSE.,.FALSE.,array_false, & array_zero,array_zero,array_zero,array_zero, & - array_zero,array_zero,array_zero, & + array_zero,array_zero,array_zero,array_zero,array_zero, & dzdummy,qstar_ice_cat(:,:,1),qw_1,radnet_sice(:,:,1), & array_zero,timestep,tl_1,ti_cat(:,:,1),tstar_sice_cat(:,:,1), & array_zero,array_emis,array_one,array_zero, & array_one,alpha1_sice(:,:,1),k_sice(:,:,1),ashtf(:,:,1), & + ashtf(:,:,1),ashtf(:,:,1), & rhostar,bq_1,bt_1, & cd_ice(:,:,1),ch_ice(:,:,1),cd_std_ice(:,1), & v_s_ice(:,:,1),v_s_std_ice(:,1),recip_l_mo_ice(:,:,1), & @@ -1527,11 +1529,12 @@ SUBROUTINE jules_ssi_sf_explicit ( & l_vegdrag_ssi,array_zero,array_zero, & array_zero_int,0,.FALSE.,.FALSE.,array_false, & array_zero,array_zero,array_zero,array_zero, & - array_zero,array_zero,array_zero, & + array_zero,array_zero,array_zero,array_zero,array_zero, & dzdummy,qstar_ice_cat(:,:,1),qw_1,radnet_sice(:,:,1), & array_zero,timestep,tl_1,ti_cat(:,:,1),tstar_sice_cat(:,:,1), & array_zero,array_emis,array_one,array_zero, & array_one,alpha1_sice(:,:,1),k_sice(:,:,1),ashtf(:,:,1), & + ashtf(:,:,1),ashtf(:,:,1), & rhostar,bq_1,bt_1, & cd_miz,ch_miz,cd_std_miz, & v_s_miz,v_s_std_miz,recip_l_mo_miz, & @@ -1776,6 +1779,7 @@ SUBROUTINE jules_ssi_sf_explicit ( & ssi_pts,sea_pts, & ssi_index,sea_index, & array_zero_int,0,canhc_sea,dzssi,hcons_sea,ashtf_sea, & + ashtf_sea,ashtf_sea,array_zero, & qstar_sea,qw_1,radnet_sea, & array_one * beta_evap,array_zero,rhokh_sea,array_false,array_zero, & timestep,tl_1,tstar_sea,tstar_sea, & @@ -1821,6 +1825,7 @@ SUBROUTINE jules_ssi_sf_explicit ( & ssi_pts,sea_pts, & ssi_index,sea_index, & array_zero_int,0,canhc_sea,dzssi,hcons_sea,ashtf_sea, & + ashtf_sea,ashtf_sea,array_zero, & qstar_sea,qw_1,radnet_sea, & array_one * beta_evap,array_zero,rhokh_1_sice,array_false,array_zero, & timestep,tl_1,tstar_sea,tstar_sea, & @@ -1916,6 +1921,7 @@ SUBROUTINE jules_ssi_sf_explicit ( & ssi_pts,sice_pts_ncat(n), & ssi_index,sice_index_ncat(:,n), & array_zero_int,0,array_zero,dzdummy,k_sice(:,:,n),ashtf(:,:,n), & + ashtf(:,:,n),ashtf(:,:,n),array_zero, & qstar_ice_cat(:,:,n),qw_1,radnet_sice(:,:,n),array_one,array_one, & rhokh_1_sice_ncats(:,:,n),array_false,array_zero, & timestep,tl_1,ti_cat(:,:,n), & @@ -1951,6 +1957,7 @@ SUBROUTINE jules_ssi_sf_explicit ( & ssi_pts,sice_pts_ncat(1), & ssi_index,sice_index_ncat(:,1), & array_zero_int,0,array_zero,dzdummy,k_sice(:,:,1),ashtf(:,:,1), & + ashtf(:,:,1),ashtf(:,:,1),array_zero, & qstar_ice,qw_1,radnet_sice(:,:,1),array_one,array_one, & rhokh_1_sice_ncats(:,:,1),array_false,array_zero, & timestep,tl_1,ti,tstar_sice_cat(:,:,1), & diff --git a/src/science/surface/physiol_jls_mod.F90 b/src/science/surface/physiol_jls_mod.F90 index 00caf8cf..8cb3427b 100644 --- a/src/science/surface/physiol_jls_mod.F90 +++ b/src/science/surface/physiol_jls_mod.F90 @@ -54,6 +54,7 @@ SUBROUTINE physiol ( & rootc_cpft, sthu_irr_soilt, frac_irr_soilt, frac_irr_surft, dvi_cpft, & !crop_vars_mod (OUT) gs_irr_surft, smc_irr_soilt, wt_ext_irr_surft, gc_irr_surft, & + gs_nir_surft, gc_nir_surft, & !p_s_parms (IN) bexp_soilt, sathh_soilt, v_close_pft, v_open_pft, & !ancil_info (IN) @@ -358,6 +359,8 @@ SUBROUTINE physiol ( & REAL(KIND=real_jlslsm), INTENT(OUT) :: & wt_ext_irr_surft(land_pts,sm_levels,nsurft) REAL(KIND=real_jlslsm), INTENT(OUT) :: gc_irr_surft(land_pts,nsurft) +REAL(KIND=real_jlslsm), INTENT(OUT) :: gs_nir_surft(land_pts,nsurft) +REAL(KIND=real_jlslsm), INTENT(OUT) :: gc_nir_surft(land_pts,nsurft) !ancil_info (IN) LOGICAL, INTENT(IN) :: l_soil_point(land_pts) @@ -445,22 +448,39 @@ SUBROUTINE physiol ( & ! was calculated from psi_close for that ! soil tile and pft. REAL(KIND=real_jlslsm) :: & -fsmc_irr(land_pts,npft) & +fsmc_nir(land_pts,npft) & +! ! WORK Soil moisture availability +! ! factor over non-irrigated fraction. +,fsmc_irr(land_pts,npft) & ! ! WORK Soil moisture availability ! ! factor over irrigated fraction. ,sthu_nir_soilt(land_pts,nsoilt,sm_levels) & ,sthu_surft(land_pts,nsoilt,sm_levels) & +,wt_ext_nir_soilt(land_pts,nsoilt,sm_levels) & +! ! WORK Fraction of transpiration over +! ! non-irrigated fraction extracted +! ! from each soil layer. ,wt_ext_irr_soilt(land_pts,nsoilt,sm_levels) & ! ! WORK Fraction of transpiration over ! ! irrigated fraction extracted ! ! from each soil layer. +,wt_ext_nir_type(land_pts,sm_levels,ntype) & +! ! WORK Fraction of transpiration over +! ! non-irrigated area extracted from +! ! each soil layer (kg/m2/s). ,wt_ext_irr_type(land_pts,sm_levels,ntype) & ! ! WORK Fraction of transpiration over ! ! irrigated area extracted from ! ! each soil layer (kg/m2/s). +,smc_nir_soilt(land_pts,nsoilt) & +,gs_nir_type(land_pts,ntype) & +! ! WORK Conductance for non-irrigated surface types ,gs_irr_type(land_pts,ntype) & ! ! WORK Conductance for irrigated surface types +,gsoil_nir_soilt(land_pts,nsoilt) & +! ! WORK Bare soil conductance over +! ! non-irrigated fraction. ,gsoil_irr_soilt(land_pts,nsoilt) & ! ! WORK Bare soil conductance over ! ! irrigated fraction. @@ -518,6 +538,8 @@ SUBROUTINE physiol ( & ! WORK Fractional canopy coverage. ,vf_type(land_pts,ntype) & ! WORK VFRAC for surface types. +,sthu_nir_soilt(land_pts,nsoilt,sm_levels) & +,wt_ext_type_tmp(land_pts,sm_levels,ntype) & ,wt_ext_type(land_pts,sm_levels,ntype) & ! ! WORK WT_EXT for surface types. ,wt_ext_soilt(land_pts,nsoilt,sm_levels) & @@ -525,6 +547,8 @@ SUBROUTINE physiol ( & ,fsoil(land_pts,npft) & ! WORK Fraction of ground below canopy ! ! contributing to evaporation. +,fsoil_irr_tot(land_pts) & +,fsoil_nir_tot(land_pts) & ,fsoil_tot(land_pts) & ! WORK Total fraction of soil ! ! contributing to evaporation diff --git a/src/science/surface/sf_evap_jls.F90 b/src/science/surface/sf_evap_jls.F90 index e7c06103..5eb20ec3 100644 --- a/src/science/surface/sf_evap_jls.F90 +++ b/src/science/surface/sf_evap_jls.F90 @@ -188,6 +188,9 @@ SUBROUTINE sf_evap ( & ! ! WORK Evapotranspiration from soil ! ! moisture through non-irrigated ! ! fraction of land tiles (kg/m2/s). +,ext_nir_soilt(land_pts,nsoilt,sm_levels) & +,wt_ext_nir_surft(land_pts,sm_levels,nsurft) & +,resfs_nir_surft(land_pts,nsurft) & ,smc_nir_soilt(land_pts,nsoilt) ! ! WORK Available soil moisture (kg/m2). ! ! fraction (kg/m2/s). diff --git a/src/science/surface/sf_flux_mod.F90 b/src/science/surface/sf_flux_mod.F90 index b41ae51f..7ca3e33b 100644 --- a/src/science/surface/sf_flux_mod.F90 +++ b/src/science/surface/sf_flux_mod.F90 @@ -14,7 +14,8 @@ MODULE sf_flux_mod CONTAINS SUBROUTINE sf_flux ( & points,surft_pts,pts_index,surft_index, & - nsnow,n,canhc,dzsurf,hcons,ashtf,qstar,q_elev,radnet,resft,fracs, & + nsnow,n,canhc,dzsurf,hcons,ashtff,ashtf_irr,ashtf_nir,frac_irr, & + qstar,q_elev,radnet,resft,fracs, & rhokh_1,l_soil_point,snowdepth,timestep, & t_elev,ts1_elev,tstar,vfrac,rhokh_can, & z0h,z0m_eff,zdt,z1_tq,lh0,emis_surft,emis_soil, & @@ -35,6 +36,7 @@ SUBROUTINE sf_flux ( & USE jules_surface_mod, ONLY: l_aggregate, l_epot_corr USE jules_science_fixes_mod, ONLY: l_fix_moruses_roof_rad_coupling, & l_fix_neg_snow +USE jules_irrig_mod, ONLY: l_irrig_dmd USE parkind1, ONLY: jprb, jpim USE yomhook, ONLY: lhook, dr_hook @@ -70,6 +72,9 @@ SUBROUTINE sf_flux ( & ,ashtf(points) & ! IN Coefficient to calculate surface ! heat flux into soil (W/m2/K). +,ashtf_irr(points) & +,ashtf_nir(points) & +,frac_irr(points) & ,qstar(points) & ! IN Surface qsat. ,q_elev(points) & @@ -162,6 +167,14 @@ SUBROUTINE sf_flux ( & dtstar_pot(points) & ! Change in TSTAR over timestep that is ! appropriate for the potential evaporation +,ddtstar(points) & +,dtstar_nir(points) & +,dtstar_irr(points) & +,dtstar_new(points) & +,ashtf_prime_nir(points) & +,ashtf_prime_irr(points) & +,surf_ht_flux_nir & +,surf_ht_flux_irr & ,surf_ht_flux ! Flux of heat from surface to sub-surface ! Scalars diff --git a/src/science/surface/sf_resist_jls.F90 b/src/science/surface/sf_resist_jls.F90 index 1ff6b897..16701a72 100644 --- a/src/science/surface/sf_resist_jls.F90 +++ b/src/science/surface/sf_resist_jls.F90 @@ -19,7 +19,8 @@ MODULE sf_resist_mod ! Arguments -------------------------------------------------------- SUBROUTINE sf_resist ( & land_pts,surft_pts,land_index,surft_index,cansnowtile, & - canopy,catch,ch,dq,epdt,flake,gc,gc_stom_surft,snowdep_surft,snow_surft, & + canopy,catch,ch,dq,epdt,flake,gc,gc_stom_surft,gc_irr_surft,frac_irr_surft, & + snowdep_surft,snow_surft, & vshr,tstar,fracaero_t, fracaero_s,resfs,resft, & resfs_stom,l_et_stom,l_et_stom_surft) @@ -31,6 +32,7 @@ SUBROUTINE sf_resist ( & USE water_constants_mod, ONLY: tm, rho_ice USE jules_surface_mod, ONLY: l_aggregate USE jules_vegetation_mod, ONLY: can_model +USE jules_irrig_mod, ONLY: l_irrig_dmd USE parkind1, ONLY: jprb, jpim USE yomhook, ONLY: lhook, dr_hook IMPLICIT NONE @@ -74,6 +76,9 @@ SUBROUTINE sf_resist ( & ,gc(land_pts) & ! IN Interactive canopy conductance ! ! to evaporation (m/s) +,frac_irr_surft(land_pts) & +,gc_irr_surft(land_pts) & + ! IN canopy conductance over irrigated frac ,gc_stom_surft(land_pts) & ! IN canopy conductance (excluding soil) (m/s) ,snowdep_surft(land_pts) & @@ -123,6 +128,7 @@ SUBROUTINE sf_resist ( & INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0 INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1 REAL(KIND=jprb) :: zhook_handle +REAL(KIND=real_jlslsm) :: gc_nir_surft(land_pts) CHARACTER(LEN=*), PARAMETER :: RoutineName='SF_RESIST' From 34f29ccc74fa4270bcfc31d2aad5772957d7e287 Mon Sep 17 00:00:00 2001 From: nicgedney <131251916+nicgedney@users.noreply.github.com> Date: Thu, 20 Aug 2026 16:23:34 +0100 Subject: [PATCH 02/16] fix compiler bug --- src/science/surface/physiol_jls_mod.F90 | 12 ++++++++---- src/science/surface/sf_flux_mod.F90 | 2 +- 2 files changed, 9 insertions(+), 5 deletions(-) diff --git a/src/science/surface/physiol_jls_mod.F90 b/src/science/surface/physiol_jls_mod.F90 index 8cb3427b..26c4a993 100644 --- a/src/science/surface/physiol_jls_mod.F90 +++ b/src/science/surface/physiol_jls_mod.F90 @@ -487,6 +487,7 @@ SUBROUTINE physiol ( & ,gsoil_under_canopy(land_pts) & ! ! WORK Bare soil conductance under ! ! canopy +,gsoil_nir_under_canopy(land_pts) & ,gsoil_irr_under_canopy(land_pts) ! ! WORK Bare soil conductance under ! ! canopy on irrigated fraction. @@ -538,7 +539,7 @@ SUBROUTINE physiol ( & ! WORK Fractional canopy coverage. ,vf_type(land_pts,ntype) & ! WORK VFRAC for surface types. -,sthu_nir_soilt(land_pts,nsoilt,sm_levels) & +!!!,sthu_nir_soilt(land_pts,nsoilt,sm_levels) & ,wt_ext_type_tmp(land_pts,sm_levels,ntype) & ,wt_ext_type(land_pts,sm_levels,ntype) & ! ! WORK WT_EXT for surface types. @@ -1091,7 +1092,8 @@ SUBROUTINE physiol ( & v_open,smvcst_soilt(:,m,:), & v_close, & bexp_soilt(:,m,:), sathh_soilt(:,m,:), & - wt_ext_type(:,:,n),fsmc_pft(:,n),psi_root_zone_pft(:,n)) + wt_ext_type(:,:,n),fsmc_pft(:,n), & + psi_root_zone_pft(:,n)) END IF IF (l_irrig_dmd) THEN @@ -1252,8 +1254,10 @@ SUBROUTINE physiol ( & CALL soil_evap (land_pts,sm_levels,surft_pts(n),surft_index(:,n), & irrig_tile(n),gsoil_under_canopy(:),lai_pft_soil_evap(:,n), & - gs_type(:,n), wt_ext_type(:,:,n), & - fsoil(:,n),gsoil_irr_under_canopy(:), & + gs_type(:,n), wt_ext_type(:,:,n),fsoil(:,n), & + frac_irr_surft(:,n),gsoil_nir_under_canopy(:), & + gs_nir_type(:,n),wt_ext_nir_type(:,:,n), & + gsoil_irr_under_canopy(:), & gs_irr_type(:,n),wt_ext_irr_type(:,:,n)) CALL leaf_lit (land_pts,surft_pts(n),surft_index(:,n) & diff --git a/src/science/surface/sf_flux_mod.F90 b/src/science/surface/sf_flux_mod.F90 index 7ca3e33b..7b422b5d 100644 --- a/src/science/surface/sf_flux_mod.F90 +++ b/src/science/surface/sf_flux_mod.F90 @@ -14,7 +14,7 @@ MODULE sf_flux_mod CONTAINS SUBROUTINE sf_flux ( & points,surft_pts,pts_index,surft_index, & - nsnow,n,canhc,dzsurf,hcons,ashtff,ashtf_irr,ashtf_nir,frac_irr, & + nsnow,n,canhc,dzsurf,hcons,ashtf,ashtf_irr,ashtf_nir,frac_irr, & qstar,q_elev,radnet,resft,fracs, & rhokh_1,l_soil_point,snowdepth,timestep, & t_elev,ts1_elev,tstar,vfrac,rhokh_can, & From ff478327333760d3605cea70d0254447c05f6038 Mon Sep 17 00:00:00 2001 From: nicgedney <131251916+nicgedney@users.noreply.github.com> Date: Thu, 20 Aug 2026 17:00:58 +0100 Subject: [PATCH 03/16] more bug fixes --- .../surface/jules_land_sf_explicit_jls.F90 | 3 +-- src/science/surface/soil_evap_jls.F90 | 20 +++++++++++++++---- 2 files changed, 17 insertions(+), 6 deletions(-) diff --git a/src/science/surface/jules_land_sf_explicit_jls.F90 b/src/science/surface/jules_land_sf_explicit_jls.F90 index 0191bfb6..ebddc924 100644 --- a/src/science/surface/jules_land_sf_explicit_jls.F90 +++ b/src/science/surface/jules_land_sf_explicit_jls.F90 @@ -93,7 +93,6 @@ SUBROUTINE jules_land_sf_explicit ( & resfs_irr_surft, & !crop_vars_mod (OUT) gs_irr_surft, smc_irr_soilt, wt_ext_irr_surft, gc_irr_surft, & - gs_nir_surft, gc_nir_surft, & !p_s_parms (IN) bexp_soilt, sathh_soilt, v_close_pft, v_open_pft, & !urban_param (IN) @@ -1976,7 +1975,7 @@ SUBROUTINE jules_land_sf_explicit ( & !$OMP n, m, ts1_lake_gb, hcon_lake, l_elev_land_ice, l_lice_point, & !$OMP tsurf_elev_surft, dzsoil_elev, l_lice_surft, hcondeep, & !$OMP l_moruses_storage, urban_roof, l_fix_moruses_roof_rad_coupling, & -!$OMP vfrac_surft, ashtf_surft, scaling_urban, l_soil_point) & +!$OMP vfrac_surft, ashtf_surft, ashtf_nir_surft, ashtf_irr_surft, &!$OMP scaling_urban, l_soil_point) & !$OMP SCHEDULE(STATIC) DO l = 1,land_pts j = (land_index(l) - 1) / t_i_length + 1 diff --git a/src/science/surface/soil_evap_jls.F90 b/src/science/surface/soil_evap_jls.F90 index 1d62399e..d1662ecb 100644 --- a/src/science/surface/soil_evap_jls.F90 +++ b/src/science/surface/soil_evap_jls.F90 @@ -21,8 +21,9 @@ MODULE soil_evap_mod ! ********************************************************************* SUBROUTINE soil_evap (npnts,nshyd,surft_pts,surft_index, & - irrig_tile,gsoil,lai,gs,wt_ext,fsoil & - ,gsoil_irr,gs_irr,wt_ext_irr & + irrig_tile,gsoil,lai,gs,wt_ext,fsoil,frac_irr, & + gsoil_nir,gs_nir,wt_ext_nir, & + gsoil_irr,gs_irr,wt_ext_irr & ) USE jules_irrig_mod, ONLY: l_irrig_dmd @@ -48,12 +49,16 @@ SUBROUTINE soil_evap (npnts,nshyd,surft_pts,surft_index, & REAL(KIND=real_jlslsm), INTENT(IN) :: & gsoil(npnts) & ! IN Soil surface conductance (m/s). +,frac_irr(npnts) & ,lai(npnts) ! IN Leaf area index. REAL(KIND=real_jlslsm), INTENT(IN) :: & -gsoil_irr(npnts) ! IN Soil surface conductance (m/s) over + gsoil_irr(npnts) & +! ! IN Soil surface conductance (m/s) over ! irrigated fraction. +,gsoil_nir(npnts) ! IN Soil surface conductance (m/s) over +! non-irrigated fraction. REAL(KIND=real_jlslsm), INTENT(IN OUT) :: & gs(npnts) & @@ -67,9 +72,16 @@ SUBROUTINE soil_evap (npnts,nshyd,surft_pts,surft_index, & ! ! INOUT Fraction of evapotranspiration ! ! extracted from each soil layer ! ! over irrigated area. -,gs_irr(npnts) +,wt_ext_nir(npnts,nshyd) & +! ! INOUT Fraction of evapotranspiration +! ! extracted from each soil layer +! ! over non-irrigated area. +,gs_irr(npnts) & ! ! INOUT Conductance for irrigated ! ! surface fraction. +,gs_nir(npnts) +! ! INOUT Conductance for non-irrigated +! ! surface fraction. REAL(KIND=real_jlslsm), INTENT(OUT) :: & fsoil(npnts) ! Fraction of ground below canopy From 91429bff492e7ff0d868f920068a1093eaeeaeb3 Mon Sep 17 00:00:00 2001 From: nicgedney <131251916+nicgedney@users.noreply.github.com> Date: Thu, 20 Aug 2026 17:10:33 +0100 Subject: [PATCH 04/16] correcting one typo --- src/science/surface/jules_land_sf_explicit_jls.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/science/surface/jules_land_sf_explicit_jls.F90 b/src/science/surface/jules_land_sf_explicit_jls.F90 index ebddc924..41d5ebca 100644 --- a/src/science/surface/jules_land_sf_explicit_jls.F90 +++ b/src/science/surface/jules_land_sf_explicit_jls.F90 @@ -1975,7 +1975,7 @@ SUBROUTINE jules_land_sf_explicit ( & !$OMP n, m, ts1_lake_gb, hcon_lake, l_elev_land_ice, l_lice_point, & !$OMP tsurf_elev_surft, dzsoil_elev, l_lice_surft, hcondeep, & !$OMP l_moruses_storage, urban_roof, l_fix_moruses_roof_rad_coupling, & -!$OMP vfrac_surft, ashtf_surft, ashtf_nir_surft, ashtf_irr_surft, &!$OMP scaling_urban, l_soil_point) & +!$OMP vfrac_surft, ashtf_surft, ashtf_nir_surft, ashtf_irr_surft, &!$OMP scaling_urban, l_soil_point) !$OMP SCHEDULE(STATIC) DO l = 1,land_pts j = (land_index(l) - 1) / t_i_length + 1 From 26f839ec6ad1fd0cb64a2e16bd389fd46fd7302e Mon Sep 17 00:00:00 2001 From: nicgedney <131251916+nicgedney@users.noreply.github.com> Date: Thu, 20 Aug 2026 17:37:47 +0100 Subject: [PATCH 05/16] OMP typo fixed --- src/science/surface/jules_land_sf_explicit_jls.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/science/surface/jules_land_sf_explicit_jls.F90 b/src/science/surface/jules_land_sf_explicit_jls.F90 index 41d5ebca..ba4a755f 100644 --- a/src/science/surface/jules_land_sf_explicit_jls.F90 +++ b/src/science/surface/jules_land_sf_explicit_jls.F90 @@ -1975,7 +1975,8 @@ SUBROUTINE jules_land_sf_explicit ( & !$OMP n, m, ts1_lake_gb, hcon_lake, l_elev_land_ice, l_lice_point, & !$OMP tsurf_elev_surft, dzsoil_elev, l_lice_surft, hcondeep, & !$OMP l_moruses_storage, urban_roof, l_fix_moruses_roof_rad_coupling, & -!$OMP vfrac_surft, ashtf_surft, ashtf_nir_surft, ashtf_irr_surft, &!$OMP scaling_urban, l_soil_point) +!$OMP vfrac_surft, ashtf_surft, ashtf_nir_surft, ashtf_irr_surft, & +!$OMP scaling_urban, l_soil_point) !$OMP SCHEDULE(STATIC) DO l = 1,land_pts j = (land_index(l) - 1) / t_i_length + 1 From 7d95d7c5c21e99d71ffe30c650fe91c4829f5ef6 Mon Sep 17 00:00:00 2001 From: nicgedney <131251916+nicgedney@users.noreply.github.com> Date: Thu, 20 Aug 2026 17:50:41 +0100 Subject: [PATCH 06/16] OMP typo fixed --- src/science/surface/jules_land_sf_explicit_jls.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/science/surface/jules_land_sf_explicit_jls.F90 b/src/science/surface/jules_land_sf_explicit_jls.F90 index ba4a755f..aebcce9e 100644 --- a/src/science/surface/jules_land_sf_explicit_jls.F90 +++ b/src/science/surface/jules_land_sf_explicit_jls.F90 @@ -1975,8 +1975,8 @@ SUBROUTINE jules_land_sf_explicit ( & !$OMP n, m, ts1_lake_gb, hcon_lake, l_elev_land_ice, l_lice_point, & !$OMP tsurf_elev_surft, dzsoil_elev, l_lice_surft, hcondeep, & !$OMP l_moruses_storage, urban_roof, l_fix_moruses_roof_rad_coupling, & -!$OMP vfrac_surft, ashtf_surft, ashtf_nir_surft, ashtf_irr_surft, & -!$OMP scaling_urban, l_soil_point) +!$OMP vfrac_surft, ashtf_surft, ashtf_irr_surft, ashtf_nir_surft, & +!$OMP scaling_urban, l_soil_point) & !$OMP SCHEDULE(STATIC) DO l = 1,land_pts j = (land_index(l) - 1) / t_i_length + 1 From 4fe1ce2e3b3951dc6364146b21b085731ce6ad26 Mon Sep 17 00:00:00 2001 From: nicgedney <131251916+nicgedney@users.noreply.github.com> Date: Fri, 21 Aug 2026 15:07:31 +0100 Subject: [PATCH 07/16] added first attempt of code additions to physiol --- src/control/shared/jules_hydrology_mod.F90 | 6 +- src/science/surface/physiol_jls_mod.F90 | 264 ++++++++++++++++++--- 2 files changed, 230 insertions(+), 40 deletions(-) diff --git a/src/control/shared/jules_hydrology_mod.F90 b/src/control/shared/jules_hydrology_mod.F90 index f1d360b4..7bb08015 100644 --- a/src/control/shared/jules_hydrology_mod.F90 +++ b/src/control/shared/jules_hydrology_mod.F90 @@ -47,8 +47,12 @@ MODULE jules_hydrology_mod ! Only used if l_top=.T. l_limit_gsoil = .FALSE., & ! Switch for limiting gsoil above theta_crit - l_inland = .FALSE. + l_inland = .FALSE., & ! Switch for putting inland water from from rivers into soil moisture + l_soil_evap_irrig_expl = .FALSE. + ! Switch for explcitly calculating bare soil evaporation over the + ! separate irrigated and non-irrigated fractions of the grid box. + ! (Default used the grid box mean soil moisture). !----------------------------------------------------------------------------- ! PDM parameters diff --git a/src/science/surface/physiol_jls_mod.F90 b/src/science/surface/physiol_jls_mod.F90 index 26c4a993..48bf0f56 100644 --- a/src/science/surface/physiol_jls_mod.F90 +++ b/src/science/surface/physiol_jls_mod.F90 @@ -109,7 +109,7 @@ SUBROUTINE physiol ( & USE jules_irrig_mod, ONLY: l_irrig_dmd -USE jules_hydrology_mod, ONLY: l_limit_gsoil +USE jules_hydrology_mod, ONLY: l_limit_gsoil, l_soil_evap_irrig_expl USE pftparm, ONLY: emis_pft, fsmc_p0, rootd_ft, gsoil_f @@ -637,17 +637,20 @@ SUBROUTINE physiol ( & !$OMP resp_l_pft,resp_r_pft,fsmc_pft,apar_diag_pft,isoprene_pft,terpene_pft, & !$OMP methanol_pft,acetone_pft, nsoilt,smc_soilt,g_leaf,fsmc_irr,root_param, & !$OMP sm_levels,rib,f_root,tdims, ilayers,faparv,nsurft,gc_stom_surft, & -!$OMP smc_irr_soilt,ntype,alb_type_dummy,fapar_dir,fapar_dif, & +!$OMP smc_irr_soilt,smc_nir_soilt,ntype,alb_type_dummy,fapar_dir,fapar_dif, & !$OMP wt_ext_soilt,wt_ext_irr_soilt,wt_ext_irr_type,wt_ext_type, & !$OMP dim_cs1,resp_s_soilt,gpp,npp,resp_p,ra,canhc,vfrac,apar_diag_gb, & !$OMP isoprene_gb,terpene_gb,methanol_gb,acetone_gb,fsoil_tot,frac, & !$OMP land_index, t_i_length, pstar_land, pstar, ipar_land, & !$OMP photosynth_act_rad, q1_land, qw_1, gs_type, gs, & -!$OMP l_irrig_dmd, gs_irr_type, cosz_gb, cos_zenith_angle, & +!$OMP l_irrig_dmd, l_soil_evap_irrig_expl, gs_irr_type, & +!$OMP cosz_gb, cos_zenith_angle, & !$OMP gsoil_irr_soilt, smvccl_soilt, gs_nvg, soil, l_limit_gsoil, & !$OMP sthu_irr_soilt, smvcst_soilt, gsoil_soilt, sthu_soilt, & !$OMP gc_corr, n_wtrac_jls, smc_soilt_wtrac, growth_sug_pft, growth_sug_gb, & -!$OMP lwp_c_pft,l_wtrac_jls) +!$OMP fsmc_nir, wt_ext_nir_soilt, wt_ext_nir_type, sthu_nir_soilt, & +!$OMP frac_irr_soilt,fsoil_irr_tot,fsoil_nir_tot, gs_nir_type, & +!$OMP gsoil_nir_soilt,lwp_c_pft,l_wtrac_jls,frac_irr_surft) DO n = 1,npft !$OMP DO SCHEDULE(STATIC) @@ -665,6 +668,7 @@ SUBROUTINE physiol ( & methanol_pft(l,n) = 0.0 acetone_pft(l,n) = 0.0 g_leaf(l,n) = 0.0 + fsmc_nir(l,n) = 0.0 fsmc_irr(l,n) = 0.0 root_param(l,n) = 0.0 gc_corr(l,n) = 0.0 @@ -700,6 +704,7 @@ SUBROUTINE physiol ( & DO l = 1,land_pts smc_soilt(l,m) = 0.0 smc_irr_soilt(l,m) = 0.0 + smc_nir_soilt(l,m) = 0.0 END DO !$OMP END DO NOWAIT END DO @@ -775,6 +780,7 @@ SUBROUTINE physiol ( & DO l = 1,land_pts wt_ext_soilt(l,m,k) = 0.0 wt_ext_irr_soilt(l,m,k) = 0.0 + wt_ext_nir_soilt(l,m,k) = 0.0 END DO !$OMP END DO NOWAIT END DO @@ -785,6 +791,7 @@ SUBROUTINE physiol ( & !$OMP DO SCHEDULE(STATIC) DO l = 1,land_pts wt_ext_irr_type(l,k,n) = 0.0 + wt_ext_nir_type(l,k,n) = 0.0 wt_ext_type(l,k,n) = 0.0 END DO !$OMP END DO NOWAIT @@ -803,6 +810,26 @@ SUBROUTINE physiol ( & END DO END DO +IF (l_soil_evap_irrig_expl) THEN + DO k = 1,sm_levels + DO m = 1,nsoilt + DO l = 1,land_pts + sthu_nir_soilt(l,m,k) = sthu_soilt(l,m,k) + IF ( l_irrig_dmd ) THEN + sthu_nir_soilt(l,m,k) = sthu_soilt(l,m,k) + IF ( frac_irr_soilt(l,m) < 1.0 ) THEN + sthu_nir_soilt(l,m,k) = & + (sthu_soilt(l,m,k) - frac_irr_soilt(l,m) & + * sthu_irr_soilt(l,m,k)) & + / (1.0 - frac_irr_soilt(l,m)) + ELSE + sthu_nir_soilt(l,m,k) = sthu_irr_soilt(l,m,k) + END IF + END IF + END DO + END DO + END DO +END IF DO n = 1,ntype !$OMP DO SCHEDULE(STATIC) @@ -810,7 +837,10 @@ SUBROUTINE physiol ( & gs_type(l,n) = gs(l) IF (l_irrig_dmd) THEN gs_irr_type(l,n) = gs(l) - END IF + IF ( l_soil_evap_irrig_expl ) THEN + gs_nir_type(l,n) = gs(l) + END IF + END IF END DO !$OMP END DO NOWAIT END DO @@ -848,6 +878,19 @@ SUBROUTINE physiol ( & * smvcst_soilt(l,m,1) / smvccl_soilt(l,m,1))**2 ! ELSE Do nothing END IF + IF ( l_soil_evap_irrig_expl ) THEN + gsoil_nir_soilt(l,m) = 0.0 + IF (smvccl_soilt(l,m,1) > 0.0 .AND. l_limit_gsoil) THEN + gsoil_nir_soilt(l,m) = gs_nvg(soil - npft) * & + MIN(1.0, (sthu_nir_soilt(l,m,1) & + * smvcst_soilt(l,m,1) / smvccl_soilt(l,m,1))**2) + ELSE IF (smvccl_soilt(l,m,1) > 0.0) THEN + gsoil_nir_soilt(l,m) = gs_nvg(soil - npft) * & + (sthu_nir_soilt(l,m,1) & + * smvcst_soilt(l,m,1) / smvccl_soilt(l,m,1))**2 + ! ELSE Do nothing + END IF + END IF END DO !$OMP END DO NOWAIT END DO @@ -864,6 +907,10 @@ SUBROUTINE physiol ( & q1_land(l) = qw_1(i,j) cosz_gb(l) = cos_zenith_angle(i,j) fsoil_tot(l) = frac(l,soil) + IF ( l_soil_evap_irrig_expl ) THEN + fsoil_irr_tot(l) = frac(l,soil)*frac_irr_surft(l,soil) + fsoil_nir_tot(l) = frac(l,soil)*(1.-frac_irr_surft(l,soil)) + END IF gs(l) = 0.0 END DO !$OMP END DO NOWAIT @@ -1035,7 +1082,8 @@ SUBROUTINE physiol ( & ! is the same as in the overall gridbox irrigated fraction !$OMP PARALLEL IF(l_do_omp) DEFAULT(NONE) PRIVATE(l, k) & !$OMP SHARED(frac_irr_soilt, frac_irr_surft, land_pts, v_open, & -!$OMP l_irrig_dmd, n, m,l_use_pft_psi, v_close, v_close_pft, & +!$OMP l_irrig_dmd, l_soil_evap_irrig_expl, & +!$OMP n, m, l_use_pft_psi, v_close, v_close_pft, & !$OMP sm_levels, sthu_soilt, sthu_irr_soilt, sthu_nir_soilt, & !$OMP l_do_omp, sthu_surft, v_open_pft, smvcwt_soilt, smvccl_soilt, fsmc_p0) DO k = 1,sm_levels @@ -1048,16 +1096,22 @@ SUBROUTINE physiol ( & IF ( l_irrig_dmd ) THEN !$OMP DO SCHEDULE(STATIC) DO l = 1,land_pts - sthu_nir_soilt(l,m,k) = sthu_soilt(l,m,k) - IF ( frac_irr_soilt(l,m) < 1.0 ) THEN - sthu_nir_soilt(l,m,k) = (sthu_soilt(l,m,k) - frac_irr_soilt(l,m) & - * sthu_irr_soilt(l,m,k)) & - / (1.0 - frac_irr_soilt(l,m)) - ELSE - sthu_nir_soilt(l,m,k) = sthu_irr_soilt(l,m,k) - END IF - sthu_surft(l,m,k) = frac_irr_surft(l,n) * sthu_irr_soilt(l,m,k) & - + (1.0 - frac_irr_surft(l,n)) * sthu_nir_soilt(l,m,k) + IF ( l_soil_evap_irrig_expl ) THEN + sthu_surft(l,m,k) = frac_irr_surft(l,n) * sthu_irr_soilt(l,m,k) & + + (1.0 - frac_irr_surft(l,n)) * sthu_nir_soilt(l,m,k) + ELSE +! MAY Be ABLE to remove the following section (calc of sthu_nir done above with l_bare_soil_evap_irr)*** check with rose stem?*** + sthu_nir_soilt(l,m,k) = sthu_soilt(l,m,k) + IF ( frac_irr_soilt(l,m) < 1.0 ) THEN + sthu_nir_soilt(l,m,k) = (sthu_soilt(l,m,k) - frac_irr_soilt(l,m)& + * sthu_irr_soilt(l,m,k)) & + / (1.0 - frac_irr_soilt(l,m)) + ELSE + sthu_nir_soilt(l,m,k) = sthu_irr_soilt(l,m,k) + END IF + sthu_surft(l,m,k) = frac_irr_surft(l,n) * sthu_irr_soilt(l,m,k) & + + (1.0 - frac_irr_surft(l,n)) * sthu_nir_soilt(l,m,k) + END IF END DO !$OMP END DO END IF @@ -1104,7 +1158,27 @@ SUBROUTINE physiol ( & bexp_soilt(:,m,:), sathh_soilt(:,m,:), & wt_ext_irr_type(:,:,n),fsmc_irr(:,n), & psi_root_zone_pft(:,n)) - END IF + + IF ( l_soil_evap_irrig_expl ) THEN + CALL smc_ext (land_pts,sm_levels,surft_pts(n),surft_index(:,n), n, & + f_root,sthu_nir_soilt(:,m,:), & + v_open,smvcst_soilt(:,m,:), & + v_close, & + bexp_soilt(:,m,:), sathh_soilt(:,m,:), & + wt_ext_nir_type(:,:,n),fsmc_nir(:,n), & + psi_root_zone_pft(:,n)) + + DO l = 1,land_pts + fsmc_pft(l,n) = fsmc_nir(l,n)*(1.-frac_irr_surft(l,n)) & + + fsmc_irr(l,n)*frac_irr_surft(l,n) + DO k = 1,sm_levels + wt_ext_type(l,k,n) = & + wt_ext_nir_type(l,k,n)*(1.-frac_irr_surft(l,n)) & + + wt_ext_irr_type(l,k,n)*frac_irr_surft(l,n) + END DO + END DO + END IF + END IF CALL raero (land_pts,land_index,surft_pts(n),surft_index(:,n) & , rib,vshr,z0,z0,z1_uv_ij,ra) @@ -1204,10 +1278,12 @@ SUBROUTINE physiol ( & IF (l_irrig_dmd) THEN ! adjust conductance for irrigated fraction !$OMP PARALLEL DO IF(surft_pts(n) > 1) DEFAULT(NONE) PRIVATE(k, l) & -!$OMP SHARED(gs_irr_type, gs_type, n, surft_index, surft_pts) & +!$OMP SHARED(gs_irr_type, gs_nir_type, gs_type, n, surft_index, & +!$OMP surft_pts) & !$OMP SCHEDULE(STATIC) DO k = 1,surft_pts(n) l = surft_index(k,n) + gs_nir_type(l,n) = gs_type(l,n) gs_irr_type(l,n) = gs_type(l,n) END DO !$OMP END PARALLEL DO @@ -1218,7 +1294,10 @@ SUBROUTINE physiol ( & IF ( frac_irr_surft(l,n) > 0.0 ) THEN IF ( fsmc_pft(l,n) > 0.0 ) THEN gs_irr_type(l,n) = gs_type(l,n) * fsmc_irr(l,n) / fsmc_pft(l,n) - + IF ( l_soil_evap_irrig_expl ) THEN + gs_nir_type(l,n) = gs_type(l,n) * fsmc_nir(l,n) / fsmc_pft(l,n) + END IF + ELSE ! hadrd - this should only happen if sthu is 0.0, see smc_ext WRITE (ERRMSG,*) 'tile:', n, 'point:',l, 'fsmc:', fsmc_pft(l,n), & @@ -1247,9 +1326,15 @@ SUBROUTINE physiol ( & ! with code before gsoil_f parameter was added gsoil_under_canopy(:) = gsoil_soilt(:,m) gsoil_irr_under_canopy(:) = gsoil_irr_soilt(:,m) - ELSE + IF ( l_soil_evap_irrig_expl ) THEN + gsoil_nir_under_canopy(:) = gsoil_nir_soilt(:,m) + END IF + ELSE gsoil_under_canopy(:) = gsoil_soilt(:,m) * gsoil_f(n) gsoil_irr_under_canopy(:) = gsoil_irr_soilt(:,m) * gsoil_f(n) + IF ( l_soil_evap_irrig_expl ) THEN + gsoil_nir_under_canopy(:) = gsoil_nir_soilt(:,m) * gsoil_f(n) + END IF END IF CALL soil_evap (land_pts,sm_levels,surft_pts(n),surft_index(:,n), & @@ -1271,10 +1356,18 @@ SUBROUTINE physiol ( & dvi_cpft) !$OMP PARALLEL DO IF(l_do_omp) DEFAULT(NONE) PRIVATE(l) SHARED(frac, & -!$OMP l_do_omp, fsoil, fsoil_tot, land_pts, n) SCHEDULE(STATIC) +!$OMP l_do_omp, fsoil, fsoil_tot, fsoil_irr_tot, fsoil_nir_tot, & +!$OMP l_soil_evap_irrig_expl, frac_irr_surft, land_pts, n) SCHEDULE(STATIC) DO l = 1,land_pts fsoil_tot(l) = fsoil_tot(l) + frac(l,n) * fsoil(l,n) - END DO + IF ( l_soil_evap_irrig_expl ) THEN + fsoil_irr_tot(l) = fsoil_irr_tot(l) + frac(l,n) * fsoil(l,n) * & + frac_irr_surft(l,n) + fsoil_nir_tot(l) = fsoil_nir_tot(l) + frac(l,n) * fsoil(l,n) * & + (1.-frac_irr_surft(l,n)) + + END IF + END DO !$OMP END PARALLEL DO END DO @@ -1288,13 +1381,18 @@ SUBROUTINE physiol ( & !---------------------------------------------------------------------- DO n = npft+1,ntype !$OMP PARALLEL DO IF(surft_pts(n) > 1) DEFAULT(NONE) PRIVATE(l, j) & -!$OMP SHARED(gs_irr_type, gs_nvg, gs_type, l_irrig_dmd, n, npft, & -!$OMP surft_index, surft_pts) SCHEDULE(STATIC) +!$OMP SHARED(gs_irr_type, gs_nir_type, gs_nvg, gs_type, & +!$OMP l_irrig_dmd, l_soil_evap_irrig_expl, & +!$OMP n, npft, surft_index, surft_pts) & +!$OMP SCHEDULE(STATIC) DO j = 1,surft_pts(n) l = surft_index(j,n) gs_type(l,n) = gs_nvg(n - npft) IF (l_irrig_dmd) THEN gs_irr_type(l,n) = gs_nvg(n - npft) ! irrigation + IF (l_soil_evap_irrig_expl ) THEN + gs_nir_type(l,n) = gs_nvg(n - npft) ! non-irrigation + END IF END IF END DO !$OMP END PARALLEL DO @@ -1337,9 +1435,10 @@ SUBROUTINE physiol ( & n = soil !$OMP PARALLEL DO IF (surft_pts(n) > 1) DEFAULT(NONE) PRIVATE(l, j) & !$OMP SHARED(gs_irr_type, gs_type, gsoil_soilt, gsoil_irr_soilt, & -!$OMP l_irrig_dmd, irrig_tile, & +!$OMP l_irrig_dmd, l_soil_evap_irrig_expl, frac_irr_surft, & +!$OMP gsoil_nir_soilt, irrig_tile, & !$OMP n, m, surft_index, surft_pts, wt_ext_type, & -!$OMP wt_ext_irr_type) SCHEDULE(STATIC) +!$OMP wt_ext_irr_type, gs_nir_type) SCHEDULE(STATIC) DO j = 1,surft_pts(n) l = surft_index(j,n) gs_type(l,n) = gsoil_soilt(l,m) @@ -1347,6 +1446,11 @@ SUBROUTINE physiol ( & wt_ext_type(l,1,n) = 1.0 END IF IF (l_irrig_dmd) THEN + IF ( l_soil_evap_irrig_expl )THEN + gs_type(l,n) = frac_irr_surft(l,n)*gsoil_irr_soilt(l,m) & + +(1.0-frac_irr_surft(l,n))*gsoil_nir_soilt(l,m) + gs_nir_type(l,n) = gsoil_nir_soilt(l,m) ! non-irrigation + END IF gs_irr_type(l,n) = gsoil_irr_soilt(l,m) ! irrigation wt_ext_irr_type(l,1,n) = 1.0 ! irrigation END IF @@ -1634,9 +1738,11 @@ SUBROUTINE physiol ( & m = 1 DO n = 1,ntype !$OMP PARALLEL DO IF(surft_pts(n) > 1) DEFAULT(NONE) PRIVATE(l, j) & -!$OMP SHARED(canhc, ch_type, frac, l_irrig_dmd, n, sm_levels, & +!$OMP SHARED(canhc, ch_type, frac, n, sm_levels, & +!$OMP l_irrig_dmd, l_soil_evap_irrig_expl, & !$OMP surft_index, surft_pts, vfrac, vf_type, wt_ext_soilt, & !$OMP frac_irr_surft, frac_irr_soilt, & +!$OMP wt_ext_nir_soilt, wt_ext_nir_type, & !$OMP wt_ext_irr_soilt, wt_ext_type, wt_ext_irr_type, m) & !$OMP SCHEDULE(STATIC) DO j = 1,surft_pts(n) @@ -1653,7 +1759,19 @@ SUBROUTINE physiol ( & / frac_irr_soilt(l,m) & * frac(l,n) * wt_ext_irr_type(l,k,n) END IF - END IF + IF ( l_soil_evap_irrig_expl) THEN + IF ((1.-frac_irr_soilt(l,m)) > EPSILON(1.0)) THEN + wt_ext_nir_soilt(l,m,k) = wt_ext_nir_soilt(l,m,k) & + + (1.-frac_irr_surft(l,n)) & + / (1.-frac_irr_soilt(l,m)) & + * frac(l,n) * wt_ext_nir_type(l,k,n) + END IF + wt_ext_soilt(l,m,k) = frac_irr_soilt(l,m)*wt_ext_irr_soilt(l,m,k) & + + (1.-frac_irr_soilt(l,m)) & + * wt_ext_nir_soilt(l,m,k) + + END IF + END IF END DO END DO !$OMP END PARALLEL DO @@ -1726,10 +1844,13 @@ SUBROUTINE physiol ( & !$OMP PARALLEL DO IF(surft_pts(n) > 1) DEFAULT(NONE) PRIVATE(k, l, j) & !$OMP SHARED(surft_pts, surft_index, flake, gc_surft, gs_type, l_irrig_dmd, & -!$OMP gs_irr_surft, gs_irr_type, canhc_surft, ch_type, vfrac_surft, & +!$OMP l_soil_evap_irrig_expl, gs_irr_surft, gs_irr_type, & +!$OMP canhc_surft, ch_type, vfrac_surft, & !$OMP vf_type, sm_levels, wt_ext_soilt, frac, wt_ext_type, & !$OMP wt_ext_surft, frac_irr_surft, frac_irr_soilt, & -!$OMP wt_ext_irr_soilt, wt_ext_irr_type, wt_ext_irr_surft, n, m, lake, & +!$OMP wt_ext_irr_soilt, wt_ext_irr_type, wt_ext_irr_surft, & +!$OMP wt_ext_nir_soilt, wt_ext_nir_type, gs_nir_surft, gc_irr_surft, & +!$OMP gs_nir_type, n, m, lake, & !$OMP l_flake_model, non_lake_frac) & !$OMP SCHEDULE(STATIC) DO j = 1,surft_pts(n) @@ -1738,6 +1859,10 @@ SUBROUTINE physiol ( & gc_surft(l,n) = gs_type(l,n) IF (l_irrig_dmd) THEN gs_irr_surft(l,n) = gs_irr_type(l,n) ! irrigation + IF (l_soil_evap_irrig_expl) THEN + gs_nir_surft(l,n) = gs_nir_type(l,n) ! non irrigation + gc_irr_surft(l,n) = gs_irr_surft(l,n) + END IF END IF canhc_surft(l,n) = ch_type(l,n) vfrac_surft(l,n) = vf_type(l,n) @@ -1756,6 +1881,17 @@ SUBROUTINE physiol ( & * frac(l,n) * wt_ext_irr_type(l,k,n) END IF wt_ext_irr_surft(l,k,n) = wt_ext_irr_type(l,k,n) + IF (l_soil_evap_irrig_expl) THEN + IF ((1.-frac_irr_soilt(l,m)) > EPSILON(1.0)) THEN + wt_ext_nir_soilt(l,m,k) = wt_ext_nir_soilt(l,m,k) & + + (1.-frac_irr_surft(l,n)) & + / (1.-frac_irr_soilt(l,m)) & + * frac(l,n) * wt_ext_nir_type(l,k,n) + END IF + wt_ext_soilt(l,m,k) = frac_irr_soilt(l,m)*wt_ext_irr_soilt(l,m,k) & + + (1.-frac_irr_soilt(l,m)) & + * wt_ext_nir_soilt(l,m,k) + END IF END IF END DO !sm_levels END DO !surf_pts @@ -2039,9 +2175,10 @@ SUBROUTINE physiol ( & DO k = 1,sm_levels !$OMP PARALLEL DO IF(l_do_omp) DEFAULT(NONE) PRIVATE(l) SHARED(dzsoil, & -!$OMP land_pts, k, n, m, smc_irr_soilt, sthu_irr_soilt, frac, & -!$OMP frac_irr_surft, frac_irr_soilt, l_do_omp, & -!$OMP smvcst_soilt, v_close_pft, wt_ext_irr_type) & +!$OMP land_pts, k, n, m, smc_irr_soilt, sthu_irr_soilt, & +!$OMP smc_nir_soilt, sthu_nir_soilt, frac, frac_irr_surft, & +!$OMP frac_irr_soilt, l_do_omp,smvcst_soilt, v_close_pft, & +!$OMP l_soil_evap_irrig_expl, wt_ext_irr_type, wt_ext_nir_type) & !$OMP SCHEDULE(STATIC) DO l = 1,land_pts IF ( frac_irr_soilt(l,m) > EPSILON(1.0) ) THEN @@ -2054,6 +2191,18 @@ SUBROUTINE physiol ( & * smvcst_soilt(l,m,k) & - v_close_pft(l,k,n))) END IF + IF (l_soil_evap_irrig_expl) THEN + IF (1. - frac_irr_soilt(l,m) > EPSILON(1.0) ) THEN + smc_nir_soilt(l,m) = smc_nir_soilt(l,m) & + + MAX(0.0,(1.-frac_irr_surft(l,n)) & + / (1.-frac_irr_soilt(l,m)) & + * frac(l,n) * wt_ext_nir_type(l,k,n) & + * rho_water * dzsoil(k) & + * (sthu_nir_soilt(l,m,k) & + * smvcst_soilt(l,m,k) & + - v_close_pft(l,k,n))) + END IF + END IF END DO !$OMP END PARALLEL DO END DO @@ -2063,8 +2212,9 @@ SUBROUTINE physiol ( & DO k = 1,sm_levels DO m = 1,nsoilt !$OMP PARALLEL DO IF(l_do_omp) DEFAULT(NONE) PRIVATE(l) SHARED(dzsoil, & -!$OMP land_pts, k, n, smc_irr_soilt, sthu_irr_soilt, smvcst_soilt, & -!$OMP smvcwt_soilt,wt_ext_irr_soilt,m, l_do_omp) & +!$OMP land_pts, k, n, smc_irr_soilt, sthu_irr_soilt, & +!$OMP smc_nir_soilt, sthu_nir_soilt,smvcst_soilt, & +!$OMP smvcwt_soilt,wt_ext_irr_soilt,wt_ext_nir_soilt,m,l_do_omp) & !$OMP SCHEDULE(STATIC) DO l = 1,land_pts smc_irr_soilt(l,m) = smc_irr_soilt(l,m) & @@ -2074,6 +2224,15 @@ SUBROUTINE physiol ( & * (sthu_irr_soilt(l,m,k) & * smvcst_soilt(l,m,k) & - smvcwt_soilt(l,m,k))) + IF (l_soil_evap_irrig_expl) THEN + smc_nir_soilt(l,m) = smc_nir_soilt(l,m) & + + MAX(0.0 , & + wt_ext_nir_soilt(l,m,k) * rho_water & + * dzsoil(k) & + * (sthu_nir_soilt(l,m,k) & + * smvcst_soilt(l,m,k) & + - smvcwt_soilt(l,m,k))) + END IF END DO !$OMP END PARALLEL DO END DO @@ -2082,14 +2241,41 @@ SUBROUTINE physiol ( & ! Add available water for evaporation from bare soil in irrig frac. !$OMP PARALLEL IF(l_do_omp) DEFAULT(NONE) PRIVATE(l,m,n) SHARED(dzsoil, & -!$OMP fsoil_tot, land_pts, smc_irr_soilt, sthu_irr_soilt,nsoilt, & -!$OMP smvcst_soilt, gs_irr_surft,gc_irr_surft, nsurft,l_do_omp) +!$OMP fsoil_tot, land_pts, smc_irr_soilt, sthu_irr_soilt, nsoilt, & +!$OMP smc_nir_soilt, smc_soilt, sthu_nir_soilt, & +!$OMP smvcst_soilt, gs_irr_surft, gc_irr_surft, nsurft, l_do_omp, & +!$OMP fsoil_irr_tot, fsoil_nir_tot, frac_irr_soilt, & +!$OMP frac_irr_surft, l_soil_evap_irrig_expl) DO m = 1,nsoilt !$OMP DO SCHEDULE(STATIC) - DO l = 1,land_pts - smc_irr_soilt(l,m) = (1.0 - fsoil_tot(l)) * smc_irr_soilt(l,m) + & + DO l = 1,land_pts + IF (l_soil_evap_irrig_expl) THEN + IF (frac_irr_soilt(l,m) > 0.0) THEN + fsoil_irr_tot(l) = fsoil_irr_tot(l)/frac_irr_soilt(l,m) + smc_irr_soilt(l,m) = (1.0 - fsoil_irr_tot(l) ) * & + smc_irr_soilt(l,m) + fsoil_irr_tot(l) * & + rho_water * dzsoil(1) * & + MAX(0.0,sthu_irr_soilt(l,m,1)) * smvcst_soilt(l,m,1) + ELSE + smc_irr_soilt(l,m) = 0.0 + END IF + IF (1.0 - frac_irr_soilt(l,m) > 0.0) THEN + fsoil_nir_tot(l) = fsoil_nir_tot(l)/(1.-frac_irr_soilt(l,m)) + smc_nir_soilt(l,m) = (1.0 - fsoil_nir_tot(l)) * & + smc_nir_soilt(l,m) + fsoil_nir_tot(l) * & + rho_water * dzsoil(1) * & + MAX(0.0,sthu_nir_soilt(l,m,1)) * smvcst_soilt(l,m,1) + ELSE + smc_nir_soilt(l,m) = 0.0 + END IF + + smc_soilt(l,m) = frac_irr_soilt(l,m) * smc_irr_soilt(l,m) + & + (1.0 - frac_irr_soilt(l,m)) * smc_nir_soilt(l,m) + ELSE + smc_irr_soilt(l,m) = (1.0 - fsoil_tot(l)) * smc_irr_soilt(l,m) + & fsoil_tot(l) * rho_water * dzsoil(1) * & MAX(0.0,sthu_irr_soilt(l,m,1)) * smvcst_soilt(l,m,1) + END IF END DO !$OMP END DO END DO From 985b90a953bceba29e95622180b0d45779440c42 Mon Sep 17 00:00:00 2001 From: nicgedney <131251916+nicgedney@users.noreply.github.com> Date: Fri, 21 Aug 2026 17:03:20 +0100 Subject: [PATCH 08/16] basic code passes rose stem tests --- src/control/shared/jules_hydrology_mod.F90 | 6 +-- src/control/shared/jules_irrig_mod.F90 | 6 ++- src/science/surface/physiol_jls_mod.F90 | 5 ++- src/science/surface/sf_evap_jls.F90 | 48 +++++++++++++++++++++- src/science/surface/sf_resist_jls.F90 | 36 ++++++++++++++-- src/science/surface/soil_evap_jls.F90 | 33 ++++++++++++++- 6 files changed, 120 insertions(+), 14 deletions(-) diff --git a/src/control/shared/jules_hydrology_mod.F90 b/src/control/shared/jules_hydrology_mod.F90 index 7bb08015..f1d360b4 100644 --- a/src/control/shared/jules_hydrology_mod.F90 +++ b/src/control/shared/jules_hydrology_mod.F90 @@ -47,12 +47,8 @@ MODULE jules_hydrology_mod ! Only used if l_top=.T. l_limit_gsoil = .FALSE., & ! Switch for limiting gsoil above theta_crit - l_inland = .FALSE., & + l_inland = .FALSE. ! Switch for putting inland water from from rivers into soil moisture - l_soil_evap_irrig_expl = .FALSE. - ! Switch for explcitly calculating bare soil evaporation over the - ! separate irrigated and non-irrigated fractions of the grid box. - ! (Default used the grid box mean soil moisture). !----------------------------------------------------------------------------- ! PDM parameters diff --git a/src/control/shared/jules_irrig_mod.F90 b/src/control/shared/jules_irrig_mod.F90 index 74cd8f3a..fef9aa7b 100644 --- a/src/control/shared/jules_irrig_mod.F90 +++ b/src/control/shared/jules_irrig_mod.F90 @@ -47,8 +47,12 @@ MODULE jules_irrig_mod LOGICAL :: & l_irrig_dmd = .FALSE., & ! Switch for using irrigation demand code - l_irrig_limit = .FALSE. + l_irrig_limit = .FALSE., & ! Switch for limiting irrigation supply + l_soil_evap_irrig_expl = .FALSE. + ! Switch for explcitly calculating bare soil evaporation over the + ! separate irrigated and non-irrigated fractions of the grid box. + ! (Default used the grid box mean soil moisture). INTEGER :: nirrtile = imdi ! Number of tiles that can have irrigated fraction diff --git a/src/science/surface/physiol_jls_mod.F90 b/src/science/surface/physiol_jls_mod.F90 index 48bf0f56..c952ab89 100644 --- a/src/science/surface/physiol_jls_mod.F90 +++ b/src/science/surface/physiol_jls_mod.F90 @@ -107,9 +107,9 @@ SUBROUTINE physiol ( & ! imported variables l_crop, l_use_pft_psi, l_triffid -USE jules_irrig_mod, ONLY: l_irrig_dmd +USE jules_irrig_mod, ONLY: l_irrig_dmd, l_soil_evap_irrig_expl -USE jules_hydrology_mod, ONLY: l_limit_gsoil, l_soil_evap_irrig_expl +USE jules_hydrology_mod, ONLY: l_limit_gsoil USE pftparm, ONLY: emis_pft, fsmc_p0, rootd_ft, gsoil_f @@ -2213,6 +2213,7 @@ SUBROUTINE physiol ( & DO m = 1,nsoilt !$OMP PARALLEL DO IF(l_do_omp) DEFAULT(NONE) PRIVATE(l) SHARED(dzsoil, & !$OMP land_pts, k, n, smc_irr_soilt, sthu_irr_soilt, & +!$OMP l_soil_evap_irrig_expl, & !$OMP smc_nir_soilt, sthu_nir_soilt,smvcst_soilt, & !$OMP smvcwt_soilt,wt_ext_irr_soilt,wt_ext_nir_soilt,m,l_do_omp) & !$OMP SCHEDULE(STATIC) diff --git a/src/science/surface/sf_evap_jls.F90 b/src/science/surface/sf_evap_jls.F90 index 5eb20ec3..b420d606 100644 --- a/src/science/surface/sf_evap_jls.F90 +++ b/src/science/surface/sf_evap_jls.F90 @@ -47,7 +47,7 @@ SUBROUTINE sf_evap ( & USE ancil_info, ONLY: nsoilt -USE jules_irrig_mod, ONLY: l_irrig_dmd +USE jules_irrig_mod, ONLY: l_irrig_dmd, l_soil_evap_irrig_expl USE jules_surface_mod, ONLY: l_aggregate, l_flake_model USE jules_surface_types_mod, ONLY: lake @@ -691,6 +691,9 @@ SUBROUTINE sf_evap ( & DO l = 1,land_pts ext_soilt(l,:,m) = 0.0 ext_irr_soilt(l,:,m) = 0.0 + IF ( l_soil_evap_irrig_expl ) THEN + ext_nir_soilt(l,:,m) = 0.0 + END IF END DO !$OMP END DO END DO @@ -712,6 +715,15 @@ SUBROUTINE sf_evap ( & ext_soilt(l,mm,m) = ext_soilt(l,mm,m) & + tile_frac(l,n) * wt_ext_surft(l,m,n) & * esoil_surft(l,n) + + IF ( l_soil_evap_irrig_expl ) THEN + wt_ext_nir_surft(l,m,n) = wt_ext_surft(l,m,n) + IF (1.- frac_irr_surft(l,n) > EPSILON(1.0) ) THEN + wt_ext_nir_surft(l,m,n) = (wt_ext_surft(l,m,n) - & + wt_ext_irr_surft(l,m,n) * frac_irr_surft(l,n)) / & + (1.- frac_irr_surft(l,n)) + END IF + END IF END DO !$OMP END DO END IF @@ -764,6 +776,23 @@ SUBROUTINE sf_evap ( & !$OMP DO SCHEDULE(STATIC) DO k = 1,surft_pts(n) l = surft_index(k,n) + IF ( l_soil_evap_irrig_expl ) THEN + wt_ext_nir_surft(l,m,n) = wt_ext_surft(l,m,n) + IF ((1.- frac_irr_surft(l,n)) > EPSILON(1.0) ) THEN + wt_ext_nir_surft(l,m,n) = (wt_ext_surft(l,m,n) - & + wt_ext_irr_surft(l,m,n) * frac_irr_surft(l,n)) / & + (1.- frac_irr_surft(l,n)) + END IF + IF (1. - frac_irr_soilt(l,mm) > EPSILON(1.0) ) THEN + ext_nir_soilt(l,mm,m) = ext_nir_soilt(l,mm,m) & + + tile_frac(l,n) & + * wt_ext_nir_surft(l,m,n) & + * esoil_nir_surft(l,n) & + * (1.0 - frac_irr_surft(l,n)) & + / (1.0 - frac_irr_soilt(l,mm)) + END IF + END IF + IF ( frac_irr_soilt(l,mm) > EPSILON(1.0) ) THEN ext_irr_soilt(l,mm,m) = ext_irr_soilt(l,mm,m) & + tile_frac(l,n) & @@ -783,6 +812,23 @@ SUBROUTINE sf_evap ( & !$OMP DO SCHEDULE(STATIC) DO k = 1,surft_pts(n) l = surft_index(k,n) + + IF ( l_soil_evap_irrig_expl ) THEN + wt_ext_nir_surft(l,m,n) = wt_ext_surft(l,m,n) + IF (1.- frac_irr_surft(l,n) > EPSILON(1.0) ) THEN + wt_ext_nir_surft(l,m,n) = (wt_ext_surft(l,m,n) - & + wt_ext_irr_surft(l,m,n) * frac_irr_surft(l,n)) / & + (1.- frac_irr_surft(l,n)) + end if + IF (1.- frac_irr_soilt(l,mm) > EPSILON(1.0) ) THEN + ext_nir_soilt(l,mm,m) = ext_nir_soilt(l,mm,m) & + + wt_ext_nir_surft(l,m,n) & + * esoil_nir_surft(l,n) & + * (1.0 - frac_irr_surft(l,n)) & + / (1.0 - frac_irr_soilt(l,mm)) + END IF + END IF + IF ( frac_irr_soilt(l,mm) > EPSILON(1.0) ) THEN ext_irr_soilt(l,mm,m) = ext_irr_soilt(l,mm,m) & + wt_ext_irr_surft(l,m,n) & diff --git a/src/science/surface/sf_resist_jls.F90 b/src/science/surface/sf_resist_jls.F90 index 16701a72..0843e256 100644 --- a/src/science/surface/sf_resist_jls.F90 +++ b/src/science/surface/sf_resist_jls.F90 @@ -32,7 +32,7 @@ SUBROUTINE sf_resist ( & USE water_constants_mod, ONLY: tm, rho_ice USE jules_surface_mod, ONLY: l_aggregate USE jules_vegetation_mod, ONLY: can_model -USE jules_irrig_mod, ONLY: l_irrig_dmd +USE jules_irrig_mod, ONLY: l_soil_evap_irrig_expl USE parkind1, ONLY: jprb, jpim USE yomhook, ONLY: lhook, dr_hook IMPLICIT NONE @@ -146,7 +146,8 @@ SUBROUTINE sf_resist ( & !$OMP SHARED(surft_pts,surft_index,land_index,t_i_length,fracaero_t,fracaero_s,& !$OMP dq,snowdep_surft,tstar,snow_surft, & !$OMP catch,frac_snow_subl_melt,maskd,resfs,gc,ch,vshr,l_et_stom, & -!$OMP l_et_stom_surft,resfs_stom,gc_stom_surft,flake, & +!$OMP l_et_stom_surft,resfs_stom,gc_stom_surft,frac_irr_surft, & +!$OMP gc_irr_surft,gc_nir_surft,l_soil_evap_irrig_expl,flake, & !$OMP canopy,epdt,resft,l_fix_snow_frac, l_fix_neg_snow) DO k = 1,surft_pts l = surft_index(k) @@ -231,6 +232,20 @@ SUBROUTINE sf_resist ( & ! and bare soil evaporation from soil tiles. !----------------------------------------------------------------------- resfs(l) = gc(l) / ( gc(l) + ch(l) * vshr(i,j) ) + IF ( l_soil_evap_irrig_expl ) THEN + gc_nir_surft(l) = gc(l) + IF ( frac_irr_surft(l) < 1.0 ) THEN + gc_nir_surft(l) = (gc(l) - frac_irr_surft(l) & + * gc_irr_surft(l)) & + / (1.0 - frac_irr_surft(l)) + ELSE + gc_nir_surft(l) = gc_irr_surft(l) + END IF + resfs(l) = frac_irr_surft(l)*gc_irr_surft(l) & + / ( gc_irr_surft(l) + ch(l) * vshr(i,j) ) & + +(1.-frac_irr_surft(l))*gc_nir_surft(l) & + / ( gc_nir_surft(l) + ch(l) * vshr(i,j) ) + END IF IF (l_et_stom .OR. l_et_stom_surft) THEN resfs_stom(l) = gc_stom_surft(l) / ( gc_stom_surft(l) + ch(l) * vshr(i,j) ) END IF @@ -248,7 +263,8 @@ SUBROUTINE sf_resist ( & !$OMP PARALLEL DO IF(surft_pts > 1) DEFAULT(NONE) PRIVATE(i, j, k, l) & !$OMP SHARED(surft_pts, surft_index, land_index, t_i_length, & !$OMP snow_surft, gc, vshr, fracaero_t, & -!$OMP resfs, ch, resft) SCHEDULE(STATIC) +!$OMP resfs, ch, resft, gc_nir_surft, frac_irr_surft, & +!$OMP gc_irr_surft, l_soil_evap_irrig_expl) SCHEDULE(STATIC) DO k = 1,surft_pts l = surft_index(k) IF (snow_surft(l) > 0.0) THEN @@ -257,6 +273,20 @@ SUBROUTINE sf_resist ( & fracaero_t(l) = 0.0 resfs(l) = gc(l) / & (gc(l) + ch(l) * vshr(i,j)) + IF ( l_soil_evap_irrig_expl ) THEN + gc_nir_surft(l) = gc(l) + IF ( frac_irr_surft(l) < 1.0 ) THEN + gc_nir_surft(l) = (gc(l) - frac_irr_surft(l) & + * gc_irr_surft(l)) & + / (1.0 - frac_irr_surft(l)) + ELSE + gc_nir_surft(l) = gc_irr_surft(l) + END IF + resfs(l) = frac_irr_surft(l)*gc_irr_surft(l) & + / ( gc_irr_surft(l) + ch(l) * vshr(i,j) ) & + +(1.-frac_irr_surft(l))*gc_nir_surft(l) & + / ( gc_nir_surft(l) + ch(l) * vshr(i,j) ) + END IF resft(l) = resfs(l) END IF END DO diff --git a/src/science/surface/soil_evap_jls.F90 b/src/science/surface/soil_evap_jls.F90 index d1662ecb..1454843c 100644 --- a/src/science/surface/soil_evap_jls.F90 +++ b/src/science/surface/soil_evap_jls.F90 @@ -26,7 +26,7 @@ SUBROUTINE soil_evap (npnts,nshyd,surft_pts,surft_index, & gsoil_irr,gs_irr,wt_ext_irr & ) -USE jules_irrig_mod, ONLY: l_irrig_dmd +USE jules_irrig_mod, ONLY: l_irrig_dmd, l_soil_evap_irrig_expl USE yomhook, ONLY: lhook, dr_hook USE parkind1, ONLY: jprb, jpim IMPLICIT NONE @@ -104,7 +104,8 @@ SUBROUTINE soil_evap (npnts,nshyd,surft_pts,surft_index, & !$OMP DEFAULT(NONE) & !$OMP PRIVATE(l,j,k) & !$OMP SHARED(npnts,fsoil,surft_pts,surft_index,lai,nshyd,wt_ext,gs,gsoil, & -!$OMP wt_ext_irr,gs_irr,gsoil_irr,l_irrig_dmd,irrig_tile) +!$OMP frac_irr,gsoil_nir,gs_nir,wt_ext_nir,irrig_tile, & +!$OMP wt_ext_irr,gs_irr,gsoil_irr,l_irrig_dmd,l_soil_evap_irrig_expl) ! Initialisations @@ -138,6 +139,17 @@ SUBROUTINE soil_evap (npnts,nshyd,surft_pts,surft_index, & wt_ext_irr(l,k) = gs_irr(l) * wt_ext_irr(l,k) & / (gs_irr(l) + fsoil(l) * gsoil_irr(l)) END DO +!$OMP END DO NOWAIT + END IF + IF (l_soil_evap_irrig_expl) THEN +!$OMP DO SCHEDULE(STATIC) + DO j = 1,surft_pts + l = surft_index(j) + wt_ext_nir(l,k) = gs_nir(l) * wt_ext_nir(l,k) & + / (gs_nir(l) + fsoil(l) * gsoil_nir(l)) + wt_ext(l,k) = frac_irr(l)*wt_ext_irr(l,k) & + +(1.0-frac_irr(l))*wt_ext_nir(l,k) + END DO !$OMP END DO NOWAIT END IF END DO @@ -179,6 +191,23 @@ SUBROUTINE soil_evap (npnts,nshyd,surft_pts,surft_index, & !$OMP END DO NOWAIT END IF +! Transpiration and soil conductances over irrigated fraction of tile +! relative to tile mean conductance (scaled by relative area later). +! Soil evaporation does not use grid box mean soil moisture: +IF (l_soil_evap_irrig_expl) THEN +!$OMP DO SCHEDULE(STATIC) + !CDIR NODEP + DO j = 1,surft_pts + l = surft_index(j) + wt_ext_nir(l,1) = (gs_nir(l) * wt_ext_nir(l,1) + fsoil(l) * gsoil_nir(l)) & + / (gs_nir(l) + fsoil(l) * gsoil_nir(l)) + gs_nir(l) = gs_nir(l) + fsoil(l) * gsoil_nir(l) + wt_ext(l,1) = frac_irr(l)*wt_ext_irr(l,1)+(1.0-frac_irr(l))*wt_ext_nir(l,1) + gs(l) = frac_irr(l)*gs_irr(l)+(1.0-frac_irr(l))*gs_nir(l) + END DO +!$OMP END DO NOWAIT +END IF + !$OMP END PARALLEL IF (lhook) CALL dr_hook(ModuleName//':'//RoutineName,zhook_out,zhook_handle) RETURN From 50ba4db21b558a1f93f8bc5e2235c94641d82adc Mon Sep 17 00:00:00 2001 From: nicgedney <131251916+nicgedney@users.noreply.github.com> Date: Mon, 24 Aug 2026 14:00:54 +0100 Subject: [PATCH 09/16] add variable descriptions --- src/science/surface/fcdch.F90 | 4 ++++ .../surface/jules_land_sf_explicit_jls.F90 | 16 ++++++---------- src/science/surface/sf_evap_jls.F90 | 10 +++++++++- src/science/surface/sf_flux_mod.F90 | 8 -------- src/science/surface/sf_resist_jls.F90 | 1 + src/science/surface/soil_evap_jls.F90 | 1 + 6 files changed, 21 insertions(+), 19 deletions(-) diff --git a/src/science/surface/fcdch.F90 b/src/science/surface/fcdch.F90 index 9549618c..13791f52 100644 --- a/src/science/surface/fcdch.F90 +++ b/src/science/surface/fcdch.F90 @@ -156,7 +156,11 @@ SUBROUTINE fcdch ( & ! IN Interactive canopy conductance ! ! to evaporation (m/s) ,gc_irr_surft(points) & + ! IN Interactive canopy conductance +! ! to evaporation over irrigated +! ! part of tile (m/s) ,frac_irr_surft(points) & +! ! IN Irrigation fraction in tile ,snowdep(points) & ! IN Snow depth (m) ,snow(points) & diff --git a/src/science/surface/jules_land_sf_explicit_jls.F90 b/src/science/surface/jules_land_sf_explicit_jls.F90 index aebcce9e..44350f62 100644 --- a/src/science/surface/jules_land_sf_explicit_jls.F90 +++ b/src/science/surface/jules_land_sf_explicit_jls.F90 @@ -806,23 +806,17 @@ SUBROUTINE jules_land_sf_explicit ( & ! Areal heat capacity of snow (J/K/m2) ,ksnow(land_pts,nsmax) & ! Thermal conductivity of snow (W/m/K) -,ashtf_irr_surft(land_pts,nsurft) & -,ashtf_nir_surft(land_pts,nsurft) & -,hcons_irr_surf(land_pts,nsurft) & -,hcons_nir_surf(land_pts,nsurft) & -,hcons_irr_soilt(land_pts,nsoilt) & -,hcons_nir_soilt(land_pts,nsoilt) & -,sthu1_nir_soilt(land_pts) & -,sthf1_nir_soilt(land_pts) & -,sthf1_irr_soilt(land_pts) & ,hcons_snow(land_pts,nsurft) & ! Snow thermal conductivity ,resp_frac(land_pts,dim_cslayer) & ! respired fraction of RESP_S ,gc_stom_surft(land_pts,nsurft) & ! canopy conductance -,gs_nir_surft(land_pts,nsurft) & ,gc_nir_surft(land_pts,nsurft) & + ! canopy conductance over irrigated part + ! of tile +,gs_nir_surft(land_pts,nsurft) & + ! Conductance for non-irrigated part of tile ,sice_surft_tmp(land_pts,nsmax) & ! Ice content of snow layers (kg/m2) ,sliq_surft_tmp(land_pts,nsmax) & @@ -964,6 +958,8 @@ SUBROUTINE jules_land_sf_explicit ( & ,ashtf_surft(land_pts,nsurft) & ! Coefficient to calculate surface ! heat flux into soil (W/m2/K). +,ashtf_irr_surft(land_pts,nsurft) & +,ashtf_nir_surft(land_pts,nsurft) & ,lw_down_surftsum(land_pts) & ! Gridbox sum of elevation corrections to ! downward longwave radiation diff --git a/src/science/surface/sf_evap_jls.F90 b/src/science/surface/sf_evap_jls.F90 index b420d606..1c4b0534 100644 --- a/src/science/surface/sf_evap_jls.F90 +++ b/src/science/surface/sf_evap_jls.F90 @@ -160,7 +160,6 @@ SUBROUTINE sf_evap ( & ! soil layer (kg/m2/s). ! of land tiles. - !New arguments replacing USE statements ! crop_vars_mod (IN) REAL(KIND=real_jlslsm), INTENT(IN) :: frac_irr_soilt(land_pts,nsoilt) @@ -189,8 +188,17 @@ SUBROUTINE sf_evap ( & ! ! moisture through non-irrigated ! ! fraction of land tiles (kg/m2/s). ,ext_nir_soilt(land_pts,nsoilt,sm_levels) & +! ! WORK Extraction of water from each +! ! soil layer from non-irrigated +! ! fraction of land tiles (kg/m2/s). ,wt_ext_nir_surft(land_pts,sm_levels,nsurft) & +! ! WORK Fraction of transpiration +! ! extracted from each soil layer +! ! by non-irrigated part of each tile. ,resfs_nir_surft(land_pts,nsurft) & +! ! WORK Combined soil, stomatal and aerodynam. +! ! resistance factor for fraction 1-fracaero_t +! ! of non-irrigated part of each land tile. ,smc_nir_soilt(land_pts,nsoilt) ! ! WORK Available soil moisture (kg/m2). ! ! fraction (kg/m2/s). diff --git a/src/science/surface/sf_flux_mod.F90 b/src/science/surface/sf_flux_mod.F90 index 7b422b5d..526480a3 100644 --- a/src/science/surface/sf_flux_mod.F90 +++ b/src/science/surface/sf_flux_mod.F90 @@ -167,14 +167,6 @@ SUBROUTINE sf_flux ( & dtstar_pot(points) & ! Change in TSTAR over timestep that is ! appropriate for the potential evaporation -,ddtstar(points) & -,dtstar_nir(points) & -,dtstar_irr(points) & -,dtstar_new(points) & -,ashtf_prime_nir(points) & -,ashtf_prime_irr(points) & -,surf_ht_flux_nir & -,surf_ht_flux_irr & ,surf_ht_flux ! Flux of heat from surface to sub-surface ! Scalars diff --git a/src/science/surface/sf_resist_jls.F90 b/src/science/surface/sf_resist_jls.F90 index 0843e256..50315a77 100644 --- a/src/science/surface/sf_resist_jls.F90 +++ b/src/science/surface/sf_resist_jls.F90 @@ -77,6 +77,7 @@ SUBROUTINE sf_resist ( & ! IN Interactive canopy conductance ! ! to evaporation (m/s) ,frac_irr_surft(land_pts) & + ! IN Irrigation fraction in tile ,gc_irr_surft(land_pts) & ! IN canopy conductance over irrigated frac ,gc_stom_surft(land_pts) & diff --git a/src/science/surface/soil_evap_jls.F90 b/src/science/surface/soil_evap_jls.F90 index 1454843c..b348fa1b 100644 --- a/src/science/surface/soil_evap_jls.F90 +++ b/src/science/surface/soil_evap_jls.F90 @@ -50,6 +50,7 @@ SUBROUTINE soil_evap (npnts,nshyd,surft_pts,surft_index, & gsoil(npnts) & ! IN Soil surface conductance (m/s). ,frac_irr(npnts) & + ! IN Irrigation fraction in tile ,lai(npnts) ! IN Leaf area index. From 90e7ffcbb4d478604fbbcb034bcb87a88c7147ff Mon Sep 17 00:00:00 2001 From: nicgedney <131251916+nicgedney@users.noreply.github.com> Date: Mon, 24 Aug 2026 14:22:51 +0100 Subject: [PATCH 10/16] rose-meta info added --- rose-meta/jules-standalone/HEAD/rose-meta.conf | 8 ++++++++ rose-meta/jules-standalone/versions.py | 8 +++++--- src/control/shared/jules_irrig_mod.F90 | 3 ++- 3 files changed, 15 insertions(+), 4 deletions(-) diff --git a/rose-meta/jules-standalone/HEAD/rose-meta.conf b/rose-meta/jules-standalone/HEAD/rose-meta.conf index e30a27c5..42794694 100644 --- a/rose-meta/jules-standalone/HEAD/rose-meta.conf +++ b/rose-meta/jules-standalone/HEAD/rose-meta.conf @@ -2646,6 +2646,7 @@ trigger=namelist:jules_irrig=irr_crop: .true.; =namelist:jules_irrig=nstep_irrig: .true.; =namelist:jules_irrig_props: .true.; =namelist:jules_irrig=irrig_option: .false.; + =namelist:jules_irrig=l_soil_evap_irrig_expl: .false.; type=logical url=https://metoffice.github.io/jules/latest/namelists/jules_irrig.nml.html#JULES_IRRIG::l_irrig_dmd @@ -2687,6 +2688,13 @@ sort-key=g type=logical url=https://metoffice.github.io/jules/latest/namelists/jules_irrig.nml.html#JULES_IRRIG::set_irrfrac_on_irrtiles +[namelist:jules_irrig=l_soil_evap_irrig_expl] +compulsory=true +description=logical to decide whether bare soil evaporation is calculated over the grid-box mean (false) or explicitly irrigated and non-irrigated fractions (true) +sort-key=h +type=logical +url=https://metoffice.github.io/jules/latest/namelists/jules_irrig.nml.html#JULES_IRRIG::l_soil_evap_irrig_expl + [namelist:jules_irrig_props] compulsory=true description=Configuration of irrigation properties diff --git a/rose-meta/jules-standalone/versions.py b/rose-meta/jules-standalone/versions.py index 1d4c41a9..9e103106 100644 --- a/rose-meta/jules-standalone/versions.py +++ b/rose-meta/jules-standalone/versions.py @@ -49,11 +49,13 @@ class vnYY_txxxx(MacroUpgrade): """Upgrade macro from JULES by Author""" - BEFORE_TAG = "vnY.Y" - AFTER_TAG = "vnY.Y_txxxx" + BEFORE_TAG = "vn8.2" + AFTER_TAG = "vn8.2_t139" def upgrade(self, config, meta_config=None): """Upgrade a JULES runtime app configuration.""" - # Add settings + # Add l_soil_evap_irrig_expl to namelist jules_irrig + self.add_setting(config, ["namelist:jules_irrig","l_soil_evap_irrig_expl"], ".false.") + return config, self.reports diff --git a/src/control/shared/jules_irrig_mod.F90 b/src/control/shared/jules_irrig_mod.F90 index fef9aa7b..cfc8e5c8 100644 --- a/src/control/shared/jules_irrig_mod.F90 +++ b/src/control/shared/jules_irrig_mod.F90 @@ -85,7 +85,8 @@ MODULE jules_irrig_mod !----------------------------------------------------------------------------- NAMELIST / jules_irrig/ l_irrig_dmd, l_irrig_limit, irr_crop, & frac_irrig_all_tiles, nirrtile, irrigtiles, & - set_irrfrac_on_irrtiles, nstep_irrig, irrig_option + set_irrfrac_on_irrtiles, nstep_irrig, irrig_option, & + l_soil_evap_irrig_expl CHARACTER(LEN=*), PARAMETER, PRIVATE :: ModuleName='JULES_IRRIG_MOD' From 8884cf6b85615c27146fdb8d8372fb316600a358 Mon Sep 17 00:00:00 2001 From: nicgedney <131251916+nicgedney@users.noreply.github.com> Date: Mon, 24 Aug 2026 15:25:25 +0100 Subject: [PATCH 11/16] attempt to remove ashtf_nir and ashtf_irr --- src/science/surface/fcdch.F90 | 5 +---- .../surface/jules_land_sf_explicit_jls.F90 | 15 ++------------- src/science/surface/jules_ssi_sf_explicit_jls.F90 | 9 +-------- src/science/surface/sf_flux_mod.F90 | 5 +---- 4 files changed, 5 insertions(+), 29 deletions(-) diff --git a/src/science/surface/fcdch.F90 b/src/science/surface/fcdch.F90 index 13791f52..c8b57145 100644 --- a/src/science/surface/fcdch.F90 +++ b/src/science/surface/fcdch.F90 @@ -36,7 +36,7 @@ SUBROUTINE fcdch ( & canopy,catch,flake,gc,gc_irr_surft,frac_irr_surft,snowdep,snow,canhc, & dzsurf,qstar,q_elev,radnet,snowdepth,timestep, & t_elev,tsurf,tstar,vfrac,emis,emis_soil, & - anthrop_heat,scaling_urban,alpha1,hcons,ashtf,ashtf_irr,ashtf_nir, & + anthrop_heat,scaling_urban,alpha1,hcons,ashtf, & rhostar,bq_1,bt_1, & cdv,chv,cdv_std,v_s,v_s_std,recip_l_mo,u_s_std & ) @@ -213,8 +213,6 @@ SUBROUTINE fcdch ( & ! IN Soil thermal conductivity (W/m/K). ,ashtf(points) & ! IN Adjusted SEB coefficient -,ashtf_irr(points) & -,ashtf_nir(points) & ,rhostar(tdims%i_start:tdims%i_end,tdims%j_start:tdims%j_end) & ! IN Surface air density ,bq_1(tdims%i_start:tdims%i_end,tdims%j_start:tdims%j_end) & @@ -629,7 +627,6 @@ SUBROUTINE fcdch ( & points,surft_pts, & pts_index,surft_index, & nsnow,n,canhc,dzsurf,hcons,ashtf, & - ashtf_irr,ashtf_nir,frac_irr_surft, & qstemp,q_elev, & radnet,resft,fracaero_s(:),rhokh,l_soil_point, & snowdepth,timestep,t_elev,tsurf, & diff --git a/src/science/surface/jules_land_sf_explicit_jls.F90 b/src/science/surface/jules_land_sf_explicit_jls.F90 index 44350f62..8edd15ab 100644 --- a/src/science/surface/jules_land_sf_explicit_jls.F90 +++ b/src/science/surface/jules_land_sf_explicit_jls.F90 @@ -958,8 +958,6 @@ SUBROUTINE jules_land_sf_explicit ( & ,ashtf_surft(land_pts,nsurft) & ! Coefficient to calculate surface ! heat flux into soil (W/m2/K). -,ashtf_irr_surft(land_pts,nsurft) & -,ashtf_nir_surft(land_pts,nsurft) & ,lw_down_surftsum(land_pts) & ! Gridbox sum of elevation corrections to ! downward longwave radiation @@ -1971,8 +1969,7 @@ SUBROUTINE jules_land_sf_explicit ( & !$OMP n, m, ts1_lake_gb, hcon_lake, l_elev_land_ice, l_lice_point, & !$OMP tsurf_elev_surft, dzsoil_elev, l_lice_surft, hcondeep, & !$OMP l_moruses_storage, urban_roof, l_fix_moruses_roof_rad_coupling, & -!$OMP vfrac_surft, ashtf_surft, ashtf_irr_surft, ashtf_nir_surft, & -!$OMP scaling_urban, l_soil_point) & +!$OMP vfrac_surft, ashtf_surft, scaling_urban, l_soil_point) & !$OMP SCHEDULE(STATIC) DO l = 1,land_pts j = (land_index(l) - 1) / t_i_length + 1 @@ -2032,13 +2029,9 @@ SUBROUTINE jules_land_sf_explicit ( & ! Set up surface soil condictivity ashtf_surft(l,n) = 2.0 * hcons_surf(l,n) / dzsurf(l,n) - ashtf_nir_surft(l,n) = ashtf_surft(l,n) - ashtf_irr_surft(l,n) = ashtf_surft(l,n) ! Except when n == urban_canyon when MORUSES is used ! scaling_urban(l) = 1.0 ashtf_surft(l,n) = ashtf_surft(l,n) * scaling_urban(l,n) - ashtf_nir_surft(l,n) = ashtf_surft(l,n) - ashtf_irr_surft(l,n) = ashtf_surft(l,n) ! Adjust surface soil condictivity for snow IF (snowdepth_surft(l,n) > 0.0 .AND. l_soil_point(l) & @@ -2326,7 +2319,6 @@ SUBROUTINE jules_land_sf_explicit ( & snowdepth_surft(:,n),timestep,t_elev(:,n),tsurf(:,n),tstar_surft(:,n), & vfrac_surft(:,n),emis_surft(:,n),emis_soil,anthrop_heat_surft(:,n), & scaling_urban(:,n),alpha1(:,n),hcons_surf(:,n),ashtf_surft(:,n), & - ashtf_irr_surft(:,n),ashtf_nir_surft(:,n), & rhostar,bq_1,bt_1, & cd_surft(:,n),ch_surft(:,n),cd_std(:,n), & v_s_surft(:,n),v_s_std(:,n),recip_l_mo_surft(:,n), & @@ -2431,7 +2423,6 @@ SUBROUTINE jules_land_sf_explicit ( & snowdepth_surft(:,n),timestep,t_elev(:,n),tsurf(:,n),tstar_surft(:,n), & vfrac_surft(:,n),emis_surft(:,n),emis_soil,anthrop_heat_surft(:,n), & scaling_urban(:,n),alpha1(:,n),hcons_surf(:,n),ashtf_surft(:,n), & - ashtf_irr_surft(:,n),ashtf_nir_surft(:,n), & rhostar,bq_1,bt_1, & ! Following tiled outputs (except v_s_std_soil and u_s_iter_soil) ! are dummy variables not needed from this call @@ -2499,7 +2490,6 @@ SUBROUTINE jules_land_sf_explicit ( & snowdepth_surft(:,n),timestep,t_elev(:,n),tsurf(:,n),tstar_surft(:,n), & vfrac_surft(:,n),emis_surft(:,n),emis_soil,anthrop_heat_surft(:,n), & scaling_urban(:,n),alpha1(:,n),hcons_surf(:,n),ashtf_surft(:,n), & - ashtf_irr_surft(:,n),ashtf_nir_surft(:,n), & rhostar,bq_1,bt_1, & ! Following tiled outputs (except cd_std_classic and ch_surft_classic) ! are dummy variables not needed from this call @@ -2630,8 +2620,7 @@ SUBROUTINE jules_land_sf_explicit ( & land_pts,surft_pts(n), & land_index,surft_index(:,n), & nsnow_surft(:,n),n,canhc_surf(:,n),dzsurf(:,n),hcons_surf(:,n), & - ashtf_surft(:,n),ashtf_irr_surft(:,n),ashtf_nir_surft(:,n), & - frac_irr_surft(:,n),qstar_surft(:,n),q_elev(:,n), & + ashtf_surft(:,n),qstar_surft(:,n),q_elev(:,n), & radnet_surft(:,n),resft(:,n),fracaero_s(:,n),rhokh_surft(:,n),l_soil_point, & snowdepth_surft(:,n),timestep,t_elev(:,n),tsurf(:,n), & tstar_surft(:,n),vfrac_surft(:,n),rhokh_can(:,n),z0h_surft(:,n), & diff --git a/src/science/surface/jules_ssi_sf_explicit_jls.F90 b/src/science/surface/jules_ssi_sf_explicit_jls.F90 index 3bd03add..024648ab 100644 --- a/src/science/surface/jules_ssi_sf_explicit_jls.F90 +++ b/src/science/surface/jules_ssi_sf_explicit_jls.F90 @@ -1440,7 +1440,7 @@ SUBROUTINE jules_ssi_sf_explicit ( & dzssi,qstar_sea,qw_1,radnet_sea, & array_zero,timestep,tl_1,tstar_sea,tstar_sea, & array_zero,array_emis,array_one,array_zero, & - array_one,alpha1_sea,hcons_sea,ashtf_sea,ashtf_sea,ashtf_sea, & + array_one,alpha1_sea,hcons_sea,ashtf_sea, & rhostar,bq_1,bt_1, & cd_sea,ch_sea,cd_std_sea, & v_s_sea,v_s_std_sea,recip_l_mo_sea, & @@ -1466,7 +1466,6 @@ SUBROUTINE jules_ssi_sf_explicit ( & array_zero,timestep,tl_1,ti_cat(:,:,n),tstar_sice_cat(:,:,n), & array_zero,array_emis,array_one,array_zero, & array_one,alpha1_sice(:,:,n),k_sice(:,:,n),ashtf(:,:,n), & - ashtf(:,:,n),ashtf(:,:,n), & rhostar,bq_1,bt_1, & cd_ice(:,:,n),ch_ice(:,:,n),cd_std_ice(:,n), & v_s_ice(:,:,n),v_s_std_ice(:,n),recip_l_mo_ice(:,:,n), & @@ -1490,7 +1489,6 @@ SUBROUTINE jules_ssi_sf_explicit ( & array_zero,timestep,tl_1,ti_cat(:,:,1),tstar_sice_cat(:,:,1), & array_zero,array_emis,array_one,array_zero, & array_one,alpha1_sice(:,:,1),k_sice(:,:,1),ashtf(:,:,1), & - ashtf(:,:,1),ashtf(:,:,1), & rhostar,bq_1,bt_1, & cd_ice(:,:,1),ch_ice(:,:,1),cd_std_ice(:,1), & v_s_ice(:,:,1),v_s_std_ice(:,1),recip_l_mo_ice(:,:,1), & @@ -1534,7 +1532,6 @@ SUBROUTINE jules_ssi_sf_explicit ( & array_zero,timestep,tl_1,ti_cat(:,:,1),tstar_sice_cat(:,:,1), & array_zero,array_emis,array_one,array_zero, & array_one,alpha1_sice(:,:,1),k_sice(:,:,1),ashtf(:,:,1), & - ashtf(:,:,1),ashtf(:,:,1), & rhostar,bq_1,bt_1, & cd_miz,ch_miz,cd_std_miz, & v_s_miz,v_s_std_miz,recip_l_mo_miz, & @@ -1779,7 +1776,6 @@ SUBROUTINE jules_ssi_sf_explicit ( & ssi_pts,sea_pts, & ssi_index,sea_index, & array_zero_int,0,canhc_sea,dzssi,hcons_sea,ashtf_sea, & - ashtf_sea,ashtf_sea,array_zero, & qstar_sea,qw_1,radnet_sea, & array_one * beta_evap,array_zero,rhokh_sea,array_false,array_zero, & timestep,tl_1,tstar_sea,tstar_sea, & @@ -1825,7 +1821,6 @@ SUBROUTINE jules_ssi_sf_explicit ( & ssi_pts,sea_pts, & ssi_index,sea_index, & array_zero_int,0,canhc_sea,dzssi,hcons_sea,ashtf_sea, & - ashtf_sea,ashtf_sea,array_zero, & qstar_sea,qw_1,radnet_sea, & array_one * beta_evap,array_zero,rhokh_1_sice,array_false,array_zero, & timestep,tl_1,tstar_sea,tstar_sea, & @@ -1921,7 +1916,6 @@ SUBROUTINE jules_ssi_sf_explicit ( & ssi_pts,sice_pts_ncat(n), & ssi_index,sice_index_ncat(:,n), & array_zero_int,0,array_zero,dzdummy,k_sice(:,:,n),ashtf(:,:,n), & - ashtf(:,:,n),ashtf(:,:,n),array_zero, & qstar_ice_cat(:,:,n),qw_1,radnet_sice(:,:,n),array_one,array_one, & rhokh_1_sice_ncats(:,:,n),array_false,array_zero, & timestep,tl_1,ti_cat(:,:,n), & @@ -1957,7 +1951,6 @@ SUBROUTINE jules_ssi_sf_explicit ( & ssi_pts,sice_pts_ncat(1), & ssi_index,sice_index_ncat(:,1), & array_zero_int,0,array_zero,dzdummy,k_sice(:,:,1),ashtf(:,:,1), & - ashtf(:,:,1),ashtf(:,:,1),array_zero, & qstar_ice,qw_1,radnet_sice(:,:,1),array_one,array_one, & rhokh_1_sice_ncats(:,:,1),array_false,array_zero, & timestep,tl_1,ti,tstar_sice_cat(:,:,1), & diff --git a/src/science/surface/sf_flux_mod.F90 b/src/science/surface/sf_flux_mod.F90 index 526480a3..0aa969ca 100644 --- a/src/science/surface/sf_flux_mod.F90 +++ b/src/science/surface/sf_flux_mod.F90 @@ -14,7 +14,7 @@ MODULE sf_flux_mod CONTAINS SUBROUTINE sf_flux ( & points,surft_pts,pts_index,surft_index, & - nsnow,n,canhc,dzsurf,hcons,ashtf,ashtf_irr,ashtf_nir,frac_irr, & + nsnow,n,canhc,dzsurf,hcons,ashtf, & qstar,q_elev,radnet,resft,fracs, & rhokh_1,l_soil_point,snowdepth,timestep, & t_elev,ts1_elev,tstar,vfrac,rhokh_can, & @@ -72,9 +72,6 @@ SUBROUTINE sf_flux ( & ,ashtf(points) & ! IN Coefficient to calculate surface ! heat flux into soil (W/m2/K). -,ashtf_irr(points) & -,ashtf_nir(points) & -,frac_irr(points) & ,qstar(points) & ! IN Surface qsat. ,q_elev(points) & From ac7b60d5db1f4bfacc7d88880222c3305ab083b7 Mon Sep 17 00:00:00 2001 From: nicgedney <131251916+nicgedney@users.noreply.github.com> Date: Mon, 24 Aug 2026 15:31:44 +0100 Subject: [PATCH 12/16] remove inconsistent variables in calls to fcdch --- src/science/surface/fcdch.F90 | 1 - src/science/surface/jules_ssi_sf_explicit_jls.F90 | 8 ++++---- 2 files changed, 4 insertions(+), 5 deletions(-) diff --git a/src/science/surface/fcdch.F90 b/src/science/surface/fcdch.F90 index c8b57145..761289eb 100644 --- a/src/science/surface/fcdch.F90 +++ b/src/science/surface/fcdch.F90 @@ -1049,7 +1049,6 @@ SUBROUTINE fcdch ( & points,surft_pts, & pts_index,surft_index, & nsnow,n,canhc,dzsurf,hcons,ashtf, & - ashtf,ashtf,frac_irr_surft, & qstemp,q_elev, & radnet,resft,fracaero_s(:),rhokh,l_soil_point, & snowdepth,timestep,t_elev,tsurf, & diff --git a/src/science/surface/jules_ssi_sf_explicit_jls.F90 b/src/science/surface/jules_ssi_sf_explicit_jls.F90 index 024648ab..0c536dbb 100644 --- a/src/science/surface/jules_ssi_sf_explicit_jls.F90 +++ b/src/science/surface/jules_ssi_sf_explicit_jls.F90 @@ -1436,7 +1436,7 @@ SUBROUTINE jules_ssi_sf_explicit ( & l_vegdrag_ssi,array_zero,array_zero, & array_zero_int,0,.FALSE.,.FALSE.,array_false, & array_zero,array_zero,array_zero,array_zero, & - array_zero,array_zero,array_zero,array_zero,canhc_sea, & + array_zero,array_zero,canhc_sea, & dzssi,qstar_sea,qw_1,radnet_sea, & array_zero,timestep,tl_1,tstar_sea,tstar_sea, & array_zero,array_emis,array_one,array_zero, & @@ -1461,7 +1461,7 @@ SUBROUTINE jules_ssi_sf_explicit ( & l_vegdrag_ssi,array_zero,array_zero, & array_zero_int,0,.FALSE.,.FALSE.,array_false, & array_zero,array_zero,array_zero,array_zero, & - array_zero,array_zero,array_zero,array_zero,array_zero, & + array_zero,array_zero,array_zero, & dzdummy,qstar_ice_cat(:,:,n),qw_1,radnet_sice(:,:,n), & array_zero,timestep,tl_1,ti_cat(:,:,n),tstar_sice_cat(:,:,n), & array_zero,array_emis,array_one,array_zero, & @@ -1484,7 +1484,7 @@ SUBROUTINE jules_ssi_sf_explicit ( & l_vegdrag_ssi,array_zero,array_zero, & array_zero_int,0,.FALSE.,.FALSE.,array_false, & array_zero,array_zero,array_zero,array_zero, & - array_zero,array_zero,array_zero,array_zero,array_zero, & + array_zero,array_zero,array_zero, & dzdummy,qstar_ice_cat(:,:,1),qw_1,radnet_sice(:,:,1), & array_zero,timestep,tl_1,ti_cat(:,:,1),tstar_sice_cat(:,:,1), & array_zero,array_emis,array_one,array_zero, & @@ -1527,7 +1527,7 @@ SUBROUTINE jules_ssi_sf_explicit ( & l_vegdrag_ssi,array_zero,array_zero, & array_zero_int,0,.FALSE.,.FALSE.,array_false, & array_zero,array_zero,array_zero,array_zero, & - array_zero,array_zero,array_zero,array_zero,array_zero, & + array_zero,array_zero,array_zero, & dzdummy,qstar_ice_cat(:,:,1),qw_1,radnet_sice(:,:,1), & array_zero,timestep,tl_1,ti_cat(:,:,1),tstar_sice_cat(:,:,1), & array_zero,array_emis,array_one,array_zero, & From 098437946be0cd6ca4deb15c53a12932aa26ff15 Mon Sep 17 00:00:00 2001 From: nicgedney <131251916+nicgedney@users.noreply.github.com> Date: Tue, 25 Aug 2026 15:03:11 +0100 Subject: [PATCH 13/16] added text to documentation --- doc/source/namelists/jules_irrig.nml.rst | 18 ++++++++++++++++++ .../surface/jules_ssi_sf_explicit_jls.F90 | 8 ++++---- 2 files changed, 22 insertions(+), 4 deletions(-) diff --git a/doc/source/namelists/jules_irrig.nml.rst b/doc/source/namelists/jules_irrig.nml.rst index e1c55478..dd017f3b 100644 --- a/doc/source/namelists/jules_irrig.nml.rst +++ b/doc/source/namelists/jules_irrig.nml.rst @@ -148,6 +148,24 @@ This namelist specifies the different options available for setting up the irrig :nml:mem:`nstep_irrig` = NINT(frequency of irrigation update (in sec)) / :nml:mem:`JULES_TIME::timestep_len` +.. nml:member:: l_soil_evap_irrig_expl + + :type: logical + :default: F + + Switch controlling whether the bare soil evaporation from the irrigated and non-irrigated part of the grid-box (or soil tile) is controlled by the mean soil moisture or the separate irrigated and non-irrigated soil moisture columns. + + TRUE + Bare soil evaporation is explicitly calculated from the irrigated and non-irrigated soil moisture columns. + + FALSE + No effect. + + This must be set to FALSE if :nml:mem:`JULES_IRRIG::irrig_option` = 0. + This must be set to FALSE if :nml:mem:`JULES_IRRIG::irrig_option` = 2. + + + .. _References_irrig: ``JULES_IRRIG`` references diff --git a/src/science/surface/jules_ssi_sf_explicit_jls.F90 b/src/science/surface/jules_ssi_sf_explicit_jls.F90 index 0c536dbb..d17e15ce 100644 --- a/src/science/surface/jules_ssi_sf_explicit_jls.F90 +++ b/src/science/surface/jules_ssi_sf_explicit_jls.F90 @@ -1436,7 +1436,7 @@ SUBROUTINE jules_ssi_sf_explicit ( & l_vegdrag_ssi,array_zero,array_zero, & array_zero_int,0,.FALSE.,.FALSE.,array_false, & array_zero,array_zero,array_zero,array_zero, & - array_zero,array_zero,canhc_sea, & + array_zero,array_zero,array_zero,array_zero,canhc_sea, & dzssi,qstar_sea,qw_1,radnet_sea, & array_zero,timestep,tl_1,tstar_sea,tstar_sea, & array_zero,array_emis,array_one,array_zero, & @@ -1461,7 +1461,7 @@ SUBROUTINE jules_ssi_sf_explicit ( & l_vegdrag_ssi,array_zero,array_zero, & array_zero_int,0,.FALSE.,.FALSE.,array_false, & array_zero,array_zero,array_zero,array_zero, & - array_zero,array_zero,array_zero, & + array_zero,array_zero,array_zero,array_zero,array_zero, & dzdummy,qstar_ice_cat(:,:,n),qw_1,radnet_sice(:,:,n), & array_zero,timestep,tl_1,ti_cat(:,:,n),tstar_sice_cat(:,:,n), & array_zero,array_emis,array_one,array_zero, & @@ -1484,7 +1484,7 @@ SUBROUTINE jules_ssi_sf_explicit ( & l_vegdrag_ssi,array_zero,array_zero, & array_zero_int,0,.FALSE.,.FALSE.,array_false, & array_zero,array_zero,array_zero,array_zero, & - array_zero,array_zero,array_zero, & + array_zero,array_zero,array_zero,array_zero,array_zero, & dzdummy,qstar_ice_cat(:,:,1),qw_1,radnet_sice(:,:,1), & array_zero,timestep,tl_1,ti_cat(:,:,1),tstar_sice_cat(:,:,1), & array_zero,array_emis,array_one,array_zero, & @@ -1527,7 +1527,7 @@ SUBROUTINE jules_ssi_sf_explicit ( & l_vegdrag_ssi,array_zero,array_zero, & array_zero_int,0,.FALSE.,.FALSE.,array_false, & array_zero,array_zero,array_zero,array_zero, & - array_zero,array_zero,array_zero, & + array_zero,array_zero,array_zero,array_zero,array_zero, & dzdummy,qstar_ice_cat(:,:,1),qw_1,radnet_sice(:,:,1), & array_zero,timestep,tl_1,ti_cat(:,:,1),tstar_sice_cat(:,:,1), & array_zero,array_emis,array_one,array_zero, & From 07a99353228bc2988d0bbe7c99e176cf7271c6cf Mon Sep 17 00:00:00 2001 From: nicgedney <131251916+nicgedney@users.noreply.github.com> Date: Tue, 25 Aug 2026 16:15:02 +0100 Subject: [PATCH 14/16] ran umdp3_fixer.py --- .../surface/jules_ssi_sf_explicit_jls.F90 | 8 +- src/science/surface/physiol_jls_mod.F90 | 246 +++++++++--------- src/science/surface/sf_evap_jls.F90 | 70 ++--- src/science/surface/sf_resist_jls.F90 | 48 ++-- 4 files changed, 186 insertions(+), 186 deletions(-) diff --git a/src/science/surface/jules_ssi_sf_explicit_jls.F90 b/src/science/surface/jules_ssi_sf_explicit_jls.F90 index d17e15ce..024648ab 100644 --- a/src/science/surface/jules_ssi_sf_explicit_jls.F90 +++ b/src/science/surface/jules_ssi_sf_explicit_jls.F90 @@ -1436,7 +1436,7 @@ SUBROUTINE jules_ssi_sf_explicit ( & l_vegdrag_ssi,array_zero,array_zero, & array_zero_int,0,.FALSE.,.FALSE.,array_false, & array_zero,array_zero,array_zero,array_zero, & - array_zero,array_zero,array_zero,array_zero,canhc_sea, & + array_zero,array_zero,array_zero,array_zero,canhc_sea, & dzssi,qstar_sea,qw_1,radnet_sea, & array_zero,timestep,tl_1,tstar_sea,tstar_sea, & array_zero,array_emis,array_one,array_zero, & @@ -1461,7 +1461,7 @@ SUBROUTINE jules_ssi_sf_explicit ( & l_vegdrag_ssi,array_zero,array_zero, & array_zero_int,0,.FALSE.,.FALSE.,array_false, & array_zero,array_zero,array_zero,array_zero, & - array_zero,array_zero,array_zero,array_zero,array_zero, & + array_zero,array_zero,array_zero,array_zero,array_zero, & dzdummy,qstar_ice_cat(:,:,n),qw_1,radnet_sice(:,:,n), & array_zero,timestep,tl_1,ti_cat(:,:,n),tstar_sice_cat(:,:,n), & array_zero,array_emis,array_one,array_zero, & @@ -1484,7 +1484,7 @@ SUBROUTINE jules_ssi_sf_explicit ( & l_vegdrag_ssi,array_zero,array_zero, & array_zero_int,0,.FALSE.,.FALSE.,array_false, & array_zero,array_zero,array_zero,array_zero, & - array_zero,array_zero,array_zero,array_zero,array_zero, & + array_zero,array_zero,array_zero,array_zero,array_zero, & dzdummy,qstar_ice_cat(:,:,1),qw_1,radnet_sice(:,:,1), & array_zero,timestep,tl_1,ti_cat(:,:,1),tstar_sice_cat(:,:,1), & array_zero,array_emis,array_one,array_zero, & @@ -1527,7 +1527,7 @@ SUBROUTINE jules_ssi_sf_explicit ( & l_vegdrag_ssi,array_zero,array_zero, & array_zero_int,0,.FALSE.,.FALSE.,array_false, & array_zero,array_zero,array_zero,array_zero, & - array_zero,array_zero,array_zero,array_zero,array_zero, & + array_zero,array_zero,array_zero,array_zero,array_zero, & dzdummy,qstar_ice_cat(:,:,1),qw_1,radnet_sice(:,:,1), & array_zero,timestep,tl_1,ti_cat(:,:,1),tstar_sice_cat(:,:,1), & array_zero,array_emis,array_one,array_zero, & diff --git a/src/science/surface/physiol_jls_mod.F90 b/src/science/surface/physiol_jls_mod.F90 index c952ab89..2bb82918 100644 --- a/src/science/surface/physiol_jls_mod.F90 +++ b/src/science/surface/physiol_jls_mod.F90 @@ -811,24 +811,24 @@ SUBROUTINE physiol ( & END DO IF (l_soil_evap_irrig_expl) THEN - DO k = 1,sm_levels - DO m = 1,nsoilt - DO l = 1,land_pts - sthu_nir_soilt(l,m,k) = sthu_soilt(l,m,k) - IF ( l_irrig_dmd ) THEN - sthu_nir_soilt(l,m,k) = sthu_soilt(l,m,k) - IF ( frac_irr_soilt(l,m) < 1.0 ) THEN - sthu_nir_soilt(l,m,k) = & - (sthu_soilt(l,m,k) - frac_irr_soilt(l,m) & - * sthu_irr_soilt(l,m,k)) & - / (1.0 - frac_irr_soilt(l,m)) - ELSE - sthu_nir_soilt(l,m,k) = sthu_irr_soilt(l,m,k) - END IF - END IF - END DO + DO k = 1,sm_levels + DO m = 1,nsoilt + DO l = 1,land_pts + sthu_nir_soilt(l,m,k) = sthu_soilt(l,m,k) + IF ( l_irrig_dmd ) THEN + sthu_nir_soilt(l,m,k) = sthu_soilt(l,m,k) + IF ( frac_irr_soilt(l,m) < 1.0 ) THEN + sthu_nir_soilt(l,m,k) = & + (sthu_soilt(l,m,k) - frac_irr_soilt(l,m) & + * sthu_irr_soilt(l,m,k)) & + / (1.0 - frac_irr_soilt(l,m)) + ELSE + sthu_nir_soilt(l,m,k) = sthu_irr_soilt(l,m,k) + END IF + END IF END DO - END DO + END DO + END DO END IF DO n = 1,ntype @@ -838,9 +838,9 @@ SUBROUTINE physiol ( & IF (l_irrig_dmd) THEN gs_irr_type(l,n) = gs(l) IF ( l_soil_evap_irrig_expl ) THEN - gs_nir_type(l,n) = gs(l) + gs_nir_type(l,n) = gs(l) END IF - END IF + END IF END DO !$OMP END DO NOWAIT END DO @@ -881,14 +881,14 @@ SUBROUTINE physiol ( & IF ( l_soil_evap_irrig_expl ) THEN gsoil_nir_soilt(l,m) = 0.0 IF (smvccl_soilt(l,m,1) > 0.0 .AND. l_limit_gsoil) THEN - gsoil_nir_soilt(l,m) = gs_nvg(soil - npft) * & - MIN(1.0, (sthu_nir_soilt(l,m,1) & - * smvcst_soilt(l,m,1) / smvccl_soilt(l,m,1))**2) + gsoil_nir_soilt(l,m) = gs_nvg(soil - npft) * & + MIN(1.0, (sthu_nir_soilt(l,m,1) & + * smvcst_soilt(l,m,1) / smvccl_soilt(l,m,1))**2) ELSE IF (smvccl_soilt(l,m,1) > 0.0) THEN - gsoil_nir_soilt(l,m) = gs_nvg(soil - npft) * & - (sthu_nir_soilt(l,m,1) & - * smvcst_soilt(l,m,1) / smvccl_soilt(l,m,1))**2 - ! ELSE Do nothing + gsoil_nir_soilt(l,m) = gs_nvg(soil - npft) * & + (sthu_nir_soilt(l,m,1) & + * smvcst_soilt(l,m,1) / smvccl_soilt(l,m,1))**2 + ! ELSE Do nothing END IF END IF END DO @@ -908,8 +908,8 @@ SUBROUTINE physiol ( & cosz_gb(l) = cos_zenith_angle(i,j) fsoil_tot(l) = frac(l,soil) IF ( l_soil_evap_irrig_expl ) THEN - fsoil_irr_tot(l) = frac(l,soil)*frac_irr_surft(l,soil) - fsoil_nir_tot(l) = frac(l,soil)*(1.-frac_irr_surft(l,soil)) + fsoil_irr_tot(l) = frac(l,soil)*frac_irr_surft(l,soil) + fsoil_nir_tot(l) = frac(l,soil)*(1.0-frac_irr_surft(l,soil)) END IF gs(l) = 0.0 END DO @@ -1096,22 +1096,22 @@ SUBROUTINE physiol ( & IF ( l_irrig_dmd ) THEN !$OMP DO SCHEDULE(STATIC) DO l = 1,land_pts - IF ( l_soil_evap_irrig_expl ) THEN - sthu_surft(l,m,k) = frac_irr_surft(l,n) * sthu_irr_soilt(l,m,k) & - + (1.0 - frac_irr_surft(l,n)) * sthu_nir_soilt(l,m,k) - ELSE -! MAY Be ABLE to remove the following section (calc of sthu_nir done above with l_bare_soil_evap_irr)*** check with rose stem?*** - sthu_nir_soilt(l,m,k) = sthu_soilt(l,m,k) - IF ( frac_irr_soilt(l,m) < 1.0 ) THEN - sthu_nir_soilt(l,m,k) = (sthu_soilt(l,m,k) - frac_irr_soilt(l,m)& - * sthu_irr_soilt(l,m,k)) & - / (1.0 - frac_irr_soilt(l,m)) - ELSE - sthu_nir_soilt(l,m,k) = sthu_irr_soilt(l,m,k) - END IF - sthu_surft(l,m,k) = frac_irr_surft(l,n) * sthu_irr_soilt(l,m,k) & - + (1.0 - frac_irr_surft(l,n)) * sthu_nir_soilt(l,m,k) - END IF + IF ( l_soil_evap_irrig_expl ) THEN + sthu_surft(l,m,k) = frac_irr_surft(l,n) * sthu_irr_soilt(l,m,k) & + + (1.0 - frac_irr_surft(l,n)) * sthu_nir_soilt(l,m,k) + ELSE + ! MAY Be ABLE to remove the following section (calc of sthu_nir done above with l_bare_soil_evap_irr)*** check with rose stem?*** + sthu_nir_soilt(l,m,k) = sthu_soilt(l,m,k) + IF ( frac_irr_soilt(l,m) < 1.0 ) THEN + sthu_nir_soilt(l,m,k) = (sthu_soilt(l,m,k) - frac_irr_soilt(l,m) & + * sthu_irr_soilt(l,m,k)) & + / (1.0 - frac_irr_soilt(l,m)) + ELSE + sthu_nir_soilt(l,m,k) = sthu_irr_soilt(l,m,k) + END IF + sthu_surft(l,m,k) = frac_irr_surft(l,n) * sthu_irr_soilt(l,m,k) & + + (1.0 - frac_irr_surft(l,n)) * sthu_nir_soilt(l,m,k) + END IF END DO !$OMP END DO END IF @@ -1160,25 +1160,25 @@ SUBROUTINE physiol ( & psi_root_zone_pft(:,n)) IF ( l_soil_evap_irrig_expl ) THEN - CALL smc_ext (land_pts,sm_levels,surft_pts(n),surft_index(:,n), n, & - f_root,sthu_nir_soilt(:,m,:), & - v_open,smvcst_soilt(:,m,:), & - v_close, & - bexp_soilt(:,m,:), sathh_soilt(:,m,:), & - wt_ext_nir_type(:,:,n),fsmc_nir(:,n), & - psi_root_zone_pft(:,n)) - - DO l = 1,land_pts - fsmc_pft(l,n) = fsmc_nir(l,n)*(1.-frac_irr_surft(l,n)) & - + fsmc_irr(l,n)*frac_irr_surft(l,n) - DO k = 1,sm_levels - wt_ext_type(l,k,n) = & - wt_ext_nir_type(l,k,n)*(1.-frac_irr_surft(l,n)) & - + wt_ext_irr_type(l,k,n)*frac_irr_surft(l,n) - END DO - END DO + CALL smc_ext (land_pts,sm_levels,surft_pts(n),surft_index(:,n), n, & + f_root,sthu_nir_soilt(:,m,:), & + v_open,smvcst_soilt(:,m,:), & + v_close, & + bexp_soilt(:,m,:), sathh_soilt(:,m,:), & + wt_ext_nir_type(:,:,n),fsmc_nir(:,n), & + psi_root_zone_pft(:,n)) + + DO l = 1,land_pts + fsmc_pft(l,n) = fsmc_nir(l,n)*(1.0-frac_irr_surft(l,n)) & + + fsmc_irr(l,n)*frac_irr_surft(l,n) + DO k = 1,sm_levels + wt_ext_type(l,k,n) = & + wt_ext_nir_type(l,k,n)*(1.0-frac_irr_surft(l,n)) & + + wt_ext_irr_type(l,k,n)*frac_irr_surft(l,n) + END DO + END DO END IF - END IF + END IF CALL raero (land_pts,land_index,surft_pts(n),surft_index(:,n) & , rib,vshr,z0,z0,z1_uv_ij,ra) @@ -1295,9 +1295,9 @@ SUBROUTINE physiol ( & IF ( fsmc_pft(l,n) > 0.0 ) THEN gs_irr_type(l,n) = gs_type(l,n) * fsmc_irr(l,n) / fsmc_pft(l,n) IF ( l_soil_evap_irrig_expl ) THEN - gs_nir_type(l,n) = gs_type(l,n) * fsmc_nir(l,n) / fsmc_pft(l,n) + gs_nir_type(l,n) = gs_type(l,n) * fsmc_nir(l,n) / fsmc_pft(l,n) END IF - + ELSE ! hadrd - this should only happen if sthu is 0.0, see smc_ext WRITE (ERRMSG,*) 'tile:', n, 'point:',l, 'fsmc:', fsmc_pft(l,n), & @@ -1327,13 +1327,13 @@ SUBROUTINE physiol ( & gsoil_under_canopy(:) = gsoil_soilt(:,m) gsoil_irr_under_canopy(:) = gsoil_irr_soilt(:,m) IF ( l_soil_evap_irrig_expl ) THEN - gsoil_nir_under_canopy(:) = gsoil_nir_soilt(:,m) + gsoil_nir_under_canopy(:) = gsoil_nir_soilt(:,m) END IF - ELSE + ELSE gsoil_under_canopy(:) = gsoil_soilt(:,m) * gsoil_f(n) gsoil_irr_under_canopy(:) = gsoil_irr_soilt(:,m) * gsoil_f(n) IF ( l_soil_evap_irrig_expl ) THEN - gsoil_nir_under_canopy(:) = gsoil_nir_soilt(:,m) * gsoil_f(n) + gsoil_nir_under_canopy(:) = gsoil_nir_soilt(:,m) * gsoil_f(n) END IF END IF @@ -1361,13 +1361,13 @@ SUBROUTINE physiol ( & DO l = 1,land_pts fsoil_tot(l) = fsoil_tot(l) + frac(l,n) * fsoil(l,n) IF ( l_soil_evap_irrig_expl ) THEN - fsoil_irr_tot(l) = fsoil_irr_tot(l) + frac(l,n) * fsoil(l,n) * & - frac_irr_surft(l,n) - fsoil_nir_tot(l) = fsoil_nir_tot(l) + frac(l,n) * fsoil(l,n) * & - (1.-frac_irr_surft(l,n)) + fsoil_irr_tot(l) = fsoil_irr_tot(l) + frac(l,n) * fsoil(l,n) * & + frac_irr_surft(l,n) + fsoil_nir_tot(l) = fsoil_nir_tot(l) + frac(l,n) * fsoil(l,n) * & + (1.0-frac_irr_surft(l,n)) END IF - END DO + END DO !$OMP END PARALLEL DO END DO @@ -1391,7 +1391,7 @@ SUBROUTINE physiol ( & IF (l_irrig_dmd) THEN gs_irr_type(l,n) = gs_nvg(n - npft) ! irrigation IF (l_soil_evap_irrig_expl ) THEN - gs_nir_type(l,n) = gs_nvg(n - npft) ! non-irrigation + gs_nir_type(l,n) = gs_nvg(n - npft) ! non-irrigation END IF END IF END DO @@ -1446,7 +1446,7 @@ SUBROUTINE physiol ( & wt_ext_type(l,1,n) = 1.0 END IF IF (l_irrig_dmd) THEN - IF ( l_soil_evap_irrig_expl )THEN + IF ( l_soil_evap_irrig_expl ) THEN gs_type(l,n) = frac_irr_surft(l,n)*gsoil_irr_soilt(l,m) & +(1.0-frac_irr_surft(l,n))*gsoil_nir_soilt(l,m) gs_nir_type(l,n) = gsoil_nir_soilt(l,m) ! non-irrigation @@ -1760,18 +1760,18 @@ SUBROUTINE physiol ( & * frac(l,n) * wt_ext_irr_type(l,k,n) END IF IF ( l_soil_evap_irrig_expl) THEN - IF ((1.-frac_irr_soilt(l,m)) > EPSILON(1.0)) THEN + IF ((1.0-frac_irr_soilt(l,m)) > EPSILON(1.0)) THEN wt_ext_nir_soilt(l,m,k) = wt_ext_nir_soilt(l,m,k) & - + (1.-frac_irr_surft(l,n)) & - / (1.-frac_irr_soilt(l,m)) & + + (1.0-frac_irr_surft(l,n)) & + / (1.0-frac_irr_soilt(l,m)) & * frac(l,n) * wt_ext_nir_type(l,k,n) - END IF - wt_ext_soilt(l,m,k) = frac_irr_soilt(l,m)*wt_ext_irr_soilt(l,m,k) & - + (1.-frac_irr_soilt(l,m)) & - * wt_ext_nir_soilt(l,m,k) + END IF + wt_ext_soilt(l,m,k) = frac_irr_soilt(l,m)*wt_ext_irr_soilt(l,m,k) & + + (1.0-frac_irr_soilt(l,m)) & + * wt_ext_nir_soilt(l,m,k) - END IF - END IF + END IF + END IF END DO END DO !$OMP END PARALLEL DO @@ -1882,15 +1882,15 @@ SUBROUTINE physiol ( & END IF wt_ext_irr_surft(l,k,n) = wt_ext_irr_type(l,k,n) IF (l_soil_evap_irrig_expl) THEN - IF ((1.-frac_irr_soilt(l,m)) > EPSILON(1.0)) THEN - wt_ext_nir_soilt(l,m,k) = wt_ext_nir_soilt(l,m,k) & - + (1.-frac_irr_surft(l,n)) & - / (1.-frac_irr_soilt(l,m)) & - * frac(l,n) * wt_ext_nir_type(l,k,n) - END IF - wt_ext_soilt(l,m,k) = frac_irr_soilt(l,m)*wt_ext_irr_soilt(l,m,k) & - + (1.-frac_irr_soilt(l,m)) & - * wt_ext_nir_soilt(l,m,k) + IF ((1.0-frac_irr_soilt(l,m)) > EPSILON(1.0)) THEN + wt_ext_nir_soilt(l,m,k) = wt_ext_nir_soilt(l,m,k) & + + (1.0-frac_irr_surft(l,n)) & + / (1.0-frac_irr_soilt(l,m)) & + * frac(l,n) * wt_ext_nir_type(l,k,n) + END IF + wt_ext_soilt(l,m,k) = frac_irr_soilt(l,m)*wt_ext_irr_soilt(l,m,k) & + + (1.0-frac_irr_soilt(l,m)) & + * wt_ext_nir_soilt(l,m,k) END IF END IF END DO !sm_levels @@ -2192,10 +2192,10 @@ SUBROUTINE physiol ( & - v_close_pft(l,k,n))) END IF IF (l_soil_evap_irrig_expl) THEN - IF (1. - frac_irr_soilt(l,m) > EPSILON(1.0) ) THEN + IF (1.0 - frac_irr_soilt(l,m) > EPSILON(1.0) ) THEN smc_nir_soilt(l,m) = smc_nir_soilt(l,m) & - + MAX(0.0,(1.-frac_irr_surft(l,n)) & - / (1.-frac_irr_soilt(l,m)) & + + MAX(0.0,(1.0-frac_irr_surft(l,n)) & + / (1.0-frac_irr_soilt(l,m)) & * frac(l,n) * wt_ext_nir_type(l,k,n) & * rho_water * dzsoil(k) & * (sthu_nir_soilt(l,m,k) & @@ -2249,34 +2249,34 @@ SUBROUTINE physiol ( & !$OMP frac_irr_surft, l_soil_evap_irrig_expl) DO m = 1,nsoilt !$OMP DO SCHEDULE(STATIC) - DO l = 1,land_pts - IF (l_soil_evap_irrig_expl) THEN - IF (frac_irr_soilt(l,m) > 0.0) THEN - fsoil_irr_tot(l) = fsoil_irr_tot(l)/frac_irr_soilt(l,m) - smc_irr_soilt(l,m) = (1.0 - fsoil_irr_tot(l) ) * & - smc_irr_soilt(l,m) + fsoil_irr_tot(l) * & - rho_water * dzsoil(1) * & - MAX(0.0,sthu_irr_soilt(l,m,1)) * smvcst_soilt(l,m,1) - ELSE - smc_irr_soilt(l,m) = 0.0 - END IF - IF (1.0 - frac_irr_soilt(l,m) > 0.0) THEN - fsoil_nir_tot(l) = fsoil_nir_tot(l)/(1.-frac_irr_soilt(l,m)) - smc_nir_soilt(l,m) = (1.0 - fsoil_nir_tot(l)) * & - smc_nir_soilt(l,m) + fsoil_nir_tot(l) * & - rho_water * dzsoil(1) * & - MAX(0.0,sthu_nir_soilt(l,m,1)) * smvcst_soilt(l,m,1) - ELSE - smc_nir_soilt(l,m) = 0.0 - END IF - - smc_soilt(l,m) = frac_irr_soilt(l,m) * smc_irr_soilt(l,m) + & - (1.0 - frac_irr_soilt(l,m)) * smc_nir_soilt(l,m) - ELSE - smc_irr_soilt(l,m) = (1.0 - fsoil_tot(l)) * smc_irr_soilt(l,m) + & - fsoil_tot(l) * rho_water * dzsoil(1) * & - MAX(0.0,sthu_irr_soilt(l,m,1)) * smvcst_soilt(l,m,1) - END IF + DO l = 1,land_pts + IF (l_soil_evap_irrig_expl) THEN + IF (frac_irr_soilt(l,m) > 0.0) THEN + fsoil_irr_tot(l) = fsoil_irr_tot(l)/frac_irr_soilt(l,m) + smc_irr_soilt(l,m) = (1.0 - fsoil_irr_tot(l) ) * & + smc_irr_soilt(l,m) + fsoil_irr_tot(l) * & + rho_water * dzsoil(1) * & + MAX(0.0,sthu_irr_soilt(l,m,1)) * smvcst_soilt(l,m,1) + ELSE + smc_irr_soilt(l,m) = 0.0 + END IF + IF (1.0 - frac_irr_soilt(l,m) > 0.0) THEN + fsoil_nir_tot(l) = fsoil_nir_tot(l)/(1.0-frac_irr_soilt(l,m)) + smc_nir_soilt(l,m) = (1.0 - fsoil_nir_tot(l)) * & + smc_nir_soilt(l,m) + fsoil_nir_tot(l) * & + rho_water * dzsoil(1) * & + MAX(0.0,sthu_nir_soilt(l,m,1)) * smvcst_soilt(l,m,1) + ELSE + smc_nir_soilt(l,m) = 0.0 + END IF + + smc_soilt(l,m) = frac_irr_soilt(l,m) * smc_irr_soilt(l,m) + & + (1.0 - frac_irr_soilt(l,m)) * smc_nir_soilt(l,m) + ELSE + smc_irr_soilt(l,m) = (1.0 - fsoil_tot(l)) * smc_irr_soilt(l,m) + & + fsoil_tot(l) * rho_water * dzsoil(1) * & + MAX(0.0,sthu_irr_soilt(l,m,1)) * smvcst_soilt(l,m,1) + END IF END DO !$OMP END DO END DO diff --git a/src/science/surface/sf_evap_jls.F90 b/src/science/surface/sf_evap_jls.F90 index 1c4b0534..57b3e723 100644 --- a/src/science/surface/sf_evap_jls.F90 +++ b/src/science/surface/sf_evap_jls.F90 @@ -700,7 +700,7 @@ SUBROUTINE sf_evap ( & ext_soilt(l,:,m) = 0.0 ext_irr_soilt(l,:,m) = 0.0 IF ( l_soil_evap_irrig_expl ) THEN - ext_nir_soilt(l,:,m) = 0.0 + ext_nir_soilt(l,:,m) = 0.0 END IF END DO !$OMP END DO @@ -723,14 +723,14 @@ SUBROUTINE sf_evap ( & ext_soilt(l,mm,m) = ext_soilt(l,mm,m) & + tile_frac(l,n) * wt_ext_surft(l,m,n) & * esoil_surft(l,n) - + IF ( l_soil_evap_irrig_expl ) THEN - wt_ext_nir_surft(l,m,n) = wt_ext_surft(l,m,n) - IF (1.- frac_irr_surft(l,n) > EPSILON(1.0) ) THEN - wt_ext_nir_surft(l,m,n) = (wt_ext_surft(l,m,n) - & - wt_ext_irr_surft(l,m,n) * frac_irr_surft(l,n)) / & - (1.- frac_irr_surft(l,n)) - END IF + wt_ext_nir_surft(l,m,n) = wt_ext_surft(l,m,n) + IF (1.0- frac_irr_surft(l,n) > EPSILON(1.0) ) THEN + wt_ext_nir_surft(l,m,n) = (wt_ext_surft(l,m,n) - & + wt_ext_irr_surft(l,m,n) * frac_irr_surft(l,n)) / & + (1.0- frac_irr_surft(l,n)) + END IF END IF END DO !$OMP END DO @@ -785,20 +785,20 @@ SUBROUTINE sf_evap ( & DO k = 1,surft_pts(n) l = surft_index(k,n) IF ( l_soil_evap_irrig_expl ) THEN - wt_ext_nir_surft(l,m,n) = wt_ext_surft(l,m,n) - IF ((1.- frac_irr_surft(l,n)) > EPSILON(1.0) ) THEN - wt_ext_nir_surft(l,m,n) = (wt_ext_surft(l,m,n) - & - wt_ext_irr_surft(l,m,n) * frac_irr_surft(l,n)) / & - (1.- frac_irr_surft(l,n)) - END IF - IF (1. - frac_irr_soilt(l,mm) > EPSILON(1.0) ) THEN - ext_nir_soilt(l,mm,m) = ext_nir_soilt(l,mm,m) & - + tile_frac(l,n) & - * wt_ext_nir_surft(l,m,n) & - * esoil_nir_surft(l,n) & - * (1.0 - frac_irr_surft(l,n)) & - / (1.0 - frac_irr_soilt(l,mm)) - END IF + wt_ext_nir_surft(l,m,n) = wt_ext_surft(l,m,n) + IF ((1.0- frac_irr_surft(l,n)) > EPSILON(1.0) ) THEN + wt_ext_nir_surft(l,m,n) = (wt_ext_surft(l,m,n) - & + wt_ext_irr_surft(l,m,n) * frac_irr_surft(l,n)) / & + (1.0- frac_irr_surft(l,n)) + END IF + IF (1.0 - frac_irr_soilt(l,mm) > EPSILON(1.0) ) THEN + ext_nir_soilt(l,mm,m) = ext_nir_soilt(l,mm,m) & + + tile_frac(l,n) & + * wt_ext_nir_surft(l,m,n) & + * esoil_nir_surft(l,n) & + * (1.0 - frac_irr_surft(l,n)) & + / (1.0 - frac_irr_soilt(l,mm)) + END IF END IF IF ( frac_irr_soilt(l,mm) > EPSILON(1.0) ) THEN @@ -822,19 +822,19 @@ SUBROUTINE sf_evap ( & l = surft_index(k,n) IF ( l_soil_evap_irrig_expl ) THEN - wt_ext_nir_surft(l,m,n) = wt_ext_surft(l,m,n) - IF (1.- frac_irr_surft(l,n) > EPSILON(1.0) ) THEN - wt_ext_nir_surft(l,m,n) = (wt_ext_surft(l,m,n) - & - wt_ext_irr_surft(l,m,n) * frac_irr_surft(l,n)) / & - (1.- frac_irr_surft(l,n)) - end if - IF (1.- frac_irr_soilt(l,mm) > EPSILON(1.0) ) THEN - ext_nir_soilt(l,mm,m) = ext_nir_soilt(l,mm,m) & - + wt_ext_nir_surft(l,m,n) & - * esoil_nir_surft(l,n) & - * (1.0 - frac_irr_surft(l,n)) & - / (1.0 - frac_irr_soilt(l,mm)) - END IF + wt_ext_nir_surft(l,m,n) = wt_ext_surft(l,m,n) + IF (1.0- frac_irr_surft(l,n) > EPSILON(1.0) ) THEN + wt_ext_nir_surft(l,m,n) = (wt_ext_surft(l,m,n) - & + wt_ext_irr_surft(l,m,n) * frac_irr_surft(l,n)) / & + (1.0- frac_irr_surft(l,n)) + END IF + IF (1.0- frac_irr_soilt(l,mm) > EPSILON(1.0) ) THEN + ext_nir_soilt(l,mm,m) = ext_nir_soilt(l,mm,m) & + + wt_ext_nir_surft(l,m,n) & + * esoil_nir_surft(l,n) & + * (1.0 - frac_irr_surft(l,n)) & + / (1.0 - frac_irr_soilt(l,mm)) + END IF END IF IF ( frac_irr_soilt(l,mm) > EPSILON(1.0) ) THEN diff --git a/src/science/surface/sf_resist_jls.F90 b/src/science/surface/sf_resist_jls.F90 index 50315a77..78b7e864 100644 --- a/src/science/surface/sf_resist_jls.F90 +++ b/src/science/surface/sf_resist_jls.F90 @@ -234,18 +234,18 @@ SUBROUTINE sf_resist ( & !----------------------------------------------------------------------- resfs(l) = gc(l) / ( gc(l) + ch(l) * vshr(i,j) ) IF ( l_soil_evap_irrig_expl ) THEN - gc_nir_surft(l) = gc(l) - IF ( frac_irr_surft(l) < 1.0 ) THEN - gc_nir_surft(l) = (gc(l) - frac_irr_surft(l) & - * gc_irr_surft(l)) & - / (1.0 - frac_irr_surft(l)) - ELSE - gc_nir_surft(l) = gc_irr_surft(l) - END IF - resfs(l) = frac_irr_surft(l)*gc_irr_surft(l) & - / ( gc_irr_surft(l) + ch(l) * vshr(i,j) ) & - +(1.-frac_irr_surft(l))*gc_nir_surft(l) & - / ( gc_nir_surft(l) + ch(l) * vshr(i,j) ) + gc_nir_surft(l) = gc(l) + IF ( frac_irr_surft(l) < 1.0 ) THEN + gc_nir_surft(l) = (gc(l) - frac_irr_surft(l) & + * gc_irr_surft(l)) & + / (1.0 - frac_irr_surft(l)) + ELSE + gc_nir_surft(l) = gc_irr_surft(l) + END IF + resfs(l) = frac_irr_surft(l)*gc_irr_surft(l) & + / ( gc_irr_surft(l) + ch(l) * vshr(i,j) ) & + +(1.0-frac_irr_surft(l))*gc_nir_surft(l) & + / ( gc_nir_surft(l) + ch(l) * vshr(i,j) ) END IF IF (l_et_stom .OR. l_et_stom_surft) THEN resfs_stom(l) = gc_stom_surft(l) / ( gc_stom_surft(l) + ch(l) * vshr(i,j) ) @@ -275,18 +275,18 @@ SUBROUTINE sf_resist ( & resfs(l) = gc(l) / & (gc(l) + ch(l) * vshr(i,j)) IF ( l_soil_evap_irrig_expl ) THEN - gc_nir_surft(l) = gc(l) - IF ( frac_irr_surft(l) < 1.0 ) THEN - gc_nir_surft(l) = (gc(l) - frac_irr_surft(l) & - * gc_irr_surft(l)) & - / (1.0 - frac_irr_surft(l)) - ELSE - gc_nir_surft(l) = gc_irr_surft(l) - END IF - resfs(l) = frac_irr_surft(l)*gc_irr_surft(l) & - / ( gc_irr_surft(l) + ch(l) * vshr(i,j) ) & - +(1.-frac_irr_surft(l))*gc_nir_surft(l) & - / ( gc_nir_surft(l) + ch(l) * vshr(i,j) ) + gc_nir_surft(l) = gc(l) + IF ( frac_irr_surft(l) < 1.0 ) THEN + gc_nir_surft(l) = (gc(l) - frac_irr_surft(l) & + * gc_irr_surft(l)) & + / (1.0 - frac_irr_surft(l)) + ELSE + gc_nir_surft(l) = gc_irr_surft(l) + END IF + resfs(l) = frac_irr_surft(l)*gc_irr_surft(l) & + / ( gc_irr_surft(l) + ch(l) * vshr(i,j) ) & + +(1.0-frac_irr_surft(l))*gc_nir_surft(l) & + / ( gc_nir_surft(l) + ch(l) * vshr(i,j) ) END IF resft(l) = resfs(l) END IF From 4dd9e4e1a0a7b73416fe365e23fe9e4a831e6c72 Mon Sep 17 00:00:00 2001 From: nicgedney <131251916+nicgedney@users.noreply.github.com> Date: Tue, 25 Aug 2026 16:54:11 +0100 Subject: [PATCH 15/16] comment out additional code fro sthu_nir calc in physiol --- src/science/surface/physiol_jls_mod.F90 | 39 ++++++++++++++----------- 1 file changed, 22 insertions(+), 17 deletions(-) diff --git a/src/science/surface/physiol_jls_mod.F90 b/src/science/surface/physiol_jls_mod.F90 index 2bb82918..b4426a19 100644 --- a/src/science/surface/physiol_jls_mod.F90 +++ b/src/science/surface/physiol_jls_mod.F90 @@ -455,7 +455,13 @@ SUBROUTINE physiol ( & ! ! WORK Soil moisture availability ! ! factor over irrigated fraction. ,sthu_nir_soilt(land_pts,nsoilt,sm_levels) & + ! WORK Soil moisture content in each layer +! ! in the non-irrigated soil column +! ! as a fraction of saturation ,sthu_surft(land_pts,nsoilt,sm_levels) & + ! WORK Soil moisture content in each layer +! ! as a fraction of saturation +! ! on surface tiles ,wt_ext_nir_soilt(land_pts,nsoilt,sm_levels) & ! ! WORK Fraction of transpiration over ! ! non-irrigated fraction extracted @@ -539,8 +545,6 @@ SUBROUTINE physiol ( & ! WORK Fractional canopy coverage. ,vf_type(land_pts,ntype) & ! WORK VFRAC for surface types. -!!!,sthu_nir_soilt(land_pts,nsoilt,sm_levels) & -,wt_ext_type_tmp(land_pts,sm_levels,ntype) & ,wt_ext_type(land_pts,sm_levels,ntype) & ! ! WORK WT_EXT for surface types. ,wt_ext_soilt(land_pts,nsoilt,sm_levels) & @@ -810,7 +814,8 @@ SUBROUTINE physiol ( & END DO END DO -IF (l_soil_evap_irrig_expl) THEN +!!!***??IF (l_soil_evap_irrig_expl) THEN +IF ( l_irrig_dmd ) THEN DO k = 1,sm_levels DO m = 1,nsoilt DO l = 1,land_pts @@ -1096,22 +1101,22 @@ SUBROUTINE physiol ( & IF ( l_irrig_dmd ) THEN !$OMP DO SCHEDULE(STATIC) DO l = 1,land_pts - IF ( l_soil_evap_irrig_expl ) THEN - sthu_surft(l,m,k) = frac_irr_surft(l,n) * sthu_irr_soilt(l,m,k) & + !!!IF ( l_soil_evap_irrig_expl ) THEN + sthu_surft(l,m,k) = frac_irr_surft(l,n) * sthu_irr_soilt(l,m,k) & + (1.0 - frac_irr_surft(l,n)) * sthu_nir_soilt(l,m,k) - ELSE + !!!ELSE ! MAY Be ABLE to remove the following section (calc of sthu_nir done above with l_bare_soil_evap_irr)*** check with rose stem?*** - sthu_nir_soilt(l,m,k) = sthu_soilt(l,m,k) - IF ( frac_irr_soilt(l,m) < 1.0 ) THEN - sthu_nir_soilt(l,m,k) = (sthu_soilt(l,m,k) - frac_irr_soilt(l,m) & - * sthu_irr_soilt(l,m,k)) & - / (1.0 - frac_irr_soilt(l,m)) - ELSE - sthu_nir_soilt(l,m,k) = sthu_irr_soilt(l,m,k) - END IF - sthu_surft(l,m,k) = frac_irr_surft(l,n) * sthu_irr_soilt(l,m,k) & - + (1.0 - frac_irr_surft(l,n)) * sthu_nir_soilt(l,m,k) - END IF + !!!sthu_nir_soilt(l,m,k) = sthu_soilt(l,m,k) + !!!IF ( frac_irr_soilt(l,m) < 1.0 ) THEN + !!! sthu_nir_soilt(l,m,k) = (sthu_soilt(l,m,k) - frac_irr_soilt(l,m) & + !!! * sthu_irr_soilt(l,m,k)) & + !!! / (1.0 - frac_irr_soilt(l,m)) + !!!ELSE + !!! sthu_nir_soilt(l,m,k) = sthu_irr_soilt(l,m,k) + !!!END IF + !!!sthu_surft(l,m,k) = frac_irr_surft(l,n) * sthu_irr_soilt(l,m,k) & + !!! + (1.0 - frac_irr_surft(l,n)) * sthu_nir_soilt(l,m,k) + !!!END IF END DO !$OMP END DO END IF From 2d264728d6f06356449d9044095dec3221cae0ed Mon Sep 17 00:00:00 2001 From: nicgedney <131251916+nicgedney@users.noreply.github.com> Date: Wed, 26 Aug 2026 10:04:30 +0100 Subject: [PATCH 16/16] remove comments from physiol --- src/science/surface/physiol_jls_mod.F90 | 15 --------------- 1 file changed, 15 deletions(-) diff --git a/src/science/surface/physiol_jls_mod.F90 b/src/science/surface/physiol_jls_mod.F90 index b4426a19..7393fa33 100644 --- a/src/science/surface/physiol_jls_mod.F90 +++ b/src/science/surface/physiol_jls_mod.F90 @@ -814,7 +814,6 @@ SUBROUTINE physiol ( & END DO END DO -!!!***??IF (l_soil_evap_irrig_expl) THEN IF ( l_irrig_dmd ) THEN DO k = 1,sm_levels DO m = 1,nsoilt @@ -1101,22 +1100,8 @@ SUBROUTINE physiol ( & IF ( l_irrig_dmd ) THEN !$OMP DO SCHEDULE(STATIC) DO l = 1,land_pts - !!!IF ( l_soil_evap_irrig_expl ) THEN sthu_surft(l,m,k) = frac_irr_surft(l,n) * sthu_irr_soilt(l,m,k) & + (1.0 - frac_irr_surft(l,n)) * sthu_nir_soilt(l,m,k) - !!!ELSE - ! MAY Be ABLE to remove the following section (calc of sthu_nir done above with l_bare_soil_evap_irr)*** check with rose stem?*** - !!!sthu_nir_soilt(l,m,k) = sthu_soilt(l,m,k) - !!!IF ( frac_irr_soilt(l,m) < 1.0 ) THEN - !!! sthu_nir_soilt(l,m,k) = (sthu_soilt(l,m,k) - frac_irr_soilt(l,m) & - !!! * sthu_irr_soilt(l,m,k)) & - !!! / (1.0 - frac_irr_soilt(l,m)) - !!!ELSE - !!! sthu_nir_soilt(l,m,k) = sthu_irr_soilt(l,m,k) - !!!END IF - !!!sthu_surft(l,m,k) = frac_irr_surft(l,n) * sthu_irr_soilt(l,m,k) & - !!! + (1.0 - frac_irr_surft(l,n)) * sthu_nir_soilt(l,m,k) - !!!END IF END DO !$OMP END DO END IF