diff --git a/components/elm/src/biogeochem/AllocationMod.F90 b/components/elm/src/biogeochem/AllocationMod.F90 index db273ceedafd..c937bdd69405 100644 --- a/components/elm/src/biogeochem/AllocationMod.F90 +++ b/components/elm/src/biogeochem/AllocationMod.F90 @@ -24,6 +24,7 @@ module AllocationMod use LandunitType , only : lun_pp use ColumnType , only : col_pp use ColumnDataType , only : col_ws + use ColumnDataType , only : col_cs use ColumnDataType , only : col_cf, c13_col_cf, c14_col_cf use ColumnDataType , only : col_ns, col_nf, col_ps, col_pf use VegetationType , only : veg_pp @@ -1318,7 +1319,7 @@ subroutine Allocation2_ResolveNPLimit (bounds, num_soilc, filter_soilc , & else !(ECA) - decompmicc(fc,:) = elm_fates%fates(ci)%bc_out(s)%decompmicc(:) ! Should be (nlevdecomp) + decompmicc(fc,:) = col_cs%decompmicc_fates(fc,:) end if end do diff --git a/components/elm/src/biogeophys/SoilStateType.F90 b/components/elm/src/biogeophys/SoilStateType.F90 index ff4a100141ed..b4b8141efe5f 100644 --- a/components/elm/src/biogeophys/SoilStateType.F90 +++ b/components/elm/src/biogeophys/SoilStateType.F90 @@ -61,6 +61,7 @@ module SoilStateType real(r8), pointer :: watmin_col (:,:) ! col minimum volumetric soil water (nlevsoi) real(r8), pointer :: sucsat_col (:,:) ! col minimum soil suction (mm) (nlevgrnd) real(r8), pointer :: sucmin_col (:,:) ! col minimum allowable soil liquid suction pressure (mm) [Note: sucmin_col is a negative value, while sucsat_col is a positive quantity] + real(r8), pointer :: sucpot_col_fates (:,:) ! col soil suction potential (mm) [Note: sucpot_col is a negative value, while sucsat_col is a positive quantity] real(r8), pointer :: soilbeta_col (:) ! col factor that reduces ground evaporation L&P1992(-) real(r8), pointer :: soilalpha_col (:) ! col factor that reduces ground saturated specific humidity (-) real(r8), pointer :: soilalpha_u_col (:) ! col urban factor that reduces ground saturated specific humidity (-) @@ -165,6 +166,7 @@ subroutine InitAllocate(this, bounds) allocate(this%watmin_col (begc:endc,nlevgrnd)) ; this%watmin_col (:,:) = spval allocate(this%sucsat_col (begc:endc,nlevgrnd)) ; this%sucsat_col (:,:) = spval allocate(this%sucmin_col (begc:endc,nlevgrnd)) ; this%sucmin_col (:,:) = spval + allocate(this%sucpot_col_fates (begc:endc,nlevgrnd)) ; this%sucpot_col_fates (:,:) = spval allocate(this%soilbeta_col (begc:endc)) ; this%soilbeta_col (:) = spval allocate(this%soilalpha_col (begc:endc)) ; this%soilalpha_col (:) = spval allocate(this%soilalpha_u_col (begc:endc)) ; this%soilalpha_u_col (:) = spval diff --git a/components/elm/src/data_types/ColumnDataType.F90 b/components/elm/src/data_types/ColumnDataType.F90 index 6582814c416c..d3ace0b17e40 100644 --- a/components/elm/src/data_types/ColumnDataType.F90 +++ b/components/elm/src/data_types/ColumnDataType.F90 @@ -200,6 +200,7 @@ module ColumnDataType real(r8), pointer :: ctrunc_vr (:,:) => null() ! (gC/m3) vertically-resolved column-level sink for C truncation real(r8), pointer :: frootc (:) => null() ! (gC/m2) column-level C pool for fine root real(r8), pointer :: seedc (:) => null() ! (gC/m2) column-level pool for seeding new Patches + real(r8), pointer :: seedc_fates (:) => null() ! (gC/m2) column-level seed carbon from FATES real(r8), pointer :: prod1c (:) => null() ! (gC/m2) crop product C pool, 1-year lifespan real(r8), pointer :: prod10c (:) => null() ! (gC/m2) wood product C pool, 10-year lifespan real(r8), pointer :: prod100c (:) => null() ! (gC/m2) wood product C pool, 100-year lifespan @@ -208,9 +209,11 @@ module ColumnDataType real(r8), pointer :: totpftc (:) => null() ! (gC/m2) total patch-level carbon, including cpool averaged to column (p2c) real(r8), pointer :: decomp_cpools_1m (:,:) => null() ! (gC/m2) Diagnostic: decomposing (litter, cwd, soil) c pools to 1 meter real(r8), pointer :: decomp_cpools (:,:) => null() ! (gC/m2) decomposing (litter, cwd, soil) c pools + real(r8), pointer :: decompmicc_fates (:,:) => null() ! (gC/m3) microbial decomposer biomass per decomp level, FATES real(r8), pointer :: cwdc (:) => null() ! (gC/m2) Diagnostic: coarse woody debris C real(r8), pointer :: ctrunc (:) => null() ! (gC/m2) column-level sink for C truncation real(r8), pointer :: totlitc (:) => null() ! (gC/m2) total litter carbon + real(r8), pointer :: totlitc_cwd_fates (:) => null() ! (gC/m2) total litter carbon + coarse woody debris, FATES real(r8), pointer :: totsomc (:) => null() ! (gC/m2) total soil organic matter carbon real(r8), pointer :: som1c (:) => null() real(r8), pointer :: som2c (:) => null() @@ -644,6 +647,8 @@ module ColumnDataType real(r8), pointer :: nep (:) => null() ! (gC/m2/s) net ecosystem production, excludes fire, landuse, and harvest flux, positive for sink real(r8), pointer :: nbp (:) => null() ! (gC/m2/s) net biome production, includes fire, landuse, and harvest flux, positive for sink real(r8), pointer :: nee (:) => null() ! (gC/m2/s) net ecosystem exchange of carbon, includes fire, landuse, harvest, and hrv_xsmrpool flux, positive for source + real(r8), pointer :: grazing_loss_atm_fates (:) => null() ! (gC/m2/s) loss of carbon to atmosphere from grazing in FATES + real(r8), pointer :: fire_loss_atm_fates (:) => null() ! (gC/m2/s) loss of carbon to atmosphere from fire in FATES real(r8), pointer :: cinputs (:) => null() ! column-level C inputs (gC/m2/s) real(r8), pointer :: coutputs (:) => null() ! column-level C outputs (gC/m2/s) ! CLAMP summary (diagnostic) flux variables, not involved in mass balance @@ -656,7 +661,9 @@ module ColumnDataType real(r8), pointer :: rr (:) => null() ! column (gC/m2/s) root respiration (fine root MR + total root GR) (p2c) real(r8), pointer :: rr_vr (:,:) => null() ! column (gC/m2/s) root respiration (fine root MR + total root GR) (p2c) real(r8), pointer :: ar (:) => null() ! column (gC/m2/s) autotrophic respiration (MR + GR) (p2c) + real(r8), pointer :: ar_fates (:) => null() ! column (gC/m2/s) autotrophic respiration from FATES real(r8), pointer :: gpp (:) => null() ! column (gC/m2/s) GPP flux before downregulation (p2c) + real(r8), pointer :: gpp_fates (:) => null() ! column (gC/m2/s) GPP flux from FATES real(r8), pointer :: npp (:) => null() ! column (gC/m2/s) net primary production (p2c) real(r8), pointer :: fire_closs_p2c (:) => null() ! column (gC/m2/s) patch2col averaged column-level fire C loss (p2c) real(r8), pointer :: fire_closs (:) => null() ! column (gC/m2/s) total patch-level fire C loss @@ -2153,6 +2160,7 @@ subroutine col_cs_init(this, begc, endc, carbon_type, ratio, c12_carbonstate_var allocate(this%fuelc_crop (begc:endc)) ; this%fuelc_crop (:) = spval allocate(this%frootc (begc:endc)) ; this%frootc (:) = spval allocate(this%seedc (begc:endc)) ; this%seedc (:) = spval + allocate(this%seedc_fates (begc:endc)) ; this%seedc_fates (:) = spval allocate(this%prod1c (begc:endc)) ; this%prod1c (:) = spval allocate(this%prod10c (begc:endc)) ; this%prod10c (:) = spval allocate(this%prod100c (begc:endc)) ; this%prod100c (:) = spval @@ -2184,11 +2192,13 @@ subroutine col_cs_init(this, begc, endc, carbon_type, ratio, c12_carbonstate_var allocate(this%decomp_cpools_vr (begc:endc,1:nlevdecomp_full,1:ndecomp_pools)) ; this%decomp_cpools_vr (:,:,:) = spval allocate(this%ctrunc_vr (begc:endc,1:nlevdecomp_full)) ; this%ctrunc_vr (:,:) = spval allocate(this%decomp_som2c_vr (begc:endc,1:nlevdecomp_full)) ; this%decomp_som2c_vr (:,:) = spval + allocate(this%decompmicc_fates (begc:endc,1:nlevdecomp_full)) ; this%decompmicc_fates (:,:) = spval allocate(this%decomp_cpools_1m (begc:endc,1:ndecomp_pools)) ; this%decomp_cpools_1m (:,:) = spval allocate(this%decomp_cpools (begc:endc,1:ndecomp_pools)) ; this%decomp_cpools (:,:) = spval allocate(this%totlitc_1m (begc:endc)) ; this%totlitc_1m (:) = spval allocate(this%totsomc_1m (begc:endc)) ; this%totsomc_1m (:) = spval allocate(this%totlitc (begc:endc)) ; this%totlitc (:) = spval + allocate(this%totlitc_cwd_fates (begc:endc)) ; this%totlitc_cwd_fates (:) = spval allocate(this%totsomc (begc:endc)) ; this%totsomc (:) = spval !----------------------------------------------------------------------- @@ -3305,6 +3315,9 @@ subroutine col_cs_zero_forfates_veg(this, bounds, num_soilc, filter_soilc) this%totvegc(c) = 0._r8 this%totvegc_abg(c) = 0._r8 this%cropseedc_deficit(c) = 0._r8 + this%totlitc_cwd_fates(c) = 0._r8 + this%seedc_fates(c) = 0._r8 + this%decompmicc_fates(c,:) = 0.0_r8 end do return @@ -6251,6 +6264,8 @@ subroutine col_cf_init(this, begc, endc, carbon_type) allocate(this%nep (begc:endc)) ; this%nep (:) = spval allocate(this%nbp (begc:endc)) ; this%nbp (:) = spval allocate(this%nee (begc:endc)) ; this%nee (:) = spval + allocate(this%grazing_loss_atm_fates (begc:endc)) ; this%grazing_loss_atm_fates (:) = spval + allocate(this%fire_loss_atm_fates (begc:endc)) ; this%fire_loss_atm_fates (:) = spval allocate(this%cinputs (begc:endc)) ; this%cinputs (:) = spval allocate(this%coutputs (begc:endc)) ; this%coutputs (:) = spval allocate(this%bgc_cpool_ext_inputs_vr (begc:endc, 1:nlevdecomp_full,ndecomp_pools)) ; this%bgc_cpool_ext_inputs_vr(:,:,:) = spval @@ -6261,7 +6276,9 @@ subroutine col_cf_init(this, begc, endc, carbon_type) allocate(this%rr (begc:endc)) ; this%rr (:) = spval allocate(this%rr_vr(begc:endc,1:nlevdecomp_full)); this%rr_vr(:,:) = spval allocate(this%ar (begc:endc)) ; this%ar (:) = spval + allocate(this%ar_fates (begc:endc)) ; this%ar_fates (:) = spval allocate(this%gpp (begc:endc)) ; this%gpp (:) = spval + allocate(this%gpp_fates (begc:endc)) ; this%gpp_fates (:) = spval allocate(this%npp (begc:endc)) ; this%npp (:) = spval allocate(this%fire_closs_p2c (begc:endc)) ; this%fire_closs_p2c (:) = spval allocate(this%fire_closs (begc:endc)) ; this%fire_closs (:) = spval @@ -7981,6 +7998,13 @@ subroutine col_cf_setvalues ( this, num_column, filter_column, value_column) this%vegfire(i) = value_column this%wood_harvestc(i) = value_column this%hrv_xsmrpool_to_atm(i) = value_column + + ! Zero fates column fluxes + this%gpp_fates(i) = value_column + this%ar_fates(i) = value_column + this%grazing_loss_atm_fates(i)= value_column + this%fire_loss_atm_fates(i) = value_column + end do if(use_crop) then @@ -8034,13 +8058,17 @@ subroutine col_cf_zero_forfates_veg(this, bounds, num_soilc, filter_soilc) do fc = 1,num_soilc c = filter_soilc(fc) this%gpp(c) = 0._r8 + this%gpp_fates(c) = 0._r8 this%ar(c) = 0._r8 + this%ar_fates(c) = 0._r8 this%npp(c) = 0._r8 this%vegfire(c) = 0._r8 this%wood_harvestc(c) = 0._r8 this%fire_closs_p2c(c) = 0._r8 !this%litfall(c) = 0._r8 (overwritten) this%hrv_xsmrpool_to_atm(c) = 0._r8 + this%grazing_loss_atm_fates(c) = 0._r8 + this%fire_loss_atm_fates(c) = 0._r8 end do diff --git a/components/elm/src/external_models/fates b/components/elm/src/external_models/fates index 5869e048634d..ca12ac4a0ac3 160000 --- a/components/elm/src/external_models/fates +++ b/components/elm/src/external_models/fates @@ -1 +1 @@ -Subproject commit 5869e048634d9a4d71a71c6cb54bc1625fa8e487 +Subproject commit ca12ac4a0ac36e49bfc8175a70846d1a8475d4dd diff --git a/components/elm/src/main/elmfates_interfaceMod.F90 b/components/elm/src/main/elmfates_interfaceMod.F90 index b69ab053ea65..599ab4979880 100644 --- a/components/elm/src/main/elmfates_interfaceMod.F90 +++ b/components/elm/src/main/elmfates_interfaceMod.F90 @@ -38,8 +38,8 @@ module ELMFatesInterfaceMod use CanopyStateType , only : canopystate_type use TemperatureType , only : temperature_type use EnergyFluxType , only : energyflux_type - use SoilStateType , only : soilstate_type + use elm_varctl , only : iulog use elm_varctl , only : use_fates use elm_varctl , only : use_vertsoilc @@ -87,6 +87,7 @@ module ELMFatesInterfaceMod use elm_varpar , only : ivis use elm_varpar , only : inir use elm_varpar , only : nlevsoi + use elm_varpar , only : nlevgrnd use elm_varpar , only : nlevdecomp use elm_varpar , only : nlevdecomp_full use elm_varpar , only : i_met_lit, i_cel_lit, i_lig_lit @@ -1216,7 +1217,7 @@ subroutine dynamics_driv(this, bounds_clump, top_as_inst, & integer :: nc ! clump index integer :: nlevsoil ! number of soil layers at the site integer :: ier ! allocate status code - real(r8) :: s_node, smp_node ! local for relative water content and potential + real(r8) :: s_node ! local for relative water content and potential logical :: nitr_suppl,phos_suppl ! Is ELM currently supplementing N or P? real(r8), pointer :: lnfm24(:) ! 24-hour averaged lightning data real(r8), pointer :: gdp_lf_col(:) ! gdp data @@ -1290,17 +1291,6 @@ subroutine dynamics_driv(this, bounds_clump, top_as_inst, & end if nlevsoil = this%fates(nc)%bc_in(s)%nlevsoil - - ! Soil water - this%fates(nc)%bc_in(s)%h2o_liqvol_sl(1:nlevsoil) = & - col_ws%h2osoi_vol(c,1:nlevsoil) - - this%fates(nc)%bc_in(s)%max_rooting_depth_index_col = & - min(nlevsoil, canopystate_inst%altmax_lastyear_indx_col(c)) - - do j = 1,nlevsoil - this%fates(nc)%bc_in(s)%tempk_sl(j) = col_es%t_soisno(c,j) - end do call get_active_suction_layers(this%fates(nc)%nsites, & this%fates(nc)%sites, & @@ -1313,8 +1303,7 @@ subroutine dynamics_driv(this, bounds_clump, top_as_inst, & call soil_water_retention_curve%soil_suction(soilstate_inst%sucsat_col(c,j), & s_node, & soilstate_inst%bsw_col(c,j), & - smp_node) - this%fates(nc)%bc_in(s)%smp_sl(j) = smp_node + soilstate_inst%sucpot_col_fates(c,j)) end if end do @@ -1345,15 +1334,6 @@ subroutine dynamics_driv(this, bounds_clump, top_as_inst, & end do ! p end if ! SP - if(use_fates_planthydro)then - this%fates(nc)%bc_in(s)%hksat_sisl(1:nlevsoil) = soilstate_inst%hksat_col(c,1:nlevsoil) - this%fates(nc)%bc_in(s)%watsat_sisl(1:nlevsoil) = soilstate_inst%watsat_col(c,1:nlevsoil) - this%fates(nc)%bc_in(s)%watres_sisl(1:nlevsoil) = soilstate_inst%watmin_col(c,1:nlevsoil) - this%fates(nc)%bc_in(s)%sucsat_sisl(1:nlevsoil) = soilstate_inst%sucsat_col(c,1:nlevsoil) - this%fates(nc)%bc_in(s)%bsw_sisl(1:nlevsoil) = soilstate_inst%bsw_col(c,1:nlevsoil) - this%fates(nc)%bc_in(s)%h2o_liq_sisl(1:nlevsoil) = col_ws%h2osoi_liq(c,1:nlevsoil) - end if - ! get the harvest data, which is by gridcell ! for now there is one veg column per gridcell, so store all harvest data in each site ! this will eventually change @@ -1576,19 +1556,12 @@ subroutine wrap_update_hlmfates_dyn(this, nc, bounds_clump, & z0m => frictionvel_inst%z0m_patch , & ! Output: [real(r8) (:) ] momentum roughness length (m) displa => canopystate_inst%displa_patch, & dleaf_patch => canopystate_inst%dleaf_patch, & - snow_depth => col_ws%snow_depth, & frac_sno_eff => col_ws%frac_sno_eff, & frac_veg_nosno_alb => canopystate_inst%frac_veg_nosno_alb_patch) ! Process input boundary conditions to FATES ! -------------------------------------------------------------------------------- - do s=1,this%fates(nc)%nsites - c = this%f2hmap(nc)%fcolumn(s) - this%fates(nc)%bc_in(s)%snow_depth_si = snow_depth(c) - this%fates(nc)%bc_in(s)%frac_sno_eff_si = frac_sno_eff(c) - end do - ! Only update the fates internal snow burial if this is not a restart if (.not. is_initing_from_restart) then call UpdateFatesAvgSnowDepth(this%fates(nc)%sites,this%fates(nc)%bc_in) @@ -1978,7 +1951,7 @@ subroutine restart( this, bounds_proc, ncid, flag, & ! Register interface variables handled normally during cold start - call this%RegisterInterfaceVariablesColdStart(nc, canopystate_inst) + call this%RegisterInterfaceVariablesColdStart(nc, canopystate_inst, soilstate_inst) ! Update the interface variables call this%fates(nc)%UpdateInterfaceVariables(restarting=.true.) @@ -1989,8 +1962,6 @@ subroutine restart( this, bounds_proc, ncid, flag, & do s = 1,this%fates(nc)%nsites c = this%f2hmap(nc)%fcolumn(s) - this%fates(nc)%bc_in(s)%max_rooting_depth_index_col = & - min(this%fates(nc)%bc_in(s)%nlevsoil, canopystate_inst%altmax_lastyear_indx_col(c)) ! When restarting the model, this subroutine has several ! procedures that are incremental or don't need to be performed for @@ -2034,29 +2005,6 @@ subroutine restart( this, bounds_proc, ncid, flag, & ! ------------------------------------------------------------------------ if (use_fates_planthydro) then - do s = 1,this%fates(nc)%nsites - c = this%f2hmap(nc)%fcolumn(s) - nlevsoil = this%fates(nc)%bc_in(s)%nlevsoil - this%fates(nc)%bc_in(s)%hksat_sisl(1:nlevsoil) = & - soilstate_inst%hksat_col(c,1:nlevsoil) - - this%fates(nc)%bc_in(s)%watsat_sisl(1:nlevsoil) = & - soilstate_inst%watsat_col(c,1:nlevsoil) - - this%fates(nc)%bc_in(s)%watres_sisl(1:nlevsoil) = & - soilstate_inst%watmin_col(c,1:nlevsoil) - - this%fates(nc)%bc_in(s)%sucsat_sisl(1:nlevsoil) = & - soilstate_inst%sucsat_col(c,1:nlevsoil) - - this%fates(nc)%bc_in(s)%bsw_sisl(1:nlevsoil) = & - soilstate_inst%bsw_col(c,1:nlevsoil) - - this%fates(nc)%bc_in(s)%h2o_liq_sisl(1:nlevsoil) = & - col_ws%h2osoi_liq(c,1:nlevsoil) - - end do - call RestartHydrStates(this%fates(nc)%sites, & this%fates(nc)%nsites, & this%fates(nc)%bc_in, & @@ -2150,7 +2098,7 @@ subroutine init_coldstart(this, canopystate_inst, soilstate_inst, frictionvel_in if ( this%fates(nc)%nsites>0 ) then ! Register interface variables - call this%RegisterInterfaceVariablesColdStart(nc, canopystate_inst) + call this%RegisterInterfaceVariablesColdStart(nc, canopystate_inst, soilstate_inst) ! Update the interface variables call this%fates(nc)%UpdateInterfaceVariables(initialize=.true.) @@ -2196,24 +2144,6 @@ subroutine init_coldstart(this, canopystate_inst, soilstate_inst, frictionvel_in c = this%f2hmap(nc)%fcolumn(s) nlevsoil = this%fates(nc)%bc_in(s)%nlevsoil - this%fates(nc)%bc_in(s)%watsat_sisl(1:nlevsoil) = & - soilstate_inst%watsat_col(c,1:nlevsoil) - - this%fates(nc)%bc_in(s)%watres_sisl(1:nlevsoil) = & - soilstate_inst%watmin_col(c,1:nlevsoil) - - this%fates(nc)%bc_in(s)%sucsat_sisl(1:nlevsoil) = & - soilstate_inst%sucsat_col(c,1:nlevsoil) - - this%fates(nc)%bc_in(s)%bsw_sisl(1:nlevsoil) = & - soilstate_inst%bsw_col(c,1:nlevsoil) - - this%fates(nc)%bc_in(s)%h2o_liq_sisl(1:nlevsoil) = & - col_ws%h2osoi_liq(c,1:nlevsoil) - - this%fates(nc)%bc_in(s)%hksat_sisl(1:nlevsoil) = & - soilstate_inst%hksat_col(c,1:nlevsoil) - do j = 1, nlevsoil vol_ice = min(soilstate_inst%watsat_col(c,j), & col_ws%h2osoi_ice(c,j)/(col_pp%dz(c,j)*denice)) @@ -2258,8 +2188,6 @@ subroutine init_coldstart(this, canopystate_inst, soilstate_inst, frictionvel_in do s = 1,this%fates(nc)%nsites c = this%f2hmap(nc)%fcolumn(s) - this%fates(nc)%bc_in(s)%max_rooting_depth_index_col = this%fates(nc)%bc_in(s)%nlevdecomp - call ed_update_site(this%fates(nc)%sites(s), & this%fates(nc)%bc_in(s), & @@ -2443,7 +2371,7 @@ subroutine wrap_btran(this,bounds_clump,fn,filterc,soilstate_inst, & ! ! --------------------------------------------------------------------------------- - + use FatesInterfaceParametersMod, only: hlm_fates_soil_suction_potential implicit none @@ -2458,7 +2386,6 @@ subroutine wrap_btran(this,bounds_clump,fn,filterc,soilstate_inst, & class(soil_water_retention_curve_type), intent(in) :: soil_water_retention_curve ! local variables - real(r8) :: smp_node ! Soil suction potential, negative, [mm] real(r8) :: s_node integer :: s integer :: c @@ -2470,7 +2397,6 @@ subroutine wrap_btran(this,bounds_clump,fn,filterc,soilstate_inst, & associate(& sucsat => soilstate_inst%sucsat_col , & ! Input: [real(r8) (:,:) ] minimum soil suction (mm) - watsat => soilstate_inst%watsat_col , & ! Input: [real(r8) (:,:) ] volumetric soil water at saturation (porosity) bsw => soilstate_inst%bsw_col , & ! Input: [real(r8) (:,:) ] Clapp and Hornberger "b" eff_porosity => soilstate_inst%eff_porosity_col , & ! Input: [real(r8) (:,:) ] effective porosity = porosity - vol_ice t_soisno => col_es%t_soisno , & ! Input: [real(r8) (:,:) ] soil temperature (Kelvin) @@ -2508,25 +2434,16 @@ subroutine wrap_btran(this,bounds_clump,fn,filterc,soilstate_inst, & ! Check to see if this column is in the exposed veg filter if( any(filterc==c) )then - this%fates(nc)%bc_in(s)%filter_btran = .true. - do j = 1,nlevsoil - this%fates(nc)%bc_in(s)%tempk_sl(j) = t_soisno(c,j) - this%fates(nc)%bc_in(s)%h2o_liqvol_sl(j) = h2osoi_liqvol(c,j) - this%fates(nc)%bc_in(s)%eff_porosity_sl(j) = eff_porosity(c,j) - this%fates(nc)%bc_in(s)%watsat_sl(j) = watsat(c,j) - end do - else this%fates(nc)%bc_in(s)%filter_btran = .false. - this%fates(nc)%bc_in(s)%tempk_sl(:) = -999._r8 - this%fates(nc)%bc_in(s)%h2o_liqvol_sl(:) = -999._r8 - this%fates(nc)%bc_in(s)%eff_porosity_sl(:) = -999._r8 - this%fates(nc)%bc_in(s)%watsat_sl(:) = -999._r8 end if end do + ! Update the interface variables that work on the model time step now + call this%fates(nc)%UpdateInterfaceVariablesTimeStep() + ! ------------------------------------------------------------------------------- ! This function evaluates the ground layer to determine if ! root water uptake can happen, and soil suction should even @@ -2555,15 +2472,14 @@ subroutine wrap_btran(this,bounds_clump,fn,filterc,soilstate_inst, & call soil_water_retention_curve%soil_suction( soilstate_inst%sucsat_col(c,j), & s_node, & soilstate_inst%bsw_col(c,j), & - smp_node) - - ! Non-fates places a maximum (which is a negative upper bound) on smp - - this%fates(nc)%bc_in(s)%smp_sl(j) = smp_node + soilstate_inst%sucpot_col_fates(c,j)) end if end do end do + ! Update the soil suction potential interface variable only + call this%fates(nc)%UpdateInterfaceVariable(key=hlm_fates_soil_suction_potential) + ! ------------------------------------------------------------------------------- ! Suction and active uptake layers calculated, lets calculate uptake (btran) ! This will calculate internals, as well as output boundary conditions: @@ -2661,11 +2577,6 @@ subroutine wrap_photosynthesis(this, bounds_clump, fn, filterp, & c = this%f2hmap(nc)%fcolumn(s) t = col_pp%topounit(c) - nlevsoil = this%fates(nc)%bc_in(s)%nlevsoil - - do j = 1,nlevsoil - this%fates(nc)%bc_in(s)%t_soisno_sl(j) = t_soisno(c,j) ! soil temperature (Kelvin) - end do this%fates(nc)%bc_in(s)%forc_pbot = forc_pbot(t) ! atmospheric pressure (Pa) do ifp = 1, this%fates(nc)%sites(s)%youngest_patch%patchno @@ -2835,21 +2746,23 @@ subroutine wrap_FatesAtmosphericCarbonFluxes(this, bounds_clump, fc, filterc) nee => col_cf%nee , & nbp => col_cf%nbp , & product_closs => col_cf%product_closs , & - hr => col_cf%hr) - + hr => col_cf%hr, & + gpp_fates => col_cf%gpp_fates, & + ar_fates => col_cf%ar_fates, & + grazing_loss_atm_fates => col_cf%grazing_loss_atm_fates, & + fire_loss_atm_fates => col_cf%fire_loss_atm_fates) + nc = bounds_clump%clump_index ! Loop over columns do icc = 1,fc c = filterc(icc) s = this%f2hmap(nc)%hsites(c) - nep(c) = this%fates(nc)%bc_out(s)%gpp_site*g_per_kg & - - this%fates(nc)%bc_out(s)%ar_site*g_per_kg & - - hr(c) + nep(c) = gpp_fates(c) - ar_fates(c) - hr(c) nbp(c) = nep(c) & - - this%fates(nc)%bc_out(s)%grazing_closs_to_atm_si*g_per_kg & - - this%fates(nc)%bc_out(s)%fire_closs_to_atm_si*g_per_kg & + - grazing_loss_atm_fates(c) & + - fire_loss_atm_fates(c) & - product_closs(c) nee(c) = -nbp(c) @@ -2883,7 +2796,10 @@ subroutine wrap_FatesCarbonStocks(this, bounds_clump, fc, filterc) totecosysc => col_cs%totecosysc, & totlitc => col_cs%totlitc, & totsomc => col_cs%totsomc, & - totprodc => col_cs%totprodc) + totprodc => col_cs%totprodc, & + totvegc => col_cs%totvegc, & + litt_cwdc => col_cs%totlitc_cwd_fates, & + seedc => col_cs%seedc_fates) nc = bounds_clump%clump_index ! Loop over columns @@ -2892,9 +2808,8 @@ subroutine wrap_FatesCarbonStocks(this, bounds_clump, fc, filterc) s = this%f2hmap(nc)%hsites(c) totecosysc(c) = totsomc(c) + totlitc(c) + totprodc(c) + & - this%fates(nc)%bc_out(s)%veg_c_si + & - this%fates(nc)%bc_out(s)%litter_cwd_c_si + & - this%fates(nc)%bc_out(s)%seed_c_si + totvegc(c) + litt_cwdc(c) + seedc(c) + end do @@ -3141,13 +3056,8 @@ subroutine wrap_update_hifrq_hist(this, bounds_clump ) nc = bounds_clump%clump_index dtime = real(get_step_size(),r8) - ! Summarize Net Fluxes - do s = 1, this%fates(nc)%nsites - c = this%f2hmap(nc)%fcolumn(s) - this%fates(nc)%bc_in(s)%tot_het_resp = hr(c) - this%fates(nc)%bc_in(s)%tot_somc = totsomc(c) - this%fates(nc)%bc_in(s)%tot_litc = totlitc(c) - end do + ! Update model timestep (hifreq) interface variables for fates history + call this%fates(nc)%UpdateInterfaceVariablesTimeStep(update_history=.true.) ! Update history variables that track these variables call fates_hist%update_history_hifrq(nc, & @@ -3668,22 +3578,6 @@ subroutine wrap_hydraulics_drive(this, bounds_clump, & do s = 1, this%fates(nc)%nsites c = this%f2hmap(nc)%fcolumn(s) - nlevsoil = this%fates(nc)%bc_in(s)%nlevsoil - - this%fates(nc)%bc_in(s)%smpmin_si = & - soilstate_inst%smpmin_col(c) - this%fates(nc)%bc_in(s)%watsat_sisl(1:nlevsoil) = & - soilstate_inst%watsat_col(c,1:nlevsoil) - this%fates(nc)%bc_in(s)%watres_sisl(1:nlevsoil) = & - soilstate_inst%watmin_col(c,1:nlevsoil) - this%fates(nc)%bc_in(s)%sucsat_sisl(1:nlevsoil) = & - soilstate_inst%sucsat_col(c,1:nlevsoil) - this%fates(nc)%bc_in(s)%bsw_sisl(1:nlevsoil) = & - soilstate_inst%bsw_col(c,1:nlevsoil) - this%fates(nc)%bc_in(s)%h2o_liq_sisl(1:nlevsoil) = & - col_ws%h2osoi_liq(c,1:nlevsoil) - this%fates(nc)%bc_in(s)%eff_porosity_sl(1:nlevsoil) = & - soilstate_inst%eff_porosity_col(c,1:nlevsoil) do ifp = 1, this%fates(nc)%sites(s)%youngest_patch%patchno p = ifp+col_pp%pfti(c) @@ -4030,10 +3924,16 @@ subroutine RegisterInterfaceVariablesInit(this, nc) integer :: r ! Register index integer :: p ! HLM patch index integer :: c ! Column index + integer :: lb ! Local lower bounds logical :: is_bareground ! Is this register associated with a bareground patch logical :: is_first ! Is this register associated with the first patch on the column, landunit, etc ! This is necessary to ensure that accumulation variables are zero'd properly + ! Set the local lower bound to be one. This is a workaround to address the fact that + ! some HLM arrays have lower bounds that are less than 1, but fates does not currently + ! use these lower bounds. + lb = 1 + ! Iterate over the number of vegetated patches do r = 1, this%fates(nc)%npatches p = this%fates(nc)%registry(r)%GetHLMPatchIndex() @@ -4053,6 +3953,8 @@ subroutine RegisterInterfaceVariablesInit(this, nc) ! Register and initialize the boundary condition variables ! Global variables + call this%fates(nc)%registry(r)%Register(key=hlm_fates_nlevground, & + data=nlevgrnd, hlm_flag=.true.) call this%fates(nc)%registry(r)%Register(key=hlm_fates_decomp, & data=nlevdecomp, hlm_flag=.true.) call this%fates(nc)%registry(r)%Register(key=hlm_fates_decomp_max, & @@ -4071,6 +3973,9 @@ subroutine RegisterInterfaceVariablesInit(this, nc) end if ! Variables that do not need to accumulate + call this%fates(nc)%registry(r)%Register(key=hlm_fates_heterotrophic_respiration, & + data=col_cf%hr(c), hlm_flag=.true., & + subgrid_type=registry_var_intid_column) call this%fates(nc)%registry(r)%Register(key=hlm_fates_soil_level, & data=col_pp%nlevbed(c), hlm_flag=.true., & subgrid_type=registry_var_intid_column) @@ -4080,6 +3985,40 @@ subroutine RegisterInterfaceVariablesInit(this, nc) call this%fates(nc)%registry(r)%Register(key=hlm_fates_decomp_frac_temperature, & data=col_cf%t_scalar(c,:), hlm_flag=.true., & subgrid_type=registry_var_intid_column) + call this%fates(nc)%registry(r)%Register(key=hlm_fates_snow_depth, & + data=col_ws%snow_depth(c), hlm_flag=.true., & + subgrid_type=registry_var_intid_column) + call this%fates(nc)%registry(r)%Register(key=hlm_fates_snow_cover_frac, & + data=col_ws%frac_sno_eff(c), hlm_flag=.true., & + subgrid_type=registry_var_intid_column) + call this%fates(nc)%registry(r)%Register(key=hlm_fates_soil_h2o_liquid, & + data=col_ws%h2osoi_liqvol(c,lb:), hlm_flag=.true., & + subgrid_type=registry_var_intid_column) + call this%fates(nc)%registry(r)%Register(key=hlm_fates_soil_temperature, & + data=col_es%t_soisno(c,lb:), hlm_flag=.true., & + subgrid_type=registry_var_intid_column) + call this%fates(nc)%registry(r)%Register(key=hlm_fates_veg_carbon_total, & + data=col_cs%totvegc(c), hlm_flag=.true., & + subgrid_type=registry_var_intid_column) + call this%fates(nc)%registry(r)%Register(key=hlm_fates_litter_cwd_carbon_total, & + data=col_cs%totlitc_cwd_fates(c), hlm_flag=.true., & + subgrid_type=registry_var_intid_column) + call this%fates(nc)%registry(r)%Register(key=hlm_fates_seed_carbon_total, & + data=col_cs%seedc_fates(c), hlm_flag=.true., & + subgrid_type=registry_var_intid_column) + + if(trim(nu_com)=='ECA') then + call this%fates(nc)%registry(r)%Register(key=hlm_fates_decomposer_biomass, & + data=col_cs%decompmicc_fates(c,:), hlm_flag=.true., & + subgrid_type=registry_var_intid_column) + end if + + ! Register variables related to plant hydraulics if necessary + if (use_fates_planthydro) then + call this%fates(nc)%registry(r)%Register(key=hlm_fates_liquid_water, & + data=col_ws%h2osoi_liq(c,lb:), hlm_flag=.true., & + subgrid_type=registry_var_intid_column) + end if ! Variables that need to accumulate call this%fates(nc)%registry(r)%Register(key=hlm_fates_litter_carbon_cellulose, & @@ -4094,6 +4033,21 @@ subroutine RegisterInterfaceVariablesInit(this, nc) data=col_cf%decomp_cpools_sourcesink(c,1:nlevdecomp,i_met_lit), & hlm_flag=.true., accumulate=.true., & subgrid_type=registry_var_intid_column) + call this%fates(nc)%registry(r)%Register(key=hlm_fates_gpp, data=col_cf%gpp_fates(c), & + hlm_flag=.true., accumulate=.true., & + subgrid_type=registry_var_intid_column) + call this%fates(nc)%registry(r)%Register(key=hlm_fates_ar, data=col_cf%ar_fates(c), & + hlm_flag=.true., accumulate=.true., & + subgrid_type=registry_var_intid_column) + call this%fates(nc)%registry(r)%Register(key=hlm_fates_grazing_loss_atm, & + data=col_cf%grazing_loss_atm_fates(c), & + hlm_flag=.true., accumulate=.true., & + subgrid_type=registry_var_intid_column) + call this%fates(nc)%registry(r)%Register(key=hlm_fates_fire_loss_atm, & + data=col_cf%fire_loss_atm_fates(c), & + hlm_flag=.true., accumulate=.true., & + subgrid_type=registry_var_intid_column) + ! Pass is_first option to assure HLM updates are zero'd call this%fates(nc)%registry(r)%Register(key=hlm_fates_litter_carbon_total, & @@ -4144,18 +4098,19 @@ subroutine RegisterInterfaceVariablesInit(this, nc) subgrid_type=registry_var_intid_column) end if end do - + end subroutine RegisterInterfaceVariablesInit ! ====================================================================================== -subroutine RegisterInterfaceVariablesColdStart(this, nc, canopystate_inst) +subroutine RegisterInterfaceVariablesColdStart(this, nc, canopystate_inst, soilstate_inst) - use FatesInterfaceParametersMod, only : hlm_fates_thaw_max_depth_index + use FatesInterfaceParametersMod class(hlm_fates_interface_type), intent(inout) :: this integer, intent(in) :: nc type(canopystate_type), intent(inout) :: canopystate_inst + type(soilstate_type), intent(inout) :: soilstate_inst ! Locals integer :: r ! register index @@ -4168,7 +4123,45 @@ subroutine RegisterInterfaceVariablesColdStart(this, nc, canopystate_inst) c = this%fates(nc)%registry(r)%GetColumnIndex() call this%fates(nc)%registry(r)%Register(key=hlm_fates_thaw_max_depth_index, & - data=canopystate_inst%altmax_lastyear_indx_col(c), hlm_flag=.true.) + data=canopystate_inst%altmax_lastyear_indx_col(c), & + hlm_flag=.true., & + subgrid_type=registry_var_intid_column) + call this%fates(nc)%registry(r)%Register(key=hlm_fates_effective_porosity, & + data=soilstate_inst%eff_porosity_col(c,:), & + hlm_flag=.true., & + subgrid_type=registry_var_intid_column) + call this%fates(nc)%registry(r)%Register(key=hlm_fates_soil_water_saturation, & + data=soilstate_inst%watsat_col(c,:), & + hlm_flag=.true., & + subgrid_type=registry_var_intid_column) + call this%fates(nc)%registry(r)%Register(key=hlm_fates_soil_suction_potential, & + data=soilstate_inst%sucpot_col_fates(c,:), & + hlm_flag=.true., & + subgrid_type=registry_var_intid_column) + + if (use_fates_planthydro) then + call this%fates(nc)%registry(r)%Register(key=hlm_fates_soil_potential_min, & + data=soilstate_inst%smpmin_col(c), & + hlm_flag=.true., & + subgrid_type=registry_var_intid_column) + call this%fates(nc)%registry(r)%Register(key=hlm_fates_soil_saturated_hydr_cond, & + data=soilstate_inst%hksat_col(c,:), & + hlm_flag=.true., & + subgrid_type=registry_var_intid_column) + call this%fates(nc)%registry(r)%Register(key=hlm_fates_soil_clapp_hornberger_b, & + data=soilstate_inst%bsw_col(c,:), & + hlm_flag=.true., & + subgrid_type=registry_var_intid_column) + call this%fates(nc)%registry(r)%Register(key=hlm_fates_soil_suction_min, & + data=soilstate_inst%sucsat_col(c,:), & + hlm_flag=.true., & + subgrid_type=registry_var_intid_column) + call this%fates(nc)%registry(r)%Register(key=hlm_fates_soil_water_vol_min, & + data=soilstate_inst%watmin_col(c,:), & + hlm_flag=.true., & + subgrid_type=registry_var_intid_column) + end if + end do end subroutine RegisterInterfaceVariablesColdStart