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/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 74cd8f3a..cfc8e5c8 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 @@ -81,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' diff --git a/src/science/surface/fcdch.F90 b/src/science/surface/fcdch.F90 index 9f460f7f..761289eb 100644 --- a/src/science/surface/fcdch.F90 +++ b/src/science/surface/fcdch.F90 @@ -33,7 +33,7 @@ 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, & @@ -155,6 +155,12 @@ SUBROUTINE fcdch ( & ,gc(points) & ! 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) & @@ -588,6 +594,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.) @@ -1009,6 +1016,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.) diff --git a/src/science/surface/jules_land_sf_explicit_jls.F90 b/src/science/surface/jules_land_sf_explicit_jls.F90 index 6cf33e11..8edd15ab 100644 --- a/src/science/surface/jules_land_sf_explicit_jls.F90 +++ b/src/science/surface/jules_land_sf_explicit_jls.F90 @@ -812,6 +812,11 @@ SUBROUTINE jules_land_sf_explicit ( & ! respired fraction of RESP_S ,gc_stom_surft(land_pts,nsurft) & ! canopy conductance +,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) & @@ -1247,6 +1252,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 @@ -2247,7 +2253,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,6 +2313,7 @@ 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), & @@ -2409,6 +2417,7 @@ 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), & @@ -2475,6 +2484,7 @@ 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), & @@ -2601,7 +2611,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) diff --git a/src/science/surface/jules_ssi_sf_explicit_jls.F90 b/src/science/surface/jules_ssi_sf_explicit_jls.F90 index 0c536dbb..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,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, & diff --git a/src/science/surface/physiol_jls_mod.F90 b/src/science/surface/physiol_jls_mod.F90 index 00caf8cf..7393fa33 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) @@ -106,7 +107,7 @@ 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 @@ -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,28 +448,52 @@ 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) & + ! 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 +! ! 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. ,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. @@ -525,6 +552,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 @@ -612,17 +641,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) @@ -640,6 +672,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 @@ -675,6 +708,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 @@ -750,6 +784,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 @@ -760,6 +795,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 @@ -778,6 +814,26 @@ SUBROUTINE physiol ( & END DO END DO +IF ( l_irrig_dmd ) 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) @@ -785,6 +841,9 @@ SUBROUTINE physiol ( & gs_type(l,n) = gs(l) 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) + END IF END IF END DO !$OMP END DO NOWAIT @@ -823,6 +882,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 @@ -839,6 +911,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.0-frac_irr_surft(l,soil)) + END IF gs(l) = 0.0 END DO !$OMP END DO NOWAIT @@ -1010,7 +1086,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 @@ -1023,16 +1100,8 @@ 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) + + (1.0 - frac_irr_surft(l,n)) * sthu_nir_soilt(l,m,k) END DO !$OMP END DO END IF @@ -1067,7 +1136,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 @@ -1078,6 +1148,26 @@ SUBROUTINE physiol ( & bexp_soilt(:,m,:), sathh_soilt(:,m,:), & wt_ext_irr_type(:,:,n),fsmc_irr(:,n), & 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.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 CALL raero (land_pts,land_index,surft_pts(n),surft_index(:,n) & @@ -1178,10 +1268,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 @@ -1192,6 +1284,9 @@ 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 @@ -1221,15 +1316,23 @@ SUBROUTINE physiol ( & ! with code before gsoil_f parameter was added 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) + 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), & 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) & @@ -1243,9 +1346,17 @@ 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) + 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.0-frac_irr_surft(l,n)) + + END IF END DO !$OMP END PARALLEL DO @@ -1260,13 +1371,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 @@ -1309,9 +1425,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) @@ -1319,6 +1436,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 @@ -1606,9 +1728,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) @@ -1625,6 +1749,18 @@ SUBROUTINE physiol ( & / frac_irr_soilt(l,m) & * frac(l,n) * wt_ext_irr_type(l,k,n) END IF + IF ( l_soil_evap_irrig_expl) 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.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 END DO @@ -1698,10 +1834,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) @@ -1710,6 +1849,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) @@ -1728,6 +1871,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.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 END DO !surf_pts @@ -2011,9 +2165,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 @@ -2026,6 +2181,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.0 - frac_irr_soilt(l,m) > EPSILON(1.0) ) THEN + smc_nir_soilt(l,m) = smc_nir_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) & + * smvcst_soilt(l,m,k) & + - v_close_pft(l,k,n))) + END IF + END IF END DO !$OMP END PARALLEL DO END DO @@ -2035,8 +2202,10 @@ 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 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) DO l = 1,land_pts smc_irr_soilt(l,m) = smc_irr_soilt(l,m) & @@ -2046,6 +2215,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 @@ -2054,14 +2232,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) + & - fsoil_tot(l) * rho_water * dzsoil(1) * & - MAX(0.0,sthu_irr_soilt(l,m,1)) * smvcst_soilt(l,m,1) + 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 e7c06103..57b3e723 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 @@ -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) @@ -188,6 +187,18 @@ 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) & +! ! 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). @@ -688,6 +699,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 @@ -709,6 +723,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.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 END IF @@ -761,6 +784,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.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 ext_irr_soilt(l,mm,m) = ext_irr_soilt(l,mm,m) & + tile_frac(l,n) & @@ -780,6 +820,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.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 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_flux_mod.F90 b/src/science/surface/sf_flux_mod.F90 index b41ae51f..0aa969ca 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,ashtf, & + 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 diff --git a/src/science/surface/sf_resist_jls.F90 b/src/science/surface/sf_resist_jls.F90 index 1ff6b897..78b7e864 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_soil_evap_irrig_expl USE parkind1, ONLY: jprb, jpim USE yomhook, ONLY: lhook, dr_hook IMPLICIT NONE @@ -74,6 +76,10 @@ SUBROUTINE sf_resist ( & ,gc(land_pts) & ! 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) & ! IN canopy conductance (excluding soil) (m/s) ,snowdep_surft(land_pts) & @@ -123,6 +129,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' @@ -140,7 +147,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) @@ -225,6 +233,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.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) ) END IF @@ -242,7 +264,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 @@ -251,6 +274,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.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 END DO diff --git a/src/science/surface/soil_evap_jls.F90 b/src/science/surface/soil_evap_jls.F90 index 1d62399e..b348fa1b 100644 --- a/src/science/surface/soil_evap_jls.F90 +++ b/src/science/surface/soil_evap_jls.F90 @@ -21,11 +21,12 @@ 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 +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 @@ -48,12 +49,17 @@ 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) & + ! IN Irrigation fraction in tile ,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 +73,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 @@ -92,7 +105,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 @@ -126,6 +140,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 @@ -167,6 +192,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