From 751490c7373ac7a50303186b03bdcd04803cce7d Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Mon, 18 Oct 2021 14:39:51 -0400 Subject: [PATCH 01/55] Setting target_m to dummy value to overcome IBM issues with base functions not setting output result --- parteh/PRTGenericMod.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/parteh/PRTGenericMod.F90 b/parteh/PRTGenericMod.F90 index 76d0e01eda..3dab9563a3 100644 --- a/parteh/PRTGenericMod.F90 +++ b/parteh/PRTGenericMod.F90 @@ -1396,6 +1396,8 @@ function GetNutrientTargetBase(this,element_id,organ_id,stoich_mode) result(targ integer, intent(in),optional :: stoich_mode real(r8) :: target_m ! Target amount of nutrient for this organ [kg] + target_m = 0._r8 + write(fates_log(),*)'GetNutrientTargetBase must be extended by a child class.' call endrun(msg=errMsg(sourcefile, __LINE__)) From 9563af17d08f7153ff75040ff676fd9ed1fa5b0e Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 28 Oct 2021 15:07:40 -0400 Subject: [PATCH 02/55] NCLMax = 3 --- main/EDTypesMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 5da7babc54..ad1c6668c9 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -30,7 +30,7 @@ module EDTypesMod (/ 10, 4 /) !!! MUST SUM TO maxPatchesPerSite !!! integer, public :: maxCohortsPerPatch = 100 ! maximum number of cohorts per patch - integer, parameter, public :: nclmax = 2 ! Maximum number of canopy layers + integer, parameter, public :: nclmax = 3 ! Maximum number of canopy layers integer, parameter, public :: ican_upper = 1 ! Nominal index for the upper canopy integer, parameter, public :: ican_ustory = 2 ! Nominal index for diagnostics that refer ! to understory layers (all layers that From 7191021a890cba1e8ee002e96c603819e8d88246 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Sat, 30 Oct 2021 13:13:08 -0400 Subject: [PATCH 03/55] Added nutrient storage limit and derivative to test effects on stature growth --- parteh/PRTAllometricCNPMod.F90 | 139 +++++++++++++-------------------- 1 file changed, 53 insertions(+), 86 deletions(-) diff --git a/parteh/PRTAllometricCNPMod.F90 b/parteh/PRTAllometricCNPMod.F90 index 5617d71e5d..85bc11aa3e 100644 --- a/parteh/PRTAllometricCNPMod.F90 +++ b/parteh/PRTAllometricCNPMod.F90 @@ -167,6 +167,9 @@ module PRTAllometricCNPMod integer, parameter :: num_bc_out = 5 ! Total number of + + real(r8), parameter :: min_stf_growth = 0.9_r8 ! Plants are only allowed to increase in stature + ! if they have more than 90% of their stores full ! ------------------------------------------------------------------------------------- @@ -374,6 +377,14 @@ subroutine DailyPRTAllometricCNP(this) real(r8) :: p_gain0 real(r8) :: maint_r_def0 + ! Knowing the stored N and P helps + ! to identify if the plant is net + ! gaining nutrients after replacement + real(r8) :: n_store0 + real(r8) :: p_store0 + real(r8) :: net_n_gain + real(r8) :: net_p_gain + ! Used for mass checking, total mass allocated based ! on change in the states, should match gain0's real(r8) :: allocated_c @@ -470,10 +481,12 @@ subroutine DailyPRTAllometricCNP(this) i_var = prt_global%sp_organ_map(store_organ,nitrogen_element) n_gain = n_gain + sum(this%variables(i_var)%val(:)) + net_n_gain = - sum(this%variables(i_var)%val(:)) this%variables(i_var)%val(:) = 0._r8 i_var = prt_global%sp_organ_map(store_organ,phosphorus_element) p_gain = p_gain + sum(this%variables(i_var)%val(:)) + net_p_gain = - sum(this%variables(i_var)%val(:)) this%variables(i_var)%val(:) = 0._r8 ! =================================================================================== @@ -484,6 +497,7 @@ subroutine DailyPRTAllometricCNP(this) call this%CNPPrioritizedReplacement(maint_r_def, c_gain, n_gain, p_gain, & state_c, state_n, state_p, target_c) + sum_c = 0._r8 do i_org = 1,num_organs sum_c = sum_c+state_c(i_org)%ptr @@ -504,8 +518,12 @@ subroutine DailyPRTAllometricCNP(this) ! Attempts have been made to get all pools and species closest to allometric ! targets based on prioritized relative demand and allometry functions. ! =================================================================================== + + net_n_gain = net_n_gain + n_gain + net_p_gain = net_p_gain + p_gain - call this%CNPStatureGrowth(c_gain, n_gain, p_gain, & + call this%CNPStatureGrowth(c_gain, n_gain, p_gain, & + net_n_gain, net_p_gain, & state_c, state_n, state_p, target_c, target_dcdd, cnp_limiter) sum_c = 0._r8 @@ -626,7 +644,7 @@ subroutine CNPPrioritizedReplacement(this, & real(r8), intent(inout) :: c_gain real(r8), intent(inout) :: n_gain real(r8), intent(inout) :: p_gain - real(r8), intent(inout) :: maint_r_deficit + real(r8), intent(inout) :: maint_r_deficit ! Not currently used type(parray_type) :: state_c(:) ! State array for carbon, by organ [kg] type(parray_type) :: state_n(:) ! State array for N, by organ [kg] type(parray_type) :: state_p(:) ! State array for P, by organ [kg] @@ -989,16 +1007,21 @@ end subroutine CNPPrioritizedReplacement ! ===================================================================================== - subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & + subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, net_n_gain, net_p_gain, & state_c, state_n, state_p, & target_c, target_dcdd, cnp_limiter) class(cnp_allom_prt_vartypes) :: this - real(r8), intent(inout) :: c_gain - real(r8), intent(inout) :: n_gain - real(r8), intent(inout) :: p_gain - real(r8), pointer :: maint_r_deficit + real(r8), intent(inout) :: c_gain ! Total daily C gain that remains to be used + real(r8), intent(inout) :: n_gain ! Total N available for allocation + ! (new uptake + storage) + real(r8), intent(inout) :: p_gain ! Total P available for allocation + ! (new uptake + storage) + real(r8), intent(in) :: net_n_gain ! How much N was gained or lost in the + ! process of net uptake and turnover replacment + real(r8), intent(in) :: net_p_gain ! How much P was gained or lost in the + ! process of net uptake and turnover replacment type(parray_type) :: state_c(:) ! State array for carbon, by organ [kg] type(parray_type) :: state_n(:) ! State array for N, by organ [kg] type(parray_type) :: state_p(:) ! State array for P, by organ [kg] @@ -1028,6 +1051,8 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & real(r8) :: sum_c_flux ! Sum of the carbon allocated, as reported ! by the ODE solver. [kg] real(r8) :: np_limit + real(r8) :: n_stf ! nitrogen storage target fraction (stf) [-] + real(r8) :: p_stf ! phosphorus storage target fraction (stf) [-] real(r8) :: n_match real(r8) :: p_match real(r8) :: c_flux_adj ! Adjustment to total carbon flux during stature growth @@ -1086,6 +1111,7 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & integer, parameter :: c_limited = 1 integer, parameter :: n_limited = 2 integer, parameter :: p_limited = 3 + leaf_status = this%bc_in(acnp_bc_in_id_lstat)%ival dbh => this%bc_inout(acnp_bc_inout_id_dbh)%rval @@ -1101,11 +1127,21 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & ! a plant had a productive last day before the phenology scheme ! signaled a drop. If this is the case, we can't grow stature ! cause that would force the leaves back on, so just leave. + + + target_n = this%GetNutrientTarget(nitrogen_element,store_organ,stoich_growth_min) + n_stf = max(state_n(store_id)%ptr/target_n,0._r8) + + target_p = this%GetNutrientTarget(phosphorus_element,store_organ,stoich_growth_min) + p_stf = max(state_p(store_id)%ptr/target_p,0._r8) - if( c_gain <= calloc_abs_error .or. & - n_gain <= 0.1_r8*calloc_abs_error .or. & - p_gain <= 0.02_r8*calloc_abs_error .or. & - leaf_status.eq.leaves_off ) then + if( c_gain <= calloc_abs_error .or. & + net_n_gain < 0._r8 .or. & + net_p_gain < 0._r8 .or. & + leaf_status.eq.leaves_off .or. & + n_stf < min_stf_growth .or. & + p_stf < min_stf_growth & + ) then return end if @@ -1230,82 +1266,13 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & end if end if - - select case(grow_lim_type) - case(1) - - - ! Calculate an approximation of the total amount of carbon that would be needed - ! to match the amount of each nutrient used. We also add in the amount of nutrient - ! that may or may-not exist above each pool's minimum stoichiometry... - ! -------------------------------------------------------------------------------- - - grow_c_from_c = 0._r8 - grow_c_from_n = 0._r8 - grow_c_from_p = 0._r8 - do ii = 1, n_mask_organs - i = mask_organs(ii) - if(organ_list(i).ne.store_organ)then - call this%GrowEquivC(c_gain,n_gain,p_gain, & - frac_c(i),ipft,organ_list(i), & - grow_c_from_c,grow_c_from_n,grow_c_from_p) - end if - end do - - ! -------------------------------------------------------------------------------- - ! We limit growth to align with the species would motivate the least flux of - ! carbon into growing tissues to match. This is only an approximation of how much - ! growth we get out of each, and they don't have to be perfect. As long as we - ! don't use more carbon than we have (we wont) and if we use the actual numerical - ! integrator in the trasfer step, the nutrients will be transferred linearly in - ! the next step. if they dip slightly above or below their target allometries, - ! its no big deal. - ! -------------------------------------------------------------------------------- - - if(grow_c_from_c > nearzero) then - c_gstature = c_gain * min(grow_c_from_c, grow_c_from_n, grow_c_from_p)/grow_c_from_c - else - write(fates_log(),*) 'Somehow grow_c_from_c is near zero',grow_c_from_c - call endrun(msg=errMsg(sourcefile, __LINE__)) - end if - case(2) - - n_match = 0._r8 - p_match = 0._r8 - do ii = 1, n_mask_organs - i = mask_organs(ii) - if(organ_list(i).ne.store_organ)then - call this%NAndPToMatchC(c_gain*frac_c(i),target_dcdd(i), & - ipft,organ_list(i),n_match,p_match) - end if - end do - - np_limit = min(min(1._r8, n_gain/n_match), min(1._r8, p_gain/p_match)) - - if( (n_gain/n_match)>1._r8 .and. (p_gain/p_match)>1._r8 ) then - cnp_limiter = c_limited - else - if( n_gain/n_match < p_gain/p_match ) then - cnp_limiter = n_limited - else - cnp_limiter = p_limited - end if - end if - - c_gstature = c_gain * np_limit - - case(3) - - ! No mathematical co-limitation of growth - ! This assumes that limitations will prevent - ! organs from allowing the growth step to even occur - ! and thus from an algorithmic level limit growth - - c_gstature = c_gain - - - end select + ! No mathematical co-limitation of growth + ! This assumes that limitations will prevent + ! organs from allowing the growth step to even occur + ! and thus from an algorithmic level limit growth + + c_gstature = c_gain if_stature_growth: if(c_gstature > nearzero) then From 949e9caddbbf826042cea64fd8bdc90afb5e152e Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Wed, 3 Nov 2021 16:11:38 -0400 Subject: [PATCH 04/55] fixed logic limiting growth --- parteh/PRTAllometricCNPMod.F90 | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) diff --git a/parteh/PRTAllometricCNPMod.F90 b/parteh/PRTAllometricCNPMod.F90 index 85bc11aa3e..30b3ad71c2 100644 --- a/parteh/PRTAllometricCNPMod.F90 +++ b/parteh/PRTAllometricCNPMod.F90 @@ -1136,12 +1136,9 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, net_n_gain, net_p_gain, p_stf = max(state_p(store_id)%ptr/target_p,0._r8) if( c_gain <= calloc_abs_error .or. & - net_n_gain < 0._r8 .or. & - net_p_gain < 0._r8 .or. & leaf_status.eq.leaves_off .or. & - n_stf < min_stf_growth .or. & - p_stf < min_stf_growth & - ) then + (n_stf < min_stf_growth .and. net_n_gain < 0._r8) .or. & + (p_stf < min_stf_growth .and. net_p_gain < 0._r8) ) then return end if From 5084a1da2a9852cdc238db5e3009170dec79eb78 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 4 Nov 2021 10:51:35 -0400 Subject: [PATCH 05/55] Adjusted growth restrictions and uptake downregulation so that downregulation would not occur at nutrient storage fractions less than the growth cutoff. --- biogeochem/FatesSoilBGCFluxMod.F90 | 6 +++--- parteh/PRTAllometricCNPMod.F90 | 8 ++++---- 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/biogeochem/FatesSoilBGCFluxMod.F90 b/biogeochem/FatesSoilBGCFluxMod.F90 index 9f210e8404..9815af8096 100644 --- a/biogeochem/FatesSoilBGCFluxMod.F90 +++ b/biogeochem/FatesSoilBGCFluxMod.F90 @@ -1185,13 +1185,13 @@ function ECACScalar(ccohort, element_id) result(c_scalar) integer, parameter :: downreg_type = downreg_linear - real(r8), parameter :: logi_k = 25.0_r8 ! logistic function k - real(r8), parameter :: store_x0 = 1.0_r8 ! storage fraction inflection point + real(r8), parameter :: logi_k = 30.0_r8 ! logistic function k + real(r8), parameter :: store_x0 = 0.9_r8 ! storage fraction inflection point real(r8), parameter :: logi_min = 0.0_r8 ! minimum cn_scalar for logistic ! This is the storage fraction where downregulation starts if using ! a linear function - real(r8), parameter :: store_frac0 = 0.5_r8 + real(r8), parameter :: store_frac0 = 0.85_r8 real(r8), parameter :: c_max = 1.0_r8 real(r8), parameter :: c_min = 1.e-3_r8 diff --git a/parteh/PRTAllometricCNPMod.F90 b/parteh/PRTAllometricCNPMod.F90 index 30b3ad71c2..3d5eb85b61 100644 --- a/parteh/PRTAllometricCNPMod.F90 +++ b/parteh/PRTAllometricCNPMod.F90 @@ -168,8 +168,8 @@ module PRTAllometricCNPMod - real(r8), parameter :: min_stf_growth = 0.9_r8 ! Plants are only allowed to increase in stature - ! if they have more than 90% of their stores full + real(r8), parameter :: min_stf_growth = 0.8_r8 ! Plants are only allowed to increase in stature + ! if they have more than 80% of their stores full ! ------------------------------------------------------------------------------------- @@ -1137,8 +1137,8 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, net_n_gain, net_p_gain, if( c_gain <= calloc_abs_error .or. & leaf_status.eq.leaves_off .or. & - (n_stf < min_stf_growth .and. net_n_gain < 0._r8) .or. & - (p_stf < min_stf_growth .and. net_p_gain < 0._r8) ) then + (n_stf < min_stf_growth ) .or. & !.and. net_n_gain < 0._r8) .or. & + (p_stf < min_stf_growth ) ) then !.and. net_p_gain < 0._r8) ) then return end if From 760e8705b7dc9170ea35343237fd1c78d10b071c Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Sat, 6 Nov 2021 10:00:10 -0400 Subject: [PATCH 06/55] First complete pass-through on having a dynamic root response to nutrient storage --- biogeochem/EDCohortDynamicsMod.F90 | 22 ++- biogeochem/EDPhysiologyMod.F90 | 5 +- biogeochem/FatesAllometryMod.F90 | 61 ++---- biogeochem/FatesSoilBGCFluxMod.F90 | 105 +--------- main/EDInitMod.F90 | 12 +- main/EDTypesMod.F90 | 9 + main/FatesInventoryInitMod.F90 | 5 +- parameter_files/fates_params_default.cdl | 13 +- parteh/PRTAllometricCNPMod.F90 | 239 ++++++++++++++++++++--- parteh/PRTAllometricCarbonMod.F90 | 20 +- parteh/PRTParametersMod.F90 | 5 +- parteh/PRTParamsFATESMod.F90 | 19 +- 12 files changed, 315 insertions(+), 200 deletions(-) diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index b6714ee3e9..341cf3c836 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -90,6 +90,7 @@ module EDCohortDynamicsMod use PRTAllometricCNPMod, only : cnp_allom_prt_vartypes use PRTAllometricCNPMod, only : acnp_bc_in_id_pft, acnp_bc_in_id_ctrim use PRTAllometricCNPMod, only : acnp_bc_in_id_lstat, acnp_bc_inout_id_dbh + use PRTAllometricCNPMod, only : acnp_bc_inout_id_l2fr use PRTAllometricCNPMod, only : acnp_bc_inout_id_rmaint_def, acnp_bc_in_id_netdc use PRTAllometricCNPMod, only : acnp_bc_in_id_netdnh4, acnp_bc_in_id_netdno3, acnp_bc_in_id_netdp use PRTAllometricCNPMod, only : acnp_bc_out_id_cefflux, acnp_bc_out_id_nefflux @@ -236,6 +237,16 @@ subroutine create_cohort(currentSite, patchptr, pft, nn, hite, coage, dbh, & new_cohort%sapwmemory = sapwmemory new_cohort%structmemory = structmemory + ! Initialize the leaf to fineroot biomass ratio + ! for C-only, this will stay constant, for nutrient enabled + ! this will be dynamic. In both cases, new cohorts are + ! initialized with the minimum. This works in the nutrient + ! enabled case, because cohorts are also initialized with + ! full stores, which match with minimum fr biomass + + new_cohort%l2fr = prt_params%allom_l2fr_min(pft) + + ! This sets things like vcmax25top, that depend on the ! leaf age fractions (which are defined by PARTEH) call UpdateCohortBioPhysRates(new_cohort) @@ -393,7 +404,7 @@ subroutine InitPRTBoundaryConditions(new_cohort) call new_cohort%prt%RegisterBCIn(ac_bc_in_id_pft,bc_ival = new_cohort%pft) call new_cohort%prt%RegisterBCIn(ac_bc_in_id_ctrim,bc_rval = new_cohort%canopy_trim) call new_cohort%prt%RegisterBCIn(ac_bc_in_id_lstat,bc_ival = new_cohort%status_coh) - + case (prt_cnp_flex_allom_hyp) call new_cohort%prt%RegisterBCIn(acnp_bc_in_id_pft,bc_ival = new_cohort%pft) @@ -406,6 +417,7 @@ subroutine InitPRTBoundaryConditions(new_cohort) call new_cohort%prt%RegisterBCInOut(acnp_bc_inout_id_dbh,bc_rval = new_cohort%dbh) call new_cohort%prt%RegisterBCInOut(acnp_bc_inout_id_rmaint_def,bc_rval = new_cohort%resp_m_def) + call new_cohort%prt%RegisterBCInOut(acnp_bc_inout_id_l2fr,bc_rval = new_cohort%l2fr) call new_cohort%prt%RegisterBCOut(acnp_bc_out_id_cefflux, bc_rval = new_cohort%daily_c_efflux) call new_cohort%prt%RegisterBCOut(acnp_bc_out_id_nefflux, bc_rval = new_cohort%daily_n_efflux) @@ -1173,7 +1185,10 @@ subroutine fuse_cohorts(currentSite, currentPatch, bc_in) ! Leaf biophysical rates (use leaf mass weighting) ! ----------------------------------------------------------------- call UpdateCohortBioPhysRates(currentCohort) - + + currentCohort%l2fr = (currentCohort%n*currentCohort%l2fr& + + nextc%n*nextc%l2fr)/newn + currentCohort%laimemory = (currentCohort%n*currentCohort%laimemory & + nextc%n*nextc%laimemory)/newn @@ -1788,7 +1803,8 @@ subroutine copy_cohort( currentCohort,copyc ) n%coage_by_pft_class = o%coage_by_pft_class ! This transfers the PRT objects over. call n%prt%CopyPRTVartypes(o%prt) - + n%l2fr = o%l2fr + ! Leaf biophysical rates n%vcmax25top = o%vcmax25top n%jmax25top = o%jmax25top diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index fe184dd343..c7e0515f39 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -482,7 +482,7 @@ subroutine trim_canopy( currentSite ) if ( int(prt_params%allom_fmode(ipft)) .eq. 1 ) then ! only query fine root biomass if using a fine root allometric model that takes leaf trim into account - call bfineroot(currentcohort%dbh,ipft,currentcohort%canopy_trim,tar_bfr) + call bfineroot(currentcohort%dbh,ipft,currentcohort%canopy_trim,currentcohort%l2fr,tar_bfr) bfr_per_bleaf = tar_bfr/tar_bl endif @@ -1625,13 +1625,14 @@ subroutine recruitment( currentSite, currentPatch, bc_in ) temp_cohort%pft = ft temp_cohort%hite = EDPftvarcon_inst%hgt_min(ft) temp_cohort%coage = 0.0_r8 + temp_cohort%l2fr = prt_params%allom_l2fr_min(ft) stem_drop_fraction = EDPftvarcon_inst%phen_stem_drop_fraction(ft) call h2d_allom(temp_cohort%hite,ft,temp_cohort%dbh) ! Initialize live pools call bleaf(temp_cohort%dbh,ft,temp_cohort%canopy_trim,c_leaf) - call bfineroot(temp_cohort%dbh,ft,temp_cohort%canopy_trim,c_fnrt) + call bfineroot(temp_cohort%dbh,ft,temp_cohort%canopy_trim,temp_cohort%l2fr,c_fnrt) call bsap_allom(temp_cohort%dbh,ft,temp_cohort%canopy_trim,a_sapw, c_sapw) call bagw_allom(temp_cohort%dbh,ft,c_agw) call bbgw_allom(temp_cohort%dbh,ft,c_bgw) diff --git a/biogeochem/FatesAllometryMod.F90 b/biogeochem/FatesAllometryMod.F90 index 8e27faae22..0012d1b735 100644 --- a/biogeochem/FatesAllometryMod.F90 +++ b/biogeochem/FatesAllometryMod.F90 @@ -156,7 +156,7 @@ module FatesAllometryMod ! ============================================================================ - subroutine CheckIntegratedAllometries(dbh,ipft,canopy_trim, & + subroutine CheckIntegratedAllometries(dbh,ipft,canopy_trim,l2fr, & bl,bfr,bsap,bstore,bdead, & grow_leaf, grow_fr, grow_sap, grow_store, grow_dead, & max_err, l_pass) @@ -172,6 +172,7 @@ subroutine CheckIntegratedAllometries(dbh,ipft,canopy_trim, & real(r8),intent(in) :: dbh ! diameter of plant [cm] integer,intent(in) :: ipft ! plant functional type index real(r8),intent(in) :: canopy_trim ! trimming function + real(r8),intent(in) :: l2fr ! leaf to fine-root biomass multiplier (fr/leaf) real(r8),intent(in) :: bl ! integrated leaf biomass [kgC] real(r8),intent(in) :: bfr ! integrated fine root biomass [kgC] real(r8),intent(in) :: bsap ! integrated sapwood biomass [kgC] @@ -215,7 +216,7 @@ subroutine CheckIntegratedAllometries(dbh,ipft,canopy_trim, & end if if (grow_fr) then - call bfineroot(dbh,ipft,canopy_trim,bfr_diag) + call bfineroot(dbh,ipft,canopy_trim,l2fr,bfr_diag) if( abs(bfr_diag-bfr) > max_err ) then if(verbose_logging) then write(fates_log(),*) 'disparity in integrated/diagnosed fineroot carbon' @@ -860,18 +861,22 @@ end subroutine bbgw_allom ! Fine root biomass allometry wrapper ! ============================================================================ - subroutine bfineroot(d,ipft,canopy_trim,bfr,dbfrdd) + subroutine bfineroot(d,ipft,canopy_trim,l2fr,bfr,dbfrdd) ! ------------------------------------------------------------------------- ! This subroutine calculates the actual target fineroot biomass ! based on functions that may or may not have prognostic properties. ! ------------------------------------------------------------------------- - real(r8),intent(in) :: d ! plant diameter [cm] - integer(i4),intent(in) :: ipft ! PFT index - real(r8),intent(in) :: canopy_trim ! trimming function - real(r8),intent(out) :: bfr ! fine root biomass [kgC] - real(r8),intent(out),optional :: dbfrdd ! change leaf bio per diameter [kgC/cm] + real(r8),intent(in) :: d ! plant diameter [cm] + integer(i4),intent(in) :: ipft ! PFT index + real(r8),intent(in) :: canopy_trim ! trimming function + real(r8),intent(in) :: l2fr ! leaf to fineroot scaler + ! this is either a PFT parameter + ! constant (when no nutrient model) + ! or dynamic (with nutrient model) + real(r8),intent(out) :: bfr ! fine root biomass [kgC] + real(r8),intent(out),optional :: dbfrdd ! change leaf bio per diameter [kgC/cm] real(r8) :: blmax ! maximum leaf biomss per allometry real(r8) :: dblmaxdd @@ -883,18 +888,20 @@ subroutine bfineroot(d,ipft,canopy_trim,bfr,dbfrdd) case(1) ! "constant proportionality with TRIMMED target bleaf" call blmax_allom(d,ipft,blmax,dblmaxdd) - call bfrmax_const(d,blmax,dblmaxdd,ipft,bfrmax,dbfrmaxdd) - bfr = bfrmax * canopy_trim + + bfr = blmax*l2fr*canopy_trim + if(present(dbfrdd))then - dbfrdd = dbfrmaxdd * canopy_trim + dbfrdd = dblmaxdd*l2fr * canopy_trim + end if case(2) ! "constant proportionality with UNTRIMMED target bleaf" call blmax_allom(d,ipft,blmax,dblmaxdd) - call bfrmax_const(d,blmax,dblmaxdd,ipft,bfrmax,dbfrmaxdd) - bfr = bfrmax + + bfr = blmax*l2fr if(present(dbfrdd))then - dbfrdd = dbfrmaxdd + dbfrdd = dbfrmaxdd*l2fr end if case DEFAULT @@ -1005,32 +1012,6 @@ subroutine bdead_allom(bagw,bbgw,bsap,ipft,bdead,dbagwdd,dbbgwdd,dbsapdd,dbdeadd return end subroutine bdead_allom - ! ============================================================================ - ! Specific bfrmax relationships - ! ============================================================================ - - subroutine bfrmax_const(d,blmax,dblmaxdd,ipft,bfrmax,dbfrmaxdd) - - - real(r8),intent(in) :: d ! plant diameter [cm] - real(r8),intent(in) :: blmax ! max leaf biomass [kgC] - real(r8),intent(in) :: dblmaxdd ! change in blmax per diam [kgC/cm] - integer(i4),intent(in) :: ipft ! PFT index - real(r8),intent(out) :: bfrmax ! max fine-root root biomass [kgC] - real(r8),intent(out),optional :: dbfrmaxdd ! change frmax bio per diam [kgC/cm] - - associate( l2fr => prt_params%allom_l2fr(ipft) ) - - bfrmax = blmax*l2fr - - ! dbfr/dd = dbfrmax/dblmax * dblmax/dd - if(present(dbfrmaxdd))then - dbfrmaxdd = dblmaxdd*l2fr - end if - - end associate - return - end subroutine bfrmax_const ! ============================================================================ ! Specific bbgw relationships diff --git a/biogeochem/FatesSoilBGCFluxMod.F90 b/biogeochem/FatesSoilBGCFluxMod.F90 index 9815af8096..b42b60a6ec 100644 --- a/biogeochem/FatesSoilBGCFluxMod.F90 +++ b/biogeochem/FatesSoilBGCFluxMod.F90 @@ -38,7 +38,6 @@ module FatesSoilBGCFluxMod use FatesAllometryMod , only : bagw_allom use FatesAllometryMod , only : bsap_allom use FatesAllometryMod , only : bleaf - use FatesAllometryMod , only : bfineroot use FatesAllometryMod , only : bdead_allom use FatesAllometryMod , only : bstore_allom use FatesAllometryMod , only : bbgw_allom @@ -724,8 +723,8 @@ subroutine PrepNutrientAquisitionBCs(csite, bc_in, bc_out) icomp = pft end if - bc_out%cn_scalar(icomp) = bc_out%cn_scalar(icomp) + & - ECACScalar(ccohort, nitrogen_element) + bc_out%cn_scalar(icomp) = 1.0_r8 + ccohort => ccohort%shorter end do @@ -763,8 +762,7 @@ subroutine PrepNutrientAquisitionBCs(csite, bc_in, bc_out) icomp = pft end if - bc_out%cp_scalar(icomp) = bc_out%cp_scalar(icomp) + & - ECACScalar(ccohort, phosphorus_element) + bc_out%cp_scalar(icomp) = 1.0_r8 ccohort => ccohort%shorter end do @@ -1146,104 +1144,7 @@ subroutine FluxIntoLitterPools(csite, bc_in, bc_out) return end subroutine FluxIntoLitterPools - ! ===================================================================================== - - function ECACScalar(ccohort, element_id) result(c_scalar) - - ! ----------------------------------------------------------------------------------- - ! This function returns the cn_scalar or cp_scalar term - ! described in: - ! Zhu, Q et al. Representing Nitrogen, Phosphorus and Carbon - ! interactions in the E3SM land model: Development and Global benchmarking. - ! Journal of Advances in Modeling Earth Systems, 11, 2238-2258, 2019. - ! https://doi.org/10.1029/2018MS001571 - ! - ! In the manuscript c_scalar is described as: "f(CN) and f(CP) account for the - ! regulation of plant nutritional level on nutrient carrier enzyme activity" - ! Also, see equations 4 and 5. - ! ----------------------------------------------------------------------------------- - - - ! Arguments (in) - type(ed_cohort_type), pointer :: ccohort ! current cohort pointer - integer :: element_id ! element id consistent with parteh/PRTGenericMod.F90 - - ! Arguments (out) - real(r8) :: c_scalar - - ! Locals - real(r8) :: store_frac ! Current nutrient storage relative to max - real(r8) :: store_max ! Maximum nutrient storable by plant - real(r8) :: store_c ! Current storage carbon - real(r8) :: store_c_max ! Current maximum storage carbon - integer :: icode ! real variable checking code - - integer, parameter :: downreg_linear = 1 - integer, parameter :: downreg_logi = 2 - integer, parameter :: downreg_CN_logi = 3 - - integer, parameter :: downreg_type = downreg_linear - - - real(r8), parameter :: logi_k = 30.0_r8 ! logistic function k - real(r8), parameter :: store_x0 = 0.9_r8 ! storage fraction inflection point - real(r8), parameter :: logi_min = 0.0_r8 ! minimum cn_scalar for logistic - - ! This is the storage fraction where downregulation starts if using - ! a linear function - real(r8), parameter :: store_frac0 = 0.85_r8 - - real(r8), parameter :: c_max = 1.0_r8 - real(r8), parameter :: c_min = 1.e-3_r8 - - - store_max = ccohort%prt%GetNutrientTarget(element_id,store_organ,stoich_max) - store_frac = min(2.0_r8,ccohort%prt%GetState(store_organ, element_id)/store_max) - - if(downreg_type == downreg_linear) then - - c_scalar = min(c_max,max(c_min,1.0 - (store_frac - store_frac0)/(1.0_r8-store_frac0))) - - elseif(downreg_type == downreg_logi) then - - ! In this method, we define the c_scalar term - ! with a logistic function that goes to 1 (full need) - ! as the plant's nutrien storage hits a low threshold - ! and goes to 0, no demand, as the plant's nutrient - ! storage approaches it's maximum holding capacity - - - - c_scalar = max(c_min,min(c_max,logi_min + (1.0_r8-logi_min)/(1.0_r8 + exp(logi_k*(store_frac-store_x0))))) - - call check_var_real(c_scalar,'c_scalar',icode) - if (icode .ne. 0) then - write(fates_log(),*) 'c_scalar is invalid, element: ',element_id - write(fates_log(),*) 'ending' - call endrun(msg=errMsg(sourcefile, __LINE__)) - endif - - else - - store_c = ccohort%prt%GetState(store_organ, carbon12_element) - call bstore_allom(ccohort%dbh,ccohort%pft,ccohort%canopy_trim,store_c_max) - - ! Fraction of N per fraction of C - ! If this is greater than 1, then we have more N in storage than - ! we have C, so we downregulate. If this is less than 1, then - ! we have less N in storage than we have C, so up-regulate - - store_frac = store_frac / (store_c/store_c_max) - - c_scalar = max(c_min,min(c_max,logi_min + (1.0_r8-logi_min)/(1.0_r8 + exp(logi_k*(store_frac-store_x0))))) - - - - - end if - - end function ECACScalar end module FatesSoilBGCFluxMod diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index 9c3059312d..875fe4c730 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -529,11 +529,11 @@ subroutine init_cohorts( site_in, patch_in, bc_in) allocate(temp_cohort) ! temporary cohort - temp_cohort%pft = pft - temp_cohort%n = EDPftvarcon_inst%initd(pft) * patch_in%area - temp_cohort%hite = EDPftvarcon_inst%hgt_min(pft) + temp_cohort%pft = pft + temp_cohort%n = EDPftvarcon_inst%initd(pft) * patch_in%area + temp_cohort%hite = EDPftvarcon_inst%hgt_min(pft) + temp_cohort%l2fr = prt_params%allom_l2fr_min(pft) - ! Calculate the plant diameter from height call h2d_allom(temp_cohort%hite,pft,temp_cohort%dbh) @@ -551,7 +551,7 @@ subroutine init_cohorts( site_in, patch_in, bc_in) ! Calculate fine root biomass from allometry ! (calculates a maximum and then trimming value) - call bfineroot(temp_cohort%dbh,pft,temp_cohort%canopy_trim,c_fnrt) + call bfineroot(temp_cohort%dbh,pft,temp_cohort%canopy_trim,temp_cohort%l2fr,c_fnrt) ! Calculate sapwood biomass call bsap_allom(temp_cohort%dbh,pft,temp_cohort%canopy_trim,a_sapw,c_sapw) @@ -665,7 +665,7 @@ subroutine init_cohorts( site_in, patch_in, bc_in) call create_cohort(site_in, patch_in, pft, temp_cohort%n, temp_cohort%hite, & temp_cohort%coage, temp_cohort%dbh, prt_obj, temp_cohort%laimemory, & temp_cohort%sapwmemory, temp_cohort%structmemory, cstatus, rstatus, & - temp_cohort%canopy_trim, 1, site_in%spread, bc_in) + temp_cohort%canopy_trim, 1, site_in%spread, bc_in) deallocate(temp_cohort) ! get rid of temporary cohort diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index ad1c6668c9..e8fa27ee8e 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -209,6 +209,14 @@ module EDTypesMod class(prt_vartypes), pointer :: prt + real(r8) :: l2fr ! leaf to fineroot biomass ratio (this is constant + ! in carbon only simulations, and is set by the + ! allom_l2fr_min parameter. In nutrient + ! enabled simulations, this is dynamic, will + ! vary between allom_l2fr_min and allom_l2fr_max + ! parameters, with a tendency driven by + ! nutrient storage) + ! VEGETATION STRUCTURE integer :: pft ! pft number real(r8) :: n ! number of individuals in cohort per 'area' (10000m2 default) @@ -1028,6 +1036,7 @@ subroutine dump_cohort(ccohort) write(fates_log(),*) 'co%laimemory = ', ccohort%laimemory write(fates_log(),*) 'co%sapwmemory = ', ccohort%sapwmemory write(fates_log(),*) 'co%structmemory = ', ccohort%structmemory + write(fates_log(),*) 'co%l2fr = ', ccohort%l2fr write(fates_log(),*) 'leaf carbon = ', ccohort%prt%GetState(leaf_organ,all_carbon_elements) write(fates_log(),*) 'fineroot carbon = ', ccohort%prt%GetState(fnrt_organ,all_carbon_elements) diff --git a/main/FatesInventoryInitMod.F90 b/main/FatesInventoryInitMod.F90 index efdebb8708..4d3dc256e7 100644 --- a/main/FatesInventoryInitMod.F90 +++ b/main/FatesInventoryInitMod.F90 @@ -1028,7 +1028,8 @@ subroutine set_inventory_edcohort_type1(csite,bc_in,css_file_unit,npatches, & call bleaf(temp_cohort%dbh,temp_cohort%pft,temp_cohort%canopy_trim,c_leaf) ! Calculate fine root biomass - call bfineroot(temp_cohort%dbh,temp_cohort%pft,temp_cohort%canopy_trim,c_fnrt) + temp_cohort%l2fr = prt_params%allom_l2fr_min(temp_cohort%pft) + call bfineroot(temp_cohort%dbh,temp_cohort%pft,temp_cohort%canopy_trim,temp_cohort%l2fr,c_fnrt) ! Calculate sapwood biomass call bsap_allom(temp_cohort%dbh,temp_cohort%pft,temp_cohort%canopy_trim, a_sapw, c_sapw) @@ -1042,7 +1043,7 @@ subroutine set_inventory_edcohort_type1(csite,bc_in,css_file_unit,npatches, & temp_cohort%structmemory = 0._r8 cstatus = leaves_on - stem_drop_fraction = EDPftvarcon_inst%phen_stem_drop_fraction(temp_cohort%pft) + stem_drop_fraction = EDPftvarcon_inst%phen_stem_drop_fraction(temp_cohort%pft) if( prt_params%season_decid(temp_cohort%pft) == itrue .and. & any(csite%cstatus == [phen_cstat_nevercold,phen_cstat_iscold])) then diff --git a/parameter_files/fates_params_default.cdl b/parameter_files/fates_params_default.cdl index 86d46710da..3e30fef4b4 100644 --- a/parameter_files/fates_params_default.cdl +++ b/parameter_files/fates_params_default.cdl @@ -100,9 +100,12 @@ variables: fates_allom_hmode:units = "index" ; fates_allom_hmode:long_name = "height allometry function index." ; fates_allom_hmode:possible_values = "1: OBrien 1995; 2: Poorter 2006; 3: 2 parameter power law; 4: Chave 2014; 5: Martinez-Cano 2019." ; - double fates_allom_l2fr(fates_pft) ; - fates_allom_l2fr:units = "gC/gC" ; - fates_allom_l2fr:long_name = "Allocation parameter: fine root C per leaf C" ; + double fates_allom_l2fr_min(fates_pft) ; + fates_allom_l2fr_min:units = "gC/gC" ; + fates_allom_l2fr_min:long_name = "Allocation parameter: minimum fine root C per leaf C (definitive l2fr for Carbon-only)" ; + double fates_allom_l2fr_max(fates_pft) ; + fates_allom_l2fr_max:units = "gC/gC" ; + fates_allom_l2fr_max:long_name = "Allocation parameter: maximum fine root C per leaf C (NOT USED IN Carbon-only, only CNP)" ; double fates_allom_la_per_sa_int(fates_pft) ; fates_allom_la_per_sa_int:units = "m2/cm2" ; fates_allom_la_per_sa_int:long_name = "Leaf area per sapwood area, intercept" ; @@ -781,7 +784,9 @@ data: fates_allom_hmode = 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 ; - fates_allom_l2fr = 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 ; + fates_allom_l2fr_min = 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 ; + + fates_allom_l2fr_max = 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 ; fates_allom_la_per_sa_int = 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8 ; diff --git a/parteh/PRTAllometricCNPMod.F90 b/parteh/PRTAllometricCNPMod.F90 index 3d5eb85b61..109cb4cf0d 100644 --- a/parteh/PRTAllometricCNPMod.F90 +++ b/parteh/PRTAllometricCNPMod.F90 @@ -124,7 +124,7 @@ module PRTAllometricCNPMod integer, parameter :: num_intgr_vars = 7 - + ! ------------------------------------------------------------------------------------- ! Input/Output Boundary Indices (These are public, and therefore ! each boundary condition across all modules must @@ -137,7 +137,9 @@ module PRTAllometricCNPMod integer, public, parameter :: acnp_bc_inout_id_dbh = 1 ! Plant DBH integer, public, parameter :: acnp_bc_inout_id_rmaint_def = 2 ! Index for any accumulated ! maintenance respiration deficit - integer, public, parameter :: num_bc_inout = 2 + integer, public, parameter :: acnp_bc_inout_id_l2fr = 3 ! leaf 2 fineroot scalar, this + ! is dynamic with CNP + integer, public, parameter :: num_bc_inout = 3 ! ------------------------------------------------------------------------------------- ! Input only Boundary Indices (These are public) @@ -167,6 +169,12 @@ module PRTAllometricCNPMod integer, parameter :: num_bc_out = 5 ! Total number of + ! Indices for parameters passed to the integrator + integer,private, parameter :: intgr_parm_ctrim = 1 + integer,private, parameter :: intgr_parm_pft = 2 + integer,private, parameter :: intgr_parm_l2fr = 3 + integer,private, parameter :: num_intgr_parm = 3 + real(r8), parameter :: min_stf_growth = 0.8_r8 ! Plants are only allowed to increase in stature ! if they have more than 80% of their stores full @@ -192,8 +200,14 @@ module PRTAllometricCNPMod ! in the same priority group as fineroots. logical, parameter :: reproduce_conly = .false. - + ! Definitions for the regulation functions. These typically translate + ! a storage fraction into a scalar used to regulate resources somehow + + integer, parameter :: regulate_linear = 1 + integer, parameter :: regulate_logi = 2 + integer, parameter :: regulate_CN_logi = 3 + ! Array of pointers are difficult in F90 ! This structure is a necessary intermediate type :: parray_type @@ -217,10 +231,12 @@ module PRTAllometricCNPMod ! Extended functions specific to Allometric CNP procedure :: CNPPrioritizedReplacement procedure :: CNPStatureGrowth + procedure :: CNPAdjustFRootTargets procedure :: CNPAllocateRemainder procedure :: GetDeficit procedure :: GrowEquivC procedure :: NAndPToMatchC + procedure :: StorageRegulator end type cnp_allom_prt_vartypes @@ -330,6 +346,7 @@ subroutine DailyPRTAllometricCNP(this) ! Pointers to in-out bcs real(r8),pointer :: dbh ! Diameter at breast height [cm] real(r8),pointer :: maint_r_def ! Current maintenance respiration deficit [kgC] + real(r8),pointer :: l2fr ! Leaf to fineroot ratio of target biomass ! Input only bcs integer :: ipft ! Plant Functional Type index @@ -415,11 +432,10 @@ subroutine DailyPRTAllometricCNP(this) n_need => this%bc_out(acnp_bc_out_id_nneed)%rval; n_need = fates_unset_r8 p_need => this%bc_out(acnp_bc_out_id_pneed)%rval; p_need = fates_unset_r8 - ! In/out boundary conditions maint_r_def => this%bc_inout(acnp_bc_inout_id_rmaint_def)%rval; maint_r_def0 = maint_r_def dbh => this%bc_inout(acnp_bc_inout_id_dbh)%rval; dbh0 = dbh - + l2fr => this%bc_out(acnp_bc_inout_id_l2fr)%rval ! If more than 1 leaf age bin is present, this @@ -447,7 +463,7 @@ subroutine DailyPRTAllometricCNP(this) call bdead_allom(agw_c_target,bgw_c_target, target_c(sapw_id), ipft, target_c(struct_id), & agw_dcdd_target, bgw_dcdd_target, target_dcdd(sapw_id), target_dcdd(struct_id)) call bleaf(dbh,ipft,canopy_trim, target_c(leaf_id), target_dcdd(leaf_id)) - call bfineroot(dbh,ipft,canopy_trim, target_c(fnrt_id), target_dcdd(fnrt_id)) + call bfineroot(dbh,ipft,canopy_trim, l2fr, target_c(fnrt_id), target_dcdd(fnrt_id)) call bstore_allom(dbh,ipft,canopy_trim, target_c(store_id), target_dcdd(store_id)) target_c(repro_id) = 0._r8 target_dcdd(repro_id) = 0._r8 @@ -488,9 +504,22 @@ subroutine DailyPRTAllometricCNP(this) p_gain = p_gain + sum(this%variables(i_var)%val(:)) net_p_gain = - sum(this%variables(i_var)%val(:)) this%variables(i_var)%val(:) = 0._r8 + + + ! =================================================================================== + ! Step 1: Evaluate nutrient storage in the plant. Depending on how low + ! these stores are, we will move proportionally more or less of the daily carbon + ! gain to increase the target fine-root biomass, fill up to target + ! and then attempt to get them up to stoichiometry targets. + ! =================================================================================== + + ! This routine actually just updates the l2fr variable + call this%CNPAdjustFRootTargets() + + call bfineroot(dbh,ipft,canopy_trim, l2fr, target_c(fnrt_id), target_dcdd(fnrt_id)) ! =================================================================================== - ! Step 1. Prioritized allocation to replace tissues from turnover, and/or pay + ! Step 2. Prioritized allocation to replace tissues from turnover, and/or pay ! any un-paid maintenance respiration from storage. ! =================================================================================== @@ -513,7 +542,7 @@ subroutine DailyPRTAllometricCNP(this) end if ! =================================================================================== - ! Step 2. Grow out the stature of the plant by allocating to tissues beyond + ! Step 3. Grow out the stature of the plant by allocating to tissues beyond ! current targets. ! Attempts have been made to get all pools and species closest to allometric ! targets based on prioritized relative demand and allometry functions. @@ -521,7 +550,7 @@ subroutine DailyPRTAllometricCNP(this) net_n_gain = net_n_gain + n_gain net_p_gain = net_p_gain + p_gain - + call this%CNPStatureGrowth(c_gain, n_gain, p_gain, & net_n_gain, net_p_gain, & state_c, state_n, state_p, target_c, target_dcdd, cnp_limiter) @@ -629,7 +658,61 @@ subroutine DailyPRTAllometricCNP(this) end subroutine DailyPRTAllometricCNP ! ===================================================================================== - + subroutine CNPAdjustFRootTargets(this) + + class(cnp_allom_prt_vartypes) :: this + + real(r8), pointer :: l2fr ! leaf to fineroot target biomass scaler + integer :: ipft ! PFT index + + real(r8) :: n_regulator ! Nitrogen storage regulation function scaler + real(r8) :: p_regulator ! Phosphorus storage regulation function scaler + real(r8) :: np_regulator ! Combined NP storage regulation function scaler + + + ipft = this%bc_in(acnp_bc_in_id_pft)%ival + l2fr => this%bc_inout(acnp_bc_inout_id_l2fr)%rval + + associate( l2fr_min => prt_params%allom_l2fr_min(ipft), & + l2fr_max => prt_params%allom_l2fr_max(ipft)) + + n_regulator = this%StorageRegulator(nitrogen_element, regulate_logi) + p_regulator = this%StorageRegulator(phosphorus_element, regulate_logi) + + ! We take the maximum here, because the maximum is reflective of the + ! element with the lowest storage, which is the limiting element + + np_regulator = max(n_regulator,p_regulator) + + ! Update the leaf-to-fineroot ratio used + ! to set fine-root biomass allometry + l2fr = l2fr_min + np_regulator*(l2fr_max-l2fr_min) + + ! Find the updated target fineroot biomass + ! call bfineroot(dbh,ipft,canopy_trim, l2fr, target_fnrt) + + ! Consider removing biomass immediately too... + ! we could send it to the turnover flux + ! c_to_froot = max(0._r8,target_fnrt - state_c(fnrt_id)%ptr) + + ! Update the actual carbon + ! state_c(fnrt_id)%ptr = state_c(fnrt_id)%ptr + c_to_froot + + ! Push nitrogen into fineroots to get to stoichiometry + ! call ProportionalNutrAllocation(state_n, deficit_n, & + ! n_gain, nitrogen_element, fnrt_id) + + ! Push phos into fineroots to get to stoichiometry + ! call ProportionalNutrAllocation(state_p, deficit_p, & + ! p_gain, phosphorus_element, fnrt_id) + + end associate + + return + end subroutine CNPAdjustFRootTargets + + ! ===================================================================================== + subroutine CNPPrioritizedReplacement(this, & maint_r_deficit, c_gain, n_gain, p_gain, & state_c, state_n, state_p, target_c) @@ -1033,6 +1116,7 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, net_n_gain, net_p_gain, integer :: ipft real(r8) :: canopy_trim real(r8) :: leaf_status + real(r8) :: l2fr integer :: i, ii ! organ index loops (masked and unmasked) integer :: istep ! outer step iteration loop @@ -1100,7 +1184,8 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, net_n_gain, net_p_gain, integer , parameter :: max_substeps = 300 ! Maximum allowable iterations real(r8), parameter :: max_trunc_error = 1.0_r8 ! Maximum allowable truncation error integer, parameter :: ODESolve = 2 ! 1=RKF45, 2=Euler - real(r8) :: intgr_params(num_bc_in) + + real(r8) :: intgr_params(num_intgr_parm) integer, parameter :: grow_lim_type = 3 ! Dev flag for growth limitation algorithm ! 1 = tries to calculate equivalent carbon @@ -1117,7 +1202,9 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, net_n_gain, net_p_gain, dbh => this%bc_inout(acnp_bc_inout_id_dbh)%rval ipft = this%bc_in(acnp_bc_in_id_pft)%ival canopy_trim = this%bc_in(acnp_bc_in_id_ctrim)%rval - + l2fr = this%bc_inout(acnp_bc_inout_id_l2fr)%rval ! This variable is not updated in this + ! routine, and is therefore not a pointer + cnp_limiter = 0 ! If any of these resources is essentially tapped out, @@ -1143,10 +1230,10 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, net_n_gain, net_p_gain, end if - intgr_params(:) = fates_unset_r8 - intgr_params(acnp_bc_in_id_ctrim) = this%bc_in(acnp_bc_in_id_ctrim)%rval - intgr_params(acnp_bc_in_id_pft) = real(this%bc_in(acnp_bc_in_id_pft)%ival) - + intgr_params(:) = fates_unset_r8 + intgr_params(intgr_parm_ctrim) = this%bc_in(acnp_bc_in_id_ctrim)%rval + intgr_params(intgr_parm_pft) = real(this%bc_in(acnp_bc_in_id_pft)%ival) + intgr_params(intgr_parm_l2fr) = this%bc_in(acnp_bc_inout_id_l2fr)%rval state_mask(:) = .false. mask_organs(:) = fates_unset_int @@ -1321,7 +1408,7 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, net_n_gain, net_p_gain, leafc_tp1 = leafc_tp1 + this%variables(i_var)%val(i) end do - call CheckIntegratedAllometries(state_array_out(dbh_id),ipft,canopy_trim, & + call CheckIntegratedAllometries(state_array_out(dbh_id),ipft,canopy_trim, l2fr, & leafc_tp1, state_array_out(fnrt_id), state_array_out(sapw_id), & state_array_out(store_id), state_array_out(struct_id), & state_mask(leaf_id), state_mask(fnrt_id), state_mask(sapw_id), & @@ -1412,7 +1499,7 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, net_n_gain, net_p_gain, structc_tp1 = state_array_out(struct_id) call bleaf(dbh_tp1,ipft,canopy_trim,leaf_c_target_tp1) - call bfineroot(dbh_tp1,ipft,canopy_trim,fnrt_c_target_tp1) + call bfineroot(dbh_tp1,ipft,canopy_trim,l2fr,fnrt_c_target_tp1) call bsap_allom(dbh_tp1,ipft,canopy_trim,sapw_area,sapw_c_target_tp1) call bagw_allom(dbh_tp1,ipft,agw_c_target_tp1) call bbgw_allom(dbh_tp1,ipft,bgw_c_target_tp1) @@ -1668,20 +1755,19 @@ function GetNutrientTargetCNP(this,element_id,organ_id,stoich_mode) result(targe real(r8) :: target_c real(r8),pointer :: dbh real(r8) :: canopy_trim + real(r8) :: l2fr integer :: ipft integer :: i_cvar real(r8) :: sapw_area real(r8) :: leaf_c_target,fnrt_c_target real(r8) :: sapw_c_target,agw_c_target real(r8) :: bgw_c_target,struct_c_target - - - dbh => this%bc_inout(acnp_bc_inout_id_dbh)%rval canopy_trim = this%bc_in(acnp_bc_in_id_ctrim)%rval ipft = this%bc_in(acnp_bc_in_id_pft)%ival i_cvar = prt_global%sp_organ_map(organ_id,carbon12_element) + l2fr = this%bc_inout(acnp_bc_inout_id_l2fr)%rval ! Storage of nutrients are assumed to have different compartments than ! for carbon, and thus their targets are not associated with a tissue @@ -1691,7 +1777,7 @@ function GetNutrientTargetCNP(this,element_id,organ_id,stoich_mode) result(targe if(organ_id == store_organ) then call bleaf(dbh,ipft,canopy_trim,leaf_c_target) - call bfineroot(dbh,ipft,canopy_trim,fnrt_c_target) + call bfineroot(dbh,ipft,canopy_trim,l2fr,fnrt_c_target) call bsap_allom(dbh,ipft,canopy_trim,sapw_area,sapw_c_target) call bagw_allom(dbh,ipft,agw_c_target) call bbgw_allom(dbh,ipft,bgw_c_target) @@ -2048,6 +2134,7 @@ function AllomCNPGrowthDeriv(l_state_array,l_state_mask,cbalance,intgr_params) r ! locals integer :: ipft ! PFT index real(r8) :: canopy_trim ! Canopy trimming function (boundary condition [0-1] + real(r8) :: l2fr ! leaf to fineroot biomass multiplier real(r8) :: leaf_c_target ! target leaf biomass, dummy var (kgC) real(r8) :: fnrt_c_target ! target fine-root biomass, dummy var (kgC) real(r8) :: sapw_c_target ! target sapwood biomass, dummy var (kgC) @@ -2083,12 +2170,12 @@ function AllomCNPGrowthDeriv(l_state_array,l_state_mask,cbalance,intgr_params) r mask_struct => l_state_mask(struct_id), & mask_repro => l_state_mask(repro_id) ) - - canopy_trim = intgr_params(acnp_bc_in_id_ctrim) - ipft = int(intgr_params(acnp_bc_in_id_pft)) + canopy_trim = intgr_params(intgr_parm_ctrim) + ipft = int(intgr_params(intgr_parm_pft)) + l2fr = intgr_params(intgr_parm_l2fr) call bleaf(dbh,ipft,canopy_trim,leaf_c_target,leaf_dcdd_target) - call bfineroot(dbh,ipft,canopy_trim,fnrt_c_target,fnrt_dcdd_target) + call bfineroot(dbh,ipft,canopy_trim,l2fr,fnrt_c_target,fnrt_dcdd_target) call bsap_allom(dbh,ipft,canopy_trim,sapw_area,sapw_c_target,sapw_dcdd_target) call bagw_allom(dbh,ipft,agw_c_target,agw_dcdd_target) call bbgw_allom(dbh,ipft,bgw_c_target,bgw_dcdd_target) @@ -2255,7 +2342,105 @@ subroutine TargetAllometryCheck(bleaf,bfroot,bsap,bstore,bdead, & end subroutine TargetAllometryCheck - + ! ===================================================================================== + function StorageRegulator(this,element_id,regulate_type) result(c_scalar) + + ! ----------------------------------------------------------------------------------- + ! This function returns the cn_scalar or cp_scalar term + ! described in: + ! Zhu, Q et al. Representing Nitrogen, Phosphorus and Carbon + ! interactions in the E3SM land model: Development and Global benchmarking. + ! Journal of Advances in Modeling Earth Systems, 11, 2238-2258, 2019. + ! https://doi.org/10.1029/2018MS001571 + ! + ! In the manuscript c_scalar is described as: "f(CN) and f(CP) account for the + ! regulation of plant nutritional level on nutrient carrier enzyme activity" + ! Also, see equations 4 and 5. + ! ----------------------------------------------------------------------------------- + + + ! Arguments (in) + class(cnp_allom_prt_vartypes) :: this + integer,intent(in) :: element_id ! element id consistent with parteh/PRTGenericMod.F90 + integer,intent(in) :: regulate_type + + + ! Arguments (out) + real(r8) :: c_scalar + + ! Locals + real(r8) :: store_frac ! Current nutrient storage relative to max + real(r8) :: store_max ! Maximum nutrient storable by plant + real(r8) :: store_c ! Current storage carbon + real(r8) :: store_c_max ! Current maximum storage carbon + integer :: icode ! real variable checking code + + real(r8), parameter :: logi_k = 30.0_r8 ! logistic function k + real(r8), parameter :: store_x0 = 0.7_r8 ! storage fraction inflection point + real(r8), parameter :: logi_min = 0.0_r8 ! minimum cn_scalar for logistic + + ! This is the storage fraction where downregulation starts if using + ! a linear function + real(r8), parameter :: store_frac0 = 0.85_r8 + + real(r8), parameter :: c_max = 1.0_r8 ! Maximum allowable result of the function + real(r8), parameter :: c_min = 0.0_r8 ! Minimum allowable result of the function + + associate(dbh => this%bc_inout(acnp_bc_inout_id_dbh)%rval, & + canopy_trim => this%bc_in(acnp_bc_in_id_ctrim)%rval, & + ipft => this%bc_in(acnp_bc_in_id_pft)%ival) + + store_max = this%GetNutrientTarget(element_id,store_organ,stoich_max) + + ! Storage fractions could more than the target, depending on the + ! hypothesis and functions involved, but should typically be 0-1 + ! The cap of 2 is for numerics and preventing weird math + store_frac = min(2.0_r8,this%GetState(store_organ, element_id)/store_max) + + if(regulate_type == regulate_linear) then + + c_scalar = min(c_max,max(c_min,1.0 - (store_frac - store_frac0)/(1.0_r8-store_frac0))) + + elseif(regulate_type == regulate_logi) then + + ! In this method, we define the c_scalar term + ! with a logistic function that goes to 1 (full need) + ! as the plant's nutrien storage hits a low threshold + ! and goes to 0, no demand, as the plant's nutrient + ! storage approaches it's maximum holding capacity + + c_scalar = max(c_min,min(c_max,logi_min + (1.0_r8-logi_min)/(1.0_r8 + exp(logi_k*(store_frac-store_x0))))) + + !call check_var_real(c_scalar,'c_scalar',icode) + !if (icode .ne. 0) then + ! write(fates_log(),*) 'c_scalar is invalid, element: ',element_id + ! write(fates_log(),*) 'ending' + ! call endrun(msg=errMsg(sourcefile, __LINE__)) + !endif + + else + + store_c = this%GetState(store_organ, carbon12_element) + call bstore_allom(dbh,ipft,canopy_trim,store_c_max) + + ! Fraction of N per fraction of C + ! If this is greater than 1, then we have more N in storage than + ! we have C, so we downregulate. If this is less than 1, then + ! we have less N in storage than we have C, so up-regulate + + store_frac = store_frac / (store_c/store_c_max) + + c_scalar = max(c_min,min(c_max,logi_min + (1.0_r8-logi_min)/(1.0_r8 + exp(logi_k*(store_frac-store_x0))))) + + end if + + end associate + + + end function StorageRegulator + + + end module PRTAllometricCNPMod diff --git a/parteh/PRTAllometricCarbonMod.F90 b/parteh/PRTAllometricCarbonMod.F90 index 5bdf624502..bb05e1c365 100644 --- a/parteh/PRTAllometricCarbonMod.F90 +++ b/parteh/PRTAllometricCarbonMod.F90 @@ -381,14 +381,17 @@ subroutine DailyPRTAllometricCarbon(this) ! are pressed into an array that is also ! passed to the integrators + + ipft = this%bc_in(ac_bc_in_id_pft)%ival + associate( & leaf_c => this%variables(leaf_c_id)%val, & fnrt_c => this%variables(fnrt_c_id)%val(icd), & sapw_c => this%variables(sapw_c_id)%val(icd), & store_c => this%variables(store_c_id)%val(icd), & repro_c => this%variables(repro_c_id)%val(icd), & - struct_c => this%variables(struct_c_id)%val(icd)) - + struct_c => this%variables(struct_c_id)%val(icd), & + l2fr => prt_params%allom_l2fr_min(ipft) ) ! ----------------------------------------------------------------------------------- ! 0. @@ -400,9 +403,9 @@ subroutine DailyPRTAllometricCarbon(this) carbon_balance => this%bc_inout(ac_bc_inout_id_netdc)%rval canopy_trim = this%bc_in(ac_bc_in_id_ctrim)%rval - ipft = this%bc_in(ac_bc_in_id_pft)%ival + leaf_status = this%bc_in(ac_bc_in_id_lstat)%ival - + intgr_params(:) = un_initialized intgr_params(ac_bc_in_id_ctrim) = this%bc_in(ac_bc_in_id_ctrim)%rval intgr_params(ac_bc_in_id_pft) = real(this%bc_in(ac_bc_in_id_pft)%ival) @@ -458,7 +461,7 @@ subroutine DailyPRTAllometricCarbon(this) end if ! Target fine-root biomass and deriv. according to allometry and trimming [kgC, kgC/cm] - call bfineroot(dbh,ipft,canopy_trim,target_fnrt_c) + call bfineroot(dbh,ipft,canopy_trim,l2fr,target_fnrt_c) ! Target storage carbon [kgC,kgC/cm] call bstore_allom(dbh,ipft,canopy_trim,target_store_c) @@ -731,7 +734,7 @@ subroutine DailyPRTAllometricCarbon(this) ! we halve the step-size, and then retry. If that step was fine, then ! we remember the current step size as a good next guess. - call CheckIntegratedAllometries(c_pool_out(dbh_id),ipft,canopy_trim, & + call CheckIntegratedAllometries(c_pool_out(dbh_id),ipft,canopy_trim,l2fr, & c_pool_out(leaf_c_id), c_pool_out(fnrt_c_id), c_pool_out(sapw_c_id), & c_pool_out(store_c_id), c_pool_out(struct_c_id), & c_mask(leaf_c_id), c_mask(fnrt_c_id), c_mask(sapw_c_id), & @@ -891,6 +894,7 @@ function AllomCGrowthDeriv(c_pools,c_mask,cbalance,intgr_params) result(dCdx) ! locals integer :: ipft ! PFT index real(r8) :: canopy_trim ! Canopy trimming function (boundary condition [0-1] + real(r8) :: l2fr ! leaf to fine root biomass multiplier real(r8) :: ct_leaf ! target leaf biomass, dummy var (kgC) real(r8) :: ct_fnrt ! target fine-root biomass, dummy var (kgC) real(r8) :: ct_sap ! target sapwood biomass, dummy var (kgC) @@ -927,10 +931,10 @@ function AllomCGrowthDeriv(c_pools,c_mask,cbalance,intgr_params) result(dCdx) canopy_trim = intgr_params(ac_bc_in_id_ctrim) ipft = int(intgr_params(ac_bc_in_id_pft)) - + l2fr = prt_params%allom_l2fr_min(ipft) call bleaf(dbh,ipft,canopy_trim,ct_leaf,ct_dleafdd) - call bfineroot(dbh,ipft,canopy_trim,ct_fnrt,ct_dfnrtdd) + call bfineroot(dbh,ipft,canopy_trim,l2fr,ct_fnrt,ct_dfnrtdd) call bsap_allom(dbh,ipft,canopy_trim,sapw_area,ct_sap,ct_dsapdd) call bagw_allom(dbh,ipft,ct_agw,ct_dagwdd) diff --git a/parteh/PRTParametersMod.F90 b/parteh/PRTParametersMod.F90 index 6e2c17ac66..1200cb17a6 100644 --- a/parteh/PRTParametersMod.F90 +++ b/parteh/PRTParametersMod.F90 @@ -118,7 +118,10 @@ module PRTParametersMod ! (sapwood area / leaf area) [cm2/m2] real(r8), allocatable :: allom_la_per_sa_slp(:) ! Leaf area to sap area conversion, slope ! (sapwood area / leaf area / diameter) [cm2/m2/cm] - real(r8), allocatable :: allom_l2fr(:) ! Fine root biomass per leaf biomass ratio [kgC/kgC] + real(r8), allocatable :: allom_l2fr_min(:) ! Minimum fine root biomass per leaf biomass ratio [kgC/kgC] + ! FOR C-ONLY, THIS IS THE ONLY AND STATIC L2FR + real(r8), allocatable :: allom_l2fr_max(:) ! Maximum fine root biomass per leaf biomass ratio [kgC/kgC] + ! for nutrient enabled runs real(r8), allocatable :: allom_agb_frac(:) ! Fraction of stem above ground [-] real(r8), allocatable :: allom_d2h1(:) ! Parameter 1 for d2h allometry (intercept, or "c") real(r8), allocatable :: allom_d2h2(:) ! Parameter 2 for d2h allometry (slope, or "m") diff --git a/parteh/PRTParamsFATESMod.F90 b/parteh/PRTParamsFATESMod.F90 index 4442c090e8..da8a9c0448 100644 --- a/parteh/PRTParamsFATESMod.F90 +++ b/parteh/PRTParamsFATESMod.F90 @@ -227,10 +227,14 @@ subroutine PRTRegisterPFT(fates_params) call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'fates_allom_l2fr' + name = 'fates_allom_l2fr_min' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) + name = 'fates_allom_l2fr_max' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + name = 'fates_grperc' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) @@ -495,9 +499,13 @@ subroutine PRTReceivePFT(fates_params) call fates_params%RetreiveParameterAllocate(name=name, & data=prt_params%allom_la_per_sa_slp) - name = 'fates_allom_l2fr' + name = 'fates_allom_l2fr_min' + call fates_params%RetreiveParameterAllocate(name=name, & + data=prt_params%allom_l2fr_min) + + name = 'fates_allom_l2fr_max' call fates_params%RetreiveParameterAllocate(name=name, & - data=prt_params%allom_l2fr) + data=prt_params%allom_l2fr_max) name = 'fates_allom_agb_frac' call fates_params%RetreiveParameterAllocate(name=name, & @@ -835,7 +843,8 @@ subroutine FatesReportPFTParams(is_master) write(fates_log(),fmt0) 'allom_smode = ',prt_params%allom_smode write(fates_log(),fmt0) 'allom_la_per_sa_int = ',prt_params%allom_la_per_sa_int write(fates_log(),fmt0) 'allom_la_per_sa_slp = ',prt_params%allom_la_per_sa_slp - write(fates_log(),fmt0) 'allom_l2fr = ',prt_params%allom_l2fr + write(fates_log(),fmt0) 'allom_l2fr_min = ',prt_params%allom_l2fr_min + write(fates_log(),fmt0) 'allom_l2fr_max = ',prt_params%allom_l2fr_max write(fates_log(),fmt0) 'allom_agb_frac = ',prt_params%allom_agb_frac write(fates_log(),fmt0) 'allom_d2h1 = ',prt_params%allom_d2h1 write(fates_log(),fmt0) 'allom_d2h2 = ',prt_params%allom_d2h2 @@ -1405,7 +1414,7 @@ function NewRecruitTotalStoichiometry(ft,element_id) result(recruit_stoich) call h2d_allom(EDPftvarcon_inst%hgt_min(ft),ft,dbh) call bleaf(dbh,ft,init_recruit_trim,c_leaf) - call bfineroot(dbh,ft,init_recruit_trim,c_fnrt) + call bfineroot(dbh,ft,init_recruit_trim,prt_params%allom_l2fr_min(ft),c_fnrt) call bsap_allom(dbh,ft,init_recruit_trim,a_sapw, c_sapw) call bagw_allom(dbh,ft,c_agw) call bbgw_allom(dbh,ft,c_bgw) From 6f1b1ca8a81d224afc3adfeb7f33f10382024e91 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 18 Nov 2021 10:38:18 -0500 Subject: [PATCH 07/55] Work on dynamic root responses to nutrient availability --- biogeochem/FatesSoilBGCFluxMod.F90 | 548 ++++++----------------------- main/EDPftvarcon.F90 | 8 - main/FatesConstantsMod.F90 | 13 +- main/FatesHistoryInterfaceMod.F90 | 50 ++- main/FatesInterfaceMod.F90 | 66 ++-- main/FatesInterfaceTypesMod.F90 | 8 +- parteh/PRTAllometricCNPMod.F90 | 106 +++--- 7 files changed, 254 insertions(+), 545 deletions(-) diff --git a/biogeochem/FatesSoilBGCFluxMod.F90 b/biogeochem/FatesSoilBGCFluxMod.F90 index b42b60a6ec..e3dd7a76f1 100644 --- a/biogeochem/FatesSoilBGCFluxMod.F90 +++ b/biogeochem/FatesSoilBGCFluxMod.F90 @@ -62,8 +62,7 @@ module FatesSoilBGCFluxMod use FatesConstantsMod, only : g_per_kg use FatesConstantsMod, only : kg_per_g use FatesConstantsMod, only : fates_np_comp_scaling - use FatesConstantsMod, only : cohort_np_comp_scaling - use FatesConstantsMod, only : pft_np_comp_scaling + use FatesConstantsMod, only : coupled_np_comp_scaling use FatesConstantsMod, only : trivial_np_comp_scaling use FatesConstantsMod, only : rsnbl_math_prec use FatesConstantsMod, only : days_per_year @@ -196,27 +195,9 @@ subroutine UnPackNutrientAquisitionBCs(sites, bc_in) type(ed_patch_type), pointer :: cpatch ! current patch pointer type(ed_cohort_type), pointer :: ccohort ! current cohort pointer real(r8) :: fnrt_c ! fine-root carbon [kg] - real(r8) :: fnrt_c_pft(numpft) ! total mass of root for each PFT [kgC] nsites = size(sites,dim=1) - - ! Zero the uptake rates - do s = 1, nsites - cpatch => sites(s)%oldest_patch - do while (associated(cpatch)) - ccohort => cpatch%tallest - do while (associated(ccohort)) - ccohort%daily_nh4_uptake = 0._r8 - ccohort%daily_no3_uptake = 0._r8 - ccohort%daily_p_uptake = 0._r8 - ccohort => ccohort%shorter - end do - cpatch => cpatch%younger - end do - - end do - ! We can exit if this is a c-only simulation if(hlm_parteh_mode.eq.prt_carbon_allom_hyp) then ! These can now be zero'd @@ -238,20 +219,39 @@ subroutine UnPackNutrientAquisitionBCs(sites, bc_in) ! the plant demand. if (n_uptake_mode.eq.prescribed_n_uptake) then + cpatch => sites(s)%oldest_patch do while (associated(cpatch)) ccohort => cpatch%tallest do while (associated(ccohort)) pft = ccohort%pft - ccohort%daily_n_demand = GetPlantDemand(ccohort,nitrogen_element) ccohort%daily_nh4_uptake = EDPftvarcon_inst%prescribed_nuptake(pft) * ccohort%daily_n_demand ccohort%daily_no3_uptake = 0._r8 - ccohort => ccohort%shorter end do cpatch => cpatch%younger end do + + elseif(n_uptake_mode.eq.coupled_n_uptake) then + + icomp = 0 + cpatch => sites(s)%oldest_patch + do while (associated(cpatch)) + ccohort => cpatch%tallest + do while (associated(ccohort)) + icomp = icomp+1 + fnrt_c = ccohort%prt%GetState(fnrt_organ, carbon12_element) + ccohort%daily_n_demand = fnrt_c * ccohort%n * AREA_INV * & + EDPftvarcon_inst%eca_vmax_nh4(ccohort%pft) * sec_per_day + ! N Uptake: Convert g/m2/day -> kg/plant/day + ccohort%daily_nh4_uptake = bc_in(s)%plant_nh4_uptake_flux(icomp,1)*kg_per_g*AREA/ccohort%n + ccohort%daily_no3_uptake = bc_in(s)%plant_no3_uptake_flux(icomp,1)*kg_per_g*AREA/ccohort%n + ccohort => ccohort%shorter + end do + cpatch => cpatch%younger + end do + end if if (p_uptake_mode.eq.prescribed_p_uptake) then @@ -260,151 +260,33 @@ subroutine UnPackNutrientAquisitionBCs(sites, bc_in) ccohort => cpatch%tallest do while (associated(ccohort)) pft = ccohort%pft - ccohort%daily_p_demand = GetPlantDemand(ccohort,phosphorus_element) ccohort%daily_p_uptake = EDPftvarcon_inst%prescribed_puptake(pft) * ccohort%daily_p_demand - ccohort => ccohort%shorter end do cpatch => cpatch%younger end do - end if - - - ! If nutrient competition is sent to the BGC model as PFTs - ! and not as individual cohorts, we need to unravel the input - ! boundary condition and send to cohort. We do this downscaling - ! by finding each cohort's fraction of total fine-root for the group - - n_or_p_coupled_if: if(n_uptake_mode.eq.coupled_n_uptake .or. p_uptake_mode.eq.coupled_p_uptake)then - - ! Note there are two scaling methods. Either competition for - ! N and/or P was performed by cohorts acting individually - ! (cohort_np_comp_scaling) , or as PFTs (pft_np_comp_scaling) - ! If we opt for the latter, then we assume that the nutrient - ! uptake share of the cohort, matches the fraction of root - ! mass it contributes to the group (PFT). - if(fates_np_comp_scaling.eq.pft_np_comp_scaling) then - - ! *Currently, all cohorts in a PFT have the same root - ! fraction, so all we have to to is find its total mass fraction. - - fnrt_c_pft(:) = 0._r8 - cpatch => sites(s)%oldest_patch - do while (associated(cpatch)) - ccohort => cpatch%tallest - do while (associated(ccohort)) - pft = ccohort%pft - fnrt_c_pft(pft) = fnrt_c_pft(pft) + & - ccohort%prt%GetState(fnrt_organ, all_carbon_elements)*ccohort%n - ccohort => ccohort%shorter - end do - cpatch => cpatch%younger + elseif(p_uptake_mode.eq.coupled_p_uptake) then + + icomp = 0 + cpatch => sites(s)%oldest_patch + do while (associated(cpatch)) + ccohort => cpatch%tallest + do while (associated(ccohort)) + icomp = icomp+1 + fnrt_c = ccohort%prt%GetState(fnrt_organ, carbon12_element) + ccohort%daily_p_demand = fnrt_c * ccohort%n * AREA_INV * & + EDPftvarcon_inst%eca_vmax_p(ccohort%pft) * sec_per_day + ! P Uptake: Convert g/m2/day -> kg/plant/day + ccohort%daily_p_uptake = bc_in(s)%plant_p_uptake_flux(icomp,1)*kg_per_g*AREA/ccohort%n + ccohort => ccohort%shorter end do - - end if ! end if(fates_np_comp_scaling.eq.pft_np_comp_scaling) then + cpatch => cpatch%younger + end do + + end if - ! -------------------------------------------------------------------------------- - ! Now that we have the arrays ready for downscaling (if needed) - ! loop through all cohorts and acquire nutrient - ! -------------------------------------------------------------------------------- - - if(n_uptake_mode.eq.coupled_n_uptake) then - - if(fates_np_comp_scaling.eq.cohort_np_comp_scaling) then - - icomp = 0 - cpatch => sites(s)%oldest_patch - do while (associated(cpatch)) - ccohort => cpatch%tallest - do while (associated(ccohort)) - icomp = icomp+1 - - ! N Uptake: Convert g/m2/day -> kg/plant/day - - ccohort%daily_nh4_uptake = sum(bc_in(s)%plant_nh4_uptake_flux(icomp,:))*kg_per_g*AREA/ccohort%n - ccohort%daily_no3_uptake = sum(bc_in(s)%plant_no3_uptake_flux(icomp,:))*kg_per_g*AREA/ccohort%n - - ccohort => ccohort%shorter - end do - cpatch => cpatch%younger - end do - - else - - cpatch => sites(s)%oldest_patch - do while (associated(cpatch)) - ccohort => cpatch%tallest - do while (associated(ccohort)) - pft = ccohort%pft - - ! Total fine-root carbon of the cohort [kgC/ha] - fnrt_c = ccohort%prt%GetState(fnrt_organ, all_carbon_elements)*ccohort%n - - ! Loop through soil layers, add up the uptake this cohort gets from each layer - do id = 1,bc_in(s)%nlevdecomp - ccohort%daily_nh4_uptake = ccohort%daily_nh4_uptake + & - bc_in(s)%plant_nh4_uptake_flux(pft,id) * & - (fnrt_c/fnrt_c_pft(pft))*kg_per_g*AREA/ccohort%n - ccohort%daily_no3_uptake = ccohort%daily_no3_uptake + & - bc_in(s)%plant_no3_uptake_flux(pft,id) * & - (fnrt_c/fnrt_c_pft(pft))*kg_per_g*AREA/ccohort%n - end do - - ccohort => ccohort%shorter - end do - cpatch => cpatch%younger - end do - - end if - - end if - - if(p_uptake_mode.eq.coupled_p_uptake) then - - if(fates_np_comp_scaling.eq.cohort_np_comp_scaling) then - - icomp = 0 - cpatch => sites(s)%oldest_patch - do while (associated(cpatch)) - ccohort => cpatch%tallest - do while (associated(ccohort)) - icomp = icomp+1 - ! P Uptake: Convert g/m2/day -> kg/plant/day - ccohort%daily_p_uptake = ccohort%daily_p_uptake + & - sum(bc_in(s)%plant_p_uptake_flux(icomp,:))*kg_per_g*AREA/ccohort%n - ccohort => ccohort%shorter - end do - cpatch => cpatch%younger - end do - - else - - cpatch => sites(s)%oldest_patch - do while (associated(cpatch)) - ccohort => cpatch%tallest - do while (associated(ccohort)) - pft = ccohort%pft - ! Total fine-root carbon of the cohort [kgC/ha] - fnrt_c = ccohort%prt%GetState(fnrt_organ, all_carbon_elements)*ccohort%n - ! Loop through soil layers, add up the uptake this cohort gets from each layer - do id = 1,bc_in(s)%nlevdecomp - ccohort%daily_p_uptake = ccohort%daily_p_uptake + & - bc_in(s)%plant_p_uptake_flux(pft,id) * & - (fnrt_c/fnrt_c_pft(pft))*kg_per_g*AREA/ccohort%n - end do - ccohort => ccohort%shorter - end do - cpatch => cpatch%younger - end do - - end if - - end if - - end if n_or_p_coupled_if - ! These can now be zero'd bc_in(s)%plant_nh4_uptake_flux(:,:) = 0._r8 bc_in(s)%plant_no3_uptake_flux(:,:) = 0._r8 @@ -579,303 +461,107 @@ subroutine PrepNutrientAquisitionBCs(csite, bc_in, bc_out) type(bc_out_type), intent(inout) :: bc_out ! Locals - integer :: icomp ! competitor index - integer :: j ! soil layer index - integer :: id ! decomp index (might == j) - integer :: pft ! plant functional type - type(ed_patch_type), pointer :: cpatch ! current patch pointer - type(ed_cohort_type), pointer :: ccohort ! current cohort pointer - real(r8) :: fnrt_c ! fine-root carbon [kg] - real(r8) :: veg_rootc ! fine root carbon in each layer [g/m3] - real(r8) :: dbh ! dbh (cm) - real(r8) :: npp_n_demand ! Nitrogen needed to keep up with NPP [kgN] - real(r8) :: npp_p_demand ! Phosphorus needed to keep up with NPP [kgP] - real(r8) :: deficit_n_demand ! Nitrogen needed to get stoich back to - ! optimal [kgN] - real(r8) :: deficit_p_demand ! Phosphorus needed to get stoich back to - ! optimal [kgP] - real(r8) :: comp_per_pft(numpft) ! Competitors per PFT, used for averaging - real(r8) :: decompmicc_layer ! Microbial dedcomposer biomass for current layer - integer :: comp_scaling ! Flag that defines the boundary condition scaling method (includes trivial) - - real(r8), parameter :: decompmicc_lambda = 2.5_r8 ! Depth attenuation exponent for decomposer biomass + integer :: icomp ! competitor index + integer :: j ! soil layer index + integer :: id ! decomp index (might == j) + integer :: pft ! plant functional type + type(ed_patch_type), pointer :: cpatch ! current patch pointer + type(ed_cohort_type), pointer :: ccohort ! current cohort pointer + real(r8) :: fnrt_c ! fine-root carbon [kg] + real(r8) :: veg_rootc ! fine root carbon in each layer [g/m3] + real(r8) :: decompmicc_layer ! Microbial dedcomposer biomass for current layer + + real(r8), parameter :: decompmicc_lambda = 2.5_r8 ! Depth attenuation exponent for decomposer biomass real(r8), parameter :: decompmicc_zmax = 7.0e-2_r8 ! Depth of maximum decomposer biomass - ! Determine the scaling approach - if((hlm_parteh_mode.eq.prt_cnp_flex_allom_hyp) .and. & - ((n_uptake_mode.eq.coupled_n_uptake) .or. & - (p_uptake_mode.eq.coupled_p_uptake))) then - comp_scaling = fates_np_comp_scaling - - else - - comp_scaling = trivial_np_comp_scaling - - ! Note: With ECA, we still need to update the - ! decomp microbe density even if we are not - ! fully coupled, so can't exit yet - - if(trim(hlm_nu_com).eq.'RD') then - bc_out%num_plant_comps = 1 - bc_out%n_demand(1) = 0._r8 - bc_out%p_demand(1) = 0._r8 - return + + ! Whether this is a trivial or coupled run, + ! the following variables get initialized in the same way + bc_out%veg_rootc(:,:) = 0._r8 + bc_out%ft_index(:) = -1 + if(trim(hlm_nu_com).eq.'ECA')then + bc_out%decompmicc(:) = 0._r8 + bc_out%cn_scalar(:) = 1._r8 + bc_out%cp_scalar(:) = 1._r8 + end if + + if(fates_np_comp_scaling == trivial_np_comp_scaling) then + if(trim(hlm_nu_com).eq.'RD')then + bc_out%num_plant_comps = 1 + bc_out%ft_index(1) = 1 + return end if - end if - - ! ECA Specific Parameters - ! -------------------------------------------------------------------------------- - if(trim(hlm_nu_com).eq.'ECA')then - - bc_out%veg_rootc(:,:) = 0._r8 ! Zero this, it will be incremented - bc_out%decompmicc(:) = 0._r8 - bc_out%cn_scalar(:) = 0._r8 - bc_out%cp_scalar(:) = 0._r8 - bc_out%ft_index(:) = -1 - - ! Loop over all patches and sum up the seed input for each PFT - icomp = 0 - comp_per_pft(:) = 0 ! This counts how many competitors per - ! pft, used for averaging - - cpatch => csite%oldest_patch - do while (associated(cpatch)) - - ccohort => cpatch%tallest - do while (associated(ccohort)) - - pft = ccohort%pft - ! If we are not coupling plant uptake - ! with ECA, then we send 1 token - ! competitor with plant root biomass, but no - ! uptake affinity + ! For both the trivial case with ECA, and the coupled case + ! we still need to calculate the root biomass and decompmicc + ! arrays (the former for the latter when trivial). So we + ! don't differentiate - if(comp_scaling.eq.cohort_np_comp_scaling) then - icomp = icomp+1 - bc_out%ft_index(icomp) = pft - else - icomp = pft - comp_per_pft(pft) = comp_per_pft(pft) + 1 - bc_out%ft_index(icomp) = pft - end if - - call set_root_fraction(csite%rootfrac_scr, pft, csite%zi_soil, & - bc_in%max_rooting_depth_index_col ) - - fnrt_c = ccohort%prt%GetState(fnrt_organ, carbon12_element) - - ! Map the soil layers to the decomposition layers - ! (which may be synonomous) - ! veg_rootc in units: [g/m3] = [kgC/plant] * [plant/ha] * [ha/ 10k m2] * [1000 g / kg] * [1/m] + icomp = 0 + cpatch => csite%oldest_patch + do while (associated(cpatch)) + ccohort => cpatch%tallest + do while (associated(ccohort)) - do j = 1, bc_in%nlevdecomp - id = bc_in%decomp_id(j) ! Map from soil layer to decomp layer - veg_rootc = fnrt_c * ccohort%n * csite%rootfrac_scr(j) * AREA_INV * g_per_kg / csite%dz_soil(j) - - bc_out%veg_rootc(icomp,id) = bc_out%veg_rootc(icomp,id) + veg_rootc + if(fates_np_comp_scaling .eq. coupled_np_comp_scaling) then + icomp = icomp+1 + else + icomp = 1 + end if + + pft = ccohort%pft + bc_out%ft_index(icomp) = pft + + call set_root_fraction(csite%rootfrac_scr, pft, csite%zi_soil, & + bc_in%max_rooting_depth_index_col ) + + fnrt_c = ccohort%prt%GetState(fnrt_organ, carbon12_element) + + ! Map the soil layers to the decomposition layers (which may be synonomous) + ! veg_rootc in units: [gC/m3] = [kgC/plant] * [plant/ha] * [ha/ 10k m2] * [1000 g / kg] * [1/m] + + do j = 1, bc_in%nlevdecomp + id = bc_in%decomp_id(j) ! Map from soil layer to decomp layer + veg_rootc = fnrt_c * ccohort%n * csite%rootfrac_scr(j) * AREA_INV * g_per_kg / csite%dz_soil(j) + + bc_out%veg_rootc(icomp,id) = bc_out%veg_rootc(icomp,id) + veg_rootc + + if(trim(hlm_nu_com).eq.'ECA')then ! We use a 3 parameter exponential attenuation function to estimate decomposer biomass ! The parameter EDPftvarcon_inst%decompmicc(pft) is the maximum amount found at depth ! decompmicc_zmax, and the profile attenuates with strength lambda - + decompmicc_layer = EDPftvarcon_inst%decompmicc(pft) * & exp(-decompmicc_lambda*abs(csite%z_soil(j)-decompmicc_zmax)) - + + bc_out%decompmicc(id) = bc_out%decompmicc(id) + decompmicc_layer * veg_rootc - end do - ccohort => ccohort%shorter + end if + end do - - cpatch => cpatch%younger + ccohort => ccohort%shorter end do - ! We calculate the decomposer microbial biomass by weighting with the - ! root biomass. This is just the normalization step + cpatch => cpatch%younger + end do + + ! We calculate the decomposer microbial biomass by weighting with the + ! root biomass. This is just the normalization step + if(trim(hlm_nu_com).eq.'ECA')then do id = 1,bc_in%nlevdecomp bc_out%decompmicc(id) = bc_out%decompmicc(id) / & max(nearzero,sum(bc_out%veg_rootc(:,id),dim=1)) end do + end if - if(comp_scaling.eq.cohort_np_comp_scaling) then - bc_out%num_plant_comps = icomp - elseif(comp_scaling.eq.pft_np_comp_scaling) then - bc_out%num_plant_comps = numpft - elseif(comp_scaling.eq.trivial_np_comp_scaling) then - bc_out%num_plant_comps = 1 - ! Now that the microbial density is calculated - ! we can exit the trivial case - return - end if - - coupled_n_if: if(n_uptake_mode.eq.coupled_n_uptake) then - icomp = 0 - cpatch => csite%oldest_patch - do while (associated(cpatch)) - ccohort => cpatch%tallest - do while (associated(ccohort)) - - pft = ccohort%pft - if(fates_np_comp_scaling.eq.cohort_np_comp_scaling) then - icomp = icomp+1 - else - icomp = pft - end if - - bc_out%cn_scalar(icomp) = 1.0_r8 - - - ccohort => ccohort%shorter - end do - cpatch => cpatch%younger - end do - - ! Normalize the sum to a mean, if this is a PFT scale - ! boundary flux - if(fates_np_comp_scaling.eq.pft_np_comp_scaling) then - do icomp = 1, numpft - bc_out%cn_scalar(icomp) = bc_out%cn_scalar(icomp)/real(comp_per_pft(icomp),r8) - end do - end if - - else - - ! If we are not coupling N, then make sure to set affinity of plants to 0 - ! (it is possible to be here if P is coupled but N is not) - bc_out%cn_scalar(:) = 0._r8 - - end if coupled_n_if - - coupled_p_if: if(p_uptake_mode.eq.coupled_p_uptake) then - - icomp = 0 - cpatch => csite%oldest_patch - do while (associated(cpatch)) - ccohort => cpatch%tallest - do while (associated(ccohort)) - - pft = ccohort%pft - if(fates_np_comp_scaling.eq.cohort_np_comp_scaling) then - icomp = icomp+1 - else - icomp = pft - end if - - bc_out%cp_scalar(icomp) = 1.0_r8 - - ccohort => ccohort%shorter - end do - cpatch => cpatch%younger - end do - - if(fates_np_comp_scaling.eq.pft_np_comp_scaling) then - do icomp = 1, numpft - bc_out%cp_scalar(icomp) = bc_out%cp_scalar(icomp)/real(comp_per_pft(icomp),r8) - end do - end if - else - - ! If we are not coupling P, then make sure to set affinity of plants to 0 - ! (it is possible to be here if N is coupled but P is not) - bc_out%cp_scalar(:) = 0._r8 - - end if coupled_p_if - - elseif(trim(hlm_nu_com).eq.'RD') then - - ! If we are using RD competition and coupling that into FATES, - ! we must update the plant's demand - ! (if this is un-coupled, the demand is handled completely in - ! the UnPack code) - ! ----------------------------------------------------------------------------------- - - if(n_uptake_mode .eq. coupled_n_uptake ) then - cpatch => csite%oldest_patch - do while (associated(cpatch)) - ccohort => cpatch%tallest - do while (associated(ccohort)) - ccohort%daily_n_demand = GetPlantDemand(ccohort,nitrogen_element) - ccohort => ccohort%shorter - end do - cpatch => cpatch%younger - end do - - end if - - if(p_uptake_mode .eq. coupled_p_uptake ) then - cpatch => csite%oldest_patch - do while (associated(cpatch)) - ccohort => cpatch%tallest - do while (associated(ccohort)) - ccohort%daily_p_demand = GetPlantDemand(ccohort,phosphorus_element) - ccohort => ccohort%shorter - end do - cpatch => cpatch%younger - end do - end if - - ! -------------------------------------------------------------------------------- - ! Units on demand: - ! [gX/m2/s] convert [kgX/plant/day] * [plant/ha] * - ! [ha/10000 m2] * [1000 g/kg] * [1 day /86400 sec] - ! -------------------------------------------------------------------------------- - - bc_out%n_demand(:) = 0._r8 - bc_out%p_demand(:) = 0._r8 - - if(n_uptake_mode.eq.coupled_n_uptake) then - icomp = 0 - cpatch => csite%oldest_patch - do while (associated(cpatch)) - ccohort => cpatch%tallest - do while (associated(ccohort)) - pft = ccohort%pft - if(fates_np_comp_scaling.eq.cohort_np_comp_scaling) then - icomp = icomp+1 - else - icomp = pft - end if - bc_out%n_demand(icomp) = bc_out%n_demand(icomp) + & - ccohort%daily_n_demand*ccohort%n*AREA_INV*g_per_kg*days_per_sec - - ccohort => ccohort%shorter - end do - cpatch => cpatch%younger - end do - end if - - if(p_uptake_mode.eq.coupled_p_uptake) then - icomp = 0 - cpatch => csite%oldest_patch - do while (associated(cpatch)) - ccohort => cpatch%tallest - do while (associated(ccohort)) - pft = ccohort%pft - if(fates_np_comp_scaling.eq.cohort_np_comp_scaling) then - icomp = icomp+1 - else - icomp = pft - end if - bc_out%p_demand(icomp) = bc_out%p_demand(icomp) + & - ccohort%daily_p_demand*ccohort%n*AREA_INV*g_per_kg*days_per_sec - ccohort => ccohort%shorter - end do - cpatch => cpatch%younger - end do - end if - - if(comp_scaling.eq.cohort_np_comp_scaling) then - bc_out%num_plant_comps = icomp - elseif(comp_scaling.eq.pft_np_comp_scaling) then - bc_out%num_plant_comps = numpft - else - bc_out%num_plant_comps = 1 - end if - + if(fates_np_comp_scaling == coupled_np_comp_scaling) then + bc_out%num_plant_comps = icomp + else + bc_out%num_plant_comps = 1 end if - return end subroutine PrepNutrientAquisitionBCs diff --git a/main/EDPftvarcon.F90 b/main/EDPftvarcon.F90 index 61f095a758..1f608efa3e 100644 --- a/main/EDPftvarcon.F90 +++ b/main/EDPftvarcon.F90 @@ -1462,9 +1462,6 @@ subroutine FatesCheckParams(is_master) write(fates_log(),*) ' Aborting' call endrun(msg=errMsg(sourcefile, __LINE__)) end if - n_uptake_mode = prescribed_n_uptake - else - n_uptake_mode = coupled_n_uptake end if ! logging parameters, make sure they make sense @@ -1494,13 +1491,8 @@ subroutine FatesCheckParams(is_master) write(fates_log(),*) ' Aborting' call endrun(msg=errMsg(sourcefile, __LINE__)) end if - p_uptake_mode = prescribed_p_uptake - else - p_uptake_mode = coupled_p_uptake end if - - do ipft = 1,npft diff --git a/main/FatesConstantsMod.F90 b/main/FatesConstantsMod.F90 index 7e19856aa2..cf1e7edafa 100644 --- a/main/FatesConstantsMod.F90 +++ b/main/FatesConstantsMod.F90 @@ -47,15 +47,10 @@ module FatesConstantsMod integer, public, parameter :: coupled_n_uptake = 2 - integer, public, parameter :: cohort_np_comp_scaling = 1 ! This flag definition indicates that EVERY cohort on - ! the column should compete independently in the soil - ! BGC nitrogen and phosphorus acquisition scheme. + integer, public, parameter :: coupled_np_comp_scaling = 1 ! This flag signals that at least 1 chemical element (ie N or P) + ! is dynamic and exchanged between FATES and the HLM - integer, public, parameter :: pft_np_comp_scaling = 2 ! This flag definition indicates that cohorts should - ! be grouped into PFTs, and each PFT will be represented - ! as the competitor, in the BGC N and P acquisition scheme - - integer, public, parameter :: trivial_np_comp_scaling = 3 ! This flag definition indicates that either + integer, public, parameter :: trivial_np_comp_scaling = 2 ! This flag definition indicates that either ! nutrients are turned off in FATES, or, that the ! plants are not coupled with below ground chemistry. In ! this situation, we send token boundary condition information. @@ -64,7 +59,7 @@ module FatesConstantsMod ! This flag specifies the scaling of how we present ! nutrient competitors to the HLM's soil BGC model - integer, public, parameter :: fates_np_comp_scaling = cohort_np_comp_scaling + integer, public :: fates_np_comp_scaling = -1 real(fates_r8), parameter, public :: secondary_age_threshold = 94._fates_r8 ! less than this value is young secondary land ! based on average age of global diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 97f3342b43..b7b1ae2f34 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -170,6 +170,9 @@ module FatesHistoryInterfaceMod integer :: ih_reprop_si integer :: ih_totvegp_si + integer :: ih_l2fr_si + integer :: ih_l2fr_scpf + integer,public :: ih_nh4uptake_si integer,public :: ih_no3uptake_si integer,public :: ih_puptake_si @@ -1787,6 +1790,8 @@ subroutine update_history_dyn(this,nc,nsites,sites) associate( hio_npatches_si => this%hvars(ih_npatches_si)%r81d, & hio_ncohorts_si => this%hvars(ih_ncohorts_si)%r81d, & hio_trimming_si => this%hvars(ih_trimming_si)%r81d, & + hio_l2fr_si => this%hvars(ih_l2fr_si)%r81d, & + hio_l2fr_scpf => this%hvars(ih_l2fr_scpf)%r82d, & hio_area_plant_si => this%hvars(ih_area_plant_si)%r81d, & hio_area_trees_si => this%hvars(ih_area_trees_si)%r81d, & hio_canopy_spread_si => this%hvars(ih_canopy_spread_si)%r81d, & @@ -2209,8 +2214,8 @@ subroutine update_history_dyn(this,nc,nsites,sites) call sizetype_class_index(ccohort%dbh, ccohort%pft, ccohort%size_class, ccohort%size_by_pft_class) call coagetype_class_index(ccohort%coage, ccohort%pft, & ccohort%coage_class, ccohort%coage_by_pft_class) - - ! Increment the number of cohorts per site + + ! Increment the number of cohorts per site hio_ncohorts_si(io_si) = hio_ncohorts_si(io_si) + 1._r8 n_perm2 = ccohort%n * AREA_INV @@ -2268,6 +2273,14 @@ subroutine update_history_dyn(this,nc,nsites,sites) ! Zero states, and set the fluxes if( element_list(el).eq.carbon12_element )then + + ! These L2FR diagnostics are weighted by fineroot carbon biomass + hio_l2fr_si(io_si) = hio_l2fr_si(io_si) + ccohort%n*fnrt_m*ccohort%l2fr + + hio_l2fr_scpf(io_si,ccohort%size_by_pft_class) = & + hio_l2fr_scpf(io_si,ccohort%size_by_pft_class) + & + ccohort%n*fnrt_m*ccohort%l2fr + this%hvars(ih_storec_si)%r81d(io_si) = & this%hvars(ih_storec_si)%r81d(io_si) + ccohort%n * store_m this%hvars(ih_leafc_si)%r81d(io_si) = & @@ -2856,6 +2869,10 @@ subroutine update_history_dyn(this,nc,nsites,sites) cpatch => cpatch%younger end do !patch loop + ! Normalize the l2fr value by total biomass + hio_l2fr_si(io_si) = hio_l2fr_si(io_si)/this%hvars(ih_fnrtc_si)%r81d(io_si) + + ! divide so-far-just-summed but to-be-averaged patch-age-class variables by patch-age-class area to get mean values do ipa2 = 1, nlevage if (hio_area_si_age(io_si, ipa2) .gt. tiny) then @@ -2878,6 +2895,9 @@ subroutine update_history_dyn(this,nc,nsites,sites) do i_pft = 1, numpft do i_scls = 1,nlevsclass i_scpf = (i_pft-1)*nlevsclass + i_scls + + + ! ! termination mortality. sum of canopy and understory indices hio_m6_si_scpf(io_si,i_scpf) = (sites(s)%term_nindivs_canopy(i_scls,i_pft) + & @@ -3004,7 +3024,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_m4_si_scpf(io_si,i_scpf) + & hio_m5_si_scpf(io_si,i_scpf) + & hio_m6_si_scpf(io_si,i_scpf) + & - hio_m7_si_scpf(io_si,i_scpf) + & + hio_m7_si_scpf(io_si,i_scpf) + & hio_m8_si_scpf(io_si,i_scpf) + & hio_m9_si_scpf(io_si,i_scpf) + & hio_m10_si_scpf(io_si,i_scpf) @@ -3157,8 +3177,6 @@ subroutine update_history_dyn(this,nc,nsites,sites) area_frac = cpatch%area * AREA_INV - - ! Sum up all output fluxes (fragmentation) hio_litter_out_elem(io_si,el) = hio_litter_out_elem(io_si,el) + & (sum(litt%leaf_fines_frag(:)) + & @@ -3302,7 +3320,12 @@ subroutine update_history_dyn(this,nc,nsites,sites) do i_pft = 1, numpft do i_scls = 1,nlevsclass i_scpf = (i_pft-1)*nlevsclass + i_scls - + + if(this%hvars(ih_fnrtc_scpf)%r82d(io_si,i_scpf)>nearzero)then + hio_l2fr_scpf(io_si,i_scpf) = hio_l2fr_scpf(io_si,i_scpf) / & + this%hvars(ih_fnrtc_scpf)%r82d(io_si,i_scpf) + end if + if( hio_nplant_canopy_si_scpf(io_si,i_scpf)>nearzero ) then this%hvars(ih_storentfrac_canopy_scpf)%r82d(io_si,i_scpf) = & this%hvars(ih_storentfrac_canopy_scpf)%r82d(io_si,i_scpf) / & @@ -4244,12 +4267,23 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_ncohorts_si) - ! Patch variables call this%set_history_var(vname='TRIMMING', units='none', & long='Degree to which canopy expansion is limited by leaf economics', & use_default='active', & avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_trimming_si) + + call this%set_history_var(vname='LEAF2FNRT', units='none', & + long='The leaf to fineroot biomass multiplier for target allometry', & + use_default='active', & + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_l2fr_si) + + call this%set_history_var(vname='LEAF2FNRT_SCPF', units='none', & + long='The leaf to fineroot biomass multiplier for target allometry', & + use_default='active', & + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_l2fr_scpf) call this%set_history_var(vname='AREA_PLANT', units='m2/m2', & long='area occupied by all plants', use_default='active', & @@ -4592,6 +4626,8 @@ subroutine define_history_vars(this, initialize_variables) ivar=ivar, initialize=initialize_variables, index = ih_burnt_frac_litter_si_fuel ) + + ! Litter Variables call this%set_history_var(vname='LITTER_IN', units='gC m-2 s-1', & diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 0156beb2dc..46abeb14ab 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -49,8 +49,8 @@ module FatesInterfaceMod use FatesConstantsMod , only : coupled_p_uptake use FatesConstantsMod , only : coupled_n_uptake use FatesConstantsMod , only : fates_np_comp_scaling - use FatesConstantsMod , only : cohort_np_comp_scaling - use FatesConstantsMod , only : pft_np_comp_scaling + use FatesConstantsMod , only : coupled_np_comp_scaling + use FatesConstantsMod , only : trivial_np_comp_scaling use PRTGenericMod , only : num_elements use PRTGenericMod , only : element_list use PRTGenericMod , only : element_pos @@ -214,13 +214,6 @@ subroutine set_bcpconst(bc_pconst,nlevdecomp) bc_pconst%eca_alpha_ptase(1:numpft) = EDPftvarcon_inst%eca_alpha_ptase(1:numpft) bc_pconst%eca_lambda_ptase(1:numpft) = EDPftvarcon_inst%eca_lambda_ptase(1:numpft) bc_pconst%eca_plant_escalar = eca_plant_escalar - if(fates_np_comp_scaling.eq.cohort_np_comp_scaling) then - bc_pconst%j_uptake(1:nlevdecomp) = 1 - else - do j=1,nlevdecomp - bc_pconst%j_uptake(j) = j - end do - end if return end subroutine set_bcpconst @@ -421,15 +414,9 @@ subroutine allocate_bcin(bc_in, nlevsoil_in, nlevdecomp_in, num_lu_harvest_cats) ! Allocating differently could save a lot of memory and time if (hlm_parteh_mode .eq. prt_cnp_flex_allom_hyp) then - if(fates_np_comp_scaling.eq.cohort_np_comp_scaling) then - allocate(bc_in%plant_nh4_uptake_flux(max_comp_per_site,1)) - allocate(bc_in%plant_no3_uptake_flux(max_comp_per_site,1)) - allocate(bc_in%plant_p_uptake_flux(max_comp_per_site,1)) - else - allocate(bc_in%plant_nh4_uptake_flux(max_comp_per_site,bc_in%nlevdecomp)) - allocate(bc_in%plant_no3_uptake_flux(max_comp_per_site,bc_in%nlevdecomp)) - allocate(bc_in%plant_p_uptake_flux(max_comp_per_site,bc_in%nlevdecomp)) - end if + allocate(bc_in%plant_nh4_uptake_flux(max_comp_per_site,1)) + allocate(bc_in%plant_no3_uptake_flux(max_comp_per_site,1)) + allocate(bc_in%plant_p_uptake_flux(max_comp_per_site,1)) else allocate(bc_in%plant_nh4_uptake_flux(1,1)) allocate(bc_in%plant_no3_uptake_flux(1,1)) @@ -569,15 +556,17 @@ subroutine allocate_bcout(bc_out, nlevsoil_in, nlevdecomp_in) ! When FATES does not have nutrients enabled, these ! arrays are indexed by 1. - if(trim(hlm_nu_com).eq.'RD') then - allocate(bc_out%n_demand(max_comp_per_site)) - allocate(bc_out%p_demand(max_comp_per_site)) - end if - + !if(trim(hlm_nu_com).eq.'RD') then + ! allocate(bc_out%n_demand(max_comp_per_site)) + ! allocate(bc_out%p_demand(max_comp_per_site)) + !end if + + ! Used in both + allocate(bc_out%veg_rootc(max_comp_per_site,nlevdecomp_in)) + allocate(bc_out%ft_index(max_comp_per_site)) + if(trim(hlm_nu_com).eq.'ECA') then - allocate(bc_out%veg_rootc(max_comp_per_site,nlevdecomp_in)) allocate(bc_out%decompmicc(nlevdecomp_in)) - allocate(bc_out%ft_index(max_comp_per_site)) allocate(bc_out%cn_scalar(max_comp_per_site)) allocate(bc_out%cp_scalar(max_comp_per_site)) end if @@ -772,20 +761,33 @@ subroutine SetFatesGlobalElements(use_fates) ! Note: since BGC code may be active even when no nutrients ! present, we still need to allocate things when no nutrients + + if (any(abs(EDPftvarcon_inst%prescribed_nuptake(:)) > nearzero )) then + n_uptake_mode = prescribed_n_uptake + else + n_uptake_mode = coupled_n_uptake + end if + + if (any(abs(EDPftvarcon_inst%prescribed_puptake(:)) > nearzero )) then + p_uptake_mode = prescribed_p_uptake + else + p_uptake_mode = coupled_p_uptake + end if + if (hlm_parteh_mode .eq. prt_cnp_flex_allom_hyp ) then - if(fates_np_comp_scaling.eq.cohort_np_comp_scaling) then + + if((p_uptake_mode==coupled_p_uptake) .or. (n_uptake_mode==coupled_n_uptake))then max_comp_per_site = fates_maxElementsPerSite - elseif(fates_np_comp_scaling.eq.pft_np_comp_scaling) then - max_comp_per_site = numpft + fates_np_comp_scaling = coupled_np_comp_scaling else - write(fates_log(), *) 'An unknown nutrient competitor scaling method was chosen?' - call endrun(msg=errMsg(sourcefile, __LINE__)) + max_comp_per_site = 1 + fates_np_comp_scaling = trivial_np_comp_scaling end if + else max_comp_per_site = 1 + fates_np_comp_scaling = trivial_np_comp_scaling end if - - ! Identify number of size and age class bins for history output ! assume these arrays are 1-indexed diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 1052ef251e..5dee182d1a 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -628,10 +628,10 @@ module FatesInterfaceTypesMod ! RD Nutrient Boundary Conditions ! --------------------------------------------------------------------------------- - real(r8), pointer :: n_demand(:) ! Nitrogen demand from each competitor - ! for use in ELMs CTC/RD [g/m2/s] - real(r8), pointer :: p_demand(:) ! Phosophorus demand from each competitor - ! for use in ELMs CTC/RD [g/m2/s] + !real(r8), pointer :: n_demand(:) ! Nitrogen demand from each competitor + ! ! for use in ELMs CTC/RD [g/m2/s] + !real(r8), pointer :: p_demand(:) ! Phosophorus demand from each competitor + ! ! for use in ELMs CTC/RD [g/m2/s] ! CH4 Boundary Conditions diff --git a/parteh/PRTAllometricCNPMod.F90 b/parteh/PRTAllometricCNPMod.F90 index 109cb4cf0d..56c5f13ff7 100644 --- a/parteh/PRTAllometricCNPMod.F90 +++ b/parteh/PRTAllometricCNPMod.F90 @@ -394,14 +394,6 @@ subroutine DailyPRTAllometricCNP(this) real(r8) :: p_gain0 real(r8) :: maint_r_def0 - ! Knowing the stored N and P helps - ! to identify if the plant is net - ! gaining nutrients after replacement - real(r8) :: n_store0 - real(r8) :: p_store0 - real(r8) :: net_n_gain - real(r8) :: net_p_gain - ! Used for mass checking, total mass allocated based ! on change in the states, should match gain0's real(r8) :: allocated_c @@ -435,7 +427,7 @@ subroutine DailyPRTAllometricCNP(this) ! In/out boundary conditions maint_r_def => this%bc_inout(acnp_bc_inout_id_rmaint_def)%rval; maint_r_def0 = maint_r_def dbh => this%bc_inout(acnp_bc_inout_id_dbh)%rval; dbh0 = dbh - l2fr => this%bc_out(acnp_bc_inout_id_l2fr)%rval + l2fr => this%bc_inout(acnp_bc_inout_id_l2fr)%rval ! If more than 1 leaf age bin is present, this @@ -488,6 +480,17 @@ subroutine DailyPRTAllometricCNP(this) end do + ! =================================================================================== + ! Step 1: Evaluate nutrient storage in the plant. Depending on how low + ! these stores are, we will move proportionally more or less of the daily carbon + ! gain to increase the target fine-root biomass, fill up to target + ! and then attempt to get them up to stoichiometry targets. + ! =================================================================================== + + ! This routine actually just updates the l2fr variable + call this%CNPAdjustFRootTargets() + call bfineroot(dbh,ipft,canopy_trim, l2fr, target_c(fnrt_id), target_dcdd(fnrt_id)) + ! =================================================================================== ! Step 0. Transfer all stored nutrient into the daily uptake pool. ! Storage in nutrients does not need to have a buffer like @@ -495,28 +498,15 @@ subroutine DailyPRTAllometricCNP(this) ! anything left at the end is added back (CNPAllocateRemainder()) ! =================================================================================== + + i_var = prt_global%sp_organ_map(store_organ,nitrogen_element) n_gain = n_gain + sum(this%variables(i_var)%val(:)) - net_n_gain = - sum(this%variables(i_var)%val(:)) this%variables(i_var)%val(:) = 0._r8 i_var = prt_global%sp_organ_map(store_organ,phosphorus_element) p_gain = p_gain + sum(this%variables(i_var)%val(:)) - net_p_gain = - sum(this%variables(i_var)%val(:)) this%variables(i_var)%val(:) = 0._r8 - - - ! =================================================================================== - ! Step 1: Evaluate nutrient storage in the plant. Depending on how low - ! these stores are, we will move proportionally more or less of the daily carbon - ! gain to increase the target fine-root biomass, fill up to target - ! and then attempt to get them up to stoichiometry targets. - ! =================================================================================== - - ! This routine actually just updates the l2fr variable - call this%CNPAdjustFRootTargets() - - call bfineroot(dbh,ipft,canopy_trim, l2fr, target_c(fnrt_id), target_dcdd(fnrt_id)) ! =================================================================================== ! Step 2. Prioritized allocation to replace tissues from turnover, and/or pay @@ -548,11 +538,7 @@ subroutine DailyPRTAllometricCNP(this) ! targets based on prioritized relative demand and allometry functions. ! =================================================================================== - net_n_gain = net_n_gain + n_gain - net_p_gain = net_p_gain + p_gain - call this%CNPStatureGrowth(c_gain, n_gain, p_gain, & - net_n_gain, net_p_gain, & state_c, state_n, state_p, target_c, target_dcdd, cnp_limiter) sum_c = 0._r8 @@ -676,8 +662,8 @@ subroutine CNPAdjustFRootTargets(this) associate( l2fr_min => prt_params%allom_l2fr_min(ipft), & l2fr_max => prt_params%allom_l2fr_max(ipft)) - n_regulator = this%StorageRegulator(nitrogen_element, regulate_logi) - p_regulator = this%StorageRegulator(phosphorus_element, regulate_logi) + call this%StorageRegulator(nitrogen_element, regulate_logi,n_regulator) + call this%StorageRegulator(phosphorus_element, regulate_logi,p_regulator) ! We take the maximum here, because the maximum is reflective of the ! element with the lowest storage, which is the limiting element @@ -686,8 +672,9 @@ subroutine CNPAdjustFRootTargets(this) ! Update the leaf-to-fineroot ratio used ! to set fine-root biomass allometry - l2fr = l2fr_min + np_regulator*(l2fr_max-l2fr_min) + l2fr = l2fr_min + max(0._r8,min(1.0_r8,np_regulator))*(l2fr_max-l2fr_min) + ! Find the updated target fineroot biomass ! call bfineroot(dbh,ipft,canopy_trim, l2fr, target_fnrt) @@ -1090,7 +1077,7 @@ end subroutine CNPPrioritizedReplacement ! ===================================================================================== - subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, net_n_gain, net_p_gain, & + subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & state_c, state_n, state_p, & target_c, target_dcdd, cnp_limiter) @@ -1101,10 +1088,6 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, net_n_gain, net_p_gain, ! (new uptake + storage) real(r8), intent(inout) :: p_gain ! Total P available for allocation ! (new uptake + storage) - real(r8), intent(in) :: net_n_gain ! How much N was gained or lost in the - ! process of net uptake and turnover replacment - real(r8), intent(in) :: net_p_gain ! How much P was gained or lost in the - ! process of net uptake and turnover replacment type(parray_type) :: state_c(:) ! State array for carbon, by organ [kg] type(parray_type) :: state_n(:) ! State array for N, by organ [kg] type(parray_type) :: state_p(:) ! State array for P, by organ [kg] @@ -1223,9 +1206,9 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, net_n_gain, net_p_gain, p_stf = max(state_p(store_id)%ptr/target_p,0._r8) if( c_gain <= calloc_abs_error .or. & - leaf_status.eq.leaves_off .or. & - (n_stf < min_stf_growth ) .or. & !.and. net_n_gain < 0._r8) .or. & - (p_stf < min_stf_growth ) ) then !.and. net_p_gain < 0._r8) ) then + leaf_status.eq.leaves_off .or. & + n_gain <= 0.1_r8*calloc_abs_error .or. & + p_gain <= 0.02_r8*calloc_abs_error ) then return end if @@ -1233,7 +1216,7 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, net_n_gain, net_p_gain, intgr_params(:) = fates_unset_r8 intgr_params(intgr_parm_ctrim) = this%bc_in(acnp_bc_in_id_ctrim)%rval intgr_params(intgr_parm_pft) = real(this%bc_in(acnp_bc_in_id_pft)%ival) - intgr_params(intgr_parm_l2fr) = this%bc_in(acnp_bc_inout_id_l2fr)%rval + intgr_params(intgr_parm_l2fr) = this%bc_inout(acnp_bc_inout_id_l2fr)%rval state_mask(:) = .false. mask_organs(:) = fates_unset_int @@ -1652,11 +1635,11 @@ subroutine CNPAllocateRemainder(this,c_gain, n_gain, p_gain, & ! If any N or P is still hanging around, put it in storage - state_n(store_id)%ptr = state_n(store_id)%ptr + n_gain - state_p(store_id)%ptr = state_p(store_id)%ptr + p_gain + !state_n(store_id)%ptr = state_n(store_id)%ptr + n_gain + !state_p(store_id)%ptr = state_p(store_id)%ptr + p_gain - n_gain = 0._r8 - p_gain = 0._r8 + !n_gain = 0._r8 + !p_gain = 0._r8 ! ----------------------------------------------------------------------------------- @@ -1689,13 +1672,13 @@ subroutine CNPAllocateRemainder(this,c_gain, n_gain, p_gain, & ! ----------------------------------------------------------------------------------- c_efflux = max(0.0_r8,c_gain) -! n_efflux = max(0.0_r8,n_gain) -! p_efflux = max(0.0_r8,p_gain) + n_efflux = max(0.0_r8,n_gain) + p_efflux = max(0.0_r8,p_gain) c_gain = 0.0_r8 -! n_gain = 0.0_r8 -! p_gain = 0.0_r8 + n_gain = 0.0_r8 + p_gain = 0.0_r8 return end subroutine CNPAllocateRemainder @@ -2345,7 +2328,7 @@ end subroutine TargetAllometryCheck ! ===================================================================================== - function StorageRegulator(this,element_id,regulate_type) result(c_scalar) + subroutine StorageRegulator(this,element_id,regulate_type,c_scalar) ! ----------------------------------------------------------------------------------- ! This function returns the cn_scalar or cp_scalar term @@ -2376,11 +2359,15 @@ function StorageRegulator(this,element_id,regulate_type) result(c_scalar) real(r8) :: store_c ! Current storage carbon real(r8) :: store_c_max ! Current maximum storage carbon integer :: icode ! real variable checking code + real(r8) :: store_x + integer :: i_var - real(r8), parameter :: logi_k = 30.0_r8 ! logistic function k - real(r8), parameter :: store_x0 = 0.7_r8 ! storage fraction inflection point - real(r8), parameter :: logi_min = 0.0_r8 ! minimum cn_scalar for logistic + ! For N/C logistic + real(r8) :: logi_k ! logistic function k + real(r8) :: store_x0 ! storage fraction inflection point + real(r8) :: logi_min ! minimum cn_scalar for logistic + ! This is the storage fraction where downregulation starts if using ! a linear function real(r8), parameter :: store_frac0 = 0.85_r8 @@ -2399,12 +2386,19 @@ function StorageRegulator(this,element_id,regulate_type) result(c_scalar) ! The cap of 2 is for numerics and preventing weird math store_frac = min(2.0_r8,this%GetState(store_organ, element_id)/store_max) + i_var = prt_global%sp_organ_map(store_organ,element_id ) + store_x = sum(this%variables(i_var)%val(:)) + if(regulate_type == regulate_linear) then c_scalar = min(c_max,max(c_min,1.0 - (store_frac - store_frac0)/(1.0_r8-store_frac0))) elseif(regulate_type == regulate_logi) then + logi_k = 30.0_r8 + store_x0 = 0.7_r8 + logi_min = 0.0_r8 + ! In this method, we define the c_scalar term ! with a logistic function that goes to 1 (full need) ! as the plant's nutrien storage hits a low threshold @@ -2422,6 +2416,10 @@ function StorageRegulator(this,element_id,regulate_type) result(c_scalar) else + logi_k = 30.0_r8 + store_x0 = 1.0_r8 + logi_min = 0.0_r8 + store_c = this%GetState(store_organ, carbon12_element) call bstore_allom(dbh,ipft,canopy_trim,store_c_max) @@ -2430,7 +2428,7 @@ function StorageRegulator(this,element_id,regulate_type) result(c_scalar) ! we have C, so we downregulate. If this is less than 1, then ! we have less N in storage than we have C, so up-regulate - store_frac = store_frac / (store_c/store_c_max) + store_frac = max(0.1_r8,store_frac) / max(0.1_r8,(store_c/store_c_max)) c_scalar = max(c_min,min(c_max,logi_min + (1.0_r8-logi_min)/(1.0_r8 + exp(logi_k*(store_frac-store_x0))))) @@ -2439,7 +2437,7 @@ function StorageRegulator(this,element_id,regulate_type) result(c_scalar) end associate - end function StorageRegulator + end subroutine StorageRegulator From e1d88b1fdb2110927bfb3061c94dd2fed44c3499 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Tue, 23 Nov 2021 21:25:39 -0500 Subject: [PATCH 08/55] version 2 of fates nutrient aquisition, bug fixes and enabling dynamic roots --- main/FatesHistoryInterfaceMod.F90 | 32 +++- parteh/PRTAllometricCNPMod.F90 | 272 +++++------------------------- 2 files changed, 69 insertions(+), 235 deletions(-) diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index b7b1ae2f34..8675cf1141 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -62,13 +62,14 @@ module FatesHistoryInterfaceMod use FatesConstantsMod , only : years_per_day use FatesLitterMod , only : litter_type use FatesConstantsMod , only : secondaryforest - + use FatesAllometryMod , only : bstore_allom use PRTGenericMod , only : leaf_organ, fnrt_organ, sapw_organ use PRTGenericMod , only : struct_organ, store_organ, repro_organ use PRTGenericMod , only : all_carbon_elements use PRTGenericMod , only : carbon12_element use PRTGenericMod , only : nitrogen_element, phosphorus_element use PRTGenericMod , only : prt_carbon_allom_hyp + use PRTAllometricCNPMod , only : stoich_max implicit none private ! By default everything is private @@ -148,6 +149,7 @@ module FatesHistoryInterfaceMod ! Indices to 1D Patch variables integer :: ih_storec_si + integer :: ih_storectfrac_si integer :: ih_leafc_si integer :: ih_sapwc_si integer :: ih_fnrtc_si @@ -2283,6 +2285,12 @@ subroutine update_history_dyn(this,nc,nsites,sites) this%hvars(ih_storec_si)%r81d(io_si) = & this%hvars(ih_storec_si)%r81d(io_si) + ccohort%n * store_m + + call bstore_allom(ccohort%dbh,ccohort%pft,ccohort%canopy_trim, store_max) + this%hvars(ih_storectfrac_si)%r81d(io_si) = & + this%hvars(ih_storectfrac_si)%r81d(io_si) + ccohort%n * store_max + + this%hvars(ih_leafc_si)%r81d(io_si) = & this%hvars(ih_leafc_si)%r81d(io_si) + ccohort%n * leaf_m this%hvars(ih_fnrtc_si)%r81d(io_si) = & @@ -2332,7 +2340,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) elseif(element_list(el).eq.nitrogen_element)then - store_max = ccohort%prt%GetNutrientTarget(element_list(el),store_organ) + store_max = ccohort%prt%GetNutrientTarget(element_list(el),store_organ,stoich_max) this%hvars(ih_storen_si)%r81d(io_si) = & this%hvars(ih_storen_si)%r81d(io_si) + ccohort%n * store_m @@ -2352,7 +2360,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) elseif(element_list(el).eq.phosphorus_element) then - store_max = ccohort%prt%GetNutrientTarget(element_list(el),store_organ) + store_max = ccohort%prt%GetNutrientTarget(element_list(el),store_organ,stoich_max) this%hvars(ih_storep_si)%r81d(io_si) = & this%hvars(ih_storep_si)%r81d(io_si) + ccohort%n * store_m @@ -3251,7 +3259,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) this%hvars(ih_reproc_scpf)%r82d(io_si,i_scpf) + repro_m * ccohort%n elseif(element_list(el).eq.nitrogen_element)then - store_max = ccohort%prt%GetNutrientTarget(element_list(el),store_organ) + store_max = ccohort%prt%GetNutrientTarget(element_list(el),store_organ,stoich_max) this%hvars(ih_totvegn_scpf)%r82d(io_si,i_scpf) = & this%hvars(ih_totvegn_scpf)%r82d(io_si,i_scpf) + total_m * ccohort%n @@ -3276,7 +3284,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) elseif(element_list(el).eq.phosphorus_element)then - store_max = ccohort%prt%GetNutrientTarget(element_list(el),store_organ) + store_max = ccohort%prt%GetNutrientTarget(element_list(el),store_organ,stoich_max) this%hvars(ih_totvegp_scpf)%r82d(io_si,i_scpf) = & this%hvars(ih_totvegp_scpf)%r82d(io_si,i_scpf) + total_m * ccohort%n @@ -3312,7 +3320,14 @@ subroutine update_history_dyn(this,nc,nsites,sites) ! Normalize nutrient storage fractions do el = 1, num_elements - if(element_list(el).eq.nitrogen_element)then + + if(element_list(el).eq.carbon12_element)then + if( this%hvars(ih_storectfrac_si)%r81d(io_si)>nearzero ) then + this%hvars(ih_storectfrac_si)%r81d(io_si) = this%hvars(ih_storec_si)%r81d(io_si) / & + this%hvars(ih_storectfrac_si)%r81d(io_si) + end if + + elseif(element_list(el).eq.nitrogen_element)then if( this%hvars(ih_storentfrac_si)%r81d(io_si)>nearzero ) then this%hvars(ih_storentfrac_si)%r81d(io_si) = this%hvars(ih_storen_si)%r81d(io_si) / & this%hvars(ih_storentfrac_si)%r81d(io_si) @@ -4691,6 +4706,11 @@ subroutine define_history_vars(this, initialize_variables) long='Total carbon in live plant storage', use_default='active', & avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_storec_si ) + + call this%set_history_var(vname='STOREC_TFRAC', units='-', & + long='Storage C fraction of target', use_default='active', & + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_storectfrac_si ) call this%set_history_var(vname='TOTVEGC', units='kgC ha-1', & long='Total carbon in live plants', use_default='active', & diff --git a/parteh/PRTAllometricCNPMod.F90 b/parteh/PRTAllometricCNPMod.F90 index 56c5f13ff7..e20c2febce 100644 --- a/parteh/PRTAllometricCNPMod.F90 +++ b/parteh/PRTAllometricCNPMod.F90 @@ -234,8 +234,6 @@ module PRTAllometricCNPMod procedure :: CNPAdjustFRootTargets procedure :: CNPAllocateRemainder procedure :: GetDeficit - procedure :: GrowEquivC - procedure :: NAndPToMatchC procedure :: StorageRegulator end type cnp_allom_prt_vartypes @@ -630,8 +628,8 @@ subroutine DailyPRTAllometricCNP(this) end if end if - target_n = this%GetNutrientTarget(nitrogen_element,store_organ) - target_p = this%GetNutrientTarget(phosphorus_element,store_organ) + target_n = this%GetNutrientTarget(nitrogen_element,store_organ,stoich_max) + target_p = this%GetNutrientTarget(phosphorus_element,store_organ,stoich_max) n_need = target_n - state_n(store_id)%ptr p_need = target_p - state_p(store_id)%ptr @@ -662,8 +660,8 @@ subroutine CNPAdjustFRootTargets(this) associate( l2fr_min => prt_params%allom_l2fr_min(ipft), & l2fr_max => prt_params%allom_l2fr_max(ipft)) - call this%StorageRegulator(nitrogen_element, regulate_logi,n_regulator) - call this%StorageRegulator(phosphorus_element, regulate_logi,p_regulator) + call this%StorageRegulator(nitrogen_element, regulate_CN_logi,n_regulator) + call this%StorageRegulator(phosphorus_element, regulate_CN_logi,p_regulator) ! We take the maximum here, because the maximum is reflective of the ! element with the lowest storage, which is the limiting element @@ -811,10 +809,10 @@ subroutine CNPPrioritizedReplacement(this, & ! ----------------------------------------------------------------------------------- sum_c_demand = 0._r8 - do ii = 1,n_curpri_org - i = curpri_org(ii) + do i = 1,n_curpri_org + ii = curpri_org(i) - i_cvar = prt_global%sp_organ_map(organ_list(i),carbon12_element) + i_cvar = prt_global%sp_organ_map(organ_list(ii),carbon12_element) sum_c_demand = sum_c_demand + prt_params%leaf_stor_priority(ipft) * & sum(this%variables(i_cvar)%turnover(:)) @@ -914,7 +912,7 @@ subroutine CNPPrioritizedReplacement(this, & store_c_flux = min(store_below_target,store_demand) c_gain = c_gain - store_c_flux - state_c(store_id)%ptr = state_c(store_id)%ptr + store_c_flux + state_c(store_id)%ptr = state_c(store_id)%ptr + store_c_flux end if @@ -1036,14 +1034,11 @@ subroutine CNPPrioritizedReplacement(this, & end do end if - - - ! Determine nutrient demand and make tansfers do i = 1, n_curpri_org i_org = curpri_org(i) - if(organ_list(i_org).ne.store_organ)then +! if(organ_list(i_org).ne.store_organ)then ! Update the nitrogen deficits ! Note that the nitrogen target is tied to the stoichiometry of thegrowing pool only target_n = this%GetNutrientTarget(nitrogen_element,organ_list(i_org),stoich_growth_min) @@ -1053,10 +1048,10 @@ subroutine CNPPrioritizedReplacement(this, & ! Note that the phsophorus target is tied to the stoichiometry of thegrowing pool only (also) target_p = this%GetNutrientTarget(phosphorus_element,organ_list(i_org),stoich_growth_min) deficit_p(i_org) = max(0.0_r8, target_p - state_p(i_org)%ptr ) - else - deficit_n(i_org) = 0._r8 - deficit_p(i_org) = 0._r8 - end if +! else +! deficit_n(i_org) = 0._r8 +! deficit_p(i_org) = 0._r8 +! end if end do ! Allocate nutrients at this priority level @@ -1070,6 +1065,9 @@ subroutine CNPPrioritizedReplacement(this, & end do priority_loop + + + return end subroutine CNPPrioritizedReplacement @@ -1532,23 +1530,17 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & sum_n_demand = 0._r8 ! For error checking sum_p_demand = 0._r8 ! For error checking do ii = 1, n_mask_organs + i = mask_organs(ii) - if(organ_list(i).ne.store_organ)then - ! Update the nitrogen deficits (which are based off of carbon actual..) - ! Note that the nitrogen target is tied to the stoichiometry of thegrowing pool only - target_n = this%GetNutrientTarget(nitrogen_element,organ_list(i),stoich_growth_min) - deficit_n(i) = this%GetDeficit(nitrogen_element,organ_list(i),target_n) - sum_n_demand = sum_n_demand+max(0._r8,deficit_n(i)) - - ! Update the nitrogen deficits (which are based off of carbon actual..) - ! Note that the nitrogen target is tied to the stoichiometry of thegrowing pool only - target_p = this%GetNutrientTarget(phosphorus_element,organ_list(i),stoich_growth_min) - deficit_p(i) = this%GetDeficit(phosphorus_element,organ_list(i),target_p) - sum_p_demand = sum_p_demand+max(0._r8,deficit_p(i)) - else - deficit_n(i) = 0._r8 - deficit_p(i) = 0._r8 - end if + + target_n = this%GetNutrientTarget(nitrogen_element,organ_list(i),stoich_growth_min) + target_p = this%GetNutrientTarget(phosphorus_element,organ_list(i),stoich_growth_min) + + deficit_n(i) = this%GetDeficit(nitrogen_element,organ_list(i),target_n) + sum_n_demand = sum_n_demand+max(0._r8,deficit_n(i)) + + deficit_p(i) = this%GetDeficit(phosphorus_element,organ_list(i),target_p) + sum_p_demand = sum_p_demand+max(0._r8,deficit_p(i)) end do @@ -1590,7 +1582,7 @@ subroutine CNPAllocateRemainder(this,c_gain, n_gain, p_gain, & real(r8) :: store_c_target ! Target amount of C in storage including "overflow" [kgC] real(r8) :: total_c_flux ! Total C flux from gains into storage and growth R [kgC] real(r8) :: growth_r_flux ! Growth respiration for filling storage [kgC] - real(r8) :: store_c_flux ! Flux into storage [kgC] + real(r8) :: store_m_flux ! Flux into storage [kg] integer, dimension(num_organs),parameter :: all_organs = [1,2,3,4,5,6] real(r8), pointer :: dbh integer :: ipft @@ -1600,7 +1592,8 @@ subroutine CNPAllocateRemainder(this,c_gain, n_gain, p_gain, & dbh => this%bc_inout(acnp_bc_inout_id_dbh)%rval canopy_trim = this%bc_in(acnp_bc_in_id_ctrim)%rval ipft = this%bc_in(acnp_bc_in_id_pft)%ival - + + ! ----------------------------------------------------------------------------------- ! If nutrients are still available, then we can bump up the values in the pools ! towards the OPTIMAL target values. @@ -1633,6 +1626,7 @@ subroutine CNPAllocateRemainder(this,c_gain, n_gain, p_gain, & p_gain, phosphorus_element, all_organs) + ! Optional hypothesis ( ! If any N or P is still hanging around, put it in storage !state_n(store_id)%ptr = state_n(store_id)%ptr + n_gain @@ -1777,13 +1771,18 @@ function GetNutrientTargetCNP(this,element_id,organ_id,stoich_mode) result(targe sapw_c_target*prt_params%nitr_stoich_p2(ipft,prt_params%organ_param_id(sapw_organ)), & struct_c_target*prt_params%nitr_stoich_p2(ipft,prt_params%organ_param_id(struct_organ))) else - + target_m = StorageNutrientTarget(ipft, element_id, & leaf_c_target*prt_params%phos_stoich_p2(ipft,prt_params%organ_param_id(leaf_organ)), & fnrt_c_target*prt_params%phos_stoich_p2(ipft,prt_params%organ_param_id(fnrt_organ)), & sapw_c_target*prt_params%phos_stoich_p2(ipft,prt_params%organ_param_id(sapw_organ)), & struct_c_target*prt_params%phos_stoich_p2(ipft,prt_params%organ_param_id(struct_organ))) - + + end if + + ! Hard-code the growth minimum storage stoichiometry to 75% of maximum + if( stoich_mode == stoich_growth_min ) then + target_m = target_m*0.75_r8 end if elseif(organ_id == repro_organ) then @@ -1898,192 +1897,6 @@ subroutine ProportionalNutrAllocation(state_m, deficit_m, gain_m, element_id, li return end subroutine ProportionalNutrAllocation - ! ===================================================================================== - - - subroutine NAndPToMatchC(this,c_gain_org,dc_dd,ipft,organ_id,n_match,p_match) - - class(cnp_allom_prt_vartypes) :: this ! - real(r8),intent(in) :: c_gain_org ! Fraction of C sent to this organ - ! (does not include resp tax) - real(r8),intent(in) :: dc_dd ! derivative of the target value - integer, intent(in) :: ipft ! pft index - integer, intent(in) :: organ_id ! global organ index - real(r8), intent(inout) :: n_match ! N needed to match C growth - real(r8), intent(inout) :: p_match ! P needed to match C growth - - integer :: c_var_id ! Data array index of the carbon state variable - integer :: np_var_id ! Data array index of the N and P states - real(r8) :: grow_c ! Amount of C that would go into the organs tissue - real(r8) :: c0,d0 ! Variables to save the original C and dbh states - real(r8) :: np_target ! The target amount of N or P at the future C/DBH - - - ! All states are drawn from index 1, which is the growing index - ! for leaves, and the only index of non-leaves. Remember, if - ! this routine is being called, the initial amount of carbon - ! is the on-allometry value. - - c_var_id = prt_global%sp_organ_map(organ_id,carbon12_element) - - ! Save the current carbon and dbh state (we need dbh also - ! because nutient targets may not queue off of current mass, - ! but off of stature) - - c0 = this%variables(c_var_id)%val(1) - d0 = this%bc_inout(acnp_bc_inout_id_dbh)%rval - - ! Given the desired growth, imagine what the future C and dbh states are - this%variables(c_var_id)%val(1) = this%variables(c_var_id)%val(1)+c_gain_org - - ! Reproductive tissues may not have an allometry curve, their - ! target will be based off of actual C anyway - if(dc_dd>nearzero) then - this%bc_inout(acnp_bc_inout_id_dbh)%rval = & - this%bc_inout(acnp_bc_inout_id_dbh)%rval + c_gain_org/dc_dd - end if - - ! Calculate the nitrogen target at this future - np_var_id = prt_global%sp_organ_map(organ_id,nitrogen_element) - np_target = this%GetNutrientTarget(nitrogen_element,organ_id,stoich_growth_min) - - - ! Determine N needed to get match predicted C - n_match = n_match + max(0._r8, np_target - this%variables(np_var_id)%val(1)) - - - - ! Calculate the phosphorus target at this future - np_var_id = prt_global%sp_organ_map(organ_id,phosphorus_element) - np_target = this%GetNutrientTarget(phosphorus_element,organ_id,stoich_growth_min) - - - ! Determine P needed to get match predicted C - p_match = p_match + max(0._r8, np_target - this%variables(np_var_id)%val(1)) - - - ! Return out predictions back to their initial states - ! Save the current carbon and dbh state - this%variables(c_var_id)%val(1) = c0 - this%bc_inout(acnp_bc_inout_id_dbh)%rval = d0 - - - return - end subroutine NAndPToMatchC - - - - - ! ===================================================================================== - - subroutine GrowEquivC(this,carbon_gain,nitrogen_gain,phosphorus_gain, & - alloc_frac,ipft,organ_id,& - grow_c_from_c,grow_c_from_n,grow_c_from_p) - - ! ----------------------------------------------------------------------------------- - ! This subroutine calculates how much growth to expect in the specified organ - ! in terms of equivalent carbon, for each of C, N and P. - ! Total carbon allocated is roughly a function of how much carbon is available, - ! and the growth respiration tax. - ! Equivalent carbon allocated for each nutrient, is roughly the amount of - ! nutrient available, divided through by its stoichiometry, and also incremented - ! by any extra nutrient that may be in the tissues because of flexible stoich. - ! ----------------------------------------------------------------------------------- - - ! Arguments - class(cnp_allom_prt_vartypes) :: this ! - real(r8),intent(in) :: carbon_gain ! Total carbon available for allocation - real(r8),intent(in) :: nitrogen_gain ! Total N available for allocation - real(r8),intent(in) :: phosphorus_gain ! Total P available for allocation - real(r8),intent(in) :: alloc_frac ! - - integer,intent(in) :: ipft - integer,intent(in) :: organ_id - real(r8),intent(inout) :: grow_c_from_c - real(r8),intent(inout) :: grow_c_from_n - real(r8),intent(inout) :: grow_c_from_p - - ! Locals - real(r8) :: grow_c - real(r8) :: c_from_n_headstart - real(r8) :: c_from_n_gain - real(r8) :: c_from_p_headstart - real(r8) :: c_from_p_gain - integer :: c_var_id - integer :: n_var_id - integer :: p_var_id - real(r8) :: c_state - real(r8) :: n_target - real(r8) :: p_target - - ! Calculate gains from carbon - ! ----------------------------------------------------------------------------------- - grow_c = carbon_gain*alloc_frac - - grow_c_from_c = grow_c_from_c + grow_c - - c_var_id = prt_global%sp_organ_map(organ_id,carbon12_element) - - ! Calculate gains from Nitrogen - ! ----------------------------------------------------------------------------------- - - if(prt_params%nitr_stoich_p1(ipft,prt_params%organ_param_id(organ_id))>nearzero)then - - ! The amount of C we could match with N in the aquisition pool - c_from_n_gain = nitrogen_gain * alloc_frac / prt_params%nitr_stoich_p1(ipft,prt_params%organ_param_id(organ_id)) - - ! It is possible that the nutrient pool of interest is already above the minimum - ! requirement. In this case, we add that into the amount that the equivalent - ! carbon for that nutrient can get. Its like giving it a head start. - - n_var_id = prt_global%sp_organ_map(organ_id,nitrogen_element) - n_target = this%GetNutrientTarget(nitrogen_element,organ_id,stoich_growth_min) - - c_from_n_headstart = max(0.0_r8, sum(this%variables(n_var_id)%val(:),dim=1) - n_target ) / & - prt_params%nitr_stoich_p1(ipft,prt_params%organ_param_id(organ_id)) - - - ! Increment the amount of C that we could match with N, as the minimum - ! of what C could do itself, and what N could do. We need this minimum - ! because some pools may have excess, but those excesses cannot travel between - ! pools and contribute to the total allocation - grow_c_from_n = grow_c_from_n + min(grow_c,c_from_n_gain+c_from_n_headstart) - - - - end if - - ! Calculate gains from phosphorus - ! ----------------------------------------------------------------------------------- - - if(prt_params%phos_stoich_p1(ipft,prt_params%organ_param_id(organ_id))>nearzero) then - - - c_from_p_gain = phosphorus_gain * alloc_frac / prt_params%phos_stoich_p1(ipft,prt_params%organ_param_id(organ_id)) - - ! It is possible that the nutrient pool of interest is already above the minimum - ! requirement. In this case, we add that into the amount that the equivalent - ! carbon for that nutrient can get. Its like giving it a head start. - - p_var_id = prt_global%sp_organ_map(organ_id,phosphorus_element) - p_target = this%GetNutrientTarget(phosphorus_element,organ_id,stoich_growth_min) - - c_from_p_headstart = max(0.0_r8,sum(this%variables(p_var_id)%val(:),dim=1) - p_target ) / & - prt_params%phos_stoich_p1(ipft,prt_params%organ_param_id(organ_id)) - - ! Increment the amount of C that we could match with P, as the minimum - ! of what C could do itself, and what P could do. We need this minimum - ! because some pools may have excess, but those excesses cannot travel between - ! pools and contribute to the total allocation - grow_c_from_p = grow_c_from_p + min(grow_c,c_from_p_gain+c_from_p_headstart) - - - end if - - return - end subroutine GrowEquivC - - ! ===================================================================================== function AllomCNPGrowthDeriv(l_state_array,l_state_mask,cbalance,intgr_params) result(dCdx) @@ -2379,7 +2192,7 @@ subroutine StorageRegulator(this,element_id,regulate_type,c_scalar) canopy_trim => this%bc_in(acnp_bc_in_id_ctrim)%rval, & ipft => this%bc_in(acnp_bc_in_id_pft)%ival) - store_max = this%GetNutrientTarget(element_id,store_organ,stoich_max) + store_max = this%GetNutrientTarget(element_id,store_organ,stoich_growth_min) ! Storage fractions could more than the target, depending on the ! hypothesis and functions involved, but should typically be 0-1 @@ -2416,8 +2229,8 @@ subroutine StorageRegulator(this,element_id,regulate_type,c_scalar) else - logi_k = 30.0_r8 - store_x0 = 1.0_r8 + logi_k = 2.0_r8 + store_x0 = 0.0_r8 logi_min = 0.0_r8 store_c = this%GetState(store_organ, carbon12_element) @@ -2428,10 +2241,11 @@ subroutine StorageRegulator(this,element_id,regulate_type,c_scalar) ! we have C, so we downregulate. If this is less than 1, then ! we have less N in storage than we have C, so up-regulate - store_frac = max(0.1_r8,store_frac) / max(0.1_r8,(store_c/store_c_max)) + store_frac = log(max(0.01_r8,store_frac) / max(0.01_r8,(store_c/store_c_max))) - c_scalar = max(c_min,min(c_max,logi_min + (1.0_r8-logi_min)/(1.0_r8 + exp(logi_k*(store_frac-store_x0))))) + c_scalar = max(0._r8,min(1._r8,logi_min + (1._r8-logi_min)/(1.0 + exp(logi_k*(store_frac-store_x0))))) + end if end associate From 561750f0d7a01a1411e2469149d6f7afc16d0394 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Fri, 3 Dec 2021 13:59:56 -0500 Subject: [PATCH 09/55] Updates to fates nutrient coupling and feedback algorithm. Modified plants to hold overflow storage in the CNP version, which prevents dumping to soil which would otherwise promote decomposition from reducing mineralized pools. Also, changed storage nutrients to not key off of target root biomass, which was creating an instability in the dynamic root code. --- biogeochem/EDCohortDynamicsMod.F90 | 17 ------------- biogeochem/FatesSoilBGCFluxMod.F90 | 20 +++++++--------- main/EDInitMod.F90 | 2 +- main/EDMainMod.F90 | 12 +++++----- main/EDTypesMod.F90 | 17 ++++--------- main/FatesHistoryInterfaceMod.F90 | 36 ++++++++++++++-------------- main/FatesRestartInterfaceMod.F90 | 20 ---------------- parteh/PRTAllometricCNPMod.F90 | 38 ++++++++++++++---------------- parteh/PRTGenericMod.F90 | 6 ++--- 9 files changed, 58 insertions(+), 110 deletions(-) diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index 341cf3c836..ea0024eb04 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -95,8 +95,6 @@ module EDCohortDynamicsMod use PRTAllometricCNPMod, only : acnp_bc_in_id_netdnh4, acnp_bc_in_id_netdno3, acnp_bc_in_id_netdp use PRTAllometricCNPMod, only : acnp_bc_out_id_cefflux, acnp_bc_out_id_nefflux use PRTAllometricCNPMod, only : acnp_bc_out_id_pefflux - use PRTAllometricCNPMod, only : acnp_bc_out_id_nneed - use PRTAllometricCNPMod, only : acnp_bc_out_id_pneed use shr_infnan_mod, only : nan => shr_infnan_nan, assignment(=) @@ -422,8 +420,6 @@ subroutine InitPRTBoundaryConditions(new_cohort) call new_cohort%prt%RegisterBCOut(acnp_bc_out_id_cefflux, bc_rval = new_cohort%daily_c_efflux) call new_cohort%prt%RegisterBCOut(acnp_bc_out_id_nefflux, bc_rval = new_cohort%daily_n_efflux) call new_cohort%prt%RegisterBCOut(acnp_bc_out_id_pefflux, bc_rval = new_cohort%daily_p_efflux) - call new_cohort%prt%RegisterBCOut(acnp_bc_out_id_nneed, bc_rval = new_cohort%daily_n_need) - call new_cohort%prt%RegisterBCOut(acnp_bc_out_id_pneed, bc_rval = new_cohort%daily_p_need) case DEFAULT @@ -576,8 +572,6 @@ subroutine nan_cohort(cc_p) currentCohort%daily_c_efflux = nan currentCohort%daily_n_efflux = nan currentCohort%daily_p_efflux = nan - currentCohort%daily_n_need = nan - currentCohort%daily_p_need = nan currentCohort%daily_n_demand = nan currentCohort%daily_p_demand = nan @@ -695,9 +689,6 @@ subroutine zero_cohort(cc_p) currentCohort%daily_c_efflux = 0._r8 currentCohort%daily_n_efflux = 0._r8 currentCohort%daily_p_efflux = 0._r8 - - currentCohort%daily_n_need = 0._r8 - currentCohort%daily_p_need = 0._r8 ! Initialize these as negative currentCohort%daily_p_demand = -9._r8 @@ -1429,12 +1420,6 @@ subroutine fuse_cohorts(currentSite, currentPatch, bc_in) currentCohort%daily_p_efflux = (currentCohort%n*currentCohort%daily_p_efflux + & nextc%n*nextc%daily_p_efflux)/newn - currentCohort%daily_n_need = (currentCohort%n*currentCohort%daily_n_need + & - nextc%n*nextc%daily_n_need)/newn - currentCohort%daily_p_need = (currentCohort%n*currentCohort%daily_p_need + & - nextc%n*nextc%daily_p_need)/newn - - ! logging mortality, Yi Xu currentCohort%lmort_direct = (currentCohort%n*currentCohort%lmort_direct + & nextc%n*nextc%lmort_direct)/newn @@ -1835,8 +1820,6 @@ subroutine copy_cohort( currentCohort,copyc ) n%daily_c_efflux = o%daily_c_efflux n%daily_n_efflux = o%daily_n_efflux n%daily_p_efflux = o%daily_p_efflux - n%daily_n_need = o%daily_n_need - n%daily_p_need = o%daily_p_need n%daily_n_demand = o%daily_n_demand n%daily_p_demand = o%daily_p_demand diff --git a/biogeochem/FatesSoilBGCFluxMod.F90 b/biogeochem/FatesSoilBGCFluxMod.F90 index e3dd7a76f1..90b79559a2 100644 --- a/biogeochem/FatesSoilBGCFluxMod.F90 +++ b/biogeochem/FatesSoilBGCFluxMod.F90 @@ -121,7 +121,7 @@ function GetPlantDemand(ccohort,element_id) result(plant_demand) real(r8) :: plant_max_x ! Maximum mass for element of interest [kg] integer :: pft real(r8) :: dbh - real(r8) :: leafm,fnrtm,sapwm,structm,storem + real(r8) :: fnrt_c real(r8), parameter :: smth_fac = 0.1_r8 ! Smoothing factor for updating ! demand. @@ -145,18 +145,19 @@ function GetPlantDemand(ccohort,element_id) result(plant_demand) return end if - + fnrt_c = ccohort%prt%GetState(fnrt_organ, carbon12_element) + ! If the plant is not a newly recruited plant ! We use other methods of specifying nutrient demand ! ----------------------------------------------------------------------------------- if(element_id.eq.nitrogen_element) then - plant_demand = smth_fac*ccohort%daily_n_demand + (1._r8-smth_fac)*max(0._r8,ccohort%daily_n_need) + plant_demand = fnrt_c * EDPftvarcon_inst%eca_vmax_nh4(ccohort%pft) * sec_per_day elseif(element_id.eq.phosphorus_element) then - - plant_demand = smth_fac*ccohort%daily_p_demand + (1._r8-smth_fac)*max(0._r8,ccohort%daily_p_need) + + plant_demand = fnrt_c * EDPftvarcon_inst%eca_vmax_p(ccohort%pft) * sec_per_day end if @@ -241,9 +242,7 @@ subroutine UnPackNutrientAquisitionBCs(sites, bc_in) ccohort => cpatch%tallest do while (associated(ccohort)) icomp = icomp+1 - fnrt_c = ccohort%prt%GetState(fnrt_organ, carbon12_element) - ccohort%daily_n_demand = fnrt_c * ccohort%n * AREA_INV * & - EDPftvarcon_inst%eca_vmax_nh4(ccohort%pft) * sec_per_day + ccohort%daily_n_demand = GetPlantDemand(ccohort,nitrogen_element) ! N Uptake: Convert g/m2/day -> kg/plant/day ccohort%daily_nh4_uptake = bc_in(s)%plant_nh4_uptake_flux(icomp,1)*kg_per_g*AREA/ccohort%n ccohort%daily_no3_uptake = bc_in(s)%plant_no3_uptake_flux(icomp,1)*kg_per_g*AREA/ccohort%n @@ -275,9 +274,7 @@ subroutine UnPackNutrientAquisitionBCs(sites, bc_in) ccohort => cpatch%tallest do while (associated(ccohort)) icomp = icomp+1 - fnrt_c = ccohort%prt%GetState(fnrt_organ, carbon12_element) - ccohort%daily_p_demand = fnrt_c * ccohort%n * AREA_INV * & - EDPftvarcon_inst%eca_vmax_p(ccohort%pft) * sec_per_day + ccohort%daily_p_demand = GetPlantDemand(ccohort,phosphorus_element) ! P Uptake: Convert g/m2/day -> kg/plant/day ccohort%daily_p_uptake = bc_in(s)%plant_p_uptake_flux(icomp,1)*kg_per_g*AREA/ccohort%n ccohort => ccohort%shorter @@ -596,7 +593,6 @@ subroutine FluxIntoLitterPools(csite, bc_in, bc_out) ! ----------------------------------------------------------------------------------- - use FatesConstantsMod, only : sec_per_day use FatesInterfaceTypesMod, only : bc_in_type, bc_out_type use FatesInterfaceTypesMod, only : hlm_use_vertsoilc use FatesInterfaceTypesMod, only : hlm_numlevgrnd diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index 875fe4c730..3cdeaf48ea 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -135,7 +135,7 @@ subroutine init_site_vars( site_in, bc_in, bc_out ) allocate(site_in%flux_diags(el)%root_litter_input(1:numpft)) allocate(site_in%flux_diags(el)%nutrient_efflux_scpf(nlevsclass*numpft)) allocate(site_in%flux_diags(el)%nutrient_uptake_scpf(nlevsclass*numpft)) - allocate(site_in%flux_diags(el)%nutrient_need_scpf(nlevsclass*numpft)) + allocate(site_in%flux_diags(el)%nutrient_demand_scpf(nlevsclass*numpft)) end do ! Initialize the static soil diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index 5deb2c5084..7d75d8a885 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -493,13 +493,13 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) currentCohort%daily_c_efflux*currentCohort%n ! Diagnostics on plant nutrient need - currentSite%flux_diags(element_pos(nitrogen_element))%nutrient_need_scpf(iscpf) = & - currentSite%flux_diags(element_pos(nitrogen_element))%nutrient_need_scpf(iscpf) + & - currentCohort%daily_n_need*currentCohort%n + currentSite%flux_diags(element_pos(nitrogen_element))%nutrient_demand_scpf(iscpf) = & + currentSite%flux_diags(element_pos(nitrogen_element))%nutrient_demand_scpf(iscpf) + & + currentCohort%daily_n_demand*currentCohort%n - currentSite%flux_diags(element_pos(phosphorus_element))%nutrient_need_scpf(iscpf) = & - currentSite%flux_diags(element_pos(phosphorus_element))%nutrient_need_scpf(iscpf) + & - currentCohort%daily_p_need*currentCohort%n + currentSite%flux_diags(element_pos(phosphorus_element))%nutrient_demand_scpf(iscpf) = & + currentSite%flux_diags(element_pos(phosphorus_element))%nutrient_demand_scpf(iscpf) + & + currentCohort%daily_p_demand*currentCohort%n end if diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index e8fa27ee8e..6f347b8b41 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -301,17 +301,8 @@ module EDTypesMod real(r8) :: daily_n_efflux ! daily mean efflux of excess nitrogen from roots into labile pool [kg N/plant/day] real(r8) :: daily_p_efflux ! daily mean efflux of excess phophorus from roots into labile pool [kg P/plant/day] - real(r8) :: daily_n_need ! Generic Nitrogen need of the plant, (hypothesis dependent) [kgN/plant/day] - real(r8) :: daily_p_need ! Generic Phosphorus need of the plant, (hypothesis dependent) [kgN/plant/day] - - - ! These two variables may use the previous "need" variables, by applying a smoothing function. - ! These variables are used in two scenarios. 1) They work with the prescribed uptake fraction - ! in un-coupled mode, and 2) They are the plant's demand subbmitted to the Relative-Demand - ! type soil BGC scheme. - - real(r8) :: daily_n_demand ! The daily amount of N demanded by the plant [kgN] - real(r8) :: daily_p_demand ! The daily amount of P demanded by the plant [kgN] + real(r8) :: daily_n_demand ! The daily amount of N demanded by the plant [kgN/plant/day] + real(r8) :: daily_p_demand ! The daily amount of P demanded by the plant [kgN/plant/day] ! The following four biophysical rates are assumed to be @@ -611,7 +602,7 @@ module EDTypesMod real(r8),allocatable :: nutrient_uptake_scpf(:) real(r8),allocatable :: nutrient_efflux_scpf(:) - real(r8),allocatable :: nutrient_need_scpf(:) + real(r8),allocatable :: nutrient_demand_scpf(:) contains @@ -847,7 +838,7 @@ subroutine ZeroFluxDiags(this) this%root_litter_input(:) = 0._r8 this%nutrient_uptake_scpf(:) = 0._r8 this%nutrient_efflux_scpf(:) = 0._r8 - this%nutrient_need_scpf(:) = 0._r8 + this%nutrient_demand_scpf(:) = 0._r8 return end subroutine ZeroFluxDiags diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 8675cf1141..d1dd3b4294 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -181,8 +181,8 @@ module FatesHistoryInterfaceMod integer :: ih_cefflux_si integer :: ih_nefflux_si integer :: ih_pefflux_si - integer :: ih_nneed_si - integer :: ih_pneed_si + integer :: ih_ndemand_si + integer :: ih_pdemand_si integer :: ih_trimming_si integer :: ih_area_plant_si @@ -229,7 +229,7 @@ module FatesHistoryInterfaceMod integer,public :: ih_nh4uptake_scpf integer,public :: ih_no3uptake_scpf integer :: ih_nefflux_scpf - integer :: ih_nneed_scpf + integer :: ih_ndemand_scpf integer :: ih_totvegc_scpf integer :: ih_leafc_scpf @@ -249,7 +249,7 @@ module FatesHistoryInterfaceMod integer :: ih_sapwp_scpf integer,public :: ih_puptake_scpf integer :: ih_pefflux_scpf - integer :: ih_pneed_scpf + integer :: ih_pdemand_scpf integer :: ih_daily_temp integer :: ih_daily_rh @@ -3144,11 +3144,11 @@ subroutine update_history_dyn(this,nc,nsites,sites) this%hvars(ih_nefflux_scpf)%r82d(io_si,:) = & sites(s)%flux_diags(el)%nutrient_efflux_scpf(:) - this%hvars(ih_nneed_scpf)%r82d(io_si,:) = & - sites(s)%flux_diags(el)%nutrient_need_scpf(:) + this%hvars(ih_ndemand_scpf)%r82d(io_si,:) = & + sites(s)%flux_diags(el)%nutrient_demand_scpf(:) - this%hvars(ih_nneed_si)%r81d(io_si) = & - sum(sites(s)%flux_diags(el)%nutrient_need_scpf(:),dim=1) + this%hvars(ih_ndemand_si)%r81d(io_si) = & + sum(sites(s)%flux_diags(el)%nutrient_demand_scpf(:),dim=1) this%hvars(ih_nefflux_si)%r81d(io_si) = & sum(sites(s)%flux_diags(el)%nutrient_efflux_scpf(:),dim=1) @@ -3166,11 +3166,11 @@ subroutine update_history_dyn(this,nc,nsites,sites) this%hvars(ih_pefflux_scpf)%r82d(io_si,:) = & sites(s)%flux_diags(el)%nutrient_efflux_scpf(:) - this%hvars(ih_pneed_scpf)%r82d(io_si,:) = & - sites(s)%flux_diags(el)%nutrient_need_scpf(:) + this%hvars(ih_pdemand_scpf)%r82d(io_si,:) = & + sites(s)%flux_diags(el)%nutrient_demand_scpf(:) - this%hvars(ih_pneed_si)%r81d(io_si) = & - sum(sites(s)%flux_diags(el)%nutrient_need_scpf(:),dim=1) + this%hvars(ih_pdemand_si)%r81d(io_si) = & + sum(sites(s)%flux_diags(el)%nutrient_demand_scpf(:),dim=1) this%hvars(ih_pefflux_si)%r81d(io_si) = & sum(sites(s)%flux_diags(el)%nutrient_efflux_scpf(:),dim=1) @@ -4797,7 +4797,7 @@ subroutine define_history_vars(this, initialize_variables) call this%set_history_var(vname='NNEED', units='kgN d-1 ha-1', & long='Plant nitrogen need (algorithm dependent)', use_default='active', & avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & - ivar=ivar, initialize=initialize_variables, index = ih_nneed_si ) + ivar=ivar, initialize=initialize_variables, index = ih_ndemand_si ) end if nitrogen_active_if @@ -4851,7 +4851,7 @@ subroutine define_history_vars(this, initialize_variables) call this%set_history_var(vname='PNEED', units='kgP ha-1 d-1', & long='Plant phosphorus need (algorithm dependent)', use_default='active', & avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & - ivar=ivar, initialize=initialize_variables, index = ih_pneed_si ) + ivar=ivar, initialize=initialize_variables, index = ih_pdemand_si ) end if phosphorus_active_if @@ -6141,10 +6141,10 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_nefflux_scpf ) - call this%set_history_var(vname='NNEED_SCPF', units='kgN d-1 ha-1', & + call this%set_history_var(vname='NDEMAND_SCPF', units='kgN d-1 ha-1', & long='plant N need (algorithm dependent), by size-class x pft', use_default='inactive', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_nneed_scpf ) + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_ndemand_scpf ) end if nitrogen_active_if2 @@ -6200,10 +6200,10 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_pefflux_scpf ) - call this%set_history_var(vname='PNEED_SCPF', units='kg/ha/day', & + call this%set_history_var(vname='PDEMAND_SCPF', units='kg/ha/day', & long='plant P need (algorithm dependent), by size-class x pft', use_default='inactive', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_pneed_scpf ) + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_pdemand_scpf ) end if phosphorus_active_if2 diff --git a/main/FatesRestartInterfaceMod.F90 b/main/FatesRestartInterfaceMod.F90 index 7ae00ed0b2..d436924cc8 100644 --- a/main/FatesRestartInterfaceMod.F90 +++ b/main/FatesRestartInterfaceMod.F90 @@ -123,8 +123,6 @@ module FatesRestartInterfaceMod integer :: ir_daily_p_efflux_co integer :: ir_daily_n_demand_co integer :: ir_daily_p_demand_co - integer :: ir_daily_n_need_co - integer :: ir_daily_p_need_co !Logging integer :: ir_lmort_direct_co @@ -801,16 +799,6 @@ subroutine define_restart_vars(this, initialize_variables) units='kgN/plant/day', flushval = flushzero, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_daily_n_demand_co ) - call this%set_restart_var(vname='fates_daily_p_need', vtype=cohort_r8, & - long_name='fates cohort- daily phosphorus need', & - units='kgP/plant/day', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_daily_p_need_co ) - - call this%set_restart_var(vname='fates_daily_n_need', vtype=cohort_r8, & - long_name='fates cohort- daily nitrogen need', & - units='kgN/plant/day', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_daily_n_need_co ) - call this%set_restart_var(vname='fates_frmort', vtype=cohort_r8, & long_name='ed cohort - freezing mortality rate', & units='/year', flushval = flushzero, & @@ -1642,8 +1630,6 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_daily_p_efflux_co => this%rvars(ir_daily_p_efflux_co)%r81d, & rio_daily_n_demand_co => this%rvars(ir_daily_n_demand_co)%r81d, & rio_daily_p_demand_co => this%rvars(ir_daily_p_demand_co)%r81d, & - rio_daily_n_need_co => this%rvars(ir_daily_n_need_co)%r81d, & - rio_daily_p_need_co => this%rvars(ir_daily_p_need_co)%r81d, & rio_smort_co => this%rvars(ir_smort_co)%r81d, & rio_asmort_co => this%rvars(ir_asmort_co)%r81d, & rio_frmort_co => this%rvars(ir_frmort_co)%r81d, & @@ -1880,8 +1866,6 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_daily_n_demand_co(io_idx_co) = ccohort%daily_n_demand rio_daily_p_demand_co(io_idx_co) = ccohort%daily_p_demand - rio_daily_n_need_co(io_idx_co) = ccohort%daily_n_need - rio_daily_p_need_co(io_idx_co) = ccohort%daily_p_need !Logging rio_lmort_direct_co(io_idx_co) = ccohort%lmort_direct @@ -2426,8 +2410,6 @@ subroutine get_restart_vectors(this, nc, nsites, sites) rio_daily_p_efflux_co => this%rvars(ir_daily_p_efflux_co)%r81d, & rio_daily_n_demand_co => this%rvars(ir_daily_n_demand_co)%r81d, & rio_daily_p_demand_co => this%rvars(ir_daily_p_demand_co)%r81d, & - rio_daily_n_need_co => this%rvars(ir_daily_n_need_co)%r81d, & - rio_daily_p_need_co => this%rvars(ir_daily_p_need_co)%r81d, & rio_smort_co => this%rvars(ir_smort_co)%r81d, & rio_asmort_co => this%rvars(ir_asmort_co)%r81d, & rio_frmort_co => this%rvars(ir_frmort_co)%r81d, & @@ -2633,8 +2615,6 @@ subroutine get_restart_vectors(this, nc, nsites, sites) ccohort%daily_n_demand = rio_daily_n_demand_co(io_idx_co) ccohort%daily_p_demand = rio_daily_p_demand_co(io_idx_co) - ccohort%daily_n_need = rio_daily_n_need_co(io_idx_co) - ccohort%daily_p_need = rio_daily_p_need_co(io_idx_co) !Logging ccohort%lmort_direct = rio_lmort_direct_co(io_idx_co) diff --git a/parteh/PRTAllometricCNPMod.F90 b/parteh/PRTAllometricCNPMod.F90 index e20c2febce..86c392f755 100644 --- a/parteh/PRTAllometricCNPMod.F90 +++ b/parteh/PRTAllometricCNPMod.F90 @@ -163,8 +163,6 @@ module PRTAllometricCNPMod integer, public, parameter :: acnp_bc_out_id_cefflux = 1 ! Daily exudation of C [kg] integer, public, parameter :: acnp_bc_out_id_nefflux = 2 ! Daily exudation of N [kg] integer, public, parameter :: acnp_bc_out_id_pefflux = 3 ! Daily exudation of P [kg] - integer, public, parameter :: acnp_bc_out_id_nneed = 4 ! N need [kgN] - integer, public, parameter :: acnp_bc_out_id_pneed = 5 ! P need [kgP] integer, parameter :: num_bc_out = 5 ! Total number of @@ -189,6 +187,7 @@ module PRTAllometricCNPMod real(r8), parameter :: store_overflow_frac = 0.15 ! The fraction above target allowed in storage + logical, parameter :: force_store_c_overflow = .true. ! User may want to attempt matching results with the ! C-only allocation module. If so, then set reproduce_conly @@ -297,8 +296,6 @@ subroutine InitPRTGlobalAllometricCNP() call endrun(msg=errMsg(sourcefile, __LINE__)) end if - - call prt_global_acnp%RegisterVarInGlobal(leaf_c_id,'Leaf Carbon','leaf_c',leaf_organ,carbon12_element,nleafage) call prt_global_acnp%RegisterVarInGlobal(fnrt_c_id,'Fine Root Carbon','fnrt_c',fnrt_organ,carbon12_element,icd) call prt_global_acnp%RegisterVarInGlobal(sapw_c_id,'Sapwood Carbon','sapw_c',sapw_organ,carbon12_element,icd) @@ -357,8 +354,6 @@ subroutine DailyPRTAllometricCNP(this) real(r8),pointer :: c_efflux ! Total plant efflux of carbon (kgC) real(r8),pointer :: n_efflux ! Total plant efflux of nitrogen (kgN) real(r8),pointer :: p_efflux ! Total plant efflux of phosphorus (kgP) - real(r8),pointer :: n_need ! N need (algorithm dependant) (kgN) - real(r8),pointer :: p_need ! P need (algorithm dependant) (kgP) real(r8),pointer :: growth_r ! Total plant growth respiration this step (kgC) ! These are pointers to the state variables, rearranged in organ dimensioned @@ -419,8 +414,6 @@ subroutine DailyPRTAllometricCNP(this) c_efflux => this%bc_out(acnp_bc_out_id_cefflux)%rval; c_efflux = 0._r8 n_efflux => this%bc_out(acnp_bc_out_id_nefflux)%rval; n_efflux = 0._r8 p_efflux => this%bc_out(acnp_bc_out_id_pefflux)%rval; p_efflux = 0._r8 - n_need => this%bc_out(acnp_bc_out_id_nneed)%rval; n_need = fates_unset_r8 - p_need => this%bc_out(acnp_bc_out_id_pneed)%rval; p_need = fates_unset_r8 ! In/out boundary conditions maint_r_def => this%bc_inout(acnp_bc_inout_id_rmaint_def)%rval; maint_r_def0 = maint_r_def @@ -631,9 +624,6 @@ subroutine DailyPRTAllometricCNP(this) target_n = this%GetNutrientTarget(nitrogen_element,store_organ,stoich_max) target_p = this%GetNutrientTarget(phosphorus_element,store_organ,stoich_max) - n_need = target_n - state_n(store_id)%ptr - p_need = target_p - state_p(store_id)%ptr - deallocate(state_c) deallocate(state_n) deallocate(state_p) @@ -1644,18 +1634,26 @@ subroutine CNPAllocateRemainder(this,c_gain, n_gain, p_gain, & if(c_gain>calloc_abs_error) then - ! Update carbon based allometric targets - call bstore_allom(dbh,ipft,canopy_trim, store_c_target) - - ! Estimate the overflow - store_c_target = store_c_target * (1.0_r8 + store_overflow_frac) - - total_c_flux = min(c_gain,max(0.0, (store_c_target - state_c(store_id)%ptr))) - + + if(force_store_c_overflow)then + + total_c_flux = c_gain + else + + ! Update carbon based allometric targets + call bstore_allom(dbh,ipft,canopy_trim, store_c_target) + + ! Estimate the overflow + store_c_target = store_c_target * (1.0_r8 + store_overflow_frac) + + total_c_flux = min(c_gain,max(0.0, (store_c_target - state_c(store_id)%ptr))) + + end if ! Transfer excess carbon into storage overflow state_c(store_id)%ptr = state_c(store_id)%ptr + total_c_flux c_gain = c_gain - total_c_flux - + + end if diff --git a/parteh/PRTGenericMod.F90 b/parteh/PRTGenericMod.F90 index 3dab9563a3..cfd398ec58 100644 --- a/parteh/PRTGenericMod.F90 +++ b/parteh/PRTGenericMod.F90 @@ -1425,10 +1425,10 @@ function StorageNutrientTarget(pft, element_id, leaf_target, fnrt_target, sapw_t ! total nitrogen content of 1 or more sets of organs ! ------------------------------------------------------------------------------------- - integer, parameter :: lfs_store_prop = 1 ! leaf-fnrt-sapw proportional storage + integer, parameter :: lfs_store_prop = 1 ! leaf-sapwood proportional storage integer, parameter :: lfss_store_prop = 2 ! leaf-fnrt-sapw-struct proportional storage integer, parameter :: fnrt_store_prop = 3 ! fineroot proportional storage - integer, parameter :: store_prop = fnrt_store_prop + integer, parameter :: store_prop = lfs_store_prop select case(element_id) @@ -1441,7 +1441,7 @@ function StorageNutrientTarget(pft, element_id, leaf_target, fnrt_target, sapw_t if (store_prop == lfs_store_prop) then - store_target = prt_params%nitr_store_ratio(pft) * (leaf_target + fnrt_target + sapw_target) + store_target = prt_params%nitr_store_ratio(pft) * (leaf_target + sapw_target) elseif(store_prop==lfss_store_prop) then From f2a9b05b92cb8f003407046614c2b05b504afebe Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Sat, 1 Jan 2022 11:21:13 -0500 Subject: [PATCH 10/55] Adding l2fr to the restarts, updating soil root biomass diagnostic --- main/FatesHistoryInterfaceMod.F90 | 25 +++++++++++++++++++++---- main/FatesRestartInterfaceMod.F90 | 9 +++++++++ 2 files changed, 30 insertions(+), 4 deletions(-) diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index d1dd3b4294..c3e94bebae 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -63,6 +63,7 @@ module FatesHistoryInterfaceMod use FatesLitterMod , only : litter_type use FatesConstantsMod , only : secondaryforest use FatesAllometryMod , only : bstore_allom + use FatesAllometryMod , only : set_root_fraction use PRTGenericMod , only : leaf_organ, fnrt_organ, sapw_organ use PRTGenericMod , only : struct_organ, store_organ, repro_organ use PRTGenericMod , only : all_carbon_elements @@ -153,6 +154,7 @@ module FatesHistoryInterfaceMod integer :: ih_leafc_si integer :: ih_sapwc_si integer :: ih_fnrtc_si + integer :: ih_fnrtc_sl integer :: ih_reproc_si integer :: ih_totvegc_si @@ -1688,7 +1690,7 @@ end subroutine init_dim_kinds_maps ! ==================================================================================== - subroutine update_history_dyn(this,nc,nsites,sites) + subroutine update_history_dyn(this,nc,nsites,sites,bc_in) ! --------------------------------------------------------------------------------- ! This is the call to update the history IO arrays that are expected to only change @@ -1716,6 +1718,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) integer , intent(in) :: nc ! clump index integer , intent(in) :: nsites type(ed_site_type) , intent(inout), target :: sites(nsites) + type(bc_in_type) , intent(in) :: bc_in(nsites) ! Locals type(litter_type), pointer :: litt_c ! Pointer to the carbon12 litter pool @@ -2295,6 +2298,17 @@ subroutine update_history_dyn(this,nc,nsites,sites) this%hvars(ih_leafc_si)%r81d(io_si) + ccohort%n * leaf_m this%hvars(ih_fnrtc_si)%r81d(io_si) = & this%hvars(ih_fnrtc_si)%r81d(io_si) + ccohort%n * fnrt_m + + ! Determine the root carbon biomass in kg/m3 + ! [kg/m3] = [kg/plant] * [plant/ha] / [m3/ha] * [fraction] / [m] + + call set_root_fraction(sites(s)%rootfrac_scr, ccohort%pft, sites(s)%zi_soil, & + bc_in(s)%max_rooting_depth_index_col ) + do ilyr = 1,sites(s)%nlevsoil + this%hvars(ih_fnrtc_sl)%r82d(io_si,ilyr) = this%hvars(ih_fnrtc_sl)%r82d(io_si,ilyr) + & + fnrt_m * ccohort%n / area * sites(s)%rootfrac_scr(ilyr) / sites(s)%dz_soil(ilyr) + end do + this%hvars(ih_reproc_si)%r81d(io_si) = & this%hvars(ih_reproc_si)%r81d(io_si)+ ccohort%n * repro_m this%hvars(ih_sapwc_si)%r81d(io_si) = & @@ -2830,7 +2844,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_sum_fuel_si(io_si) = hio_sum_fuel_si(io_si) + cpatch%sum_fuel * g_per_kg * cpatch%area * AREA_INV do ilyr = 1,sites(s)%nlevsoil - hio_fragmentation_scaler_sl(io_si,ilyr) = hio_fragmentation_scaler_sl(io_si,ilyr) + cpatch%fragmentation_scaler(ilyr) * cpatch%area * AREA_INV + hio_fragmentation_scaler_sl(io_si,ilyr) = hio_fragmentation_scaler_sl(io_si,ilyr) + cpatch%fragmentation_scaler(ilyr) * cpatch%area * AREA_INV end do do i_fuel = 1,nfsc @@ -2903,8 +2917,6 @@ subroutine update_history_dyn(this,nc,nsites,sites) do i_pft = 1, numpft do i_scls = 1,nlevsclass i_scpf = (i_pft-1)*nlevsclass + i_scls - - ! ! termination mortality. sum of canopy and understory indices @@ -4732,6 +4744,11 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_fnrtc_si ) + call this%set_history_var(vname='FNRTC_SL', units='kgC m-3', & + long='Total carbon in live plant fine-roots over depth', use_default='active', & + avgflag='A', vtype=site_ground_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_fnrtc_sl ) + call this%set_history_var(vname='REPROC', units='kgC ha-1', & long='Total carbon in live plant reproductive tissues', use_default='active', & avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & diff --git a/main/FatesRestartInterfaceMod.F90 b/main/FatesRestartInterfaceMod.F90 index d436924cc8..688ddc1f7a 100644 --- a/main/FatesRestartInterfaceMod.F90 +++ b/main/FatesRestartInterfaceMod.F90 @@ -92,6 +92,7 @@ module FatesRestartInterfaceMod integer :: ir_canopy_layer_co integer :: ir_canopy_layer_yesterday_co integer :: ir_canopy_trim_co + integer :: ir_l2fr_co integer :: ir_size_class_lasttimestep_co integer :: ir_dbh_co integer :: ir_coage_co @@ -673,6 +674,10 @@ subroutine define_restart_vars(this, initialize_variables) long_name='ed cohort - canopy_trim', units='fraction', flushval = flushzero, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_canopy_trim_co ) + call this%set_restart_var(vname='fates_l2fr', vtype=cohort_r8, & + long_name='ed cohort - l2fr', units='fraction', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_l2fr_co ) + call this%set_restart_var(vname='fates_size_class_lasttimestep', vtype=cohort_int, & long_name='ed cohort - size-class last timestep', units='index', flushval = flushzero, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_size_class_lasttimestep_co ) @@ -1602,6 +1607,7 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_canopy_layer_co => this%rvars(ir_canopy_layer_co)%int1d, & rio_canopy_layer_yesterday_co => this%rvars(ir_canopy_layer_yesterday_co)%r81d, & rio_canopy_trim_co => this%rvars(ir_canopy_trim_co)%r81d, & + rio_l2fr_co => this%rvars(ir_l2fr_co)%r81d, & rio_seed_prod_co => this%rvars(ir_seed_prod_co)%r81d, & rio_size_class_lasttimestep => this%rvars(ir_size_class_lasttimestep_co)%int1d, & rio_dbh_co => this%rvars(ir_dbh_co)%r81d, & @@ -1828,6 +1834,7 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_canopy_layer_co(io_idx_co) = ccohort%canopy_layer rio_canopy_layer_yesterday_co(io_idx_co) = ccohort%canopy_layer_yesterday rio_canopy_trim_co(io_idx_co) = ccohort%canopy_trim + rio_l2fr_co(io_idx_co) = ccohort%l2fr rio_seed_prod_co(io_idx_co) = ccohort%seed_prod rio_size_class_lasttimestep(io_idx_co) = ccohort%size_class_lasttimestep rio_dbh_co(io_idx_co) = ccohort%dbh @@ -2382,6 +2389,7 @@ subroutine get_restart_vectors(this, nc, nsites, sites) rio_canopy_layer_co => this%rvars(ir_canopy_layer_co)%int1d, & rio_canopy_layer_yesterday_co => this%rvars(ir_canopy_layer_yesterday_co)%r81d, & rio_canopy_trim_co => this%rvars(ir_canopy_trim_co)%r81d, & + rio_l2fr_co => this%rvars(ir_l2fr_co)%r81d, & rio_seed_prod_co => this%rvars(ir_seed_prod_co)%r81d, & rio_size_class_lasttimestep => this%rvars(ir_size_class_lasttimestep_co)%int1d, & rio_dbh_co => this%rvars(ir_dbh_co)%r81d, & @@ -2580,6 +2588,7 @@ subroutine get_restart_vectors(this, nc, nsites, sites) ccohort%canopy_layer = rio_canopy_layer_co(io_idx_co) ccohort%canopy_layer_yesterday = rio_canopy_layer_yesterday_co(io_idx_co) ccohort%canopy_trim = rio_canopy_trim_co(io_idx_co) + ccohort%l2fr = rio_l2fr_co(io_idx_co) ccohort%seed_prod = rio_seed_prod_co(io_idx_co) ccohort%size_class_lasttimestep = rio_size_class_lasttimestep(io_idx_co) ccohort%dbh = rio_dbh_co(io_idx_co) From 9b5074466f6a3e0961d61c6a9f43405fbc8894dc Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 20 Jan 2022 16:42:18 -0500 Subject: [PATCH 11/55] Updates to fates history variables for NP cycling --- biogeochem/FatesSoilBGCFluxMod.F90 | 14 ++++++++++++-- main/EDMainMod.F90 | 1 + main/EDTypesMod.F90 | 28 +++++++++++++++++++++++++++- main/FatesHistoryInterfaceMod.F90 | 20 ++++++++++++++++++++ 4 files changed, 60 insertions(+), 3 deletions(-) diff --git a/biogeochem/FatesSoilBGCFluxMod.F90 b/biogeochem/FatesSoilBGCFluxMod.F90 index 90b79559a2..73572851fe 100644 --- a/biogeochem/FatesSoilBGCFluxMod.F90 +++ b/biogeochem/FatesSoilBGCFluxMod.F90 @@ -718,14 +718,24 @@ subroutine FluxIntoLitterPools(csite, bc_in, bc_out) elseif(element_list(el).eq.phosphorus_element) then efflux_ptr => currentCohort%daily_p_efflux end if + + call set_root_fraction(csite%rootfrac_scr, currentCohort%pft, csite%zi_soil, & + bc_in%max_rooting_depth_index_col ) ! Unit conversion ! kg/plant/day * plant/ha * ha/m2 -> kg/m2/day + ! Also, lets efflux out through the roots - do id = 1,nlev_eff_decomp + !do id = 1,nlev_eff_decomp + ! flux_lab_si(id) = flux_lab_si(id) + & + ! efflux_ptr * currentCohort%n* AREA_INV * surface_prof(id) + !end do + + do id = 1,nlev_eff_soil flux_lab_si(id) = flux_lab_si(id) + & - efflux_ptr * currentCohort%n* AREA_INV * surface_prof(id) + efflux_ptr * currentCohort%n* AREA_INV *csite%rootfrac_scr(id) end do + end if currentCohort => currentCohort%shorter end do diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index 7d75d8a885..66288650b3 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -107,6 +107,7 @@ module EDMainMod ! !PUBLIC MEMBER FUNCTIONS: public :: ed_ecosystem_dynamics public :: ed_update_site + ! ! !PRIVATE MEMBER FUNCTIONS: diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 6f347b8b41..40420da88d 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -190,7 +190,9 @@ module EDTypesMod integer, public :: n_uptake_mode integer, public :: p_uptake_mode + + !************************************ !** COHORT type structure ** @@ -824,9 +826,33 @@ module EDTypesMod public :: dump_patch public :: dump_cohort public :: dump_cohort_hydr - + public :: CanUpperUnder contains + ! ===================================================================================== + + function CanUpperUnder(ccohort) result(can_position) + + ! This simple function is used to determine if a + ! cohort's crown position is in the upper portion (ie the canopy) + ! or the understory. This differentiation is only used for + ! diagnostic purposes. Functionally, the model uses + ! the canopy layer position, which may have more than two layers + ! at any given time. Utlimately, every plant that is not in the + ! top layer (canopy), is considered understory. + + type(ed_cohort_type) :: ccohort ! Current cohort of interest + integer :: can_position + + if(ccohort%canopy_layer == 1)then + can_position = ican_upper + else + can_position = ican_ustory + end if + + end function CanUpperUnder + + ! ===================================================================================== subroutine ZeroFluxDiags(this) diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index c3e94bebae..98a4ab730e 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -176,6 +176,8 @@ module FatesHistoryInterfaceMod integer :: ih_l2fr_si integer :: ih_l2fr_scpf + integer :: ih_l2fr_canopy_scpf + integer :: ih_l2fr_understory_scpf integer,public :: ih_nh4uptake_si integer,public :: ih_no3uptake_si @@ -1797,6 +1799,8 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) hio_trimming_si => this%hvars(ih_trimming_si)%r81d, & hio_l2fr_si => this%hvars(ih_l2fr_si)%r81d, & hio_l2fr_scpf => this%hvars(ih_l2fr_scpf)%r82d, & + hio_l2fr_canopy_scpf => this%hvars(ih_l2fr_canopy_scpf)%r82d, & + hio_l2fr_understory_scpf => this%hvars(ih_l2fr_understory_scpf)%r82d, & hio_area_plant_si => this%hvars(ih_area_plant_si)%r81d, & hio_area_trees_si => this%hvars(ih_area_trees_si)%r81d, & hio_canopy_spread_si => this%hvars(ih_canopy_spread_si)%r81d, & @@ -2282,6 +2286,10 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) ! These L2FR diagnostics are weighted by fineroot carbon biomass hio_l2fr_si(io_si) = hio_l2fr_si(io_si) + ccohort%n*fnrt_m*ccohort%l2fr + hio_l2fr_scpf(io_si,ccohort%size_by_pft_class) = & + hio_l2fr_scpf(io_si,ccohort%size_by_pft_class) + & + ccohort%n*fnrt_m*ccohort%l2fr + hio_l2fr_scpf(io_si,ccohort%size_by_pft_class) = & hio_l2fr_scpf(io_si,ccohort%size_by_pft_class) + & ccohort%n*fnrt_m*ccohort%l2fr @@ -4311,6 +4319,18 @@ subroutine define_history_vars(this, initialize_variables) use_default='active', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_l2fr_scpf) + + call this%set_history_var(vname='LEAF2FNRT_CANOPY_SCPF', units='none', & + long='The leaf to fineroot biomass multiplier for target allometry in canopy plants', & + use_default='active', & + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_l2fr_canopy_scpf) + + call this%set_history_var(vname='LEAF2FNRT_UNDERSTORY_SCPF', units='none', & + long='The leaf to fineroot biomass multiplier for target allometry in understory plants', & + use_default='active', & + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_l2fr_understory_scpf) call this%set_history_var(vname='AREA_PLANT', units='m2/m2', & long='area occupied by all plants', use_default='active', & From 04c454ff0283adedf4061a4377213959614be483 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Wed, 2 Feb 2022 11:59:54 -0500 Subject: [PATCH 12/55] Incremental work on l2fr searching --- main/EDMainMod.F90 | 1 + main/FatesHistoryInterfaceMod.F90 | 66 ++++++++++++--- parteh/PRTAllometricCNPMod.F90 | 131 ++++++++++++++++++++++++------ 3 files changed, 161 insertions(+), 37 deletions(-) diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index 66288650b3..de2bf7b778 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -321,6 +321,7 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) !----------------------------------------------------------------------- real(r8) :: frac_site_primary + print*,"DYNAMICS" call get_frac_site_primary(currentSite, frac_site_primary) diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 98a4ab730e..f0ab692c7d 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -1714,7 +1714,8 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) use FatesSizeAgeTypeIndicesMod, only : coagetype_class_index use EDTypesMod , only : nlevleaf use EDParamsMod , only : ED_val_history_height_bin_edges - + use FatesUtilsMod , only : check_var_real + ! Arguments class(fates_history_interface_type) :: this integer , intent(in) :: nc ! clump index @@ -1785,7 +1786,10 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) real(r8) :: struct_m_net_alloc real(r8) :: repro_m_net_alloc real(r8) :: area_frac - + real(r8) :: fnrtc_canopy_scpf(numpft*nlevsclass) + real(r8) :: fnrtc_understory_scpf(numpft*nlevsclass) + integer :: return_code + type(ed_patch_type),pointer :: cpatch type(ed_cohort_type),pointer :: ccohort @@ -2052,6 +2056,9 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) model_day_int = nint(hlm_model_day) + + + ! --------------------------------------------------------------------------------- ! Loop through the FATES scale hierarchy and fill the history IO arrays ! --------------------------------------------------------------------------------- @@ -2059,6 +2066,10 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) do s = 1,nsites io_si = sites(s)%h_gid + + ! These are weighting factors used for calculating l2fr_scpf + fnrtc_canopy_scpf(:) = 0._r8 + fnrtc_understory_scpf(:) = 0._r8 ! Total carbon model error [kgC/day -> mgC/day] hio_cbal_err_fates_si(io_si) = & @@ -2283,6 +2294,8 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) if( element_list(el).eq.carbon12_element )then + call check_var_real(ccohort%l2fr, 'l2fr', return_code) + ! These L2FR diagnostics are weighted by fineroot carbon biomass hio_l2fr_si(io_si) = hio_l2fr_si(io_si) + ccohort%n*fnrt_m*ccohort%l2fr @@ -2290,9 +2303,23 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) hio_l2fr_scpf(io_si,ccohort%size_by_pft_class) + & ccohort%n*fnrt_m*ccohort%l2fr - hio_l2fr_scpf(io_si,ccohort%size_by_pft_class) = & - hio_l2fr_scpf(io_si,ccohort%size_by_pft_class) + & - ccohort%n*fnrt_m*ccohort%l2fr + if (ccohort%canopy_layer .eq. 1) then + hio_l2fr_canopy_scpf(io_si,ccohort%size_by_pft_class) = & + hio_l2fr_canopy_scpf(io_si,ccohort%size_by_pft_class) + & + ccohort%n*fnrt_m*ccohort%l2fr + + fnrtc_canopy_scpf(ccohort%size_by_pft_class) = & + fnrtc_canopy_scpf(ccohort%size_by_pft_class) + ccohort%n*fnrt_m + + else + hio_l2fr_understory_scpf(io_si,ccohort%size_by_pft_class) = & + hio_l2fr_understory_scpf(io_si,ccohort%size_by_pft_class) + & + ccohort%n*fnrt_m*ccohort%l2fr + fnrtc_understory_scpf(ccohort%size_by_pft_class) = & + fnrtc_understory_scpf(ccohort%size_by_pft_class) + ccohort%n*fnrt_m + + end if + this%hvars(ih_storec_si)%r81d(io_si) = & this%hvars(ih_storec_si)%r81d(io_si) + ccohort%n * store_m @@ -3345,6 +3372,30 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) if( this%hvars(ih_storectfrac_si)%r81d(io_si)>nearzero ) then this%hvars(ih_storectfrac_si)%r81d(io_si) = this%hvars(ih_storec_si)%r81d(io_si) / & this%hvars(ih_storectfrac_si)%r81d(io_si) + + do i_pft = 1, numpft + do i_scls = 1,nlevsclass + i_scpf = (i_pft-1)*nlevsclass + i_scls + + if(this%hvars(ih_fnrtc_scpf)%r82d(io_si,i_scpf)>nearzero)then + hio_l2fr_scpf(io_si,i_scpf) = hio_l2fr_scpf(io_si,i_scpf) / & + this%hvars(ih_fnrtc_scpf)%r82d(io_si,i_scpf) + end if + + if(fnrtc_canopy_scpf(i_scpf)>nearzero)then + hio_l2fr_canopy_scpf(io_si,i_scpf) = & + hio_l2fr_canopy_scpf(io_si,i_scpf)/fnrtc_canopy_scpf(i_scpf) + end if + + if(fnrtc_understory_scpf(i_scpf)>nearzero)then + hio_l2fr_understory_scpf(io_si,i_scpf) = & + hio_l2fr_understory_scpf(io_si,i_scpf)/fnrtc_understory_scpf(i_scpf) + end if + + + end do + end do + end if elseif(element_list(el).eq.nitrogen_element)then @@ -3355,11 +3406,6 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) do i_pft = 1, numpft do i_scls = 1,nlevsclass i_scpf = (i_pft-1)*nlevsclass + i_scls - - if(this%hvars(ih_fnrtc_scpf)%r82d(io_si,i_scpf)>nearzero)then - hio_l2fr_scpf(io_si,i_scpf) = hio_l2fr_scpf(io_si,i_scpf) / & - this%hvars(ih_fnrtc_scpf)%r82d(io_si,i_scpf) - end if if( hio_nplant_canopy_si_scpf(io_si,i_scpf)>nearzero ) then this%hvars(ih_storentfrac_canopy_scpf)%r82d(io_si,i_scpf) = & diff --git a/parteh/PRTAllometricCNPMod.F90 b/parteh/PRTAllometricCNPMod.F90 index 86c392f755..24849e40bc 100644 --- a/parteh/PRTAllometricCNPMod.F90 +++ b/parteh/PRTAllometricCNPMod.F90 @@ -46,6 +46,7 @@ module PRTAllometricCNPMod use FatesConstantsMod , only : i4 => fates_int use FatesConstantsMod , only : calloc_abs_error use FatesConstantsMod , only : rsnbl_math_prec + use FatesConstantsMod , only : years_per_day use FatesIntegratorsMod , only : RKF45 use FatesIntegratorsMod , only : Euler use FatesConstantsMod , only : calloc_abs_error @@ -206,7 +207,8 @@ module PRTAllometricCNPMod integer, parameter :: regulate_linear = 1 integer, parameter :: regulate_logi = 2 integer, parameter :: regulate_CN_logi = 3 - + integer, parameter :: regulate_CN_dfdd = 4 + ! Array of pointers are difficult in F90 ! This structure is a necessary intermediate type :: parray_type @@ -436,7 +438,7 @@ subroutine DailyPRTAllometricCNP(this) allocate(state_c(num_organs)) allocate(state_n(num_organs)) allocate(state_p(num_organs)) - + ! Set carbon targets based on the plant's current stature target_c(:) = fates_unset_r8 target_dcdd(:) = fates_unset_r8 @@ -638,20 +640,30 @@ subroutine CNPAdjustFRootTargets(this) real(r8), pointer :: l2fr ! leaf to fineroot target biomass scaler integer :: ipft ! PFT index + real(r8), pointer :: dbh + real(r8) :: canopy_trim - real(r8) :: n_regulator ! Nitrogen storage regulation function scaler - real(r8) :: p_regulator ! Phosphorus storage regulation function scaler - real(r8) :: np_regulator ! Combined NP storage regulation function scaler + real(r8) :: fnrt_c_target ! Target fineroot C before we change l2fr + real(r8) :: n_regulator ! Nitrogen storage regulation function scaler + real(r8) :: p_regulator ! Phosphorus storage regulation function scaler + real(r8) :: np_regulator ! Combined NP storage regulation function scaler + real(r8) :: turnfrac ! The factional amount of root biomass that may + ! remain after a day of root turnover without + ! replacement + real(r8) :: fnrt_frac ! fine-root's current fraction of the target + integer, parameter :: regulate_type = regulate_CN_logi !regulate_CN_dfdd ipft = this%bc_in(acnp_bc_in_id_pft)%ival l2fr => this%bc_inout(acnp_bc_inout_id_l2fr)%rval - + dbh => this%bc_inout(acnp_bc_inout_id_dbh)%rval + canopy_trim = this%bc_in(acnp_bc_in_id_ctrim)%rval + associate( l2fr_min => prt_params%allom_l2fr_min(ipft), & l2fr_max => prt_params%allom_l2fr_max(ipft)) - call this%StorageRegulator(nitrogen_element, regulate_CN_logi,n_regulator) - call this%StorageRegulator(phosphorus_element, regulate_CN_logi,p_regulator) + call this%StorageRegulator(nitrogen_element, regulate_type,n_regulator) + call this%StorageRegulator(phosphorus_element, regulate_type,p_regulator) ! We take the maximum here, because the maximum is reflective of the ! element with the lowest storage, which is the limiting element @@ -661,7 +673,48 @@ subroutine CNPAdjustFRootTargets(this) ! Update the leaf-to-fineroot ratio used ! to set fine-root biomass allometry - l2fr = l2fr_min + max(0._r8,min(1.0_r8,np_regulator))*(l2fr_max-l2fr_min) + if(regulate_type == regulate_CN_logi)then + + l2fr = l2fr_min + max(0._r8,min(1.0_r8,np_regulator))*(l2fr_max-l2fr_min) + + elseif(regulate_type == regulate_CN_dfdd)then + + ! Also, we aren't allowed to increase root biomass target if + ! we are very low on root biomass relative to the target + ! And we aren't allowed to reduce the target if we are above the target + + call bfineroot(dbh,ipft,canopy_trim,l2fr,fnrt_c_target) + fnrt_frac = this%GetState(fnrt_organ, carbon12_element)/fnrt_c_target + + turnfrac = (years_per_day / prt_params%root_long(ipft)) + + ! If there is low root compared to the max, don't allow cap growth + if(fnrt_frac < 1._r8-1.5_r8*turnfrac)then + np_regulator = min(np_regulator,1.0) + end if + + ! If there is high root compared to the max, don't allow cap decrease + if(fnrt_frac > 1.0_r8+1.5_r8*turnfrac)then + np_regulator = max(np_regulator,1.0) + end if + + ! Don't allow us to drop l2fr more than what the maximum loss to turnover + ! would be for one day. + ! this will prevent the algorithm from snowballing. This is doubly important + ! because if C is low compared to N or P, then the plant is probably + ! not very productive, and will not be growing. A growing plant can reach + ! equilibrium root mass more quickly. (might be unnecessary given + ! the growth caps prior to this...?) + + + + !print*,dbh,fnrt_frac,l2fr,min(max(np_regulator,1._r8-turnfrac),1._r8+turnfrac) + + l2fr = l2fr * min(max(np_regulator,1._r8-2._r8*turnfrac),1._r8+2._r8*turnfrac) + + end if + + ! Find the updated target fineroot biomass ! call bfineroot(dbh,ipft,canopy_trim, l2fr, target_fnrt) @@ -2142,16 +2195,10 @@ end subroutine TargetAllometryCheck subroutine StorageRegulator(this,element_id,regulate_type,c_scalar) ! ----------------------------------------------------------------------------------- - ! This function returns the cn_scalar or cp_scalar term - ! described in: - ! Zhu, Q et al. Representing Nitrogen, Phosphorus and Carbon - ! interactions in the E3SM land model: Development and Global benchmarking. - ! Journal of Advances in Modeling Earth Systems, 11, 2238-2258, 2019. - ! https://doi.org/10.1029/2018MS001571 - ! - ! In the manuscript c_scalar is described as: "f(CN) and f(CP) account for the - ! regulation of plant nutritional level on nutrient carrier enzyme activity" - ! Also, see equations 4 and 5. + ! This function evaluates the storage of either N or P, and returns + ! a scalar that is used to regulate fine-root biomass in some way. Depending + ! on the type of method, this may either be an absolute scalar on biomass + ! or it may be a rate of change on that scalar. ! ----------------------------------------------------------------------------------- @@ -2165,14 +2212,20 @@ subroutine StorageRegulator(this,element_id,regulate_type,c_scalar) real(r8) :: c_scalar ! Locals - real(r8) :: store_frac ! Current nutrient storage relative to max - real(r8) :: store_max ! Maximum nutrient storable by plant - real(r8) :: store_c ! Current storage carbon - real(r8) :: store_c_max ! Current maximum storage carbon - integer :: icode ! real variable checking code + real(r8) :: store_frac ! Current nutrient storage relative to max + real(r8) :: store_max ! Maximum nutrient storable by plant + real(r8) :: store_c ! Current storage carbon + real(r8) :: store_c_max ! Current maximum storage carbon + integer :: icode ! real variable checking code real(r8) :: store_x integer :: i_var - + real(r8) :: c_eq_offset ! This shifts the center-point + ! of the N:C or P:C storage equlibrium + ! by multiplying the C term. If its less than 1 it + ! shifts left and great than one it shifts right. + ! It should shift left to help mitigate wasted N and P + ! storage overflow + ! For N/C logistic real(r8) :: logi_k ! logistic function k real(r8) :: store_x0 ! storage fraction inflection point @@ -2225,8 +2278,8 @@ subroutine StorageRegulator(this,element_id,regulate_type,c_scalar) ! call endrun(msg=errMsg(sourcefile, __LINE__)) !endif - else - + elseif(regulate_type == regulate_CN_logi) then + logi_k = 2.0_r8 store_x0 = 0.0_r8 logi_min = 0.0_r8 @@ -2243,6 +2296,30 @@ subroutine StorageRegulator(this,element_id,regulate_type,c_scalar) c_scalar = max(0._r8,min(1._r8,logi_min + (1._r8-logi_min)/(1.0 + exp(logi_k*(store_frac-store_x0))))) + elseif(regulate_type == regulate_CN_dfdd) then + + store_c = this%GetState(store_organ, carbon12_element) + call bstore_allom(dbh,ipft,canopy_trim,store_c_max) + + ! Fraction of N per fraction of C + ! If this is greater than 1, then we have more N in storage than + ! we have C, so we downregulate. If this is less than 1, then + ! we have less N in storage than we have C, so up-regulate + + ! Note also, we do not allow the plants to dump C + ! but we do allow them to exude either P or N. Because of this + ! we shift our equilibrium point from a ratio of 1:1 to something + ! with a slightly lower C fraction equilibrium (ie > 1) + ! This will reduce N and P uptake inefficiencies by reducing + ! storage overflow and dumping. + + c_eq_offset = 0.75 + + store_frac = max(0.01_r8,store_frac) / max(0.01_r8,c_eq_offset*(store_c/store_c_max)) + + c_scalar = 1._r8 - 0.02_r8*log(store_frac) + + !print*,element_id,store_frac,c_scalar end if From 6bd5eb1ba452311cb0c0c32fe94b2ec074a17b28 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 3 Feb 2022 17:47:15 -0500 Subject: [PATCH 13/55] Updated l2fr diagnostics to be canopy and understory --- main/FatesHistoryInterfaceMod.F90 | 55 +++++++++++++++++++++++-------- 1 file changed, 42 insertions(+), 13 deletions(-) diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index a15f910c6c..ac986de9d2 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -1497,7 +1497,7 @@ subroutine zero_site_hvars(this, currentSite, upfreq_in) integer :: ndims ! number of dimensions do ivar=1,ubound(this%hvars,1) - if (this%hvars(ivar)%upfreq == upfreq_in) then ! Only flush variables with update on dynamics step + if (this%hvars(ivar)%upfreq == upfreq_in) then ndims = this%dim_kinds(this%hvars(ivar)%dim_kinds_index)%ndims @@ -1834,7 +1834,10 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) real(r8) :: repro_m_net_alloc real(r8) :: area_frac real(r8) :: crown_depth - + real(r8) :: fnrtc_canopy_scpf(numpft*nlevsclass) + real(r8) :: fnrtc_understory_scpf(numpft*nlevsclass) + integer :: return_code + type(ed_patch_type),pointer :: cpatch type(ed_cohort_type),pointer :: ccohort @@ -2099,6 +2102,10 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) io_si = sites(s)%h_gid + ! These are weighting factors used for calculating l2fr_scpf + fnrtc_canopy_scpf(:) = 0._r8 + fnrtc_understory_scpf(:) = 0._r8 + ! Total carbon model error [kgC/day -> kgC/s] hio_cbal_err_fates_si(io_si) = & sites(s)%mass_balance(element_pos(carbon12_element))%err_fates / sec_per_day @@ -2379,14 +2386,24 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) ! These L2FR diagnostics are weighted by fineroot carbon biomass hio_l2fr_si(io_si) = hio_l2fr_si(io_si) + ccohort%n*fnrt_m*ccohort%l2fr - hio_l2fr_scpf(io_si,ccohort%size_by_pft_class) = & - hio_l2fr_scpf(io_si,ccohort%size_by_pft_class) + & - ccohort%n*fnrt_m*ccohort%l2fr - hio_l2fr_scpf(io_si,ccohort%size_by_pft_class) = & hio_l2fr_scpf(io_si,ccohort%size_by_pft_class) + & ccohort%n*fnrt_m*ccohort%l2fr + if (ccohort%canopy_layer .eq. 1) then + hio_l2fr_canopy_scpf(io_si,ccohort%size_by_pft_class) = & + hio_l2fr_canopy_scpf(io_si,ccohort%size_by_pft_class) + & + ccohort%n*fnrt_m*ccohort%l2fr + fnrtc_canopy_scpf(ccohort%size_by_pft_class) = & + fnrtc_canopy_scpf(ccohort%size_by_pft_class) + ccohort%n*fnrt_m + else + hio_l2fr_understory_scpf(io_si,ccohort%size_by_pft_class) = & + hio_l2fr_understory_scpf(io_si,ccohort%size_by_pft_class) + & + ccohort%n*fnrt_m*ccohort%l2fr + fnrtc_understory_scpf(ccohort%size_by_pft_class) = & + fnrtc_understory_scpf(ccohort%size_by_pft_class) + ccohort%n*fnrt_m + end if + call bstore_allom(ccohort%dbh,ccohort%pft,ccohort%canopy_trim, store_max) this%hvars(ih_storectfrac_si)%r81d(io_si) = & this%hvars(ih_storectfrac_si)%r81d(io_si) + ccohort%n * store_max @@ -3447,18 +3464,30 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) end do ! end element loop - - - ! Normalize storage fractions + ! Normalize storage fractions and L2FR if( this%hvars(ih_storectfrac_si)%r81d(io_si)>nearzero ) then this%hvars(ih_storectfrac_si)%r81d(io_si) = this%hvars(ih_storec_si)%r81d(io_si) / & this%hvars(ih_storectfrac_si)%r81d(io_si) end if - if(this%hvars(ih_fnrtc_scpf)%r82d(io_si,i_scpf)>nearzero)then - hio_l2fr_scpf(io_si,i_scpf) = hio_l2fr_scpf(io_si,i_scpf) / & - this%hvars(ih_fnrtc_scpf)%r82d(io_si,i_scpf) - end if + + do i_pft = 1, numpft + do i_scls = 1,nlevsclass + i_scpf = (i_pft-1)*nlevsclass + i_scls + if(this%hvars(ih_fnrtc_scpf)%r82d(io_si,i_scpf)>nearzero)then + hio_l2fr_scpf(io_si,i_scpf) = hio_l2fr_scpf(io_si,i_scpf) / & + this%hvars(ih_fnrtc_scpf)%r82d(io_si,i_scpf) + end if + if(fnrtc_canopy_scpf(i_scpf)>nearzero)then + hio_l2fr_canopy_scpf(io_si,i_scpf) = & + hio_l2fr_canopy_scpf(io_si,i_scpf)/fnrtc_canopy_scpf(i_scpf) + end if + if(fnrtc_understory_scpf(i_scpf)>nearzero)then + hio_l2fr_understory_scpf(io_si,i_scpf) = & + hio_l2fr_understory_scpf(io_si,i_scpf)/fnrtc_understory_scpf(i_scpf) + end if + end do + end do do el = 1, num_elements From b570617f9912220ec1edc8a66a859b12c4b0ab53 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Tue, 8 Feb 2022 16:23:57 -0500 Subject: [PATCH 14/55] Fixed l2fr and storage fraction history fields, updated some name conventions --- main/FatesHistoryInterfaceMod.F90 | 161 ++++++++++++++++-------------- 1 file changed, 88 insertions(+), 73 deletions(-) diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index ac986de9d2..15b7e479bc 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -169,7 +169,6 @@ module FatesHistoryInterfaceMod integer :: ih_totvegc_si integer :: ih_storen_si - integer :: ih_storentfrac_si integer :: ih_leafn_si integer :: ih_sapwn_si integer :: ih_fnrtn_si @@ -177,7 +176,7 @@ module FatesHistoryInterfaceMod integer :: ih_totvegn_si integer :: ih_storep_si - integer :: ih_storeptfrac_si + integer :: ih_leafp_si integer :: ih_sapwp_si integer :: ih_fnrtp_si @@ -239,6 +238,7 @@ module FatesHistoryInterfaceMod integer :: ih_leafn_scpf integer :: ih_fnrtn_scpf integer :: ih_storen_scpf + integer :: ih_storentfrac_si integer :: ih_storentfrac_canopy_scpf integer :: ih_storentfrac_understory_scpf integer :: ih_sapwn_scpf @@ -261,6 +261,7 @@ module FatesHistoryInterfaceMod integer :: ih_fnrtp_scpf integer :: ih_reprop_scpf integer :: ih_storep_scpf + integer :: ih_storeptfrac_si integer :: ih_storeptfrac_canopy_scpf integer :: ih_storeptfrac_understory_scpf integer :: ih_sapwp_scpf @@ -1834,8 +1835,14 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) real(r8) :: repro_m_net_alloc real(r8) :: area_frac real(r8) :: crown_depth + real(r8) :: fnrtc_canopy_scpf(numpft*nlevsclass) real(r8) :: fnrtc_understory_scpf(numpft*nlevsclass) + real(r8) :: storen_canopy_scpf(numpft*nlevsclass) + real(r8) :: storen_understory_scpf(numpft*nlevsclass) + real(r8) :: storep_canopy_scpf(numpft*nlevsclass) + real(r8) :: storep_understory_scpf(numpft*nlevsclass) + integer :: return_code type(ed_patch_type),pointer :: cpatch @@ -2105,7 +2112,11 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) ! These are weighting factors used for calculating l2fr_scpf fnrtc_canopy_scpf(:) = 0._r8 fnrtc_understory_scpf(:) = 0._r8 - + storen_canopy_scpf(:) = 0._r8 + storen_understory_scpf(:) = 0._r8 + storep_canopy_scpf(:) = 0._r8 + storep_understory_scpf(:) = 0._r8 + ! Total carbon model error [kgC/day -> kgC/s] hio_cbal_err_fates_si(io_si) = & sites(s)%mass_balance(element_pos(carbon12_element))%err_fates / sec_per_day @@ -2342,6 +2353,9 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) hio_canopy_height_dist_si_height(io_si,height_bin_max) + ccohort%c_area * AREA_INV endif + call set_root_fraction(sites(s)%rootfrac_scr, ccohort%pft, sites(s)%zi_soil, & + bc_in(s)%max_rooting_depth_index_col ) + ! Update biomass components ! Mass pools [kg] elloop: do el = 1, num_elements @@ -2356,11 +2370,12 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) alive_m = leaf_m + fnrt_m + sapw_m total_m = alive_m + store_m + struct_m + i_scpf = ccohort%size_by_pft_class + + ! Plant multi-element states and fluxes ! Zero states, and set the fluxes if( element_list(el).eq.carbon12_element )then - - ! mass in different tissues [kg/ha] -> [kg/m2] this%hvars(ih_storec_si)%r81d(io_si) = & @@ -2384,35 +2399,29 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) ! These L2FR diagnostics are weighted by fineroot carbon biomass - hio_l2fr_si(io_si) = hio_l2fr_si(io_si) + ccohort%n*fnrt_m*ccohort%l2fr + hio_l2fr_si(io_si) = hio_l2fr_si(io_si) + ccohort%n*fnrt_m/m2_per_ha*ccohort%l2fr - hio_l2fr_scpf(io_si,ccohort%size_by_pft_class) = & - hio_l2fr_scpf(io_si,ccohort%size_by_pft_class) + & - ccohort%n*fnrt_m*ccohort%l2fr + hio_l2fr_scpf(io_si,i_scpf) = & + hio_l2fr_scpf(io_si,i_scpf) + ccohort%n*fnrt_m/m2_per_ha*ccohort%l2fr if (ccohort%canopy_layer .eq. 1) then - hio_l2fr_canopy_scpf(io_si,ccohort%size_by_pft_class) = & - hio_l2fr_canopy_scpf(io_si,ccohort%size_by_pft_class) + & - ccohort%n*fnrt_m*ccohort%l2fr - fnrtc_canopy_scpf(ccohort%size_by_pft_class) = & - fnrtc_canopy_scpf(ccohort%size_by_pft_class) + ccohort%n*fnrt_m + hio_l2fr_canopy_scpf(io_si,i_scpf) = & + hio_l2fr_canopy_scpf(io_si,i_scpf) + ccohort%n*fnrt_m *ccohort%l2fr + fnrtc_canopy_scpf(i_scpf) = fnrtc_canopy_scpf(i_scpf) + ccohort%n*fnrt_m else - hio_l2fr_understory_scpf(io_si,ccohort%size_by_pft_class) = & - hio_l2fr_understory_scpf(io_si,ccohort%size_by_pft_class) + & - ccohort%n*fnrt_m*ccohort%l2fr - fnrtc_understory_scpf(ccohort%size_by_pft_class) = & - fnrtc_understory_scpf(ccohort%size_by_pft_class) + ccohort%n*fnrt_m + hio_l2fr_understory_scpf(io_si,i_scpf) = & + hio_l2fr_understory_scpf(io_si,i_scpf) + ccohort%n*fnrt_m*ccohort%l2fr + fnrtc_understory_scpf(i_scpf) = fnrtc_understory_scpf(i_scpf) + ccohort%n*fnrt_m end if call bstore_allom(ccohort%dbh,ccohort%pft,ccohort%canopy_trim, store_max) this%hvars(ih_storectfrac_si)%r81d(io_si) = & - this%hvars(ih_storectfrac_si)%r81d(io_si) + ccohort%n * store_max + this%hvars(ih_storectfrac_si)%r81d(io_si) + ccohort%n * store_max/m2_per_ha ! Determine the root carbon biomass in kg/m3 ! [kg/m3] = [kg/plant] * [plant/ha] / [m3/ha] * [fraction] / [m] - call set_root_fraction(sites(s)%rootfrac_scr, ccohort%pft, sites(s)%zi_soil, & - bc_in(s)%max_rooting_depth_index_col ) + do ilyr = 1,sites(s)%nlevsoil this%hvars(ih_fnrtc_sl)%r82d(io_si,ilyr) = this%hvars(ih_fnrtc_sl)%r82d(io_si,ilyr) + & fnrt_m * ccohort%n / area * sites(s)%rootfrac_scr(ilyr) / sites(s)%dz_soil(ilyr) @@ -2474,6 +2483,20 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) this%hvars(ih_totvegn_si)%r81d(io_si) + ccohort%n * & total_m / m2_per_ha + if (ccohort%canopy_layer .eq. 1) then + storen_canopy_scpf(i_scpf) = & + storen_canopy_scpf(i_scpf) + ccohort%n * store_m + this%hvars(ih_storentfrac_canopy_scpf)%r82d(io_si,i_scpf) = & + this%hvars(ih_storentfrac_canopy_scpf)%r82d(io_si,i_scpf) + & + ccohort%n * store_max + else + storen_understory_scpf(i_scpf) = & + storen_understory_scpf(i_scpf) + ccohort%n * store_m + this%hvars(ih_storentfrac_understory_scpf)%r82d(io_si,i_scpf) = & + this%hvars(ih_storentfrac_understory_scpf)%r82d(io_si,i_scpf) + & + ccohort%n * store_max + end if + elseif(element_list(el).eq.phosphorus_element) then store_max = ccohort%prt%GetNutrientTarget(element_list(el),store_organ,stoich_max) @@ -2500,6 +2523,21 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) this%hvars(ih_totvegp_si)%r81d(io_si)+ ccohort%n * & total_m / m2_per_ha + if (ccohort%canopy_layer .eq. 1) then + storep_canopy_scpf(i_scpf) = & + storep_canopy_scpf(i_scpf) + ccohort%n * store_m + this%hvars(ih_storeptfrac_canopy_scpf)%r82d(io_si,i_scpf) = & + this%hvars(ih_storeptfrac_canopy_scpf)%r82d(io_si,i_scpf) + & + ccohort%n * store_max + else + storep_understory_scpf(i_scpf) = & + storep_understory_scpf(i_scpf) + ccohort%n * store_m + this%hvars(ih_storeptfrac_understory_scpf)%r82d(io_si,i_scpf) = & + this%hvars(ih_storeptfrac_understory_scpf)%r82d(io_si,i_scpf) + & + ccohort%n * store_max + end if + + end if end do elloop @@ -3183,7 +3221,7 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) area_frac = cpatch%area * AREA_INV - ! Sum up all output fluxes (fragmentation) kgC/m2/day -> gC/m2/s + ! Sum up all output fluxes (fragmentation) kgC/m2/day -> kgC/m2/s hio_litter_out_si(io_si) = hio_litter_out_si(io_si) + & (sum(litt%leaf_fines_frag(:)) + & sum(litt%root_fines_frag(:,:)) + & @@ -3256,8 +3294,6 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) this%hvars(ih_fnrtn_scpf)%r82d(io_si,:) = 0._r8 this%hvars(ih_sapwn_scpf)%r82d(io_si,:) = 0._r8 this%hvars(ih_storen_scpf)%r82d(io_si,:) = 0._r8 - this%hvars(ih_storentfrac_canopy_scpf)%r82d(io_si,:) = 0._r8 - this%hvars(ih_storentfrac_understory_scpf)%r82d(io_si,:) = 0._r8 this%hvars(ih_repron_scpf)%r82d(io_si,:) = 0._r8 this%hvars(ih_nefflux_scpf)%r82d(io_si,:) = & @@ -3282,8 +3318,6 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) this%hvars(ih_fnrtp_scpf)%r82d(io_si,:) = 0._r8 this%hvars(ih_sapwp_scpf)%r82d(io_si,:) = 0._r8 this%hvars(ih_storep_scpf)%r82d(io_si,:) = 0._r8 - this%hvars(ih_storeptfrac_canopy_scpf)%r82d(io_si,:) = 0._r8 - this%hvars(ih_storeptfrac_understory_scpf)%r82d(io_si,:) = 0._r8 this%hvars(ih_reprop_scpf)%r82d(io_si,:) = 0._r8 this%hvars(ih_pdemand_scpf)%r82d(io_si,:) = & @@ -3295,7 +3329,7 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) m2_per_ha / sec_per_day this%hvars(ih_pdemand_si)%r81d(io_si) = & - sum(sites(s)%flux_diags(el)%nutrient_demand_scpf(:),dim=1) + sum(sites(s)%flux_diags(el)%nutrient_demand_scpf(:),dim=1) / & m2_per_ha / sec_per_day this%hvars(ih_pefflux_si)%r81d(io_si) = & @@ -3414,14 +3448,6 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) this%hvars(ih_repron_scpf)%r82d(io_si,i_scpf) + & repro_m * ccohort%n / m2_per_ha - if (ccohort%canopy_layer .eq. 1) then - this%hvars(ih_storentfrac_canopy_scpf)%r82d(io_si,i_scpf) = & - this%hvars(ih_storentfrac_canopy_scpf)%r82d(io_si,i_scpf) + store_m/store_max * ccohort%n - else - this%hvars(ih_storentfrac_understory_scpf)%r82d(io_si,i_scpf) = & - this%hvars(ih_storentfrac_understory_scpf)%r82d(io_si,i_scpf) + store_m/store_max * ccohort%n - end if - elseif(element_list(el).eq.phosphorus_element)then store_max = ccohort%prt%GetNutrientTarget(element_list(el),store_organ,stoich_max) @@ -3445,14 +3471,6 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) this%hvars(ih_reprop_scpf)%r82d(io_si,i_scpf) + & repro_m * ccohort%n / m2_per_ha - if (ccohort%canopy_layer .eq. 1) then - this%hvars(ih_storeptfrac_canopy_scpf)%r82d(io_si,i_scpf) = & - this%hvars(ih_storeptfrac_canopy_scpf)%r82d(io_si,i_scpf) + store_m/store_max * ccohort%n - else - this%hvars(ih_storeptfrac_understory_scpf)%r82d(io_si,i_scpf) = & - this%hvars(ih_storeptfrac_understory_scpf)%r82d(io_si,i_scpf) + store_m/store_max * ccohort%n - end if - end if ccohort => ccohort%shorter @@ -3491,7 +3509,6 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) do el = 1, num_elements - if(element_list(el).eq.nitrogen_element)then if( this%hvars(ih_storentfrac_si)%r81d(io_si)>nearzero ) then this%hvars(ih_storentfrac_si)%r81d(io_si) = this%hvars(ih_storen_si)%r81d(io_si) / & @@ -3501,16 +3518,15 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) do i_scls = 1,nlevsclass i_scpf = (i_pft-1)*nlevsclass + i_scls - if( hio_nplant_canopy_si_scpf(io_si,i_scpf)>nearzero ) then + if( this%hvars(ih_storentfrac_canopy_scpf)%r82d(io_si,i_scpf)>nearzero ) then this%hvars(ih_storentfrac_canopy_scpf)%r82d(io_si,i_scpf) = & - this%hvars(ih_storentfrac_canopy_scpf)%r82d(io_si,i_scpf) / & - (hio_nplant_canopy_si_scpf(io_si,i_scpf)*m2_per_ha) + storen_canopy_scpf(i_scpf) / & + this%hvars(ih_storentfrac_canopy_scpf)%r82d(io_si,i_scpf) end if - - if( hio_nplant_understory_si_scpf(io_si,i_scpf)>nearzero ) then + if( this%hvars(ih_storentfrac_understory_scpf)%r82d(io_si,i_scpf)>nearzero ) then this%hvars(ih_storentfrac_understory_scpf)%r82d(io_si,i_scpf) = & - this%hvars(ih_storentfrac_understory_scpf)%r82d(io_si,i_scpf) / & - (hio_nplant_understory_si_scpf(io_si,i_scpf)*m2_per_ha) + storen_understory_scpf(i_scpf) / & + this%hvars(ih_storentfrac_understory_scpf)%r82d(io_si,i_scpf) end if end do @@ -3524,16 +3540,15 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) do i_scls = 1,nlevsclass i_scpf = (i_pft-1)*nlevsclass + i_scls - if( hio_nplant_canopy_si_scpf(io_si,i_scpf)>nearzero ) then + if( this%hvars(ih_storeptfrac_canopy_scpf)%r82d(io_si,i_scpf)>nearzero ) then this%hvars(ih_storeptfrac_canopy_scpf)%r82d(io_si,i_scpf) = & - this%hvars(ih_storeptfrac_canopy_scpf)%r82d(io_si,i_scpf) /& - (hio_nplant_canopy_si_scpf(io_si,i_scpf)*m2_per_ha) - + storep_canopy_scpf(i_scpf) / & + this%hvars(ih_storeptfrac_canopy_scpf)%r82d(io_si,i_scpf) end if - if( hio_nplant_understory_si_scpf(io_si,i_scpf)>nearzero ) then + if( this%hvars(ih_storeptfrac_understory_scpf)%r82d(io_si,i_scpf)>nearzero ) then this%hvars(ih_storeptfrac_understory_scpf)%r82d(io_si,i_scpf) = & - this%hvars(ih_storeptfrac_understory_scpf)%r82d(io_si,i_scpf) /& - (hio_nplant_understory_si_scpf(io_si,i_scpf)*m2_per_ha) + storep_understory_scpf(i_scpf) / & + this%hvars(ih_storeptfrac_understory_scpf)%r82d(io_si,i_scpf) end if end do @@ -4487,25 +4502,25 @@ subroutine define_history_vars(this, initialize_variables) upfreq=1, ivar=ivar, initialize=initialize_variables, & index=ih_trimming_si) - call this%set_history_var(vname='FATES_LEAF2FNRT', units='kg kg-1', & + call this%set_history_var(vname='FATES_L2FR', units='kg kg-1', & long='The leaf to fineroot biomass multiplier for target allometry', & use_default='active', & avgflag='A', vtype=site_r8, hlms='CLM:ALM', upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_l2fr_si) - call this%set_history_var(vname='FATES_LEAF2FNRT_SCPF', units='kg kg-1', & + call this%set_history_var(vname='FATES_L2FR_SZPF', units='kg kg-1', & long='The leaf to fineroot biomass multiplier for target allometry', & use_default='active', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_l2fr_scpf) - call this%set_history_var(vname='FATES_LEAF2FNRT_CANOPY_SCPF', units='kg kg-1', & + call this%set_history_var(vname='FATES_L2FR_CANOPY_SZPF', units='kg kg-1', & long='The leaf to fineroot biomass multiplier for target allometry in canopy plants', & use_default='active', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_l2fr_canopy_scpf) - call this%set_history_var(vname='FATES_LEAF2FNRT_UNDERSTORY_SCPF', units='kg kg-1', & + call this%set_history_var(vname='FATES_L2FR_USTORY_SZPF', units='kg kg-1', & long='The leaf to fineroot biomass multiplier for target allometry in understory plants', & use_default='active', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', upfreq=1, & @@ -4959,7 +4974,7 @@ subroutine define_history_vars(this, initialize_variables) upfreq=1, ivar=ivar, initialize=initialize_variables, & index = ih_storec_si) - call this%set_history_var(vname='STOREC_TFRAC', units='kg kg-1', & + call this%set_history_var(vname='FATES_STOREC_TFRAC', units='kg kg-1', & long='Storage C fraction of target', use_default='active', & avgflag='A', vtype=site_r8, hlms='CLM:ALM', upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_storectfrac_si ) @@ -5012,7 +5027,7 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=site_r8, hlms='CLM:ALM', upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_storen_si) - call this%set_history_var(vname='FATES_STOREN_TF', units='1', & + call this%set_history_var(vname='FATES_STOREN_TFRAC', units='1', & long='storage N fraction of target', use_default='active', & avgflag='A', vtype=site_r8, hlms='CLM:ALM', upfreq=1, ivar=ivar, & initialize=initialize_variables, index = ih_storentfrac_si) @@ -5078,7 +5093,7 @@ subroutine define_history_vars(this, initialize_variables) upfreq=1, ivar=ivar, initialize=initialize_variables, & index = ih_storep_si) - call this%set_history_var(vname='FATES_STOREP_TF', units='1', & + call this%set_history_var(vname='FATES_STOREP_TFRAC', units='1', & long='storage P fraction of target', use_default='active', & avgflag='A', vtype=site_r8, hlms='CLM:ALM', upfreq=1, & ivar=ivar, initialize=initialize_variables, & @@ -5330,14 +5345,14 @@ subroutine define_history_vars(this, initialize_variables) upfreq=2, ivar=ivar, initialize=initialize_variables, & index = ih_ar_canopy_si) - call this%set_history_var(vname='FATES_GPP_UNDERSTORY', & + call this%set_history_var(vname='FATES_GPP_USTORY', & units='kg m-2 s-1', & long='gross primary production of understory plants in kg carbon per m2 per second', & use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & upfreq=2, ivar=ivar, initialize=initialize_variables, & index = ih_gpp_understory_si) - call this%set_history_var(vname='FATES_AUTORESP_UNDERSTORY', & + call this%set_history_var(vname='FATES_AUTORESP_USTORY', & units='kg m-2 s-1', & long='autotrophic respiration of understory plants in kg carbon per m2 per second', & use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & @@ -5557,7 +5572,7 @@ subroutine define_history_vars(this, initialize_variables) upfreq=1, ivar=ivar, initialize=initialize_variables, & index = ih_canopy_mortality_carbonflux_si) - call this%set_history_var(vname='FATES_MORTALITY_CFLUX_UNDERSTORY', & + call this%set_history_var(vname='FATES_MORTALITY_CFLUX_USTORY', & units = 'kg m-2 s-1', & long='flux of biomass carbon from live to dead pools from mortality of understory plants in kg carbon per m2 per second', & use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & @@ -6723,14 +6738,14 @@ subroutine define_history_vars(this, initialize_variables) hlms='CLM:ALM', upfreq=1, ivar=ivar, & initialize=initialize_variables, index = ih_storen_scpf) - call this%set_history_var(vname='FATES_STOREN_TF_CANOPY_SZPF', & + call this%set_history_var(vname='FATES_STOREN_TFRAC_CANOPY_SZPF', & units='1', & long='storage nitrogen fraction (0-1) of target, in canopy, by size-class x pft', & use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & hlms='CLM:ALM', upfreq=1, ivar=ivar, & initialize=initialize_variables, index = ih_storentfrac_canopy_scpf) - call this%set_history_var(vname='FATES_STOREN_TF_USTORY_SZPF', & + call this%set_history_var(vname='FATES_STOREN_TFRAC_USTORY_SZPF', & units='1', & long='storage nitrogen fraction (0-1) of target, in understory, by size-class x pft', & use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & @@ -6805,14 +6820,14 @@ subroutine define_history_vars(this, initialize_variables) hlms='CLM:ALM', upfreq=1, ivar=ivar, & initialize=initialize_variables, index = ih_storep_scpf) - call this%set_history_var(vname='FATES_STOREP_TF_CANOPY_SZPF', & + call this%set_history_var(vname='FATES_STOREP_TFRAC_CANOPY_SZPF', & units='1', & long='storage phosphorus fraction (0-1) of target, in canopy, by size-class x pft', & use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & hlms='CLM:ALM', upfreq=1, ivar=ivar, & initialize=initialize_variables, index = ih_storeptfrac_canopy_scpf) - call this%set_history_var(vname='FATES_STOREP_TF_USTORY_SZPF', & + call this%set_history_var(vname='FATES_STOREP_TFRAC_USTORY_SZPF', & units='1', & long='storage phosphorus fraction (0-1) of target, in understory, by size-class x pft', & use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & From 7a4a95a19537546c329ac573678dd65f271cc2d4 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Sun, 20 Feb 2022 12:32:18 -0500 Subject: [PATCH 15/55] Incremental work towards getting dynamic root response c/n balance to be boundless --- biogeochem/EDCanopyStructureMod.F90 | 22 +- biogeochem/EDCohortDynamicsMod.F90 | 22 +- biogeochem/EDPatchDynamicsMod.F90 | 12 +- main/EDMainMod.F90 | 26 +- main/EDTypesMod.F90 | 3 + main/FatesHistoryInterfaceMod.F90 | 25 +- main/FatesInterfaceMod.F90 | 11 +- main/FatesRunningMeanMod.F90 | 15 +- parteh/PRTAllometricCNPMod.F90 | 406 ++++++++++++++++------------ parteh/PRTLossFluxesMod.F90 | 2 +- 10 files changed, 331 insertions(+), 213 deletions(-) diff --git a/biogeochem/EDCanopyStructureMod.F90 b/biogeochem/EDCanopyStructureMod.F90 index 130fd776f7..e2db556bdb 100644 --- a/biogeochem/EDCanopyStructureMod.F90 +++ b/biogeochem/EDCanopyStructureMod.F90 @@ -42,7 +42,7 @@ module EDCanopyStructureMod use PRTGenericMod, only : repro_organ use PRTGenericMod, only : struct_organ use PRTGenericMod, only : SetState - use FatesRunningMeanMod, only : ema_lpa + use FatesRunningMeanMod, only : ema_lpa, ema_60day ! CIME Globals use shr_log_mod , only : errMsg => shr_log_errMsg @@ -659,6 +659,14 @@ subroutine DemoteFromLayer(currentSite,currentPatch,i_lyr,bc_in) allocate(copyc) + ! (keep as an example) + ! Initialize running means + !allocate(copyc%tveg_lpa) + allocate(copyc%l2fr_ema) + ! Note, no need to give a starter value here, + ! that will be taken care of in copy_cohort() + call copyc%l2fr_ema%InitRMean(ema_60day) + ! Initialize the PARTEH object and point to the ! correct boundary condition fields copyc%prt => null() @@ -669,12 +677,6 @@ subroutine DemoteFromLayer(currentSite,currentPatch,i_lyr,bc_in) call InitHydrCohort(currentSite,copyc) endif - ! (keep as an example) - ! Initialize running means - !allocate(copyc%tveg_lpa) - !call copyc%tveg_lpa%InitRMean(ema_lpa, & - ! init_value=currentPatch%tveg_lpa%GetMean()) - call copy_cohort(currentCohort, copyc) newarea = currentCohort%c_area - cc_loss @@ -1118,6 +1120,12 @@ subroutine PromoteIntoLayer(currentSite,currentPatch,i_lyr) allocate(copyc) + + allocate(copyc%l2fr_ema) + ! Note, no need to give a starter value here, + ! that will be taken care of in copy_cohort() + call copyc%l2fr_ema%InitRMean(ema_60day) + ! Initialize the PARTEH object and point to the ! correct boundary condition fields copyc%prt => null() diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index 4297375c13..7fe667ed33 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -18,7 +18,8 @@ module EDCohortDynamicsMod use FatesConstantsMod , only : fates_unset_r8 use FatesConstantsMod , only : nearzero use FatesConstantsMod , only : calloc_abs_error - use FatesRunningMeanMod , only : ema_lpa + use FatesConstantsMod , only : sec_per_day + use FatesRunningMeanMod , only : ema_lpa, ema_60day use FatesInterfaceTypesMod , only : hlm_days_per_year use FatesInterfaceTypesMod , only : nleafage use SFParamsMod , only : SF_val_CWD_frac @@ -93,11 +94,13 @@ module EDCohortDynamicsMod use PRTAllometricCNPMod, only : cnp_allom_prt_vartypes use PRTAllometricCNPMod, only : acnp_bc_in_id_pft, acnp_bc_in_id_ctrim use PRTAllometricCNPMod, only : acnp_bc_in_id_lstat, acnp_bc_inout_id_dbh + use PRTAllometricCNPMod, only : acnp_bc_in_id_l2fr_ema use PRTAllometricCNPMod, only : acnp_bc_inout_id_l2fr use PRTAllometricCNPMod, only : acnp_bc_inout_id_rmaint_def, acnp_bc_in_id_netdc use PRTAllometricCNPMod, only : acnp_bc_in_id_netdnh4, acnp_bc_in_id_netdno3, acnp_bc_in_id_netdp use PRTAllometricCNPMod, only : acnp_bc_out_id_cefflux, acnp_bc_out_id_nefflux use PRTAllometricCNPMod, only : acnp_bc_out_id_pefflux + use PRTAllometricCNPMod, only : fnrt_adapt_tscl use shr_infnan_mod, only : nan => shr_infnan_nan, assignment(=) @@ -315,15 +318,17 @@ subroutine create_cohort(currentSite, patchptr, pft, nn, hite, coage, dbh, & patchptr%shortest => new_cohort endif - call InitPRTBoundaryConditions(new_cohort) - - ! Allocate running mean functions ! (Keeping as an example) !! allocate(new_cohort%tveg_lpa) !! call new_cohort%tveg_lpa%InitRMean(ema_lpa,init_value=patchptr%tveg_lpa%GetMean()) + allocate(new_cohort%l2fr_ema) + call new_cohort%l2fr_ema%InitRMean(ema_60day,init_value=new_cohort%l2fr,init_offset=fnrt_adapt_tscl*sec_per_day) + + call InitPRTBoundaryConditions(new_cohort) + ! Recuits do not have mortality rates, nor have they moved any ! carbon when they are created. They will bias our statistics @@ -426,7 +431,8 @@ subroutine InitPRTBoundaryConditions(new_cohort) call new_cohort%prt%RegisterBCIn(acnp_bc_in_id_netdnh4, bc_rval = new_cohort%daily_nh4_uptake) call new_cohort%prt%RegisterBCIn(acnp_bc_in_id_netdno3, bc_rval = new_cohort%daily_no3_uptake) call new_cohort%prt%RegisterBCIn(acnp_bc_in_id_netdp, bc_rval = new_cohort%daily_p_uptake) - + call new_cohort%prt%RegisterBCIn(acnp_bc_in_id_l2fr_ema, bc_rval = new_cohort%l2fr_ema%l_mean) + call new_cohort%prt%RegisterBCInOut(acnp_bc_inout_id_dbh,bc_rval = new_cohort%dbh) call new_cohort%prt%RegisterBCInOut(acnp_bc_inout_id_rmaint_def,bc_rval = new_cohort%resp_m_def) call new_cohort%prt%RegisterBCInOut(acnp_bc_inout_id_l2fr,bc_rval = new_cohort%l2fr) @@ -1011,7 +1017,8 @@ subroutine DeallocateCohort(currentCohort) ! (Keeping as an example) ! Remove the running mean structure ! deallocate(currentCohort%tveg_lpa) - + deallocate(currentCohort%l2fr_ema) + ! At this point, nothing should be pointing to current Cohort if (hlm_use_planthydro.eq.itrue) call DeallocateHydrCohort(currentCohort) @@ -1179,6 +1186,8 @@ subroutine fuse_cohorts(currentSite, currentPatch, bc_in) ! Running mean fuses based on number density fraction just ! like other variables !!call currentCohort%tveg_lpa%FuseRMean(nextc%tveg_lpa,currentCohort%n/newn) + + call currentCohort%l2fr_ema%FuseRMean(nextc%l2fr_ema,currentCohort%n/newn) ! new cohort age is weighted mean of two cohorts currentCohort%coage = & @@ -1823,6 +1832,7 @@ subroutine copy_cohort( currentCohort,copyc ) ! (Keeping as an example) ! Copy over running means ! call n%tveg_lpa%CopyFromDonor(o%tveg_lpa) + call n%l2fr_ema%CopyFromDonor(o%l2fr_ema) ! CARBON FLUXES n%gpp_acc_hold = o%gpp_acc_hold diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 5f89ba0b07..17f72aff8f 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -89,7 +89,7 @@ module EDPatchDynamicsMod use SFParamsMod, only : SF_VAL_CWD_FRAC use EDParamsMod, only : logging_event_code use EDParamsMod, only : logging_export_frac - use FatesRunningMeanMod, only : ema_24hr, fixed_24hr, ema_lpa + use FatesRunningMeanMod, only : ema_24hr, fixed_24hr, ema_lpa, ema_60day ! CIME globals use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) @@ -697,6 +697,11 @@ subroutine spawn_patches( currentSite, bc_in) allocate(nc) if(hlm_use_planthydro.eq.itrue) call InitHydrCohort(CurrentSite,nc) + + allocate(nc%l2fr_ema) + ! Note, no need to give a starter value here, + ! that will be taken care of in copy_cohort() + call nc%l2fr_ema%InitRMean(ema_60day) ! Initialize the PARTEH object and point to the ! correct boundary condition fields @@ -704,11 +709,6 @@ subroutine spawn_patches( currentSite, bc_in) call InitPRTObject(nc%prt) call InitPRTBoundaryConditions(nc) - ! (Keeping as an example) - ! Allocate running mean functions - !allocate(nc%tveg_lpa) - !call nc%tveg_lpa%InitRMean(ema_lpa,init_value=new_patch%tveg_lpa%GetMean()) - call zero_cohort(nc) ! nc is the new cohort that goes in the disturbed patch (new_patch)... currentCohort diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index d9ef3d07a0..3399c1122f 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -79,6 +79,7 @@ module EDMainMod use FatesPlantHydraulicsMod , only : UpdateSizeDepRhizHydProps use FatesPlantHydraulicsMod , only : AccumulateMortalityWaterStorage use FatesAllometryMod , only : h_allom,tree_sai,tree_lai + use FatesAllometryMod , only : bleaf use FatesPlantHydraulicsMod , only : UpdateSizeDepRhizHydStates use EDLoggingMortalityMod , only : IsItLoggingTime use EDPatchDynamicsMod , only : get_frac_site_primary @@ -335,23 +336,23 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) logical :: is_drought ! logical for if the plant (site) is in a drought state real(r8) :: delta_dbh ! correction for dbh real(r8) :: delta_hite ! correction for hite - + real(r8) :: actual_l2fr ! The fine-root/leaf carbon biomass ratio following allocation + ! note, this is not the target, but the actual + real(r8) :: leaf_c_target ! target leaf crabon [kg] real(r8) :: current_npp ! place holder for calculating npp each year in prescribed physiology mode !----------------------------------------------------------------------- real(r8) :: frac_site_primary - print*,"DYNAMICS" - call get_frac_site_primary(currentSite, frac_site_primary) ! Set a pointer to this sites carbon12 mass balance site_cmass => currentSite%mass_balance(element_pos(carbon12_element)) currentPatch => currentSite%youngest_patch - do while(associated(currentPatch)) - + !print*,"PATCH" + currentPatch%age = currentPatch%age + hlm_freq_day ! FIX(SPM,032414) valgrind 'Conditional jump or move depends on uninitialised value' if( currentPatch%age < 0._r8 )then @@ -443,9 +444,22 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) ! Growth and Allocation (PARTEH) ! ----------------------------------------------------------------------------- - call currentCohort%prt%DailyPRT() + + + ! Update the moving average of actual L2FR + call bleaf(currentCohort%dbh,currentCohort%pft,currentCohort%canopy_trim,leaf_c_target) + if(currentCohort%prt%GetState(leaf_organ, carbon12_element)/leaf_c_target>0.01_r8)then + actual_l2fr = currentCohort%prt%GetState(fnrt_organ, carbon12_element) / & + currentCohort%prt%GetState(leaf_organ, carbon12_element) + actual_l2fr = max(0.05_r8,min(10._r8,actual_l2fr)) + + call currentCohort%l2fr_ema%UpdateRMean(actual_l2fr) + end if + + call currentCohort%prt%DailyPRT() + ! Update the mass balance tracking for the daily nutrient uptake flux ! Then zero out the daily uptakes, they have been used ! ----------------------------------------------------------------------------- diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index da5198d842..041626447c 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -221,6 +221,9 @@ module EDTypesMod ! parameters, with a tendency driven by ! nutrient storage) + + class(rmean_type), pointer :: l2fr_ema ! Exponential moving average of the L2FR + ! VEGETATION STRUCTURE integer :: pft ! pft number real(r8) :: n ! number of individuals in cohort per 'area' (10000m2 default) diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 15b7e479bc..34fa749dbb 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -184,6 +184,7 @@ module FatesHistoryInterfaceMod integer :: ih_totvegp_si integer :: ih_l2fr_si + integer :: ih_l2fr_ema_si integer :: ih_l2fr_scpf integer :: ih_l2fr_canopy_scpf integer :: ih_l2fr_understory_scpf @@ -1857,6 +1858,7 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) hio_ncohorts_si => this%hvars(ih_ncohorts_si)%r81d, & hio_trimming_si => this%hvars(ih_trimming_si)%r81d, & hio_l2fr_si => this%hvars(ih_l2fr_si)%r81d, & + hio_l2fr_ema_si => this%hvars(ih_l2fr_ema_si)%r81d, & hio_l2fr_scpf => this%hvars(ih_l2fr_scpf)%r82d, & hio_l2fr_canopy_scpf => this%hvars(ih_l2fr_canopy_scpf)%r82d, & hio_l2fr_understory_scpf => this%hvars(ih_l2fr_understory_scpf)%r82d, & @@ -2400,6 +2402,9 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) ! These L2FR diagnostics are weighted by fineroot carbon biomass hio_l2fr_si(io_si) = hio_l2fr_si(io_si) + ccohort%n*fnrt_m/m2_per_ha*ccohort%l2fr + + + hio_l2fr_ema_si(io_si) = hio_l2fr_ema_si(io_si) + ccohort%n*fnrt_m/m2_per_ha*ccohort%l2fr_ema%GetMean() hio_l2fr_scpf(io_si,i_scpf) = & hio_l2fr_scpf(io_si,i_scpf) + ccohort%n*fnrt_m/m2_per_ha*ccohort%l2fr @@ -3045,7 +3050,8 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) ! Normalize the l2fr value by total biomass hio_l2fr_si(io_si) = hio_l2fr_si(io_si)/this%hvars(ih_fnrtc_si)%r81d(io_si) - + hio_l2fr_ema_si(io_si) = hio_l2fr_ema_si(io_si)/this%hvars(ih_fnrtc_si)%r81d(io_si) + ! divide so-far-just-summed but to-be-averaged patch-age-class variables by patch-age-class area to get mean values do ipa2 = 1, nlevage @@ -3226,7 +3232,9 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) (sum(litt%leaf_fines_frag(:)) + & sum(litt%root_fines_frag(:,:)) + & sum(litt%ag_cwd_frag(:)) + & - sum(litt%bg_cwd_frag(:,:))) * & + sum(litt%bg_cwd_frag(:,:)) + & + sum(litt%seed_decay(:)) + & + sum(litt%seed_germ_decay(:))) * & area_frac * days_per_sec ! Sum up total seed bank (germinated and ungerminated) @@ -4502,12 +4510,19 @@ subroutine define_history_vars(this, initialize_variables) upfreq=1, ivar=ivar, initialize=initialize_variables, & index=ih_trimming_si) - call this%set_history_var(vname='FATES_L2FR', units='kg kg-1', & + call this%set_history_var(vname='FATES_L2FR', units='kg kg-1', & long='The leaf to fineroot biomass multiplier for target allometry', & use_default='active', & avgflag='A', vtype=site_r8, hlms='CLM:ALM', upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_l2fr_si) + call this%set_history_var(vname='FATES_L2FR_EMA', units='kg kg-1', & + long='Moving average of the leaf to fineroot biomass multiplier for target allometry', & + use_default='active', & + avgflag='A', vtype=site_r8, hlms='CLM:ALM', upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_l2fr_ema_si) + + call this%set_history_var(vname='FATES_L2FR_SZPF', units='kg kg-1', & long='The leaf to fineroot biomass multiplier for target allometry', & use_default='active', & @@ -4906,7 +4921,7 @@ subroutine define_history_vars(this, initialize_variables) index = ih_litter_in_si) call this%set_history_var(vname='FATES_LITTER_OUT', units='kg m-2 s-1', & - long='litter flux out in kg carbon per m2 per second', & + long='litter flux out in kg carbon (fragmentation AND seed decay)', & use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & upfreq=1, ivar=ivar, initialize=initialize_variables, & index = ih_litter_out_si) @@ -4930,7 +4945,7 @@ subroutine define_history_vars(this, initialize_variables) index = ih_litter_in_elem) call this%set_history_var(vname='FATES_LITTER_OUT_EL', units='kg m-2 s-1', & - long='litter flux out (fragmentation only) in kg element per m2 per second', & + long='litter flux out (fragmentation and seed decay) in kg element', & use_default='active', avgflag='A', vtype=site_elem_r8, & hlms='CLM:ALM', upfreq=1, ivar=ivar, initialize=initialize_variables, & index = ih_litter_out_elem) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 947dabf179..2ad860ef47 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -80,10 +80,11 @@ module FatesInterfaceMod use FatesRunningMeanMod , only : ema_24hr use FatesRunningMeanMod , only : fixed_24hr use FatesRunningMeanMod , only : ema_lpa + use FatesRunningMeanMod , only : ema_60day use FatesRunningMeanMod , only : moving_ema_window use FatesRunningMeanMod , only : fixed_window use FatesHistoryInterfaceMod , only : fates_hist - + use PRTAllometricCNPMod , only : fnrt_adapt_tscl ! CIME Globals use shr_log_mod , only : errMsg => shr_log_errMsg @@ -926,7 +927,13 @@ subroutine InitTimeAveragingGlobals() allocate(ema_lpa) call ema_lpa%define(photo_temp_acclim_timescale*sec_per_day, & hlm_stepsize,moving_ema_window) + allocate(ema_60day) + call ema_60day%define(fnrt_adapt_tscl*sec_per_day,sec_per_day,moving_ema_window) + !class(rmean_arr_type), pointer :: ema_fnrt_tscale(:) + !rmean_arr_type + + return end subroutine InitTimeAveragingGlobals @@ -1909,7 +1916,7 @@ subroutine UpdateFatesRMeansTStep(sites,bc_in) call cpatch%tveg24%UpdateRMean(bc_in(s)%t_veg_pa(ifp)) call cpatch%tveg_lpa%UpdateRMean(bc_in(s)%t_veg_pa(ifp)) - ! (Keeping as an example) + !ccohort => cpatch%tallest !do while (associated(ccohort)) ! call ccohort%tveg_lpa%UpdateRMean(bc_in(s)%t_veg_pa(ifp)) diff --git a/main/FatesRunningMeanMod.F90 b/main/FatesRunningMeanMod.F90 index 7fa3bfd7cc..f7887f3fb4 100644 --- a/main/FatesRunningMeanMod.F90 +++ b/main/FatesRunningMeanMod.F90 @@ -91,6 +91,15 @@ module FatesRunningMeanMod class(rmean_def_type), public, pointer :: ema_24hr ! Exponential moving average - 24hr window class(rmean_def_type), public, pointer :: fixed_24hr ! Fixed, 24-hour window class(rmean_def_type), public, pointer :: ema_lpa ! Exponential moving average - leaf photo acclimation + class(rmean_def_type), public, pointer :: ema_60day ! Exponential moving average, 60 day + ! Updated daily + + + ! If we want to have different running mean specs based on + ! pft or other types of constants + type, public :: rmean_arr_type + class(rmean_def_type), pointer :: p + end type rmean_arr_type contains @@ -197,7 +206,11 @@ subroutine InitRMean(this,rmean_def,init_value,init_offset) if(present(init_value))then this%c_mean = init_value this%l_mean = init_value - this%c_index = 1 + if(present(init_offset))then + this%c_index = min(nint(init_offset/rmean_def%up_period),rmean_def%n_mem) + else + this%c_index = 1 + end if else this%c_mean = nan this%l_mean = nan diff --git a/parteh/PRTAllometricCNPMod.F90 b/parteh/PRTAllometricCNPMod.F90 index 24849e40bc..75aac5c285 100644 --- a/parteh/PRTAllometricCNPMod.F90 +++ b/parteh/PRTAllometricCNPMod.F90 @@ -146,16 +146,17 @@ module PRTAllometricCNPMod ! Input only Boundary Indices (These are public) ! ------------------------------------------------------------------------------------- - integer, public, parameter :: acnp_bc_in_id_pft = 1 ! Index for the PFT input BC - integer, public, parameter :: acnp_bc_in_id_ctrim = 2 ! Index for the canopy trim function - integer, public, parameter :: acnp_bc_in_id_lstat = 3 ! phenology status logical - integer, public, parameter :: acnp_bc_in_id_netdc = 4 ! Index for the net daily C input BC - integer, public, parameter :: acnp_bc_in_id_netdnh4 = 5 ! Index for the net daily NH4 input BC - integer, public, parameter :: acnp_bc_in_id_netdno3 = 6 ! Index for the net daily NO3 input BC - integer, public, parameter :: acnp_bc_in_id_netdp = 7 ! Index for the net daily P input BC + integer, public, parameter :: acnp_bc_in_id_pft = 1 ! Index for the PFT input BC + integer, public, parameter :: acnp_bc_in_id_ctrim = 2 ! Index for the canopy trim function + integer, public, parameter :: acnp_bc_in_id_lstat = 3 ! phenology status logical + integer, public, parameter :: acnp_bc_in_id_netdc = 4 ! Index for the net daily C input BC + integer, public, parameter :: acnp_bc_in_id_netdnh4 = 5 ! Index for the net daily NH4 input BC + integer, public, parameter :: acnp_bc_in_id_netdno3 = 6 ! Index for the net daily NO3 input BC + integer, public, parameter :: acnp_bc_in_id_netdp = 7 ! Index for the net daily P input BC + integer, public, parameter :: acnp_bc_in_id_l2fr_ema = 8 ! Index for the moving average ema ! 0=leaf off, 1=leaf on - integer, parameter :: num_bc_in = 7 + integer, parameter :: num_bc_in = 8 ! ------------------------------------------------------------------------------------- ! Output Boundary Indices (These are public) @@ -174,11 +175,6 @@ module PRTAllometricCNPMod integer,private, parameter :: intgr_parm_l2fr = 3 integer,private, parameter :: num_intgr_parm = 3 - - real(r8), parameter :: min_stf_growth = 0.8_r8 ! Plants are only allowed to increase in stature - ! if they have more than 80% of their stores full - - ! ------------------------------------------------------------------------------------- ! Define the size of the coorindate vector. For this hypothesis, there is only ! one pool per each species x organ combination, except for leaves (WHICH HAVE AGE) @@ -208,6 +204,12 @@ module PRTAllometricCNPMod integer, parameter :: regulate_logi = 2 integer, parameter :: regulate_CN_logi = 3 integer, parameter :: regulate_CN_dfdd = 4 + integer, parameter :: regulate_CN_ema = 5 + + + !real(r8), public, parameter :: fnrt_adapt_tscl = 365._r8 ! Fine-root adaptation timescale (days) + + real(r8), public, parameter :: fnrt_adapt_tscl = 30._r8 ! Fine-root adaptation timescale (days) ! Array of pointers are difficult in F90 ! This structure is a necessary intermediate @@ -351,6 +353,7 @@ subroutine DailyPRTAllometricCNP(this) real(r8) :: n_gain ! Daily nitrogen uptake through fine-roots [kgN] real(r8) :: p_gain ! Daily phosphorus uptake through fine-roots [kgN] real(r8) :: canopy_trim ! The canopy trimming function [0-1] + real(r8) :: l2fr_ema ! Mean (EMA) l2fr ! Pointers to output bcs real(r8),pointer :: c_efflux ! Total plant efflux of carbon (kgC) @@ -397,6 +400,19 @@ subroutine DailyPRTAllometricCNP(this) real(r8) :: target_n,target_p real(r8) :: sum_c ! error checking sum + + + ! =================================================================================== + ! Step 1: Evaluate nutrient storage in the plant. Depending on how low + ! these stores are, we will move proportionally more or less of the daily carbon + ! gain to increase the target fine-root biomass, fill up to target + ! and then attempt to get them up to stoichiometry targets. + ! =================================================================================== + + ! This routine actually just updates the l2fr variable + call this%CNPAdjustFRootTargets() + + ! integrator variables ! Copy the input only boundary conditions into readable local variables @@ -411,7 +427,8 @@ subroutine DailyPRTAllometricCNP(this) p_gain = this%bc_in(acnp_bc_in_id_netdp)%rval; p_gain0 = p_gain canopy_trim = this%bc_in(acnp_bc_in_id_ctrim)%rval ipft = this%bc_in(acnp_bc_in_id_pft)%ival - + + ! Output only boundary conditions c_efflux => this%bc_out(acnp_bc_out_id_cefflux)%rval; c_efflux = 0._r8 n_efflux => this%bc_out(acnp_bc_out_id_nefflux)%rval; n_efflux = 0._r8 @@ -473,25 +490,16 @@ subroutine DailyPRTAllometricCNP(this) end do - ! =================================================================================== - ! Step 1: Evaluate nutrient storage in the plant. Depending on how low - ! these stores are, we will move proportionally more or less of the daily carbon - ! gain to increase the target fine-root biomass, fill up to target - ! and then attempt to get them up to stoichiometry targets. - ! =================================================================================== - - ! This routine actually just updates the l2fr variable - call this%CNPAdjustFRootTargets() + call bfineroot(dbh,ipft,canopy_trim, l2fr, target_c(fnrt_id), target_dcdd(fnrt_id)) ! =================================================================================== ! Step 0. Transfer all stored nutrient into the daily uptake pool. - ! Storage in nutrients does not need to have a buffer like - ! carbon does, so we simply use it when we want it, and then - ! anything left at the end is added back (CNPAllocateRemainder()) ! =================================================================================== - + !i_var = prt_global%sp_organ_map(store_organ,carbon12_element) + !c_gain = c_gain + max(0._r8,sum(this%variables(i_var)%val(:))-target_c(store_id)) + !this%variables(i_var)%val(1) = this%variables(i_var)%val(1)-max(0._r8,sum(this%variables(i_var)%val(:))-target_c(store_id)) i_var = prt_global%sp_organ_map(store_organ,nitrogen_element) n_gain = n_gain + sum(this%variables(i_var)%val(:)) @@ -623,8 +631,8 @@ subroutine DailyPRTAllometricCNP(this) end if end if - target_n = this%GetNutrientTarget(nitrogen_element,store_organ,stoich_max) - target_p = this%GetNutrientTarget(phosphorus_element,store_organ,stoich_max) + !target_n = this%GetNutrientTarget(nitrogen_element,store_organ,stoich_max) + !target_p = this%GetNutrientTarget(phosphorus_element,store_organ,stoich_max) deallocate(state_c) deallocate(state_n) @@ -642,8 +650,11 @@ subroutine CNPAdjustFRootTargets(this) integer :: ipft ! PFT index real(r8), pointer :: dbh real(r8) :: canopy_trim + real(r8) :: l2fr_ema ! Moving average L2FR (EMA) + real(r8) :: l2fr_actual real(r8) :: fnrt_c_target ! Target fineroot C before we change l2fr + real(r8) :: leaf_c_target real(r8) :: n_regulator ! Nitrogen storage regulation function scaler real(r8) :: p_regulator ! Phosphorus storage regulation function scaler real(r8) :: np_regulator ! Combined NP storage regulation function scaler @@ -651,13 +662,18 @@ subroutine CNPAdjustFRootTargets(this) ! remain after a day of root turnover without ! replacement real(r8) :: fnrt_frac ! fine-root's current fraction of the target - - integer, parameter :: regulate_type = regulate_CN_logi !regulate_CN_dfdd + real(r8) :: loss_flux_c + real(r8) :: loss_flux_n + real(r8) :: loss_flux_p + real(r8) :: fnrt_c_above_target + + integer, parameter :: regulate_type = regulate_CN_ema ipft = this%bc_in(acnp_bc_in_id_pft)%ival l2fr => this%bc_inout(acnp_bc_inout_id_l2fr)%rval dbh => this%bc_inout(acnp_bc_inout_id_dbh)%rval canopy_trim = this%bc_in(acnp_bc_in_id_ctrim)%rval + l2fr_ema = this%bc_in(acnp_bc_in_id_l2fr_ema)%rval associate( l2fr_min => prt_params%allom_l2fr_min(ipft), & l2fr_max => prt_params%allom_l2fr_max(ipft)) @@ -675,7 +691,23 @@ subroutine CNPAdjustFRootTargets(this) if(regulate_type == regulate_CN_logi)then - l2fr = l2fr_min + max(0._r8,min(1.0_r8,np_regulator))*(l2fr_max-l2fr_min) + l2fr = l2fr_min + max(0._r8,min(1.0_r8,np_regulator))*(l2fr_max-l2fr_min) + + + elseif(regulate_type == regulate_CN_ema) then + + ! To prevent the target l2fr from diverging too far from the + ! actual l2fr, create some constraints. + l2fr_actual = this%GetState(fnrt_organ, carbon12_element)/this%GetState(leaf_organ, carbon12_element) + + ! Only update L2FR if some leaves are out + call bleaf(dbh,ipft,canopy_trim,leaf_c_target) + if(this%GetState(leaf_organ, carbon12_element)/leaf_c_target>0.5_r8) then + l2fr = l2fr_ema * np_regulator + !l2fr = l2fr_actual * np_regulator + !l2fr = l2fr * np_regulator + end if + elseif(regulate_type == regulate_CN_dfdd)then @@ -706,33 +738,40 @@ subroutine CNPAdjustFRootTargets(this) ! equilibrium root mass more quickly. (might be unnecessary given ! the growth caps prior to this...?) - - - !print*,dbh,fnrt_frac,l2fr,min(max(np_regulator,1._r8-turnfrac),1._r8+turnfrac) - l2fr = l2fr * min(max(np_regulator,1._r8-2._r8*turnfrac),1._r8+2._r8*turnfrac) end if - - ! Find the updated target fineroot biomass - ! call bfineroot(dbh,ipft,canopy_trim, l2fr, target_fnrt) + call bfineroot(dbh,ipft,canopy_trim, l2fr, fnrt_c_target) + + fnrt_c_above_target = max(0._r8,this%GetState(fnrt_organ, carbon12_element) - fnrt_c_target) - ! Consider removing biomass immediately too... - ! we could send it to the turnover flux - ! c_to_froot = max(0._r8,target_fnrt - state_c(fnrt_id)%ptr) + ! Allow no reabsorption? (any reabsorption of nutrients will further push the N/C or P/C imbalance + ! and if we are dropping roots, its because we had excess nutrient compared to carbon anyway + ! Stop the positive feedback - ! Update the actual carbon - ! state_c(fnrt_id)%ptr = state_c(fnrt_id)%ptr + c_to_froot + ! Since this is really a stop gap, we want to allow allocation to handle most of the + ! fine-root adaption, and only have this kick in when the target starts to drift significantly + ! from the actual - ! Push nitrogen into fineroots to get to stoichiometry - ! call ProportionalNutrAllocation(state_n, deficit_n, & - ! n_gain, nitrogen_element, fnrt_id) + loss_flux_c = 0._r8 + + !loss_flux_c = fnrt_c_above_target*max(fnrt_c_above_target/fnrt_c_target-0.1_r8,0._r8) + + + loss_flux_n = loss_flux_c*this%variables(fnrt_n_id)%val(1)/this%variables(fnrt_c_id)%val(1) + this%variables(fnrt_n_id)%val(1) = this%variables(fnrt_n_id)%val(1) - loss_flux_n + this%variables(fnrt_n_id)%turnover(1) = this%variables(fnrt_n_id)%turnover(1) + loss_flux_p + + loss_flux_p = loss_flux_c*this%variables(fnrt_p_id)%val(1)/this%variables(fnrt_c_id)%val(1) + this%variables(fnrt_p_id)%val(1) = this%variables(fnrt_p_id)%val(1) - loss_flux_p + this%variables(fnrt_p_id)%turnover(1) = this%variables(fnrt_p_id)%turnover(1) + loss_flux_p + + this%variables(fnrt_c_id)%val(1) = this%variables(fnrt_c_id)%val(1) - loss_flux_c + this%variables(fnrt_c_id)%turnover(1) = this%variables(fnrt_c_id)%turnover(1) + loss_flux_c - ! Push phos into fineroots to get to stoichiometry - ! call ProportionalNutrAllocation(state_p, deficit_p, & - ! p_gain, phosphorus_element, fnrt_id) + end associate @@ -775,7 +814,6 @@ subroutine CNPPrioritizedReplacement(this, & real(r8) :: canopy_trim ! trim factor for maximum leaf biomass real(r8) :: target_n ! Target mass of N for a given organ [kg] real(r8) :: target_p ! Target mass of P for a given organ [kg] - real(r8) :: c_gain0 integer :: priority_code ! Index for priority level of each organ real(r8) :: sum_c_demand ! Carbon demanded to bring tissues up to allometry (kg) real(r8) :: sum_n_deficit ! The nitrogen deficit of all pools for given priority level (kg) @@ -798,9 +836,6 @@ subroutine CNPPrioritizedReplacement(this, & ! the total number organs plus 1, which allows ! each organ to have its own level, and ignore ! the specialized priority 1 - - - c_gain0 = c_gain leaf_status = this%bc_in(acnp_bc_in_id_lstat)%ival ipft = this%bc_in(acnp_bc_in_id_pft)%ival @@ -874,14 +909,8 @@ subroutine CNPPrioritizedReplacement(this, & i_cvar = prt_global%sp_organ_map(organ_list(i),carbon12_element) - if(reproduce_conly) then - c_flux = min(prt_params%leaf_stor_priority(ipft)*sum(this%variables(i_cvar)%turnover(:)), & - max(0.0_r8, (state_c(store_id)%ptr+c_gain)* & - (prt_params%leaf_stor_priority(ipft)*sum(this%variables(i_cvar)%turnover(:))/sum_c_demand) )) - else - c_flux = sum_c_flux*(prt_params%leaf_stor_priority(ipft) * & - sum(this%variables(i_cvar)%turnover(:))/sum_c_demand) - end if + c_flux = sum_c_flux*(prt_params%leaf_stor_priority(ipft) * & + sum(this%variables(i_cvar)%turnover(:))/sum_c_demand) ! Add carbon to the pool state_c(i)%ptr = state_c(i)%ptr + c_flux @@ -892,7 +921,7 @@ subroutine CNPPrioritizedReplacement(this, & end do end if - ! Determine nutrient demand and make tansfers (ignore replacing storage) + ! Determine nutrient demand and make tansfers do i = 1, n_curpri_org i_org = curpri_org(i) @@ -900,19 +929,13 @@ subroutine CNPPrioritizedReplacement(this, & ! Update the nitrogen deficits ! Note that the nitrogen target is tied to the stoichiometry of thegrowing pool only - if(organ_list(i_org).ne.store_organ)then - - target_n = this%GetNutrientTarget(nitrogen_element,organ_list(i_org),stoich_growth_min) - deficit_n(i_org) = max(0.0_r8, target_n - state_n(i_org)%ptr ) - - ! Update the phosphorus deficits (which are based off of carbon actual..) - ! Note that the phsophorus target is tied to the stoichiometry of thegrowing pool only (also) - target_p = this%GetNutrientTarget(phosphorus_element,organ_list(i_org),stoich_growth_min) - deficit_p(i_org) = max(0.0_r8, target_p - state_p(i_org)%ptr ) - else - deficit_n(i_org) = 0._r8 - deficit_p(i_org) = 0._r8 - end if + target_n = this%GetNutrientTarget(nitrogen_element,organ_list(i_org),stoich_growth_min) + deficit_n(i_org) = max(0.0_r8, target_n - state_n(i_org)%ptr ) + + ! Update the phosphorus deficits (which are based off of carbon actual..) + ! Note that the phsophorus target is tied to the stoichiometry of thegrowing pool only (also) + target_p = this%GetNutrientTarget(phosphorus_element,organ_list(i_org),stoich_growth_min) + deficit_p(i_org) = max(0.0_r8, target_p - state_p(i_org)%ptr ) end do @@ -936,8 +959,8 @@ subroutine CNPPrioritizedReplacement(this, & ! Storage will have to pay for any negative gains store_c_flux = -c_gain - c_gain = c_gain + store_c_flux - state_c(store_id)%ptr = state_c(store_id)%ptr - store_c_flux + c_gain = c_gain + store_c_flux + state_c(store_id)%ptr = state_c(store_id)%ptr - store_c_flux else @@ -949,8 +972,6 @@ subroutine CNPPrioritizedReplacement(this, & store_demand = max(c_gain*(exp(-1.*store_target_fraction**4._r8) - exp( -1.0_r8 )),0._r8) - - ! The flux is the (positive) minimum of all three store_c_flux = min(store_below_target,store_demand) @@ -996,7 +1017,7 @@ subroutine CNPPrioritizedReplacement(this, & ! (this prevents accidental re-flushing on the day they drop) if((leaf_status.eq.leaves_off) .and. (organ_list(ii).eq.leaf_organ)) cycle - ! 1 is the highest priority code possible + if( priority_code == i_pri ) then deficit_c(ii) = max(0._r8,this%GetDeficit(carbon12_element,organ_list(ii),target_c(ii))) i = i + 1 @@ -1010,9 +1031,6 @@ subroutine CNPPrioritizedReplacement(this, & n_curpri_org = i - ! The total amount of carbon needed to be replaced - ! is the deficit and the growth respiration needed - ! accomany replacing that deficit sum_c_demand = 0._r8 do i=1,n_curpri_org @@ -1028,12 +1046,7 @@ subroutine CNPPrioritizedReplacement(this, & i_org = curpri_org(i) - if(reproduce_conly) then - c_flux = min(deficit_c(i_org), & - c_gain*(deficit_c(i_org)/sum_c_demand)) - else - c_flux = sum_c_flux*deficit_c(i_org)/sum_c_demand - end if + c_flux = sum_c_flux*deficit_c(i_org)/sum_c_demand ! Update the carbon pool state_c(i_org)%ptr = state_c(i_org)%ptr + c_flux @@ -1047,58 +1060,24 @@ subroutine CNPPrioritizedReplacement(this, & end do end if - - sum_c_demand = 0._r8 - do i=1,n_curpri_org - i_org = curpri_org(i) - deficit_c(i_org) = max(0._r8,this%GetDeficit(carbon12_element,organ_list(i_org),target_c(i_org))) - sum_c_demand = sum_c_demand + deficit_c(i_org) - end do - - sum_c_flux = min(c_gain, sum_c_demand) - - ! Transfer carbon into pools if there is any (second round to match C-only) - if (sum_c_flux>nearzero) then - do i = 1, n_curpri_org - - i_org = curpri_org(i) - - c_flux = sum_c_flux*deficit_c(i_org)/sum_c_demand - - ! Update the carbon pool - state_c(i_org)%ptr = state_c(i_org)%ptr + c_flux - - ! Update carbon pools deficit - deficit_c(i_org) = max(0._r8,deficit_c(i_org) - c_flux) - - ! Reduce the carbon gain - c_gain = c_gain - c_flux - - end do - end if - ! Determine nutrient demand and make tansfers do i = 1, n_curpri_org i_org = curpri_org(i) -! if(organ_list(i_org).ne.store_organ)then - ! Update the nitrogen deficits - ! Note that the nitrogen target is tied to the stoichiometry of thegrowing pool only - target_n = this%GetNutrientTarget(nitrogen_element,organ_list(i_org),stoich_growth_min) - deficit_n(i_org) = max(0.0_r8, target_n - state_n(i_org)%ptr ) + + ! Update the nitrogen deficits + ! Note that the nitrogen target is tied to the stoichiometry of thegrowing pool only + target_n = this%GetNutrientTarget(nitrogen_element,organ_list(i_org),stoich_growth_min) + deficit_n(i_org) = max(0.0_r8, target_n - state_n(i_org)%ptr ) - ! Update the phosphorus deficits (which are based off of carbon actual..) - ! Note that the phsophorus target is tied to the stoichiometry of thegrowing pool only (also) - target_p = this%GetNutrientTarget(phosphorus_element,organ_list(i_org),stoich_growth_min) - deficit_p(i_org) = max(0.0_r8, target_p - state_p(i_org)%ptr ) -! else -! deficit_n(i_org) = 0._r8 -! deficit_p(i_org) = 0._r8 -! end if + ! Update the phosphorus deficits (which are based off of carbon actual..) + ! Note that the phsophorus target is tied to the stoichiometry of thegrowing pool only (also) + target_p = this%GetNutrientTarget(phosphorus_element,organ_list(i_org),stoich_growth_min) + deficit_p(i_org) = max(0.0_r8, target_p - state_p(i_org)%ptr ) + end do - ! Allocate nutrients at this priority level - ! Nitrogen + ! Allocate nutrients at this priority level Nitrogen call ProportionalNutrAllocation(state_n, deficit_n, & n_gain, nitrogen_element, curpri_org(1:n_curpri_org)) @@ -1159,8 +1138,6 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & real(r8) :: sum_c_flux ! Sum of the carbon allocated, as reported ! by the ODE solver. [kg] real(r8) :: np_limit - real(r8) :: n_stf ! nitrogen storage target fraction (stf) [-] - real(r8) :: p_stf ! phosphorus storage target fraction (stf) [-] real(r8) :: n_match real(r8) :: p_match real(r8) :: c_flux_adj ! Adjustment to total carbon flux during stature growth @@ -1239,12 +1216,6 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & ! signaled a drop. If this is the case, we can't grow stature ! cause that would force the leaves back on, so just leave. - - target_n = this%GetNutrientTarget(nitrogen_element,store_organ,stoich_growth_min) - n_stf = max(state_n(store_id)%ptr/target_n,0._r8) - - target_p = this%GetNutrientTarget(phosphorus_element,store_organ,stoich_growth_min) - p_stf = max(state_p(store_id)%ptr/target_p,0._r8) if( c_gain <= calloc_abs_error .or. & leaf_status.eq.leaves_off .or. & @@ -1688,6 +1659,17 @@ subroutine CNPAllocateRemainder(this,c_gain, n_gain, p_gain, & if(c_gain>calloc_abs_error) then +! select(c_overlow_method) +! case(store_c_overflow) + +! case(efflux_c_overflow) + +! case(burn_c_overflow) + +! end if + + + if(force_store_c_overflow)then total_c_flux = c_gain @@ -1768,7 +1750,6 @@ function GetDeficit(this,element_id,organ_id,target_m) result(deficit_m) return end function GetDeficit - ! ===================================================================================== @@ -1833,7 +1814,7 @@ function GetNutrientTargetCNP(this,element_id,organ_id,stoich_mode) result(targe ! Hard-code the growth minimum storage stoichiometry to 75% of maximum if( stoich_mode == stoich_growth_min ) then - target_m = target_m*0.75_r8 + target_m = target_m*0.25_r8 end if elseif(organ_id == repro_organ) then @@ -2219,18 +2200,25 @@ subroutine StorageRegulator(this,element_id,regulate_type,c_scalar) integer :: icode ! real variable checking code real(r8) :: store_x integer :: i_var - real(r8) :: c_eq_offset ! This shifts the center-point - ! of the N:C or P:C storage equlibrium - ! by multiplying the C term. If its less than 1 it - ! shifts left and great than one it shifts right. - ! It should shift left to help mitigate wasted N and P - ! storage overflow + real(r8), parameter :: c_eq_offset = 0.95 ! This shifts the center-point + ! of the N:C or P:C storage equlibrium + ! by multiplying the C term. If its less than 1 it + ! shifts left and great than one it shifts right. + ! It should shift left to help mitigate wasted N and P + ! storage overflow ! For N/C logistic real(r8) :: logi_k ! logistic function k real(r8) :: store_x0 ! storage fraction inflection point real(r8) :: logi_min ! minimum cn_scalar for logistic - + real(r8) :: l2fr_delta_max + real(r8) :: l2fr_delta_min + real(r8) :: l2fr_actual + real(r8) :: leaf_c_target + real(r8) :: log_nc_frac + real(r8) :: store_c_frac + real(r8) :: c_gain + real(r8) :: target_fnrt_c ! This is the storage fraction where downregulation starts if using ! a linear function @@ -2239,19 +2227,26 @@ subroutine StorageRegulator(this,element_id,regulate_type,c_scalar) real(r8), parameter :: c_max = 1.0_r8 ! Maximum allowable result of the function real(r8), parameter :: c_min = 0.0_r8 ! Minimum allowable result of the function + ! This fraction governs + ! how much carbon from daily gains + storage overflow, is allowed to + ! be spent on growing out roots. This inludes getting roots + ! back on allometry before growing out + + real(r8), parameter :: max_l2fr_cgain_frac = 0.5_r8 + associate(dbh => this%bc_inout(acnp_bc_inout_id_dbh)%rval, & canopy_trim => this%bc_in(acnp_bc_in_id_ctrim)%rval, & - ipft => this%bc_in(acnp_bc_in_id_pft)%ival) + ipft => this%bc_in(acnp_bc_in_id_pft)%ival, & + l2fr => this%bc_inout(acnp_bc_inout_id_l2fr)%rval, & + l2fr_ema => this%bc_in(acnp_bc_in_id_l2fr_ema)%rval) - store_max = this%GetNutrientTarget(element_id,store_organ,stoich_growth_min) + + store_max = this%GetNutrientTarget(element_id,store_organ,stoich_max) ! Storage fractions could more than the target, depending on the ! hypothesis and functions involved, but should typically be 0-1 ! The cap of 2 is for numerics and preventing weird math - store_frac = min(2.0_r8,this%GetState(store_organ, element_id)/store_max) - - i_var = prt_global%sp_organ_map(store_organ,element_id ) - store_x = sum(this%variables(i_var)%val(:)) + store_frac = max(0.01_r8,min(1.0_r8,this%GetState(store_organ, element_id)/store_max)) if(regulate_type == regulate_linear) then @@ -2278,24 +2273,84 @@ subroutine StorageRegulator(this,element_id,regulate_type,c_scalar) ! call endrun(msg=errMsg(sourcefile, __LINE__)) !endif - elseif(regulate_type == regulate_CN_logi) then - + elseif(regulate_type == regulate_CN_logi .or. regulate_type == regulate_CN_ema) then + logi_k = 2.0_r8 store_x0 = 0.0_r8 logi_min = 0.0_r8 - - store_c = this%GetState(store_organ, carbon12_element) - call bstore_allom(dbh,ipft,canopy_trim,store_c_max) - - ! Fraction of N per fraction of C - ! If this is greater than 1, then we have more N in storage than - ! we have C, so we downregulate. If this is less than 1, then - ! we have less N in storage than we have C, so up-regulate - - store_frac = log(max(0.01_r8,store_frac) / max(0.01_r8,(store_c/store_c_max))) - c_scalar = max(0._r8,min(1._r8,logi_min + (1._r8-logi_min)/(1.0 + exp(logi_k*(store_frac-store_x0))))) + ! Only update L2FR if some leaves are out + call bleaf(dbh,ipft,canopy_trim,leaf_c_target) + if(this%GetState(leaf_organ, carbon12_element)/leaf_c_target>0.01_r8) then + store_max = this%GetNutrientTarget(element_id,store_organ,stoich_max) + + ! Storage fractions could be more than the target, depending on the + ! hypothesis and functions involved, but should typically be 0-1 + ! The cap of 2 is for numerics and preventing weird math + + store_frac = max(0.01_r8,min(2.0_r8,this%GetState(store_organ, element_id)/store_max)) + + + call bstore_allom(dbh,ipft,canopy_trim,store_c_max) + + ! Since we don't dump storage carbon + ! these stores can actually get pretty large, so the cap of 10x is numerically + ! feasable, and should also minimize stress on the logistic function + store_c_frac = max(0.01_r8,min(10.0_r8,c_eq_offset*(this%GetState(store_organ, carbon12_element)/store_c_max))) + + + ! ----------------------------------------------------------------------------- + ! To decide the upper limit on expanding root growth, we perform a carbon + ! balance. Note that if we are growing roots out more, than we have proportionaly + ! more C compared to other resources. Specifically, we want to limit root growth + ! such that allocation to roots can't exceed a certain fraction of the daily + ! available carbon. This fraction is "max_l2fr_cgain_frac". + ! Additional notes. When calculating the "allocation to roots", we consider + ! both the carbon necessary to get the roots "on allometry" plux the carbon + ! necessary to expand them. + ! + ! (l2fr_delta_max*target_fnrt_c + target_fnrt_c-actual_fnrt_c )/c_gain + ! < max_l2fr_cgain_frac + ! + ! ------------------------------------------------------------------------------ + + call bfineroot(dbh,ipft,canopy_trim, l2fr, target_fnrt_c) + + ! If there is overflow storage, add this to the gain + c_gain = this%bc_in(acnp_bc_in_id_netdc)%rval + & + max(0._r8,this%GetState(store_organ, carbon12_element)-store_c_max) + + l2fr_delta_max = max(0._r8, & + c_gain*max_l2fr_cgain_frac - & + target_fnrt_c-this%GetState(fnrt_organ, carbon12_element))/target_fnrt_c + + ! Since we use l2fr_ema as the basis, we need to transform this + ! l2fr_actual*(1+l2fr_delta_max) = l2fr_ema*(1+l2fr_delta_eff) + + l2fr_actual = this%GetState(fnrt_organ, carbon12_element) / & + this%GetState(leaf_organ, carbon12_element) + ! RE + !l2fr_delta_max = l2fr_actual*(1+l2fr_delta_max)/l2fr_ema - 1.0_r8 + l2fr_delta_min = (years_per_day / prt_params%root_long(ipft)) + + log_nc_frac = log( store_frac / store_c_frac ) + + ! This is a logistic between -1 and 1 + c_scalar = 2._r8*max(0._r8, & + min(1._r8,logi_min + (1._r8-logi_min)/(1._r8 + exp(logi_k*(log_nc_frac-store_x0)))))-1.0_r8 + + if(c_scalar>0.0_r8)then + c_scalar = 1._r8+c_scalar*l2fr_delta_max + else + c_scalar = 1._r8+c_scalar*l2fr_delta_min + end if + + else + c_scalar = 1._r8 + end if + + elseif(regulate_type == regulate_CN_dfdd) then store_c = this%GetState(store_organ, carbon12_element) @@ -2306,14 +2361,7 @@ subroutine StorageRegulator(this,element_id,regulate_type,c_scalar) ! we have C, so we downregulate. If this is less than 1, then ! we have less N in storage than we have C, so up-regulate - ! Note also, we do not allow the plants to dump C - ! but we do allow them to exude either P or N. Because of this - ! we shift our equilibrium point from a ratio of 1:1 to something - ! with a slightly lower C fraction equilibrium (ie > 1) - ! This will reduce N and P uptake inefficiencies by reducing - ! storage overflow and dumping. - - c_eq_offset = 0.75 + store_frac = max(0.01_r8,store_frac) / max(0.01_r8,c_eq_offset*(store_c/store_c_max)) diff --git a/parteh/PRTLossFluxesMod.F90 b/parteh/PRTLossFluxesMod.F90 index 13b09b2e37..b95e074f2d 100644 --- a/parteh/PRTLossFluxesMod.F90 +++ b/parteh/PRTLossFluxesMod.F90 @@ -538,7 +538,7 @@ subroutine DeciduousTurnoverSimpleRetranslocation(prt,ipft,organ_id,mass_fractio ! Loop over all of the coordinate ids do i_pos = 1, prt_global%state_descriptor(i_var)%num_pos - ! The mass that is leaving the plant + ! The mass that is leaving the plant turnover_mass = (1.0_r8 - retrans) * mass_fraction * prt%variables(i_var)%val(i_pos) ! The mass that is going towards storage From 12f824dd00186a84d4399f62a6de681a7e5ab40e Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 24 Feb 2022 11:46:08 -0500 Subject: [PATCH 16/55] Incremental changes towards fine-root biomass adaptation to N:C and P:C storage fractions --- biogeochem/EDCanopyStructureMod.F90 | 12 ++--- biogeochem/EDCohortDynamicsMod.F90 | 14 ++--- biogeochem/EDPatchDynamicsMod.F90 | 4 +- main/EDMainMod.F90 | 2 +- main/EDTypesMod.F90 | 2 +- main/FatesHistoryInterfaceMod.F90 | 18 +++---- parteh/PRTAllometricCNPMod.F90 | 81 ++++++++++++++++++----------- 7 files changed, 78 insertions(+), 55 deletions(-) diff --git a/biogeochem/EDCanopyStructureMod.F90 b/biogeochem/EDCanopyStructureMod.F90 index e2db556bdb..2d3dc30e97 100644 --- a/biogeochem/EDCanopyStructureMod.F90 +++ b/biogeochem/EDCanopyStructureMod.F90 @@ -662,10 +662,10 @@ subroutine DemoteFromLayer(currentSite,currentPatch,i_lyr,bc_in) ! (keep as an example) ! Initialize running means !allocate(copyc%tveg_lpa) - allocate(copyc%l2fr_ema) - ! Note, no need to give a starter value here, - ! that will be taken care of in copy_cohort() - call copyc%l2fr_ema%InitRMean(ema_60day) + !!allocate(copyc%l2fr_ema) + ! Note, no need to give a starter value here, + ! that will be taken care of in copy_cohort() + !!call copyc%l2fr_ema%InitRMean(ema_60day) ! Initialize the PARTEH object and point to the ! correct boundary condition fields @@ -1121,10 +1121,10 @@ subroutine PromoteIntoLayer(currentSite,currentPatch,i_lyr) allocate(copyc) - allocate(copyc%l2fr_ema) + !!allocate(copyc%l2fr_ema) ! Note, no need to give a starter value here, ! that will be taken care of in copy_cohort() - call copyc%l2fr_ema%InitRMean(ema_60day) + !!call copyc%l2fr_ema%InitRMean(ema_60day) ! Initialize the PARTEH object and point to the ! correct boundary condition fields diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index 7fe667ed33..a0df486966 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -94,7 +94,7 @@ module EDCohortDynamicsMod use PRTAllometricCNPMod, only : cnp_allom_prt_vartypes use PRTAllometricCNPMod, only : acnp_bc_in_id_pft, acnp_bc_in_id_ctrim use PRTAllometricCNPMod, only : acnp_bc_in_id_lstat, acnp_bc_inout_id_dbh - use PRTAllometricCNPMod, only : acnp_bc_in_id_l2fr_ema + !use PRTAllometricCNPMod, only : acnp_bc_in_id_l2fr_ema use PRTAllometricCNPMod, only : acnp_bc_inout_id_l2fr use PRTAllometricCNPMod, only : acnp_bc_inout_id_rmaint_def, acnp_bc_in_id_netdc use PRTAllometricCNPMod, only : acnp_bc_in_id_netdnh4, acnp_bc_in_id_netdno3, acnp_bc_in_id_netdp @@ -324,8 +324,8 @@ subroutine create_cohort(currentSite, patchptr, pft, nn, hite, coage, dbh, & !! allocate(new_cohort%tveg_lpa) !! call new_cohort%tveg_lpa%InitRMean(ema_lpa,init_value=patchptr%tveg_lpa%GetMean()) - allocate(new_cohort%l2fr_ema) - call new_cohort%l2fr_ema%InitRMean(ema_60day,init_value=new_cohort%l2fr,init_offset=fnrt_adapt_tscl*sec_per_day) + !!allocate(new_cohort%l2fr_ema) + !!call new_cohort%l2fr_ema%InitRMean(ema_60day,init_value=new_cohort%l2fr,init_offset=fnrt_adapt_tscl*sec_per_day) call InitPRTBoundaryConditions(new_cohort) @@ -431,7 +431,7 @@ subroutine InitPRTBoundaryConditions(new_cohort) call new_cohort%prt%RegisterBCIn(acnp_bc_in_id_netdnh4, bc_rval = new_cohort%daily_nh4_uptake) call new_cohort%prt%RegisterBCIn(acnp_bc_in_id_netdno3, bc_rval = new_cohort%daily_no3_uptake) call new_cohort%prt%RegisterBCIn(acnp_bc_in_id_netdp, bc_rval = new_cohort%daily_p_uptake) - call new_cohort%prt%RegisterBCIn(acnp_bc_in_id_l2fr_ema, bc_rval = new_cohort%l2fr_ema%l_mean) + !!call new_cohort%prt%RegisterBCIn(acnp_bc_in_id_l2fr_ema, bc_rval = new_cohort%l2fr_ema%l_mean) call new_cohort%prt%RegisterBCInOut(acnp_bc_inout_id_dbh,bc_rval = new_cohort%dbh) call new_cohort%prt%RegisterBCInOut(acnp_bc_inout_id_rmaint_def,bc_rval = new_cohort%resp_m_def) @@ -1017,7 +1017,7 @@ subroutine DeallocateCohort(currentCohort) ! (Keeping as an example) ! Remove the running mean structure ! deallocate(currentCohort%tveg_lpa) - deallocate(currentCohort%l2fr_ema) + !!deallocate(currentCohort%l2fr_ema) ! At this point, nothing should be pointing to current Cohort if (hlm_use_planthydro.eq.itrue) call DeallocateHydrCohort(currentCohort) @@ -1187,7 +1187,7 @@ subroutine fuse_cohorts(currentSite, currentPatch, bc_in) ! like other variables !!call currentCohort%tveg_lpa%FuseRMean(nextc%tveg_lpa,currentCohort%n/newn) - call currentCohort%l2fr_ema%FuseRMean(nextc%l2fr_ema,currentCohort%n/newn) + !!call currentCohort%l2fr_ema%FuseRMean(nextc%l2fr_ema,currentCohort%n/newn) ! new cohort age is weighted mean of two cohorts currentCohort%coage = & @@ -1832,7 +1832,7 @@ subroutine copy_cohort( currentCohort,copyc ) ! (Keeping as an example) ! Copy over running means ! call n%tveg_lpa%CopyFromDonor(o%tveg_lpa) - call n%l2fr_ema%CopyFromDonor(o%l2fr_ema) + !!call n%l2fr_ema%CopyFromDonor(o%l2fr_ema) ! CARBON FLUXES n%gpp_acc_hold = o%gpp_acc_hold diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 17f72aff8f..4fee51a877 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -698,10 +698,10 @@ subroutine spawn_patches( currentSite, bc_in) allocate(nc) if(hlm_use_planthydro.eq.itrue) call InitHydrCohort(CurrentSite,nc) - allocate(nc%l2fr_ema) + !!allocate(nc%l2fr_ema) ! Note, no need to give a starter value here, ! that will be taken care of in copy_cohort() - call nc%l2fr_ema%InitRMean(ema_60day) + !!call nc%l2fr_ema%InitRMean(ema_60day) ! Initialize the PARTEH object and point to the ! correct boundary condition fields diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index 3399c1122f..aeec0c7974 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -455,7 +455,7 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) actual_l2fr = max(0.05_r8,min(10._r8,actual_l2fr)) - call currentCohort%l2fr_ema%UpdateRMean(actual_l2fr) + !!call currentCohort%l2fr_ema%UpdateRMean(actual_l2fr) end if call currentCohort%prt%DailyPRT() diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 041626447c..dc9753f9c3 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -222,7 +222,7 @@ module EDTypesMod ! nutrient storage) - class(rmean_type), pointer :: l2fr_ema ! Exponential moving average of the L2FR + !!class(rmean_type), pointer :: l2fr_ema ! Exponential moving average of the L2FR ! VEGETATION STRUCTURE integer :: pft ! pft number diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 34fa749dbb..07359802c0 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -184,7 +184,7 @@ module FatesHistoryInterfaceMod integer :: ih_totvegp_si integer :: ih_l2fr_si - integer :: ih_l2fr_ema_si + !!integer :: ih_l2fr_ema_si integer :: ih_l2fr_scpf integer :: ih_l2fr_canopy_scpf integer :: ih_l2fr_understory_scpf @@ -1858,7 +1858,7 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) hio_ncohorts_si => this%hvars(ih_ncohorts_si)%r81d, & hio_trimming_si => this%hvars(ih_trimming_si)%r81d, & hio_l2fr_si => this%hvars(ih_l2fr_si)%r81d, & - hio_l2fr_ema_si => this%hvars(ih_l2fr_ema_si)%r81d, & + !!hio_l2fr_ema_si => this%hvars(ih_l2fr_ema_si)%r81d, & hio_l2fr_scpf => this%hvars(ih_l2fr_scpf)%r82d, & hio_l2fr_canopy_scpf => this%hvars(ih_l2fr_canopy_scpf)%r82d, & hio_l2fr_understory_scpf => this%hvars(ih_l2fr_understory_scpf)%r82d, & @@ -2404,7 +2404,7 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) hio_l2fr_si(io_si) = hio_l2fr_si(io_si) + ccohort%n*fnrt_m/m2_per_ha*ccohort%l2fr - hio_l2fr_ema_si(io_si) = hio_l2fr_ema_si(io_si) + ccohort%n*fnrt_m/m2_per_ha*ccohort%l2fr_ema%GetMean() + !!hio_l2fr_ema_si(io_si) = hio_l2fr_ema_si(io_si) + ccohort%n*fnrt_m/m2_per_ha*ccohort%l2fr_ema%GetMean() hio_l2fr_scpf(io_si,i_scpf) = & hio_l2fr_scpf(io_si,i_scpf) + ccohort%n*fnrt_m/m2_per_ha*ccohort%l2fr @@ -3050,7 +3050,7 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) ! Normalize the l2fr value by total biomass hio_l2fr_si(io_si) = hio_l2fr_si(io_si)/this%hvars(ih_fnrtc_si)%r81d(io_si) - hio_l2fr_ema_si(io_si) = hio_l2fr_ema_si(io_si)/this%hvars(ih_fnrtc_si)%r81d(io_si) + !!hio_l2fr_ema_si(io_si) = hio_l2fr_ema_si(io_si)/this%hvars(ih_fnrtc_si)%r81d(io_si) ! divide so-far-just-summed but to-be-averaged patch-age-class variables by patch-age-class area to get mean values @@ -4516,11 +4516,11 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=site_r8, hlms='CLM:ALM', upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_l2fr_si) - call this%set_history_var(vname='FATES_L2FR_EMA', units='kg kg-1', & - long='Moving average of the leaf to fineroot biomass multiplier for target allometry', & - use_default='active', & - avgflag='A', vtype=site_r8, hlms='CLM:ALM', upfreq=1, & - ivar=ivar, initialize=initialize_variables, index = ih_l2fr_ema_si) + !!call this%set_history_var(vname='FATES_L2FR_EMA', units='kg kg-1', & + !! long='Moving average of the leaf to fineroot biomass multiplier for target allometry', & + !! use_default='active', & + !! avgflag='A', vtype=site_r8, hlms='CLM:ALM', upfreq=1, & + !! ivar=ivar, initialize=initialize_variables, index = ih_l2fr_ema_si) call this%set_history_var(vname='FATES_L2FR_SZPF', units='kg kg-1', & diff --git a/parteh/PRTAllometricCNPMod.F90 b/parteh/PRTAllometricCNPMod.F90 index 75aac5c285..2e79fe93b6 100644 --- a/parteh/PRTAllometricCNPMod.F90 +++ b/parteh/PRTAllometricCNPMod.F90 @@ -153,10 +153,12 @@ module PRTAllometricCNPMod integer, public, parameter :: acnp_bc_in_id_netdnh4 = 5 ! Index for the net daily NH4 input BC integer, public, parameter :: acnp_bc_in_id_netdno3 = 6 ! Index for the net daily NO3 input BC integer, public, parameter :: acnp_bc_in_id_netdp = 7 ! Index for the net daily P input BC - integer, public, parameter :: acnp_bc_in_id_l2fr_ema = 8 ! Index for the moving average ema + !integer, public, parameter :: acnp_bc_in_id_l2fr_ema = 7 ! Index for the moving average ema + !integer, public, parameter :: acnp_bc_in_id_ncs_ema = 9 ! Index for N/C storage ratio (EMA) + !integer, public, parameter :: acnp_bc_in_id_pcs_ema = 10 ! Index for P/C storage ratio (EMA) ! 0=leaf off, 1=leaf on - integer, parameter :: num_bc_in = 8 + integer, parameter :: num_bc_in = 7 ! ------------------------------------------------------------------------------------- ! Output Boundary Indices (These are public) @@ -166,7 +168,7 @@ module PRTAllometricCNPMod integer, public, parameter :: acnp_bc_out_id_nefflux = 2 ! Daily exudation of N [kg] integer, public, parameter :: acnp_bc_out_id_pefflux = 3 ! Daily exudation of P [kg] - integer, parameter :: num_bc_out = 5 ! Total number of + integer, parameter :: num_bc_out = 3 ! Total number of ! Indices for parameters passed to the integrator @@ -207,9 +209,12 @@ module PRTAllometricCNPMod integer, parameter :: regulate_CN_ema = 5 - !real(r8), public, parameter :: fnrt_adapt_tscl = 365._r8 ! Fine-root adaptation timescale (days) - - real(r8), public, parameter :: fnrt_adapt_tscl = 30._r8 ! Fine-root adaptation timescale (days) + real(r8), public, parameter :: fnrt_adapt_tscl = 100._r8 ! Fine-root adaptation timescale (days) + ! or, how many days it takes + ! for a doubling or halving of the l2fr + + + ! Array of pointers are difficult in F90 ! This structure is a necessary intermediate @@ -353,7 +358,7 @@ subroutine DailyPRTAllometricCNP(this) real(r8) :: n_gain ! Daily nitrogen uptake through fine-roots [kgN] real(r8) :: p_gain ! Daily phosphorus uptake through fine-roots [kgN] real(r8) :: canopy_trim ! The canopy trimming function [0-1] - real(r8) :: l2fr_ema ! Mean (EMA) l2fr + !real(r8) :: l2fr_ema ! Mean (EMA) l2fr ! Pointers to output bcs real(r8),pointer :: c_efflux ! Total plant efflux of carbon (kgC) @@ -650,7 +655,7 @@ subroutine CNPAdjustFRootTargets(this) integer :: ipft ! PFT index real(r8), pointer :: dbh real(r8) :: canopy_trim - real(r8) :: l2fr_ema ! Moving average L2FR (EMA) + !!real(r8) :: l2fr_ema ! Moving average L2FR (EMA) real(r8) :: l2fr_actual real(r8) :: fnrt_c_target ! Target fineroot C before we change l2fr @@ -673,7 +678,7 @@ subroutine CNPAdjustFRootTargets(this) l2fr => this%bc_inout(acnp_bc_inout_id_l2fr)%rval dbh => this%bc_inout(acnp_bc_inout_id_dbh)%rval canopy_trim = this%bc_in(acnp_bc_in_id_ctrim)%rval - l2fr_ema = this%bc_in(acnp_bc_in_id_l2fr_ema)%rval + !!l2fr_ema = this%bc_in(acnp_bc_in_id_l2fr_ema)%rval associate( l2fr_min => prt_params%allom_l2fr_min(ipft), & l2fr_max => prt_params%allom_l2fr_max(ipft)) @@ -703,9 +708,7 @@ subroutine CNPAdjustFRootTargets(this) ! Only update L2FR if some leaves are out call bleaf(dbh,ipft,canopy_trim,leaf_c_target) if(this%GetState(leaf_organ, carbon12_element)/leaf_c_target>0.5_r8) then - l2fr = l2fr_ema * np_regulator - !l2fr = l2fr_actual * np_regulator - !l2fr = l2fr * np_regulator + l2fr = l2fr * np_regulator end if @@ -2214,11 +2217,12 @@ subroutine StorageRegulator(this,element_id,regulate_type,c_scalar) real(r8) :: l2fr_delta_max real(r8) :: l2fr_delta_min real(r8) :: l2fr_actual + real(r8) :: leaf_c, fnrt_c real(r8) :: leaf_c_target real(r8) :: log_nc_frac real(r8) :: store_c_frac real(r8) :: c_gain - real(r8) :: target_fnrt_c + real(r8) :: fnrt_c_target ! This is the storage fraction where downregulation starts if using ! a linear function @@ -2237,10 +2241,8 @@ subroutine StorageRegulator(this,element_id,regulate_type,c_scalar) associate(dbh => this%bc_inout(acnp_bc_inout_id_dbh)%rval, & canopy_trim => this%bc_in(acnp_bc_in_id_ctrim)%rval, & ipft => this%bc_in(acnp_bc_in_id_pft)%ival, & - l2fr => this%bc_inout(acnp_bc_inout_id_l2fr)%rval, & - l2fr_ema => this%bc_in(acnp_bc_in_id_l2fr_ema)%rval) - - + l2fr => this%bc_inout(acnp_bc_inout_id_l2fr)%rval) + store_max = this%GetNutrientTarget(element_id,store_organ,stoich_max) ! Storage fractions could more than the target, depending on the @@ -2275,7 +2277,7 @@ subroutine StorageRegulator(this,element_id,regulate_type,c_scalar) elseif(regulate_type == regulate_CN_logi .or. regulate_type == regulate_CN_ema) then - logi_k = 2.0_r8 + logi_k = 1.0_r8 store_x0 = 0.0_r8 logi_min = 0.0_r8 @@ -2312,27 +2314,48 @@ subroutine StorageRegulator(this,element_id,regulate_type,c_scalar) ! (l2fr_delta_max*target_fnrt_c + target_fnrt_c-actual_fnrt_c )/c_gain ! < max_l2fr_cgain_frac ! + ! or + ! + ! l2fr_delta_max*target_fnrt_c < max_l2fr_cgain_frac * (c_gain - + ! (target_fnrt_c-actual_fnrt_c) - + ! (target_leaf_c-actual_leaf_c)) + ! ! ------------------------------------------------------------------------------ - call bfineroot(dbh,ipft,canopy_trim, l2fr, target_fnrt_c) + call bfineroot(dbh,ipft,canopy_trim, l2fr, fnrt_c_target) + call bleaf(dbh,ipft,canopy_trim,leaf_c_target) ! If there is overflow storage, add this to the gain c_gain = this%bc_in(acnp_bc_in_id_netdc)%rval + & max(0._r8,this%GetState(store_organ, carbon12_element)-store_c_max) + + fnrt_c = this%GetState(fnrt_organ, carbon12_element) + leaf_c = this%GetState(leaf_organ, carbon12_element) + + l2fr_delta_max = max_l2fr_cgain_frac / fnrt_c_target * & + (c_gain - (fnrt_c_target-fnrt_c) - (leaf_c_target-leaf_c)) + + ! This value could be negative if there is no gain, or less gain + ! than what can replace leaf/root, just ensure the multiplier is GT 1 - l2fr_delta_max = max(0._r8, & - c_gain*max_l2fr_cgain_frac - & - target_fnrt_c-this%GetState(fnrt_organ, carbon12_element))/target_fnrt_c + l2fr_delta_max = max(1._r8,l2fr_delta_max) + + + ! Second constraint, folding timescale + ! 2.0 = l2fr_delta_max^frnt_adapt_tscl + l2fr_delta_max = min(l2fr_delta_max, 2._r8**(1._r8/fnrt_adapt_tscl)) - ! Since we use l2fr_ema as the basis, we need to transform this - ! l2fr_actual*(1+l2fr_delta_max) = l2fr_ema*(1+l2fr_delta_eff) l2fr_actual = this%GetState(fnrt_organ, carbon12_element) / & this%GetState(leaf_organ, carbon12_element) - ! RE - !l2fr_delta_max = l2fr_actual*(1+l2fr_delta_max)/l2fr_ema - 1.0_r8 - l2fr_delta_min = (years_per_day / prt_params%root_long(ipft)) + ! Constrain change in l2fr minimum to be no more than what is lost + ! in turnover for a day + l2fr_delta_min = 1._r8-(years_per_day / prt_params%root_long(ipft)) + + ! Second constraint, folding timescale + l2fr_delta_min = max(l2fr_delta_min, 0.5_r8**(1._r8/fnrt_adapt_tscl)) + log_nc_frac = log( store_frac / store_c_frac ) @@ -2341,9 +2364,9 @@ subroutine StorageRegulator(this,element_id,regulate_type,c_scalar) min(1._r8,logi_min + (1._r8-logi_min)/(1._r8 + exp(logi_k*(log_nc_frac-store_x0)))))-1.0_r8 if(c_scalar>0.0_r8)then - c_scalar = 1._r8+c_scalar*l2fr_delta_max + c_scalar = 1._r8 + c_scalar*(l2fr_delta_max-1._r8) else - c_scalar = 1._r8+c_scalar*l2fr_delta_min + c_scalar = 1._r8 + c_scalar*(1._r8-l2fr_delta_min) end if else From d017a3108ddafdf432bd24de2f4ee297c024d055 Mon Sep 17 00:00:00 2001 From: ckoven Date: Fri, 29 Oct 2021 17:09:33 -0600 Subject: [PATCH 17/55] merging in Charlies sym fix code --- biogeophys/FatesPlantRespPhotosynthMod.F90 | 44 +++++++++++++++++----- main/EDTypesMod.F90 | 4 +- 2 files changed, 37 insertions(+), 11 deletions(-) diff --git a/biogeophys/FatesPlantRespPhotosynthMod.F90 b/biogeophys/FatesPlantRespPhotosynthMod.F90 index adffe67d85..5a0c55183b 100644 --- a/biogeophys/FatesPlantRespPhotosynthMod.F90 +++ b/biogeophys/FatesPlantRespPhotosynthMod.F90 @@ -237,6 +237,9 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) real(r8) :: lai_current ! the LAI in the current leaf layer real(r8) :: cumulative_lai ! the cumulative LAI, top down, to the leaf layer of interest real(r8) :: leaf_psi ! leaf xylem matric potential [MPa] (only meaningful/used w/ hydro) + real(r8) :: fnrt_mr_layer ! fine root maintenance respiation per layer [kgC/plant/s] + real(r8) :: c_cost_nfix ! carbon cost of N fixation [kgC/kgN] + real(r8), allocatable :: rootfr_ft(:,:) ! Root fractions per depth and PFT ! ----------------------------------------------------------------------------------- @@ -263,6 +266,11 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) ! (gC/gN/s) ! ------------------------------------------------------------------------ + ! N fixation parameters from Houlton et al (2008) and Fisher et al (2010) + real(r8), parameter :: s_fix = -6.25_r8 ! s parameter from FUN model (fisher et al 2010) + real(r8), parameter :: a_fix = -3.62_r8 ! a parameter from Houlton et al. 2010 (a = -3.62 +/- 0.52) + real(r8), parameter :: b_fix = 0.27_r8 ! b parameter from Houlton et al. 2010 (b = 0.27 +/-0.04) + real(r8), parameter :: c_fix = 25.15_r8 ! c parameter from Houlton et al. 2010 (c = 25.15 +/- 0.66) ! ----------------------------------------------------------------------------------- ! Photosynthesis and stomatal conductance parameters, from: ! Bonan et al (2011) JGR, 116, doi:10.1029/2010JG001593 @@ -695,12 +703,28 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) ! Fine Root MR (kgC/plant/s) + ! and calculate the N fixation rate as a function of the fixation-specific root respiration + ! for now use dev_arbitrary_pft as scaling term between 0 and 1 as additional increment of root respiration used for N fixation ! ------------------------------------------------------------------ currentCohort%froot_mr = 0._r8 + + ! n_fixation is integrated over the course of the day + currentCohort%n_fixation = 0._r8 + do j = 1,bc_in(s)%nlevsoil tcsoi = q10_mr**((bc_in(s)%t_soisno_sl(j)-tfrz - 20.0_r8)/10.0_r8) - currentCohort%froot_mr = currentCohort%froot_mr + & - fnrt_n * ED_val_base_mr_20 * tcsoi * rootfr_ft(ft,j) * maintresp_reduction_factor + + fnrt_mr_layer = fnrt_n * ED_val_base_mr_20 * tcsoi * rootfr_ft(ft,j) * maintresp_reduction_factor + + currentCohort%froot_mr = currentCohort%froot_mr + fnrt_mr_layer * (1._r8 + EDPftvarcon_inst%dev_arbitrary_pft(ft)) + + ! calculate the cost of carbon for N fixation in each soil layer and calculate N fixation rate based on that [kgC / kgN] + + c_cost_nfix = s_fix * (exp(a_fix + b_fix * (bc_in(s)%t_soisno_sl(j)-tfrz) & + * (1._r8 - 0.5_r8 * (bc_in(s)%t_soisno_sl(j)-tfrz) / c_fix)) - 2._r8) + + currentCohort%n_fixation = currentCohort%n_fixation + fnrt_mr_layer * EDPftvarcon_inst%dev_arbitrary_pft / c_cost_nfix + enddo ! Coarse Root MR (kgC/plant/s) (below ground sapwood) @@ -1434,14 +1458,14 @@ subroutine ScaleLeafLayerFluxToCohort(nv, & ! in currentCohort%nv real(r8), intent(in) :: nplant ! indiv/m2 real(r8), intent(in) :: rb ! leaf boundary layer resistance (s/m) real(r8), intent(in) :: maintresp_reduction_factor ! factor by which to reduce maintenance respiration - real(r8), intent(out) :: g_sb_laweight ! Combined conductance (stomatal + boundary layer) for the cohort - ! weighted by leaf area [m/s]*[m2] - real(r8), intent(out) :: gpp ! GPP (kgC/indiv/s) - real(r8), intent(out) :: rdark ! Dark Leaf Respiration (kgC/indiv/s) - real(r8), intent(out) :: cohort_eleaf_area ! Effective leaf area of the cohort [m2] - real(r8), intent(out) :: c13disc_clm ! unpacked Cohort level c13 discrimination - real(r8) :: sum_weight ! sum of weight for unpacking d13c flux (c13disc_z) from - ! (canopy_layer, pft, leaf_layer) matrix to cohort (c13disc_clm) + real(r8), intent(out) :: g_sb_laweight ! Combined conductance (stomatal + boundary layer) for the cohort + ! weighted by leaf area [m/s]*[m2] + real(r8), intent(out) :: gpp ! GPP (kgC/indiv/s) + real(r8), intent(out) :: rdark ! Dark Leaf Respiration (kgC/indiv/s) + real(r8), intent(out) :: cohort_eleaf_area ! Effective leaf area of the cohort [m2] + real(r8), intent(out) :: c13disc_clm ! unpacked Cohort level c13 discrimination + real(r8) :: sum_weight ! sum of weight for unpacking d13c flux (c13disc_z) from + ! (canopy_layer, pft, leaf_layer) matrix to cohort (c13disc_clm) ! GPP IN THIS SUBROUTINE IS A RATE. THE CALLING ARGUMENT IS GPP_TSTEP. AFTER THIS ! CALL THE RATE WILL BE MULTIPLIED BY THE INTERVAL TO GIVE THE INTEGRATED QUANT. diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index dc9753f9c3..94a02d9672 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -311,7 +311,9 @@ module EDTypesMod real(r8) :: daily_n_demand ! The daily amount of N demanded by the plant [kgN/plant/day] real(r8) :: daily_p_demand ! The daily amount of P demanded by the plant [kgN/plant/day] - + ! N fixation rate + real(r8) :: n_fixation ! Rate of N fixation from the roots [kgN/indiv/s] + ! The following four biophysical rates are assumed to be ! at the canopy top, at reference temp 25C, and based on the ! leaf age weighted average of the PFT parameterized values. The last From c4422f1e0781b46ea31ee8c206b97fffb179b9d1 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Tue, 15 Mar 2022 12:17:40 -0400 Subject: [PATCH 18/55] various updates to the cnp acquisition algorithm, including symbiotic fixation --- biogeochem/EDCanopyStructureMod.F90 | 52 +- biogeochem/EDCohortDynamicsMod.F90 | 57 +- biogeochem/EDLoggingMortalityMod.F90 | 2 +- biogeochem/EDMortalityFunctionsMod.F90 | 5 +- biogeochem/EDPatchDynamicsMod.F90 | 17 +- biogeochem/EDPhysiologyMod.F90 | 13 +- biogeochem/FatesAllometryMod.F90 | 3 +- biogeochem/FatesSoilBGCFluxMod.F90 | 121 ++- biogeophys/FatesPlantRespPhotosynthMod.F90 | 39 +- fire/SFMainMod.F90 | 9 +- main/ChecksBalancesMod.F90 | 11 - main/EDInitMod.F90 | 3 - main/EDMainMod.F90 | 146 +-- main/EDPftvarcon.F90 | 21 +- main/EDTypesMod.F90 | 34 +- main/FatesHistoryInterfaceMod.F90 | 244 +++-- main/FatesRestartInterfaceMod.F90 | 92 +- parteh/PRTAllometricCNPMod.F90 | 1083 +++++++++----------- parteh/PRTGenericMod.F90 | 159 +-- 19 files changed, 979 insertions(+), 1132 deletions(-) diff --git a/biogeochem/EDCanopyStructureMod.F90 b/biogeochem/EDCanopyStructureMod.F90 index 2d3dc30e97..2e0ad6159e 100644 --- a/biogeochem/EDCanopyStructureMod.F90 +++ b/biogeochem/EDCanopyStructureMod.F90 @@ -19,7 +19,7 @@ module EDCanopyStructureMod use EDCohortDynamicsMod , only : InitPRTBoundaryConditions use EDCohortDynamicsMod , only : SendCohortToLitter use FatesAllometryMod , only : tree_lai - use FatesAllometryMod , only : tree_sai + use FatesAllometryMod , only : tree_sai,bstore_allom use EDtypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type use EDTypesMod , only : nclmax use EDTypesMod , only : nlevleaf @@ -34,7 +34,6 @@ module EDCanopyStructureMod use FatesPlantHydraulicsMod, only : UpdateH2OVeg,InitHydrCohort, RecruitWaterStorage use EDTypesMod , only : maxCohortsPerPatch use PRTGenericMod, only : leaf_organ - use PRTGenericMod, only : all_carbon_elements use PRTGenericMod, only : leaf_organ use PRTGenericMod, only : fnrt_organ use PRTGenericMod, only : sapw_organ @@ -42,6 +41,7 @@ module EDCanopyStructureMod use PRTGenericMod, only : repro_organ use PRTGenericMod, only : struct_organ use PRTGenericMod, only : SetState + use PRTGenericMod, only : carbon12_element use FatesRunningMeanMod, only : ema_lpa, ema_60day ! CIME Globals @@ -142,7 +142,7 @@ subroutine canopy_structure( currentSite , bc_in ) logical :: area_not_balanced ! logical controlling if the patch layer areas ! have successfully been redistributed integer :: return_code ! math checks on variables will return>0 if problems exist - + real(r8) :: target_storec ! We only iterate because of possible imprecisions generated by the cohort ! termination process. These should be super small, so at the most ! try to re-balance 3 times. If that doesn't give layer areas @@ -320,7 +320,7 @@ subroutine canopy_structure( currentSite , bc_in ) currentCohort => currentCohort%shorter enddo endif - + currentPatch => currentPatch%younger enddo !patch @@ -625,11 +625,11 @@ subroutine DemoteFromLayer(currentSite,currentPatch,i_lyr,bc_in) if(currentCohort%canopy_layer == i_lyr )then cc_loss = currentCohort%excl_weight - leaf_c = currentCohort%prt%GetState(leaf_organ,all_carbon_elements) - store_c = currentCohort%prt%GetState(store_organ,all_carbon_elements) - fnrt_c = currentCohort%prt%GetState(fnrt_organ,all_carbon_elements) - sapw_c = currentCohort%prt%GetState(sapw_organ,all_carbon_elements) - struct_c = currentCohort%prt%GetState(struct_organ,all_carbon_elements) + leaf_c = currentCohort%prt%GetState(leaf_organ,carbon12_element) + store_c = currentCohort%prt%GetState(store_organ,carbon12_element) + fnrt_c = currentCohort%prt%GetState(fnrt_organ,carbon12_element) + sapw_c = currentCohort%prt%GetState(sapw_organ,carbon12_element) + struct_c = currentCohort%prt%GetState(struct_organ,carbon12_element) if ( (cc_loss-currentCohort%c_area) > -nearzero .and. & (cc_loss-currentCohort%c_area) < area_target_precision ) then @@ -833,11 +833,11 @@ subroutine PromoteIntoLayer(currentSite,currentPatch,i_lyr) !look at the cohorts in the canopy layer below... if(currentCohort%canopy_layer == i_lyr+1)then - leaf_c = currentCohort%prt%GetState(leaf_organ,all_carbon_elements) - store_c = currentCohort%prt%GetState(store_organ,all_carbon_elements) - fnrt_c = currentCohort%prt%GetState(fnrt_organ,all_carbon_elements) - sapw_c = currentCohort%prt%GetState(sapw_organ,all_carbon_elements) - struct_c = currentCohort%prt%GetState(struct_organ,all_carbon_elements) + leaf_c = currentCohort%prt%GetState(leaf_organ,carbon12_element) + store_c = currentCohort%prt%GetState(store_organ,carbon12_element) + fnrt_c = currentCohort%prt%GetState(fnrt_organ,carbon12_element) + sapw_c = currentCohort%prt%GetState(sapw_organ,carbon12_element) + struct_c = currentCohort%prt%GetState(struct_organ,carbon12_element) currentCohort%canopy_layer = i_lyr call carea_allom(currentCohort%dbh,currentCohort%n,currentSite%spread, & @@ -1097,11 +1097,11 @@ subroutine PromoteIntoLayer(currentSite,currentPatch,i_lyr) if( (currentCohort%canopy_layer == i_lyr+1) ) then cc_gain = currentCohort%prom_weight - leaf_c = currentCohort%prt%GetState(leaf_organ,all_carbon_elements) - store_c = currentCohort%prt%GetState(store_organ,all_carbon_elements) - fnrt_c = currentCohort%prt%GetState(fnrt_organ,all_carbon_elements) - sapw_c = currentCohort%prt%GetState(sapw_organ,all_carbon_elements) - struct_c = currentCohort%prt%GetState(struct_organ,all_carbon_elements) + leaf_c = currentCohort%prt%GetState(leaf_organ,carbon12_element) + store_c = currentCohort%prt%GetState(store_organ,carbon12_element) + fnrt_c = currentCohort%prt%GetState(fnrt_organ,carbon12_element) + sapw_c = currentCohort%prt%GetState(sapw_organ,carbon12_element) + struct_c = currentCohort%prt%GetState(struct_organ,carbon12_element) if ( (cc_gain-currentCohort%c_area) > -nearzero .and. & (cc_gain-currentCohort%c_area) < area_target_precision ) then @@ -1333,11 +1333,11 @@ subroutine canopy_summarization( nsites, sites, bc_in ) ft = currentCohort%pft - leaf_c = currentCohort%prt%GetState(leaf_organ, all_carbon_elements) - sapw_c = currentCohort%prt%GetState(sapw_organ, all_carbon_elements) - struct_c = currentCohort%prt%GetState(struct_organ, all_carbon_elements) - fnrt_c = currentCohort%prt%GetState(fnrt_organ, all_carbon_elements) - store_c = currentCohort%prt%GetState(store_organ, all_carbon_elements) + leaf_c = currentCohort%prt%GetState(leaf_organ, carbon12_element) + sapw_c = currentCohort%prt%GetState(sapw_organ, carbon12_element) + struct_c = currentCohort%prt%GetState(struct_organ, carbon12_element) + fnrt_c = currentCohort%prt%GetState(fnrt_organ, carbon12_element) + store_c = currentCohort%prt%GetState(store_organ, carbon12_element) ! Update the cohort's index within the size bin classes ! Update the cohort's index within the SCPF classification system @@ -1561,7 +1561,7 @@ subroutine leaf_area_profile( currentSite ) ! Note that the canopy_layer_lai is also calculated in this loop ! but since we go top down in terms of plant size, we should be okay - leaf_c = currentCohort%prt%GetState(leaf_organ,all_carbon_elements) + leaf_c = currentCohort%prt%GetState(leaf_organ,carbon12_element) currentCohort%treelai = tree_lai(leaf_c, currentCohort%pft, currentCohort%c_area, & currentCohort%n, currentCohort%canopy_layer, & @@ -1990,7 +1990,7 @@ subroutine update_hlm_dynamics(nsites,sites,fcolumn,bc_out) call carea_allom(currentCohort%dbh,currentCohort%n,sites(s)%spread,& currentCohort%pft,currentCohort%c_area) - currentCohort%treelai = tree_lai(currentCohort%prt%GetState(leaf_organ, all_carbon_elements), & + currentCohort%treelai = tree_lai(currentCohort%prt%GetState(leaf_organ, carbon12_element), & currentCohort%pft, currentCohort%c_area, currentCohort%n, & currentCohort%canopy_layer, currentPatch%canopy_layer_tlai,currentCohort%vcmax25top ) diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index a0df486966..7c3fe61322 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -65,6 +65,7 @@ module EDCohortDynamicsMod use FatesAllometryMod , only : bagw_allom use FatesAllometryMod , only : bbgw_allom use FatesAllometryMod , only : bdead_allom + use FatesAllometryMod , only : bstore_allom use FatesAllometryMod , only : h_allom use FatesAllometryMod , only : carea_allom use FatesAllometryMod , only : ForceDBH @@ -73,7 +74,6 @@ module EDCohortDynamicsMod use PRTGenericMod, only : prt_carbon_allom_hyp use PRTGenericMod, only : prt_cnp_flex_allom_hyp use PRTGenericMod, only : prt_vartypes - use PRTGenericMod, only : all_carbon_elements use PRTGenericMod, only : carbon12_element use PRTGenericMod, only : nitrogen_element use PRTGenericMod, only : phosphorus_element @@ -96,8 +96,8 @@ module EDCohortDynamicsMod use PRTAllometricCNPMod, only : acnp_bc_in_id_lstat, acnp_bc_inout_id_dbh !use PRTAllometricCNPMod, only : acnp_bc_in_id_l2fr_ema use PRTAllometricCNPMod, only : acnp_bc_inout_id_l2fr - use PRTAllometricCNPMod, only : acnp_bc_inout_id_rmaint_def, acnp_bc_in_id_netdc - use PRTAllometricCNPMod, only : acnp_bc_in_id_netdnh4, acnp_bc_in_id_netdno3, acnp_bc_in_id_netdp + use PRTAllometricCNPMod, only : acnp_bc_inout_id_resp_excess, acnp_bc_in_id_netdc + use PRTAllometricCNPMod, only : acnp_bc_in_id_netdn, acnp_bc_in_id_netdp use PRTAllometricCNPMod, only : acnp_bc_out_id_cefflux, acnp_bc_out_id_nefflux use PRTAllometricCNPMod, only : acnp_bc_out_id_pefflux use PRTAllometricCNPMod, only : fnrt_adapt_tscl @@ -428,13 +428,12 @@ subroutine InitPRTBoundaryConditions(new_cohort) call new_cohort%prt%RegisterBCIn(acnp_bc_in_id_ctrim,bc_rval = new_cohort%canopy_trim) call new_cohort%prt%RegisterBCIn(acnp_bc_in_id_lstat,bc_ival = new_cohort%status_coh) call new_cohort%prt%RegisterBCIn(acnp_bc_in_id_netdc, bc_rval = new_cohort%npp_acc) - call new_cohort%prt%RegisterBCIn(acnp_bc_in_id_netdnh4, bc_rval = new_cohort%daily_nh4_uptake) - call new_cohort%prt%RegisterBCIn(acnp_bc_in_id_netdno3, bc_rval = new_cohort%daily_no3_uptake) + call new_cohort%prt%RegisterBCIn(acnp_bc_in_id_netdn, bc_rval = new_cohort%daily_n_gain) call new_cohort%prt%RegisterBCIn(acnp_bc_in_id_netdp, bc_rval = new_cohort%daily_p_uptake) !!call new_cohort%prt%RegisterBCIn(acnp_bc_in_id_l2fr_ema, bc_rval = new_cohort%l2fr_ema%l_mean) call new_cohort%prt%RegisterBCInOut(acnp_bc_inout_id_dbh,bc_rval = new_cohort%dbh) - call new_cohort%prt%RegisterBCInOut(acnp_bc_inout_id_rmaint_def,bc_rval = new_cohort%resp_m_def) + call new_cohort%prt%RegisterBCInOut(acnp_bc_inout_id_resp_excess,bc_rval = new_cohort%resp_excess) call new_cohort%prt%RegisterBCInOut(acnp_bc_inout_id_l2fr,bc_rval = new_cohort%l2fr) call new_cohort%prt%RegisterBCOut(acnp_bc_out_id_cefflux, bc_rval = new_cohort%daily_c_efflux) @@ -587,6 +586,8 @@ subroutine nan_cohort(cc_p) ! Fluxes from nutrient allocation currentCohort%daily_nh4_uptake = nan currentCohort%daily_no3_uptake = nan + currentCohort%daily_n_gain = nan + currentCohort%daily_n_fixation = nan currentCohort%daily_p_uptake = nan currentCohort%daily_c_efflux = nan currentCohort%daily_n_efflux = nan @@ -601,7 +602,7 @@ subroutine nan_cohort(cc_p) !RESPIRATION currentCohort%rdark = nan currentCohort%resp_m = nan ! Maintenance respiration. kGC/cohort/year - currentCohort%resp_m_def = nan ! Maintenance respiration deficit kgC/plant + currentCohort%resp_excess = nan ! Respiration of excess (unallocatable) carbon currentCohort%livestem_mr = nan ! Live stem maintenance respiration. kgC/indiv/s-1 currentCohort%livecroot_mr = nan ! Coarse root maintenance respiration. kgC/indiv/s-1 currentCohort%froot_mr = nan ! Fine root maintenance respiration. kgC/indiv/s-1 @@ -658,7 +659,7 @@ subroutine zero_cohort(cc_p) currentCohort%status_coh = 0 currentCohort%rdark = 0._r8 currentCohort%resp_m = 0._r8 - currentCohort%resp_m_def = 0._r8 + currentCohort%resp_excess = 0._r8 currentCohort%resp_g_tstep = 0._r8 currentCohort%livestem_mr = 0._r8 currentCohort%livecroot_mr = 0._r8 @@ -713,6 +714,11 @@ subroutine zero_cohort(cc_p) currentCohort%daily_p_demand = -9._r8 currentCohort%daily_n_demand = -9._r8 + ! Fixation is also integrated over the course of the day + ! and must be zeroid upon creation and after plant + ! resource allocation + currentCohort%daily_n_fixation = 0._r8 + end subroutine zero_cohort @@ -1075,7 +1081,8 @@ subroutine fuse_cohorts(currentSite, currentPatch, bc_in) real(r8) :: dynamic_age_fusion_tolerance real(r8) :: dbh real(r8) :: leaf_c ! leaf carbon [kg] - + real(r8) :: target_storec ! Target storage C + integer :: largersc, smallersc, sc_i ! indices for tracking the growth flux caused by fusion real(r8) :: larger_n, smaller_n integer :: oldercacls, youngercacls, cacls_i ! indices for tracking the age flux caused by fusion @@ -1281,7 +1288,7 @@ subroutine fuse_cohorts(currentSite, currentPatch, bc_in) call ForceDBH( currentCohort%pft, currentCohort%canopy_trim, & currentCohort%dbh, currentCohort%hite, & - bdead = currentCohort%prt%GetState(struct_organ,all_carbon_elements)) + bdead = currentCohort%prt%GetState(struct_organ,carbon12_element)) end if ! @@ -1318,7 +1325,7 @@ subroutine fuse_cohorts(currentSite, currentPatch, bc_in) if( prt_params%woody(currentCohort%pft) == itrue ) then call ForceDBH( currentCohort%pft, currentCohort%canopy_trim, & currentCohort%dbh, currentCohort%hite, & - bdead = currentCohort%prt%GetState(struct_organ,all_carbon_elements)) + bdead = currentCohort%prt%GetState(struct_organ,carbon12_element)) end if ! @@ -1330,7 +1337,7 @@ subroutine fuse_cohorts(currentSite, currentPatch, bc_in) call endrun(msg=errMsg(sourcefile, __LINE__)) end select - leaf_c = currentCohort%prt%GetState(leaf_organ,all_carbon_elements) + leaf_c = currentCohort%prt%GetState(leaf_organ,carbon12_element) currentCohort%treelai = tree_lai(leaf_c, currentCohort%pft, currentCohort%c_area, newn, & currentCohort%canopy_layer, currentPatch%canopy_layer_tlai, & @@ -1412,11 +1419,8 @@ subroutine fuse_cohorts(currentSite, currentPatch, bc_in) (currentCohort%n*currentCohort%gpp_acc_hold + & nextc%n*nextc%gpp_acc_hold)/newn - ! This carbon variable needs continuity from day to day, as resp_m_def - ! needs to hold mass and be conservative - - currentCohort%resp_m_def = (currentCohort%n*currentCohort%resp_m_def + & - nextc%n*nextc%resp_m_def)/newn + currentCohort%resp_excess = (currentCohort%n*currentCohort%resp_excess + & + nextc%n*nextc%resp_excess)/newn currentCohort%dmort = (currentCohort%n*currentCohort%dmort + & nextc%n*nextc%dmort)/newn @@ -1437,9 +1441,16 @@ subroutine fuse_cohorts(currentSite, currentPatch, bc_in) nextc%n*nextc%daily_nh4_uptake)/newn currentCohort%daily_no3_uptake = (currentCohort%n*currentCohort%daily_no3_uptake + & nextc%n*nextc%daily_no3_uptake)/newn + currentCohort%daily_n_fixation = (currentCohort%n*currentCohort%daily_n_fixation + & + nextc%n*nextc%daily_n_fixation)/newn + currentCohort%daily_n_gain = (currentCohort%n*currentCohort%daily_n_gain + & + nextc%n*nextc%daily_n_gain)/newn + currentCohort%daily_p_uptake = (currentCohort%n*currentCohort%daily_p_uptake + & nextc%n*nextc%daily_p_uptake)/newn - + + + currentCohort%daily_p_demand = (currentCohort%n*currentCohort%daily_p_demand + & nextc%n*nextc%daily_p_demand)/newn currentCohort%daily_n_demand = (currentCohort%n*currentCohort%daily_n_demand + & @@ -1854,6 +1865,8 @@ subroutine copy_cohort( currentCohort,copyc ) n%daily_nh4_uptake = o%daily_nh4_uptake n%daily_no3_uptake = o%daily_no3_uptake + n%daily_n_fixation = o%daily_n_fixation + n%daily_n_gain = o%daily_n_gain n%daily_p_uptake = o%daily_p_uptake n%daily_c_efflux = o%daily_c_efflux n%daily_n_efflux = o%daily_n_efflux @@ -1868,7 +1881,7 @@ subroutine copy_cohort( currentCohort,copyc ) !RESPIRATION n%rdark = o%rdark n%resp_m = o%resp_m - n%resp_m_def = o%resp_m_def + n%resp_excess = o%resp_excess n%resp_g_tstep = o%resp_g_tstep n%livestem_mr = o%livestem_mr n%livecroot_mr = o%livecroot_mr @@ -1993,7 +2006,7 @@ subroutine UpdateCohortBioPhysRates(currentCohort) do iage = 1, nleafage frac_leaf_aclass(iage) = & - currentCohort%prt%GetState(leaf_organ, all_carbon_elements,iage) + currentCohort%prt%GetState(leaf_organ, carbon12_element,iage) end do ! If there are leaves, then perform proportional weighting on the four rates @@ -2080,7 +2093,7 @@ subroutine EvaluateAndCorrectDBH(currentCohort,delta_dbh,delta_hite) if( int(prt_params%woody(currentCohort%pft)) == itrue) then - struct_c = currentCohort%prt%GetState(struct_organ, all_carbon_elements) + struct_c = currentCohort%prt%GetState(struct_organ, carbon12_element) ! Target sapwood biomass according to allometry and trimming [kgC] call bsap_allom(dbh,ipft,canopy_trim,sapw_area,target_sapw_c) @@ -2111,7 +2124,7 @@ subroutine EvaluateAndCorrectDBH(currentCohort,delta_dbh,delta_hite) else ! This returns the sum of leaf carbon over all (age) bins - leaf_c = currentCohort%prt%GetState(leaf_organ, all_carbon_elements) + leaf_c = currentCohort%prt%GetState(leaf_organ, carbon12_element) ! Target leaf biomass according to allometry and trimming call bleaf(dbh,ipft,canopy_trim,target_leaf_c) diff --git a/biogeochem/EDLoggingMortalityMod.F90 b/biogeochem/EDLoggingMortalityMod.F90 index f1f23d9f33..38afb74dc3 100644 --- a/biogeochem/EDLoggingMortalityMod.F90 +++ b/biogeochem/EDLoggingMortalityMod.F90 @@ -56,7 +56,7 @@ module EDLoggingMortalityMod use FatesGlobals , only : fates_log use shr_log_mod , only : errMsg => shr_log_errMsg use FatesPlantHydraulicsMod, only : AccumulateMortalityWaterStorage - use PRTGenericMod , only : all_carbon_elements,carbon12_element + use PRTGenericMod , only : carbon12_element use PRTGenericMod , only : sapw_organ, struct_organ, leaf_organ use PRTGenericMod , only : fnrt_organ, store_organ, repro_organ use FatesAllometryMod , only : set_root_fraction diff --git a/biogeochem/EDMortalityFunctionsMod.F90 b/biogeochem/EDMortalityFunctionsMod.F90 index e4a0b3c138..b337b9a751 100644 --- a/biogeochem/EDMortalityFunctionsMod.F90 +++ b/biogeochem/EDMortalityFunctionsMod.F90 @@ -19,9 +19,8 @@ module EDMortalityFunctionsMod use FatesInterfaceTypesMod , only : hlm_use_planthydro use EDLoggingMortalityMod , only : LoggingMortality_frac use EDParamsMod , only : fates_mortality_disturbance_fraction - - use PRTGenericMod, only : all_carbon_elements use PRTGenericMod, only : store_organ + use PRTGenericMod, only : carbon12_element implicit none private @@ -150,7 +149,7 @@ subroutine mortality_rates( cohort_in,bc_in,cmort,hmort,bmort,frmort,smort,asmor if ( cohort_in%dbh > 0._r8 ) then call bleaf(cohort_in%dbh,cohort_in%pft,cohort_in%canopy_trim,leaf_c_target) - store_c = cohort_in%prt%GetState(store_organ,all_carbon_elements) + store_c = cohort_in%prt%GetState(store_organ,carbon12_element) call storage_fraction_of_target(leaf_c_target, store_c, frac) if( frac .lt. 1._r8) then diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 4fee51a877..456f49304c 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -74,7 +74,6 @@ module EDPatchDynamicsMod use EDCohortDynamicsMod , only : InitPRTObject use EDCohortDynamicsMod , only : InitPRTBoundaryConditions use ChecksBalancesMod, only : SiteMassStock - use PRTGenericMod, only : all_carbon_elements use PRTGenericMod, only : carbon12_element use PRTGenericMod, only : leaf_organ use PRTGenericMod, only : fnrt_organ @@ -235,8 +234,8 @@ subroutine disturbance_rates( site_in, bc_in) if (currentCohort%canopy_layer>=1) then site_in%harvest_carbon_flux = site_in%harvest_carbon_flux + & currentCohort%lmort_direct * currentCohort%n * & - ( currentCohort%prt%GetState(sapw_organ, all_carbon_elements) + & - currentCohort%prt%GetState(struct_organ, all_carbon_elements)) * & + ( currentCohort%prt%GetState(sapw_organ, carbon12_element) + & + currentCohort%prt%GetState(struct_organ, carbon12_element)) * & prt_params%allom_agb_frac(currentCohort%pft) * & SF_val_CWD_frac(ncwd) * logging_export_frac endif @@ -720,11 +719,11 @@ subroutine spawn_patches( currentSite, bc_in) nc%canopy_layer = 1 nc%canopy_layer_yesterday = 1._r8 - sapw_c = currentCohort%prt%GetState(sapw_organ, all_carbon_elements) - struct_c = currentCohort%prt%GetState(struct_organ, all_carbon_elements) - leaf_c = currentCohort%prt%GetState(leaf_organ, all_carbon_elements) - fnrt_c = currentCohort%prt%GetState(fnrt_organ, all_carbon_elements) - store_c = currentCohort%prt%GetState(store_organ, all_carbon_elements) + sapw_c = currentCohort%prt%GetState(sapw_organ, carbon12_element) + struct_c = currentCohort%prt%GetState(struct_organ, carbon12_element) + leaf_c = currentCohort%prt%GetState(leaf_organ, carbon12_element) + fnrt_c = currentCohort%prt%GetState(fnrt_organ, carbon12_element) + store_c = currentCohort%prt%GetState(store_organ, carbon12_element) total_c = sapw_c + struct_c + leaf_c + fnrt_c + store_c ! treefall mortality is the dominant disturbance @@ -2954,7 +2953,7 @@ subroutine patch_pft_size_profile(cp_pnt) currentPatch%pft_agb_profile(currentCohort%pft,j) = & currentPatch%pft_agb_profile(currentCohort%pft,j) + & - currentCohort%prt%GetState(struct_organ, all_carbon_elements) * & + currentCohort%prt%GetState(struct_organ, carbon12_element) * & currentCohort%n/currentPatch%area endif diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index c286188d2c..0fb17d5b39 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -92,7 +92,6 @@ module EDPhysiologyMod use PRTGenericMod, only : prt_vartypes use PRTGenericMod, only : leaf_organ use PRTGenericMod, only : sapw_organ, struct_organ - use PRTGenericMod, only : all_carbon_elements use PRTGenericMod, only : carbon12_element use PRTGenericMod, only : nitrogen_element use PRTGenericMod, only : phosphorus_element @@ -427,7 +426,7 @@ subroutine trim_canopy( currentSite ) real(r8) :: optimum_trim ! Optimum trim value real(r8) :: initial_laimem ! Initial laimemory real(r8) :: optimum_laimem ! Optimum laimemory - + real(r8) :: target_storec !---------------------------------------------------------------------- ipatch = 1 ! Start counting patches @@ -461,7 +460,7 @@ subroutine trim_canopy( currentSite ) ipft = currentCohort%pft call carea_allom(currentCohort%dbh,currentCohort%n,currentSite%spread,currentCohort%pft,currentCohort%c_area) - leaf_c = currentCohort%prt%GetState(leaf_organ, all_carbon_elements) + leaf_c = currentCohort%prt%GetState(leaf_organ, carbon12_element) currentCohort%treelai = tree_lai(leaf_c, currentCohort%pft, currentCohort%c_area, & currentCohort%n, currentCohort%canopy_layer, & @@ -1105,10 +1104,10 @@ subroutine phenology_leafonoff(currentSite) if(debug) call currentCohort%prt%CheckMassConservation(ipft,0) - store_c = currentCohort%prt%GetState(store_organ, all_carbon_elements) - leaf_c = currentCohort%prt%GetState(leaf_organ, all_carbon_elements) - sapw_c = currentCohort%prt%GetState(sapw_organ, all_carbon_elements) - struct_c = currentCohort%prt%GetState(struct_organ, all_carbon_elements) + store_c = currentCohort%prt%GetState(store_organ, carbon12_element) + leaf_c = currentCohort%prt%GetState(leaf_organ, carbon12_element) + sapw_c = currentCohort%prt%GetState(sapw_organ, carbon12_element) + struct_c = currentCohort%prt%GetState(struct_organ, carbon12_element) stem_drop_fraction = EDPftvarcon_inst%phen_stem_drop_fraction(ipft) diff --git a/biogeochem/FatesAllometryMod.F90 b/biogeochem/FatesAllometryMod.F90 index ef6ea7151e..511bb90592 100644 --- a/biogeochem/FatesAllometryMod.F90 +++ b/biogeochem/FatesAllometryMod.F90 @@ -1031,7 +1031,8 @@ subroutine bstore_allom(d,ipft,canopy_trim,bstore,dbstoredd) case(1) ! Storage is constant proportionality of trimmed maximum leaf ! biomass (ie cushion * bleaf) - call bleaf(d,ipft,canopy_trim,bl,dbldd) + !call bleaf(d,ipft,canopy_trim,bl,dbldd) + call bleaf(d,ipft,1.0_r8,bl,dbldd) call bstore_blcushion(d,bl,dbldd,cushion,ipft,bstore,dbstoredd) case DEFAULT diff --git a/biogeochem/FatesSoilBGCFluxMod.F90 b/biogeochem/FatesSoilBGCFluxMod.F90 index caab5e8d54..3556013556 100644 --- a/biogeochem/FatesSoilBGCFluxMod.F90 +++ b/biogeochem/FatesSoilBGCFluxMod.F90 @@ -20,7 +20,6 @@ module FatesSoilBGCFluxMod use PRTGenericMod , only : prt_vartypes use PRTGenericMod , only : leaf_organ use PRTGenericMod , only : sapw_organ, struct_organ - use PRTGenericMod , only : all_carbon_elements use PRTGenericMod , only : carbon12_element use PRTGenericMod , only : nitrogen_element use PRTGenericMod , only : phosphorus_element @@ -86,7 +85,7 @@ module FatesSoilBGCFluxMod public :: PrepNutrientAquisitionBCs public :: UnPackNutrientAquisitionBCs public :: FluxIntoLitterPools - + public :: EffluxIntoLitterPools logical, parameter :: debug = .false. ! local debug flag character(len=*), parameter, private :: sourcefile = & @@ -562,6 +561,71 @@ subroutine PrepNutrientAquisitionBCs(csite, bc_in, bc_out) return end subroutine PrepNutrientAquisitionBCs + ! ===================================================================================== + + subroutine EffluxIntoLitterPools(csite, cpatch, ccohort, bc_in ) + + ! ----------------------------------------------------------------------------------- + ! This subroutine just handles the transfer of exudation/efflux from plants + ! to the HLM. We "root_fines_frag" array to save memory, and because it has + ! a labile component, soil discretization, and already has routines + ! in place for restarting and mass balancing through disturbance. + ! ----------------------------------------------------------------------------------- + + ! Arguments + type(ed_site_type), intent(inout) :: csite + type(ed_patch_type), intent(inout) :: cpatch + type(ed_cohort_type), intent(inout),target :: ccohort + type(bc_in_type), intent(in) :: bc_in + + ! locals + integer :: el ! element loop index + integer :: j ! soil layer loop index + real(r8), pointer :: efflux_ptr ! pointer to cohort efflux + type(litter_type), pointer :: litt + + call set_root_fraction(csite%rootfrac_scr, & + ccohort%pft, csite%zi_soil, & + bc_in%max_rooting_depth_index_col ) + + ! Loop over the different elements. + do el = 1, num_elements + + select case (element_list(el)) + case (carbon12_element) + + efflux_ptr => ccohort%daily_c_efflux + + case (nitrogen_element) + + efflux_ptr => ccohort%daily_n_efflux + + case (phosphorus_element) + + efflux_ptr => ccohort%daily_p_efflux + + end select + + litt => cpatch%litter(el) + + do j = 1,csite%nlevsoil + + ! kg/m2/day + litt%root_fines_frag(ilabile,j) = litt%root_fines_frag(ilabile,j) + & + efflux_ptr * ccohort%n * AREA_INV * csite%rootfrac_scr(j) + + ! Note: we do not increment the site-level mass flux checking + ! variable site_mass%frag_out This will be incremented later + ! in the call sequence, and we don't want to double count. + + end do + + end do + + return + end subroutine EffluxIntoLitterPools + + ! ===================================================================================== subroutine FluxIntoLitterPools(csite, bc_in, bc_out) @@ -677,21 +741,19 @@ subroutine FluxIntoLitterPools(csite, bc_in, bc_out) select case (element_list(el)) case (carbon12_element) - bc_out%litt_flux_cel_c_si(:) = 0.0_r8 - bc_out%litt_flux_lig_c_si(:) = 0.0_r8 - bc_out%litt_flux_lab_c_si(:) = 0.0_r8 + bc_out%litt_flux_cel_c_si(:) = 0._r8 + bc_out%litt_flux_lig_c_si(:) = 0._r8 + bc_out%litt_flux_lab_c_si(:) = 0._r8 flux_cel_si => bc_out%litt_flux_cel_c_si(:) flux_lab_si => bc_out%litt_flux_lab_c_si(:) flux_lig_si => bc_out%litt_flux_lig_c_si(:) - - case (nitrogen_element) + case (nitrogen_element) bc_out%litt_flux_cel_n_si(:) = 0._r8 bc_out%litt_flux_lig_n_si(:) = 0._r8 bc_out%litt_flux_lab_n_si(:) = 0._r8 flux_cel_si => bc_out%litt_flux_cel_n_si(:) flux_lab_si => bc_out%litt_flux_lab_n_si(:) flux_lig_si => bc_out%litt_flux_lig_n_si(:) - case (phosphorus_element) bc_out%litt_flux_cel_p_si(:) = 0._r8 bc_out%litt_flux_lig_p_si(:) = 0._r8 @@ -699,52 +761,11 @@ subroutine FluxIntoLitterPools(csite, bc_in, bc_out) flux_cel_si => bc_out%litt_flux_cel_p_si(:) flux_lab_si => bc_out%litt_flux_lab_p_si(:) flux_lig_si => bc_out%litt_flux_lig_p_si(:) - end select - - ! If there is any efflux (from stores overflowing) - ! than pass that to the labile litter pool - - do id = 1,nlev_eff_decomp - flux_lab_si(id) = flux_lab_si(id) + & - sum(csite%flux_diags(el)%nutrient_efflux_scpf(:)) * & - area_inv * surface_prof(id) - end do - currentPatch => csite%oldest_patch do while (associated(currentPatch)) - ! If there is any efflux (from stores overflowing) - ! than pass that to the labile litter pool - if(.false.)then - currentCohort => currentPatch%tallest - do while(associated(currentCohort)) - if(.not.currentCohort%isnew)then - if(element_list(el).eq.carbon12_element) then - efflux_ptr => currentCohort%daily_c_efflux - elseif(element_list(el).eq.nitrogen_element) then - efflux_ptr => currentCohort%daily_n_efflux - elseif(element_list(el).eq.phosphorus_element) then - efflux_ptr => currentCohort%daily_p_efflux - end if - - call set_root_fraction(csite%rootfrac_scr, currentCohort%pft, csite%zi_soil, & - bc_in%max_rooting_depth_index_col ) - - ! Unit conversion - ! kg/plant/day * plant/ha * ha/m2 -> kg/m2/day - - do id = 1,nlev_eff_soil - flux_lab_si(id) = flux_lab_si(id) + & - efflux_ptr * currentCohort%n* AREA_INV *csite%rootfrac_scr(id) - end do - - end if - currentCohort => currentCohort%shorter - end do - end if - ! Set a pointer to the litter object ! for the current element on the current ! patch @@ -808,9 +829,7 @@ subroutine FluxIntoLitterPools(csite, bc_in, bc_out) end do end do - do j = 1, nlev_eff_soil - id = bc_in%decomp_id(j) flux_lab_si(id) = flux_lab_si(id) + & litt%root_fines_frag(ilabile,j) * area_frac diff --git a/biogeophys/FatesPlantRespPhotosynthMod.F90 b/biogeophys/FatesPlantRespPhotosynthMod.F90 index 5a0c55183b..f4d918c9c8 100644 --- a/biogeophys/FatesPlantRespPhotosynthMod.F90 +++ b/biogeophys/FatesPlantRespPhotosynthMod.F90 @@ -41,7 +41,7 @@ module FATESPlantRespPhotosynthMod use EDParamsMod, only : q10_mr use PRTGenericMod, only : prt_carbon_allom_hyp use PRTGenericMod, only : prt_cnp_flex_allom_hyp - use PRTGenericMod, only : all_carbon_elements + use PRTGenericMod, only : carbon12_element use PRTGenericMod, only : nitrogen_element use PRTGenericMod, only : leaf_organ use PRTGenericMod, only : fnrt_organ @@ -221,7 +221,7 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) real(r8) :: maintresp_reduction_factor ! factor by which to reduce maintenance - ! respiration when storage pools are low + ! respiration when storage pools are low real(r8) :: b_leaf ! leaf biomass kgC real(r8) :: frac ! storage pool as a fraction of target leaf biomass real(r8) :: check_elai ! This is a check on the effective LAI that is calculated @@ -239,7 +239,8 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) real(r8) :: leaf_psi ! leaf xylem matric potential [MPa] (only meaningful/used w/ hydro) real(r8) :: fnrt_mr_layer ! fine root maintenance respiation per layer [kgC/plant/s] real(r8) :: c_cost_nfix ! carbon cost of N fixation [kgC/kgN] - + real(r8) :: c_spent_nfix ! carbon spent on N fixation, per layer [kgC/plant/timestep] + real(r8), allocatable :: rootfr_ft(:,:) ! Root fractions per depth and PFT ! ----------------------------------------------------------------------------------- @@ -398,16 +399,16 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) ! currentCohort%canopy_trim,store_c_target) call storage_fraction_of_target(store_c_target, & - currentCohort%prt%GetState(store_organ, all_carbon_elements), & + currentCohort%prt%GetState(store_organ, carbon12_element), & frac) call lowstorage_maintresp_reduction(frac,currentCohort%pft, & maintresp_reduction_factor) ! are there any leaves of this pft in this layer? - if(currentPatch%canopy_mask(cl,ft) == 1)then + canopy_mask_if: if(currentPatch%canopy_mask(cl,ft) == 1)then ! Loop over leaf-layers - do iv = 1,currentCohort%nv + leaf_layer_loop : do iv = 1,currentCohort%nv ! ------------------------------------------------------------ ! If we are doing plant hydro-dynamics (or any run-type @@ -422,7 +423,7 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) ! age classes ! ------------------------------------------------------------ - if ( .not.rate_mask_z(iv,ft,cl) .or. & + rate_mask_if: if ( .not.rate_mask_z(iv,ft,cl) .or. & (hlm_use_planthydro.eq.itrue) .or. & (nleafage > 1) .or. & (hlm_parteh_mode .ne. prt_carbon_allom_hyp ) ) then @@ -494,7 +495,7 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) case (prt_cnp_flex_allom_hyp) - leaf_c = currentCohort%prt%GetState(leaf_organ, all_carbon_elements) + leaf_c = currentCohort%prt%GetState(leaf_organ, carbon12_element) if( (leaf_c*slatop(ft)) > nearzero) then leaf_n = currentCohort%prt%GetState(leaf_organ, nitrogen_element) lnc_top = leaf_n / (slatop(ft) * leaf_c ) @@ -578,8 +579,9 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) c13disc_z(cl,ft,iv)) ! out rate_mask_z(iv,ft,cl) = .true. - end if - end do + + end if rate_mask_if + end do leaf_layer_loop ! Zero cohort flux accumulators. currentCohort%npp_tstep = 0.0_r8 @@ -628,7 +630,7 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) currentCohort%g_sb_laweight = 0.0_r8 currentCohort%ts_net_uptake(:) = 0.0_r8 - end if ! if(currentPatch%canopy_mask(cl,ft) == 1)then + end if canopy_mask_if ! ------------------------------------------------------------------ @@ -643,8 +645,8 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) ! Units are in (kgN/plant) ! ------------------------------------------------------------------ - sapw_c = currentCohort%prt%GetState(sapw_organ, all_carbon_elements) - fnrt_c = currentCohort%prt%GetState(fnrt_organ, all_carbon_elements) + sapw_c = currentCohort%prt%GetState(sapw_organ, carbon12_element) + fnrt_c = currentCohort%prt%GetState(fnrt_organ, carbon12_element) select case(hlm_parteh_mode) case (prt_carbon_allom_hyp) @@ -709,21 +711,24 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) currentCohort%froot_mr = 0._r8 ! n_fixation is integrated over the course of the day - currentCohort%n_fixation = 0._r8 + ! this variable is zeroed at the end of the FATES dynamics sequence do j = 1,bc_in(s)%nlevsoil tcsoi = q10_mr**((bc_in(s)%t_soisno_sl(j)-tfrz - 20.0_r8)/10.0_r8) fnrt_mr_layer = fnrt_n * ED_val_base_mr_20 * tcsoi * rootfr_ft(ft,j) * maintresp_reduction_factor - currentCohort%froot_mr = currentCohort%froot_mr + fnrt_mr_layer * (1._r8 + EDPftvarcon_inst%dev_arbitrary_pft(ft)) + currentCohort%froot_mr = currentCohort%froot_mr + fnrt_mr_layer * (1._r8 + EDPftvarcon_inst%nfix_mresp_scfrac(ft)) ! calculate the cost of carbon for N fixation in each soil layer and calculate N fixation rate based on that [kgC / kgN] c_cost_nfix = s_fix * (exp(a_fix + b_fix * (bc_in(s)%t_soisno_sl(j)-tfrz) & * (1._r8 - 0.5_r8 * (bc_in(s)%t_soisno_sl(j)-tfrz) / c_fix)) - 2._r8) + + ! Time integrated amount of carbon spent on fixation (in this layer) [kgC/plant/layer/tstep] + c_spent_nfix = fnrt_mr_layer * dtime * EDPftvarcon_inst%nfix_mresp_scfrac(ft) - currentCohort%n_fixation = currentCohort%n_fixation + fnrt_mr_layer * EDPftvarcon_inst%dev_arbitrary_pft / c_cost_nfix + currentCohort%daily_n_fixation = currentCohort%daily_n_fixation + c_spent_nfix / c_cost_nfix enddo @@ -2089,7 +2094,7 @@ subroutine LeafLayerBiophysicalRates( parsun_lsl, & vcmax = vcmax * btran return -end subroutine LeafLayerBiophysicalRates + end subroutine LeafLayerBiophysicalRates subroutine lowstorage_maintresp_reduction(frac, pft, maintresp_reduction_factor) diff --git a/fire/SFMainMod.F90 b/fire/SFMainMod.F90 index aedcb4aa7c..c0d30fa3fb 100644 --- a/fire/SFMainMod.F90 +++ b/fire/SFMainMod.F90 @@ -37,7 +37,6 @@ module SFMainMod use PRTGenericMod, only : leaf_organ use PRTGenericMod, only : carbon12_element - use PRTGenericMod, only : all_carbon_elements use PRTGenericMod, only : leaf_organ use PRTGenericMod, only : fnrt_organ use PRTGenericMod, only : sapw_organ @@ -195,7 +194,7 @@ subroutine charecteristics_of_fuel ( currentSite ) if( int(prt_params%woody(currentCohort%pft)) == ifalse)then currentPatch%livegrass = currentPatch%livegrass + & - currentCohort%prt%GetState(leaf_organ, all_carbon_elements) * & + currentCohort%prt%GetState(leaf_organ, carbon12_element) * & currentCohort%n/currentPatch%area endif @@ -866,9 +865,9 @@ subroutine crown_scorching ( currentSite ) do while(associated(currentCohort)) if ( int(prt_params%woody(currentCohort%pft)) == itrue) then !trees only - leaf_c = currentCohort%prt%GetState(leaf_organ, all_carbon_elements) - sapw_c = currentCohort%prt%GetState(sapw_organ, all_carbon_elements) - struct_c = currentCohort%prt%GetState(struct_organ, all_carbon_elements) + leaf_c = currentCohort%prt%GetState(leaf_organ, carbon12_element) + sapw_c = currentCohort%prt%GetState(sapw_organ, carbon12_element) + struct_c = currentCohort%prt%GetState(struct_organ, carbon12_element) tree_ag_biomass = tree_ag_biomass + & currentCohort%n * (leaf_c + & diff --git a/main/ChecksBalancesMod.F90 b/main/ChecksBalancesMod.F90 index 9a17fbfc33..ab76715fe6 100644 --- a/main/ChecksBalancesMod.F90 +++ b/main/ChecksBalancesMod.F90 @@ -15,7 +15,6 @@ module ChecksBalancesMod use FatesLitterMod, only : litter_type use FatesLitterMod, only : ncwd use FatesLitterMod, only : ndcmpy - use PRTGenericMod, only : all_carbon_elements use PRTGenericMod, only : carbon12_element use PRTGenericMod, only : leaf_organ use PRTGenericMod, only : fnrt_organ @@ -121,16 +120,6 @@ subroutine PatchMassStock(currentPatch,el,live_stock,seed_stock,litter_stock) currentCohort => currentCohort%shorter enddo !end cohort loop - - if(element_id.eq.carbon12_element) then - currentCohort => currentPatch%tallest - do while(associated(currentCohort)) - live_stock = live_stock - & - (currentCohort%resp_m_def*currentCohort%n) - currentCohort => currentCohort%shorter - enddo !end cohort loop - end if - return end subroutine PatchMassStock diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index 671bc7c7a0..854b9ecebe 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -152,9 +152,6 @@ subroutine init_site_vars( site_in, bc_in, bc_out ) do el=1,num_elements allocate(site_in%flux_diags(el)%leaf_litter_input(1:numpft)) allocate(site_in%flux_diags(el)%root_litter_input(1:numpft)) - allocate(site_in%flux_diags(el)%nutrient_efflux_scpf(nlevsclass*numpft)) - allocate(site_in%flux_diags(el)%nutrient_uptake_scpf(nlevsclass*numpft)) - allocate(site_in%flux_diags(el)%nutrient_demand_scpf(nlevsclass*numpft)) end do ! Initialize the static soil diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index aeec0c7974..28fefe9da2 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -49,6 +49,7 @@ module EDMainMod use EDPhysiologyMod , only : PreDisturbanceLitterFluxes use EDPhysiologyMod , only : PreDisturbanceIntegrateLitter use FatesSoilBGCFluxMod , only : FluxIntoLitterPools + use FatesSoilBGCFluxMod , only : EffluxIntoLitterPools use EDCohortDynamicsMod , only : UpdateCohortBioPhysRates use FatesSoilBGCFluxMod , only : PrepNutrientAquisitionBCs use FatesSoilBGCFluxMod , only : PrepCH4BCs @@ -79,7 +80,7 @@ module EDMainMod use FatesPlantHydraulicsMod , only : UpdateSizeDepRhizHydProps use FatesPlantHydraulicsMod , only : AccumulateMortalityWaterStorage use FatesAllometryMod , only : h_allom,tree_sai,tree_lai - use FatesAllometryMod , only : bleaf + use FatesAllometryMod , only : bleaf,bstore_allom use FatesPlantHydraulicsMod , only : UpdateSizeDepRhizHydStates use EDLoggingMortalityMod , only : IsItLoggingTime use EDPatchDynamicsMod , only : get_frac_site_primary @@ -88,7 +89,6 @@ module EDMainMod use EDMortalityFunctionsMod , only : Mortality_Derivative use EDTypesMod , only : AREA_INV use PRTGenericMod, only : carbon12_element - use PRTGenericMod, only : all_carbon_elements use PRTGenericMod, only : leaf_organ use PRTGenericMod, only : fnrt_organ use PRTGenericMod, only : sapw_organ @@ -98,8 +98,6 @@ module EDMainMod use PRTLossFluxesMod, only : PRTMaintTurnover use PRTLossFluxesMod, only : PRTReproRelease use EDPftvarcon, only : EDPftvarcon_inst - use FatesHistoryInterfaceMod, only : ih_nh4uptake_si, ih_no3uptake_si, ih_puptake_si - use FatesHistoryInterfaceMod, only : ih_nh4uptake_scpf, ih_no3uptake_scpf, ih_puptake_scpf use FatesHistoryInterfaceMod, only : fates_hist ! CIME Globals @@ -166,6 +164,8 @@ subroutine ed_ecosystem_dynamics(currentSite, bc_in, bc_out) ! zero dynamics (upfreq_in = 1) output history variables call fates_hist%zero_site_hvars(currentSite,upfreq_in=1) + ! zero nutrient fluxes (upfreq_in=5) output hist variables + call fates_hist%zero_site_hvars(currentSite,upfreq_in=5) ! Call a routine that simply identifies if logging should occur ! This is limited to a global event until more structured event handling is enabled @@ -340,6 +340,7 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) ! note, this is not the target, but the actual real(r8) :: leaf_c_target ! target leaf crabon [kg] real(r8) :: current_npp ! place holder for calculating npp each year in prescribed physiology mode + real(r8) :: target_storec !----------------------------------------------------------------------- real(r8) :: frac_site_primary @@ -351,8 +352,6 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) currentPatch => currentSite%youngest_patch do while(associated(currentPatch)) - !print*,"PATCH" - currentPatch%age = currentPatch%age + hlm_freq_day ! FIX(SPM,032414) valgrind 'Conditional jump or move depends on uninitialised value' if( currentPatch%age < 0._r8 )then @@ -373,9 +372,8 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) currentCohort => currentPatch%shortest do while(associated(currentCohort)) - ft = currentCohort%pft - + ! Calculate the mortality derivatives call Mortality_Derivative( currentSite, currentCohort, bc_in, frac_site_primary ) @@ -440,115 +438,56 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) hite_old = currentCohort%hite dbh_old = currentCohort%dbh + ! Plants can acquire N from 3 sources (excluding re-absorption), + ! the source doesn't affect how its allocated (yet), so they + ! are combined into daily_n_gain, which is the value used in the following + ! allocation scheme + + currentCohort%daily_n_gain = currentCohort%daily_nh4_uptake + & + currentCohort%daily_no3_uptake + currentCohort%daily_n_fixation + ! ----------------------------------------------------------------------------- ! Growth and Allocation (PARTEH) ! ----------------------------------------------------------------------------- + currentCohort%resp_excess = 0._r8 + + call currentCohort%prt%DailyPRT() + ! Send any efflux/exudates to the labile litter pools in the HLM + ! ----------------------------------------------------------------------------- + call EffluxIntoLitterPools(currentSite, currentPatch, currentCohort, bc_in ) - ! Update the moving average of actual L2FR - call bleaf(currentCohort%dbh,currentCohort%pft,currentCohort%canopy_trim,leaf_c_target) - if(currentCohort%prt%GetState(leaf_organ, carbon12_element)/leaf_c_target>0.01_r8)then - actual_l2fr = currentCohort%prt%GetState(fnrt_organ, carbon12_element) / & - currentCohort%prt%GetState(leaf_organ, carbon12_element) + ! Update history diagnostics related to Nutrient fluxes and C efflux (if any) + ! ----------------------------------------------------------------------------- + + call fates_hist%update_history_nutrflux(currentSite,currentPatch,currentCohort) - actual_l2fr = max(0.05_r8,min(10._r8,actual_l2fr)) + + currentCohort%daily_n_fixation = 0._r8 - !!call currentCohort%l2fr_ema%UpdateRMean(actual_l2fr) - end if + ! Mass balance for N uptake + currentSite%mass_balance(element_pos(nitrogen_element))%net_root_uptake = & + currentSite%mass_balance(element_pos(nitrogen_element))%net_root_uptake + & + (currentCohort%daily_n_gain-currentCohort%daily_n_efflux)*currentCohort%n - call currentCohort%prt%DailyPRT() + ! Mass balance for P uptake + currentSite%mass_balance(element_pos(phosphorus_element))%net_root_uptake = & + currentSite%mass_balance(element_pos(phosphorus_element))%net_root_uptake + & + (currentCohort%daily_p_uptake-currentCohort%daily_p_efflux)*currentCohort%n + + ! mass balance for C efflux (if any) + currentSite%mass_balance(element_pos(carbon12_element))%net_root_uptake = & + currentSite%mass_balance(element_pos(carbon12_element))%net_root_uptake - & + currentCohort%daily_c_efflux*currentCohort%n - ! Update the mass balance tracking for the daily nutrient uptake flux - ! Then zero out the daily uptakes, they have been used - ! ----------------------------------------------------------------------------- - - if(hlm_parteh_mode .eq. prt_cnp_flex_allom_hyp ) then - - ! Mass balance for N uptake - currentSite%mass_balance(element_pos(nitrogen_element))%net_root_uptake = & - currentSite%mass_balance(element_pos(nitrogen_element))%net_root_uptake + & - (currentCohort%daily_nh4_uptake+currentCohort%daily_no3_uptake- & - currentCohort%daily_n_efflux)*currentCohort%n - - ! Mass balance for P uptake - currentSite%mass_balance(element_pos(phosphorus_element))%net_root_uptake = & - currentSite%mass_balance(element_pos(phosphorus_element))%net_root_uptake + & - (currentCohort%daily_p_uptake-currentCohort%daily_p_efflux)*currentCohort%n - - ! mass balance for C efflux (if any) - currentSite%mass_balance(element_pos(carbon12_element))%net_root_uptake = & - currentSite%mass_balance(element_pos(carbon12_element))%net_root_uptake - & - currentCohort%daily_c_efflux*currentCohort%n - - ! size class index - iscpf = currentCohort%size_by_pft_class - - ! Diagnostics for uptake, by size and pft, [kgX/ha/day] - - io_si = currentSite%h_gid - - fates_hist%hvars(ih_nh4uptake_scpf)%r82d(io_si,iscpf) = & - fates_hist%hvars(ih_nh4uptake_scpf)%r82d(io_si,iscpf) + & - currentCohort%daily_nh4_uptake*currentCohort%n / & - m2_per_ha / sec_per_day - - fates_hist%hvars(ih_no3uptake_scpf)%r82d(io_si,iscpf) = & - fates_hist%hvars(ih_no3uptake_scpf)%r82d(io_si,iscpf) + & - currentCohort%daily_no3_uptake*currentCohort%n / & - m2_per_ha / sec_per_day - - fates_hist%hvars(ih_puptake_scpf)%r82d(io_si,iscpf) = & - fates_hist%hvars(ih_puptake_scpf)%r82d(io_si,iscpf) + & - currentCohort%daily_p_uptake*currentCohort%n / & - m2_per_ha / sec_per_day - - fates_hist%hvars(ih_nh4uptake_si)%r81d(io_si) = & - fates_hist%hvars(ih_nh4uptake_si)%r81d(io_si) + & - currentCohort%daily_nh4_uptake*currentCohort%n / & - m2_per_ha / sec_per_day - - fates_hist%hvars(ih_no3uptake_si)%r81d(io_si) = & - fates_hist%hvars(ih_no3uptake_si)%r81d(io_si) + & - currentCohort%daily_no3_uptake*currentCohort%n / & - m2_per_ha / sec_per_day - - fates_hist%hvars(ih_puptake_si)%r81d(io_si) = & - fates_hist%hvars(ih_puptake_si)%r81d(io_si) + & - currentCohort%daily_p_uptake*currentCohort%n / & - m2_per_ha / sec_per_day - - - ! Diagnostics on efflux, size and pft [kgX/ha/day] - currentSite%flux_diags(element_pos(nitrogen_element))%nutrient_efflux_scpf(iscpf) = & - currentSite%flux_diags(element_pos(nitrogen_element))%nutrient_efflux_scpf(iscpf) + & - currentCohort%daily_n_efflux*currentCohort%n - - currentSite%flux_diags(element_pos(phosphorus_element))%nutrient_efflux_scpf(iscpf) = & - currentSite%flux_diags(element_pos(phosphorus_element))%nutrient_efflux_scpf(iscpf) + & - currentCohort%daily_p_efflux*currentCohort%n - - currentSite%flux_diags(element_pos(carbon12_element))%nutrient_efflux_scpf(iscpf) = & - currentSite%flux_diags(element_pos(carbon12_element))%nutrient_efflux_scpf(iscpf) + & - currentCohort%daily_c_efflux*currentCohort%n - - ! Diagnostics on plant nutrient need - currentSite%flux_diags(element_pos(nitrogen_element))%nutrient_demand_scpf(iscpf) = & - currentSite%flux_diags(element_pos(nitrogen_element))%nutrient_demand_scpf(iscpf) + & - currentCohort%daily_n_demand*currentCohort%n - - currentSite%flux_diags(element_pos(phosphorus_element))%nutrient_demand_scpf(iscpf) = & - currentSite%flux_diags(element_pos(phosphorus_element))%nutrient_demand_scpf(iscpf) + & - currentCohort%daily_p_demand*currentCohort%n - - end if - ! And simultaneously add the input fluxes to mass balance accounting site_cmass%gpp_acc = site_cmass%gpp_acc + & currentCohort%gpp_acc * currentCohort%n + site_cmass%aresp_acc = site_cmass%aresp_acc + & - currentCohort%resp_acc * currentCohort%n + (currentCohort%resp_acc+currentCohort%resp_excess) * currentCohort%n call currentCohort%prt%CheckMassConservation(ft,5) @@ -885,12 +824,13 @@ subroutine TotalBalanceCheck (currentSite, call_index ) write(fates_log(),*) 'leaf: ',leaf_m,' structure: ',struct_m,' store: ',store_m write(fates_log(),*) 'fineroot: ',fnrt_m,' repro: ',repro_m,' sapwood: ',sapw_m write(fates_log(),*) 'num plant: ',currentCohort%n - write(fates_log(),*) 'resp m def: ',currentCohort%resp_m_def*currentCohort%n + write(fates_log(),*) 'resp excess: ',currentCohort%resp_excess*currentCohort%n if(element_list(el).eq.nitrogen_element) then write(fates_log(),*) 'NH4 uptake: ',currentCohort%daily_nh4_uptake*currentCohort%n write(fates_log(),*) 'NO3 uptake: ',currentCohort%daily_no3_uptake*currentCohort%n write(fates_log(),*) 'N efflux: ',currentCohort%daily_n_efflux*currentCohort%n + write(fates_log(),*) 'N fixation: ',currentCohort%daily_n_fixation*currentCohort%n elseif(element_list(el).eq.phosphorus_element) then write(fates_log(),*) 'P uptake: ',currentCohort%daily_p_uptake*currentCohort%n write(fates_log(),*) 'P efflux: ',currentCohort%daily_p_efflux*currentCohort%n diff --git a/main/EDPftvarcon.F90 b/main/EDPftvarcon.F90 index 9dd076debc..387edc70f8 100644 --- a/main/EDPftvarcon.F90 +++ b/main/EDPftvarcon.F90 @@ -157,8 +157,9 @@ module EDPftvarcon ! biochemical production, fraction based how much ! more in need a plant is for P versus N [/] - !real(r8), allocatable :: nfix1(:) ! nitrogen fixation parameter 1 - !real(r8), allocatable :: nfix2(:) ! nitrogen fixation parameter 2 + ! Maintenance respiration surcharge for obligate fixation [fraction of existing respiration] + real(r8), allocatable :: nfix_mresp_scfrac(:) + ! Turnover related things @@ -572,7 +573,6 @@ subroutine Register_PFT(this, fates_params) ! Nutrient competition parameters - name = 'fates_eca_decompmicc' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) @@ -925,9 +925,10 @@ subroutine Receive_PFT(this, fates_params) call fates_params%RetreiveParameterAllocate(name=name, & data=this%prescribed_puptake) + ! TEMPORARILY USING DEV_ARIBITRARY_PFT FOR FIXATION PARAMETER name = 'fates_dev_arbitrary_pft' call fates_params%RetreiveParameterAllocate(name=name, & - data=this%dev_arbitrary_pft) + data=this%nfix_mresp_scfrac) name = 'fates_eca_decompmicc' call fates_params%RetreiveParameterAllocate(name=name, & @@ -1514,6 +1515,18 @@ subroutine FatesCheckParams(is_master) call endrun(msg=errMsg(sourcefile, __LINE__)) end if + ! Make sure that the N fixation respiration surcharge fraction is + ! between 0 and 1 + + if(any(EDpftvarcon_inst%nfix_mresp_scfrac(:)<0._r8) .or. any(EDpftvarcon_inst%nfix_mresp_scfrac(:)>1.0_r8)) then + write(fates_log(),*) 'The N fixation surcharge nfix_mresp_sfrac must be between 0-1.' + write(fates_log(),*) 'This parameter is temporarily using the parameter file field: dev_arbitrary_pft' + write(fates_log(),*) 'here are the values: ',EDpftvarcon_inst%nfix_mresp_scfrac(:) + write(fates_log(),*) 'Aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + ! If nitrogen is turned on, check to make sure there are valid ammonium ! parameters if(hlm_nitrogen_spec>0)then diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 94a02d9672..772a9d0e09 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -9,11 +9,11 @@ module EDTypesMod use PRTGenericMod, only : prt_vartypes use PRTGenericMod, only : leaf_organ, fnrt_organ, sapw_organ use PRTGenericMod, only : repro_organ, store_organ, struct_organ - use PRTGenericMod, only : all_carbon_elements use PRTGenericMod, only : num_organ_types use PRTGenericMod, only : num_elements use PRTGenericMod, only : element_list use PRTGenericMod, only : num_element_types + use PRTGenericMod, only : carbon12_element use FatesLitterMod, only : litter_type use FatesLitterMod, only : ncwd use FatesConstantsMod, only : n_anthro_disturbance_categories @@ -302,6 +302,8 @@ module EDTypesMod real(r8) :: daily_nh4_uptake ! integrated daily uptake of mineralized ammonium through competitive acquisition in soil [kg N / plant/ day] real(r8) :: daily_no3_uptake ! integrated daily uptake of mineralized nitrate through competitive acquisition in soil [kg N / plant/ day] + real(r8) :: daily_n_fixation ! Rate of N fixation from the roots [kgN/indiv/day] + real(r8) :: daily_n_gain ! sum of fixation and uptake of mineralized nh4/no3 in solution real(r8) :: daily_p_uptake ! integrated daily uptake of mineralized P through competitive acquisition in soil [kg P / plant/ day] real(r8) :: daily_c_efflux ! daily mean efflux of excess carbon from roots into labile pool [kg C/plant/day] @@ -312,7 +314,7 @@ module EDTypesMod real(r8) :: daily_p_demand ! The daily amount of P demanded by the plant [kgN/plant/day] ! N fixation rate - real(r8) :: n_fixation ! Rate of N fixation from the roots [kgN/indiv/s] + ! The following four biophysical rates are assumed to be ! at the canopy top, at reference temp 25C, and based on the @@ -338,10 +340,7 @@ module EDTypesMod real(r8) :: resp_g_tstep ! Growth respiration: kgC/indiv/timestep real(r8) :: resp_m ! Maintenance respiration: kgC/indiv/timestep - real(r8) :: resp_m_def ! Optional: (NOT IMPLEMENTED YET) - ! It may be possible to not respire at desired rate - ! because of low carbon stores, and thus build - ! up a deficit. This tracks that deficit. kgC/indiv + real(r8) :: resp_excess ! Respiration of excess carbon kgC/indiv/day real(r8) :: livestem_mr ! Live stem maintenance respiration: kgC/indiv/s ! (Above ground) real(r8) :: livecroot_mr ! Live stem maintenance respiration: kgC/indiv/s @@ -623,10 +622,6 @@ module EDTypesMod real(r8) :: cwd_bg_input(1:ncwd) real(r8),allocatable :: leaf_litter_input(:) real(r8),allocatable :: root_litter_input(:) - - real(r8),allocatable :: nutrient_uptake_scpf(:) - real(r8),allocatable :: nutrient_efflux_scpf(:) - real(r8),allocatable :: nutrient_demand_scpf(:) contains @@ -659,7 +654,8 @@ module EDTypesMod real(r8) :: aresp_acc ! Accumulated autotrophic respiration [kg/site/day] real(r8) :: net_root_uptake ! Net uptake of carbon or nutrients through the roots [kg/site/day] - ! (if carbon most likely exudation, if even active) + ! could include exudation, and for N this also includes symbiotic + ! fixation real(r8) :: seed_in ! Total mass of external seed rain into fates site [kg/site/day] ! This is from external grid-cells or from user parameterization @@ -890,9 +886,6 @@ subroutine ZeroFluxDiags(this) this%cwd_bg_input(:) = 0._r8 this%leaf_litter_input(:) = 0._r8 this%root_litter_input(:) = 0._r8 - this%nutrient_uptake_scpf(:) = 0._r8 - this%nutrient_efflux_scpf(:) = 0._r8 - this%nutrient_demand_scpf(:) = 0._r8 return end subroutine ZeroFluxDiags @@ -1083,12 +1076,12 @@ subroutine dump_cohort(ccohort) write(fates_log(),*) 'co%structmemory = ', ccohort%structmemory write(fates_log(),*) 'co%l2fr = ', ccohort%l2fr - write(fates_log(),*) 'leaf carbon = ', ccohort%prt%GetState(leaf_organ,all_carbon_elements) - write(fates_log(),*) 'fineroot carbon = ', ccohort%prt%GetState(fnrt_organ,all_carbon_elements) - write(fates_log(),*) 'sapwood carbon = ', ccohort%prt%GetState(sapw_organ,all_carbon_elements) - write(fates_log(),*) 'structural (dead) carbon = ', ccohort%prt%GetState(struct_organ,all_carbon_elements) - write(fates_log(),*) 'storage carbon = ', ccohort%prt%GetState(store_organ,all_carbon_elements) - write(fates_log(),*) 'reproductive carbon = ', ccohort%prt%GetState(repro_organ,all_carbon_elements) + write(fates_log(),*) 'leaf carbon = ', ccohort%prt%GetState(leaf_organ,carbon12_element) + write(fates_log(),*) 'fineroot carbon = ', ccohort%prt%GetState(fnrt_organ,carbon12_element) + write(fates_log(),*) 'sapwood carbon = ', ccohort%prt%GetState(sapw_organ,carbon12_element) + write(fates_log(),*) 'structural (dead) carbon = ', ccohort%prt%GetState(struct_organ,carbon12_element) + write(fates_log(),*) 'storage carbon = ', ccohort%prt%GetState(store_organ,carbon12_element) + write(fates_log(),*) 'reproductive carbon = ', ccohort%prt%GetState(repro_organ,carbon12_element) write(fates_log(),*) 'co%lai = ', ccohort%lai write(fates_log(),*) 'co%sai = ', ccohort%sai @@ -1116,7 +1109,6 @@ subroutine dump_cohort(ccohort) write(fates_log(),*) 'co%resp_acc_hold = ', ccohort%resp_acc_hold write(fates_log(),*) 'co%rdark = ', ccohort%rdark write(fates_log(),*) 'co%resp_m = ', ccohort%resp_m - write(fates_log(),*) 'co%resp_m_def = ', ccohort%resp_m_def write(fates_log(),*) 'co%resp_g_tstep = ', ccohort%resp_g_tstep write(fates_log(),*) 'co%livestem_mr = ', ccohort%livestem_mr write(fates_log(),*) 'co%livecroot_mr = ', ccohort%livecroot_mr diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 07359802c0..48d0efb3c1 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -62,11 +62,13 @@ module FatesHistoryInterfaceMod use FatesConstantsMod , only : ha_per_m2 use FatesConstantsMod , only : days_per_sec use FatesConstantsMod , only : sec_per_day + use FatesConstantsMod , only : days_per_sec use FatesConstantsMod , only : days_per_year use FatesConstantsMod , only : years_per_day use FatesConstantsMod , only : m2_per_km2 use FatesConstantsMod , only : J_per_kJ use FatesConstantsMod , only : m2_per_ha + use FatesConstantsMod , only : ha_per_m2 use FatesConstantsMod , only : m_per_cm use FatesConstantsMod , only : sec_per_min use FatesConstantsMod , only : umol_per_mol @@ -76,7 +78,6 @@ module FatesHistoryInterfaceMod use PRTGenericMod , only : leaf_organ, fnrt_organ, sapw_organ use PRTGenericMod , only : struct_organ, store_organ, repro_organ - use PRTGenericMod , only : all_carbon_elements use PRTGenericMod , only : carbon12_element use PRTGenericMod , only : nitrogen_element, phosphorus_element use PRTGenericMod , only : prt_carbon_allom_hyp @@ -189,9 +190,9 @@ module FatesHistoryInterfaceMod integer :: ih_l2fr_canopy_scpf integer :: ih_l2fr_understory_scpf - integer,public :: ih_nh4uptake_si - integer,public :: ih_no3uptake_si - integer,public :: ih_puptake_si + integer :: ih_nh4uptake_si + integer :: ih_no3uptake_si + integer :: ih_puptake_si integer :: ih_cefflux_si integer :: ih_nefflux_si integer :: ih_pefflux_si @@ -199,7 +200,8 @@ module FatesHistoryInterfaceMod integer :: ih_ndemand_scpf integer :: ih_pdemand_si integer :: ih_pdemand_scpf - + integer :: ih_nfix_si + integer :: ih_nfix_scpf integer :: ih_trimming_si integer :: ih_area_plant_si @@ -278,6 +280,7 @@ module FatesHistoryInterfaceMod integer :: ih_aresp_si integer :: ih_maint_resp_si integer :: ih_growth_resp_si + integer :: ih_excess_resp_si integer :: ih_ar_canopy_si integer :: ih_gpp_canopy_si integer :: ih_ar_understory_si @@ -692,7 +695,8 @@ module FatesHistoryInterfaceMod procedure :: update_history_dyn procedure :: update_history_hifrq procedure :: update_history_hydraulics - + procedure :: update_history_nutrflux + ! 'get' methods used by external callers to access private read only data procedure :: num_history_vars @@ -752,6 +756,7 @@ module FatesHistoryInterfaceMod procedure, public :: flush_hvars procedure, public :: zero_site_hvars + end type fates_history_interface_type @@ -1738,7 +1743,133 @@ end subroutine init_dim_kinds_maps ! ======================================================================= + subroutine update_history_nutrflux(this,csite,cpatch,ccohort) + + ! Update history diagnostics for nutrient fluxes. + ! This is a separate routine because we like to handle these + ! things before patches are reshuffled during disturbance, and + ! thus this is called immediately after PARTEH allocation + ! These diagnostics must be zero'd at the beginning + ! of the dynamics call (not here, because this is a + ! being called at the cohort level) + + ! Arguments + class(fates_history_interface_type) :: this + type(ed_site_type), intent(in) :: csite + type(ed_patch_type), intent(in) :: cpatch + type(ed_cohort_type), intent(in) :: ccohort + + ! locals + integer :: iscpf ! Size x pft class index + integer :: io_si ! site's global index in the history vector + integer :: el ! element loop index + real(r8):: uconv ! combined unit conversion factor + + ! size class index + iscpf = ccohort%size_by_pft_class + + ! history site index + io_si = csite%h_gid + + ! unit conversion factor to get x/plant/day -> x/m2/sec + uconv = ccohort%n * ha_per_m2 * days_per_sec + + ! Loop over the different elements. + do el = 1, num_elements + + select case (element_list(el)) + case (carbon12_element) + + ! Excess carbon respired + this%hvars(ih_excess_resp_si)%r81d(io_si) = & + this%hvars(ih_excess_resp_si)%r81d(io_si) + & + ccohort%resp_excess*uconv + + ! Efflux/exudation + this%hvars(ih_cefflux_scpf)%r82d(io_si,iscpf) = & + this%hvars(ih_cefflux_scpf)%r82d(io_si,iscpf) + & + ccohort%daily_c_efflux*uconv + + this%hvars(ih_cefflux_si)%r81d(io_si) = & + this%hvars(ih_cefflux_si)%r81d(io_si)+ & + ccohort%daily_c_efflux*uconv + + case (nitrogen_element) + + ! Mineralized uptake of NH4, NO3 + fates_hist%hvars(ih_nh4uptake_scpf)%r82d(io_si,iscpf) = & + fates_hist%hvars(ih_nh4uptake_scpf)%r82d(io_si,iscpf) + & + ccohort%daily_nh4_uptake*uconv + + fates_hist%hvars(ih_no3uptake_scpf)%r82d(io_si,iscpf) = & + fates_hist%hvars(ih_no3uptake_scpf)%r82d(io_si,iscpf) + & + ccohort%daily_no3_uptake*uconv + + fates_hist%hvars(ih_nh4uptake_si)%r81d(io_si) = & + fates_hist%hvars(ih_nh4uptake_si)%r81d(io_si) + & + ccohort%daily_nh4_uptake*uconv + + fates_hist%hvars(ih_no3uptake_si)%r81d(io_si) = & + fates_hist%hvars(ih_no3uptake_si)%r81d(io_si) + & + ccohort%daily_no3_uptake*uconv + + ! Symbiotic Fixation + fates_hist%hvars(ih_nfix_si)%r81d(io_si) = & + fates_hist%hvars(ih_nfix_si)%r81d(io_si) + & + ccohort%daily_n_fixation*uconv + + fates_hist%hvars(ih_nfix_scpf)%r82d(io_si,iscpf) = & + fates_hist%hvars(ih_nfix_scpf)%r82d(io_si,iscpf) + & + ccohort%daily_n_fixation*uconv + + ! Efflux/exudation + this%hvars(ih_nefflux_scpf)%r82d(io_si,iscpf) = & + this%hvars(ih_nefflux_scpf)%r82d(io_si,iscpf) + & + ccohort%daily_n_efflux*uconv + + this%hvars(ih_nefflux_si)%r81d(io_si) = & + this%hvars(ih_nefflux_si)%r81d(io_si) + & + ccohort%daily_n_efflux*uconv + + ! Demand + this%hvars(ih_ndemand_scpf)%r82d(io_si,iscpf) = & + this%hvars(ih_ndemand_scpf)%r82d(io_si,iscpf) + & + ccohort%daily_n_demand*uconv + + this%hvars(ih_ndemand_si)%r81d(io_si) = & + this%hvars(ih_ndemand_si)%r81d(io_si) + & + ccohort%daily_n_demand*uconv + + case (phosphorus_element) + + fates_hist%hvars(ih_puptake_scpf)%r82d(io_si,iscpf) = & + fates_hist%hvars(ih_puptake_scpf)%r82d(io_si,iscpf) + & + ccohort%daily_p_uptake*uconv + fates_hist%hvars(ih_puptake_si)%r81d(io_si) = & + fates_hist%hvars(ih_puptake_si)%r81d(io_si) + & + ccohort%daily_p_uptake*uconv + + this%hvars(ih_pefflux_scpf)%r82d(io_si,iscpf) = & + this%hvars(ih_pefflux_scpf)%r82d(io_si,iscpf) + & + ccohort%daily_p_efflux*uconv + + this%hvars(ih_pefflux_si)%r81d(io_si) = & + this%hvars(ih_pefflux_si)%r81d(io_si) + & + ccohort%daily_p_efflux*uconv + + this%hvars(ih_pdemand_scpf)%r82d(io_si,iscpf) = & + this%hvars(ih_pdemand_scpf)%r82d(io_si,iscpf) + & + ccohort%daily_p_demand*uconv + + this%hvars(ih_pdemand_si)%r81d(io_si) = & + ccohort%daily_p_demand*uconv + end select + end do + return + end subroutine update_history_nutrflux + + ! ==================================================================================== @@ -3049,7 +3180,9 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) end do patchloop !patch loop ! Normalize the l2fr value by total biomass - hio_l2fr_si(io_si) = hio_l2fr_si(io_si)/this%hvars(ih_fnrtc_si)%r81d(io_si) + if(this%hvars(ih_fnrtc_si)%r81d(io_si)>nearzero)then + hio_l2fr_si(io_si) = hio_l2fr_si(io_si)/this%hvars(ih_fnrtc_si)%r81d(io_si) + end if !!hio_l2fr_ema_si(io_si) = hio_l2fr_ema_si(io_si)/this%hvars(ih_fnrtc_si)%r81d(io_si) @@ -3287,13 +3420,7 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) this%hvars(ih_storec_scpf)%r82d(io_si,:) = 0._r8 this%hvars(ih_reproc_scpf)%r82d(io_si,:) = 0._r8 - this%hvars(ih_cefflux_scpf)%r82d(io_si,:) = & - sites(s)%flux_diags(el)%nutrient_efflux_scpf(:) / & - m2_per_ha / sec_per_day - this%hvars(ih_cefflux_si)%r81d(io_si) = & - sum(sites(s)%flux_diags(el)%nutrient_efflux_scpf(:),dim=1) / & - m2_per_ha / sec_per_day elseif(element_list(el).eq.nitrogen_element)then @@ -3304,21 +3431,7 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) this%hvars(ih_storen_scpf)%r82d(io_si,:) = 0._r8 this%hvars(ih_repron_scpf)%r82d(io_si,:) = 0._r8 - this%hvars(ih_nefflux_scpf)%r82d(io_si,:) = & - sites(s)%flux_diags(el)%nutrient_efflux_scpf(:) / & - m2_per_ha / sec_per_day - - this%hvars(ih_ndemand_scpf)%r82d(io_si,:) = & - sites(s)%flux_diags(el)%nutrient_demand_scpf(:) / & - m2_per_ha / sec_per_day - - this%hvars(ih_nefflux_si)%r81d(io_si) = & - sum(sites(s)%flux_diags(el)%nutrient_efflux_scpf(:),dim=1) / & - m2_per_ha / sec_per_day - - this%hvars(ih_ndemand_si)%r81d(io_si) = & - sum(sites(s)%flux_diags(el)%nutrient_demand_scpf(:),dim=1) / & - m2_per_ha / sec_per_day + elseif(element_list(el).eq.phosphorus_element)then this%hvars(ih_totvegp_scpf)%r82d(io_si,:) = 0._r8 @@ -3328,21 +3441,7 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) this%hvars(ih_storep_scpf)%r82d(io_si,:) = 0._r8 this%hvars(ih_reprop_scpf)%r82d(io_si,:) = 0._r8 - this%hvars(ih_pdemand_scpf)%r82d(io_si,:) = & - sites(s)%flux_diags(el)%nutrient_demand_scpf(:) / & - m2_per_ha / sec_per_day - - this%hvars(ih_pefflux_scpf)%r82d(io_si,:) = & - sites(s)%flux_diags(el)%nutrient_efflux_scpf(:) / & - m2_per_ha / sec_per_day - - this%hvars(ih_pdemand_si)%r81d(io_si) = & - sum(sites(s)%flux_diags(el)%nutrient_demand_scpf(:),dim=1) / & - m2_per_ha / sec_per_day - - this%hvars(ih_pefflux_si)%r81d(io_si) = & - sum(sites(s)%flux_diags(el)%nutrient_efflux_scpf(:),dim=1) / & - m2_per_ha / sec_per_day + end if @@ -4489,6 +4588,9 @@ subroutine define_history_vars(this, initialize_variables) ! cohort size x pft (site_size_pft_r8) : SZPF + + + ! Site level counting variables call this%set_history_var(vname='FATES_NPATCHES', units='', & @@ -4921,7 +5023,7 @@ subroutine define_history_vars(this, initialize_variables) index = ih_litter_in_si) call this%set_history_var(vname='FATES_LITTER_OUT', units='kg m-2 s-1', & - long='litter flux out in kg carbon (fragmentation AND seed decay)', & + long='litter flux out in kg carbon (exudation, fragmentation, seed decay)', & use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & upfreq=1, ivar=ivar, initialize=initialize_variables, & index = ih_litter_out_si) @@ -4945,7 +5047,7 @@ subroutine define_history_vars(this, initialize_variables) index = ih_litter_in_elem) call this%set_history_var(vname='FATES_LITTER_OUT_EL', units='kg m-2 s-1', & - long='litter flux out (fragmentation and seed decay) in kg element', & + long='litter flux out (exudation, fragmentation and seed decay) in kg element', & use_default='active', avgflag='A', vtype=site_elem_r8, & hlms='CLM:ALM', upfreq=1, ivar=ivar, initialize=initialize_variables, & index = ih_litter_out_elem) @@ -5032,7 +5134,7 @@ subroutine define_history_vars(this, initialize_variables) call this%set_history_var(vname='FATES_CEFFLUX', units='kg m-2 s-1', & long='carbon efflux, root to soil, in kg carbon per m2 per second', & use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & - upfreq=1, ivar=ivar, initialize=initialize_variables, & + upfreq=5, ivar=ivar, initialize=initialize_variables, & index = ih_cefflux_si) @@ -5077,27 +5179,34 @@ subroutine define_history_vars(this, initialize_variables) call this%set_history_var(vname='FATES_NH4UPTAKE', units='kg m-2 s-1', & long='ammonium uptake rate by plants in kg NH4 per m2 per second', & use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & - upfreq=1, ivar=ivar, initialize=initialize_variables, & + upfreq=5, ivar=ivar, initialize=initialize_variables, & index = ih_nh4uptake_si) call this%set_history_var(vname='FATES_NO3UPTAKE', units='kg m-2 s-1', & long='nitrate uptake rate by plants in kg NO3 per m2 per second', & use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & - upfreq=1, ivar=ivar, initialize=initialize_variables, & + upfreq=5, ivar=ivar, initialize=initialize_variables, & index = ih_no3uptake_si) call this%set_history_var(vname='FATES_NEFFLUX', units='kg m-2 s-1', & long='nitrogen effluxed from plant in kg N per m2 per second (unused)', & use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & - upfreq=1, ivar=ivar, initialize=initialize_variables, & + upfreq=5, ivar=ivar, initialize=initialize_variables, & index = ih_nefflux_si) call this%set_history_var(vname='FATES_NDEMAND', units='kg m-2 s-1', & long='plant nitrogen need (algorithm dependent) in kg N per m2 per second', & use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & - upfreq=1, ivar=ivar, initialize=initialize_variables, & + upfreq=5, ivar=ivar, initialize=initialize_variables, & index = ih_ndemand_si) + call this%set_history_var(vname='FATES_SYMNFIX', units='kg m-2 s-1', & + long='symbiotic dinitrogen fixation in kg N per m2 per second', & + use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & + upfreq=5, ivar=ivar, initialize=initialize_variables, & + index = ih_nfix_si) + + end if nitrogen_active_if @@ -5145,19 +5254,19 @@ subroutine define_history_vars(this, initialize_variables) call this%set_history_var(vname='FATES_PUPTAKE', units='kg m-2 s-1', & long='mineralized phosphorus uptake rate of plants in kg P per m2 per second', & use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & - upfreq=1, ivar=ivar, initialize=initialize_variables, & + upfreq=5, ivar=ivar, initialize=initialize_variables, & index = ih_puptake_si) call this%set_history_var(vname='FATES_PEFFLUX', units='kg m-2 s-1', & long='phosphorus effluxed from plant in kg P per m2 per second (unused)', & use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & - upfreq=1, ivar=ivar, initialize=initialize_variables, & + upfreq=5, ivar=ivar, initialize=initialize_variables, & index = ih_pefflux_si) call this%set_history_var(vname='FATES_PDEMAND', units='kg m-2 s-1', & long='plant phosphorus need (algorithm dependent) in kg P per m2 per second', & use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & - upfreq=1, ivar=ivar, initialize=initialize_variables, & + upfreq=5, ivar=ivar, initialize=initialize_variables, & index = ih_pdemand_si) end if phosphorus_active_if @@ -5318,6 +5427,12 @@ subroutine define_history_vars(this, initialize_variables) upfreq=2, ivar=ivar, initialize=initialize_variables, & index = ih_maint_resp_si) + call this%set_history_var(vname='FATES_EXCESS_RESP', units='kg m-2 s-1', & + long='respiration of un-allocatable carbon gain', & + use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & + upfreq=5, ivar=ivar, initialize=initialize_variables, & + index = ih_excess_resp_si) + ! Canopy resistance call this%set_history_var(vname='FATES_STOMATAL_COND_AP', & @@ -6716,7 +6831,7 @@ subroutine define_history_vars(this, initialize_variables) call this%set_history_var(vname='FATES_CEFFLUX_SZPF', units='kg m-2 s-1', & long='carbon efflux, root to soil, by size-class x pft in kg carbon per m2 per second', & use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & - hlms='CLM:ALM', upfreq=1, ivar=ivar, initialize=initialize_variables, & + hlms='CLM:ALM', upfreq=5, ivar=ivar, initialize=initialize_variables, & index = ih_cefflux_scpf) ! NITROGEN @@ -6778,28 +6893,35 @@ subroutine define_history_vars(this, initialize_variables) units='kg m-2 s-1', & long='ammonium uptake rate by plants by size-class x pft in kg NH4 per m2 per second', & use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & - hlms='CLM:ALM', upfreq=1, ivar=ivar, & + hlms='CLM:ALM', upfreq=5, ivar=ivar, & initialize=initialize_variables, index = ih_nh4uptake_scpf) call this%set_history_var(vname='FATES_NO3UPTAKE_SZPF', & units='kg m-2 s-1', & long='nitrate uptake rate by plants by size-class x pft in kg NO3 per m2 per second', & use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & - hlms='CLM:ALM', upfreq=1, ivar=ivar, & + hlms='CLM:ALM', upfreq=5, ivar=ivar, & initialize=initialize_variables, index = ih_no3uptake_scpf) call this%set_history_var(vname='FATES_NEFFLUX_SZPF', units='kg m-2 s-1', & long='nitrogen efflux, root to soil, by size-class x pft in kg N per m2 per second', & use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & - hlms='CLM:ALM', upfreq=1, ivar=ivar, & + hlms='CLM:ALM', upfreq=5, ivar=ivar, & initialize=initialize_variables, index = ih_nefflux_scpf) call this%set_history_var(vname='FATES_NDEMAND_SZPF', units='kg m-2 s-1', & long='plant N need (algorithm dependent), by size-class x pft in kg N per m2 per second', & use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & - hlms='CLM:ALM', upfreq=1, ivar=ivar, & + hlms='CLM:ALM', upfreq=5, ivar=ivar, & initialize=initialize_variables, index = ih_ndemand_scpf) + call this%set_history_var(vname='FATES_SYMNFIX_SZPF', units='kg m-2 s-1', & + long='symbiotic dinitrogen fixation, by size-class x pft in kg N per m2 per second', & + use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & + hlms='CLM:ALM', upfreq=5, ivar=ivar, & + initialize=initialize_variables, index = ih_nfix_scpf) + + end if nitrogen_active_if2 ! PHOSPHORUS @@ -6860,20 +6982,20 @@ subroutine define_history_vars(this, initialize_variables) units='kg m-2 s-1', & long='phosphorus uptake rate by plants, by size-class x pft in kg P per m2 per second', & use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & - hlms='CLM:ALM', upfreq=1, ivar=ivar, & + hlms='CLM:ALM', upfreq=5, ivar=ivar, & initialize=initialize_variables, index = ih_puptake_scpf) call this%set_history_var(vname='FATES_PEFFLUX_SZPF', & units='kg m-2 s-1', & long='phosphorus efflux, root to soil, by size-class x pft in kg P per m2 per second', & use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & - hlms='CLM:ALM', upfreq=1, ivar=ivar, & + hlms='CLM:ALM', upfreq=5, ivar=ivar, & initialize=initialize_variables, index = ih_pefflux_scpf) call this%set_history_var(vname='FATES_PDEMAND_SZPF', units='kg m-2 s-1', & long='plant P need (algorithm dependent), by size-class x pft in kg P per m2 per second', & use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & - hlms='CLM:ALM', upfreq=1, ivar=ivar, & + hlms='CLM:ALM', upfreq=5, ivar=ivar, & initialize=initialize_variables, index = ih_pdemand_scpf) end if phosphorus_active_if2 diff --git a/main/FatesRestartInterfaceMod.F90 b/main/FatesRestartInterfaceMod.F90 index eb93ab70cc..23787241bb 100644 --- a/main/FatesRestartInterfaceMod.F90 +++ b/main/FatesRestartInterfaceMod.F90 @@ -111,7 +111,7 @@ module FatesRestartInterfaceMod integer :: ir_gpp_acc_hold_co integer :: ir_npp_acc_hold_co integer :: ir_resp_acc_hold_co - integer :: ir_resp_m_def_co + integer :: ir_resp_excess_co integer :: ir_bmort_co integer :: ir_hmort_co integer :: ir_cmort_co @@ -125,10 +125,8 @@ module FatesRestartInterfaceMod integer :: ir_daily_nh4_uptake_co integer :: ir_daily_no3_uptake_co + integer :: ir_daily_n_fixation_co integer :: ir_daily_p_uptake_co - integer :: ir_daily_c_efflux_co - integer :: ir_daily_n_efflux_co - integer :: ir_daily_p_efflux_co integer :: ir_daily_n_demand_co integer :: ir_daily_p_demand_co @@ -214,8 +212,6 @@ module FatesRestartInterfaceMod integer :: ir_cwdbgin_flxdg integer :: ir_leaflittin_flxdg integer :: ir_rootlittin_flxdg - integer :: ir_efflux_flxdg - integer :: ir_uptake_flxdg integer :: ir_oldstock_mbal integer :: ir_errfates_mbal integer :: ir_prt_base ! Base index for all PRT variables @@ -767,10 +763,10 @@ subroutine define_restart_vars(this, initialize_variables) units='kgC/indiv/year', flushval = flushzero, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_resp_acc_hold_co ) - call this%set_restart_var(vname='fates_resp_m_def', vtype=cohort_r8, & + call this%set_restart_var(vname='fates_resp_excess', vtype=cohort_r8, & long_name='ed cohort - maintenance respiration deficit', & units='kgC/indiv', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_resp_m_def_co ) + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_resp_excess_co ) call this%set_restart_var(vname='fates_bmort', vtype=cohort_r8, & long_name='ed cohort - background mortality rate', & @@ -797,26 +793,16 @@ subroutine define_restart_vars(this, initialize_variables) units='kg/plant/day', flushval = flushzero, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_daily_no3_uptake_co ) + call this%set_restart_var(vname='fates_daily_n_fixation', vtype=cohort_r8, & + long_name='fates cohort- daily N symbiotic fixation', & + units='kg/plant/day', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_daily_n_fixation_co ) + call this%set_restart_var(vname='fates_daily_p_uptake', vtype=cohort_r8, & long_name='fates cohort- daily phosphorus uptake', & units='kg/plant/day', flushval = flushzero, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_daily_p_uptake_co ) - call this%set_restart_var(vname='fates_daily_c_efflux', vtype=cohort_r8, & - long_name='fates cohort- daily carbon efflux', & - units='kg/plant/day', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_daily_c_efflux_co ) - - call this%set_restart_var(vname='fates_daily_n_efflux', vtype=cohort_r8, & - long_name='fates cohort- daily nitrogen efflux', & - units='kg/plant/day', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_daily_n_efflux_co ) - - call this%set_restart_var(vname='fates_daily_p_efflux', vtype=cohort_r8, & - long_name='fates cohort- daily phosphorus efflux', & - units='kg/plant/day', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_daily_p_efflux_co ) - call this%set_restart_var(vname='fates_daily_p_demand', vtype=cohort_r8, & long_name='fates cohort- daily phosphorus demand', & units='kgP/plant/day', flushval = flushzero, & @@ -1027,17 +1013,6 @@ subroutine define_restart_vars(this, initialize_variables) units='kg/ha', veclength=num_elements, flushval = flushzero, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_rootlittin_flxdg) - call this%RegisterCohortVector(symbol_base='fates_efflux_scpf', vtype=cohort_r8, & - long_name_base='Efflux from plants to soil through roots', & - units='kg/day/ha', veclength=num_elements, flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_efflux_flxdg) - - call this%RegisterCohortVector(symbol_base='fates_uptake_scpf', vtype=cohort_r8, & - long_name_base='Daily uptake for plants through roots', & - units='kg/day/ha', veclength=num_elements, flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_uptake_flxdg) - - ! Site level Mass Balance State Accounting call this%RegisterCohortVector(symbol_base='fates_oldstock', vtype=site_r8, & @@ -1773,16 +1748,14 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_gpp_acc_hold_co => this%rvars(ir_gpp_acc_hold_co)%r81d, & rio_resp_acc_hold_co => this%rvars(ir_resp_acc_hold_co)%r81d, & rio_npp_acc_hold_co => this%rvars(ir_npp_acc_hold_co)%r81d, & - rio_resp_m_def_co => this%rvars(ir_resp_m_def_co)%r81d, & + rio_resp_excess_co => this%rvars(ir_resp_excess_co)%r81d, & rio_bmort_co => this%rvars(ir_bmort_co)%r81d, & rio_hmort_co => this%rvars(ir_hmort_co)%r81d, & rio_cmort_co => this%rvars(ir_cmort_co)%r81d, & rio_daily_nh4_uptake_co => this%rvars(ir_daily_nh4_uptake_co)%r81d, & rio_daily_no3_uptake_co => this%rvars(ir_daily_no3_uptake_co)%r81d, & + rio_daily_n_fixation_co => this%rvars(ir_daily_n_fixation_co)%r81d, & rio_daily_p_uptake_co => this%rvars(ir_daily_p_uptake_co)%r81d, & - rio_daily_c_efflux_co => this%rvars(ir_daily_c_efflux_co)%r81d, & - rio_daily_n_efflux_co => this%rvars(ir_daily_n_efflux_co)%r81d, & - rio_daily_p_efflux_co => this%rvars(ir_daily_p_efflux_co)%r81d, & rio_daily_n_demand_co => this%rvars(ir_daily_n_demand_co)%r81d, & rio_daily_p_demand_co => this%rvars(ir_daily_p_demand_co)%r81d, & rio_smort_co => this%rvars(ir_smort_co)%r81d, & @@ -1890,17 +1863,6 @@ subroutine set_restart_vectors(this,nc,nsites,sites) io_idx_si_pft = io_idx_si_pft + 1 end do - iscpf = 1 - do i_scls = 1, nlevsclass - do i_pft = 1, numpft - this%rvars(ir_efflux_flxdg+el-1)%r81d(io_idx_si_scpf) = sites(s)%flux_diags(el)%nutrient_efflux_scpf(iscpf) - this%rvars(ir_uptake_flxdg+el-1)%r81d(io_idx_si_scpf) = sites(s)%flux_diags(el)%nutrient_uptake_scpf(iscpf) - iscpf = iscpf + 1 - io_idx_si_scpf = io_idx_si_scpf + 1 - end do - end do - - this%rvars(ir_oldstock_mbal+el-1)%r81d(io_idx_si) = sites(s)%mass_balance(el)%old_stock this%rvars(ir_errfates_mbal+el-1)%r81d(io_idx_si) = sites(s)%mass_balance(el)%err_fates @@ -2003,7 +1965,7 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_resp_acc_hold_co(io_idx_co) = ccohort%resp_acc_hold rio_npp_acc_hold_co(io_idx_co) = ccohort%npp_acc_hold - rio_resp_m_def_co(io_idx_co) = ccohort%resp_m_def + rio_resp_excess_co(io_idx_co) = ccohort%resp_excess rio_bmort_co(io_idx_co) = ccohort%bmort rio_hmort_co(io_idx_co) = ccohort%hmort @@ -2016,11 +1978,8 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_daily_no3_uptake_co(io_idx_co) = ccohort%daily_no3_uptake rio_daily_nh4_uptake_co(io_idx_co) = ccohort%daily_nh4_uptake rio_daily_p_uptake_co(io_idx_co) = ccohort%daily_p_uptake - - rio_daily_c_efflux_co(io_idx_co) = ccohort%daily_c_efflux - rio_daily_n_efflux_co(io_idx_co) = ccohort%daily_n_efflux - rio_daily_p_efflux_co(io_idx_co) = ccohort%daily_p_efflux - + rio_daily_n_fixation_co(io_idx_co) = ccohort%daily_n_fixation + rio_daily_n_demand_co(io_idx_co) = ccohort%daily_n_demand rio_daily_p_demand_co(io_idx_co) = ccohort%daily_p_demand @@ -2602,16 +2561,14 @@ subroutine get_restart_vectors(this, nc, nsites, sites) rio_gpp_acc_hold_co => this%rvars(ir_gpp_acc_hold_co)%r81d, & rio_resp_acc_hold_co => this%rvars(ir_resp_acc_hold_co)%r81d, & rio_npp_acc_hold_co => this%rvars(ir_npp_acc_hold_co)%r81d, & - rio_resp_m_def_co => this%rvars(ir_resp_m_def_co)%r81d, & + rio_resp_excess_co => this%rvars(ir_resp_excess_co)%r81d, & rio_bmort_co => this%rvars(ir_bmort_co)%r81d, & rio_hmort_co => this%rvars(ir_hmort_co)%r81d, & rio_cmort_co => this%rvars(ir_cmort_co)%r81d, & rio_daily_nh4_uptake_co => this%rvars(ir_daily_nh4_uptake_co)%r81d, & rio_daily_no3_uptake_co => this%rvars(ir_daily_no3_uptake_co)%r81d, & + rio_daily_n_fixation_co => this%rvars(ir_daily_n_fixation_co)%r81d, & rio_daily_p_uptake_co => this%rvars(ir_daily_p_uptake_co)%r81d, & - rio_daily_c_efflux_co => this%rvars(ir_daily_c_efflux_co)%r81d, & - rio_daily_n_efflux_co => this%rvars(ir_daily_n_efflux_co)%r81d, & - rio_daily_p_efflux_co => this%rvars(ir_daily_p_efflux_co)%r81d, & rio_daily_n_demand_co => this%rvars(ir_daily_n_demand_co)%r81d, & rio_daily_p_demand_co => this%rvars(ir_daily_p_demand_co)%r81d, & rio_smort_co => this%rvars(ir_smort_co)%r81d, & @@ -2709,17 +2666,6 @@ subroutine get_restart_vectors(this, nc, nsites, sites) io_idx_si_pft = io_idx_si_pft + 1 end do - iscpf = 1 - do i_scls = 1, nlevsclass - do i_pft = 1, numpft - sites(s)%flux_diags(el)%nutrient_efflux_scpf(iscpf) = this%rvars(ir_efflux_flxdg+el-1)%r81d(io_idx_si_scpf) - sites(s)%flux_diags(el)%nutrient_uptake_scpf(iscpf) = this%rvars(ir_uptake_flxdg+el-1)%r81d(io_idx_si_scpf) - iscpf = iscpf + 1 - io_idx_si_scpf = io_idx_si_scpf + 1 - end do - end do - - sites(s)%mass_balance(el)%old_stock = this%rvars(ir_oldstock_mbal+el-1)%r81d(io_idx_si) sites(s)%mass_balance(el)%err_fates = this%rvars(ir_errfates_mbal+el-1)%r81d(io_idx_si) @@ -2803,7 +2749,7 @@ subroutine get_restart_vectors(this, nc, nsites, sites) ccohort%gpp_acc_hold = rio_gpp_acc_hold_co(io_idx_co) ccohort%resp_acc_hold = rio_resp_acc_hold_co(io_idx_co) ccohort%npp_acc_hold = rio_npp_acc_hold_co(io_idx_co) - ccohort%resp_m_def = rio_resp_m_def_co(io_idx_co) + ccohort%resp_excess = rio_resp_excess_co(io_idx_co) ccohort%bmort = rio_bmort_co(io_idx_co) ccohort%hmort = rio_hmort_co(io_idx_co) @@ -2815,10 +2761,8 @@ subroutine get_restart_vectors(this, nc, nsites, sites) ! Nutrient uptake / efflux ccohort%daily_nh4_uptake = rio_daily_nh4_uptake_co(io_idx_co) ccohort%daily_no3_uptake = rio_daily_no3_uptake_co(io_idx_co) + ccohort%daily_n_fixation = rio_daily_n_fixation_co(io_idx_co) ccohort%daily_p_uptake = rio_daily_p_uptake_co(io_idx_co) - ccohort%daily_c_efflux = rio_daily_c_efflux_co(io_idx_co) - ccohort%daily_n_efflux = rio_daily_n_efflux_co(io_idx_co) - ccohort%daily_p_efflux = rio_daily_p_efflux_co(io_idx_co) ccohort%daily_n_demand = rio_daily_n_demand_co(io_idx_co) ccohort%daily_p_demand = rio_daily_p_demand_co(io_idx_co) diff --git a/parteh/PRTAllometricCNPMod.F90 b/parteh/PRTAllometricCNPMod.F90 index 2e79fe93b6..2392f42f46 100644 --- a/parteh/PRTAllometricCNPMod.F90 +++ b/parteh/PRTAllometricCNPMod.F90 @@ -25,7 +25,7 @@ module PRTAllometricCNPMod use PRTGenericMod , only : store_organ use PRTGenericMod , only : repro_organ use PRTGenericMod , only : struct_organ - use PRTGenericMod , only : all_organs + use PRTGenericMod , only : num_organ_types use PRTGenericMod , only : prt_cnp_flex_allom_hyp use PRTGenericMod , only : StorageNutrientTarget @@ -108,9 +108,11 @@ module PRTAllometricCNPMod integer, parameter :: num_organs = 6 ! Converting from local to global organ id - integer, parameter,dimension(num_organs) :: organ_list = & + integer, parameter,dimension(num_organs) :: l2g_organ_list = & [leaf_organ, fnrt_organ, sapw_organ, store_organ, repro_organ, struct_organ] + + ! These are local indices associated with organs and quantities ! that can be integrated (namely, growth respiration during stature growth ! and dbh) @@ -136,8 +138,7 @@ module PRTAllometricCNPMod integer, public, parameter :: acnp_bc_inout_id_dbh = 1 ! Plant DBH - integer, public, parameter :: acnp_bc_inout_id_rmaint_def = 2 ! Index for any accumulated - ! maintenance respiration deficit + integer, public, parameter :: acnp_bc_inout_id_resp_excess = 2 ! Respiration of excess storage integer, public, parameter :: acnp_bc_inout_id_l2fr = 3 ! leaf 2 fineroot scalar, this ! is dynamic with CNP integer, public, parameter :: num_bc_inout = 3 @@ -150,15 +151,11 @@ module PRTAllometricCNPMod integer, public, parameter :: acnp_bc_in_id_ctrim = 2 ! Index for the canopy trim function integer, public, parameter :: acnp_bc_in_id_lstat = 3 ! phenology status logical integer, public, parameter :: acnp_bc_in_id_netdc = 4 ! Index for the net daily C input BC - integer, public, parameter :: acnp_bc_in_id_netdnh4 = 5 ! Index for the net daily NH4 input BC - integer, public, parameter :: acnp_bc_in_id_netdno3 = 6 ! Index for the net daily NO3 input BC - integer, public, parameter :: acnp_bc_in_id_netdp = 7 ! Index for the net daily P input BC - !integer, public, parameter :: acnp_bc_in_id_l2fr_ema = 7 ! Index for the moving average ema - !integer, public, parameter :: acnp_bc_in_id_ncs_ema = 9 ! Index for N/C storage ratio (EMA) - !integer, public, parameter :: acnp_bc_in_id_pcs_ema = 10 ! Index for P/C storage ratio (EMA) + integer, public, parameter :: acnp_bc_in_id_netdn = 5 ! Index for the net daily NH4 input BC + integer, public, parameter :: acnp_bc_in_id_netdp = 6 ! Index for the net daily P input BC ! 0=leaf off, 1=leaf on - integer, parameter :: num_bc_in = 7 + integer, parameter :: num_bc_in = 6 ! ------------------------------------------------------------------------------------- ! Output Boundary Indices (These are public) @@ -184,29 +181,24 @@ module PRTAllometricCNPMod integer, parameter :: icd = 1 - real(r8), parameter :: store_overflow_frac = 0.15 ! The fraction above target allowed in storage - - logical, parameter :: force_store_c_overflow = .true. + real(r8), parameter :: store_overflow_frac = 1.0_r8 ! The fraction above target allowed in storage - ! User may want to attempt matching results with the - ! C-only allocation module. If so, then set reproduce_conly - ! and make sure both fnrt and leaf are set to the highest - ! priority order, sapwood and storage are set to the - ! second highest, and then structure is last. When this is - ! flagged as true, it changes the logic in the first allocation - ! phase, to give first dibs to leaves, even though they are - ! in the same priority group as fineroots. - - logical, parameter :: reproduce_conly = .false. + integer, parameter :: exude_c_store_overflow = 1 + integer, parameter :: retain_c_store_overflow = 2 + integer, parameter :: burn_c_store_overflow = 3 + + integer, parameter :: store_c_overflow = burn_c_store_overflow + ! Following growth, if desired, you can prioritize reproductive + logical, parameter :: prioritize_repro_nutr_growth = .false. + ! Definitions for the regulation functions. These typically translate ! a storage fraction into a scalar used to regulate resources somehow - integer, parameter :: regulate_linear = 1 - integer, parameter :: regulate_logi = 2 - integer, parameter :: regulate_CN_logi = 3 + integer, parameter :: regulate_linear = 1 ! DEPRECATED + integer, parameter :: regulate_logi = 2 ! DEPRECATED + integer, parameter :: regulate_CN_logi = 3 ! almost deprecated integer, parameter :: regulate_CN_dfdd = 4 - integer, parameter :: regulate_CN_ema = 5 real(r8), public, parameter :: fnrt_adapt_tscl = 100._r8 ! Fine-root adaptation timescale (days) @@ -214,14 +206,6 @@ module PRTAllometricCNPMod ! for a doubling or halving of the l2fr - - - ! Array of pointers are difficult in F90 - ! This structure is a necessary intermediate - type :: parray_type - real(r8), pointer :: ptr - end type parray_type - ! ------------------------------------------------------------------------------------- ! This is the core type that holds this specific ! plant reactive transport (PRT) module @@ -258,7 +242,7 @@ module PRTAllometricCNPMod class(prt_global_type), public, target, allocatable :: prt_global_acnp character(len=*), parameter, private :: sourcefile = __FILE__ - logical, parameter :: debug = .false. + logical, parameter :: debug = .true. public :: InitPRTGlobalAllometricCNP @@ -349,7 +333,7 @@ subroutine DailyPRTAllometricCNP(this) ! Pointers to in-out bcs real(r8),pointer :: dbh ! Diameter at breast height [cm] - real(r8),pointer :: maint_r_def ! Current maintenance respiration deficit [kgC] + real(r8),pointer :: resp_excess ! Respiration of any un-allocatable C real(r8),pointer :: l2fr ! Leaf to fineroot ratio of target biomass ! Input only bcs @@ -358,36 +342,28 @@ subroutine DailyPRTAllometricCNP(this) real(r8) :: n_gain ! Daily nitrogen uptake through fine-roots [kgN] real(r8) :: p_gain ! Daily phosphorus uptake through fine-roots [kgN] real(r8) :: canopy_trim ! The canopy trimming function [0-1] - !real(r8) :: l2fr_ema ! Mean (EMA) l2fr ! Pointers to output bcs real(r8),pointer :: c_efflux ! Total plant efflux of carbon (kgC) real(r8),pointer :: n_efflux ! Total plant efflux of nitrogen (kgN) real(r8),pointer :: p_efflux ! Total plant efflux of phosphorus (kgP) - real(r8),pointer :: growth_r ! Total plant growth respiration this step (kgC) - ! These are pointers to the state variables, rearranged in organ dimensioned - ! arrays. This is useful because we loop through organs so often - type(parray_type),pointer :: state_c(:) ! State array for carbon, by organ [kg] - type(parray_type),pointer :: state_n(:) ! State array for N, by organ [kg] - type(parray_type),pointer :: state_p(:) ! State array for P, by organ [kg] + ! Allometry targets (kg/plant) and (kg/cm/plant) + real(r8), dimension(num_organ_types) :: target_c, target_dcdd + ! Initial states (for accounting) (kg/plant) + real(r8), dimension(num_organ_types) :: state_c0, state_n0, state_p0 + ! Allometry partial targets + real(r8) :: agw_c_target,agw_dcdd_target + real(r8) :: bgw_c_target,bgw_dcdd_target + real(r8) :: sapw_area + integer :: i ! generic organ loop index integer :: i_org ! organ index integer :: i_var ! variable index ! Agruments for allometry functions, that are not in the target_c array - real(r8) :: agw_c_target,agw_dcdd_target - real(r8) :: bgw_c_target,bgw_dcdd_target - real(r8) :: sapw_area - integer :: cnp_limiter + real(r8) :: max_store_n - ! These arrays hold various support variables dimensioned by organ - ! Zero suffix indicates the initial state values at the beginning of the routine - ! _unl suffix indicates values used for tracking nutrient need (ie unlimited) - ! target is the target masses associated with the plant stature, and - ! also the derivative of c wrt diameter at current diameter - real(r8), dimension(num_organs) :: target_c, target_dcdd - real(r8), dimension(num_organs) :: state_c0, state_n0, state_p0 ! These are daily mass gains, frozen in time, not drawn from, and thus ! these are only used for evaluating mass balancing at the end @@ -395,7 +371,7 @@ subroutine DailyPRTAllometricCNP(this) real(r8) :: c_gain0 real(r8) :: n_gain0 real(r8) :: p_gain0 - real(r8) :: maint_r_def0 + real(r8) :: resp_excess0 ! Used for mass checking, total mass allocated based ! on change in the states, should match gain0's @@ -406,18 +382,18 @@ subroutine DailyPRTAllometricCNP(this) real(r8) :: sum_c ! error checking sum - - ! =================================================================================== - ! Step 1: Evaluate nutrient storage in the plant. Depending on how low - ! these stores are, we will move proportionally more or less of the daily carbon - ! gain to increase the target fine-root biomass, fill up to target - ! and then attempt to get them up to stoichiometry targets. - ! =================================================================================== - - ! This routine actually just updates the l2fr variable - call this%CNPAdjustFRootTargets() + ! If more than 1 leaf age bin is present, this + ! call advances leaves in their age, but does + ! not actually remove any biomass from the plant + + call this%AgeLeaves(ipft,sec_per_day) + ! In/out boundary conditions + resp_excess => this%bc_inout(acnp_bc_inout_id_resp_excess)%rval; resp_excess0 = resp_excess + dbh => this%bc_inout(acnp_bc_inout_id_dbh)%rval; dbh0 = dbh + l2fr => this%bc_inout(acnp_bc_inout_id_l2fr)%rval + ! integrator variables ! Copy the input only boundary conditions into readable local variables @@ -426,85 +402,75 @@ subroutine DailyPRTAllometricCNP(this) ! for checking and resetting if needed ! ----------------------------------------------------------------------------------- c_gain = this%bc_in(acnp_bc_in_id_netdc)%rval; c_gain0 = c_gain - n_gain = this%bc_in(acnp_bc_in_id_netdnh4)%rval + & - this%bc_in(acnp_bc_in_id_netdno3)%rval - n_gain0 = n_gain + n_gain = this%bc_in(acnp_bc_in_id_netdn)%rval; n_gain0 = n_gain p_gain = this%bc_in(acnp_bc_in_id_netdp)%rval; p_gain0 = p_gain canopy_trim = this%bc_in(acnp_bc_in_id_ctrim)%rval ipft = this%bc_in(acnp_bc_in_id_pft)%ival + ! Calculate Carbon allocation targets + ! ----------------------------------------------------------------------------------- + + ! Set carbon targets based on the plant's current stature + target_c(:) = fates_unset_r8 + target_dcdd(:) = fates_unset_r8 + call bsap_allom(dbh,ipft,canopy_trim,sapw_area,target_c(sapw_organ),target_dcdd(sapw_organ)) + call bagw_allom(dbh,ipft,agw_c_target,agw_dcdd_target) + call bbgw_allom(dbh,ipft,bgw_c_target,bgw_dcdd_target) + call bdead_allom(agw_c_target,bgw_c_target,target_c(sapw_organ),ipft,target_c(struct_organ), & + agw_dcdd_target,bgw_dcdd_target,target_dcdd(sapw_organ),target_dcdd(struct_organ)) + call bleaf(dbh,ipft,canopy_trim, target_c(leaf_organ), target_dcdd(leaf_organ)) + call bfineroot(dbh,ipft,canopy_trim, l2fr, target_c(fnrt_organ), target_dcdd(fnrt_organ)) + call bstore_allom(dbh,ipft,canopy_trim, target_c(store_organ), target_dcdd(store_organ)) + target_c(repro_organ) = 0._r8 + target_dcdd(repro_organ) = 0._r8 + + + ! =================================================================================== + ! Step 1: Evaluate nutrient storage in the plant. Depending on how low + ! these stores are, we will move proportionally more or less of the daily carbon + ! gain to increase the target fine-root biomass, fill up to target + ! and then attempt to get them up to stoichiometry targets. + ! =================================================================================== + + ! This routine updates the l2fr (leaf 2 fine-root multiplier) variable + call this%CNPAdjustFRootTargets(target_c) + + + c_gain0 = c_gain + n_gain0 = n_gain + p_gain0 = p_gain + ! Output only boundary conditions c_efflux => this%bc_out(acnp_bc_out_id_cefflux)%rval; c_efflux = 0._r8 n_efflux => this%bc_out(acnp_bc_out_id_nefflux)%rval; n_efflux = 0._r8 p_efflux => this%bc_out(acnp_bc_out_id_pefflux)%rval; p_efflux = 0._r8 - ! In/out boundary conditions - maint_r_def => this%bc_inout(acnp_bc_inout_id_rmaint_def)%rval; maint_r_def0 = maint_r_def - dbh => this%bc_inout(acnp_bc_inout_id_dbh)%rval; dbh0 = dbh - l2fr => this%bc_inout(acnp_bc_inout_id_l2fr)%rval - - - ! If more than 1 leaf age bin is present, this - ! call advances leaves in their age, but does - ! not actually remove any biomass from the plant - call this%AgeLeaves(ipft,sec_per_day) + - ! Set all of the per-organ pointer arrays - ! Note: Since growth only happens in the 1st leaf bin, we only - ! point to that bin. However, we need to account for all bins - ! when we calculate the deficit + + - allocate(state_c(num_organs)) - allocate(state_n(num_organs)) - allocate(state_p(num_organs)) + ! Remember the original C,N,P states to help with final + ! evaluation of how much was allocated + ! ----------------------------------------------------------------------------------- - ! Set carbon targets based on the plant's current stature - target_c(:) = fates_unset_r8 - target_dcdd(:) = fates_unset_r8 - call bsap_allom(dbh,ipft,canopy_trim,sapw_area,target_c(sapw_id),target_dcdd(sapw_id) ) - call bagw_allom(dbh,ipft,agw_c_target,agw_dcdd_target) - call bbgw_allom(dbh,ipft,bgw_c_target,bgw_dcdd_target) - call bdead_allom(agw_c_target,bgw_c_target, target_c(sapw_id), ipft, target_c(struct_id), & - agw_dcdd_target, bgw_dcdd_target, target_dcdd(sapw_id), target_dcdd(struct_id)) - call bleaf(dbh,ipft,canopy_trim, target_c(leaf_id), target_dcdd(leaf_id)) - call bfineroot(dbh,ipft,canopy_trim, l2fr, target_c(fnrt_id), target_dcdd(fnrt_id)) - call bstore_allom(dbh,ipft,canopy_trim, target_c(store_id), target_dcdd(store_id)) - target_c(repro_id) = 0._r8 - target_dcdd(repro_id) = 0._r8 - - ! Initialize the the state, and keep a record of this state - ! as we may actuall run the allocation process twice, and - ! will need this state to both reset, and measure total - ! mass fluxes - do i_org = 1,num_organs - - i_var = prt_global%sp_organ_map(organ_list(i_org),carbon12_element) - state_c(i_org)%ptr => this%variables(i_var)%val(1) + do i = 1,num_organs + i_org = l2g_organ_list(i) ! global index from PRTGeneric + i_var = prt_global%sp_organ_map(i_org,carbon12_element) state_c0(i_org) = this%variables(i_var)%val(1) - - i_var = prt_global%sp_organ_map(organ_list(i_org),nitrogen_element) - state_n(i_org)%ptr => this%variables(i_var)%val(1) + i_var = prt_global%sp_organ_map(i_org,nitrogen_element) state_n0(i_org) = this%variables(i_var)%val(1) - - i_var = prt_global%sp_organ_map(organ_list(i_org),phosphorus_element) - state_p(i_org)%ptr => this%variables(i_var)%val(1) + i_var = prt_global%sp_organ_map(i_org,phosphorus_element) state_p0(i_org) = this%variables(i_var)%val(1) - end do - call bfineroot(dbh,ipft,canopy_trim, l2fr, target_c(fnrt_id), target_dcdd(fnrt_id)) - ! =================================================================================== ! Step 0. Transfer all stored nutrient into the daily uptake pool. ! =================================================================================== - - !i_var = prt_global%sp_organ_map(store_organ,carbon12_element) - !c_gain = c_gain + max(0._r8,sum(this%variables(i_var)%val(:))-target_c(store_id)) - !this%variables(i_var)%val(1) = this%variables(i_var)%val(1)-max(0._r8,sum(this%variables(i_var)%val(:))-target_c(store_id)) i_var = prt_global%sp_organ_map(store_organ,nitrogen_element) n_gain = n_gain + sum(this%variables(i_var)%val(:)) @@ -519,21 +485,21 @@ subroutine DailyPRTAllometricCNP(this) ! any un-paid maintenance respiration from storage. ! =================================================================================== - call this%CNPPrioritizedReplacement(maint_r_def, c_gain, n_gain, p_gain, & - state_c, state_n, state_p, target_c) - - + call this%CNPPrioritizedReplacement(c_gain, n_gain, p_gain, target_c) + sum_c = 0._r8 - do i_org = 1,num_organs - sum_c = sum_c+state_c(i_org)%ptr + do i = 1,num_organs + i_org = l2g_organ_list(i) + i_var = prt_global%sp_organ_map(i_org,carbon12_element) + sum_c = sum_c+this%variables(i_var)%val(1) end do if( abs((c_gain0-c_gain) - & - (sum_c-sum(state_c0(:),dim=1)+(maint_r_def0-maint_r_def))) >calloc_abs_error ) then + (sum_c-sum(state_c0(:),dim=1))) >calloc_abs_error ) then write(fates_log(),*) 'Carbon not balancing I' - do i_org = 1,num_organs - write(fates_log(),*) 'state_c: ',state_c(i_org)%ptr,state_c0(i_org) + do i = 1,num_organs + i_org = l2g_organ_list(i) + write(fates_log(),*) 'c: ',this%variables(prt_global%sp_organ_map(i_org,carbon12_element))%val(1) end do - write(fates_log(),*) maint_r_def0-maint_r_def call endrun(msg=errMsg(sourcefile, __LINE__)) end if @@ -544,23 +510,24 @@ subroutine DailyPRTAllometricCNP(this) ! targets based on prioritized relative demand and allometry functions. ! =================================================================================== - call this%CNPStatureGrowth(c_gain, n_gain, p_gain, & - state_c, state_n, state_p, target_c, target_dcdd, cnp_limiter) - + call this%CNPStatureGrowth(c_gain, n_gain, p_gain, target_c, target_dcdd) + sum_c = 0._r8 - do i_org = 1,num_organs - sum_c = sum_c+state_c(i_org)%ptr + do i = 1,num_organs + i_org = l2g_organ_list(i) + i_var = prt_global%sp_organ_map(i_org,carbon12_element) + sum_c = sum_c+this%variables(i_var)%val(1) end do if( abs((c_gain0-c_gain) - & - (sum_c-sum(state_c0(:),dim=1)+(maint_r_def0-maint_r_def))) >calloc_abs_error ) then - write(fates_log(),*) 'Carbon not balanceing II' - do i_org = 1,num_organs - write(fates_log(),*) 'state_c: ',state_c(i_org)%ptr,state_c0(i_org) + (sum_c-sum(state_c0(:),dim=1))) >calloc_abs_error ) then + write(fates_log(),*) 'Carbon not balancing II' + do i = 1,num_organs + i_org = l2g_organ_list(i) + write(fates_log(),*) 'c: ',this%variables(prt_global%sp_organ_map(i_org,carbon12_element))%val(1) end do - write(fates_log(),*) maint_r_def0-maint_r_def call endrun(msg=errMsg(sourcefile, __LINE__)) end if - + ! =================================================================================== ! Step 3. ! At this point, at least 1 of the 3 resources have been used up. @@ -568,8 +535,9 @@ subroutine DailyPRTAllometricCNP(this) ! =================================================================================== call this%CNPAllocateRemainder(c_gain, n_gain, p_gain, & - state_c, state_n, state_p, c_efflux, n_efflux, p_efflux) + c_efflux, n_efflux, p_efflux) + ! Error Check: Make sure that the mass gains are completely used up if( abs(c_gain) > calloc_abs_error .or. & abs(n_gain) > 0.1_r8*calloc_abs_error .or. & @@ -585,33 +553,34 @@ subroutine DailyPRTAllometricCNP(this) ! Perform a final tally on what was used (allocated) ! Since this is also a check against what was available - ! we include maintenance pay-back and efflux to the "allocated" - ! pool to make sure everything balances. + ! we include what is lost through respiration of excess storage - allocated_c = (maint_r_def0-maint_r_def) + c_efflux + allocated_c = (resp_excess-resp_excess0) + c_efflux allocated_n = n_efflux allocated_p = p_efflux ! Update the allocation flux diagnostic arrays for each 3 elements - do i_org = 1,num_organs - - i_var = prt_global%sp_organ_map(organ_list(i_org),carbon12_element) + do i = 1,num_organs + + i_org = l2g_organ_list(i) + + i_var = prt_global%sp_organ_map(i_org,carbon12_element) this%variables(i_var)%net_alloc(1) = & - this%variables(i_var)%net_alloc(1) + (state_c(i_org)%ptr - state_c0(i_org)) + this%variables(i_var)%net_alloc(1) + (this%variables(i_var)%val(1) - state_c0(i_org)) - allocated_c = allocated_c + (state_c(i_org)%ptr - state_c0(i_org)) + allocated_c = allocated_c + (this%variables(i_var)%val(1) - state_c0(i_org)) - i_var = prt_global%sp_organ_map(organ_list(i_org),nitrogen_element) + i_var = prt_global%sp_organ_map(i_org,nitrogen_element) this%variables(i_var)%net_alloc(1) = & - this%variables(i_var)%net_alloc(1) + (state_n(i_org)%ptr - state_n0(i_org)) + this%variables(i_var)%net_alloc(1) + (this%variables(i_var)%val(1) - state_n0(i_org)) - allocated_n = allocated_n + (state_n(i_org)%ptr - state_n0(i_org)) + allocated_n = allocated_n + (this%variables(i_var)%val(1) - state_n0(i_org)) - i_var = prt_global%sp_organ_map(organ_list(i_org),phosphorus_element) + i_var = prt_global%sp_organ_map(i_org,phosphorus_element) this%variables(i_var)%net_alloc(1) = & - this%variables(i_var)%net_alloc(1) + (state_p(i_org)%ptr - state_p0(i_org)) + this%variables(i_var)%net_alloc(1) + (this%variables(i_var)%val(1) - state_p0(i_org)) - allocated_p = allocated_p + (state_p(i_org)%ptr - state_p0(i_org)) + allocated_p = allocated_p + (this%variables(i_var)%val(1) - state_p0(i_org)) end do @@ -628,29 +597,24 @@ subroutine DailyPRTAllometricCNP(this) write(fates_log(),*) 'n_gain0: ',n_gain0,' allocated_n: ',allocated_n write(fates_log(),*) 'p_gain0: ',p_gain0,' allocated_p: ',allocated_p - do i_org = 1,num_organs - write(fates_log(),*) i_org, state_c(i_org)%ptr-state_c0(i_org) + do i = 1,num_organs + i_org = l2g_organ_list(i) + i_var = prt_global%sp_organ_map(i_org,carbon12_element) + write(fates_log(),*) i_org, this%variables(i_var)%val(1)-state_c0(i_org) end do - write(fates_log(),*) (maint_r_def0-maint_r_def), c_efflux call endrun(msg=errMsg(sourcefile, __LINE__)) end if end if - - !target_n = this%GetNutrientTarget(nitrogen_element,store_organ,stoich_max) - !target_p = this%GetNutrientTarget(phosphorus_element,store_organ,stoich_max) - - deallocate(state_c) - deallocate(state_n) - deallocate(state_p) return end subroutine DailyPRTAllometricCNP ! ===================================================================================== - subroutine CNPAdjustFRootTargets(this) + subroutine CNPAdjustFRootTargets(this, target_c) class(cnp_allom_prt_vartypes) :: this - + real(r8) :: target_c(:) + real(r8), pointer :: l2fr ! leaf to fineroot target biomass scaler integer :: ipft ! PFT index real(r8), pointer :: dbh @@ -658,8 +622,6 @@ subroutine CNPAdjustFRootTargets(this) !!real(r8) :: l2fr_ema ! Moving average L2FR (EMA) real(r8) :: l2fr_actual - real(r8) :: fnrt_c_target ! Target fineroot C before we change l2fr - real(r8) :: leaf_c_target real(r8) :: n_regulator ! Nitrogen storage regulation function scaler real(r8) :: p_regulator ! Phosphorus storage regulation function scaler real(r8) :: np_regulator ! Combined NP storage regulation function scaler @@ -672,19 +634,18 @@ subroutine CNPAdjustFRootTargets(this) real(r8) :: loss_flux_p real(r8) :: fnrt_c_above_target - integer, parameter :: regulate_type = regulate_CN_ema + integer, parameter :: regulate_type = regulate_CN_dfdd ipft = this%bc_in(acnp_bc_in_id_pft)%ival l2fr => this%bc_inout(acnp_bc_inout_id_l2fr)%rval dbh => this%bc_inout(acnp_bc_inout_id_dbh)%rval canopy_trim = this%bc_in(acnp_bc_in_id_ctrim)%rval - !!l2fr_ema = this%bc_in(acnp_bc_in_id_l2fr_ema)%rval associate( l2fr_min => prt_params%allom_l2fr_min(ipft), & l2fr_max => prt_params%allom_l2fr_max(ipft)) - call this%StorageRegulator(nitrogen_element, regulate_type,n_regulator) - call this%StorageRegulator(phosphorus_element, regulate_type,p_regulator) + call this%StorageRegulator(nitrogen_element, regulate_type,target_c,n_regulator) + call this%StorageRegulator(phosphorus_element, regulate_type,target_c,p_regulator) ! We take the maximum here, because the maximum is reflective of the ! element with the lowest storage, which is the limiting element @@ -698,57 +659,23 @@ subroutine CNPAdjustFRootTargets(this) l2fr = l2fr_min + max(0._r8,min(1.0_r8,np_regulator))*(l2fr_max-l2fr_min) - - elseif(regulate_type == regulate_CN_ema) then + elseif(regulate_type == regulate_CN_dfdd) then ! To prevent the target l2fr from diverging too far from the ! actual l2fr, create some constraints. l2fr_actual = this%GetState(fnrt_organ, carbon12_element)/this%GetState(leaf_organ, carbon12_element) ! Only update L2FR if some leaves are out - call bleaf(dbh,ipft,canopy_trim,leaf_c_target) - if(this%GetState(leaf_organ, carbon12_element)/leaf_c_target>0.5_r8) then + if(this%GetState(leaf_organ, carbon12_element)/target_c(leaf_organ) >0.5_r8) then l2fr = l2fr * np_regulator end if - - elseif(regulate_type == regulate_CN_dfdd)then - - ! Also, we aren't allowed to increase root biomass target if - ! we are very low on root biomass relative to the target - ! And we aren't allowed to reduce the target if we are above the target - - call bfineroot(dbh,ipft,canopy_trim,l2fr,fnrt_c_target) - fnrt_frac = this%GetState(fnrt_organ, carbon12_element)/fnrt_c_target - - turnfrac = (years_per_day / prt_params%root_long(ipft)) - - ! If there is low root compared to the max, don't allow cap growth - if(fnrt_frac < 1._r8-1.5_r8*turnfrac)then - np_regulator = min(np_regulator,1.0) - end if - - ! If there is high root compared to the max, don't allow cap decrease - if(fnrt_frac > 1.0_r8+1.5_r8*turnfrac)then - np_regulator = max(np_regulator,1.0) - end if - - ! Don't allow us to drop l2fr more than what the maximum loss to turnover - ! would be for one day. - ! this will prevent the algorithm from snowballing. This is doubly important - ! because if C is low compared to N or P, then the plant is probably - ! not very productive, and will not be growing. A growing plant can reach - ! equilibrium root mass more quickly. (might be unnecessary given - ! the growth caps prior to this...?) - - l2fr = l2fr * min(max(np_regulator,1._r8-2._r8*turnfrac),1._r8+2._r8*turnfrac) - end if ! Find the updated target fineroot biomass - call bfineroot(dbh,ipft,canopy_trim, l2fr, fnrt_c_target) + call bfineroot(dbh,ipft,canopy_trim, l2fr, target_c(fnrt_organ)) - fnrt_c_above_target = max(0._r8,this%GetState(fnrt_organ, carbon12_element) - fnrt_c_target) + fnrt_c_above_target = max(0._r8,this%GetState(fnrt_organ, carbon12_element) - target_c(fnrt_organ)) ! Allow no reabsorption? (any reabsorption of nutrients will further push the N/C or P/C imbalance ! and if we are dropping roots, its because we had excess nutrient compared to carbon anyway @@ -765,7 +692,7 @@ subroutine CNPAdjustFRootTargets(this) loss_flux_n = loss_flux_c*this%variables(fnrt_n_id)%val(1)/this%variables(fnrt_c_id)%val(1) this%variables(fnrt_n_id)%val(1) = this%variables(fnrt_n_id)%val(1) - loss_flux_n - this%variables(fnrt_n_id)%turnover(1) = this%variables(fnrt_n_id)%turnover(1) + loss_flux_p + this%variables(fnrt_n_id)%turnover(1) = this%variables(fnrt_n_id)%turnover(1) + loss_flux_n loss_flux_p = loss_flux_c*this%variables(fnrt_p_id)%val(1)/this%variables(fnrt_c_id)%val(1) this%variables(fnrt_p_id)%val(1) = this%variables(fnrt_p_id)%val(1) - loss_flux_p @@ -783,10 +710,8 @@ end subroutine CNPAdjustFRootTargets ! ===================================================================================== - subroutine CNPPrioritizedReplacement(this, & - maint_r_deficit, c_gain, n_gain, p_gain, & - state_c, state_n, state_p, target_c) - + subroutine CNPPrioritizedReplacement(this,c_gain, n_gain, p_gain, target_c) + ! ----------------------------------------------------------------------------------- ! Alternative allocation hypothesis for the prioritized replacement phase. @@ -797,19 +722,17 @@ subroutine CNPPrioritizedReplacement(this, & real(r8), intent(inout) :: c_gain real(r8), intent(inout) :: n_gain real(r8), intent(inout) :: p_gain - real(r8), intent(inout) :: maint_r_deficit ! Not currently used - type(parray_type) :: state_c(:) ! State array for carbon, by organ [kg] - type(parray_type) :: state_n(:) ! State array for N, by organ [kg] - type(parray_type) :: state_p(:) ! State array for P, by organ [kg] - real(r8), intent(in) :: target_c(:) - + real(r8), intent(in) :: target_c(:) ! Indexed by global organ (from PRTGenericMod) + integer :: n_curpri_org - integer, dimension(num_organs) :: curpri_org ! C variable ID's of the current priority level + + integer, dimension(num_organs) :: curpri_org ! organ ID's of the current priority level real(r8), dimension(num_organs) :: deficit_c ! Deficit to get to target from current [kg] real(r8), dimension(num_organs) :: deficit_n ! Deficit to get to target from current [kg] real(r8), dimension(num_organs) :: deficit_p ! Deficit to get to target from current [kg] + integer :: i, ii, i_org ! Loop indices (mostly for organs) - integer :: i_cvar ! variable index + integer :: i_var ! variable index integer :: i_pri ! loop index for priority integer :: ipft ! Plant functional type index of this plant integer :: leaf_status ! Is this plant in a leaf on or off status? @@ -818,7 +741,7 @@ subroutine CNPPrioritizedReplacement(this, & real(r8) :: target_n ! Target mass of N for a given organ [kg] real(r8) :: target_p ! Target mass of P for a given organ [kg] integer :: priority_code ! Index for priority level of each organ - real(r8) :: sum_c_demand ! Carbon demanded to bring tissues up to allometry (kg) + real(r8) :: sum_c_demand ! Carbon demanded to bring tissues up to allometry (kg) real(r8) :: sum_n_deficit ! The nitrogen deficit of all pools for given priority level (kg) real(r8) :: sum_p_deficit ! The phosphorus deficit of all pools for given priority level (kg) real(r8) :: store_below_target @@ -832,17 +755,45 @@ subroutine CNPPrioritizedReplacement(this, & real(r8) :: gr_flux ! carbon flux to fulfill growth respiration of an arbitrary pool (kg) real(r8) :: n_flux ! nitrogen flux into an arbitrary pool (kg) real(r8) :: p_flux ! phosphorus flux into an arbitrary pool (kg) - real(r8) :: maint_r_def_flux ! Flux into maintenance respiration during priority 1 allocation real(r8) :: c_gain_flux ! Flux used to pay back negative carbon gain (from storage) (kgC) real(r8) :: sapw_area - integer, parameter :: n_max_priority = num_organs + 1 ! Maximum possible number of priority levels is - ! the total number organs plus 1, which allows - ! each organ to have its own level, and ignore - ! the specialized priority 1 + + integer :: n_max_priority ! Maximum possible number of priority levels is + ! the total number organs plus 1, which allows + ! each organ to have its own level, and ignore + ! the specialized priority 1 + leaf_status = this%bc_in(acnp_bc_in_id_lstat)%ival ipft = this%bc_in(acnp_bc_in_id_pft)%ival canopy_trim = this%bc_in(acnp_bc_in_id_ctrim)%rval + + + n_max_priority = maxval(prt_params%organ_param_id(:)) + if(n_max_priority>10 .or. n_max_priority<0)then + write(fates_log(),*) 'was unable to interpret prt_params%organ_param_id' + write(fates_log(),*) 'for cnp allocation, there should be non-zero values <10' + write(fates_log(),*) 'your values: ',prt_params%organ_param_id(:) + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + ! ----------------------------------------------------------------------------------- + ! Notes on indexes: + ! + ! i_org: this is the index that matches the global organ indices found in PRTGenericMod + ! + ! prt_params%alloc_priority is a parameter array that only holds a subset of the + ! organs. For instance it does not include reproductive and storage, because those + ! organs are special. We can find out the global organ index (ie i_org) from the + ! parameter array prt_params%organ_id + ! + ! i and ii are just local indices used to iterate through sub-groups of organs. + ! for instance, i will generally iterate through the curpri_org, which is an + ! array of the global organ indices (i_org) for the current subset of organs that + ! should be allocated at the current priority level + ! + ! ----------------------------------------------------------------------------------- + ! ----------------------------------------------------------------------------------- ! Preferential transfer of available carbon and nutrients into the highest @@ -851,30 +802,30 @@ subroutine CNPPrioritizedReplacement(this, & ! If it is, then we track the variable ids associated with that pool for each CNP ! species. It "should" work fine if there are NO priority=1 pools... ! ----------------------------------------------------------------------------------- - + curpri_org(:) = fates_unset_int ! reset "current-priority" organ ids i = 0 - do ii = 1, num_organs - - deficit_c(ii) = max(0._r8,this%GetDeficit(carbon12_element,organ_list(ii),target_c(ii))) + do ii = 1, size(prt_params%organ_id,1) - ! The following logic bars any organs that were not given allocation priority - if( prt_params%organ_param_id(organ_list(ii)) < 1 ) cycle + ! universal organ index from PRTGenericMod + i_org = prt_params%organ_id(ii) - ! The priority code associated with this organ - priority_code = int(prt_params%alloc_priority(ipft, prt_params%organ_param_id(organ_list(ii)))) - ! Don't allow allocation to leaves if they are in an "off" status. ! Also, dont allocate to replace turnover if this is not evergreen ! (this prevents accidental re-flushing on the day they drop) if( ((leaf_status.eq.leaves_off) .or. (prt_params%evergreen(ipft) .ne. itrue)) & - .and. (organ_list(ii).eq.leaf_organ)) cycle + .and. (i_org.eq.leaf_organ)) cycle + + ! The priority code associated with this organ + priority_code = int(prt_params%alloc_priority(ipft, ii)) ! 1 is the highest priority code possible if( priority_code == 1 ) then i = i + 1 - curpri_org(i) = ii + curpri_org(i) = i_org + deficit_c(i) = max(0._r8,this%GetDeficit(carbon12_element,i_org,target_c(i_org))) end if + end do @@ -891,32 +842,29 @@ subroutine CNPPrioritizedReplacement(this, & sum_c_demand = 0._r8 do i = 1,n_curpri_org - ii = curpri_org(i) - - i_cvar = prt_global%sp_organ_map(organ_list(ii),carbon12_element) + i_org = curpri_org(i) + i_var = prt_global%sp_organ_map(i_org,carbon12_element) sum_c_demand = sum_c_demand + prt_params%leaf_stor_priority(ipft) * & - sum(this%variables(i_cvar)%turnover(:)) - + sum(this%variables(i_var)%turnover(:)) end do - - sum_c_flux = max(0._r8,min(sum_c_demand,state_c(store_id)%ptr+c_gain)) + sum_c_flux = max(0._r8,min(sum_c_demand,this%variables(store_c_id)%val(1)+c_gain)) if (sum_c_flux> nearzero ) then ! We pay this even if we don't have the carbon ! Just don't pay so much carbon that storage+carbon_balance can't pay for it - do ii = 1,n_curpri_org - i = curpri_org(ii) - - i_cvar = prt_global%sp_organ_map(organ_list(i),carbon12_element) + do i = 1,n_curpri_org - c_flux = sum_c_flux*(prt_params%leaf_stor_priority(ipft) * & - sum(this%variables(i_cvar)%turnover(:))/sum_c_demand) + i_org = curpri_org(i) + i_var = prt_global%sp_organ_map(i_org,carbon12_element) + c_flux = sum_c_flux*(prt_params%leaf_stor_priority(ipft) * & + sum(this%variables(i_var)%turnover(:))/sum_c_demand) + ! Add carbon to the pool - state_c(i)%ptr = state_c(i)%ptr + c_flux + this%variables(i_var)%val(1) = this%variables(i_var)%val(1) + c_flux ! Remove from daily carbon gain c_gain = c_gain - c_flux @@ -930,29 +878,27 @@ subroutine CNPPrioritizedReplacement(this, & i_org = curpri_org(i) ! Update the nitrogen deficits - ! Note that the nitrogen target is tied to the stoichiometry of thegrowing pool only + ! Note that the nitrogen target is tied to the stoichiometry of the growing pool only (pos = 1) - target_n = this%GetNutrientTarget(nitrogen_element,organ_list(i_org),stoich_growth_min) - deficit_n(i_org) = max(0.0_r8, target_n - state_n(i_org)%ptr ) + target_n = this%GetNutrientTarget(nitrogen_element,i_org,stoich_growth_min) + deficit_n(i) = max(0.0_r8, target_n - this%GetState(i_org, nitrogen_element,1)) ! Update the phosphorus deficits (which are based off of carbon actual..) ! Note that the phsophorus target is tied to the stoichiometry of thegrowing pool only (also) - target_p = this%GetNutrientTarget(phosphorus_element,organ_list(i_org),stoich_growth_min) - deficit_p(i_org) = max(0.0_r8, target_p - state_p(i_org)%ptr ) + target_p = this%GetNutrientTarget(phosphorus_element,i_org,stoich_growth_min) + deficit_p(i) = max(0.0_r8, target_p - this%GetState(i_org, phosphorus_element,1)) end do ! Allocate nutrients at this priority level ! Nitrogen - call ProportionalNutrAllocation(state_n, deficit_n, & + call ProportionalNutrAllocation(this,deficit_n(1:n_curpri_org), & n_gain, nitrogen_element, curpri_org(1:n_curpri_org)) ! Phosphorus - call ProportionalNutrAllocation(state_p, deficit_p, & + call ProportionalNutrAllocation(this,deficit_p(1:n_curpri_org), & p_gain, phosphorus_element, curpri_org(1:n_curpri_org)) - - ! ----------------------------------------------------------------------------------- ! IV. if carbon balance is negative, re-coup the losses from storage ! if it is positive, give some love to storage carbon @@ -963,15 +909,16 @@ subroutine CNPPrioritizedReplacement(this, & ! Storage will have to pay for any negative gains store_c_flux = -c_gain c_gain = c_gain + store_c_flux - state_c(store_id)%ptr = state_c(store_id)%ptr - store_c_flux + + this%variables(store_c_id)%val(1) = this%variables(store_c_id)%val(1) - store_c_flux else ! This is just a cap, don't fill up more than is needed (shouldn't even apply) - store_below_target = max(target_c(store_id) - state_c(store_id)%ptr,0._r8) + store_below_target = max(target_c(store_organ) - this%variables(store_c_id)%val(1),0._r8) ! This is the desired need for carbon - store_target_fraction = max(state_c(store_id)%ptr/target_c(store_id),0._r8) + store_target_fraction = max(this%variables(store_c_id)%val(1)/target_c(store_organ),0._r8) store_demand = max(c_gain*(exp(-1.*store_target_fraction**4._r8) - exp( -1.0_r8 )),0._r8) @@ -979,8 +926,8 @@ subroutine CNPPrioritizedReplacement(this, & store_c_flux = min(store_below_target,store_demand) c_gain = c_gain - store_c_flux - state_c(store_id)%ptr = state_c(store_id)%ptr + store_c_flux - + + this%variables(store_c_id)%val(1) = this%variables(store_c_id)%val(1) + store_c_flux end if @@ -992,6 +939,7 @@ subroutine CNPPrioritizedReplacement(this, & ! ----------------------------------------------------------------------------------- ! Bring all pools, in priority order, up to allometric targets if possible + ! Repeat priority order 1 as well. ! ----------------------------------------------------------------------------------- priority_loop: do i_pri = 1, n_max_priority @@ -999,46 +947,48 @@ subroutine CNPPrioritizedReplacement(this, & curpri_org(:) = fates_unset_int ! "current-priority" organ indices i = 0 - do ii = 1, num_organs + + ! Storage has a special hard-coded priority level of 2 + if( i_pri == 2 ) then + curpri_org(1) = store_organ + i=1 + end if - ! The priority code associated with this organ - ! Storage has a special hard-coded priority level of 2 - ! Note that it is also implicitly part of step 1 + ! Loop over all organs in the CNP routine, which + do ii = 1, size(prt_params%organ_id,1) - if( organ_list(ii).eq.store_organ ) then - priority_code = 2 - else - if( prt_params%organ_param_id(organ_list(ii)) <1 ) then - priority_code = -1 - else - priority_code = int(prt_params%alloc_priority(ipft,prt_params%organ_param_id(organ_list(ii)))) - end if - end if - + ! universal organ index from PRTGenericMod + i_org = prt_params%organ_id(ii) + + ! The priority code associated with this organ + + priority_code = int(prt_params%alloc_priority(ipft,ii)) ! Don't allow allocation to leaves if they are in an "off" status. ! (this prevents accidental re-flushing on the day they drop) - if((leaf_status.eq.leaves_off) .and. (organ_list(ii).eq.leaf_organ)) cycle - + if((leaf_status.eq.leaves_off) .and. (i_org.eq.leaf_organ)) cycle if( priority_code == i_pri ) then - deficit_c(ii) = max(0._r8,this%GetDeficit(carbon12_element,organ_list(ii),target_c(ii))) i = i + 1 - curpri_org(i) = ii + curpri_org(i) = i_org end if end do + n_curpri_org = i + + do i = 1,n_curpri_org + i_org = curpri_org(i) + deficit_c(i) = max(0._r8,this%GetDeficit(carbon12_element,i_org,target_c(i_org))) + end do + ! Bring carbon up to target first, this order is required ! because we need to know the resulting carbon concentrations ! before we set the allometric targets for the nutrients - n_curpri_org = i - - sum_c_demand = 0._r8 do i=1,n_curpri_org i_org = curpri_org(i) - sum_c_demand = sum_c_demand + deficit_c(i_org) + sum_c_demand = sum_c_demand + deficit_c(i) end do sum_c_flux = min(c_gain, sum_c_demand) @@ -1049,13 +999,14 @@ subroutine CNPPrioritizedReplacement(this, & i_org = curpri_org(i) - c_flux = sum_c_flux*deficit_c(i_org)/sum_c_demand + c_flux = sum_c_flux*deficit_c(i)/sum_c_demand ! Update the carbon pool - state_c(i_org)%ptr = state_c(i_org)%ptr + c_flux + i_var = prt_global%sp_organ_map(i_org,carbon12_element) + this%variables(i_var)%val(1) = this%variables(i_var)%val(1) + c_flux ! Update carbon pools deficit - deficit_c(i_org) = max(0._r8,deficit_c(i_org) - c_flux) + deficit_c(i) = max(0._r8,deficit_c(i) - c_flux) ! Reduce the carbon gain c_gain = c_gain - c_flux @@ -1070,22 +1021,22 @@ subroutine CNPPrioritizedReplacement(this, & ! Update the nitrogen deficits ! Note that the nitrogen target is tied to the stoichiometry of thegrowing pool only - target_n = this%GetNutrientTarget(nitrogen_element,organ_list(i_org),stoich_growth_min) - deficit_n(i_org) = max(0.0_r8, target_n - state_n(i_org)%ptr ) + target_n = this%GetNutrientTarget(nitrogen_element,i_org,stoich_growth_min) + deficit_n(i) = max(0.0_r8, target_n - this%GetState(i_org, nitrogen_element,1) ) ! Update the phosphorus deficits (which are based off of carbon actual..) ! Note that the phsophorus target is tied to the stoichiometry of thegrowing pool only (also) - target_p = this%GetNutrientTarget(phosphorus_element,organ_list(i_org),stoich_growth_min) - deficit_p(i_org) = max(0.0_r8, target_p - state_p(i_org)%ptr ) + target_p = this%GetNutrientTarget(phosphorus_element,i_org,stoich_growth_min) + deficit_p(i) = max(0.0_r8, target_p - this%GetState(i_org, phosphorus_element,1) ) end do ! Allocate nutrients at this priority level Nitrogen - call ProportionalNutrAllocation(state_n, deficit_n, & + call ProportionalNutrAllocation(this,deficit_n(1:n_curpri_org), & n_gain, nitrogen_element, curpri_org(1:n_curpri_org)) ! Phosphorus - call ProportionalNutrAllocation(state_p, deficit_p, & + call ProportionalNutrAllocation(this,deficit_p(1:n_curpri_org), & p_gain, phosphorus_element, curpri_org(1:n_curpri_org)) @@ -1101,8 +1052,7 @@ end subroutine CNPPrioritizedReplacement ! ===================================================================================== subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & - state_c, state_n, state_p, & - target_c, target_dcdd, cnp_limiter) + target_c, target_dcdd) class(cnp_allom_prt_vartypes) :: this @@ -1111,12 +1061,8 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & ! (new uptake + storage) real(r8), intent(inout) :: p_gain ! Total P available for allocation ! (new uptake + storage) - type(parray_type) :: state_c(:) ! State array for carbon, by organ [kg] - type(parray_type) :: state_n(:) ! State array for N, by organ [kg] - type(parray_type) :: state_p(:) ! State array for P, by organ [kg] real(r8), intent(in) :: target_c(:) real(r8), intent(in) :: target_dcdd(:) - integer, intent(out) :: cnp_limiter real(r8), pointer :: dbh integer :: ipft @@ -1125,6 +1071,7 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & real(r8) :: l2fr integer :: i, ii ! organ index loops (masked and unmasked) + integer :: i_org ! global organ index integer :: istep ! outer step iteration loop real(r8) :: grow_c_from_c ! carbon transferred into tissues real(r8) :: grow_c_from_n ! carbon needed to match N transfers to tissues @@ -1146,18 +1093,18 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & real(r8) :: c_flux_adj ! Adjustment to total carbon flux during stature growth ! intended to correct integration error (kg/kg) real(r8) :: c_flux ! Carbon flux from the gain pool to an organ (kgC) + real(r8) :: n_flux,p_flux real(r8) :: gr_flux ! Growth respiration flux for the current transaction (kgC) real(r8) :: c_gstature ! Carbon reserved for stature growth (kg) real(r8) :: target_n ! Target mass of N for a given organ [kg] real(r8) :: target_p ! Target mass of P for a given organ [kg] real(r8) :: sum_n_demand ! Total N deficit to overcome after C stature growth [kg] real(r8) :: sum_p_demand ! Total P deficit to overcome after C stature growth [kg] - real(r8), dimension(num_organs) :: frac_c ! Fraction of C going towards each pool - ! (only used when calculating which species limits) real(r8), dimension(num_organs) :: deficit_n ! Deficit to get to target from current [kg] real(r8), dimension(num_organs) :: deficit_p ! Deficit to get to target from current [kg] integer,dimension(num_organs) :: mask_organs ! This works with "state_mask", the list - ! of organs in the mask + ! of organs (local ids) in the mask + integer,dimension(num_organs) :: mask_gorgans ! List of organ global indices in the mask integer :: n_mask_organs ! Integrator error checking @@ -1208,9 +1155,6 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & canopy_trim = this%bc_in(acnp_bc_in_id_ctrim)%rval l2fr = this%bc_inout(acnp_bc_inout_id_l2fr)%rval ! This variable is not updated in this ! routine, and is therefore not a pointer - - cnp_limiter = 0 - ! If any of these resources is essentially tapped out, ! then there is no point in performing growth ! It also seems impossible that we would be in a leaf-off status @@ -1235,6 +1179,7 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & state_mask(:) = .false. mask_organs(:) = fates_unset_int + mask_gorgans(:) = fates_unset_int ! Go through and flag the integrating variables as either pools that ! are growing in this iteration, or not. At this point, if carbon for growth @@ -1246,7 +1191,9 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & ii = 0 do i = 1, num_organs - cdeficit = this%GetDeficit(carbon12_element,organ_list(i),target_c(i)) + i_org = l2g_organ_list(i) + + cdeficit = this%GetDeficit(carbon12_element,i_org,target_c(i_org)) if ( cdeficit > calloc_abs_error ) then ! In this case, we somehow still have carbon to play with, @@ -1254,10 +1201,10 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & ! gracefully fail write(fates_log(),*) 'A carbon pool has reached the stature growth step' write(fates_log(),*) 'yet its deficit is too large to integrate ' - write(fates_log(),*) 'organ: ',i + write(fates_log(),*) 'organ: ',i_org write(fates_log(),*) 'carbon gain: ',c_gain write(fates_log(),*) 'leaves status:', leaf_status - write(fates_log(),*) cdeficit, target_c(i), state_c(i)%ptr + write(fates_log(),*) cdeficit, target_c(i_org) call endrun(msg=errMsg(sourcefile, __LINE__)) elseif( (-cdeficit) > calloc_abs_error ) then ! In this case, we are above our target (ie negative deficit (fusion?)) @@ -1271,9 +1218,10 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & ! Reproduction is a special case, don't add it to the ! list of organs... yet - if (organ_list(i).ne.repro_organ) then + if (i_org.ne.repro_organ) then ii=ii+1 mask_organs(ii) = i + mask_gorgans(ii) = i_org end if end if @@ -1290,8 +1238,7 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & write(fates_log(),*) 'plants, and roots in grasses are not allowed above target.' write(fates_log(),*) 'pft: ',ipft write(fates_log(),*) 'dbh: ',dbh - write(fates_log(),*) 'c state1 : ',state_c(1)%ptr - write(fates_log(),*) 'c targets: ',target_c(1:num_organs) + write(fates_log(),*) 'c targets: ',target_c(:) call endrun(msg=errMsg(sourcefile, __LINE__)) end if end if @@ -1309,9 +1256,9 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & if(repro_c_frac>nearzero)then state_mask(repro_id) = .true. - ii = ii + 1 - n_mask_organs = ii - mask_organs(ii) = repro_id + n_mask_organs = n_mask_organs + 1 + mask_organs(n_mask_organs) = repro_id + mask_gorgans(n_mask_organs) = repro_organ else state_mask(repro_id) = .false. end if @@ -1328,27 +1275,11 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & total_dcostdd = 0._r8 - do ii = 1, n_mask_organs - i = mask_organs(ii) - total_dcostdd = total_dcostdd + target_dcdd(i) + do i = 1, n_mask_organs + i_org = mask_gorgans(ii) + total_dcostdd = total_dcostdd + target_dcdd(i_org) end do - frac_c(:) = 0._r8 - do ii = 1, n_mask_organs - i = mask_organs(ii) - frac_c(i) = target_dcdd(i)/total_dcostdd * (1.0_r8 - repro_c_frac) - end do - frac_c(repro_id) = repro_c_frac - - if(debug) then - if ( abs(sum(frac_c,dim=1)-1._r8)>rsnbl_math_prec ) then - write(fates_log(),*) 'predicted carbon allocation fractions dont sum to 1?' - write(fates_log(),*) 'frac_c(:):',frac_c - call endrun(msg=errMsg(sourcefile, __LINE__)) - end if - end if - - ! No mathematical co-limitation of growth ! This assumes that limitations will prevent ! organs from allowing the growth step to even occur @@ -1374,7 +1305,9 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & ! Fill the state array with element masses for each organ do i = 1, num_organs - state_array(i) = state_c(i)%ptr + i_org = l2g_organ_list(i) + i_var = prt_global%sp_organ_map(i_org,carbon12_element) + state_array(i) = this%variables(i_var)%val(1) end do state_mask(dbh_id) = .true. @@ -1445,8 +1378,10 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & sum_c_flux = 0.0_r8 do ii = 1, n_mask_organs - i = mask_organs(ii) - sum_c_flux = sum_c_flux + (state_array(i) - state_c(i)%ptr) + i = mask_organs(ii) + i_org = mask_gorgans(ii) + i_var = prt_global%sp_organ_map(i_org,carbon12_element) + sum_c_flux = sum_c_flux + (state_array(i) - this%variables(i_var)%val(1)) end do ! This is a correction factor that forces @@ -1455,13 +1390,15 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & do ii = 1, n_mask_organs - i = mask_organs(ii) + i = mask_organs(ii) + i_org = mask_gorgans(ii) + i_var = prt_global%sp_organ_map(i_org,carbon12_element) ! Calculate adjusted flux - c_flux = (state_array(i) - state_c(i)%ptr)*c_flux_adj + c_flux = (state_array(i) - this%variables(i_var)%val(1))*c_flux_adj ! update the carbon pool (in all pools flux goes into the first pool) - state_c(i)%ptr = state_c(i)%ptr + c_flux + this%variables(i_var)%val(1) = this%variables(i_var)%val(1) + c_flux ! Remove carbon from the daily gain c_gain = c_gain - c_flux @@ -1483,11 +1420,11 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & write(fates_log(),*) 'totalC',totalC write(fates_log(),*) 'pft: ',ipft write(fates_log(),*) 'dbh: ',dbh - write(fates_log(),*) 'dCleaf_dd: ',target_dcdd(leaf_id) - write(fates_log(),*) 'dCfnrt_dd: ',target_dcdd(fnrt_id) - write(fates_log(),*) 'dCstore_dd: ',target_dcdd(store_id) - write(fates_log(),*) 'dCsapw_dd: ',target_dcdd(sapw_id) - write(fates_log(),*) 'dCstruct_dd: ',target_dcdd(struct_id) + write(fates_log(),*) 'dCleaf_dd: ',target_dcdd(leaf_organ) + write(fates_log(),*) 'dCfnrt_dd: ',target_dcdd(fnrt_organ) + write(fates_log(),*) 'dCstore_dd: ',target_dcdd(store_organ) + write(fates_log(),*) 'dCsapw_dd: ',target_dcdd(sapw_organ) + write(fates_log(),*) 'dCstruct_dd: ',target_dcdd(struct_organ) write(fates_log(),*) 'repro c frac: ',repro_c_frac dbh_tp1 = state_array_out(dbh_id) leafc_tp1 = state_array_out(leaf_id) @@ -1509,8 +1446,6 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & write(fates_log(),*) 'sapw_c: ',sapwc_tp1, sapw_c_target_tp1 ,sapwc_tp1- sapw_c_target_tp1 write(fates_log(),*) 'store_c: ',storec_tp1, store_c_target_tp1,storec_tp1- store_c_target_tp1 write(fates_log(),*) 'struct_c: ',structc_tp1, struct_c_target_tp1,structc_tp1- struct_c_target_tp1 - write(fates_log(),*) 'sapw_c_t0: ',state_c(sapw_id)%ptr, target_c(sapw_id) - call endrun(msg=errMsg(sourcefile, __LINE__)) end if if_step_exceedance @@ -1526,18 +1461,23 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & ! have their maximum stoichiometry in each organ. The total stoichiometry ! of the recruits should match the stoichiometry of the seeds - !!target_n = this%GetNutrientTarget(nitrogen_element,repro_organ,stoich_growth_min) - !!deficit_n(repro_id) = this%GetDeficit(nitrogen_element,repro_organ,target_n) + if(prioritize_repro_nutr_growth)then - !!target_p = this%GetNutrientTarget(phosphorus_element,repro_organ,stoich_growth_min) - !!deficit_p(repro_id) = this%GetDeficit(phosphorus_element,repro_organ,target_p) - - ! Nitrogen for - !!call ProportionalNutrAllocation(state_n, deficit_n, n_gain, nitrogen_element,[repro_id]) - - ! Phosphorus - !!call ProportionalNutrAllocation(state_p, deficit_p, p_gain, phosphorus_element,[repro_id]) + target_n = this%GetNutrientTarget(nitrogen_element,repro_organ,stoich_growth_min) + deficit_n(1) = this%GetDeficit(nitrogen_element,repro_organ,target_n) + n_flux = max(0._r8,min(n_gain,deficit_n(1))) + + target_p = this%GetNutrientTarget(phosphorus_element,repro_organ,stoich_growth_min) + deficit_p(1) = this%GetDeficit(phosphorus_element,repro_organ,target_p) + p_flux = max(0._r8,min(p_gain,deficit_p(1))) + + this%variables(repro_n_id)%val(1) = this%variables(repro_n_id)%val(1) + n_flux + this%variables(repro_p_id)%val(1) = this%variables(repro_p_id)%val(1) + p_flux + n_gain = n_gain - n_flux + p_gain = p_gain - p_flux + + end if ! ----------------------------------------------------------------------------------- ! Nutrient Fluxes proportionally to each pool (these should be fully actualized) @@ -1548,26 +1488,29 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & sum_p_demand = 0._r8 ! For error checking do ii = 1, n_mask_organs - i = mask_organs(ii) - - target_n = this%GetNutrientTarget(nitrogen_element,organ_list(i),stoich_growth_min) - target_p = this%GetNutrientTarget(phosphorus_element,organ_list(i),stoich_growth_min) + i = mask_organs(ii) + i_org = mask_gorgans(ii) + + target_n = this%GetNutrientTarget(nitrogen_element,i_org,stoich_growth_min) + target_p = this%GetNutrientTarget(phosphorus_element,i_org,stoich_growth_min) - deficit_n(i) = this%GetDeficit(nitrogen_element,organ_list(i),target_n) - sum_n_demand = sum_n_demand+max(0._r8,deficit_n(i)) + deficit_n(ii) = this%GetDeficit(nitrogen_element,i_org,target_n) + sum_n_demand = sum_n_demand+max(0._r8,deficit_n(ii)) - deficit_p(i) = this%GetDeficit(phosphorus_element,organ_list(i),target_p) - sum_p_demand = sum_p_demand+max(0._r8,deficit_p(i)) + deficit_p(ii) = this%GetDeficit(phosphorus_element,i_org,target_p) + sum_p_demand = sum_p_demand+max(0._r8,deficit_p(ii)) end do - - ! Nitrogen - call ProportionalNutrAllocation(state_n,deficit_n, & - n_gain, nitrogen_element,mask_organs(1:n_mask_organs)) - - ! Phosphorus - call ProportionalNutrAllocation(state_p, deficit_p, & - p_gain, phosphorus_element,mask_organs(1:n_mask_organs)) + + ! TODO: mask_organs should be a vector of global organs + + ! Nitrogen + call ProportionalNutrAllocation(this,deficit_n(1:n_mask_organs), & + n_gain, nitrogen_element,mask_gorgans(1:n_mask_organs)) + + ! Phosphorus + call ProportionalNutrAllocation(this,deficit_p(1:n_mask_organs), & + p_gain, phosphorus_element,mask_gorgans(1:n_mask_organs)) end if if_stature_growth @@ -1577,16 +1520,13 @@ end subroutine CNPStatureGrowth ! ===================================================================================== - subroutine CNPAllocateRemainder(this,c_gain, n_gain, p_gain, & - state_c, state_n, state_p, c_efflux, n_efflux, p_efflux) + subroutine CNPAllocateRemainder(this, c_gain, n_gain, p_gain, & + c_efflux, n_efflux, p_efflux) class(cnp_allom_prt_vartypes) :: this real(r8), intent(inout) :: c_gain real(r8), intent(inout) :: n_gain real(r8), intent(inout) :: p_gain - type(parray_type) :: state_c(:) ! State array for carbon, by organ [kg] - type(parray_type) :: state_n(:) ! State array for N, by organ [kg] - type(parray_type) :: state_p(:) ! State array for P, by organ [kg] real(r8), intent(inout) :: c_efflux real(r8), intent(inout) :: n_efflux real(r8), intent(inout) :: p_efflux @@ -1598,18 +1538,17 @@ subroutine CNPAllocateRemainder(this,c_gain, n_gain, p_gain, & real(r8) :: target_p real(r8) :: store_c_target ! Target amount of C in storage including "overflow" [kgC] real(r8) :: total_c_flux ! Total C flux from gains into storage and growth R [kgC] - real(r8) :: growth_r_flux ! Growth respiration for filling storage [kgC] real(r8) :: store_m_flux ! Flux into storage [kg] - integer, dimension(num_organs),parameter :: all_organs = [1,2,3,4,5,6] real(r8), pointer :: dbh + real(r8), pointer :: resp_excess integer :: ipft real(r8) :: canopy_trim - + dbh => this%bc_inout(acnp_bc_inout_id_dbh)%rval canopy_trim = this%bc_in(acnp_bc_in_id_ctrim)%rval ipft = this%bc_in(acnp_bc_in_id_pft)%ival - + resp_excess => this%bc_inout(acnp_bc_inout_id_resp_excess)%rval ! ----------------------------------------------------------------------------------- ! If nutrients are still available, then we can bump up the values in the pools @@ -1619,11 +1558,11 @@ subroutine CNPAllocateRemainder(this,c_gain, n_gain, p_gain, & do i = 1, num_organs ! Update the nitrogen and phosphorus deficits - target_n = this%GetNutrientTarget(nitrogen_element,organ_list(i),stoich_max) - deficit_n(i) = max(0._r8,this%GetDeficit(nitrogen_element,organ_list(i),target_n)) + target_n = this%GetNutrientTarget(nitrogen_element,l2g_organ_list(i),stoich_max) + deficit_n(i) = max(0._r8,this%GetDeficit(nitrogen_element,l2g_organ_list(i),target_n)) - target_p = this%GetNutrientTarget(phosphorus_element,organ_list(i),stoich_max) - deficit_p(i) = max(0._r8,this%GetDeficit(phosphorus_element,organ_list(i),target_p)) + target_p = this%GetNutrientTarget(phosphorus_element,l2g_organ_list(i),stoich_max) + deficit_p(i) = max(0._r8,this%GetDeficit(phosphorus_element,l2g_organ_list(i),target_p)) end do @@ -1633,26 +1572,13 @@ subroutine CNPAllocateRemainder(this,c_gain, n_gain, p_gain, & ! ----------------------------------------------------------------------------------- ! Nitrogen - call ProportionalNutrAllocation(state_n(1:num_organs), & - deficit_n(1:num_organs), & - n_gain, nitrogen_element, all_organs) + call ProportionalNutrAllocation(this,deficit_n(1:num_organs), & + n_gain, nitrogen_element, l2g_organ_list(1:num_organs)) ! Phosphorus - call ProportionalNutrAllocation(state_p(1:num_organs), & - deficit_p(1:num_organs), & - p_gain, phosphorus_element, all_organs) - - - ! Optional hypothesis ( - ! If any N or P is still hanging around, put it in storage + call ProportionalNutrAllocation(this,deficit_p(1:num_organs), & + p_gain, phosphorus_element, l2g_organ_list(1:num_organs)) - !state_n(store_id)%ptr = state_n(store_id)%ptr + n_gain - !state_p(store_id)%ptr = state_p(store_id)%ptr + p_gain - - !n_gain = 0._r8 - !p_gain = 0._r8 - - ! ----------------------------------------------------------------------------------- ! If carbon is still available, lets cram some into storage overflow ! We will do this last, because we wanted the non-overflow storage @@ -1661,40 +1587,45 @@ subroutine CNPAllocateRemainder(this,c_gain, n_gain, p_gain, & if(c_gain>calloc_abs_error) then + if(store_c_overflow == retain_c_store_overflow)then + + total_c_flux = c_gain + ! Transfer excess carbon into storage overflow + this%variables(store_c_id)%val(1) = this%variables(store_c_id)%val(1) + total_c_flux + c_gain = c_gain - total_c_flux + + elseif(store_c_overflow == burn_c_store_overflow) then -! select(c_overlow_method) -! case(store_c_overflow) - -! case(efflux_c_overflow) - -! case(burn_c_overflow) - -! end if - - - - if(force_store_c_overflow)then + ! Update carbon based allometric targets + call bstore_allom(dbh,ipft,canopy_trim, store_c_target) + + ! Allow some overflow + store_c_target = store_c_target * (1.0_r8 + store_overflow_frac) - total_c_flux = c_gain - else + total_c_flux = min(c_gain,max(0.0, (store_c_target - this%variables(store_c_id)%val(1)))) + ! Transfer excess carbon into storage overflow + this%variables(store_c_id)%val(1) = this%variables(store_c_id)%val(1) + total_c_flux + c_gain = c_gain - total_c_flux + + resp_excess = c_gain + c_gain = 0._r8 + elseif(store_c_overflow == exude_c_store_overflow)then + ! Update carbon based allometric targets call bstore_allom(dbh,ipft,canopy_trim, store_c_target) ! Estimate the overflow store_c_target = store_c_target * (1.0_r8 + store_overflow_frac) - total_c_flux = min(c_gain,max(0.0, (store_c_target - state_c(store_id)%ptr))) + total_c_flux = min(c_gain,max(0.0, (store_c_target - this%variables(store_c_id)%val(1)))) + ! Transfer excess carbon into storage overflow + this%variables(store_c_id)%val(1) = this%variables(store_c_id)%val(1) + total_c_flux + c_gain = c_gain - total_c_flux end if - ! Transfer excess carbon into storage overflow - state_c(store_id)%ptr = state_c(store_id)%ptr + total_c_flux - c_gain = c_gain - total_c_flux - - end if - ! Figure out what to do with excess carbon and nutrients @@ -1815,7 +1746,7 @@ function GetNutrientTargetCNP(this,element_id,organ_id,stoich_mode) result(targe end if - ! Hard-code the growth minimum storage stoichiometry to 75% of maximum + ! Hard-code the growth minimum storage stoichiometry to 25% of maximum if( stoich_mode == stoich_growth_min ) then target_m = target_m*0.25_r8 end if @@ -1870,7 +1801,7 @@ end function GetNutrientTargetCNP ! ===================================================================================== - subroutine ProportionalNutrAllocation(state_m, deficit_m, gain_m, element_id, list) + subroutine ProportionalNutrAllocation(this,deficit_m, gain_m, element_id, list) ! ----------------------------------------------------------------------------------- ! This routine allocates nutrients to a set of organs based on proportional @@ -1879,19 +1810,18 @@ subroutine ProportionalNutrAllocation(state_m, deficit_m, gain_m, element_id, li ! Note: this may or may not be called inside some preferential organ filter. ! ----------------------------------------------------------------------------------- - type(parray_type) :: state_m(:) ! Current mass of nutrient - ! of arbitrary species - ! over some arbitrary set of organs + class(cnp_allom_prt_vartypes) :: this real(r8),intent(inout) :: deficit_m(:) ! Nutrient mass deficit of species ! over set of organs - integer, intent(in) :: list(:) ! List of indices if sparse + integer, intent(in) :: list(:) ! List of organ indices from PRTGenericMod real(r8),intent(inout) :: gain_m ! Total nutrient mass gain to ! work with - integer,intent(in) :: element_id ! Element global index (for debugging) + integer,intent(in) :: element_id ! Element global index ! locals integer :: num_organs - integer :: i,ii + integer :: i,i_org + integer :: i_var real(r8) :: flux real(r8) :: sum_deficit real(r8) :: sum_flux @@ -1899,8 +1829,8 @@ subroutine ProportionalNutrAllocation(state_m, deficit_m, gain_m, element_id, li num_organs = size(list,dim=1) sum_deficit = 0._r8 - do ii = 1, num_organs - i = list(ii) + do i = 1, num_organs + i_org = list(i) sum_deficit = sum_deficit + max(0._r8,deficit_m(i)) end do @@ -1908,11 +1838,14 @@ subroutine ProportionalNutrAllocation(state_m, deficit_m, gain_m, element_id, li sum_flux = min(gain_m, sum_deficit) - do ii = 1, num_organs - i = list(ii) + do i = 1, num_organs + i_org = list(i) + + flux = sum_flux * max(0._r8,deficit_m(i))/sum_deficit + + i_var = prt_global%sp_organ_map(i_org,element_id) + this%variables(i_var)%val(1) = this%variables(i_var)%val(1) + flux - flux = sum_flux * max(0._r8,deficit_m(i))/sum_deficit - state_m(i)%ptr = state_m(i)%ptr + flux deficit_m(i) = deficit_m(i) - flux gain_m = gain_m - flux @@ -2176,7 +2109,7 @@ end subroutine TargetAllometryCheck ! ===================================================================================== - subroutine StorageRegulator(this,element_id,regulate_type,c_scalar) + subroutine StorageRegulator(this,element_id,regulate_type,target_c,c_scalar) ! ----------------------------------------------------------------------------------- ! This function evaluates the storage of either N or P, and returns @@ -2190,7 +2123,8 @@ subroutine StorageRegulator(this,element_id,regulate_type,c_scalar) class(cnp_allom_prt_vartypes) :: this integer,intent(in) :: element_id ! element id consistent with parteh/PRTGenericMod.F90 integer,intent(in) :: regulate_type - + real(r8) :: target_c(:) + ! Arguments (out) real(r8) :: c_scalar @@ -2198,12 +2132,10 @@ subroutine StorageRegulator(this,element_id,regulate_type,c_scalar) ! Locals real(r8) :: store_frac ! Current nutrient storage relative to max real(r8) :: store_max ! Maximum nutrient storable by plant - real(r8) :: store_c ! Current storage carbon - real(r8) :: store_c_max ! Current maximum storage carbon integer :: icode ! real variable checking code real(r8) :: store_x integer :: i_var - real(r8), parameter :: c_eq_offset = 0.95 ! This shifts the center-point + real(r8), parameter :: c_eq_offset = 1.0_r8 ! This shifts the center-point ! of the N:C or P:C storage equlibrium ! by multiplying the C term. If its less than 1 it ! shifts left and great than one it shifts right. @@ -2216,18 +2148,15 @@ subroutine StorageRegulator(this,element_id,regulate_type,c_scalar) real(r8) :: logi_min ! minimum cn_scalar for logistic real(r8) :: l2fr_delta_max real(r8) :: l2fr_delta_min + real(r8) :: l2fr_delta_scale real(r8) :: l2fr_actual real(r8) :: leaf_c, fnrt_c - real(r8) :: leaf_c_target + real(r8) :: struct_c, sapw_c, store_c real(r8) :: log_nc_frac + real(r8) :: nc_frac real(r8) :: store_c_frac real(r8) :: c_gain - real(r8) :: fnrt_c_target - ! This is the storage fraction where downregulation starts if using - ! a linear function - real(r8), parameter :: store_frac0 = 0.85_r8 - real(r8), parameter :: c_max = 1.0_r8 ! Maximum allowable result of the function real(r8), parameter :: c_min = 0.0_r8 ! Minimum allowable result of the function @@ -2235,162 +2164,140 @@ subroutine StorageRegulator(this,element_id,regulate_type,c_scalar) ! how much carbon from daily gains + storage overflow, is allowed to ! be spent on growing out roots. This inludes getting roots ! back on allometry before growing out - + integer, parameter :: limit_all = 1 + integer, parameter :: limit_lf = 2 + + integer :: lim_l2fr_max_type = limit_all real(r8), parameter :: max_l2fr_cgain_frac = 0.5_r8 associate(dbh => this%bc_inout(acnp_bc_inout_id_dbh)%rval, & canopy_trim => this%bc_in(acnp_bc_in_id_ctrim)%rval, & ipft => this%bc_in(acnp_bc_in_id_pft)%ival, & l2fr => this%bc_inout(acnp_bc_inout_id_l2fr)%rval) - - store_max = this%GetNutrientTarget(element_id,store_organ,stoich_max) - ! Storage fractions could more than the target, depending on the - ! hypothesis and functions involved, but should typically be 0-1 - ! The cap of 2 is for numerics and preventing weird math - store_frac = max(0.01_r8,min(1.0_r8,this%GetState(store_organ, element_id)/store_max)) + logi_k = 2._r8 + store_x0 = 0.0_r8 + logi_min = 0.0_r8 - if(regulate_type == regulate_linear) then - c_scalar = min(c_max,max(c_min,1.0 - (store_frac - store_frac0)/(1.0_r8-store_frac0))) + if(regulate_type == regulate_CN_logi) then + + store_c = this%GetState(store_organ, carbon12_element) - elseif(regulate_type == regulate_logi) then + ! Fraction of N per fraction of C + ! If this is greater than 1, then we have more N in storage than + ! we have C, so we downregulate. If this is less than 1, then + ! we have less N in storage than we have C, so up-regulate + + store_frac = log(max(0.01_r8,store_frac) / max(0.01_r8,(store_c/target_c(store_organ)))) + + c_scalar = max(0._r8,min(1._r8,logi_min + (1._r8-logi_min)/(1.0 + exp(logi_k*(store_frac-store_x0))))) + + elseif(regulate_type == regulate_CN_dfdd) then - logi_k = 30.0_r8 - store_x0 = 0.7_r8 - logi_min = 0.0_r8 - ! In this method, we define the c_scalar term - ! with a logistic function that goes to 1 (full need) - ! as the plant's nutrien storage hits a low threshold - ! and goes to 0, no demand, as the plant's nutrient - ! storage approaches it's maximum holding capacity - - c_scalar = max(c_min,min(c_max,logi_min + (1.0_r8-logi_min)/(1.0_r8 + exp(logi_k*(store_frac-store_x0))))) - - !call check_var_real(c_scalar,'c_scalar',icode) - !if (icode .ne. 0) then - ! write(fates_log(),*) 'c_scalar is invalid, element: ',element_id - ! write(fates_log(),*) 'ending' - ! call endrun(msg=errMsg(sourcefile, __LINE__)) - !endif - - elseif(regulate_type == regulate_CN_logi .or. regulate_type == regulate_CN_ema) then - - logi_k = 1.0_r8 - store_x0 = 0.0_r8 - logi_min = 0.0_r8 - - ! Only update L2FR if some leaves are out - call bleaf(dbh,ipft,canopy_trim,leaf_c_target) - if(this%GetState(leaf_organ, carbon12_element)/leaf_c_target>0.01_r8) then - store_max = this%GetNutrientTarget(element_id,store_organ,stoich_max) - - ! Storage fractions could be more than the target, depending on the - ! hypothesis and functions involved, but should typically be 0-1 - ! The cap of 2 is for numerics and preventing weird math - - store_frac = max(0.01_r8,min(2.0_r8,this%GetState(store_organ, element_id)/store_max)) - - - call bstore_allom(dbh,ipft,canopy_trim,store_c_max) - - ! Since we don't dump storage carbon - ! these stores can actually get pretty large, so the cap of 10x is numerically - ! feasable, and should also minimize stress on the logistic function - store_c_frac = max(0.01_r8,min(10.0_r8,c_eq_offset*(this%GetState(store_organ, carbon12_element)/store_c_max))) - - - ! ----------------------------------------------------------------------------- - ! To decide the upper limit on expanding root growth, we perform a carbon - ! balance. Note that if we are growing roots out more, than we have proportionaly - ! more C compared to other resources. Specifically, we want to limit root growth - ! such that allocation to roots can't exceed a certain fraction of the daily - ! available carbon. This fraction is "max_l2fr_cgain_frac". - ! Additional notes. When calculating the "allocation to roots", we consider - ! both the carbon necessary to get the roots "on allometry" plux the carbon - ! necessary to expand them. - ! - ! (l2fr_delta_max*target_fnrt_c + target_fnrt_c-actual_fnrt_c )/c_gain - ! < max_l2fr_cgain_frac - ! - ! or - ! - ! l2fr_delta_max*target_fnrt_c < max_l2fr_cgain_frac * (c_gain - - ! (target_fnrt_c-actual_fnrt_c) - - ! (target_leaf_c-actual_leaf_c)) - ! - ! ------------------------------------------------------------------------------ - - call bfineroot(dbh,ipft,canopy_trim, l2fr, fnrt_c_target) - call bleaf(dbh,ipft,canopy_trim,leaf_c_target) - - ! If there is overflow storage, add this to the gain - c_gain = this%bc_in(acnp_bc_in_id_netdc)%rval + & - max(0._r8,this%GetState(store_organ, carbon12_element)-store_c_max) + store_max = this%GetNutrientTarget(element_id,store_organ,stoich_max) - fnrt_c = this%GetState(fnrt_organ, carbon12_element) - leaf_c = this%GetState(leaf_organ, carbon12_element) - - l2fr_delta_max = max_l2fr_cgain_frac / fnrt_c_target * & - (c_gain - (fnrt_c_target-fnrt_c) - (leaf_c_target-leaf_c)) + ! Storage fractions could be more than the target, depending on the + ! hypothesis and functions involved, but should typically be 0-1 + ! The cap of 5 is for numerics and preventing weird math - ! This value could be negative if there is no gain, or less gain - ! than what can replace leaf/root, just ensure the multiplier is GT 1 + + store_frac = max(0.01_r8,min(5.0_r8,this%GetState(store_organ, element_id)/store_max)) + + ! Since we don't dump storage carbon + ! these stores can actually get pretty large, so the cap of 10x is numerically + ! feasable, and should also minimize stress on the logistic function + store_c_frac = max(0.01_r8,min(5.0_r8,c_eq_offset*(this%GetState(store_organ, carbon12_element)/target_c(store_organ) ))) + + + ! ----------------------------------------------------------------------------- + ! To decide the upper limit on expanding root growth, we perform a carbon + ! balance. Note that if we are growing roots out more, than we have proportionaly + ! more C compared to other resources. Specifically, we want to limit root growth + ! such that allocation to roots can't exceed a certain fraction of the daily + ! available carbon. This fraction is "max_l2fr_cgain_frac". + ! Additional notes. When calculating the "allocation to roots", we consider + ! both the carbon necessary to get the roots "on allometry" plux the carbon + ! necessary to expand them. + ! + ! (l2fr_delta_max*target_fnrt_c + target_fnrt_c-actual_fnrt_c )/c_gain + ! < max_l2fr_cgain_frac + ! + ! or + ! + ! l2fr_delta_max*target_fnrt_c < max_l2fr_cgain_frac * (c_gain - + ! (target_fnrt_c-actual_fnrt_c) - + ! (target_leaf_c-actual_leaf_c)) + ! + ! or + ! as much as you like as long as turnover is replaced + ! + ! l2fr_delta_max*target_fnrt_c < c_gain - (target_fnrt_c-actual_fnrt_c) - + ! (target_leaf_c-actual_leaf_c) - + ! (target_sapw_c-actual_sapw_c) - + ! (target_dead_c-actual_dead_c) - + ! (target_stor_c-actual_stor_c) + ! + ! ------------------------------------------------------------------------------ + + ! If there is overflow storage, add this to the gain + c_gain = this%bc_in(acnp_bc_in_id_netdc)%rval + + fnrt_c = this%GetState(fnrt_organ, carbon12_element) + leaf_c = this%GetState(leaf_organ, carbon12_element) + store_c = this%GetState(store_organ, carbon12_element) + struct_c = this%GetState(struct_organ, carbon12_element) + sapw_c = this%GetState(sapw_organ, carbon12_element) + + if(lim_l2fr_max_type == limit_lf)then + l2fr_delta_max = max_l2fr_cgain_frac / target_c(fnrt_organ) * & + (c_gain - max(0._r8,target_c(fnrt_organ)-fnrt_c) - max(0._r8,target_c(leaf_organ)-leaf_c)) + + elseif(lim_l2fr_max_type ==limit_all)then + l2fr_delta_max = 1._r8/target_c(fnrt_organ) * & + (c_gain - & + max(0._r8,target_c(fnrt_organ)-fnrt_c) - & + max(0._r8,target_c(leaf_organ)-leaf_c) - & + max(0._r8,target_c(sapw_organ)-sapw_c) - & + max(0._r8,target_c(struct_organ)-struct_c) - & + max(0._r8,target_c(store_organ)-store_c) ) - l2fr_delta_max = max(1._r8,l2fr_delta_max) + end if + ! This value could be negative if there is no gain, or less gain + ! than what can replace leaf/root, just ensure the multiplier is GT 1 - ! Second constraint, folding timescale - ! 2.0 = l2fr_delta_max^frnt_adapt_tscl - l2fr_delta_max = min(l2fr_delta_max, 2._r8**(1._r8/fnrt_adapt_tscl)) - - - l2fr_actual = this%GetState(fnrt_organ, carbon12_element) / & - this%GetState(leaf_organ, carbon12_element) + l2fr_delta_max = max(1._r8,l2fr_delta_max) - ! Constrain change in l2fr minimum to be no more than what is lost - ! in turnover for a day - l2fr_delta_min = 1._r8-(years_per_day / prt_params%root_long(ipft)) + ! Constrain change in l2fr minimum to be no more than what is lost + ! in turnover for a day + l2fr_delta_min = 1._r8-(years_per_day / prt_params%root_long(ipft)) - ! Second constraint, folding timescale - l2fr_delta_min = max(l2fr_delta_min, 0.5_r8**(1._r8/fnrt_adapt_tscl)) + ! Determine the max change for the doubling timescale + ! 2.0 = l2fr_delta_max^frnt_adapt_tscl + l2fr_delta_scale = 2._r8**(1._r8/fnrt_adapt_tscl)-1.0_r8 - - log_nc_frac = log( store_frac / store_c_frac ) - - ! This is a logistic between -1 and 1 - c_scalar = 2._r8*max(0._r8, & - min(1._r8,logi_min + (1._r8-logi_min)/(1._r8 + exp(logi_k*(log_nc_frac-store_x0)))))-1.0_r8 - - if(c_scalar>0.0_r8)then - c_scalar = 1._r8 + c_scalar*(l2fr_delta_max-1._r8) - else - c_scalar = 1._r8 + c_scalar*(1._r8-l2fr_delta_min) - end if - - else - c_scalar = 1._r8 - end if - - - elseif(regulate_type == regulate_CN_dfdd) then + ! Determiine the change for the halving timescale + !l2fr_scale_min = 0.5_r8**(1._r8/fnrt_adapt_tscl) - store_c = this%GetState(store_organ, carbon12_element) - call bstore_allom(dbh,ipft,canopy_trim,store_c_max) + !log_nc_frac = log( store_frac / store_c_frac ) - ! Fraction of N per fraction of C - ! If this is greater than 1, then we have more N in storage than - ! we have C, so we downregulate. If this is less than 1, then - ! we have less N in storage than we have C, so up-regulate + ! This is a logistic between -1 and 1 + !c_scalar = l2fr_delta_scale*2._r8*max(0._r8, & + ! min(1._r8,logi_min + (1._r8-logi_min)/(1._r8 + exp(logi_k*(log_nc_frac-store_x0)))))-1.0_r8 - + nc_frac = store_frac / store_c_frac - store_frac = max(0.01_r8,store_frac) / max(0.01_r8,c_eq_offset*(store_c/store_c_max)) + c_scalar = l2fr_delta_scale*(2.0_r8/(1.0_r8 + nc_frac**logi_k)-1.0_r8)+1.0_r8 - c_scalar = 1._r8 - 0.02_r8*log(store_frac) + + if(c_scalar>1.0_r8)then + c_scalar = min(c_scalar,l2fr_delta_max) + else + c_scalar = max(c_scalar,l2fr_delta_min) + end if - !print*,element_id,store_frac,c_scalar end if diff --git a/parteh/PRTGenericMod.F90 b/parteh/PRTGenericMod.F90 index cfd398ec58..b92a1e14a7 100644 --- a/parteh/PRTGenericMod.F90 +++ b/parteh/PRTGenericMod.F90 @@ -100,7 +100,6 @@ module PRTGenericMod ! element. At the time of writing this, we are very far away from ! creating allocation schemes that even use potassium. - integer, parameter, public :: all_carbon_elements = 0 integer, parameter, public :: carbon12_element = 1 integer, parameter, public :: carbon13_element = 2 integer, parameter, public :: carbon14_element = 3 @@ -136,7 +135,7 @@ module PRTGenericMod ! List of all carbon elements, the special index "all_carbon_elements" - ! implies the following list of carbon organs + ! implies the following list of carbon organs (NOT USED) integer, parameter, dimension(3), public :: carbon_elements_list = & [carbon12_element, carbon13_element, carbon14_element] @@ -999,44 +998,23 @@ function GetState(this, organ_id, element_id, position_id) result(state_val) integer,intent(in) :: element_id ! Element type querried integer,intent(in),optional :: position_id ! Position querried real(r8) :: state_val ! Mass (value) of state variable [kg] - integer :: i_pos ! position loop counter - integer :: i_element ! element loop counter - integer :: num_element ! total number of elements - integer,dimension(max_spec_per_group) :: element_ids ! element ids (if element list) integer :: i_var ! variable id - - state_val = 0.0_r8 - - if(element_id == all_carbon_elements) then - element_ids(1:3) = carbon_elements_list(1:3) - num_element = 3 - else - num_element = 1 - element_ids(1) = element_id - end if if(present(position_id)) then - i_pos = position_id - - do i_element = 1,num_element - i_var = prt_global%sp_organ_map(organ_id,element_ids(i_element)) - if (i_var>0) state_val = state_val + this%variables(i_var)%val(i_pos) - end do + i_pos = position_id + i_var = prt_global%sp_organ_map(organ_id,element_id) + state_val = this%variables(i_var)%val(i_pos) + else - do i_element = 1,num_element - - i_var = prt_global%sp_organ_map(organ_id,element_ids(i_element)) - if(i_var>0)then - do i_pos = 1, prt_global%state_descriptor(i_var)%num_pos - state_val = state_val + this%variables(i_var)%val(i_pos) - end do - end if - + state_val = 0._r8 + i_var = prt_global%sp_organ_map(organ_id,element_id) + do i_pos = 1, prt_global%state_descriptor(i_var)%num_pos + state_val = state_val + this%variables(i_var)%val(i_pos) end do - + end if return @@ -1060,43 +1038,23 @@ function GetTurnover(this, organ_id, element_id, position_id) result(turnover_va integer,intent(in) :: element_id ! Element type querried integer,intent(in),optional :: position_id ! Position querried real(r8) :: turnover_val ! Amount (value) of turnover [kg] - integer :: i_pos ! position loop counter - integer :: i_element ! element loop counter - integer :: num_element ! total number of elements - integer,dimension(max_spec_per_group) :: element_ids ! element ids (if element list) integer :: i_var ! variable id - turnover_val = 0.0_r8 - - if(element_id == all_carbon_elements) then - element_ids(1:3) = carbon_elements_list(1:3) - num_element = 3 - else - num_element = 1 - element_ids(1) = element_id - end if - if(present(position_id)) then + i_pos = position_id - - do i_element = 1,num_element - i_var = prt_global%sp_organ_map(organ_id,element_ids(i_element)) - if(i_var>0) turnover_val = turnover_val + & - this%variables(i_var)%turnover(i_pos) - end do + i_var = prt_global%sp_organ_map(organ_id,element_id) + turnover_val = this%variables(i_var)%turnover(i_pos) else - do i_element = 1,num_element - i_var = prt_global%sp_organ_map(organ_id,element_ids(i_element)) - if(i_var>0) then - do i_pos = 1, prt_global%state_descriptor(i_var)%num_pos - turnover_val = turnover_val + this%variables(i_var)%turnover(i_pos) - end do - end if - + turnover_val = 0.0_r8 + i_var = prt_global%sp_organ_map(organ_id,element_id) + do i_pos = 1, prt_global%state_descriptor(i_var)%num_pos + turnover_val = turnover_val + this%variables(i_var)%turnover(i_pos) end do + end if @@ -1117,43 +1075,21 @@ function GetBurned(this, organ_id, element_id, position_id) result(burned_val) integer,intent(in) :: element_id ! Element type querried integer,intent(in),optional :: position_id ! Position querried real(r8) :: burned_val ! Amount (value) of burned [kg] - integer :: i_pos ! position loop counter - integer :: i_element ! element loop counter - integer :: num_element ! total number of elements - integer,dimension(max_spec_per_group) :: element_ids ! element ids (if element list) integer :: i_var ! variable id - - burned_val = 0.0_r8 - - if(element_id == all_carbon_elements) then - element_ids(1:3) = carbon_elements_list(1:3) - num_element = 3 - else - num_element = 1 - element_ids(1) = element_id - end if - if(present(position_id)) then + i_pos = position_id - - do i_element = 1,num_element - i_var = prt_global%sp_organ_map(organ_id,element_ids(i_element)) - if(i_var>0) burned_val = burned_val + & - this%variables(i_var)%burned(i_pos) - end do + i_var = prt_global%sp_organ_map(organ_id,element_id) + burned_val = this%variables(i_var)%burned(i_pos) else - do i_element = 1,num_element - i_var = prt_global%sp_organ_map(organ_id,element_ids(i_element)) - if(i_var>0) then - do i_pos = 1, prt_global%state_descriptor(i_var)%num_pos - burned_val = burned_val + this%variables(i_var)%burned(i_pos) - end do - end if - + burned_val = 0.0_r8 + i_var = prt_global%sp_organ_map(organ_id,element_id) + do i_pos = 1, prt_global%state_descriptor(i_var)%num_pos + burned_val = burned_val + this%variables(i_var)%burned(i_pos) end do end if @@ -1176,42 +1112,21 @@ function GetNetAlloc(this, organ_id, element_id, position_id) result(val_netallo integer,intent(in) :: element_id ! Element type querried integer,intent(in),optional :: position_id ! Position querried real(r8) :: val_netalloc ! Amount (value) of allocation [kg] - integer :: i_pos ! position loop counter - integer :: i_element ! element loop counter - integer :: num_element ! total number of elements - integer,dimension(max_spec_per_group) :: element_ids ! element ids (if element list) integer :: i_var ! variable id - - val_netalloc = 0.0_r8 - if(element_id == all_carbon_elements) then - element_ids(1:3) = carbon_elements_list(1:3) - num_element = 3 - else - num_element = 1 - element_ids(1) = element_id - end if - if(present(position_id)) then - i_pos = position_id - - do i_element = 1,num_element - i_var = prt_global%sp_organ_map(organ_id,element_ids(i_element)) - if(i_var>0) val_netalloc = val_netalloc + & - this%variables(i_var)%net_alloc(i_pos) - end do - else + i_pos = position_id + i_var = prt_global%sp_organ_map(organ_id,element_id) + val_netalloc = this%variables(i_var)%net_alloc(i_pos) - do i_element = 1,num_element - i_var = prt_global%sp_organ_map(organ_id,element_ids(i_element)) - if(i_var>0) then - do i_pos = 1, prt_global%state_descriptor(i_var)%num_pos - val_netalloc = val_netalloc + this%variables(i_var)%net_alloc(i_pos) - end do - end if - + else + + val_netalloc = 0.0_r8 + i_var = prt_global%sp_organ_map(organ_id,element_id) + do i_pos = 1, prt_global%state_descriptor(i_var)%num_pos + val_netalloc = val_netalloc + this%variables(i_var)%net_alloc(i_pos) end do end if @@ -1280,12 +1195,6 @@ subroutine SetState(prt,organ_id, element_id, state_val, position_id) integer :: i_var ! variable loop counter integer :: i_pos ! position loop counter - if(element_id == all_carbon_elements) then - write(fates_log(),*) 'You cannot set the state of all isotopes simultaneously.' - write(fates_log(),*) 'You can only set 1. Exiting.' - call endrun(msg=errMsg(sourcefile, __LINE__)) - end if - if( present(position_id) ) then i_pos = position_id else From 1e34c399f25c76408809147f3821bcc8184b7e61 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Fri, 1 Apr 2022 11:37:12 -0400 Subject: [PATCH 19/55] Various updates to l2fr search algorithm --- biogeochem/EDCohortDynamicsMod.F90 | 9 +- biogeochem/FatesSoilBGCFluxMod.F90 | 8 +- main/EDMainMod.F90 | 2 +- main/FatesHistoryInterfaceMod.F90 | 12 +- parteh/PRTAllometricCNPMod.F90 | 442 +++++++++++++++++++++-------- 5 files changed, 333 insertions(+), 140 deletions(-) diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index 7c3fe61322..c6dc4fea72 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -97,7 +97,7 @@ module EDCohortDynamicsMod !use PRTAllometricCNPMod, only : acnp_bc_in_id_l2fr_ema use PRTAllometricCNPMod, only : acnp_bc_inout_id_l2fr use PRTAllometricCNPMod, only : acnp_bc_inout_id_resp_excess, acnp_bc_in_id_netdc - use PRTAllometricCNPMod, only : acnp_bc_in_id_netdn, acnp_bc_in_id_netdp + use PRTAllometricCNPMod, only : acnp_bc_inout_id_netdn, acnp_bc_inout_id_netdp use PRTAllometricCNPMod, only : acnp_bc_out_id_cefflux, acnp_bc_out_id_nefflux use PRTAllometricCNPMod, only : acnp_bc_out_id_pefflux use PRTAllometricCNPMod, only : fnrt_adapt_tscl @@ -428,14 +428,15 @@ subroutine InitPRTBoundaryConditions(new_cohort) call new_cohort%prt%RegisterBCIn(acnp_bc_in_id_ctrim,bc_rval = new_cohort%canopy_trim) call new_cohort%prt%RegisterBCIn(acnp_bc_in_id_lstat,bc_ival = new_cohort%status_coh) call new_cohort%prt%RegisterBCIn(acnp_bc_in_id_netdc, bc_rval = new_cohort%npp_acc) - call new_cohort%prt%RegisterBCIn(acnp_bc_in_id_netdn, bc_rval = new_cohort%daily_n_gain) - call new_cohort%prt%RegisterBCIn(acnp_bc_in_id_netdp, bc_rval = new_cohort%daily_p_uptake) + !!call new_cohort%prt%RegisterBCIn(acnp_bc_in_id_l2fr_ema, bc_rval = new_cohort%l2fr_ema%l_mean) call new_cohort%prt%RegisterBCInOut(acnp_bc_inout_id_dbh,bc_rval = new_cohort%dbh) call new_cohort%prt%RegisterBCInOut(acnp_bc_inout_id_resp_excess,bc_rval = new_cohort%resp_excess) call new_cohort%prt%RegisterBCInOut(acnp_bc_inout_id_l2fr,bc_rval = new_cohort%l2fr) - + call new_cohort%prt%RegisterBCInOut(acnp_bc_inout_id_netdn, bc_rval = new_cohort%daily_n_gain) + call new_cohort%prt%RegisterBCInOut(acnp_bc_inout_id_netdp, bc_rval = new_cohort%daily_p_uptake) + call new_cohort%prt%RegisterBCOut(acnp_bc_out_id_cefflux, bc_rval = new_cohort%daily_c_efflux) call new_cohort%prt%RegisterBCOut(acnp_bc_out_id_nefflux, bc_rval = new_cohort%daily_n_efflux) call new_cohort%prt%RegisterBCOut(acnp_bc_out_id_pefflux, bc_rval = new_cohort%daily_p_efflux) diff --git a/biogeochem/FatesSoilBGCFluxMod.F90 b/biogeochem/FatesSoilBGCFluxMod.F90 index 3556013556..00dd0202cd 100644 --- a/biogeochem/FatesSoilBGCFluxMod.F90 +++ b/biogeochem/FatesSoilBGCFluxMod.F90 @@ -225,8 +225,8 @@ subroutine UnPackNutrientAquisitionBCs(sites, bc_in) ccohort => cpatch%tallest do while (associated(ccohort)) pft = ccohort%pft - ccohort%daily_n_demand = GetPlantDemand(ccohort,nitrogen_element) - ccohort%daily_nh4_uptake = EDPftvarcon_inst%prescribed_nuptake(pft) * ccohort%daily_n_demand + !ccohort%daily_n_demand = GetPlantDemand(ccohort,nitrogen_element) + ccohort%daily_nh4_uptake = -9._r8 !EDPftvarcon_inst%prescribed_nuptake(pft) * ccohort%daily_n_demand ccohort%daily_no3_uptake = 0._r8 ccohort => ccohort%shorter end do @@ -258,8 +258,8 @@ subroutine UnPackNutrientAquisitionBCs(sites, bc_in) ccohort => cpatch%tallest do while (associated(ccohort)) pft = ccohort%pft - ccohort%daily_p_demand = GetPlantDemand(ccohort,phosphorus_element) - ccohort%daily_p_uptake = EDPftvarcon_inst%prescribed_puptake(pft) * ccohort%daily_p_demand + !ccohort%daily_p_demand = GetPlantDemand(ccohort,phosphorus_element) + ccohort%daily_p_uptake = -9._r8 !EDPftvarcon_inst%prescribed_puptake(pft) * ccohort%daily_p_demand ccohort => ccohort%shorter end do cpatch => cpatch%younger diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index 28fefe9da2..d866ca0c2e 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -452,7 +452,7 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) currentCohort%resp_excess = 0._r8 call currentCohort%prt%DailyPRT() - + ! Send any efflux/exudates to the labile litter pools in the HLM ! ----------------------------------------------------------------------------- diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 48d0efb3c1..4acf85bddb 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -81,7 +81,7 @@ module FatesHistoryInterfaceMod use PRTGenericMod , only : carbon12_element use PRTGenericMod , only : nitrogen_element, phosphorus_element use PRTGenericMod , only : prt_carbon_allom_hyp - use PRTAllometricCNPMod , only : stoich_max + use PRTAllometricCNPMod , only : stoich_max,stoich_growth_min,stoich_center implicit none private ! By default everything is private @@ -2550,7 +2550,7 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) fnrtc_understory_scpf(i_scpf) = fnrtc_understory_scpf(i_scpf) + ccohort%n*fnrt_m end if - call bstore_allom(ccohort%dbh,ccohort%pft,ccohort%canopy_trim, store_max) + call bstore_allom(ccohort%dbh,ccohort%pft,ccohort%canopy_trim, store_growth_min) this%hvars(ih_storectfrac_si)%r81d(io_si) = & this%hvars(ih_storectfrac_si)%r81d(io_si) + ccohort%n * store_max/m2_per_ha @@ -2595,7 +2595,7 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) elseif(element_list(el).eq.nitrogen_element)then - store_max = ccohort%prt%GetNutrientTarget(element_list(el),store_organ,stoich_max) + store_max = ccohort%prt%GetNutrientTarget(element_list(el),store_organ,stoich_center) this%hvars(ih_storen_si)%r81d(io_si) = & this%hvars(ih_storen_si)%r81d(io_si) + ccohort%n * & @@ -2635,7 +2635,7 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) elseif(element_list(el).eq.phosphorus_element) then - store_max = ccohort%prt%GetNutrientTarget(element_list(el),store_organ,stoich_max) + store_max = ccohort%prt%GetNutrientTarget(element_list(el),store_organ,stoich_center) this%hvars(ih_storep_si)%r81d(io_si) = & this%hvars(ih_storep_si)%r81d(io_si) + ccohort%n * & @@ -3534,7 +3534,7 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) repro_m * ccohort%n / m2_per_ha elseif(element_list(el).eq.nitrogen_element)then - store_max = ccohort%prt%GetNutrientTarget(element_list(el),store_organ,stoich_max) + store_max = ccohort%prt%GetNutrientTarget(element_list(el),store_organ,stoich_center) this%hvars(ih_totvegn_scpf)%r82d(io_si,i_scpf) = & this%hvars(ih_totvegn_scpf)%r82d(io_si,i_scpf) + & @@ -3557,7 +3557,7 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) elseif(element_list(el).eq.phosphorus_element)then - store_max = ccohort%prt%GetNutrientTarget(element_list(el),store_organ,stoich_max) + store_max = ccohort%prt%GetNutrientTarget(element_list(el),store_organ,stoich_center) this%hvars(ih_totvegp_scpf)%r82d(io_si,i_scpf) = & this%hvars(ih_totvegp_scpf)%r82d(io_si,i_scpf) + & diff --git a/parteh/PRTAllometricCNPMod.F90 b/parteh/PRTAllometricCNPMod.F90 index 2392f42f46..67cf24ca65 100644 --- a/parteh/PRTAllometricCNPMod.F90 +++ b/parteh/PRTAllometricCNPMod.F90 @@ -57,6 +57,10 @@ module PRTAllometricCNPMod use FatesConstantsMod , only : sec_per_day use PRTParametersMod , only : prt_params use EDTypesMod , only : leaves_on,leaves_off + use EDTypesMod , only : p_uptake_mode + use EDTypesMod , only : n_uptake_mode + use FatesConstantsMod , only : prescribed_p_uptake + use FatesConstantsMod , only : prescribed_n_uptake implicit none private @@ -100,7 +104,8 @@ module PRTAllometricCNPMod ! minimum needed for growth integer,public, parameter :: stoich_max = 2 ! Flag for stoichiometry associated with ! maximum for that organ - + integer,public, parameter :: stoich_center=3 + ! This is the ordered list of organs used in this module ! ------------------------------------------------------------------------------------- @@ -141,7 +146,10 @@ module PRTAllometricCNPMod integer, public, parameter :: acnp_bc_inout_id_resp_excess = 2 ! Respiration of excess storage integer, public, parameter :: acnp_bc_inout_id_l2fr = 3 ! leaf 2 fineroot scalar, this ! is dynamic with CNP - integer, public, parameter :: num_bc_inout = 3 + integer, public, parameter :: acnp_bc_inout_id_netdn = 4 ! Index for the net daily NH4 input BC + integer, public, parameter :: acnp_bc_inout_id_netdp = 5 ! Index for the net daily P input BC + + integer, public, parameter :: num_bc_inout = 5 ! ------------------------------------------------------------------------------------- ! Input only Boundary Indices (These are public) @@ -151,11 +159,10 @@ module PRTAllometricCNPMod integer, public, parameter :: acnp_bc_in_id_ctrim = 2 ! Index for the canopy trim function integer, public, parameter :: acnp_bc_in_id_lstat = 3 ! phenology status logical integer, public, parameter :: acnp_bc_in_id_netdc = 4 ! Index for the net daily C input BC - integer, public, parameter :: acnp_bc_in_id_netdn = 5 ! Index for the net daily NH4 input BC - integer, public, parameter :: acnp_bc_in_id_netdp = 6 ! Index for the net daily P input BC + ! 0=leaf off, 1=leaf on - integer, parameter :: num_bc_in = 6 + integer, parameter :: num_bc_in = 4 ! ------------------------------------------------------------------------------------- ! Output Boundary Indices (These are public) @@ -190,7 +197,7 @@ module PRTAllometricCNPMod integer, parameter :: store_c_overflow = burn_c_store_overflow ! Following growth, if desired, you can prioritize reproductive - logical, parameter :: prioritize_repro_nutr_growth = .false. + logical, parameter :: prioritize_repro_nutr_growth = .true. ! Definitions for the regulation functions. These typically translate ! a storage fraction into a scalar used to regulate resources somehow @@ -223,6 +230,7 @@ module PRTAllometricCNPMod ! Extended functions specific to Allometric CNP procedure :: CNPPrioritizedReplacement procedure :: CNPStatureGrowth + procedure :: EstimateGrowthNC procedure :: CNPAdjustFRootTargets procedure :: CNPAllocateRemainder procedure :: GetDeficit @@ -339,8 +347,8 @@ subroutine DailyPRTAllometricCNP(this) ! Input only bcs integer :: ipft ! Plant Functional Type index real(r8) :: c_gain ! Daily carbon balance for this cohort [kgC] - real(r8) :: n_gain ! Daily nitrogen uptake through fine-roots [kgN] - real(r8) :: p_gain ! Daily phosphorus uptake through fine-roots [kgN] + real(r8),pointer :: n_gain ! Daily nitrogen uptake through fine-roots [kgN] + real(r8),pointer :: p_gain ! Daily phosphorus uptake through fine-roots [kgN] real(r8) :: canopy_trim ! The canopy trimming function [0-1] ! Pointers to output bcs @@ -356,7 +364,7 @@ subroutine DailyPRTAllometricCNP(this) real(r8) :: agw_c_target,agw_dcdd_target real(r8) :: bgw_c_target,bgw_dcdd_target real(r8) :: sapw_area - + real(r8) :: store_c_flux integer :: i ! generic organ loop index integer :: i_org ! organ index integer :: i_var ! variable index @@ -393,7 +401,9 @@ subroutine DailyPRTAllometricCNP(this) resp_excess => this%bc_inout(acnp_bc_inout_id_resp_excess)%rval; resp_excess0 = resp_excess dbh => this%bc_inout(acnp_bc_inout_id_dbh)%rval; dbh0 = dbh l2fr => this%bc_inout(acnp_bc_inout_id_l2fr)%rval - + n_gain => this%bc_inout(acnp_bc_inout_id_netdn)%rval; + p_gain => this%bc_inout(acnp_bc_inout_id_netdp)%rval; + ! integrator variables ! Copy the input only boundary conditions into readable local variables @@ -402,10 +412,23 @@ subroutine DailyPRTAllometricCNP(this) ! for checking and resetting if needed ! ----------------------------------------------------------------------------------- c_gain = this%bc_in(acnp_bc_in_id_netdc)%rval; c_gain0 = c_gain - n_gain = this%bc_in(acnp_bc_in_id_netdn)%rval; n_gain0 = n_gain - p_gain = this%bc_in(acnp_bc_in_id_netdp)%rval; p_gain0 = p_gain + canopy_trim = this%bc_in(acnp_bc_in_id_ctrim)%rval ipft = this%bc_in(acnp_bc_in_id_pft)%ival + + ! If either n or p uptake is in prescribed mode + ! set the gains to something massive. 1 kilo of pure + ! nutrient should be wayyy more than enough + if(n_uptake_mode.eq.prescribed_n_uptake) then + n_gain = 1.e3 + end if + if(p_uptake_mode.eq.prescribed_p_uptake) then + p_gain = 1.e3 + end if + + n_gain0 = n_gain + p_gain0 = p_gain + ! Calculate Carbon allocation targets ! ----------------------------------------------------------------------------------- @@ -424,35 +447,10 @@ subroutine DailyPRTAllometricCNP(this) target_c(repro_organ) = 0._r8 target_dcdd(repro_organ) = 0._r8 - - ! =================================================================================== - ! Step 1: Evaluate nutrient storage in the plant. Depending on how low - ! these stores are, we will move proportionally more or less of the daily carbon - ! gain to increase the target fine-root biomass, fill up to target - ! and then attempt to get them up to stoichiometry targets. - ! =================================================================================== - - ! This routine updates the l2fr (leaf 2 fine-root multiplier) variable - call this%CNPAdjustFRootTargets(target_c) - - c_gain0 = c_gain n_gain0 = n_gain p_gain0 = p_gain - - - ! Output only boundary conditions - c_efflux => this%bc_out(acnp_bc_out_id_cefflux)%rval; c_efflux = 0._r8 - n_efflux => this%bc_out(acnp_bc_out_id_nefflux)%rval; n_efflux = 0._r8 - p_efflux => this%bc_out(acnp_bc_out_id_pefflux)%rval; p_efflux = 0._r8 - - - - - - - ! Remember the original C,N,P states to help with final ! evaluation of how much was allocated ! ----------------------------------------------------------------------------------- @@ -466,19 +464,38 @@ subroutine DailyPRTAllometricCNP(this) i_var = prt_global%sp_organ_map(i_org,phosphorus_element) state_p0(i_org) = this%variables(i_var)%val(1) end do + + ! =================================================================================== + ! Step 1: Evaluate nutrient storage in the plant. Depending on how low + ! these stores are, we will move proportionally more or less of the daily carbon + ! gain to increase the target fine-root biomass, fill up to target + ! and then attempt to get them up to stoichiometry targets. + ! =================================================================================== + ! This routine updates the l2fr (leaf 2 fine-root multiplier) variable + call this%CNPAdjustFRootTargets(target_c) + + ! Output only boundary conditions + c_efflux => this%bc_out(acnp_bc_out_id_cefflux)%rval; c_efflux = 0._r8 + n_efflux => this%bc_out(acnp_bc_out_id_nefflux)%rval; n_efflux = 0._r8 + p_efflux => this%bc_out(acnp_bc_out_id_pefflux)%rval; p_efflux = 0._r8 ! =================================================================================== - ! Step 0. Transfer all stored nutrient into the daily uptake pool. + ! Step 0. Transfer all stored nutrient into the daily uptake pool. Also + ! transfer C storage that is above the target (ie transfer overflow) ! =================================================================================== + + ! Put overflow storage into the net daily pool + store_c_flux = max(0._r8, this%variables(store_c_id)%val(1) - target_c(store_organ)) + + c_gain = c_gain + store_c_flux + this%variables(store_c_id)%val(1) = this%variables(store_c_id)%val(1) - store_c_flux - i_var = prt_global%sp_organ_map(store_organ,nitrogen_element) - n_gain = n_gain + sum(this%variables(i_var)%val(:)) - this%variables(i_var)%val(:) = 0._r8 + n_gain = n_gain + sum(this%variables(store_n_id)%val(:)) + this%variables(store_n_id)%val(:) = 0._r8 - i_var = prt_global%sp_organ_map(store_organ,phosphorus_element) - p_gain = p_gain + sum(this%variables(i_var)%val(:)) - this%variables(i_var)%val(:) = 0._r8 + p_gain = p_gain + sum(this%variables(store_p_id)%val(:)) + this%variables(store_p_id)%val(:) = 0._r8 ! =================================================================================== ! Step 2. Prioritized allocation to replace tissues from turnover, and/or pay @@ -537,20 +554,32 @@ subroutine DailyPRTAllometricCNP(this) call this%CNPAllocateRemainder(c_gain, n_gain, p_gain, & c_efflux, n_efflux, p_efflux) + + if(n_uptake_mode.ne.prescribed_n_uptake) then + if( abs(n_gain) > 0.1_r8*calloc_abs_error) then + write(fates_log(),*) 'Allocation scheme should had used up all mass gain pools' + write(fates_log(),*) 'Any mass that cannot be allocated should be effluxed' + write(fates_log(),*) 'n_gain: ',n_gain + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + end if + + if(p_uptake_mode.ne.prescribed_p_uptake) then + if( abs(p_gain) > 0.01_r8*calloc_abs_error) then + write(fates_log(),*) 'Allocation scheme should had used up all mass gain pools' + write(fates_log(),*) 'Any mass that cannot be allocated should be effluxed' + write(fates_log(),*) 'p_gain: ',p_gain + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + end if - ! Error Check: Make sure that the mass gains are completely used up - if( abs(c_gain) > calloc_abs_error .or. & - abs(n_gain) > 0.1_r8*calloc_abs_error .or. & - abs(p_gain) > 0.02_r8*calloc_abs_error ) then + if( abs(c_gain) > calloc_abs_error) then write(fates_log(),*) 'Allocation scheme should had used up all mass gain pools' write(fates_log(),*) 'Any mass that cannot be allocated should be effluxed' write(fates_log(),*) 'c_gain: ',c_gain - write(fates_log(),*) 'n_gain: ',n_gain - write(fates_log(),*) 'p_gain: ',p_gain call endrun(msg=errMsg(sourcefile, __LINE__)) end if - ! Perform a final tally on what was used (allocated) ! Since this is also a check against what was available ! we include what is lost through respiration of excess storage @@ -589,9 +618,9 @@ subroutine DailyPRTAllometricCNP(this) ! Error Check: Do a final balance between how much mass ! we had to work with, and how much was allocated - if ( abs(allocated_c - c_gain0) > calloc_abs_error .or. & - abs(allocated_n - n_gain0) > calloc_abs_error .or. & - abs(allocated_p - p_gain0) > calloc_abs_error ) then + if ( abs(allocated_c - (c_gain0-c_gain)) > calloc_abs_error .or. & + abs(allocated_n - (n_gain0-n_gain)) > calloc_abs_error .or. & + abs(allocated_p - (p_gain0-p_gain)) > calloc_abs_error ) then write(fates_log(),*) 'CNP allocation scheme did not balance mass.' write(fates_log(),*) 'c_gain0: ',c_gain0,' allocated_c: ',allocated_c write(fates_log(),*) 'n_gain0: ',n_gain0,' allocated_n: ',allocated_n @@ -605,6 +634,24 @@ subroutine DailyPRTAllometricCNP(this) call endrun(msg=errMsg(sourcefile, __LINE__)) end if end if + + ! IF this was prescribed, then we dictate the uptake + ! and pass that back as an output, otherwise + ! we set the gains to what we started with so that + ! it can be used again for mass balance checking and diagnostics + + if(n_uptake_mode.eq.prescribed_n_uptake) then + n_gain = n_gain0-n_gain + else + n_gain = n_gain0 + end if + if(p_uptake_mode.eq.prescribed_p_uptake) then + p_gain = p_gain0-p_gain + else + p_gain = p_gain0 + end if + + return end subroutine DailyPRTAllometricCNP @@ -644,14 +691,31 @@ subroutine CNPAdjustFRootTargets(this, target_c) associate( l2fr_min => prt_params%allom_l2fr_min(ipft), & l2fr_max => prt_params%allom_l2fr_max(ipft)) - call this%StorageRegulator(nitrogen_element, regulate_type,target_c,n_regulator) - call this%StorageRegulator(phosphorus_element, regulate_type,target_c,p_regulator) + if(n_uptake_mode.eq.prescribed_n_uptake)then + n_regulator = 1._r8 + else + call this%StorageRegulator(nitrogen_element, regulate_type,target_c,n_regulator) + end if + if(p_uptake_mode.eq.prescribed_p_uptake)then + p_regulator = 1._r8 + else + call this%StorageRegulator(phosphorus_element, regulate_type,target_c,p_regulator) + end if + ! We take the maximum here, because the maximum is reflective of the ! element with the lowest storage, which is the limiting element + if(n_uptake_mode.eq.prescribed_n_uptake)then + np_regulator = p_regulator + else + if(p_uptake_mode.eq.prescribed_p_uptake)then + np_regulator = n_regulator + else + np_regulator = max(n_regulator,p_regulator) + end if + end if + - np_regulator = max(n_regulator,p_regulator) - ! Update the leaf-to-fineroot ratio used ! to set fine-root biomass allometry @@ -661,10 +725,6 @@ subroutine CNPAdjustFRootTargets(this, target_c) elseif(regulate_type == regulate_CN_dfdd) then - ! To prevent the target l2fr from diverging too far from the - ! actual l2fr, create some constraints. - l2fr_actual = this%GetState(fnrt_organ, carbon12_element)/this%GetState(leaf_organ, carbon12_element) - ! Only update L2FR if some leaves are out if(this%GetState(leaf_organ, carbon12_element)/target_c(leaf_organ) >0.5_r8) then l2fr = l2fr * np_regulator @@ -675,15 +735,16 @@ subroutine CNPAdjustFRootTargets(this, target_c) ! Find the updated target fineroot biomass call bfineroot(dbh,ipft,canopy_trim, l2fr, target_c(fnrt_organ)) - fnrt_c_above_target = max(0._r8,this%GetState(fnrt_organ, carbon12_element) - target_c(fnrt_organ)) - ! Allow no reabsorption? (any reabsorption of nutrients will further push the N/C or P/C imbalance - ! and if we are dropping roots, its because we had excess nutrient compared to carbon anyway - ! Stop the positive feedback + ! The following section allows forceful turnover of fine-roots if a new L2FR is generated + ! that is lower than the previous l2fr. The maintenance turnover (background) rate + ! will automatically accomodate a lower l2fr, but if the change is large it will + ! not keep pace. Note 1: however, that the algorithm in StorageRegulator() will prevent + ! large drops in l2fr (unless that safegaurd is removed). Note 2: this section may also + ! generate mass check errors in the main CNPAllocation routine, this is because the "val" is + ! changing but the net_allocated is not reciprocating, which is expected. - ! Since this is really a stop gap, we want to allow allocation to handle most of the - ! fine-root adaption, and only have this kick in when the target starts to drift significantly - ! from the actual + fnrt_c_above_target = max(0._r8,this%GetState(fnrt_organ, carbon12_element) - target_c(fnrt_organ)) loss_flux_c = 0._r8 @@ -1083,6 +1144,8 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & real(r8) :: cdeficit ! carbon deficit from target integer :: ierr ! error flag for allometric growth step integer :: nsteps ! number of sub-steps + real(r8) :: avg_nc,avg_pc ! Estimated average N/C and P/C ratios of + ! allocated carbon during stature growth real(r8) :: repro_c_frac ! Fraction of C allocated to reproduction ! at current stature (dbh) [/] real(r8) :: sum_c_flux ! Sum of the carbon allocated, as reported @@ -1138,11 +1201,12 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & real(r8) :: intgr_params(num_intgr_parm) - integer, parameter :: grow_lim_type = 3 ! Dev flag for growth limitation algorithm - ! 1 = tries to calculate equivalent carbon - ! 2 = modification of 1 - ! 3 = don't limit, and assume nutrient limitations will prevent calling - ! of this step on the next cycle if they exist + integer, parameter :: grow_lim_conly = 1 ! Just use C to decide stature on this step + integer, parameter :: grow_lim_estNP = 2 ! Estimate equivalent C from N and P + + integer, parameter :: grow_lim_type = grow_lim_estNP + + integer, parameter :: c_limited = 1 integer, parameter :: n_limited = 2 @@ -1170,6 +1234,9 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & p_gain <= 0.02_r8*calloc_abs_error ) then return end if + + + intgr_params(:) = fates_unset_r8 @@ -1279,13 +1346,25 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & i_org = mask_gorgans(ii) total_dcostdd = total_dcostdd + target_dcdd(i_org) end do - - ! No mathematical co-limitation of growth - ! This assumes that limitations will prevent - ! organs from allowing the growth step to even occur - ! and thus from an algorithmic level limit growth - c_gstature = c_gain + ! We can either proceed with stature growth by using all of the carbon + ! available, or we can try to estimate the limitations of N and P + ! and thereby reduce the amount of C we are willing to use to try + ! and match what is available in n_gain and p_gain. Note that the + ! c-only option does allow limitations to eventually occur, because + ! it is assumed that in the dynamics call that follows this one, there may + ! or not be enough N or P to reach the stature growth step at all. + + if(grow_lim_type == grow_lim_conly) then + c_gstature = c_gain + elseif (grow_lim_type == grow_lim_estNP) then + + call EstimateGrowthNC(this,target_c,target_dcdd,state_mask,avg_nc,avg_pc) + + c_gstature = min(c_gain,n_gain/avg_nc) + c_gstature = min(c_gstature,p_gain/avg_pc) + + end if if_stature_growth: if(c_gstature > nearzero) then @@ -1632,14 +1711,29 @@ subroutine CNPAllocateRemainder(this, c_gain, n_gain, p_gain, & ! 1) excude through roots cap at 0 to flush out imprecisions ! ----------------------------------------------------------------------------------- - c_efflux = max(0.0_r8,c_gain) - n_efflux = max(0.0_r8,n_gain) - p_efflux = max(0.0_r8,p_gain) - + ! If either n or p uptake is in prescribed mode + ! don't efflux anything, we will use the remainder + ! n_gain and p_gain to specify the demand as what was used + ! and what was uptaken + + if(n_uptake_mode.eq.prescribed_n_uptake) then + n_efflux = 0._r8 + else + n_efflux = max(0.0_r8,n_gain) + n_gain = 0._r8 + end if + + if(p_uptake_mode.eq.prescribed_p_uptake) then + p_efflux = 0._r8 + else + p_efflux = max(0.0_r8,p_gain) + p_gain = 0._r8 + end if + c_efflux = max(0.0_r8,c_gain) c_gain = 0.0_r8 - n_gain = 0.0_r8 - p_gain = 0.0_r8 + + return end subroutine CNPAllocateRemainder @@ -1746,11 +1840,18 @@ function GetNutrientTargetCNP(this,element_id,organ_id,stoich_mode) result(targe end if - ! Hard-code the growth minimum storage stoichiometry to 25% of maximum - if( stoich_mode == stoich_growth_min ) then - target_m = target_m*0.25_r8 + ! This is only called during phase 3, remainder and allows + ! us to have some overflow to avoid exudation/efflux if possible + if( stoich_mode == stoich_max ) then + target_m = target_m*(1._r8 + store_overflow_frac) end if - + !if( stoich_mode == stoich_growth_min ) then + ! target_m = 0.1_r8*target_m + !end if + !if( stoich_mode == stoich_center ) then + ! do nothing, target_m is unchanged + !end if + elseif(organ_id == repro_organ) then target_c = this%variables(i_cvar)%val(1) @@ -2132,15 +2233,11 @@ subroutine StorageRegulator(this,element_id,regulate_type,target_c,c_scalar) ! Locals real(r8) :: store_frac ! Current nutrient storage relative to max real(r8) :: store_max ! Maximum nutrient storable by plant + real(r8) :: store_c_max integer :: icode ! real variable checking code real(r8) :: store_x integer :: i_var - real(r8), parameter :: c_eq_offset = 1.0_r8 ! This shifts the center-point - ! of the N:C or P:C storage equlibrium - ! by multiplying the C term. If its less than 1 it - ! shifts left and great than one it shifts right. - ! It should shift left to help mitigate wasted N and P - ! storage overflow + ! For N/C logistic real(r8) :: logi_k ! logistic function k @@ -2156,10 +2253,9 @@ subroutine StorageRegulator(this,element_id,regulate_type,target_c,c_scalar) real(r8) :: nc_frac real(r8) :: store_c_frac real(r8) :: c_gain + real(r8) :: c_fnrt_expand ! predicted carbon available to expand fine-roots + ! after replacement of turnover - real(r8), parameter :: c_max = 1.0_r8 ! Maximum allowable result of the function - real(r8), parameter :: c_min = 0.0_r8 ! Minimum allowable result of the function - ! This fraction governs ! how much carbon from daily gains + storage overflow, is allowed to ! be spent on growing out roots. This inludes getting roots @@ -2167,10 +2263,15 @@ subroutine StorageRegulator(this,element_id,regulate_type,target_c,c_scalar) integer, parameter :: limit_all = 1 integer, parameter :: limit_lf = 2 - integer :: lim_l2fr_max_type = limit_all - real(r8), parameter :: max_l2fr_cgain_frac = 0.5_r8 + integer, parameter :: lim_l2fr_max_type = limit_all + real(r8), parameter :: max_l2fr_cgain_frac = 0.95_r8 - associate(dbh => this%bc_inout(acnp_bc_inout_id_dbh)%rval, & + real(r8), parameter :: nc_frac_offset = 1.0_r8 ! This shifts the center-point + ! of the N:C or P:C storage equlibrium + ! by multiplying the N term. + + + associate(dbh => this%bc_inout(acnp_bc_inout_id_dbh)%rval, & canopy_trim => this%bc_in(acnp_bc_in_id_ctrim)%rval, & ipft => this%bc_in(acnp_bc_in_id_pft)%ival, & l2fr => this%bc_inout(acnp_bc_inout_id_l2fr)%rval) @@ -2178,7 +2279,6 @@ subroutine StorageRegulator(this,element_id,regulate_type,target_c,c_scalar) logi_k = 2._r8 store_x0 = 0.0_r8 logi_min = 0.0_r8 - if(regulate_type == regulate_CN_logi) then @@ -2196,20 +2296,21 @@ subroutine StorageRegulator(this,element_id,regulate_type,target_c,c_scalar) elseif(regulate_type == regulate_CN_dfdd) then - store_max = this%GetNutrientTarget(element_id,store_organ,stoich_max) + store_max = this%GetNutrientTarget(element_id,store_organ,stoich_center) !*(1._r8 + 0.5*store_overflow_frac) ! Storage fractions could be more than the target, depending on the ! hypothesis and functions involved, but should typically be 0-1 ! The cap of 5 is for numerics and preventing weird math - store_frac = max(0.01_r8,min(5.0_r8,this%GetState(store_organ, element_id)/store_max)) ! Since we don't dump storage carbon ! these stores can actually get pretty large, so the cap of 10x is numerically ! feasable, and should also minimize stress on the logistic function - store_c_frac = max(0.01_r8,min(5.0_r8,c_eq_offset*(this%GetState(store_organ, carbon12_element)/target_c(store_organ) ))) + store_c_max = target_c(store_organ) !*(1._r8 + 0.5*store_overflow_frac) + + store_c_frac = max(0.01_r8,min(5.0_r8,this%GetState(store_organ, carbon12_element)/store_c_max )) ! ----------------------------------------------------------------------------- ! To decide the upper limit on expanding root growth, we perform a carbon @@ -2233,7 +2334,8 @@ subroutine StorageRegulator(this,element_id,regulate_type,target_c,c_scalar) ! or ! as much as you like as long as turnover is replaced ! - ! l2fr_delta_max*target_fnrt_c < c_gain - (target_fnrt_c-actual_fnrt_c) - + ! l2fr_delta_max*target_fnrt_c - target_fnrt_c < + ! c_gain - (target_fnrt_c-actual_fnrt_c) - ! (target_leaf_c-actual_leaf_c) - ! (target_sapw_c-actual_sapw_c) - ! (target_dead_c-actual_dead_c) - @@ -2241,27 +2343,31 @@ subroutine StorageRegulator(this,element_id,regulate_type,target_c,c_scalar) ! ! ------------------------------------------------------------------------------ - ! If there is overflow storage, add this to the gain - c_gain = this%bc_in(acnp_bc_in_id_netdc)%rval - fnrt_c = this%GetState(fnrt_organ, carbon12_element) leaf_c = this%GetState(leaf_organ, carbon12_element) store_c = this%GetState(store_organ, carbon12_element) struct_c = this%GetState(struct_organ, carbon12_element) sapw_c = this%GetState(sapw_organ, carbon12_element) + ! If there is overflow storage, add this to the gain + c_gain = this%bc_in(acnp_bc_in_id_netdc)%rval + max(0._r8,store_c-target_c(store_organ)) + + if(lim_l2fr_max_type == limit_lf)then l2fr_delta_max = max_l2fr_cgain_frac / target_c(fnrt_organ) * & (c_gain - max(0._r8,target_c(fnrt_organ)-fnrt_c) - max(0._r8,target_c(leaf_organ)-leaf_c)) elseif(lim_l2fr_max_type ==limit_all)then - l2fr_delta_max = 1._r8/target_c(fnrt_organ) * & - (c_gain - & + + c_fnrt_expand = max_l2fr_cgain_frac* ( c_gain - & max(0._r8,target_c(fnrt_organ)-fnrt_c) - & max(0._r8,target_c(leaf_organ)-leaf_c) - & max(0._r8,target_c(sapw_organ)-sapw_c) - & max(0._r8,target_c(struct_organ)-struct_c) - & - max(0._r8,target_c(store_organ)-store_c) ) + max(0._r8,target_c(store_organ)-store_c)) + + l2fr_delta_max = (c_fnrt_expand + target_c(fnrt_organ))/target_c(fnrt_organ) + end if @@ -2277,21 +2383,11 @@ subroutine StorageRegulator(this,element_id,regulate_type,target_c,c_scalar) ! Determine the max change for the doubling timescale ! 2.0 = l2fr_delta_max^frnt_adapt_tscl l2fr_delta_scale = 2._r8**(1._r8/fnrt_adapt_tscl)-1.0_r8 - - ! Determiine the change for the halving timescale - !l2fr_scale_min = 0.5_r8**(1._r8/fnrt_adapt_tscl) - - !log_nc_frac = log( store_frac / store_c_frac ) - - ! This is a logistic between -1 and 1 - !c_scalar = l2fr_delta_scale*2._r8*max(0._r8, & - ! min(1._r8,logi_min + (1._r8-logi_min)/(1._r8 + exp(logi_k*(log_nc_frac-store_x0)))))-1.0_r8 - - nc_frac = store_frac / store_c_frac + + nc_frac = nc_frac_offset * store_frac / store_c_frac c_scalar = l2fr_delta_scale*(2.0_r8/(1.0_r8 + nc_frac**logi_k)-1.0_r8)+1.0_r8 - if(c_scalar>1.0_r8)then c_scalar = min(c_scalar,l2fr_delta_max) else @@ -2306,6 +2402,102 @@ subroutine StorageRegulator(this,element_id,regulate_type,target_c,c_scalar) end subroutine StorageRegulator + ! ==================================================================================== + + subroutine EstimateGrowthNC(this,target_c,target_dcdd,state_mask,avg_nc,avg_pc) + + ! This routine predicts the effective nutrient/carbon allocation ratio + ! for the forthcoming growth step. This helps the growth step predict + ! which element will be limiting, and reduce the amount of carbon + ! used to make the step. + class(cnp_allom_prt_vartypes) :: this + real(r8) :: target_c(:) + real(r8) :: target_dcdd(:) + logical :: state_mask(:) + real(r8) :: avg_nc ! Average N:C ratio + real(r8) :: avg_pc ! Average P:C ratio + + real(r8) :: repro_c_frac + real(r8) :: total_w ! Weight (dC/dd) for the ratios + real(r8) :: store_nc + real(r8) :: store_pc + real(r8) :: repro_w,leaf_w,fnrt_w,sapw_w,struct_w,store_w + + associate(dbh => this%bc_inout(acnp_bc_inout_id_dbh)%rval, & + ipft => this%bc_in(acnp_bc_in_id_pft)%ival ) + + if(state_mask(repro_id)) then + if (dbh <= prt_params%dbh_repro_threshold(ipft)) then + repro_c_frac = prt_params%seed_alloc(ipft) + else + repro_c_frac = prt_params%seed_alloc(ipft) + prt_params%seed_alloc_mature(ipft) + end if + else + repro_c_frac = 0._r8 + end if + + ! Estimate the total weight + total_w = 0._r8 + avg_nc = 0._r8 + avg_pc = 0._r8 + + if(state_mask(leaf_id)) then + leaf_w = target_dcdd(leaf_organ) * (1._r8 - repro_c_frac) + total_w = total_w + leaf_w + avg_nc = avg_nc + leaf_w * prt_params%nitr_stoich_p1(ipft,prt_params%organ_param_id(leaf_organ)) + avg_pc = avg_pc + leaf_w * prt_params%phos_stoich_p1(ipft,prt_params%organ_param_id(leaf_organ)) + end if + if(state_mask(fnrt_id)) then + fnrt_w = target_dcdd(fnrt_organ) * (1._r8 - repro_c_frac) + total_w = total_w + fnrt_w + avg_nc = avg_nc + fnrt_w * prt_params%nitr_stoich_p1(ipft,prt_params%organ_param_id(fnrt_organ)) + avg_pc = avg_nc + fnrt_w * prt_params%phos_stoich_p1(ipft,prt_params%organ_param_id(fnrt_organ)) + end if + if(state_mask(sapw_id)) then + sapw_w = target_dcdd(sapw_organ) * (1._r8 - repro_c_frac) + total_w = total_w + sapw_w + avg_nc = avg_nc + sapw_w * prt_params%nitr_stoich_p1(ipft,prt_params%organ_param_id(sapw_organ)) + avg_pc = avg_pc + sapw_w * prt_params%phos_stoich_p1(ipft,prt_params%organ_param_id(sapw_organ)) + end if + if(state_mask(struct_id)) then + struct_w = target_dcdd(struct_organ) * (1._r8 - repro_c_frac) + total_w = total_w + struct_w + avg_nc = avg_nc + struct_w * prt_params%nitr_stoich_p1(ipft,prt_params%organ_param_id(struct_organ)) + avg_pc = avg_pc + struct_w * prt_params%phos_stoich_p1(ipft,prt_params%organ_param_id(struct_organ)) + end if + if(state_mask(store_id)) then + store_w = target_dcdd(store_organ) * (1._r8 - repro_c_frac) + total_w = total_w + store_w + store_nc = this%GetNutrientTarget(nitrogen_element,store_organ,stoich_growth_min) / target_c(store_organ) + store_pc = this%GetNutrientTarget(phosphorus_element,store_organ,stoich_growth_min) / target_c(store_organ) + avg_nc = avg_nc + store_w * store_nc + avg_pc = avg_pc + store_w * store_pc + end if + + if(state_mask(repro_id)) then + + ! total = total_w + repro_w + ! repro_w = total*repro_c_frac + ! repro_w = (total_w + repro_w)*repro_c_frac = total_w*repro_c_frac + repro_w*repro_c_frac + ! repro_w * (1 - repro_c_frac) = total_w*repro_c_frac + ! repro_w = total_w * repro_c_frac/(1-repro_c_frac) + + repro_w = total_w * repro_c_frac/(1._r8 - repro_c_frac) + total_w = total_w + repro_w + avg_nc = avg_nc + repro_w * prt_params%nitr_recr_stoich(ipft) + avg_pc = avg_pc + repro_w * prt_params%phos_recr_stoich(ipft) + end if + + + avg_nc = avg_nc / total_w + avg_pc = avg_pc / total_w + + end associate + + return + end subroutine EstimateGrowthNC + + end module PRTAllometricCNPMod From 232645943fbed3619996ff7eb10c32da85bd5ed5 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Fri, 15 Apr 2022 11:53:55 -0400 Subject: [PATCH 20/55] Added some parameters that were hard coded constants to the parameter file --- biogeochem/EDCohortDynamicsMod.F90 | 7 +- biogeochem/EDPhysiologyMod.F90 | 2 +- biogeophys/FatesPlantRespPhotosynthMod.F90 | 4 +- main/EDInitMod.F90 | 2 +- main/EDPftvarcon.F90 | 20 +----- main/EDTypesMod.F90 | 6 +- main/FatesHistoryInterfaceMod.F90 | 12 ++-- main/FatesInterfaceMod.F90 | 5 +- main/FatesInventoryInitMod.F90 | 2 +- parameter_files/fates_params_default.cdl | 24 ++++--- parameter_files/patch_default_bciopt224.xml | 16 +++-- parteh/PRTAllometricCNPMod.F90 | 80 ++++++++++----------- parteh/PRTAllometricCarbonMod.F90 | 4 +- parteh/PRTParametersMod.F90 | 27 +++++-- parteh/PRTParamsFATESMod.F90 | 51 ++++++++++--- 15 files changed, 144 insertions(+), 118 deletions(-) diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index c6dc4fea72..c1bffe6313 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -100,7 +100,7 @@ module EDCohortDynamicsMod use PRTAllometricCNPMod, only : acnp_bc_inout_id_netdn, acnp_bc_inout_id_netdp use PRTAllometricCNPMod, only : acnp_bc_out_id_cefflux, acnp_bc_out_id_nefflux use PRTAllometricCNPMod, only : acnp_bc_out_id_pefflux - use PRTAllometricCNPMod, only : fnrt_adapt_tscl + use shr_infnan_mod, only : nan => shr_infnan_nan, assignment(=) @@ -248,7 +248,7 @@ subroutine create_cohort(currentSite, patchptr, pft, nn, hite, coage, dbh, & ! enabled case, because cohorts are also initialized with ! full stores, which match with minimum fr biomass - new_cohort%l2fr = prt_params%allom_l2fr_min(pft) + new_cohort%l2fr = prt_params%allom_l2fr(pft) ! This sets things like vcmax25top, that depend on the @@ -324,9 +324,6 @@ subroutine create_cohort(currentSite, patchptr, pft, nn, hite, coage, dbh, & !! allocate(new_cohort%tveg_lpa) !! call new_cohort%tveg_lpa%InitRMean(ema_lpa,init_value=patchptr%tveg_lpa%GetMean()) - !!allocate(new_cohort%l2fr_ema) - !!call new_cohort%l2fr_ema%InitRMean(ema_60day,init_value=new_cohort%l2fr,init_offset=fnrt_adapt_tscl*sec_per_day) - call InitPRTBoundaryConditions(new_cohort) diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 0fb17d5b39..c55110c266 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -1866,7 +1866,7 @@ subroutine recruitment( currentSite, currentPatch, bc_in ) temp_cohort%pft = ft temp_cohort%hite = EDPftvarcon_inst%hgt_min(ft) temp_cohort%coage = 0.0_r8 - temp_cohort%l2fr = prt_params%allom_l2fr_min(ft) + temp_cohort%l2fr = prt_params%allom_l2fr(ft) stem_drop_fraction = EDPftvarcon_inst%phen_stem_drop_fraction(ft) call h2d_allom(temp_cohort%hite,ft,temp_cohort%dbh) diff --git a/biogeophys/FatesPlantRespPhotosynthMod.F90 b/biogeophys/FatesPlantRespPhotosynthMod.F90 index f4d918c9c8..80228bb582 100644 --- a/biogeophys/FatesPlantRespPhotosynthMod.F90 +++ b/biogeophys/FatesPlantRespPhotosynthMod.F90 @@ -718,7 +718,7 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) fnrt_mr_layer = fnrt_n * ED_val_base_mr_20 * tcsoi * rootfr_ft(ft,j) * maintresp_reduction_factor - currentCohort%froot_mr = currentCohort%froot_mr + fnrt_mr_layer * (1._r8 + EDPftvarcon_inst%nfix_mresp_scfrac(ft)) + currentCohort%froot_mr = currentCohort%froot_mr + fnrt_mr_layer * (1._r8 + prt_params%nfix_mresp_scfrac(ft)) ! calculate the cost of carbon for N fixation in each soil layer and calculate N fixation rate based on that [kgC / kgN] @@ -726,7 +726,7 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) * (1._r8 - 0.5_r8 * (bc_in(s)%t_soisno_sl(j)-tfrz) / c_fix)) - 2._r8) ! Time integrated amount of carbon spent on fixation (in this layer) [kgC/plant/layer/tstep] - c_spent_nfix = fnrt_mr_layer * dtime * EDPftvarcon_inst%nfix_mresp_scfrac(ft) + c_spent_nfix = fnrt_mr_layer * dtime * prt_params%nfix_mresp_scfrac(ft) currentCohort%daily_n_fixation = currentCohort%daily_n_fixation + c_spent_nfix / c_cost_nfix diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index 854b9ecebe..e51d506b05 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -745,7 +745,7 @@ subroutine init_cohorts( site_in, patch_in, bc_in) endif temp_cohort%canopy_trim = 1.0_r8 - temp_cohort%l2fr = prt_params%allom_l2fr_min(pft) + temp_cohort%l2fr = prt_params%allom_l2fr(pft) ! h,dbh,leafc,n from SP values or from small initial size. diff --git a/main/EDPftvarcon.F90 b/main/EDPftvarcon.F90 index 387edc70f8..4513307677 100644 --- a/main/EDPftvarcon.F90 +++ b/main/EDPftvarcon.F90 @@ -157,10 +157,6 @@ module EDPftvarcon ! biochemical production, fraction based how much ! more in need a plant is for P versus N [/] - ! Maintenance respiration surcharge for obligate fixation [fraction of existing respiration] - real(r8), allocatable :: nfix_mresp_scfrac(:) - - ! Turnover related things @@ -925,10 +921,9 @@ subroutine Receive_PFT(this, fates_params) call fates_params%RetreiveParameterAllocate(name=name, & data=this%prescribed_puptake) - ! TEMPORARILY USING DEV_ARIBITRARY_PFT FOR FIXATION PARAMETER name = 'fates_dev_arbitrary_pft' call fates_params%RetreiveParameterAllocate(name=name, & - data=this%nfix_mresp_scfrac) + data=this%dev_arbitrary_pft) name = 'fates_eca_decompmicc' call fates_params%RetreiveParameterAllocate(name=name, & @@ -1034,8 +1029,6 @@ subroutine Register_PFT_numrad(this, fates_params) call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names) - - end subroutine Register_PFT_numrad !----------------------------------------------------------------------- @@ -1515,17 +1508,6 @@ subroutine FatesCheckParams(is_master) call endrun(msg=errMsg(sourcefile, __LINE__)) end if - ! Make sure that the N fixation respiration surcharge fraction is - ! between 0 and 1 - - if(any(EDpftvarcon_inst%nfix_mresp_scfrac(:)<0._r8) .or. any(EDpftvarcon_inst%nfix_mresp_scfrac(:)>1.0_r8)) then - write(fates_log(),*) 'The N fixation surcharge nfix_mresp_sfrac must be between 0-1.' - write(fates_log(),*) 'This parameter is temporarily using the parameter file field: dev_arbitrary_pft' - write(fates_log(),*) 'here are the values: ',EDpftvarcon_inst%nfix_mresp_scfrac(:) - write(fates_log(),*) 'Aborting' - call endrun(msg=errMsg(sourcefile, __LINE__)) - end if - ! If nitrogen is turned on, check to make sure there are valid ammonium ! parameters diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 772a9d0e09..4ae673d5aa 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -28,10 +28,10 @@ module EDTypesMod private ! By default everything is private save - integer, parameter, public :: maxPatchesPerSite = 14 ! maximum number of patches to live on a site + integer, parameter, public :: maxPatchesPerSite = 6 ! maximum number of patches to live on a site integer, parameter, public :: maxPatchesPerSite_by_disttype(n_anthro_disturbance_categories) = & - (/ 10, 4 /) !!! MUST SUM TO maxPatchesPerSite !!! - integer, public :: maxCohortsPerPatch = 100 ! maximum number of cohorts per patch + (/ 5, 1 /) !!! MUST SUM TO maxPatchesPerSite !!! + integer, public :: maxCohortsPerPatch ! maximum number of cohorts per patch integer, parameter, public :: nclmax = 3 ! Maximum number of canopy layers integer, parameter, public :: ican_upper = 1 ! Nominal index for the upper canopy diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 4acf85bddb..1c455565f2 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -81,7 +81,7 @@ module FatesHistoryInterfaceMod use PRTGenericMod , only : carbon12_element use PRTGenericMod , only : nitrogen_element, phosphorus_element use PRTGenericMod , only : prt_carbon_allom_hyp - use PRTAllometricCNPMod , only : stoich_max,stoich_growth_min,stoich_center + use PRTAllometricCNPMod , only : stoich_max,stoich_growth_min implicit none private ! By default everything is private @@ -2550,7 +2550,7 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) fnrtc_understory_scpf(i_scpf) = fnrtc_understory_scpf(i_scpf) + ccohort%n*fnrt_m end if - call bstore_allom(ccohort%dbh,ccohort%pft,ccohort%canopy_trim, store_growth_min) + call bstore_allom(ccohort%dbh,ccohort%pft,ccohort%canopy_trim, store_max) this%hvars(ih_storectfrac_si)%r81d(io_si) = & this%hvars(ih_storectfrac_si)%r81d(io_si) + ccohort%n * store_max/m2_per_ha @@ -2595,7 +2595,7 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) elseif(element_list(el).eq.nitrogen_element)then - store_max = ccohort%prt%GetNutrientTarget(element_list(el),store_organ,stoich_center) + store_max = ccohort%prt%GetNutrientTarget(element_list(el),store_organ,stoich_growth_min) this%hvars(ih_storen_si)%r81d(io_si) = & this%hvars(ih_storen_si)%r81d(io_si) + ccohort%n * & @@ -2635,7 +2635,7 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) elseif(element_list(el).eq.phosphorus_element) then - store_max = ccohort%prt%GetNutrientTarget(element_list(el),store_organ,stoich_center) + store_max = ccohort%prt%GetNutrientTarget(element_list(el),store_organ,stoich_growth_min) this%hvars(ih_storep_si)%r81d(io_si) = & this%hvars(ih_storep_si)%r81d(io_si) + ccohort%n * & @@ -3534,7 +3534,7 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) repro_m * ccohort%n / m2_per_ha elseif(element_list(el).eq.nitrogen_element)then - store_max = ccohort%prt%GetNutrientTarget(element_list(el),store_organ,stoich_center) + store_max = ccohort%prt%GetNutrientTarget(element_list(el),store_organ,stoich_growth_min) this%hvars(ih_totvegn_scpf)%r82d(io_si,i_scpf) = & this%hvars(ih_totvegn_scpf)%r82d(io_si,i_scpf) + & @@ -3557,7 +3557,7 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) elseif(element_list(el).eq.phosphorus_element)then - store_max = ccohort%prt%GetNutrientTarget(element_list(el),store_organ,stoich_center) + store_max = ccohort%prt%GetNutrientTarget(element_list(el),store_organ,stoich_growth_min) this%hvars(ih_totvegp_scpf)%r82d(io_si,i_scpf) = & this%hvars(ih_totvegp_scpf)%r82d(io_si,i_scpf) + & diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 2ad860ef47..b70d680437 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -84,7 +84,6 @@ module FatesInterfaceMod use FatesRunningMeanMod , only : moving_ema_window use FatesRunningMeanMod , only : fixed_window use FatesHistoryInterfaceMod , only : fates_hist - use PRTAllometricCNPMod , only : fnrt_adapt_tscl ! CIME Globals use shr_log_mod , only : errMsg => shr_log_errMsg @@ -927,9 +926,9 @@ subroutine InitTimeAveragingGlobals() allocate(ema_lpa) call ema_lpa%define(photo_temp_acclim_timescale*sec_per_day, & hlm_stepsize,moving_ema_window) - allocate(ema_60day) - call ema_60day%define(fnrt_adapt_tscl*sec_per_day,sec_per_day,moving_ema_window) + !allocate(ema_60day) + !call ema_60day%define(prt_params%fnrt_adapt_tscl*sec_per_day,sec_per_day,moving_ema_window) !class(rmean_arr_type), pointer :: ema_fnrt_tscale(:) !rmean_arr_type diff --git a/main/FatesInventoryInitMod.F90 b/main/FatesInventoryInitMod.F90 index ff511b662b..c73b78a3a0 100644 --- a/main/FatesInventoryInitMod.F90 +++ b/main/FatesInventoryInitMod.F90 @@ -1031,7 +1031,7 @@ subroutine set_inventory_edcohort_type1(csite,bc_in,css_file_unit,npatches, & ! Calculate fine root biomass - temp_cohort%l2fr = prt_params%allom_l2fr_min(temp_cohort%pft) + temp_cohort%l2fr = prt_params%allom_l2fr(temp_cohort%pft) call bfineroot(temp_cohort%dbh,temp_cohort%pft,temp_cohort%canopy_trim,temp_cohort%l2fr,c_fnrt) ! Calculate sapwood biomass diff --git a/parameter_files/fates_params_default.cdl b/parameter_files/fates_params_default.cdl index 344f5ee4ab..3028fcb968 100644 --- a/parameter_files/fates_params_default.cdl +++ b/parameter_files/fates_params_default.cdl @@ -44,6 +44,9 @@ variables: char fates_prt_organ_name(fates_prt_organs, fates_string_length) ; fates_prt_organ_name:units = "unitless - string" ; fates_prt_organ_name:long_name = "Name of plant organs (order must match PRTGenericMod.F90)" ; + double fates_fnrt_adapt_tscale(fates_pft) ; + fates_fnrt_adapt_tscale:units = "fraction" ; + fates_fnrt_adapt_tscale:long_name = "Number of days that is the shortest possible doubling period for CNP fine-root adaptation" ; double fates_alloc_storage_cushion(fates_pft) ; fates_alloc_storage_cushion:units = "fraction" ; fates_alloc_storage_cushion:long_name = "maximum size of storage C pool, relative to maximum size of leaf C pool" ; @@ -111,12 +114,9 @@ variables: fates_allom_hmode:units = "index" ; fates_allom_hmode:long_name = "height allometry function index." ; fates_allom_hmode:possible_values = "1: OBrien 1995; 2: Poorter 2006; 3: 2 parameter power law; 4: Chave 2014; 5: Martinez-Cano 2019." ; - double fates_allom_l2fr_min(fates_pft) ; - fates_allom_l2fr_min:units = "gC/gC" ; - fates_allom_l2fr_min:long_name = "Allocation parameter: minimum fine root C per leaf C (definitive l2fr for Carbon-only)" ; - double fates_allom_l2fr_max(fates_pft) ; - fates_allom_l2fr_max:units = "gC/gC" ; - fates_allom_l2fr_max:long_name = "Allocation parameter: maximum fine root C per leaf C (NOT USED IN Carbon-only, only CNP)" ; + double fates_allom_l2fr(fates_pft) ; + fates_allom_l2fr:units = "gC/gC" ; + fates_allom_l2fr:long_name = "Allocation parameter: static or initial fine root C per leaf C" ; double fates_allom_la_per_sa_int(fates_pft) ; fates_allom_la_per_sa_int:units = "m2/cm2" ; fates_allom_la_per_sa_int:long_name = "Leaf area per sapwood area, intercept" ; @@ -505,6 +505,9 @@ variables: double fates_smpso(fates_pft) ; fates_smpso:units = "mm" ; fates_smpso:long_name = "Soil water potential at full stomatal opening" ; + double fates_store_ovrflw_frac(fates_pft) ; + fates_store_ovrflw_frac:units = "fraction" ; + fates_store_ovrflw_frac:long_name = "size of overflow storage (CNP only) as a fraction of storage target" ; double fates_taulnir(fates_pft) ; fates_taulnir:units = "fraction" ; fates_taulnir:long_name = "Leaf transmittance: near-IR" ; @@ -810,6 +813,9 @@ data: "sapwood ", "structure " ; + + fates_fnrt_adapt_tscale = 30.0,30.0,30.0,30.0,30.0,30.0,30.0,30.0, 30.0,30.0,30.0,30.0; + fates_alloc_storage_cushion = 1.2, 1.2, 1.2, 1.2, 1.2, 1.2, 1.2, 1.2, 1.2, 1.2, 1.2, 1.2 ; @@ -868,9 +874,7 @@ data: fates_allom_hmode = 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 ; - fates_allom_l2fr_min = 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 ; - - fates_allom_l2fr_max = 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 ; + fates_allom_l2fr = 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 ; fates_allom_la_per_sa_int = 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8 ; @@ -1291,6 +1295,8 @@ data: fates_smpso = -66000, -66000, -66000, -66000, -66000, -66000, -66000, -66000, -66000, -66000, -66000, -66000 ; + fates_store_ovrflw_frac = 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0 ; + fates_taulnir = 0.25, 0.1, 0.1, 0.25, 0.25, 0.25, 0.1, 0.25, 0.25, 0.34, 0.34, 0.34 ; diff --git a/parameter_files/patch_default_bciopt224.xml b/parameter_files/patch_default_bciopt224.xml index bfcc288efa..73f37057d6 100644 --- a/parameter_files/patch_default_bciopt224.xml +++ b/parameter_files/patch_default_bciopt224.xml @@ -2,16 +2,17 @@ This parameter dataset was created by Ryan Knox rgknox@lbl.gov. Please contact if using in published work. The calibration uses the following datasets: [1] Ely et al. 2019. Leaf mass area, Panama. NGEE-Tropics data collection.http://dx.doi.org/10.15486/ngt/1411973 and [2] Condit et al. 2019. Complete data from the Barro Colorado 50-ha plot. https://doi.org/10.15146/5xcp-0d46. [3] Koven et al. 2019. Benchmarking and parameter sensitivity of physiological and vegetation dynamics using the functionally assembled terrestrial ecosystem simulator. Biogeosciences. The ECA nutrient aquisition parmeters are unconstrained, the file output naming convention vmn6phi is shorthand for vmax for nitrogen uptake is order e-6 and for phosphorus is excessively high. These parameters were calibrated with the special fates modification in main/EDTypesMod.F90: nclmax = 3 fates_params_default.cdl - fates_params_opt224_vmn6phi_080621.cdl + fates_params_opt224_040822.cdl 1 0 0 1,1,3,4 0.03347526,0.024,1e-08,0.0047 - 0.03347526,0.024,1e-08,0.0047 - 0.025,0,0,0 + 0.002675,0.0005,0.00015,0.00015 + 0.0,0,0,0 0.45,0.25,0,0 + 0.65,0.25,0,0 0.8012471 30.94711 0.0673 @@ -31,10 +32,13 @@ 2 5 0.4863088 + 0.0 + 10 + 1 3 - 3e-06 - 3e-06 - 3e-07 + 5e-09 + 5e-09 + 5e-10 3e-08 0.03991654 0.01995827 diff --git a/parteh/PRTAllometricCNPMod.F90 b/parteh/PRTAllometricCNPMod.F90 index 67cf24ca65..4e411d3d5d 100644 --- a/parteh/PRTAllometricCNPMod.F90 +++ b/parteh/PRTAllometricCNPMod.F90 @@ -61,6 +61,7 @@ module PRTAllometricCNPMod use EDTypesMod , only : n_uptake_mode use FatesConstantsMod , only : prescribed_p_uptake use FatesConstantsMod , only : prescribed_n_uptake + use EDPftvarcon, only : EDPftvarcon_inst implicit none private @@ -104,8 +105,6 @@ module PRTAllometricCNPMod ! minimum needed for growth integer,public, parameter :: stoich_max = 2 ! Flag for stoichiometry associated with ! maximum for that organ - integer,public, parameter :: stoich_center=3 - ! This is the ordered list of organs used in this module ! ------------------------------------------------------------------------------------- @@ -187,9 +186,6 @@ module PRTAllometricCNPMod ! ------------------------------------------------------------------------------------- integer, parameter :: icd = 1 - - real(r8), parameter :: store_overflow_frac = 1.0_r8 ! The fraction above target allowed in storage - integer, parameter :: exude_c_store_overflow = 1 integer, parameter :: retain_c_store_overflow = 2 integer, parameter :: burn_c_store_overflow = 3 @@ -208,11 +204,6 @@ module PRTAllometricCNPMod integer, parameter :: regulate_CN_dfdd = 4 - real(r8), public, parameter :: fnrt_adapt_tscl = 100._r8 ! Fine-root adaptation timescale (days) - ! or, how many days it takes - ! for a doubling or halving of the l2fr - - ! ------------------------------------------------------------------------------------- ! This is the core type that holds this specific ! plant reactive transport (PRT) module @@ -398,11 +389,19 @@ subroutine DailyPRTAllometricCNP(this) ! In/out boundary conditions - resp_excess => this%bc_inout(acnp_bc_inout_id_resp_excess)%rval; resp_excess0 = resp_excess + resp_excess => this%bc_inout(acnp_bc_inout_id_resp_excess)%rval; dbh => this%bc_inout(acnp_bc_inout_id_dbh)%rval; dbh0 = dbh l2fr => this%bc_inout(acnp_bc_inout_id_l2fr)%rval n_gain => this%bc_inout(acnp_bc_inout_id_netdn)%rval; p_gain => this%bc_inout(acnp_bc_inout_id_netdp)%rval; + + + ! Assume that there is no other source of excess respiration + ! so it is safe to zero it. In the third stage we will + ! decide if this should be updated + resp_excess = 0._r8 + resp_excess0 = resp_excess + ! integrator variables @@ -688,8 +687,7 @@ subroutine CNPAdjustFRootTargets(this, target_c) dbh => this%bc_inout(acnp_bc_inout_id_dbh)%rval canopy_trim = this%bc_in(acnp_bc_in_id_ctrim)%rval - associate( l2fr_min => prt_params%allom_l2fr_min(ipft), & - l2fr_max => prt_params%allom_l2fr_max(ipft)) + associate( l2fr_min => prt_params%allom_l2fr(ipft) ) if(n_uptake_mode.eq.prescribed_n_uptake)then n_regulator = 1._r8 @@ -721,7 +719,7 @@ subroutine CNPAdjustFRootTargets(this, target_c) if(regulate_type == regulate_CN_logi)then - l2fr = l2fr_min + max(0._r8,min(1.0_r8,np_regulator))*(l2fr_max-l2fr_min) + l2fr = l2fr_min + max(0._r8,min(1.0_r8,np_regulator))*(10._r8*l2fr_min-l2fr_min) elseif(regulate_type == regulate_CN_dfdd) then @@ -1677,17 +1675,18 @@ subroutine CNPAllocateRemainder(this, c_gain, n_gain, p_gain, & ! Update carbon based allometric targets call bstore_allom(dbh,ipft,canopy_trim, store_c_target) - + + ! Allow some overflow - store_c_target = store_c_target * (1.0_r8 + store_overflow_frac) + store_c_target = store_c_target * (1._r8 + prt_params%store_ovrflw_frac(ipft)) - total_c_flux = min(c_gain,max(0.0, (store_c_target - this%variables(store_c_id)%val(1)))) - ! Transfer excess carbon into storage overflow + total_c_flux = min(c_gain,max(0.0_r8, ( store_c_target - this%variables(store_c_id)%val(1) ))) + ! Transfer excess carbon INTO storage overflow this%variables(store_c_id)%val(1) = this%variables(store_c_id)%val(1) + total_c_flux c_gain = c_gain - total_c_flux - resp_excess = c_gain - c_gain = 0._r8 + resp_excess = resp_excess + c_gain + c_gain = 0._r8 elseif(store_c_overflow == exude_c_store_overflow)then @@ -1695,7 +1694,7 @@ subroutine CNPAllocateRemainder(this, c_gain, n_gain, p_gain, & call bstore_allom(dbh,ipft,canopy_trim, store_c_target) ! Estimate the overflow - store_c_target = store_c_target * (1.0_r8 + store_overflow_frac) + store_c_target = store_c_target * (1._r8 + prt_params%store_ovrflw_frac(ipft)) total_c_flux = min(c_gain,max(0.0, (store_c_target - this%variables(store_c_id)%val(1)))) ! Transfer excess carbon into storage overflow @@ -1826,31 +1825,25 @@ function GetNutrientTargetCNP(this,element_id,organ_id,stoich_mode) result(targe if( element_id == nitrogen_element) then target_m = StorageNutrientTarget(ipft, element_id, & - leaf_c_target*prt_params%nitr_stoich_p2(ipft,prt_params%organ_param_id(leaf_organ)), & - fnrt_c_target*prt_params%nitr_stoich_p2(ipft,prt_params%organ_param_id(fnrt_organ)), & - sapw_c_target*prt_params%nitr_stoich_p2(ipft,prt_params%organ_param_id(sapw_organ)), & - struct_c_target*prt_params%nitr_stoich_p2(ipft,prt_params%organ_param_id(struct_organ))) + leaf_c_target*prt_params%nitr_stoich_p1(ipft,prt_params%organ_param_id(leaf_organ)), & + fnrt_c_target*prt_params%nitr_stoich_p1(ipft,prt_params%organ_param_id(fnrt_organ)), & + sapw_c_target*prt_params%nitr_stoich_p1(ipft,prt_params%organ_param_id(sapw_organ)), & + struct_c_target*prt_params%nitr_stoich_p1(ipft,prt_params%organ_param_id(struct_organ))) else target_m = StorageNutrientTarget(ipft, element_id, & - leaf_c_target*prt_params%phos_stoich_p2(ipft,prt_params%organ_param_id(leaf_organ)), & - fnrt_c_target*prt_params%phos_stoich_p2(ipft,prt_params%organ_param_id(fnrt_organ)), & - sapw_c_target*prt_params%phos_stoich_p2(ipft,prt_params%organ_param_id(sapw_organ)), & - struct_c_target*prt_params%phos_stoich_p2(ipft,prt_params%organ_param_id(struct_organ))) + leaf_c_target*prt_params%phos_stoich_p1(ipft,prt_params%organ_param_id(leaf_organ)), & + fnrt_c_target*prt_params%phos_stoich_p1(ipft,prt_params%organ_param_id(fnrt_organ)), & + sapw_c_target*prt_params%phos_stoich_p1(ipft,prt_params%organ_param_id(sapw_organ)), & + struct_c_target*prt_params%phos_stoich_p1(ipft,prt_params%organ_param_id(struct_organ))) end if ! This is only called during phase 3, remainder and allows ! us to have some overflow to avoid exudation/efflux if possible if( stoich_mode == stoich_max ) then - target_m = target_m*(1._r8 + store_overflow_frac) + target_m = target_m*(1._r8 + prt_params%store_ovrflw_frac(ipft)) end if - !if( stoich_mode == stoich_growth_min ) then - ! target_m = 0.1_r8*target_m - !end if - !if( stoich_mode == stoich_center ) then - ! do nothing, target_m is unchanged - !end if elseif(organ_id == repro_organ) then @@ -2255,7 +2248,7 @@ subroutine StorageRegulator(this,element_id,regulate_type,target_c,c_scalar) real(r8) :: c_gain real(r8) :: c_fnrt_expand ! predicted carbon available to expand fine-roots ! after replacement of turnover - + ! This fraction governs ! how much carbon from daily gains + storage overflow, is allowed to ! be spent on growing out roots. This inludes getting roots @@ -2276,10 +2269,13 @@ subroutine StorageRegulator(this,element_id,regulate_type,target_c,c_scalar) ipft => this%bc_in(acnp_bc_in_id_pft)%ival, & l2fr => this%bc_inout(acnp_bc_inout_id_l2fr)%rval) - logi_k = 2._r8 + + logi_k = EDPftvarcon_inst%dev_arbitrary_pft(ipft) !2._r8 store_x0 = 0.0_r8 logi_min = 0.0_r8 + ! TEMPORARY OVERRIDE + if(regulate_type == regulate_CN_logi) then store_c = this%GetState(store_organ, carbon12_element) @@ -2296,7 +2292,7 @@ subroutine StorageRegulator(this,element_id,regulate_type,target_c,c_scalar) elseif(regulate_type == regulate_CN_dfdd) then - store_max = this%GetNutrientTarget(element_id,store_organ,stoich_center) !*(1._r8 + 0.5*store_overflow_frac) + store_max = this%GetNutrientTarget(element_id,store_organ,stoich_growth_min) ! Storage fractions could be more than the target, depending on the ! hypothesis and functions involved, but should typically be 0-1 @@ -2308,7 +2304,7 @@ subroutine StorageRegulator(this,element_id,regulate_type,target_c,c_scalar) ! these stores can actually get pretty large, so the cap of 10x is numerically ! feasable, and should also minimize stress on the logistic function - store_c_max = target_c(store_organ) !*(1._r8 + 0.5*store_overflow_frac) + store_c_max = target_c(store_organ) store_c_frac = max(0.01_r8,min(5.0_r8,this%GetState(store_organ, carbon12_element)/store_c_max )) @@ -2382,8 +2378,8 @@ subroutine StorageRegulator(this,element_id,regulate_type,target_c,c_scalar) ! Determine the max change for the doubling timescale ! 2.0 = l2fr_delta_max^frnt_adapt_tscl - l2fr_delta_scale = 2._r8**(1._r8/fnrt_adapt_tscl)-1.0_r8 - + l2fr_delta_scale = 2._r8**(1._r8/prt_params%fnrt_adapt_tscale(ipft))-1.0_r8 + nc_frac = nc_frac_offset * store_frac / store_c_frac c_scalar = l2fr_delta_scale*(2.0_r8/(1.0_r8 + nc_frac**logi_k)-1.0_r8)+1.0_r8 diff --git a/parteh/PRTAllometricCarbonMod.F90 b/parteh/PRTAllometricCarbonMod.F90 index bb05e1c365..407d3e2c88 100644 --- a/parteh/PRTAllometricCarbonMod.F90 +++ b/parteh/PRTAllometricCarbonMod.F90 @@ -391,7 +391,7 @@ subroutine DailyPRTAllometricCarbon(this) store_c => this%variables(store_c_id)%val(icd), & repro_c => this%variables(repro_c_id)%val(icd), & struct_c => this%variables(struct_c_id)%val(icd), & - l2fr => prt_params%allom_l2fr_min(ipft) ) + l2fr => prt_params%allom_l2fr(ipft) ) ! ----------------------------------------------------------------------------------- ! 0. @@ -931,7 +931,7 @@ function AllomCGrowthDeriv(c_pools,c_mask,cbalance,intgr_params) result(dCdx) canopy_trim = intgr_params(ac_bc_in_id_ctrim) ipft = int(intgr_params(ac_bc_in_id_pft)) - l2fr = prt_params%allom_l2fr_min(ipft) + l2fr = prt_params%allom_l2fr(ipft) call bleaf(dbh,ipft,canopy_trim,ct_leaf,ct_dleafdd) call bfineroot(dbh,ipft,canopy_trim,l2fr,ct_fnrt,ct_dfnrtdd) diff --git a/parteh/PRTParametersMod.F90 b/parteh/PRTParametersMod.F90 index cbb9e4ad86..e1f418f09e 100644 --- a/parteh/PRTParametersMod.F90 +++ b/parteh/PRTParametersMod.F90 @@ -94,9 +94,9 @@ module PRTParametersMod ! Root profile parameters. Note we have separate parameters for those that govern ! hydraulics, and those that govern biomass (for decomposition and respiration) - real(r8), allocatable :: fnrt_prof_mode(:) ! Fine root profile functional form - real(r8), allocatable :: fnrt_prof_a(:) ! Fine root profile scaling parameter A - real(r8), allocatable :: fnrt_prof_b(:) ! Fine root profile scaling parameter B + real(r8), allocatable :: fnrt_prof_mode(:) ! Fine root profile functional form + real(r8), allocatable :: fnrt_prof_a(:) ! Fine root profile scaling parameter A + real(r8), allocatable :: fnrt_prof_b(:) ! Fine root profile scaling parameter B real(r8), allocatable :: c2b(:) ! Carbon to biomass multiplier [kg/kgC] real(r8), allocatable :: wood_density(:) ! wood density g cm^-3 ... @@ -119,10 +119,9 @@ module PRTParametersMod ! (sapwood area / leaf area) [cm2/m2] real(r8), allocatable :: allom_la_per_sa_slp(:) ! Leaf area to sap area conversion, slope ! (sapwood area / leaf area / diameter) [cm2/m2/cm] - real(r8), allocatable :: allom_l2fr_min(:) ! Minimum fine root biomass per leaf biomass ratio [kgC/kgC] - ! FOR C-ONLY, THIS IS THE ONLY AND STATIC L2FR - real(r8), allocatable :: allom_l2fr_max(:) ! Maximum fine root biomass per leaf biomass ratio [kgC/kgC] - ! for nutrient enabled runs + real(r8), allocatable :: allom_l2fr(:) ! Fine root biomass per leaf biomass ratio [kgC/kgC] + ! FOR C-ONLY: this is the static, unchanging ratio + ! FOR CNP: this is the initial value a cohort starts with real(r8), allocatable :: allom_agb_frac(:) ! Fraction of stem above ground [-] real(r8), allocatable :: allom_d2h1(:) ! Parameter 1 for d2h allometry (intercept, or "c") real(r8), allocatable :: allom_d2h2(:) ! Parameter 2 for d2h allometry (slope, or "m") @@ -147,6 +146,20 @@ module PRTParametersMod real(r8), allocatable :: allom_zroot_min_z(:) ! the maximum rooting depth defined at dbh = fates_allom_zroot_min_dbh [m] real(r8), allocatable :: allom_zroot_k(:) ! scale coefficient of logistic rooting depth model + + real(r8), allocatable :: fnrt_adapt_tscale(:) ! The time-scale over which you could see a doubling (or halving) + ! of fineroot biomass in response to a nutrient/carbon storage disparity + ! assuming no constraints on turnover or carbon availability (days) + + real(r8), allocatable :: store_ovrflw_frac(:) ! For a coupled nutrient enabled simulation with dynamic fine-root biomass, + ! there will be an excess of at least two of the three species C, N or P. + ! This specifies how much excess (overflow) is allowed to be retained in storage + ! beyond the target level before it is either burned (C) or exuded (N or P). The + ! maximum value is the target * (1+store_ovrflw_frac) + + + real(r8), allocatable :: nfix_mresp_scfrac(:) ! Surcharge (as a fraction) to add to maintentance respiration + ! that is used to pay for N-Fixation end type prt_param_type diff --git a/parteh/PRTParamsFATESMod.F90 b/parteh/PRTParamsFATESMod.F90 index 8a34af48c6..fb1338c5cd 100644 --- a/parteh/PRTParamsFATESMod.F90 +++ b/parteh/PRTParamsFATESMod.F90 @@ -231,11 +231,19 @@ subroutine PRTRegisterPFT(fates_params) call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'fates_allom_l2fr_min' + name = 'fates_allom_l2fr' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'fates_allom_l2fr_max' + name = 'fates_fnrt_adapt_tscale' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_store_ovrflw_frac' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_nfix1' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) @@ -527,14 +535,22 @@ subroutine PRTReceivePFT(fates_params) call fates_params%RetreiveParameterAllocate(name=name, & data=prt_params%allom_la_per_sa_slp) - name = 'fates_allom_l2fr_min' + name = 'fates_allom_l2fr' call fates_params%RetreiveParameterAllocate(name=name, & - data=prt_params%allom_l2fr_min) + data=prt_params%allom_l2fr) - name = 'fates_allom_l2fr_max' + name = 'fates_fnrt_adapt_tscale' call fates_params%RetreiveParameterAllocate(name=name, & - data=prt_params%allom_l2fr_max) - + data=prt_params%fnrt_adapt_tscale) + + name = 'fates_store_ovrflw_frac' + call fates_params%RetreiveParameterAllocate(name=name, & + data=prt_params%store_ovrflw_frac) + + name = 'fates_nfix1' + call fates_params%RetreiveParameterAllocate(name=name, & + data=prt_params%nfix_mresp_scfrac) + name = 'fates_allom_agb_frac' call fates_params%RetreiveParameterAllocate(name=name, & data=prt_params%allom_agb_frac) @@ -626,7 +642,7 @@ subroutine PRTReceivePFT(fates_params) name = 'fates_phos_store_ratio' call fates_params%RetreiveParameterAllocate(name=name, & data=prt_params%phos_store_ratio) - + end subroutine PRTReceivePFT @@ -891,8 +907,9 @@ subroutine FatesReportPFTParams(is_master) write(fates_log(),fmt0) 'allom_smode = ',prt_params%allom_smode write(fates_log(),fmt0) 'allom_la_per_sa_int = ',prt_params%allom_la_per_sa_int write(fates_log(),fmt0) 'allom_la_per_sa_slp = ',prt_params%allom_la_per_sa_slp - write(fates_log(),fmt0) 'allom_l2fr_min = ',prt_params%allom_l2fr_min - write(fates_log(),fmt0) 'allom_l2fr_max = ',prt_params%allom_l2fr_max + write(fates_log(),fmt0) 'allom_l2fr = ',prt_params%allom_l2fr + write(fates_log(),fmt0) 'fnrt_adapt_tscale = ',prt_params%fnrt_adapt_tscale + write(fates_log(),fmt0) 'store_ovrflw_frac = ',prt_params%store_ovrflw_frac write(fates_log(),fmt0) 'allom_agb_frac = ',prt_params%allom_agb_frac write(fates_log(),fmt0) 'allom_d2h1 = ',prt_params%allom_d2h1 write(fates_log(),fmt0) 'allom_d2h2 = ',prt_params%allom_d2h2 @@ -1046,6 +1063,18 @@ subroutine PRTCheckParams(is_master) end do end if + + ! Make sure that the N fixation respiration surcharge fraction is + ! between 0 and 1 + if (hlm_parteh_mode .eq. prt_cnp_flex_allom_hyp) then + if(any(prt_params%nfix_mresp_scfrac(:)<0._r8) .or. any(prt_params%nfix_mresp_scfrac(:)>1.0_r8)) then + write(fates_log(),*) 'The N fixation surcharge nfix_mresp_sfrac (fates_nfix1) must be between 0-1.' + write(fates_log(),*) 'here are the values: ',prt_params%nfix_mresp_scfrac(:) + write(fates_log(),*) 'Aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + end if + pftloop: do ipft = 1,npft @@ -1470,7 +1499,7 @@ function NewRecruitTotalStoichiometry(ft,element_id) result(recruit_stoich) call h2d_allom(EDPftvarcon_inst%hgt_min(ft),ft,dbh) call bleaf(dbh,ft,init_recruit_trim,c_leaf) - call bfineroot(dbh,ft,init_recruit_trim,prt_params%allom_l2fr_min(ft),c_fnrt) + call bfineroot(dbh,ft,init_recruit_trim,prt_params%allom_l2fr(ft),c_fnrt) call bsap_allom(dbh,ft,init_recruit_trim,a_sapw, c_sapw) call bagw_allom(dbh,ft,c_agw) call bbgw_allom(dbh,ft,c_bgw) From 5f44bfafc4bfe30599d2dd391831cb6d34c9e4e5 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Fri, 15 Apr 2022 15:19:55 -0400 Subject: [PATCH 21/55] Added carbon storage fraction by sizexpft ustory/canopy --- main/FatesHistoryInterfaceMod.F90 | 50 +++++++++++++++++++++++++++++-- 1 file changed, 48 insertions(+), 2 deletions(-) diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 1c455565f2..987b8ad87d 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -162,6 +162,8 @@ module FatesHistoryInterfaceMod integer :: ih_storec_si integer :: ih_storectfrac_si + integer :: ih_storectfrac_canopy_scpf + integer :: ih_storectfrac_ustory_scpf integer :: ih_leafc_si integer :: ih_sapwc_si integer :: ih_fnrtc_si @@ -1974,6 +1976,8 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) real(r8) :: storen_understory_scpf(numpft*nlevsclass) real(r8) :: storep_canopy_scpf(numpft*nlevsclass) real(r8) :: storep_understory_scpf(numpft*nlevsclass) + real(r8) :: storec_canopy_scpf(numpft*nlevsclass) + real(r8) :: storec_understory_scpf(numpft*nlevsclass) integer :: return_code @@ -2249,7 +2253,9 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) storen_understory_scpf(:) = 0._r8 storep_canopy_scpf(:) = 0._r8 storep_understory_scpf(:) = 0._r8 - + storec_canopy_scpf(:) = 0._r8 + storec_understory_scpf(:) = 0._r8 + ! Total carbon model error [kgC/day -> kgC/s] hio_cbal_err_fates_si(io_si) = & sites(s)%mass_balance(element_pos(carbon12_element))%err_fates / sec_per_day @@ -2593,6 +2599,21 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) total_m * ccohort%n * AREA_INV endif + if (ccohort%canopy_layer .eq. 1) then + storec_canopy_scpf(i_scpf) = & + storec_canopy_scpf(i_scpf) + ccohort%n * store_m + this%hvars(ih_storectfrac_canopy_scpf)%r82d(io_si,i_scpf) = & + this%hvars(ih_storectfrac_canopy_scpf)%r82d(io_si,i_scpf) + & + ccohort%n * store_max + else + storec_understory_scpf(i_scpf) = & + storec_understory_scpf(i_scpf) + ccohort%n * store_m + this%hvars(ih_storectfrac_ustory_scpf)%r82d(io_si,i_scpf) = & + this%hvars(ih_storectfrac_ustory_scpf)%r82d(io_si,i_scpf) + & + ccohort%n * store_max + end if + + elseif(element_list(el).eq.nitrogen_element)then store_max = ccohort%prt%GetNutrientTarget(element_list(el),store_organ,stoich_growth_min) @@ -3611,9 +3632,21 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) hio_l2fr_understory_scpf(io_si,i_scpf) = & hio_l2fr_understory_scpf(io_si,i_scpf)/fnrtc_understory_scpf(i_scpf) end if + + if( this%hvars(ih_storectfrac_canopy_scpf)%r82d(io_si,i_scpf)>nearzero ) then + this%hvars(ih_storectfrac_canopy_scpf)%r82d(io_si,i_scpf) = & + storec_canopy_scpf(i_scpf) / & + this%hvars(ih_storectfrac_canopy_scpf)%r82d(io_si,i_scpf) + end if + if( this%hvars(ih_storectfrac_ustory_scpf)%r82d(io_si,i_scpf)>nearzero ) then + this%hvars(ih_storectfrac_ustory_scpf)%r82d(io_si,i_scpf) = & + storec_understory_scpf(i_scpf) / & + this%hvars(ih_storectfrac_ustory_scpf)%r82d(io_si,i_scpf) + end if + end do end do - + do el = 1, num_elements if(element_list(el).eq.nitrogen_element)then @@ -5096,6 +5129,19 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=site_r8, hlms='CLM:ALM', upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_storectfrac_si ) + call this%set_history_var(vname='FATES_STOREC_TFRAC_USTORY_SZPF', units='kg kg-1', & + long='Storage C fraction of target by size x pft, in the understory', use_default='inactive', & + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_storectfrac_ustory_scpf ) + + + call this%set_history_var(vname='FATES_STOREC_TFRAC_CANOPY_SZPF', units='kg kg-1', & + long='Storage C fraction of target by size x pft, in the canopy', use_default='inactive', & + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_storectfrac_canopy_scpf ) + + + call this%set_history_var(vname='FATES_VEGC', units='kg m-2', & long='total biomass in live plants in kg carbon per m2 land area', & use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & From 7b1a8b7aee6a9661184213b5a8e68f035e035084 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Fri, 15 Apr 2022 15:22:37 -0400 Subject: [PATCH 22/55] Started work on root reabsorption for cnp optimization --- parteh/PRTAllometricCNPMod.F90 | 29 +++++++++++++++++++---------- 1 file changed, 19 insertions(+), 10 deletions(-) diff --git a/parteh/PRTAllometricCNPMod.F90 b/parteh/PRTAllometricCNPMod.F90 index 4e411d3d5d..064eec22a1 100644 --- a/parteh/PRTAllometricCNPMod.F90 +++ b/parteh/PRTAllometricCNPMod.F90 @@ -446,6 +446,19 @@ subroutine DailyPRTAllometricCNP(this) target_c(repro_organ) = 0._r8 target_dcdd(repro_organ) = 0._r8 + ! =================================================================================== + ! Step 1: Evaluate nutrient storage in the plant. Depending on how low + ! these stores are, we will move proportionally more or less of the daily carbon + ! gain to increase the target fine-root biomass, fill up to target + ! and then attempt to get them up to stoichiometry targets. + ! =================================================================================== + + ! This routine updates the l2fr (leaf 2 fine-root multiplier) variable + call this%CNPAdjustFRootTargets(target_c) + + + + c_gain0 = c_gain n_gain0 = n_gain p_gain0 = p_gain @@ -464,15 +477,7 @@ subroutine DailyPRTAllometricCNP(this) state_p0(i_org) = this%variables(i_var)%val(1) end do - ! =================================================================================== - ! Step 1: Evaluate nutrient storage in the plant. Depending on how low - ! these stores are, we will move proportionally more or less of the daily carbon - ! gain to increase the target fine-root biomass, fill up to target - ! and then attempt to get them up to stoichiometry targets. - ! =================================================================================== - - ! This routine updates the l2fr (leaf 2 fine-root multiplier) variable - call this%CNPAdjustFRootTargets(target_c) + ! Output only boundary conditions c_efflux => this%bc_out(acnp_bc_out_id_cefflux)%rval; c_efflux = 0._r8 @@ -742,7 +747,11 @@ subroutine CNPAdjustFRootTargets(this, target_c) ! generate mass check errors in the main CNPAllocation routine, this is because the "val" is ! changing but the net_allocated is not reciprocating, which is expected. - fnrt_c_above_target = max(0._r8,this%GetState(fnrt_organ, carbon12_element) - target_c(fnrt_organ)) + ! Don't remove roots that will be gone due to natural turnover + + store_c = this%GetState(fnrt_organ, carbon12_element)*(1._r8-(years_per_day / prt_params%root_long(ipft))) + + fnrt_c_above_target = max(0._r8,store_c - target_c(fnrt_organ)) loss_flux_c = 0._r8 From 7a1178f31b37a1475b30cde0dc58abc1cd6919ec Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Fri, 6 May 2022 12:07:59 -0400 Subject: [PATCH 23/55] CNP updates, small modifications to things like root trimming and limiters on growth. --- main/EDTypesMod.F90 | 4 +- main/FatesHistoryInterfaceMod.F90 | 34 ++++-- parteh/PRTAllometricCNPMod.F90 | 168 +++++++++++++++++++++--------- parteh/PRTGenericMod.F90 | 48 +++++++-- 4 files changed, 184 insertions(+), 70 deletions(-) diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 4ae673d5aa..b76408c787 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -28,9 +28,9 @@ module EDTypesMod private ! By default everything is private save - integer, parameter, public :: maxPatchesPerSite = 6 ! maximum number of patches to live on a site + integer, parameter, public :: maxPatchesPerSite = 11 ! maximum number of patches to live on a site integer, parameter, public :: maxPatchesPerSite_by_disttype(n_anthro_disturbance_categories) = & - (/ 5, 1 /) !!! MUST SUM TO maxPatchesPerSite !!! + (/ 10, 1 /) !!! MUST SUM TO maxPatchesPerSite !!! integer, public :: maxCohortsPerPatch ! maximum number of cohorts per patch integer, parameter, public :: nclmax = 3 ! Maximum number of canopy layers diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 987b8ad87d..9f645c81c4 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -1987,6 +1987,14 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) real(r8), parameter :: tiny = 1.e-5_r8 ! some small number real(r8), parameter :: reallytalltrees = 1000. ! some large number (m) + + ! Set this to true if you want the size-pft l2fr variables to + ! take a mean over the site, otherwise it just tracks the oldest patch + + logical, parameter :: do_site_l2fr_scpf = .false. + + + integer :: tmp associate( hio_npatches_si => this%hvars(ih_npatches_si)%r81d, & @@ -2238,6 +2246,11 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) model_day_int = nint(hlm_model_day) + + + + + ! --------------------------------------------------------------------------------- ! Loop through the FATES scale hierarchy and fill the history IO arrays ! --------------------------------------------------------------------------------- @@ -2546,16 +2559,19 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) hio_l2fr_scpf(io_si,i_scpf) = & hio_l2fr_scpf(io_si,i_scpf) + ccohort%n*fnrt_m/m2_per_ha*ccohort%l2fr - if (ccohort%canopy_layer .eq. 1) then - hio_l2fr_canopy_scpf(io_si,i_scpf) = & - hio_l2fr_canopy_scpf(io_si,i_scpf) + ccohort%n*fnrt_m *ccohort%l2fr - fnrtc_canopy_scpf(i_scpf) = fnrtc_canopy_scpf(i_scpf) + ccohort%n*fnrt_m - else - hio_l2fr_understory_scpf(io_si,i_scpf) = & - hio_l2fr_understory_scpf(io_si,i_scpf) + ccohort%n*fnrt_m*ccohort%l2fr - fnrtc_understory_scpf(i_scpf) = fnrtc_understory_scpf(i_scpf) + ccohort%n*fnrt_m + ! Constrain L2FR to oldest patch? + if(do_site_l2fr_scpf .or. associated(cpatch,sites(s)%oldest_patch)) then + if (ccohort%canopy_layer .eq. 1) then + hio_l2fr_canopy_scpf(io_si,i_scpf) = & + hio_l2fr_canopy_scpf(io_si,i_scpf) + ccohort%n*fnrt_m *ccohort%l2fr + fnrtc_canopy_scpf(i_scpf) = fnrtc_canopy_scpf(i_scpf) + ccohort%n*fnrt_m + else + hio_l2fr_understory_scpf(io_si,i_scpf) = & + hio_l2fr_understory_scpf(io_si,i_scpf) + ccohort%n*fnrt_m*ccohort%l2fr + fnrtc_understory_scpf(i_scpf) = fnrtc_understory_scpf(i_scpf) + ccohort%n*fnrt_m + end if end if - + call bstore_allom(ccohort%dbh,ccohort%pft,ccohort%canopy_trim, store_max) this%hvars(ih_storectfrac_si)%r81d(io_si) = & this%hvars(ih_storectfrac_si)%r81d(io_si) + ccohort%n * store_max/m2_per_ha diff --git a/parteh/PRTAllometricCNPMod.F90 b/parteh/PRTAllometricCNPMod.F90 index 064eec22a1..e729a4f33c 100644 --- a/parteh/PRTAllometricCNPMod.F90 +++ b/parteh/PRTAllometricCNPMod.F90 @@ -203,7 +203,9 @@ module PRTAllometricCNPMod integer, parameter :: regulate_CN_logi = 3 ! almost deprecated integer, parameter :: regulate_CN_dfdd = 4 - + logical, parameter :: use_gains_in_regulator = .true. + logical, parameter :: use_unrestricted_contraction = .true. + ! ------------------------------------------------------------------------------------- ! This is the core type that holds this specific ! plant reactive transport (PRT) module @@ -226,6 +228,7 @@ module PRTAllometricCNPMod procedure :: CNPAllocateRemainder procedure :: GetDeficit procedure :: StorageRegulator + procedure :: TrimFineRoot end type cnp_allom_prt_vartypes @@ -454,10 +457,8 @@ subroutine DailyPRTAllometricCNP(this) ! =================================================================================== ! This routine updates the l2fr (leaf 2 fine-root multiplier) variable + ! It will also update target_c(fnrt_organ) call this%CNPAdjustFRootTargets(target_c) - - - c_gain0 = c_gain n_gain0 = n_gain @@ -654,9 +655,16 @@ subroutine DailyPRTAllometricCNP(this) else p_gain = p_gain0 end if - + + + + ! If fine-roots are allocated above their + ! target (perhaps with some buffer, but perhaps not) + ! then + call this%TrimFineRoot() + return end subroutine DailyPRTAllometricCNP @@ -680,10 +688,8 @@ subroutine CNPAdjustFRootTargets(this, target_c) ! remain after a day of root turnover without ! replacement real(r8) :: fnrt_frac ! fine-root's current fraction of the target - real(r8) :: loss_flux_c - real(r8) :: loss_flux_n - real(r8) :: loss_flux_p - real(r8) :: fnrt_c_above_target + + integer, parameter :: regulate_type = regulate_CN_dfdd @@ -705,7 +711,7 @@ subroutine CNPAdjustFRootTargets(this, target_c) else call this%StorageRegulator(phosphorus_element, regulate_type,target_c,p_regulator) end if - + ! We take the maximum here, because the maximum is reflective of the ! element with the lowest storage, which is the limiting element if(n_uptake_mode.eq.prescribed_n_uptake)then @@ -738,44 +744,82 @@ subroutine CNPAdjustFRootTargets(this, target_c) ! Find the updated target fineroot biomass call bfineroot(dbh,ipft,canopy_trim, l2fr, target_c(fnrt_organ)) + + end associate - ! The following section allows forceful turnover of fine-roots if a new L2FR is generated - ! that is lower than the previous l2fr. The maintenance turnover (background) rate - ! will automatically accomodate a lower l2fr, but if the change is large it will - ! not keep pace. Note 1: however, that the algorithm in StorageRegulator() will prevent - ! large drops in l2fr (unless that safegaurd is removed). Note 2: this section may also - ! generate mass check errors in the main CNPAllocation routine, this is because the "val" is - ! changing but the net_allocated is not reciprocating, which is expected. + return + end subroutine CNPAdjustFRootTargets + + ! ===================================================================================== - ! Don't remove roots that will be gone due to natural turnover - - store_c = this%GetState(fnrt_organ, carbon12_element)*(1._r8-(years_per_day / prt_params%root_long(ipft))) - - fnrt_c_above_target = max(0._r8,store_c - target_c(fnrt_organ)) + subroutine TrimFineRoot(this) + + ! The following section allows forceful turnover of fine-roots if a new L2FR is generated + ! that is lower than the previous l2fr. The maintenance turnover (background) rate + ! will automatically accomodate a lower l2fr, but if the change is large it will + ! not keep pace. Note 1: however, that the algorithm in StorageRegulator() will prevent + ! large drops in l2fr (unless that safegaurd is removed). Note 2: this section may also + ! generate mass check errors in the main CNPAllocation routine, this is because the "val" is + ! changing but the net_allocated is not reciprocating, which is expected. + + ! Keep a buffer above the L2FR in the hopes that natural turnover will catch + ! up. + class(cnp_allom_prt_vartypes) :: this + + real(r8) :: fnrt_flux_c + real(r8) :: turn_flux_c + real(r8) :: store_flux_c + real(r8) :: nc_fnrt + real(r8) :: pc_fnrt + real(r8) :: target_fnrt_c + real(r8),parameter :: nday_buffer = 0._r8 + real(r8),parameter :: fnrt_opt_eff = 0._r8 ! If we want to transfer resources to storage + + if(.not.use_unrestricted_contraction)return + + associate( ipft => this%bc_in(acnp_bc_in_id_pft)%ival, & + l2fr => this%bc_inout(acnp_bc_inout_id_l2fr)%rval, & + dbh => this%bc_inout(acnp_bc_inout_id_dbh)%rval, & + canopy_trim => this%bc_in(acnp_bc_in_id_ctrim)%rval) - loss_flux_c = 0._r8 - - !loss_flux_c = fnrt_c_above_target*max(fnrt_c_above_target/fnrt_c_target-0.1_r8,0._r8) - - - loss_flux_n = loss_flux_c*this%variables(fnrt_n_id)%val(1)/this%variables(fnrt_c_id)%val(1) - this%variables(fnrt_n_id)%val(1) = this%variables(fnrt_n_id)%val(1) - loss_flux_n - this%variables(fnrt_n_id)%turnover(1) = this%variables(fnrt_n_id)%turnover(1) + loss_flux_n + ! Find the updated target fineroot biomass + call bfineroot(dbh,ipft,canopy_trim, l2fr, target_fnrt_c) - loss_flux_p = loss_flux_c*this%variables(fnrt_p_id)%val(1)/this%variables(fnrt_c_id)%val(1) - this%variables(fnrt_p_id)%val(1) = this%variables(fnrt_p_id)%val(1) - loss_flux_p - this%variables(fnrt_p_id)%turnover(1) = this%variables(fnrt_p_id)%turnover(1) + loss_flux_p - - this%variables(fnrt_c_id)%val(1) = this%variables(fnrt_c_id)%val(1) - loss_flux_c - this%variables(fnrt_c_id)%turnover(1) = this%variables(fnrt_c_id)%turnover(1) + loss_flux_c + fnrt_flux_c = max(0._r8,this%variables(fnrt_c_id)%val(1)*(1._r8-nday_buffer*(years_per_day / prt_params%root_long(ipft))) - target_fnrt_c ) - + if(fnrt_flux_c>nearzero) then - end associate + !EDPftvarcon_inst%dev_arbitrary_pft(ipft) - return - end subroutine CNPAdjustFRootTargets + turn_flux_c = (1._r8 - fnrt_opt_eff)*fnrt_flux_c + store_flux_c = fnrt_opt_eff*fnrt_flux_c + nc_fnrt = this%variables(fnrt_n_id)%val(1)/this%variables(fnrt_c_id)%val(1) + pc_fnrt = this%variables(fnrt_p_id)%val(1)/this%variables(fnrt_c_id)%val(1) + + this%variables(fnrt_c_id)%val(1) = this%variables(fnrt_c_id)%val(1) - fnrt_flux_c + this%variables(fnrt_c_id)%turnover(1) = this%variables(fnrt_c_id)%turnover(1) + turn_flux_c + this%variables(fnrt_c_id)%net_alloc(1) = this%variables(fnrt_c_id)%net_alloc(1) - store_flux_c + this%variables(store_c_id)%val(1) = this%variables(store_c_id)%val(1) + store_flux_c + this%variables(store_c_id)%net_alloc(1) = this%variables(store_c_id)%net_alloc(1) + store_flux_c + + this%variables(fnrt_n_id)%val(1) = this%variables(fnrt_n_id)%val(1) - fnrt_flux_c * nc_fnrt + this%variables(fnrt_n_id)%turnover(1) = this%variables(fnrt_n_id)%turnover(1) + turn_flux_c * nc_fnrt + this%variables(fnrt_n_id)%net_alloc(1) = this%variables(fnrt_n_id)%net_alloc(1) - store_flux_c * nc_fnrt + this%variables(store_n_id)%val(1) = this%variables(store_n_id)%val(1) + store_flux_c * nc_fnrt + this%variables(store_n_id)%net_alloc(1) = this%variables(store_n_id)%net_alloc(1) + store_flux_c * nc_fnrt + + this%variables(fnrt_p_id)%val(1) = this%variables(fnrt_p_id)%val(1) - fnrt_flux_c * pc_fnrt + this%variables(fnrt_p_id)%turnover(1) = this%variables(fnrt_p_id)%turnover(1) + turn_flux_c * pc_fnrt + this%variables(fnrt_p_id)%net_alloc(1) = this%variables(fnrt_p_id)%net_alloc(1) - store_flux_c * pc_fnrt + this%variables(store_p_id)%val(1) = this%variables(store_p_id)%val(1) + store_flux_c * pc_fnrt + this%variables(store_p_id)%net_alloc(1) = this%variables(store_p_id)%net_alloc(1) + store_flux_c * pc_fnrt + + end if + end associate + return + end subroutine TrimFineRoot + ! ===================================================================================== subroutine CNPPrioritizedReplacement(this,c_gain, n_gain, p_gain, target_c) @@ -2257,7 +2301,10 @@ subroutine StorageRegulator(this,element_id,regulate_type,target_c,c_scalar) real(r8) :: c_gain real(r8) :: c_fnrt_expand ! predicted carbon available to expand fine-roots ! after replacement of turnover - + real(r8) :: gain + real(r8) :: store_act + real(r8) :: store_c_act + ! This fraction governs ! how much carbon from daily gains + storage overflow, is allowed to ! be spent on growing out roots. This inludes getting roots @@ -2266,20 +2313,22 @@ subroutine StorageRegulator(this,element_id,regulate_type,target_c,c_scalar) integer, parameter :: limit_lf = 2 integer, parameter :: lim_l2fr_max_type = limit_all - real(r8), parameter :: max_l2fr_cgain_frac = 0.95_r8 + real(r8), parameter :: max_l2fr_cgain_frac = 0.99_r8 real(r8), parameter :: nc_frac_offset = 1.0_r8 ! This shifts the center-point ! of the N:C or P:C storage equlibrium ! by multiplying the N term. - associate(dbh => this%bc_inout(acnp_bc_inout_id_dbh)%rval, & - canopy_trim => this%bc_in(acnp_bc_in_id_ctrim)%rval, & - ipft => this%bc_in(acnp_bc_in_id_pft)%ival, & - l2fr => this%bc_inout(acnp_bc_inout_id_l2fr)%rval) + + + associate(dbh => this%bc_inout(acnp_bc_inout_id_dbh)%rval, & + canopy_trim => this%bc_in(acnp_bc_in_id_ctrim)%rval, & + ipft => this%bc_in(acnp_bc_in_id_pft)%ival, & + l2fr => this%bc_inout(acnp_bc_inout_id_l2fr)%rval) - logi_k = EDPftvarcon_inst%dev_arbitrary_pft(ipft) !2._r8 + logi_k = EDPftvarcon_inst%dev_arbitrary_pft(ipft) store_x0 = 0.0_r8 logi_min = 0.0_r8 @@ -2300,14 +2349,27 @@ subroutine StorageRegulator(this,element_id,regulate_type,target_c,c_scalar) elseif(regulate_type == regulate_CN_dfdd) then - store_max = this%GetNutrientTarget(element_id,store_organ,stoich_growth_min) ! Storage fractions could be more than the target, depending on the ! hypothesis and functions involved, but should typically be 0-1 ! The cap of 5 is for numerics and preventing weird math - store_frac = max(0.01_r8,min(5.0_r8,this%GetState(store_organ, element_id)/store_max)) + if(element_id.eq.nitrogen_element)then + gain = this%bc_inout(acnp_bc_inout_id_netdn)%rval + else + gain = this%bc_inout(acnp_bc_inout_id_netdp)%rval + end if + + if(use_gains_in_regulator)then + store_act = this%GetState(store_organ, element_id) + gain + store_c_act = this%GetState(store_organ, carbon12_element) + this%bc_in(acnp_bc_in_id_netdc)%rval + else + store_act = this%GetState(store_organ, element_id) + store_c_act = this%GetState(store_organ, carbon12_element) + end if + + store_frac = max(0.01_r8,min(5.0_r8,store_act/store_max)) ! Since we don't dump storage carbon ! these stores can actually get pretty large, so the cap of 10x is numerically @@ -2315,7 +2377,7 @@ subroutine StorageRegulator(this,element_id,regulate_type,target_c,c_scalar) store_c_max = target_c(store_organ) - store_c_frac = max(0.01_r8,min(5.0_r8,this%GetState(store_organ, carbon12_element)/store_c_max )) + store_c_frac = max(0.01_r8,min(5.0_r8,store_c_act/store_c_max)) ! ----------------------------------------------------------------------------- ! To decide the upper limit on expanding root growth, we perform a carbon @@ -2396,7 +2458,10 @@ subroutine StorageRegulator(this,element_id,regulate_type,target_c,c_scalar) if(c_scalar>1.0_r8)then c_scalar = min(c_scalar,l2fr_delta_max) else - c_scalar = max(c_scalar,l2fr_delta_min) + ! Remove the min function temporarily + if(.not.use_unrestricted_contraction)then + c_scalar = max(c_scalar,l2fr_delta_min) + end if end if @@ -2404,7 +2469,6 @@ subroutine StorageRegulator(this,element_id,regulate_type,target_c,c_scalar) end associate - end subroutine StorageRegulator ! ==================================================================================== diff --git a/parteh/PRTGenericMod.F90 b/parteh/PRTGenericMod.F90 index b92a1e14a7..d3538b528d 100644 --- a/parteh/PRTGenericMod.F90 +++ b/parteh/PRTGenericMod.F90 @@ -1334,10 +1334,12 @@ function StorageNutrientTarget(pft, element_id, leaf_target, fnrt_target, sapw_t ! total nitrogen content of 1 or more sets of organs ! ------------------------------------------------------------------------------------- - integer, parameter :: lfs_store_prop = 1 ! leaf-sapwood proportional storage - integer, parameter :: lfss_store_prop = 2 ! leaf-fnrt-sapw-struct proportional storage - integer, parameter :: fnrt_store_prop = 3 ! fineroot proportional storage - integer, parameter :: store_prop = lfs_store_prop + integer, parameter :: lfs_store_prop = 1 ! leaf-sapwood proportional storage + integer, parameter :: lfss_store_prop = 2 ! leaf-fnrt-sapw-struct proportional storage + integer, parameter :: fnrt_store_prop = 3 ! fineroot proportional storage + integer, parameter :: cstore_store_prop = 4 ! As a proportion to carbon storage times mean CN + integer, parameter :: lf_store_prop = 5 ! leaf proportional storage + integer, parameter :: store_prop = lf_store_prop select case(element_id) @@ -1352,6 +1354,10 @@ function StorageNutrientTarget(pft, element_id, leaf_target, fnrt_target, sapw_t store_target = prt_params%nitr_store_ratio(pft) * (leaf_target + sapw_target) + elseif (store_prop == lf_store_prop) then + + store_target = prt_params%nitr_store_ratio(pft) * leaf_target + elseif(store_prop==lfss_store_prop) then store_target = prt_params%nitr_store_ratio(pft) * (leaf_target + fnrt_target + sapw_target + struct_target) @@ -1360,6 +1366,30 @@ function StorageNutrientTarget(pft, element_id, leaf_target, fnrt_target, sapw_t store_target = prt_params%nitr_store_ratio(pft) * fnrt_target + elseif(store_prop==cstore_store_prop) then + + !call bsap_allom(dbh,ipft,canopy_trim,sapw_area,target_sapw_c) + !call bagw_allom(dbh,ipft,agw_c_target) + !call bbgw_allom(dbh,ipft,bgw_c_target) + !call bdead_allom(agw_c_target,bgw_c_target,target_sapw_c,ipft,target_struct_c) + !call bleaf(dbh,ipft,canopy_trim, target_leaf_c) + !call bfineroot(dbh,ipft,canopy_trim, l2fr, target_fnrt_c) + !call bstore_allom(dbh,ipft,canopy_trim, target_store_c) + + ! Strategy, store as much nutrient as needed to match carbon's growth potential + ! ie, nutrient storage is proportional to carbon storage times plant NC ratio + + ! N_so = a * C_so * NC_p + ! NC_p = ( (N_so + N_lf + N_fr + N_sa + N_de)/C_tot ) + ! N_so = a * C_so * ( N_so/C_tot) + a * C_so * (N_lf + N_fr + N_sa + N_de)/C_tot ) + ! N_so = (a * C_so * (N_lf + N_fr + N_sa + N_de)/C_tot ) / ( 1 - a * C_so/C_tot) + + !store_target = (target_store_c * prt_params%nitr_store_ratio(pft) * & + ! (leaf_target + fnrt_target + sapw_target + struct_target)/total_c_target) / & + ! ( 1._r8 - target_store_c * prt_params%nitr_store_ratio(pft) / total_c_target ) + write(fates_log(),*)'cstore_store_prop method of calculating target nutrient stores not available' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if @@ -1369,15 +1399,19 @@ function StorageNutrientTarget(pft, element_id, leaf_target, fnrt_target, sapw_t store_target = prt_params%phos_store_ratio(pft) * (leaf_target + fnrt_target + sapw_target) + elseif (store_prop == lf_store_prop) then + + store_target = prt_params%phos_store_ratio(pft) * leaf_target + elseif(store_prop==lfss_store_prop) then - store_target = prt_params%nitr_store_ratio(pft) * (leaf_target + fnrt_target + sapw_target + struct_target) + store_target = prt_params%phos_store_ratio(pft) * (leaf_target + fnrt_target + sapw_target + struct_target) elseif(store_prop==fnrt_store_prop) then store_target = prt_params%phos_store_ratio(pft) * fnrt_target - - end if + + end if end select From 87620937b992d268df8333beb1a582c7c01950ac Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Tue, 24 May 2022 13:45:36 -0400 Subject: [PATCH 24/55] cleaning up the cnp version 2 allocation code, adding in a diagnostic that tracks which speciens (CNP) limits growth --- biogeochem/EDCohortDynamicsMod.F90 | 16 +- main/EDMainMod.F90 | 2 +- main/EDTypesMod.F90 | 8 +- parteh/PRTAllometricCNPMod.F90 | 466 +++++++++++------------------ 4 files changed, 197 insertions(+), 295 deletions(-) diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index c1bffe6313..da2f4ad256 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -99,7 +99,7 @@ module EDCohortDynamicsMod use PRTAllometricCNPMod, only : acnp_bc_inout_id_resp_excess, acnp_bc_in_id_netdc use PRTAllometricCNPMod, only : acnp_bc_inout_id_netdn, acnp_bc_inout_id_netdp use PRTAllometricCNPMod, only : acnp_bc_out_id_cefflux, acnp_bc_out_id_nefflux - use PRTAllometricCNPMod, only : acnp_bc_out_id_pefflux + use PRTAllometricCNPMod, only : acnp_bc_out_id_pefflux, acnp_bc_out_id_limiter use shr_infnan_mod, only : nan => shr_infnan_nan, assignment(=) @@ -431,13 +431,15 @@ subroutine InitPRTBoundaryConditions(new_cohort) call new_cohort%prt%RegisterBCInOut(acnp_bc_inout_id_dbh,bc_rval = new_cohort%dbh) call new_cohort%prt%RegisterBCInOut(acnp_bc_inout_id_resp_excess,bc_rval = new_cohort%resp_excess) call new_cohort%prt%RegisterBCInOut(acnp_bc_inout_id_l2fr,bc_rval = new_cohort%l2fr) + call new_cohort%prt%RegisterBCInOut(acnp_bc_inout_id_netdn, bc_rval = new_cohort%daily_n_gain) call new_cohort%prt%RegisterBCInOut(acnp_bc_inout_id_netdp, bc_rval = new_cohort%daily_p_uptake) call new_cohort%prt%RegisterBCOut(acnp_bc_out_id_cefflux, bc_rval = new_cohort%daily_c_efflux) call new_cohort%prt%RegisterBCOut(acnp_bc_out_id_nefflux, bc_rval = new_cohort%daily_n_efflux) call new_cohort%prt%RegisterBCOut(acnp_bc_out_id_pefflux, bc_rval = new_cohort%daily_p_efflux) - + call new_cohort%prt%RegisterBCOut(acnp_bc_out_id_limiter, bc_ival = new_cohort%cnp_limiter) + case DEFAULT write(fates_log(),*) 'You specified an unknown PRT module' @@ -717,7 +719,6 @@ subroutine zero_cohort(cc_p) ! resource allocation currentCohort%daily_n_fixation = 0._r8 - end subroutine zero_cohort !-------------------------------------------------------------------------------------! @@ -1213,9 +1214,9 @@ subroutine fuse_cohorts(currentSite, currentPatch, bc_in) ! ----------------------------------------------------------------- call UpdateCohortBioPhysRates(currentCohort) - currentCohort%l2fr = (currentCohort%n*currentCohort%l2fr& + currentCohort%l2fr = (currentCohort%n*currentCohort%l2fr & + nextc%n*nextc%l2fr)/newn - + currentCohort%laimemory = (currentCohort%n*currentCohort%laimemory & + nextc%n*nextc%laimemory)/newn @@ -1830,7 +1831,7 @@ subroutine copy_cohort( currentCohort,copyc ) ! This transfers the PRT objects over. call n%prt%CopyPRTVartypes(o%prt) - n%l2fr = o%l2fr + n%l2fr = o%l2fr ! Leaf biophysical rates n%vcmax25top = o%vcmax25top @@ -1939,6 +1940,9 @@ subroutine copy_cohort( currentCohort,copyc ) n%shorter => NULL() ! pointer to next shorter cohort n%patchptr => o%patchptr ! pointer to patch that cohort is in + + + end subroutine copy_cohort !-------------------------------------------------------------------------------------! diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index d866ca0c2e..28fefe9da2 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -452,7 +452,7 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) currentCohort%resp_excess = 0._r8 call currentCohort%prt%DailyPRT() - + ! Send any efflux/exudates to the labile litter pools in the HLM ! ----------------------------------------------------------------------------- diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index b76408c787..0a9d46eb30 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -214,14 +214,15 @@ module EDTypesMod class(prt_vartypes), pointer :: prt real(r8) :: l2fr ! leaf to fineroot biomass ratio (this is constant - ! in carbon only simulations, and is set by the + ! in carbon only simulationss, and is set by the ! allom_l2fr_min parameter. In nutrient ! enabled simulations, this is dynamic, will ! vary between allom_l2fr_min and allom_l2fr_max ! parameters, with a tendency driven by ! nutrient storage) - + integer :: cnp_limiter ! Which species is limiting growth? ! 0=none,1=C,2=N,3=P + !!class(rmean_type), pointer :: l2fr_ema ! Exponential moving average of the L2FR ! VEGETATION STRUCTURE @@ -382,6 +383,9 @@ module EDTypesMod real(r8) :: ddbhdt ! time derivative of dbh : cm/year real(r8) :: dbdeaddt ! time derivative of dead biomass : KgC/year + + + ! FIRE real(r8) :: fraction_crown_burned ! proportion of crown affected by fire:- real(r8) :: cambial_mort ! probability that trees dies due to cambial char diff --git a/parteh/PRTAllometricCNPMod.F90 b/parteh/PRTAllometricCNPMod.F90 index e729a4f33c..5115a602b5 100644 --- a/parteh/PRTAllometricCNPMod.F90 +++ b/parteh/PRTAllometricCNPMod.F90 @@ -170,8 +170,9 @@ module PRTAllometricCNPMod integer, public, parameter :: acnp_bc_out_id_cefflux = 1 ! Daily exudation of C [kg] integer, public, parameter :: acnp_bc_out_id_nefflux = 2 ! Daily exudation of N [kg] integer, public, parameter :: acnp_bc_out_id_pefflux = 3 ! Daily exudation of P [kg] + integer, public, parameter :: acnp_bc_out_id_limiter = 4 ! The minimum of the Nutrient ratio over c ratio - integer, parameter :: num_bc_out = 3 ! Total number of + integer, parameter :: num_bc_out = 4 ! Total number of ! Indices for parameters passed to the integrator @@ -227,7 +228,6 @@ module PRTAllometricCNPMod procedure :: CNPAdjustFRootTargets procedure :: CNPAllocateRemainder procedure :: GetDeficit - procedure :: StorageRegulator procedure :: TrimFineRoot end type cnp_allom_prt_vartypes @@ -673,79 +673,163 @@ subroutine CNPAdjustFRootTargets(this, target_c) class(cnp_allom_prt_vartypes) :: this real(r8) :: target_c(:) - + real(r8), pointer :: l2fr ! leaf to fineroot target biomass scaler integer :: ipft ! PFT index real(r8), pointer :: dbh real(r8) :: canopy_trim - !!real(r8) :: l2fr_ema ! Moving average L2FR (EMA) - - real(r8) :: l2fr_actual - real(r8) :: n_regulator ! Nitrogen storage regulation function scaler - real(r8) :: p_regulator ! Phosphorus storage regulation function scaler - real(r8) :: np_regulator ! Combined NP storage regulation function scaler - real(r8) :: turnfrac ! The factional amount of root biomass that may - ! remain after a day of root turnover without - ! replacement - real(r8) :: fnrt_frac ! fine-root's current fraction of the target + real(r8) :: cnp_store_ratio - + real(r8) :: store_c_max, store_c_act + real(r8) :: store_nut_max, store_nut_act + real(r8) :: n_ratio, p_ratio, np_ratio + real(r8) :: fnrt_c,leaf_c,store_c,struct_c,sapw_c,c_gain,c_fnrt_expand + real(r8) :: l2fr_delta_max + real(r8) :: l2fr_delta_scale + real(r8) :: logi_k + real(r8) :: l2fr_mult - integer, parameter :: regulate_type = regulate_CN_dfdd + real(r8), parameter :: max_l2fr_cgain_frac = 0.99_r8 ipft = this%bc_in(acnp_bc_in_id_pft)%ival l2fr => this%bc_inout(acnp_bc_inout_id_l2fr)%rval dbh => this%bc_inout(acnp_bc_inout_id_dbh)%rval - canopy_trim = this%bc_in(acnp_bc_in_id_ctrim)%rval + canopy_trim = this%bc_in(acnp_bc_in_id_ctrim)%rval + - associate( l2fr_min => prt_params%allom_l2fr(ipft) ) + ! Step 1: Determine the nutrient to carbon ratio (aka relative health factor) + ! ----------------------------------------------------------------------------------- - if(n_uptake_mode.eq.prescribed_n_uptake)then - n_regulator = 1._r8 - else - call this%StorageRegulator(nitrogen_element, regulate_type,target_c,n_regulator) - end if + store_c_max = target_c(store_organ) - if(p_uptake_mode.eq.prescribed_p_uptake)then - p_regulator = 1._r8 - else - call this%StorageRegulator(phosphorus_element, regulate_type,target_c,p_regulator) - end if + store_c_act = this%GetState(store_organ, carbon12_element) + & + this%bc_in(acnp_bc_in_id_netdc)%rval - ! We take the maximum here, because the maximum is reflective of the - ! element with the lowest storage, which is the limiting element - if(n_uptake_mode.eq.prescribed_n_uptake)then - np_regulator = p_regulator - else - if(p_uptake_mode.eq.prescribed_p_uptake)then - np_regulator = n_regulator - else - np_regulator = max(n_regulator,p_regulator) - end if - end if - - - ! Update the leaf-to-fineroot ratio used - ! to set fine-root biomass allometry + if(n_uptake_mode.ne.prescribed_n_uptake)then - if(regulate_type == regulate_CN_logi)then + ! Calculate the relative nitrogen storage fraction, + ! over the relative carbon storage fraction. - l2fr = l2fr_min + max(0._r8,min(1.0_r8,np_regulator))*(10._r8*l2fr_min-l2fr_min) + store_nut_max = this%GetNutrientTarget(nitrogen_element,store_organ,stoich_growth_min) - elseif(regulate_type == regulate_CN_dfdd) then + store_nut_act = this%GetState(store_organ, nitrogen_element) + & + this%bc_inout(acnp_bc_inout_id_netdn)%rval - ! Only update L2FR if some leaves are out - if(this%GetState(leaf_organ, carbon12_element)/target_c(leaf_organ) >0.5_r8) then - l2fr = l2fr * np_regulator - end if - - end if - - ! Find the updated target fineroot biomass - call bfineroot(dbh,ipft,canopy_trim, l2fr, target_c(fnrt_organ)) + n_ratio = min(50.0_r8,max(0.02_r8,(store_nut_act/store_nut_max)/(store_c_act/store_c_max))) + + end if + if(p_uptake_mode.ne.prescribed_p_uptake)then + + ! Calculate the relative phosphorus storage fraction, + ! over the relative carbon storage fraction. + + store_nut_max = this%GetNutrientTarget(phosphorus_element,store_organ,stoich_growth_min) + + store_nut_act = this%GetState(store_organ, phosphorus_element) + this%bc_inout(acnp_bc_inout_id_netdp)%rval + + p_ratio = min(50.0_r8,max(0.02_r8,(store_nut_act/store_nut_max)/(store_c_act/store_c_max))) + + end if + + ! Use the limiting nutrient species + + if(n_uptake_mode.eq.prescribed_n_uptake)then + if(p_uptake_mode.eq.prescribed_p_uptake)then + cnp_store_ratio = 1._r8 + return + else + cnp_store_ratio = p_ratio + end if + else + if(p_uptake_mode.eq.prescribed_p_uptake)then + cnp_store_ratio = n_ratio + else + cnp_store_ratio = min(n_ratio, p_ratio) + end if + end if - end associate + ! ----------------------------------------------------------------------------- + ! To decide the upper limit on expanding root growth, we perform a carbon + ! balance. Note that if we are growing roots out more, than we have proportionaly + ! more C compared to other resources. Specifically, we want to limit root growth + ! such that allocation to roots can't exceed a certain fraction of the daily + ! available carbon. This fraction is "max_l2fr_cgain_frac". + ! Additional notes. When calculating the "allocation to roots", we consider + ! both the carbon necessary to get the roots "on allometry" plux the carbon + ! necessary to expand them. + ! + ! l2fr_delta_max*target_fnrt_c - target_fnrt_c < + ! c_gain - (target_fnrt_c-actual_fnrt_c) - + ! (target_leaf_c-actual_leaf_c) - + ! (target_sapw_c-actual_sapw_c) - + ! (target_dead_c-actual_dead_c) - + ! (target_stor_c-actual_stor_c) + ! + ! ------------------------------------------------------------------------------ + + fnrt_c = this%GetState(fnrt_organ, carbon12_element) + leaf_c = this%GetState(leaf_organ, carbon12_element) + store_c = this%GetState(store_organ, carbon12_element) + struct_c = this%GetState(struct_organ, carbon12_element) + sapw_c = this%GetState(sapw_organ, carbon12_element) + + ! If there is overflow storage, add this to the gain + c_gain = this%bc_in(acnp_bc_in_id_netdc)%rval + max(0._r8,store_c-target_c(store_organ)) + + c_fnrt_expand = max_l2fr_cgain_frac* ( c_gain - & + max(0._r8,target_c(fnrt_organ)-fnrt_c) - & + max(0._r8,target_c(leaf_organ)-leaf_c) - & + max(0._r8,target_c(sapw_organ)-sapw_c) - & + max(0._r8,target_c(struct_organ)-struct_c) - & + max(0._r8,target_c(store_organ)-store_c)) + + l2fr_delta_max = (c_fnrt_expand + target_c(fnrt_organ))/target_c(fnrt_organ) + + ! This value could be negative if there is no gain, or less gain + ! than what can replace tissues, just ensure the multiplier is GT 1 + + l2fr_delta_max = max(1._r8,l2fr_delta_max) + + ! Determine the max change for the doubling timescale + ! 2.0 = l2fr_delta_max^frnt_adapt_tscl + + l2fr_delta_scale = 2._r8**(1._r8/prt_params%fnrt_adapt_tscale(ipft))-1.0_r8 + + ! Calculate the un-regulated l2fr multiplier + + logi_k = EDPftvarcon_inst%dev_arbitrary_pft(ipft) + l2fr_mult = l2fr_delta_scale*(2.0_r8/(1.0_r8 + cnp_store_ratio**logi_k)-1.0_r8)+1.0_r8 + + if(l2fr_mult>1.0_r8)then + l2fr_mult = min(l2fr_mult,l2fr_delta_max) + end if + + ! Use the derivative approach + ! ----------------------------------------------------------------------------------- + + ! gamma = log(np_ratio) + + ! Calculate how close the change in gamma was to what was predicted + + !gamma_del = gamma - dlambda_dgamma*gamma_prev + + + !l2fr_deriv = gamma * dlambda_dgamma + + + + ! Only update L2FR if some leaves are out + if(this%GetState(leaf_organ, carbon12_element)/target_c(leaf_organ) > 0.5_r8) then + + !l2fr = (1._r8-err_beta)*(l2fr * l2fr_mult) + err_beta*l2fr_deriv + l2fr = l2fr * l2fr_mult + + end if + + + ! Find the updated target fineroot biomass + call bfineroot(dbh,ipft,canopy_trim, l2fr, target_c(fnrt_organ)) return end subroutine CNPAdjustFRootTargets @@ -757,7 +841,7 @@ subroutine TrimFineRoot(this) ! The following section allows forceful turnover of fine-roots if a new L2FR is generated ! that is lower than the previous l2fr. The maintenance turnover (background) rate ! will automatically accomodate a lower l2fr, but if the change is large it will - ! not keep pace. Note 1: however, that the algorithm in StorageRegulator() will prevent + ! not keep pace. Note 1: however, that the algorithm for calculating l2fr will prevent ! large drops in l2fr (unless that safegaurd is removed). Note 2: this section may also ! generate mass check errors in the main CNPAllocation routine, this is because the "val" is ! changing but the net_allocated is not reciprocating, which is expected. @@ -1178,6 +1262,7 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & real(r8), pointer :: dbh integer :: ipft + integer, pointer :: limiter real(r8) :: canopy_trim real(r8) :: leaf_status real(r8) :: l2fr @@ -1256,9 +1341,8 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & integer, parameter :: grow_lim_estNP = 2 ! Estimate equivalent C from N and P integer, parameter :: grow_lim_type = grow_lim_estNP - - - + real :: neq_cgain, peq_cgain ! N and P equivalent c_gain spent on growth + real :: cnp_gain ! used as a check to see efficiency of limited growth integer, parameter :: c_limited = 1 integer, parameter :: n_limited = 2 integer, parameter :: p_limited = 3 @@ -1267,9 +1351,12 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & leaf_status = this%bc_in(acnp_bc_in_id_lstat)%ival dbh => this%bc_inout(acnp_bc_inout_id_dbh)%rval ipft = this%bc_in(acnp_bc_in_id_pft)%ival + limiter => this%bc_out(acnp_bc_out_id_limiter)%ival canopy_trim = this%bc_in(acnp_bc_in_id_ctrim)%rval l2fr = this%bc_inout(acnp_bc_inout_id_l2fr)%rval ! This variable is not updated in this ! routine, and is therefore not a pointer + + ! If any of these resources is essentially tapped out, ! then there is no point in performing growth ! It also seems impossible that we would be in a leaf-off status @@ -1283,6 +1370,7 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & leaf_status.eq.leaves_off .or. & n_gain <= 0.1_r8*calloc_abs_error .or. & p_gain <= 0.02_r8*calloc_abs_error ) then + limiter = 0 return end if @@ -1412,8 +1500,33 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & call EstimateGrowthNC(this,target_c,target_dcdd,state_mask,avg_nc,avg_pc) - c_gstature = min(c_gain,n_gain/avg_nc) - c_gstature = min(c_gstature,p_gain/avg_pc) + neq_cgain = n_gain/avg_nc + peq_cgain = p_gain/avg_pc + + if(c_gain this%bc_inout(acnp_bc_inout_id_dbh)%rval, & - canopy_trim => this%bc_in(acnp_bc_in_id_ctrim)%rval, & - ipft => this%bc_in(acnp_bc_in_id_pft)%ival, & - l2fr => this%bc_inout(acnp_bc_inout_id_l2fr)%rval) - - - logi_k = EDPftvarcon_inst%dev_arbitrary_pft(ipft) - store_x0 = 0.0_r8 - logi_min = 0.0_r8 - - ! TEMPORARY OVERRIDE - - if(regulate_type == regulate_CN_logi) then - - store_c = this%GetState(store_organ, carbon12_element) - - ! Fraction of N per fraction of C - ! If this is greater than 1, then we have more N in storage than - ! we have C, so we downregulate. If this is less than 1, then - ! we have less N in storage than we have C, so up-regulate - - store_frac = log(max(0.01_r8,store_frac) / max(0.01_r8,(store_c/target_c(store_organ)))) - - c_scalar = max(0._r8,min(1._r8,logi_min + (1._r8-logi_min)/(1.0 + exp(logi_k*(store_frac-store_x0))))) - - elseif(regulate_type == regulate_CN_dfdd) then - - store_max = this%GetNutrientTarget(element_id,store_organ,stoich_growth_min) - - ! Storage fractions could be more than the target, depending on the - ! hypothesis and functions involved, but should typically be 0-1 - ! The cap of 5 is for numerics and preventing weird math - - if(element_id.eq.nitrogen_element)then - gain = this%bc_inout(acnp_bc_inout_id_netdn)%rval - else - gain = this%bc_inout(acnp_bc_inout_id_netdp)%rval - end if - - if(use_gains_in_regulator)then - store_act = this%GetState(store_organ, element_id) + gain - store_c_act = this%GetState(store_organ, carbon12_element) + this%bc_in(acnp_bc_in_id_netdc)%rval - else - store_act = this%GetState(store_organ, element_id) - store_c_act = this%GetState(store_organ, carbon12_element) - end if - - store_frac = max(0.01_r8,min(5.0_r8,store_act/store_max)) - - ! Since we don't dump storage carbon - ! these stores can actually get pretty large, so the cap of 10x is numerically - ! feasable, and should also minimize stress on the logistic function - - store_c_max = target_c(store_organ) - - store_c_frac = max(0.01_r8,min(5.0_r8,store_c_act/store_c_max)) - - ! ----------------------------------------------------------------------------- - ! To decide the upper limit on expanding root growth, we perform a carbon - ! balance. Note that if we are growing roots out more, than we have proportionaly - ! more C compared to other resources. Specifically, we want to limit root growth - ! such that allocation to roots can't exceed a certain fraction of the daily - ! available carbon. This fraction is "max_l2fr_cgain_frac". - ! Additional notes. When calculating the "allocation to roots", we consider - ! both the carbon necessary to get the roots "on allometry" plux the carbon - ! necessary to expand them. - ! - ! (l2fr_delta_max*target_fnrt_c + target_fnrt_c-actual_fnrt_c )/c_gain - ! < max_l2fr_cgain_frac - ! - ! or - ! - ! l2fr_delta_max*target_fnrt_c < max_l2fr_cgain_frac * (c_gain - - ! (target_fnrt_c-actual_fnrt_c) - - ! (target_leaf_c-actual_leaf_c)) - ! - ! or - ! as much as you like as long as turnover is replaced - ! - ! l2fr_delta_max*target_fnrt_c - target_fnrt_c < - ! c_gain - (target_fnrt_c-actual_fnrt_c) - - ! (target_leaf_c-actual_leaf_c) - - ! (target_sapw_c-actual_sapw_c) - - ! (target_dead_c-actual_dead_c) - - ! (target_stor_c-actual_stor_c) - ! - ! ------------------------------------------------------------------------------ - - fnrt_c = this%GetState(fnrt_organ, carbon12_element) - leaf_c = this%GetState(leaf_organ, carbon12_element) - store_c = this%GetState(store_organ, carbon12_element) - struct_c = this%GetState(struct_organ, carbon12_element) - sapw_c = this%GetState(sapw_organ, carbon12_element) - - ! If there is overflow storage, add this to the gain - c_gain = this%bc_in(acnp_bc_in_id_netdc)%rval + max(0._r8,store_c-target_c(store_organ)) - - - if(lim_l2fr_max_type == limit_lf)then - l2fr_delta_max = max_l2fr_cgain_frac / target_c(fnrt_organ) * & - (c_gain - max(0._r8,target_c(fnrt_organ)-fnrt_c) - max(0._r8,target_c(leaf_organ)-leaf_c)) - - elseif(lim_l2fr_max_type ==limit_all)then - - c_fnrt_expand = max_l2fr_cgain_frac* ( c_gain - & - max(0._r8,target_c(fnrt_organ)-fnrt_c) - & - max(0._r8,target_c(leaf_organ)-leaf_c) - & - max(0._r8,target_c(sapw_organ)-sapw_c) - & - max(0._r8,target_c(struct_organ)-struct_c) - & - max(0._r8,target_c(store_organ)-store_c)) - - l2fr_delta_max = (c_fnrt_expand + target_c(fnrt_organ))/target_c(fnrt_organ) - - - end if - - ! This value could be negative if there is no gain, or less gain - ! than what can replace leaf/root, just ensure the multiplier is GT 1 - - l2fr_delta_max = max(1._r8,l2fr_delta_max) - - ! Constrain change in l2fr minimum to be no more than what is lost - ! in turnover for a day - l2fr_delta_min = 1._r8-(years_per_day / prt_params%root_long(ipft)) - - ! Determine the max change for the doubling timescale - ! 2.0 = l2fr_delta_max^frnt_adapt_tscl - l2fr_delta_scale = 2._r8**(1._r8/prt_params%fnrt_adapt_tscale(ipft))-1.0_r8 - - nc_frac = nc_frac_offset * store_frac / store_c_frac - - c_scalar = l2fr_delta_scale*(2.0_r8/(1.0_r8 + nc_frac**logi_k)-1.0_r8)+1.0_r8 - - if(c_scalar>1.0_r8)then - c_scalar = min(c_scalar,l2fr_delta_max) - else - ! Remove the min function temporarily - if(.not.use_unrestricted_contraction)then - c_scalar = max(c_scalar,l2fr_delta_min) - end if - end if - - - end if - - end associate - - end subroutine StorageRegulator - - ! ==================================================================================== - subroutine EstimateGrowthNC(this,target_c,target_dcdd,state_mask,avg_nc,avg_pc) ! This routine predicts the effective nutrient/carbon allocation ratio @@ -2521,7 +2415,7 @@ subroutine EstimateGrowthNC(this,target_c,target_dcdd,state_mask,avg_nc,avg_pc) fnrt_w = target_dcdd(fnrt_organ) * (1._r8 - repro_c_frac) total_w = total_w + fnrt_w avg_nc = avg_nc + fnrt_w * prt_params%nitr_stoich_p1(ipft,prt_params%organ_param_id(fnrt_organ)) - avg_pc = avg_nc + fnrt_w * prt_params%phos_stoich_p1(ipft,prt_params%organ_param_id(fnrt_organ)) + avg_pc = avg_pc + fnrt_w * prt_params%phos_stoich_p1(ipft,prt_params%organ_param_id(fnrt_organ)) end if if(state_mask(sapw_id)) then sapw_w = target_dcdd(sapw_organ) * (1._r8 - repro_c_frac) From 36491b99343f2cc5fc634c736477cc4f13c2525b Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Fri, 29 Jul 2022 15:10:01 -0400 Subject: [PATCH 25/55] Adding recruit l2fr and smoothing to the f_cn function --- biogeochem/EDCanopyStructureMod.F90 | 11 +- biogeochem/EDCohortDynamicsMod.F90 | 53 +++++----- biogeochem/EDPatchDynamicsMod.F90 | 3 +- biogeochem/EDPhysiologyMod.F90 | 149 ++++++++++++++++++++++++++-- main/EDInitMod.F90 | 17 ++-- main/EDMainMod.F90 | 19 ++++ main/EDTypesMod.F90 | 43 +++++--- main/FatesHistoryInterfaceMod.F90 | 43 ++++---- main/FatesInterfaceMod.F90 | 2 +- main/FatesRestartInterfaceMod.F90 | 52 +++++++++- main/FatesRunningMeanMod.F90 | 15 +-- parteh/PRTAllometricCNPMod.F90 | 96 +++++++++--------- parteh/PRTGenericMod.F90 | 5 + parteh/PRTParametersMod.F90 | 13 +-- parteh/PRTParamsFATESMod.F90 | 27 ++--- 15 files changed, 370 insertions(+), 178 deletions(-) diff --git a/biogeochem/EDCanopyStructureMod.F90 b/biogeochem/EDCanopyStructureMod.F90 index 2e0ad6159e..bbca1054e9 100644 --- a/biogeochem/EDCanopyStructureMod.F90 +++ b/biogeochem/EDCanopyStructureMod.F90 @@ -671,14 +671,14 @@ subroutine DemoteFromLayer(currentSite,currentPatch,i_lyr,bc_in) ! correct boundary condition fields copyc%prt => null() call InitPRTObject(copyc%prt) - call InitPRTBoundaryConditions(copyc) if( hlm_use_planthydro.eq.itrue ) then call InitHydrCohort(currentSite,copyc) endif call copy_cohort(currentCohort, copyc) - + call InitPRTBoundaryConditions(copyc,currentCohort%pft,1) + newarea = currentCohort%c_area - cc_loss copyc%n = currentCohort%n*newarea/currentCohort%c_area currentCohort%n = currentCohort%n - copyc%n @@ -1130,7 +1130,7 @@ subroutine PromoteIntoLayer(currentSite,currentPatch,i_lyr) ! correct boundary condition fields copyc%prt => null() call InitPRTObject(copyc%prt) - call InitPRTBoundaryConditions(copyc) + if( hlm_use_planthydro.eq.itrue ) then call InitHydrCohort(CurrentSite,copyc) @@ -1143,7 +1143,8 @@ subroutine PromoteIntoLayer(currentSite,currentPatch,i_lyr) ! init_value=currentPatch%tveg_lpa%GetMean()) call copy_cohort(currentCohort, copyc) !makes an identical copy... - + call InitPRTBoundaryConditions(copyc,currentCohort%pft,2) + newarea = currentCohort%c_area - cc_gain !new area of existing cohort call carea_allom(currentCohort%dbh,currentCohort%n,currentSite%spread, & @@ -1331,8 +1332,6 @@ subroutine canopy_summarization( nsites, sites, bc_in ) do while(associated(currentCohort)) ft = currentCohort%pft - - leaf_c = currentCohort%prt%GetState(leaf_organ, carbon12_element) sapw_c = currentCohort%prt%GetState(sapw_organ, carbon12_element) struct_c = currentCohort%prt%GetState(struct_organ, carbon12_element) diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index da2f4ad256..234dc1bc9d 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -19,7 +19,7 @@ module EDCohortDynamicsMod use FatesConstantsMod , only : nearzero use FatesConstantsMod , only : calloc_abs_error use FatesConstantsMod , only : sec_per_day - use FatesRunningMeanMod , only : ema_lpa, ema_60day + use FatesRunningMeanMod , only : ema_lpa, ema_60day, ema_storemem use FatesInterfaceTypesMod , only : hlm_days_per_year use FatesInterfaceTypesMod , only : nleafage use SFParamsMod , only : SF_val_CWD_frac @@ -94,8 +94,11 @@ module EDCohortDynamicsMod use PRTAllometricCNPMod, only : cnp_allom_prt_vartypes use PRTAllometricCNPMod, only : acnp_bc_in_id_pft, acnp_bc_in_id_ctrim use PRTAllometricCNPMod, only : acnp_bc_in_id_lstat, acnp_bc_inout_id_dbh - !use PRTAllometricCNPMod, only : acnp_bc_in_id_l2fr_ema + use PRTAllometricCNPMod, only : acnp_bc_inout_id_nc_store + use PRTAllometricCNPMod, only : acnp_bc_inout_id_pc_store use PRTAllometricCNPMod, only : acnp_bc_inout_id_l2fr + use PRTAllometricCNPMod, only : acnp_bc_in_id_nc_repro + use PRTAllometricCNPMod, only : acnp_bc_in_id_pc_repro use PRTAllometricCNPMod, only : acnp_bc_inout_id_resp_excess, acnp_bc_in_id_netdc use PRTAllometricCNPMod, only : acnp_bc_inout_id_netdn, acnp_bc_inout_id_netdp use PRTAllometricCNPMod, only : acnp_bc_out_id_cefflux, acnp_bc_out_id_nefflux @@ -217,8 +220,7 @@ subroutine create_cohort(currentSite, patchptr, pft, nn, hite, coage, dbh, & ! The PARTEH cohort object should be allocated and already ! initialized in this routine. call new_cohort%prt%CheckInitialConditions() - - + !**********************/ ! Define cohort state variable !**********************/ @@ -250,6 +252,8 @@ subroutine create_cohort(currentSite, patchptr, pft, nn, hite, coage, dbh, & new_cohort%l2fr = prt_params%allom_l2fr(pft) + new_cohort%nc_store = 1._r8 ! Assume balanced N/C stores + new_cohort%pc_store = 1._r8 ! Assume balanced P/C stores ! This sets things like vcmax25top, that depend on the ! leaf age fractions (which are defined by PARTEH) @@ -324,7 +328,7 @@ subroutine create_cohort(currentSite, patchptr, pft, nn, hite, coage, dbh, & !! allocate(new_cohort%tveg_lpa) !! call new_cohort%tveg_lpa%InitRMean(ema_lpa,init_value=patchptr%tveg_lpa%GetMean()) - call InitPRTBoundaryConditions(new_cohort) + call InitPRTBoundaryConditions(new_cohort,pft,0) ! Recuits do not have mortality rates, nor have they moved any @@ -385,7 +389,7 @@ end subroutine create_cohort ! ------------------------------------------------------------------------------------- - subroutine InitPRTBoundaryConditions(new_cohort) + subroutine InitPRTBoundaryConditions(new_cohort,ft,call_id) ! Set the boundary conditions that flow in an out of the PARTEH ! allocation hypotheses. Each of these calls to "RegsterBC" are simply @@ -406,8 +410,9 @@ subroutine InitPRTBoundaryConditions(new_cohort) ! value boundary condition. type(ed_cohort_type), intent(inout), target :: new_cohort - - + integer,intent(in) :: ft ! PFT index + integer,intent(in) :: call_id + select case(hlm_parteh_mode) case (prt_carbon_allom_hyp) @@ -425,12 +430,15 @@ subroutine InitPRTBoundaryConditions(new_cohort) call new_cohort%prt%RegisterBCIn(acnp_bc_in_id_ctrim,bc_rval = new_cohort%canopy_trim) call new_cohort%prt%RegisterBCIn(acnp_bc_in_id_lstat,bc_ival = new_cohort%status_coh) call new_cohort%prt%RegisterBCIn(acnp_bc_in_id_netdc, bc_rval = new_cohort%npp_acc) - - !!call new_cohort%prt%RegisterBCIn(acnp_bc_in_id_l2fr_ema, bc_rval = new_cohort%l2fr_ema%l_mean) + + call new_cohort%prt%RegisterBCIn(acnp_bc_in_id_nc_repro,bc_rval = new_cohort%patchptr%nitr_repro_stoich(ft)) + call new_cohort%prt%RegisterBCIn(acnp_bc_in_id_pc_repro,bc_rval = new_cohort%patchptr%phos_repro_stoich(ft)) call new_cohort%prt%RegisterBCInOut(acnp_bc_inout_id_dbh,bc_rval = new_cohort%dbh) call new_cohort%prt%RegisterBCInOut(acnp_bc_inout_id_resp_excess,bc_rval = new_cohort%resp_excess) call new_cohort%prt%RegisterBCInOut(acnp_bc_inout_id_l2fr,bc_rval = new_cohort%l2fr) + call new_cohort%prt%RegisterBCInOut(acnp_bc_inout_id_nc_store,bc_rval = new_cohort%nc_store) + call new_cohort%prt%RegisterBCInOut(acnp_bc_inout_id_pc_store,bc_rval = new_cohort%pc_store) call new_cohort%prt%RegisterBCInOut(acnp_bc_inout_id_netdn, bc_rval = new_cohort%daily_n_gain) call new_cohort%prt%RegisterBCInOut(acnp_bc_inout_id_netdp, bc_rval = new_cohort%daily_p_uptake) @@ -594,8 +602,7 @@ subroutine nan_cohort(cc_p) currentCohort%daily_p_efflux = nan currentCohort%daily_n_demand = nan currentCohort%daily_p_demand = nan - - + currentCohort%c13disc_clm = nan ! C13 discrimination, per mil at indiv/timestep currentCohort%c13disc_acc = nan ! C13 discrimination, per mil at indiv/timestep at indiv/daily at the end of a day @@ -1019,11 +1026,6 @@ subroutine DeallocateCohort(currentCohort) type(ed_cohort_type),intent(inout) :: currentCohort - ! (Keeping as an example) - ! Remove the running mean structure - ! deallocate(currentCohort%tveg_lpa) - !!deallocate(currentCohort%l2fr_ema) - ! At this point, nothing should be pointing to current Cohort if (hlm_use_planthydro.eq.itrue) call DeallocateHydrCohort(currentCohort) @@ -1188,12 +1190,10 @@ subroutine fuse_cohorts(currentSite, currentPatch, bc_in) end do end if - ! (Keeping as an example) - ! Running mean fuses based on number density fraction just - ! like other variables - !!call currentCohort%tveg_lpa%FuseRMean(nextc%tveg_lpa,currentCohort%n/newn) - - !!call currentCohort%l2fr_ema%FuseRMean(nextc%l2fr_ema,currentCohort%n/newn) + currentCohort%nc_store = (currentCohort%n*currentCohort%nc_store & + + nextc%n*nextc%nc_store)/newn + currentCohort%pc_store = (currentCohort%n*currentCohort%pc_store & + + nextc%n*nextc%pc_store)/newn ! new cohort age is weighted mean of two cohorts currentCohort%coage = & @@ -1839,11 +1839,10 @@ subroutine copy_cohort( currentCohort,copyc ) n%tpu25top = o%tpu25top n%kp25top = o%kp25top - ! (Keeping as an example) ! Copy over running means - ! call n%tveg_lpa%CopyFromDonor(o%tveg_lpa) - !!call n%l2fr_ema%CopyFromDonor(o%l2fr_ema) - + n%nc_store = o%nc_store + n%pc_store = o%pc_store + ! CARBON FLUXES n%gpp_acc_hold = o%gpp_acc_hold n%gpp_acc = o%gpp_acc diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 456f49304c..1d24db1896 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -706,7 +706,8 @@ subroutine spawn_patches( currentSite, bc_in) ! correct boundary condition fields nc%prt => null() call InitPRTObject(nc%prt) - call InitPRTBoundaryConditions(nc) + nc%patchptr => new_patch + call InitPRTBoundaryConditions(nc,currentCohort%pft,3) call zero_cohort(nc) diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index c55110c266..f381c53347 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -48,6 +48,7 @@ module EDPhysiologyMod use EDTypesMod , only : nlevleaf use EDTypesMod , only : num_vegtemp_mem use EDTypesMod , only : maxpft + use EDTypesMod , only : nclmax use EDTypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type use EDTypesMod , only : leaves_on use EDTypesMod , only : leaves_off @@ -106,6 +107,7 @@ module EDPhysiologyMod use PRTLossFluxesMod, only : PRTDeciduousTurnover use PRTLossFluxesMod, only : PRTReproRelease use PRTGenericMod, only : StorageNutrientTarget + use PRTInitParamsFatesMod, only : NewRecruitTotalStoichiometry implicit none private @@ -116,12 +118,14 @@ module EDPhysiologyMod public :: assign_cohort_SP_properties public :: recruitment public :: ZeroLitterFluxes - public :: ZeroAllocationRates public :: PreDisturbanceLitterFluxes public :: PreDisturbanceIntegrateLitter public :: SeedIn - + public :: UpdateRecruitL2FR + public :: UpdateRecruitStoich + public :: SetRecruitL2FR + logical, parameter :: debug = .false. ! local debug flag character(len=*), parameter, private :: sourcefile = & __FILE__ @@ -1675,15 +1679,16 @@ subroutine SeedIn( currentSite, bc_in ) litt%seed_in_local(pft) = litt%seed_in_local(pft) + site_seed_rain(pft)/area ! If there is forced external seed rain, we calculate the input mass flux - ! from the different elements, usung the seed optimal stoichiometry - ! for non-carbon + ! from the different elements, usung the mean stoichiometry of new + ! recruits for the current patch and lowest canopy position + select case(element_id) case(carbon12_element) seed_stoich = 1._r8 case(nitrogen_element) - seed_stoich = prt_params%nitr_recr_stoich(pft) + seed_stoich = currentPatch%nitr_repro_stoich(pft) case(phosphorus_element) - seed_stoich = prt_params%phos_recr_stoich(pft) + seed_stoich = currentPatch%phos_repro_stoich(pft) case default write(fates_log(), *) 'undefined element specified' write(fates_log(), *) 'while defining forced external seed mass flux' @@ -1866,7 +1871,7 @@ subroutine recruitment( currentSite, currentPatch, bc_in ) temp_cohort%pft = ft temp_cohort%hite = EDPftvarcon_inst%hgt_min(ft) temp_cohort%coage = 0.0_r8 - temp_cohort%l2fr = prt_params%allom_l2fr(ft) + temp_cohort%l2fr = currentSite%rec_l2fr(ft,currentPatch%NCL_p) stem_drop_fraction = EDPftvarcon_inst%phen_stem_drop_fraction(ft) call h2d_allom(temp_cohort%hite,ft,temp_cohort%dbh) @@ -2583,4 +2588,134 @@ subroutine CWDOut( litt, fragmentation_scaler, nlev_eff_decomp ) end subroutine CWDOut + ! ====================================================================== + + subroutine UpdateRecruitL2FR(csite) + + type(ed_site_type) :: csite + type(ed_patch_type), pointer :: cpatch + type(ed_cohort_type), pointer :: ccohort + + real(r8) :: rec_n(maxpft,nclmax) ! plant count + real(r8) :: rec_l2fr0(maxpft,nclmax) ! mean l2fr for this day + integer :: rec_count(maxpft,nclmax) ! sample count + integer :: ft ! functional type index + integer :: cl ! canopy layer index + real(r8) :: dbh_min ! the dbh of a recruit + real(r8), parameter :: max_delta = 5.0_r8 ! dbh tolerance, cm, consituting a recruit + real(r8), parameter :: smth_wgt = 1._r8/300.0_r8 + integer, parameter :: max_count = 3 + + ! Difference in dbh (cm) to consider a plant was recruited fairly recently + + rec_n(1:numpft,1:nclmax) = 0._r8 + rec_l2fr0(1:numpft,1:nclmax) = 0._r8 + + cpatch => csite%youngest_patch + do while(associated(cpatch)) + + rec_count(1:numpft,1:nclmax) = 0 + + ccohort => cpatch%shortest + cloop: do while(associated(ccohort)) + + ft = ccohort%pft + cl = ccohort%canopy_layer + call h2d_allom(EDPftvarcon_inst%hgt_min(ft),ft,dbh_min) + + if( .not.ccohort%isnew ) then + + if(rec_count(ft,cl) <= max_count .and. & + ccohort%dbh-dbh_min < max_delta ) then + rec_count(ft,cl) = rec_count(ft,cl) + 1 + rec_n(ft,cl) = rec_n(ft,cl) + ccohort%n + rec_l2fr0(ft,cl) = rec_l2fr0(ft,cl) + ccohort%n*ccohort%l2fr + end if + + end if + + ccohort => ccohort%taller + end do cloop + + cpatch => cpatch%older + end do + + ! Find the daily mean for each PFT weighted by number and add it to the running mean + do cl = 1,nclmax + do ft = 1,numpft + if(rec_n(ft,cl)>nearzero)then + rec_l2fr0(ft,cl) = rec_l2fr0(ft,cl) / rec_n(ft,cl) + csite%rec_l2fr(ft,cl) = & + (1._r8-smth_wgt)*csite%rec_l2fr(ft,cl) + smth_wgt*rec_l2fr0(ft,cl) + + !print*,"REC_L2FR:",cl,csite%rec_l2fr(ft,cl) + end if + end do + end do + + return + end subroutine UpdateRecruitL2FR + + ! ====================================================================== + + subroutine UpdateRecruitStoich(csite) + + type(ed_site_type) :: csite + type(ed_patch_type), pointer :: cpatch + integer :: ft ! functional type index + integer :: cl ! canopy layer index + real(r8) :: rec_l2fr_pft ! Actual l2fr of a pft in it's patch + + ! Update the total plant stoichiometry of a new recruit, based on the updated + ! L2FR values + cpatch => csite%youngest_patch + do while(associated(cpatch)) + cl = cpatch%ncl_p + do ft = 1,numpft + rec_l2fr_pft = csite%rec_l2fr(ft,cl) + cpatch%nitr_repro_stoich(ft) = & + NewRecruitTotalStoichiometry(ft,rec_l2fr_pft,nitrogen_element) + cpatch%phos_repro_stoich(ft) = & + NewRecruitTotalStoichiometry(ft,rec_l2fr_pft,phosphorus_element) + end do + cpatch => cpatch%older + end do + + return + end subroutine UpdateRecruitStoich + + ! ====================================================================== + + subroutine SetRecruitL2FR(csite) + + ! I DONT THINK THIS ROUTINE IS ACTUALLY NEEDED... + ! TURN THIS OFF IN A B4B TEST + + + type(ed_site_type) :: csite + type(ed_patch_type), pointer :: cpatch + type(ed_cohort_type), pointer :: ccohort + integer :: ft,cl + + cpatch => csite%youngest_patch + do while(associated(cpatch)) + ccohort => cpatch%shortest + cloop: do while(associated(ccohort)) + + if( ccohort%isnew ) then + ft = ccohort%pft + cl = ccohort%canopy_layer + ccohort%l2fr = csite%rec_l2fr(ft,cl) + end if + + ccohort => ccohort%taller + end do cloop + + cpatch => cpatch%older + end do + + return + end subroutine SetRecruitL2FR + + end module EDPhysiologyMod diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index e51d506b05..775681f4ee 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -13,7 +13,7 @@ module EDInitMod use FatesGlobals , only : endrun => fates_endrun use EDTypesMod , only : nclmax use FatesGlobals , only : fates_log - use FatesInterfaceTypesMod , only : hlm_is_restart + use FatesInterfaceTypesMod , only : hlm_is_restart use EDPftvarcon , only : EDPftvarcon_inst use PRTParametersMod , only : prt_params use EDCohortDynamicsMod , only : create_cohort, fuse_cohorts, sort_cohorts @@ -143,6 +143,10 @@ subroutine init_site_vars( site_in, bc_in, bc_out ) allocate(site_in%use_this_pft(1:numpft)) allocate(site_in%area_by_age(1:nlevage)) + ! for CNP dynamics, track the mean l2fr of recruits + ! for different pfts and canopy positions + allocate(site_in%rec_l2fr(1:numpft,nclmax)) + ! SP mode allocate(site_in%sp_tlai(1:numpft)) @@ -326,6 +330,10 @@ subroutine set_site_properties( nsites, sites,bc_in ) sites(s)%NF = 0.0_r8 sites(s)%NF_successful = 0.0_r8 + do ft = 1,numpft + sites(s)%rec_l2fr(ft,:) = prt_params%allom_l2fr(ft) + end do + if(hlm_use_fixed_biogeog.eq.itrue)then ! MAPPING OF FATES PFTs on to HLM_PFTs ! add up the area associated with each FATES PFT @@ -417,9 +425,6 @@ subroutine init_patches( nsites, sites, bc_in) ! This may be call a near bare ground initialization, or it may ! load patches from an inventory. - ! - - use FatesPlantHydraulicsMod, only : updateSizeDepRhizHydProps use FatesInventoryInitMod, only : initialize_sites_by_inventory @@ -851,7 +856,7 @@ subroutine init_cohorts( site_in, patch_in, bc_in) m_leaf = c_leaf*prt_params%nitr_stoich_p2(pft,prt_params%organ_param_id(leaf_organ)) m_fnrt = c_fnrt*prt_params%nitr_stoich_p2(pft,prt_params%organ_param_id(fnrt_organ)) m_sapw = c_sapw*prt_params%nitr_stoich_p2(pft,prt_params%organ_param_id(sapw_organ)) - m_repro = 0._r8 + m_repro = 0._r8 m_store = StorageNutrientTarget(pft,element_id,m_leaf,m_fnrt,m_sapw,m_struct) case(phosphorus_element) @@ -860,7 +865,7 @@ subroutine init_cohorts( site_in, patch_in, bc_in) m_leaf = c_leaf*prt_params%phos_stoich_p2(pft,prt_params%organ_param_id(leaf_organ)) m_fnrt = c_fnrt*prt_params%phos_stoich_p2(pft,prt_params%organ_param_id(fnrt_organ)) m_sapw = c_sapw*prt_params%phos_stoich_p2(pft,prt_params%organ_param_id(sapw_organ)) - m_repro = 0._r8 + m_repro = 0._r8 m_store = StorageNutrientTarget(pft,element_id,m_leaf,m_fnrt,m_sapw,m_struct) end select diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index 28fefe9da2..5aaa4f25f2 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -48,6 +48,9 @@ module EDMainMod use EDPhysiologyMod , only : ZeroLitterFluxes use EDPhysiologyMod , only : PreDisturbanceLitterFluxes use EDPhysiologyMod , only : PreDisturbanceIntegrateLitter + use EDPhysiologyMod , only : UpdateRecruitL2FR + use EDPhysiologyMod , only : UpdateRecruitStoich + use EDPhysiologyMod , only : SetRecruitL2FR use FatesSoilBGCFluxMod , only : FluxIntoLitterPools use FatesSoilBGCFluxMod , only : EffluxIntoLitterPools use EDCohortDynamicsMod , only : UpdateCohortBioPhysRates @@ -349,6 +352,13 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) ! Set a pointer to this sites carbon12 mass balance site_cmass => currentSite%mass_balance(element_pos(carbon12_element)) + ! This call updates the assessment of the total stoichiometry + ! for a new recruit, based on its PFT and the L2FR of + ! a new recruit. This is called here, because it is + ! prior to the growth sequence, where reproductive + ! tissues are allocated + call UpdateRecruitStoich(currentSite) + currentPatch => currentSite%youngest_patch do while(associated(currentPatch)) @@ -542,6 +552,12 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) end do + ! We keep a record of the L2FRs of plants + ! that are near the recruit size, for different + ! pfts and canopy layer. We use this mean to + ! set the L2FRs of newly recruited plants + call UpdateRecruitL2FR(currentSite) + ! When plants die, the water goes with them. This effects ! the water balance. @@ -638,6 +654,9 @@ subroutine ed_update_site( currentSite, bc_in, bc_out ) call TotalBalanceCheck(currentSite,final_check_id) + ! Update recruit L2FRs based on new canopy position + call SetRecruitL2FR(currentSite) + currentSite%area_by_age(:) = 0._r8 currentPatch => currentSite%oldest_patch diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 0a9d46eb30..7adba898a1 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -220,10 +220,13 @@ module EDTypesMod ! vary between allom_l2fr_min and allom_l2fr_max ! parameters, with a tendency driven by ! nutrient storage) - - integer :: cnp_limiter ! Which species is limiting growth? ! 0=none,1=C,2=N,3=P - !!class(rmean_type), pointer :: l2fr_ema ! Exponential moving average of the L2FR + + ! Used for CNP + integer :: cnp_limiter ! Which species is limiting growth? ! 0=none,1=C,2=N,3=P + real(r8) :: nc_store ! Exponential moving average of the log of the N/C storage ratio + real(r8) :: pc_store ! Exponential moving average of the log of the P/C storage ratio + ! VEGETATION STRUCTURE integer :: pft ! pft number @@ -437,6 +440,8 @@ module EDTypesMod class(rmean_type), pointer :: tveg24 ! 24-hour mean vegetation temperature (K) class(rmean_type), pointer :: tveg_lpa ! Running mean of vegetation temperature at the ! leaf photosynthesis acclimation timescale [K] + + integer :: nocomp_pft_label ! where nocomp is active, use this label for patch ID. ! LEAF ORGANIZATION @@ -537,18 +542,25 @@ module EDTypesMod real(r8) :: psn_z(nclmax,maxpft,nlevleaf) ! carbon assimilation in each canopy layer, pft, and leaf layer. umolC/m2/s ! ROOTS - real(r8) :: btran_ft(maxpft) ! btran calculated seperately for each PFT:- - real(r8) :: bstress_sal_ft(maxpft) ! bstress from salinity calculated seperately for each PFT:- - + real(r8) :: btran_ft(maxpft) ! btran calculated seperately for each PFT:- + real(r8) :: bstress_sal_ft(maxpft) ! bstress from salinity calculated seperately for each PFT:- + +! real(r8), pointer :: rec_l2fr_pft(:) ! A pointer array that points + ! to the lowest canopy position of site%rec_l2fr + ! Thus, this is the l2fr of any new recruit in the + ! current patch, according to its PFT + real(r8) :: nitr_repro_stoich(maxpft) ! The NC ratio of a new recruit in this patch + real(r8) :: phos_repro_stoich(maxpft) ! The PC ratio of a new recruit in this patch - ! DISTURBANCE - real(r8) :: disturbance_rates(n_dist_types) ! disturbance rate from 1) mortality - ! 2) fire: fraction/day - ! 3) logging mortatliy - real(r8) :: disturbance_rate ! larger effective disturbance rate: fraction/day - integer :: disturbance_mode ! index identifying which disturbance was applied - ! can be one of: dtype_ifall, dtype_ilog or dtype_ifire - real(r8) :: fract_ldist_not_harvested ! fraction of logged area that is canopy trees that weren't harvested + + ! DISTURBANCE + real(r8) :: disturbance_rates(n_dist_types) ! disturbance rate from 1) mortality + ! 2) fire: fraction/day + ! 3) logging mortatliy + real(r8) :: disturbance_rate ! larger effective disturbance rate: fraction/day + integer :: disturbance_mode ! index identifying which disturbance was applied + ! can be one of: dtype_ifall, dtype_ilog or dtype_ifire + real(r8) :: fract_ldist_not_harvested ! fraction of logged area that is canopy trees that weren't harvested ! Litter and Coarse Woody Debris @@ -720,6 +732,9 @@ module EDTypesMod ! Total area of patches in each age bin [m2] real(r8), allocatable :: area_by_age(:) + real(r8), allocatable :: rec_l2fr(:,:) ! A running mean of the l2fr's for the newly + ! recruited, pft x canopy_layer + ! SP mode target PFT level variables real(r8), allocatable :: sp_tlai(:) ! target TLAI per FATES pft real(r8), allocatable :: sp_tsai(:) ! target TSAI per FATES pft diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 9f645c81c4..c5223c18f5 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -187,11 +187,10 @@ module FatesHistoryInterfaceMod integer :: ih_totvegp_si integer :: ih_l2fr_si - !!integer :: ih_l2fr_ema_si - integer :: ih_l2fr_scpf integer :: ih_l2fr_canopy_scpf integer :: ih_l2fr_understory_scpf - + integer :: ih_recl2fr_canopy_pf + integer :: ih_recl2fr_ustory_pf integer :: ih_nh4uptake_si integer :: ih_no3uptake_si integer :: ih_puptake_si @@ -2001,8 +2000,8 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) hio_ncohorts_si => this%hvars(ih_ncohorts_si)%r81d, & hio_trimming_si => this%hvars(ih_trimming_si)%r81d, & hio_l2fr_si => this%hvars(ih_l2fr_si)%r81d, & - !!hio_l2fr_ema_si => this%hvars(ih_l2fr_ema_si)%r81d, & - hio_l2fr_scpf => this%hvars(ih_l2fr_scpf)%r82d, & + hio_recl2fr_canopy_pf => this%hvars(ih_recl2fr_canopy_pf)%r82d, & + hio_recl2fr_ustory_pf => this%hvars(ih_recl2fr_ustory_pf)%r82d, & hio_l2fr_canopy_scpf => this%hvars(ih_l2fr_canopy_scpf)%r82d, & hio_l2fr_understory_scpf => this%hvars(ih_l2fr_understory_scpf)%r82d, & hio_area_plant_si => this%hvars(ih_area_plant_si)%r81d, & @@ -2278,6 +2277,11 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) sites(s)%mass_balance(element_pos(carbon12_element))%burn_flux_to_atm * & ha_per_m2 * days_per_sec + do ft = 1,numpft + hio_recl2fr_canopy_pf(io_si,ft) = sites(s)%rec_l2fr(ft,1) + hio_recl2fr_ustory_pf(io_si,ft) = sites(s)%rec_l2fr(ft,2) + end do + do el = 1, num_elements ! Total model error [kg/day -> kg/s] (all elements) @@ -2554,11 +2558,6 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) hio_l2fr_si(io_si) = hio_l2fr_si(io_si) + ccohort%n*fnrt_m/m2_per_ha*ccohort%l2fr - !!hio_l2fr_ema_si(io_si) = hio_l2fr_ema_si(io_si) + ccohort%n*fnrt_m/m2_per_ha*ccohort%l2fr_ema%GetMean() - - hio_l2fr_scpf(io_si,i_scpf) = & - hio_l2fr_scpf(io_si,i_scpf) + ccohort%n*fnrt_m/m2_per_ha*ccohort%l2fr - ! Constrain L2FR to oldest patch? if(do_site_l2fr_scpf .or. associated(cpatch,sites(s)%oldest_patch)) then if (ccohort%canopy_layer .eq. 1) then @@ -3636,10 +3635,6 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) do i_pft = 1, numpft do i_scls = 1,nlevsclass i_scpf = (i_pft-1)*nlevsclass + i_scls - if(this%hvars(ih_fnrtc_scpf)%r82d(io_si,i_scpf)>nearzero)then - hio_l2fr_scpf(io_si,i_scpf) = hio_l2fr_scpf(io_si,i_scpf) / & - this%hvars(ih_fnrtc_scpf)%r82d(io_si,i_scpf) - end if if(fnrtc_canopy_scpf(i_scpf)>nearzero)then hio_l2fr_canopy_scpf(io_si,i_scpf) = & hio_l2fr_canopy_scpf(io_si,i_scpf)/fnrtc_canopy_scpf(i_scpf) @@ -4631,6 +4626,7 @@ subroutine define_history_vars(this, initialize_variables) ! patch age x pft (site_agepft_r8) : APPF ! canopy layer x leaf layer (site_cnlf_r8) : CLLL ! canopy layer x leaf layer x pft (site_cnlfpft_r8) : CLLLPF + ! canopy layer x pft (site_clpf_r8) : CLPF ! element x cwd size (site_elcwd_r8) : ELDC ! cohort size x patch age (site_scag_r8) : SZAP ! cohort size x patch age x pft (site_scagpft_r8) : SZAPPF @@ -4667,18 +4663,17 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=site_r8, hlms='CLM:ALM', upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_l2fr_si) - !!call this%set_history_var(vname='FATES_L2FR_EMA', units='kg kg-1', & - !! long='Moving average of the leaf to fineroot biomass multiplier for target allometry', & - !! use_default='active', & - !! avgflag='A', vtype=site_r8, hlms='CLM:ALM', upfreq=1, & - !! ivar=ivar, initialize=initialize_variables, index = ih_l2fr_ema_si) + call this%set_history_var(vname='FATES_RECL2FR_CANOPY_PF', units='kg kg-1', & + long='The leaf to fineroot biomass multiplier for recruits (canopy)', & + use_default='active', & + avgflag='A', vtype=site_pft_r8, hlms='CLM:ALM', upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_recl2fr_canopy_pf) - - call this%set_history_var(vname='FATES_L2FR_SZPF', units='kg kg-1', & - long='The leaf to fineroot biomass multiplier for target allometry', & + call this%set_history_var(vname='FATES_RECL2FR_USTORY_PF', units='kg kg-1', & + long='The leaf to fineroot biomass multiplier for recruits (understory)', & use_default='active', & - avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', upfreq=1, & - ivar=ivar, initialize=initialize_variables, index = ih_l2fr_scpf) + avgflag='A', vtype=site_pft_r8, hlms='CLM:ALM', upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_recl2fr_ustory_pf) call this%set_history_var(vname='FATES_L2FR_CANOPY_SZPF', units='kg kg-1', & long='The leaf to fineroot biomass multiplier for target allometry in canopy plants', & diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index b70d680437..af4c7d2dc0 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -926,7 +926,7 @@ subroutine InitTimeAveragingGlobals() allocate(ema_lpa) call ema_lpa%define(photo_temp_acclim_timescale*sec_per_day, & hlm_stepsize,moving_ema_window) - + !allocate(ema_60day) !call ema_60day%define(prt_params%fnrt_adapt_tscl*sec_per_day,sec_per_day,moving_ema_window) !class(rmean_arr_type), pointer :: ema_fnrt_tscale(:) diff --git a/main/FatesRestartInterfaceMod.F90 b/main/FatesRestartInterfaceMod.F90 index 23787241bb..15604aba25 100644 --- a/main/FatesRestartInterfaceMod.F90 +++ b/main/FatesRestartInterfaceMod.F90 @@ -96,6 +96,8 @@ module FatesRestartInterfaceMod integer :: ir_canopy_layer_yesterday_co integer :: ir_canopy_trim_co integer :: ir_l2fr_co + integer :: ir_nc_store_co + integer :: ir_pc_store_co integer :: ir_size_class_lasttimestep_co integer :: ir_dbh_co integer :: ir_coage_co @@ -184,6 +186,7 @@ module FatesRestartInterfaceMod integer :: ir_litter_moisture_pa_nfsc ! Site level + integer :: ir_recl2fr_sipfcl integer :: ir_watermem_siwm integer :: ir_vegtempmem_sitm integer :: ir_seed_bank_sift @@ -696,6 +699,14 @@ subroutine define_restart_vars(this, initialize_variables) call this%set_restart_var(vname='fates_l2fr', vtype=cohort_r8, & long_name='ed cohort - l2fr', units='fraction', flushval = flushzero, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_l2fr_co ) + + call this%set_restart_var(vname='fates_nc_store', vtype=cohort_r8, & + long_name='ed cohort - nc_store', units='fraction', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_nc_store_co ) + + call this%set_restart_var(vname='fates_pc_store', vtype=cohort_r8, & + long_name='ed cohort - pc_store', units='fraction', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_pc_store_co ) call this%set_restart_var(vname='fates_size_class_lasttimestep', vtype=cohort_int, & long_name='ed cohort - size-class last timestep', units='index', flushval = flushzero, & @@ -1121,7 +1132,11 @@ subroutine define_restart_vars(this, initialize_variables) ! ! site x time level vars ! - + call this%set_restart_var(vname='fates_recruit_l2fr', vtype=cohort_r8, & + long_name='site-level mean recruit l2frs, by pft x canopy layer', & + units='-', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_recl2fr_sipfcl) + call this%set_restart_var(vname='fates_water_memory', vtype=cohort_r8, & long_name='last 10 days of volumetric soil water, by site x day-index', & units='m3/m3', flushval = flushzero, & @@ -1677,6 +1692,7 @@ subroutine set_restart_vectors(this,nc,nsites,sites) integer :: io_idx_pa_dc ! each decomposability index integer :: io_idx_pa_ib ! each SW band (vis/ir) per patch (pa_ib) integer :: io_idx_si_wmem ! each water memory class within each site + integer :: io_idx_si_pfcl ! each pft x canopy layer within each site integer :: io_idx_si_lyr_shell ! site - layer x shell index integer :: io_idx_si_scpf ! each size-class x pft index within site integer :: io_idx_si_sc ! each size-class index within site @@ -1732,6 +1748,8 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_canopy_layer_yesterday_co => this%rvars(ir_canopy_layer_yesterday_co)%r81d, & rio_canopy_trim_co => this%rvars(ir_canopy_trim_co)%r81d, & rio_l2fr_co => this%rvars(ir_l2fr_co)%r81d, & + rio_nc_store_co => this%rvars(ir_nc_store_co)%r81d, & + rio_pc_store_co => this%rvars(ir_pc_store_co)%r81d, & rio_seed_prod_co => this%rvars(ir_seed_prod_co)%r81d, & rio_size_class_lasttimestep => this%rvars(ir_size_class_lasttimestep_co)%int1d, & rio_dbh_co => this%rvars(ir_dbh_co)%r81d, & @@ -1779,6 +1797,7 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_nocomp_pft_label_pa => this%rvars(ir_nocomp_pft_label_pa)%int1d, & rio_area_pa => this%rvars(ir_area_pa)%r81d, & rio_watermem_siwm => this%rvars(ir_watermem_siwm)%r81d, & + rio_recl2fr_sipfcl => this%rvars(ir_recl2fr_sipfcl)%r81d, & rio_vegtempmem_sitm => this%rvars(ir_vegtempmem_sitm)%r81d, & rio_recrate_sift => this%rvars(ir_recrate_sift)%r81d, & rio_use_this_pft_sift => this%rvars(ir_use_this_pft_sift)%int1d, & @@ -1823,6 +1842,7 @@ subroutine set_restart_vectors(this,nc,nsites,sites) io_idx_co = io_idx_co_1st io_idx_pa_ib = io_idx_co_1st io_idx_si_wmem = io_idx_co_1st + io_idx_si_pfcl = io_idx_co_1st io_idx_si_vtmem = io_idx_co_1st io_idx_pa_ncl = io_idx_co_1st @@ -1947,6 +1967,8 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_canopy_layer_yesterday_co(io_idx_co) = ccohort%canopy_layer_yesterday rio_canopy_trim_co(io_idx_co) = ccohort%canopy_trim rio_l2fr_co(io_idx_co) = ccohort%l2fr + rio_nc_store_co(io_idx_co) = ccohort%nc_store + rio_pc_store_co(io_idx_co) = ccohort%pc_store rio_seed_prod_co(io_idx_co) = ccohort%seed_prod rio_size_class_lasttimestep(io_idx_co) = ccohort%size_class_lasttimestep rio_dbh_co(io_idx_co) = ccohort%dbh @@ -2164,7 +2186,7 @@ subroutine set_restart_vectors(this,nc,nsites,sites) io_idx_si_scpf = io_idx_si_scpf + 1 end do - rio_demorate_sisc(io_idx_si_sc) = sites(s)%demotion_rate(i_scls) + rio_demorate_sisc(io_idx_si_sc) = sites(s)%demotion_rate(i_scls) rio_promrate_sisc(io_idx_si_sc) = sites(s)%promotion_rate(i_scls) io_idx_si_sc = io_idx_si_sc + 1 @@ -2197,6 +2219,13 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_npatch_si(io_idx_si) = patchespersite + do i = 1,nclmax + do i_pft = 1, numpft + rio_recl2fr_sipfcl(io_idx_si_pfcl ) = sites(s)%rec_l2fr(i_pft,i) + io_idx_si_pfcl = io_idx_si_pfcl + 1 + end do + end do + do i = 1,numWaterMem ! numWaterMem currently 10 rio_watermem_siwm( io_idx_si_wmem ) = sites(s)%water_memory(i) io_idx_si_wmem = io_idx_si_wmem + 1 @@ -2385,7 +2414,7 @@ subroutine create_patchcohort_structure(this, nc, nsites, sites, bc_in, bc_out) ! correct boundary condition fields new_cohort%prt => null() call InitPRTObject(new_cohort%prt) - call InitPRTBoundaryConditions(new_cohort) + ! Allocate hydraulics arrays @@ -2498,6 +2527,7 @@ subroutine get_restart_vectors(this, nc, nsites, sites) integer :: io_idx_pa_dc ! each decomposability index integer :: io_idx_pa_ib ! each SW radiation band per patch (pa_ib) integer :: io_idx_si_wmem ! each water memory class within each site + integer :: io_idx_si_pfcl ! each pft x canopy layer class within each site integer :: io_idx_si_vtmem ! counter for vegetation temp memory integer :: io_idx_si_lyr_shell ! site - layer x shell index integer :: io_idx_si_scpf ! each size-class x pft index within site @@ -2545,6 +2575,8 @@ subroutine get_restart_vectors(this, nc, nsites, sites) rio_canopy_layer_yesterday_co => this%rvars(ir_canopy_layer_yesterday_co)%r81d, & rio_canopy_trim_co => this%rvars(ir_canopy_trim_co)%r81d, & rio_l2fr_co => this%rvars(ir_l2fr_co)%r81d, & + rio_nc_store_co => this%rvars(ir_nc_store_co)%r81d, & + rio_pc_store_co => this%rvars(ir_pc_store_co)%r81d, & rio_seed_prod_co => this%rvars(ir_seed_prod_co)%r81d, & rio_size_class_lasttimestep => this%rvars(ir_size_class_lasttimestep_co)%int1d, & rio_dbh_co => this%rvars(ir_dbh_co)%r81d, & @@ -2591,6 +2623,7 @@ subroutine get_restart_vectors(this, nc, nsites, sites) rio_agesinceanthrodist_pa => this%rvars(ir_agesinceanthrodist_pa)%r81d, & rio_nocomp_pft_label_pa => this%rvars(ir_nocomp_pft_label_pa)%int1d, & rio_area_pa => this%rvars(ir_area_pa)%r81d, & + rio_recl2fr_sipfcl => this%rvars(ir_recl2fr_sipfcl)%r81d, & rio_watermem_siwm => this%rvars(ir_watermem_siwm)%r81d, & rio_vegtempmem_sitm => this%rvars(ir_vegtempmem_sitm)%r81d, & rio_recrate_sift => this%rvars(ir_recrate_sift)%r81d, & @@ -2625,6 +2658,7 @@ subroutine get_restart_vectors(this, nc, nsites, sites) io_idx_co = io_idx_co_1st io_idx_pa_ib = io_idx_co_1st io_idx_si_wmem = io_idx_co_1st + io_idx_si_pfcl = io_idx_co_1st io_idx_si_vtmem = io_idx_co_1st io_idx_pa_ncl = io_idx_co_1st @@ -2732,7 +2766,9 @@ subroutine get_restart_vectors(this, nc, nsites, sites) ccohort%canopy_layer = rio_canopy_layer_co(io_idx_co) ccohort%canopy_layer_yesterday = rio_canopy_layer_yesterday_co(io_idx_co) ccohort%canopy_trim = rio_canopy_trim_co(io_idx_co) - ccohort%l2fr = rio_l2fr_co(io_idx_co) + ccohort%l2fr = rio_l2fr_co(io_idx_co) + ccohort%nc_store = rio_nc_store_co(io_idx_co) + ccohort%pc_store = rio_pc_store_co(io_idx_co) ccohort%seed_prod = rio_seed_prod_co(io_idx_co) ccohort%size_class_lasttimestep = rio_size_class_lasttimestep(io_idx_co) ccohort%dbh = rio_dbh_co(io_idx_co) @@ -2778,6 +2814,7 @@ subroutine get_restart_vectors(this, nc, nsites, sites) ccohort%status_coh = rio_status_co(io_idx_co) ccohort%isnew = ( rio_isnew_co(io_idx_co) .eq. new_cohort ) + call InitPRTBoundaryConditions(ccohort,ccohort%pft,4) call UpdateCohortBioPhysRates(ccohort) @@ -2949,6 +2986,13 @@ subroutine get_restart_vectors(this, nc, nsites, sites) call endrun(msg=errMsg(sourcefile, __LINE__)) end if + do i = 1,nclmax + do i_pft = 1, numpft + sites(s)%rec_l2fr(i_pft,i) = rio_recl2fr_sipfcl(io_idx_si_pfcl) + io_idx_si_pfcl = io_idx_si_pfcl + 1 + end do + end do + do i = 1,numWaterMem sites(s)%water_memory(i) = rio_watermem_siwm( io_idx_si_wmem ) io_idx_si_wmem = io_idx_si_wmem + 1 diff --git a/main/FatesRunningMeanMod.F90 b/main/FatesRunningMeanMod.F90 index f7887f3fb4..a1c51f6abf 100644 --- a/main/FatesRunningMeanMod.F90 +++ b/main/FatesRunningMeanMod.F90 @@ -93,7 +93,7 @@ module FatesRunningMeanMod class(rmean_def_type), public, pointer :: ema_lpa ! Exponential moving average - leaf photo acclimation class(rmean_def_type), public, pointer :: ema_60day ! Exponential moving average, 60 day ! Updated daily - + class(rmean_def_type), public, pointer :: ema_storemem ! EMA used for smoothing N/C and P/C storage ! If we want to have different running mean specs based on ! pft or other types of constants @@ -309,12 +309,13 @@ subroutine FuseRMean(this,donor,recip_wgt) class(rmean_type) :: this class(rmean_type), pointer :: donor real(r8),intent(in) :: recip_wgt ! Weighting factor for recipient (0-1) - - if(this%def_type%n_mem .ne. donor%def_type%n_mem) then - write(fates_log(), *) 'memory size is somehow different during fusion' - write(fates_log(), *) 'of two running mean variables: '!,this%name,donor%name - call endrun(msg=errMsg(sourcefile, __LINE__)) - end if + + ! Unecessary + !if(this%def_type%n_mem .ne. donor%def_type%n_mem) then + ! write(fates_log(), *) 'memory size is somehow different during fusion' + ! write(fates_log(), *) 'of two running mean variables: '!,this%name,donor%name + ! call endrun(msg=errMsg(sourcefile, __LINE__)) + !end if if(this%def_type%method .eq. fixed_window ) then if (this%c_index .ne. donor%c_index) then diff --git a/parteh/PRTAllometricCNPMod.F90 b/parteh/PRTAllometricCNPMod.F90 index 5115a602b5..6a6b71bda2 100644 --- a/parteh/PRTAllometricCNPMod.F90 +++ b/parteh/PRTAllometricCNPMod.F90 @@ -18,7 +18,7 @@ module PRTAllometricCNPMod use PRTGenericMod , only : nitrogen_element use PRTGenericMod , only : phosphorus_element use PRTGenericMod , only : max_nleafage - + use PRTGenericMod , only : l2fr_min use PRTGenericMod , only : leaf_organ use PRTGenericMod , only : fnrt_organ use PRTGenericMod , only : sapw_organ @@ -147,8 +147,10 @@ module PRTAllometricCNPMod ! is dynamic with CNP integer, public, parameter :: acnp_bc_inout_id_netdn = 4 ! Index for the net daily NH4 input BC integer, public, parameter :: acnp_bc_inout_id_netdp = 5 ! Index for the net daily P input BC - - integer, public, parameter :: num_bc_inout = 5 + integer, public, parameter :: acnp_bc_inout_id_nc_store = 6 ! Index for the EMA log storage ratio N/C + integer, public, parameter :: acnp_bc_inout_id_pc_store = 7 ! Index for the EMA log storage ratio P/C + + integer, public, parameter :: num_bc_inout = 7 ! ------------------------------------------------------------------------------------- ! Input only Boundary Indices (These are public) @@ -158,10 +160,11 @@ module PRTAllometricCNPMod integer, public, parameter :: acnp_bc_in_id_ctrim = 2 ! Index for the canopy trim function integer, public, parameter :: acnp_bc_in_id_lstat = 3 ! phenology status logical integer, public, parameter :: acnp_bc_in_id_netdc = 4 ! Index for the net daily C input BC - + integer, public, parameter :: acnp_bc_in_id_nc_repro = 5 + integer, public, parameter :: acnp_bc_in_id_pc_repro = 6 ! 0=leaf off, 1=leaf on - integer, parameter :: num_bc_in = 4 + integer, parameter :: num_bc_in = 6 ! ------------------------------------------------------------------------------------- ! Output Boundary Indices (These are public) @@ -413,8 +416,7 @@ subroutine DailyPRTAllometricCNP(this) ! Also, we save the initial values of many of these BC's ! for checking and resetting if needed ! ----------------------------------------------------------------------------------- - c_gain = this%bc_in(acnp_bc_in_id_netdc)%rval; c_gain0 = c_gain - + c_gain = this%bc_in(acnp_bc_in_id_netdc)%rval canopy_trim = this%bc_in(acnp_bc_in_id_ctrim)%rval ipft = this%bc_in(acnp_bc_in_id_pft)%ival @@ -430,7 +432,7 @@ subroutine DailyPRTAllometricCNP(this) n_gain0 = n_gain p_gain0 = p_gain - + c_gain0 = c_gain ! Calculate Carbon allocation targets ! ----------------------------------------------------------------------------------- @@ -457,13 +459,9 @@ subroutine DailyPRTAllometricCNP(this) ! =================================================================================== ! This routine updates the l2fr (leaf 2 fine-root multiplier) variable - ! It will also update target_c(fnrt_organ) - call this%CNPAdjustFRootTargets(target_c) + ! It will also update the target + call this%CNPAdjustFRootTargets(target_c,target_dcdd) - c_gain0 = c_gain - n_gain0 = n_gain - p_gain0 = p_gain - ! Remember the original C,N,P states to help with final ! evaluation of how much was allocated ! ----------------------------------------------------------------------------------- @@ -627,7 +625,7 @@ subroutine DailyPRTAllometricCNP(this) abs(allocated_n - (n_gain0-n_gain)) > calloc_abs_error .or. & abs(allocated_p - (p_gain0-p_gain)) > calloc_abs_error ) then write(fates_log(),*) 'CNP allocation scheme did not balance mass.' - write(fates_log(),*) 'c_gain0: ',c_gain0,' allocated_c: ',allocated_c + write(fates_log(),*) 'c_gain0: ',c_gain0,' allocated_c: ',allocated_c,resp_excess,resp_excess0,c_efflux write(fates_log(),*) 'n_gain0: ',n_gain0,' allocated_n: ',allocated_n write(fates_log(),*) 'p_gain0: ',p_gain0,' allocated_p: ',allocated_p @@ -669,10 +667,11 @@ subroutine DailyPRTAllometricCNP(this) end subroutine DailyPRTAllometricCNP ! ===================================================================================== - subroutine CNPAdjustFRootTargets(this, target_c) + subroutine CNPAdjustFRootTargets(this, target_c, target_dcdd) class(cnp_allom_prt_vartypes) :: this real(r8) :: target_c(:) + real(r8) :: target_dcdd(:) real(r8), pointer :: l2fr ! leaf to fineroot target biomass scaler integer :: ipft ! PFT index @@ -688,14 +687,19 @@ subroutine CNPAdjustFRootTargets(this, target_c) real(r8) :: l2fr_delta_scale real(r8) :: logi_k real(r8) :: l2fr_mult + real(r8), pointer :: nc_store + real(r8), pointer :: pc_store real(r8), parameter :: max_l2fr_cgain_frac = 0.99_r8 + real(r8), parameter :: wgt = 1._r8/10._r8 ! 10-day smoothing + ipft = this%bc_in(acnp_bc_in_id_pft)%ival l2fr => this%bc_inout(acnp_bc_inout_id_l2fr)%rval dbh => this%bc_inout(acnp_bc_inout_id_dbh)%rval canopy_trim = this%bc_in(acnp_bc_in_id_ctrim)%rval - + nc_store => this%bc_inout(acnp_bc_inout_id_nc_store)%rval + pc_store => this%bc_inout(acnp_bc_inout_id_pc_store)%rval ! Step 1: Determine the nutrient to carbon ratio (aka relative health factor) ! ----------------------------------------------------------------------------------- @@ -717,6 +721,8 @@ subroutine CNPAdjustFRootTargets(this, target_c) n_ratio = min(50.0_r8,max(0.02_r8,(store_nut_act/store_nut_max)/(store_c_act/store_c_max))) + nc_store = wgt*log(n_ratio) + (1._r8-wgt)*nc_store + end if if(p_uptake_mode.ne.prescribed_p_uptake)then @@ -726,10 +732,11 @@ subroutine CNPAdjustFRootTargets(this, target_c) store_nut_max = this%GetNutrientTarget(phosphorus_element,store_organ,stoich_growth_min) - store_nut_act = this%GetState(store_organ, phosphorus_element) + this%bc_inout(acnp_bc_inout_id_netdp)%rval - + store_nut_act = this%GetState(store_organ, phosphorus_element) + this%bc_inout(acnp_bc_inout_id_netdp)%rval p_ratio = min(50.0_r8,max(0.02_r8,(store_nut_act/store_nut_max)/(store_c_act/store_c_max))) + pc_store = wgt*log(p_ratio) + (1._r8-wgt)*pc_store + end if ! Use the limiting nutrient species @@ -739,13 +746,13 @@ subroutine CNPAdjustFRootTargets(this, target_c) cnp_store_ratio = 1._r8 return else - cnp_store_ratio = p_ratio + cnp_store_ratio = exp(pc_store) end if else if(p_uptake_mode.eq.prescribed_p_uptake)then - cnp_store_ratio = n_ratio + cnp_store_ratio = exp(nc_store) else - cnp_store_ratio = min(n_ratio, p_ratio) + cnp_store_ratio = min(exp(nc_store),exp(pc_store)) end if end if @@ -805,31 +812,17 @@ subroutine CNPAdjustFRootTargets(this, target_c) l2fr_mult = min(l2fr_mult,l2fr_delta_max) end if - ! Use the derivative approach - ! ----------------------------------------------------------------------------------- - - ! gamma = log(np_ratio) - - ! Calculate how close the change in gamma was to what was predicted - - !gamma_del = gamma - dlambda_dgamma*gamma_prev - - - !l2fr_deriv = gamma * dlambda_dgamma - - - ! Only update L2FR if some leaves are out if(this%GetState(leaf_organ, carbon12_element)/target_c(leaf_organ) > 0.5_r8) then !l2fr = (1._r8-err_beta)*(l2fr * l2fr_mult) + err_beta*l2fr_deriv - l2fr = l2fr * l2fr_mult + l2fr = max(l2fr_min,l2fr * l2fr_mult) end if ! Find the updated target fineroot biomass - call bfineroot(dbh,ipft,canopy_trim, l2fr, target_c(fnrt_organ)) + call bfineroot(dbh,ipft,canopy_trim, l2fr, target_c(fnrt_organ),target_dcdd(fnrt_organ)) return end subroutine CNPAdjustFRootTargets @@ -857,11 +850,11 @@ subroutine TrimFineRoot(this) real(r8) :: pc_fnrt real(r8) :: target_fnrt_c real(r8),parameter :: nday_buffer = 0._r8 - real(r8),parameter :: fnrt_opt_eff = 0._r8 ! If we want to transfer resources to storage + real(r8),parameter :: fnrt_opt_eff = 1._r8 ! If we want to transfer resources to storage if(.not.use_unrestricted_contraction)return - associate( ipft => this%bc_in(acnp_bc_in_id_pft)%ival, & + associate( ipft => this%bc_in(acnp_bc_in_id_pft)%ival, & l2fr => this%bc_inout(acnp_bc_inout_id_l2fr)%rval, & dbh => this%bc_inout(acnp_bc_inout_id_dbh)%rval, & canopy_trim => this%bc_in(acnp_bc_in_id_ctrim)%rval) @@ -1658,8 +1651,10 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & write(fates_log(),*) 'Aborting' write(fates_log(),*) 'mask: ',state_mask write(fates_log(),*) 'smallest deltaC',this%ode_opt_step - write(fates_log(),*) 'totalC',totalC + write(fates_log(),*) 'totalC',totalC,c_gain,neq_cgain,peq_cgain write(fates_log(),*) 'pft: ',ipft + write(fates_log(),*) 'trim: ',canopy_trim + write(fates_log(),*) 'l2fr: ',l2fr write(fates_log(),*) 'dbh: ',dbh write(fates_log(),*) 'dCleaf_dd: ',target_dcdd(leaf_organ) write(fates_log(),*) 'dCfnrt_dd: ',target_dcdd(fnrt_organ) @@ -1839,7 +1834,6 @@ subroutine CNPAllocateRemainder(this, c_gain, n_gain, p_gain, & ! Update carbon based allometric targets call bstore_allom(dbh,ipft,canopy_trim, store_c_target) - ! Allow some overflow store_c_target = store_c_target * (1._r8 + prt_params%store_ovrflw_frac(ipft)) @@ -1962,12 +1956,15 @@ function GetNutrientTargetCNP(this,element_id,organ_id,stoich_mode) result(targe real(r8) :: leaf_c_target,fnrt_c_target real(r8) :: sapw_c_target,agw_c_target real(r8) :: bgw_c_target,struct_c_target + real(r8) :: nc_repro,pc_repro dbh => this%bc_inout(acnp_bc_inout_id_dbh)%rval canopy_trim = this%bc_in(acnp_bc_in_id_ctrim)%rval ipft = this%bc_in(acnp_bc_in_id_pft)%ival i_cvar = prt_global%sp_organ_map(organ_id,carbon12_element) l2fr = this%bc_inout(acnp_bc_inout_id_l2fr)%rval + nc_repro = this%bc_in(acnp_bc_in_id_nc_repro)%rval + pc_repro = this%bc_in(acnp_bc_in_id_pc_repro)%rval ! Storage of nutrients are assumed to have different compartments than ! for carbon, and thus their targets are not associated with a tissue @@ -2013,9 +2010,9 @@ function GetNutrientTargetCNP(this,element_id,organ_id,stoich_mode) result(targe target_c = this%variables(i_cvar)%val(1) if( element_id == nitrogen_element) then - target_m = target_c * prt_params%nitr_recr_stoich(ipft) + target_m = target_c * nc_repro else - target_m = target_c * prt_params%phos_recr_stoich(ipft) + target_m = target_c * pc_repro end if else @@ -2387,8 +2384,10 @@ subroutine EstimateGrowthNC(this,target_c,target_dcdd,state_mask,avg_nc,avg_pc) real(r8) :: store_pc real(r8) :: repro_w,leaf_w,fnrt_w,sapw_w,struct_w,store_w - associate(dbh => this%bc_inout(acnp_bc_inout_id_dbh)%rval, & - ipft => this%bc_in(acnp_bc_in_id_pft)%ival ) + associate(dbh => this%bc_inout(acnp_bc_inout_id_dbh)%rval, & + ipft => this%bc_in(acnp_bc_in_id_pft)%ival, & + nc_repro => this%bc_in(acnp_bc_in_id_nc_repro)%rval, & + pc_repro => this%bc_in(acnp_bc_in_id_pc_repro)%rval) if(state_mask(repro_id)) then if (dbh <= prt_params%dbh_repro_threshold(ipft)) then @@ -2448,11 +2447,10 @@ subroutine EstimateGrowthNC(this,target_c,target_dcdd,state_mask,avg_nc,avg_pc) repro_w = total_w * repro_c_frac/(1._r8 - repro_c_frac) total_w = total_w + repro_w - avg_nc = avg_nc + repro_w * prt_params%nitr_recr_stoich(ipft) - avg_pc = avg_pc + repro_w * prt_params%phos_recr_stoich(ipft) + avg_nc = avg_nc + repro_w * nc_repro + avg_pc = avg_pc + repro_w * pc_repro end if - avg_nc = avg_nc / total_w avg_pc = avg_pc / total_w diff --git a/parteh/PRTGenericMod.F90 b/parteh/PRTGenericMod.F90 index d3538b528d..f3e995f18a 100644 --- a/parteh/PRTGenericMod.F90 +++ b/parteh/PRTGenericMod.F90 @@ -146,6 +146,11 @@ module PRTGenericMod ! (used for allocating scratch space) integer, parameter, public :: max_nleafage = 4 + + ! This is the minimum allowable L2FR, this is needed so that plants + ! in the understory don't shrink their roots down so far that + ! they dissappear and cause numerical issues + real(r8), parameter, public :: l2fr_min = 0.01_r8 ! ------------------------------------------------------------------------------------- ! diff --git a/parteh/PRTParametersMod.F90 b/parteh/PRTParametersMod.F90 index e1f418f09e..b83727570a 100644 --- a/parteh/PRTParametersMod.F90 +++ b/parteh/PRTParametersMod.F90 @@ -8,7 +8,7 @@ module PRTParametersMod ! that data, for that is model dependent (ie FATES may have a different ! way than another TBM) ! This code does perform checks on parameters. - + type,public :: prt_param_type ! The following three PFT classes @@ -61,10 +61,6 @@ module PRTParametersMod integer, allocatable :: organ_id(:) ! Mapping of the organ index in the parameter file, to the ! global list of organs found in PRTGenericMod.F90 - - - - real(r8), allocatable :: alloc_priority(:,:) ! Allocation priority for each organ (pft x organ) [integer 0-6] real(r8), allocatable :: cushion(:) ! labile carbon storage target as multiple of leaf pool. real(r8), allocatable :: leaf_stor_priority(:) ! leaf turnover vs labile carbon use prioritisation @@ -81,13 +77,6 @@ module PRTParametersMod ! by all the possible organs in parteh, and each index ! may point to the index in the parameter file, or will be -1 - real(r8), allocatable :: nitr_recr_stoich(:) ! This is the N:C ratio of newly recruited plants that are - ! on allometry at their recruitment diameter - - real(r8), allocatable :: phos_recr_stoich(:) ! This is the P:C ratio of newly recruited plants that are - ! on allometry at their recruitment diameter - - ! Allometry Parameters ! -------------------------------------------------------------------------------------------- diff --git a/parteh/PRTParamsFATESMod.F90 b/parteh/PRTParamsFATESMod.F90 index fb1338c5cd..9eec0ccaa3 100644 --- a/parteh/PRTParamsFATESMod.F90 +++ b/parteh/PRTParamsFATESMod.F90 @@ -50,6 +50,7 @@ module PRTInitParamsFatesMod public :: PRTReceiveParams public :: PRTCheckParams public :: PRTDerivedParams + public :: NewRecruitTotalStoichiometry !----------------------------------------------------------------------- contains @@ -967,8 +968,6 @@ subroutine PRTDerivedParams() ! Set the reverse lookup map for organs to the parameter file index allocate(prt_params%organ_param_id(num_organ_types)) - allocate(prt_params%nitr_recr_stoich(npft)) - allocate(prt_params%phos_recr_stoich(npft)) ! Initialize them as invalid prt_params%organ_param_id(:) = -1 @@ -977,18 +976,6 @@ subroutine PRTDerivedParams() prt_params%organ_param_id(prt_params%organ_id(i)) = i end do - - ! Calculate the stoichiometry of a new recruit, and use this for defining - ! seed stoichiometry and - - do ft = 1,npft - - prt_params%nitr_recr_stoich(ft) = NewRecruitTotalStoichiometry(ft,nitrogen_element) - prt_params%phos_recr_stoich(ft) = NewRecruitTotalStoichiometry(ft,phosphorus_element) - - end do - - return end subroutine PRTDerivedParams @@ -1466,7 +1453,7 @@ end subroutine PRTCheckParams ! ==================================================================================== - function NewRecruitTotalStoichiometry(ft,element_id) result(recruit_stoich) + function NewRecruitTotalStoichiometry(ft,l2fr,element_id) result(recruit_stoich) ! ---------------------------------------------------------------------------------- ! This function calculates the total N:C or P:C ratio for a newly recruited plant @@ -1480,10 +1467,10 @@ function NewRecruitTotalStoichiometry(ft,element_id) result(recruit_stoich) ! into new recruits. ! ---------------------------------------------------------------------------------- - - integer,intent(in) :: ft - integer,intent(in) :: element_id - real(r8) :: recruit_stoich ! nutrient to carbon ratio of recruit + integer,intent(in) :: ft + integer,intent(in) :: element_id + real(r8),intent(in) :: l2fr + real(r8) :: recruit_stoich ! nutrient to carbon ratio of recruit real(r8) :: dbh ! dbh of the new recruit [cm] real(r8) :: c_leaf ! target leaf biomass [kgC] @@ -1499,7 +1486,7 @@ function NewRecruitTotalStoichiometry(ft,element_id) result(recruit_stoich) call h2d_allom(EDPftvarcon_inst%hgt_min(ft),ft,dbh) call bleaf(dbh,ft,init_recruit_trim,c_leaf) - call bfineroot(dbh,ft,init_recruit_trim,prt_params%allom_l2fr(ft),c_fnrt) + call bfineroot(dbh,ft,init_recruit_trim,l2fr,c_fnrt) call bsap_allom(dbh,ft,init_recruit_trim,a_sapw, c_sapw) call bagw_allom(dbh,ft,c_agw) call bbgw_allom(dbh,ft,c_bgw) From a75b6d6ceb0efad715aa095f78a42dfd983dcc7c Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Wed, 3 Aug 2022 12:35:29 -0400 Subject: [PATCH 26/55] Adding canopy layer x size x pft history diagnostics --- biogeochem/EDCohortDynamicsMod.F90 | 4 +- biogeochem/EDPhysiologyMod.F90 | 11 + main/EDMainMod.F90 | 16 +- main/EDTypesMod.F90 | 2 + main/FatesHistoryInterfaceMod.F90 | 793 +++++++++++++++------------- main/FatesHistoryVariableType.F90 | 8 +- main/FatesIODimensionsMod.F90 | 6 +- main/FatesIOVariableKindMod.F90 | 3 +- main/FatesSizeAgeTypeIndicesMod.F90 | 30 +- parteh/PRTAllometricCNPMod.F90 | 5 +- parteh/PRTGenericMod.F90 | 3 +- 11 files changed, 496 insertions(+), 385 deletions(-) diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index 234dc1bc9d..e671d8982e 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -431,8 +431,8 @@ subroutine InitPRTBoundaryConditions(new_cohort,ft,call_id) call new_cohort%prt%RegisterBCIn(acnp_bc_in_id_lstat,bc_ival = new_cohort%status_coh) call new_cohort%prt%RegisterBCIn(acnp_bc_in_id_netdc, bc_rval = new_cohort%npp_acc) - call new_cohort%prt%RegisterBCIn(acnp_bc_in_id_nc_repro,bc_rval = new_cohort%patchptr%nitr_repro_stoich(ft)) - call new_cohort%prt%RegisterBCIn(acnp_bc_in_id_pc_repro,bc_rval = new_cohort%patchptr%phos_repro_stoich(ft)) + call new_cohort%prt%RegisterBCIn(acnp_bc_in_id_nc_repro,bc_rval = new_cohort%nc_repro) !patchptr%nitr_repro_stoich(ft)) + call new_cohort%prt%RegisterBCIn(acnp_bc_in_id_pc_repro,bc_rval = new_cohort%pc_repro) !patchptr%phos_repro_stoich(ft)) call new_cohort%prt%RegisterBCInOut(acnp_bc_inout_id_dbh,bc_rval = new_cohort%dbh) call new_cohort%prt%RegisterBCInOut(acnp_bc_inout_id_resp_excess,bc_rval = new_cohort%resp_excess) diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index f381c53347..a260285c42 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -2662,6 +2662,7 @@ subroutine UpdateRecruitStoich(csite) type(ed_site_type) :: csite type(ed_patch_type), pointer :: cpatch + type(ed_cohort_type), pointer :: ccohort integer :: ft ! functional type index integer :: cl ! canopy layer index real(r8) :: rec_l2fr_pft ! Actual l2fr of a pft in it's patch @@ -2671,6 +2672,7 @@ subroutine UpdateRecruitStoich(csite) cpatch => csite%youngest_patch do while(associated(cpatch)) cl = cpatch%ncl_p + do ft = 1,numpft rec_l2fr_pft = csite%rec_l2fr(ft,cl) cpatch%nitr_repro_stoich(ft) = & @@ -2678,6 +2680,15 @@ subroutine UpdateRecruitStoich(csite) cpatch%phos_repro_stoich(ft) = & NewRecruitTotalStoichiometry(ft,rec_l2fr_pft,phosphorus_element) end do + + ccohort => cpatch%shortest + cloop: do while(associated(ccohort)) + rec_l2fr_pft = csite%rec_l2fr(ccohort%pft,cl) + ccohort%nc_repro = NewRecruitTotalStoichiometry(ccohort%pft,rec_l2fr_pft,nitrogen_element) + ccohort%pc_repro = NewRecruitTotalStoichiometry(ccohort%pft,rec_l2fr_pft,phosphorus_element) + ccohort => ccohort%taller + end do cloop + cpatch => cpatch%older end do diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index 5aaa4f25f2..305fbcafb1 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -469,13 +469,7 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) call EffluxIntoLitterPools(currentSite, currentPatch, currentCohort, bc_in ) - ! Update history diagnostics related to Nutrient fluxes and C efflux (if any) - ! ----------------------------------------------------------------------------- - call fates_hist%update_history_nutrflux(currentSite,currentPatch,currentCohort) - - - currentCohort%daily_n_fixation = 0._r8 ! Mass balance for N uptake currentSite%mass_balance(element_pos(nitrogen_element))%net_root_uptake = & @@ -550,13 +544,18 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) currentPatch => currentPatch%older end do - - + ! We keep a record of the L2FRs of plants ! that are near the recruit size, for different ! pfts and canopy layer. We use this mean to ! set the L2FRs of newly recruited plants + call UpdateRecruitL2FR(currentSite) + + ! Update history diagnostics related to Nutrients (if any) + ! ----------------------------------------------------------------------------- + + call fates_hist%update_history_nutrflux(currentSite) ! When plants die, the water goes with them. This effects ! the water balance. @@ -612,6 +611,7 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) currentCohort => currentPatch%shortest do while(associated(currentCohort)) currentCohort%n = max(0._r8,currentCohort%n + currentCohort%dndt * hlm_freq_day ) + currentCohort%daily_n_fixation = 0._r8 currentCohort => currentCohort%taller enddo currentPatch => currentPatch%older diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 7adba898a1..4a1b434676 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -226,6 +226,8 @@ module EDTypesMod integer :: cnp_limiter ! Which species is limiting growth? ! 0=none,1=C,2=N,3=P real(r8) :: nc_store ! Exponential moving average of the log of the N/C storage ratio real(r8) :: pc_store ! Exponential moving average of the log of the P/C storage ratio + real(r8) :: nc_repro ! The NC ratio of a new recruit in this patch + real(r8) :: pc_repro ! The PC ratio of a new recruit in this patch ! VEGETATION STRUCTURE diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index c5223c18f5..9e71cb5a29 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -16,6 +16,7 @@ module FatesHistoryInterfaceMod use EDTypesMod , only : ican_upper use PRTGenericMod , only : element_pos use PRTGenericMod , only : num_elements + use PRTGenericMod , only : prt_cnp_flex_allom_hyp use EDTypesMod , only : site_fluxdiags_type use EDtypesMod , only : ed_site_type use EDtypesMod , only : ed_cohort_type @@ -82,6 +83,7 @@ module FatesHistoryInterfaceMod use PRTGenericMod , only : nitrogen_element, phosphorus_element use PRTGenericMod , only : prt_carbon_allom_hyp use PRTAllometricCNPMod , only : stoich_max,stoich_growth_min + use FatesSizeAgeTypeIndicesMod, only : get_layersizetype_class_index implicit none private ! By default everything is private @@ -171,32 +173,59 @@ module FatesHistoryInterfaceMod integer :: ih_reproc_si integer :: ih_totvegc_si + ! Nutrient relevant diagnostics (CNP) + ! --------------------------------------------------------------- + ! These are active if if(any(element_list(:)==nitrogen_element)) integer :: ih_storen_si integer :: ih_leafn_si integer :: ih_sapwn_si integer :: ih_fnrtn_si integer :: ih_repron_si integer :: ih_totvegn_si - - integer :: ih_storep_si + integer :: ih_storentfrac_si + integer :: ih_totvegn_scpf + integer :: ih_leafn_scpf + integer :: ih_fnrtn_scpf + integer :: ih_storen_scpf + integer :: ih_sapwn_scpf + integer :: ih_repron_scpf + integer :: ih_storentfrac_canopy_scpf + integer :: ih_storentfrac_understory_scpf + ! These are active if if(any(element_list(:)==phosphorus_element)) + integer :: ih_storep_si integer :: ih_leafp_si integer :: ih_sapwp_si integer :: ih_fnrtp_si integer :: ih_reprop_si integer :: ih_totvegp_si + integer :: ih_storeptfrac_si + integer :: ih_totvegp_scpf + integer :: ih_leafp_scpf + integer :: ih_fnrtp_scpf + integer :: ih_reprop_scpf + integer :: ih_storep_scpf + integer :: ih_sapwp_scpf + integer :: ih_storeptfrac_canopy_scpf + integer :: ih_storeptfrac_understory_scpf + ! These are active if hlm_parteh_mode = prt_cnp_flex_allom_hyp integer :: ih_l2fr_si - integer :: ih_l2fr_canopy_scpf - integer :: ih_l2fr_understory_scpf + integer :: ih_l2fr_clscpf integer :: ih_recl2fr_canopy_pf integer :: ih_recl2fr_ustory_pf + integer :: ih_ngrowlim_clscpf + integer :: ih_pgrowlim_clscpf + integer :: ih_nh4uptake_scpf + integer :: ih_no3uptake_scpf + integer :: ih_puptake_scpf integer :: ih_nh4uptake_si integer :: ih_no3uptake_si integer :: ih_puptake_si - integer :: ih_cefflux_si integer :: ih_nefflux_si integer :: ih_pefflux_si + integer :: ih_nefflux_scpf + integer :: ih_pefflux_scpf integer :: ih_ndemand_si integer :: ih_ndemand_scpf integer :: ih_pdemand_si @@ -204,20 +233,25 @@ module FatesHistoryInterfaceMod integer :: ih_nfix_si integer :: ih_nfix_scpf + ! These dimensions are useful for upscaling (weighting clscpf) + integer :: ih_fnrtc_clscpf + integer :: ih_gpp_clscpf + integer :: ih_totvegc_clscpf + + integer :: ih_trimming_si integer :: ih_area_plant_si integer :: ih_area_trees_si - integer :: ih_cwd_elcwd - + + integer :: ih_litter_in_elem + integer :: ih_litter_out_elem + integer :: ih_seed_bank_elem integer :: ih_litter_in_si ! carbon only integer :: ih_litter_out_si ! carbon only integer :: ih_seed_bank_si ! carbon only integer :: ih_seeds_in_si ! carbon only - - integer :: ih_litter_in_elem - integer :: ih_litter_out_elem - integer :: ih_seed_bank_elem + integer :: ih_seeds_in_local_elem integer :: ih_seeds_in_extern_elem integer :: ih_seed_decay_elem @@ -227,6 +261,7 @@ module FatesHistoryInterfaceMod integer :: ih_fines_bg_elem integer :: ih_cwd_ag_elem integer :: ih_cwd_bg_elem + integer :: ih_cwd_elcwd integer :: ih_burn_flux_elem ! Size-class x PFT mass states @@ -236,43 +271,12 @@ module FatesHistoryInterfaceMod integer :: ih_bleaf_canopy_si_scpf integer :: ih_bleaf_understory_si_scpf - - - integer :: ih_totvegn_scpf - integer :: ih_leafn_scpf - integer :: ih_fnrtn_scpf - integer :: ih_storen_scpf - integer :: ih_storentfrac_si - integer :: ih_storentfrac_canopy_scpf - integer :: ih_storentfrac_understory_scpf - integer :: ih_sapwn_scpf - integer :: ih_repron_scpf - integer,public :: ih_nh4uptake_scpf - integer,public :: ih_no3uptake_scpf - integer :: ih_nefflux_scpf - - integer :: ih_totvegc_scpf integer :: ih_leafc_scpf integer :: ih_fnrtc_scpf integer :: ih_storec_scpf integer :: ih_sapwc_scpf integer :: ih_reproc_scpf - integer :: ih_cefflux_scpf - - integer :: ih_totvegp_scpf - integer :: ih_leafp_scpf - integer :: ih_fnrtp_scpf - integer :: ih_reprop_scpf - integer :: ih_storep_scpf - integer :: ih_storeptfrac_si - integer :: ih_storeptfrac_canopy_scpf - integer :: ih_storeptfrac_understory_scpf - integer :: ih_sapwp_scpf - integer,public :: ih_puptake_scpf - integer :: ih_pefflux_scpf - - integer :: ih_bdead_si integer :: ih_balive_si integer :: ih_agb_si @@ -397,7 +401,6 @@ module FatesHistoryInterfaceMod integer :: ih_npp_agdw_si_scpf integer :: ih_npp_stor_si_scpf - integer :: ih_mortality_canopy_si_scpf integer :: ih_mortality_understory_si_scpf integer :: ih_nplant_canopy_si_scpf @@ -684,7 +687,7 @@ module FatesHistoryInterfaceMod integer, private :: levelem_index_, levelpft_index_ integer, private :: levelcwd_index_, levelage_index_ integer, private :: levcacls_index_, levcapf_index_ - + integer, private :: levclscpf_index_ contains @@ -724,7 +727,8 @@ module FatesHistoryInterfaceMod procedure :: levelcwd_index procedure :: levelage_index procedure :: levagefuel_index - + procedure :: levclscpf_index + ! private work functions procedure, private :: define_history_vars procedure, private :: set_history_var @@ -749,7 +753,8 @@ module FatesHistoryInterfaceMod procedure, private :: set_levagepft_index procedure, private :: set_levheight_index procedure, private :: set_levagefuel_index - + procedure, private :: set_levclscpf_index + procedure, private :: set_levelem_index procedure, private :: set_levelpft_index procedure, private :: set_levelcwd_index @@ -785,7 +790,7 @@ subroutine Init(this, num_threads, fates_bounds) use FatesIODimensionsMod, only : fates_bounds_type use FatesIODimensionsMod, only : levheight, levagefuel use FatesIODimensionsMod, only : levelem, levelpft - use FatesIODimensionsMod, only : levelcwd, levelage + use FatesIODimensionsMod, only : levelcwd, levelage, levclscpf implicit none @@ -910,6 +915,11 @@ subroutine Init(this, num_threads, fates_bounds) call this%dim_bounds(dim_count)%Init(levagefuel, num_threads, & fates_bounds%agefuel_begin, fates_bounds%agefuel_end) + dim_count = dim_count + 1 + call this%set_levclscpf_index(dim_count) + call this%dim_bounds(dim_count)%Init(levclscpf, num_threads, & + fates_bounds%clscpf_begin, fates_bounds%clscpf_end) + end subroutine Init ! ====================================================================== @@ -1018,9 +1028,9 @@ subroutine SetThreadBoundsEach(this, thread_index, thread_bounds) call this%dim_bounds(index)%SetThreadBounds(thread_index, & thread_bounds%agefuel_begin, thread_bounds%agefuel_end) - - - + index = this%levclscpf_index() + call this%dim_bounds(index)%SetThreadBounds(thread_index, & + thread_bounds%clscpf_begin, thread_bounds%clscpf_end) end subroutine SetThreadBoundsEach @@ -1036,7 +1046,7 @@ subroutine assemble_history_output_types(this) use FatesIOVariableKindMod, only : site_can_r8, site_cnlf_r8, site_cnlfpft_r8 use FatesIOVariableKindMod, only : site_height_r8, site_agefuel_r8 use FatesIOVariableKindMod, only : site_elem_r8, site_elpft_r8 - use FatesIOVariableKindMod, only : site_elcwd_r8, site_elage_r8 + use FatesIOVariableKindMod, only : site_elcwd_r8, site_elage_r8, site_clscpf_r8 implicit none @@ -1117,7 +1127,9 @@ subroutine assemble_history_output_types(this) call this%set_dim_indices(site_agefuel_r8, 1, this%column_index()) call this%set_dim_indices(site_agefuel_r8, 2, this%levagefuel_index()) - + call this%set_dim_indices(site_clscpf_r8, 1, this%column_index()) + call this%set_dim_indices(site_clscpf_r8, 2, this%levclscpf_index()) + end subroutine assemble_history_output_types ! =================================================================================== @@ -1487,6 +1499,20 @@ integer function levagefuel_index(this) class(fates_history_interface_type), intent(in) :: this levagefuel_index = this%levagefuel_index_ end function levagefuel_index + ! ====================================================================================== + + subroutine set_levclscpf_index(this, index) + implicit none + class(fates_history_interface_type), intent(inout) :: this + integer, intent(in) :: index + this%levclscpf_index_ = index + end subroutine set_levclscpf_index + + integer function levclscpf_index(this) + implicit none + class(fates_history_interface_type), intent(in) :: this + levclscpf_index = this%levclscpf_index_ + end function levclscpf_index ! ====================================================================================== @@ -1628,7 +1654,7 @@ subroutine init_dim_kinds_maps(this) use FatesIOVariableKindMod, only : site_can_r8, site_cnlf_r8, site_cnlfpft_r8 use FatesIOVariableKindMod, only : site_height_r8, site_agefuel_r8 use FatesIOVariableKindMod, only : site_elem_r8, site_elpft_r8 - use FatesIOVariableKindMod, only : site_elcwd_r8, site_elage_r8 + use FatesIOVariableKindMod, only : site_elcwd_r8, site_elage_r8, site_clscpf_r8 implicit none @@ -1738,140 +1764,226 @@ subroutine init_dim_kinds_maps(this) index = index + 1 call this%dim_kinds(index)%Init(site_agefuel_r8, 2) + ! site x age x fuel size class + index = index + 1 + call this%dim_kinds(index)%Init(site_clscpf_r8, 2) ! FIXME(bja, 2016-10) assert(index == fates_history_num_dim_kinds) end subroutine init_dim_kinds_maps - ! ======================================================================= - - subroutine update_history_nutrflux(this,csite,cpatch,ccohort) + ! ======================================================================= + + subroutine update_history_nutrflux(this,csite) - ! Update history diagnostics for nutrient fluxes. + ! Update history diagnostics for nutrient dynamics variables. ! This is a separate routine because we like to handle these ! things before patches are reshuffled during disturbance, and ! thus this is called immediately after PARTEH allocation ! These diagnostics must be zero'd at the beginning ! of the dynamics call (not here, because this is a ! being called at the cohort level) - + ! Arguments class(fates_history_interface_type) :: this type(ed_site_type), intent(in) :: csite - type(ed_patch_type), intent(in) :: cpatch - type(ed_cohort_type), intent(in) :: ccohort - ! locals + type(ed_patch_type), pointer :: cpatch + type(ed_cohort_type), pointer :: ccohort + integer :: iclscpf ! layer x size x pft class index integer :: iscpf ! Size x pft class index integer :: io_si ! site's global index in the history vector integer :: el ! element loop index + integer :: ft real(r8):: uconv ! combined unit conversion factor + + ! We use gpp and fineroot C for weighted averages + real(r8) :: gpp_clscpf(nclmax*numpft*nlevsclass) + real(r8) :: gpp_si + real(r8) :: fnrtc_clscpf(nclmax*numpft*nlevsclass) + real(r8) :: fnrtc_si + real(r8) :: fnrt_c - ! size class index - iscpf = ccohort%size_by_pft_class + associate( & + hio_ngrowlim_clscpf => this%hvars(ih_ngrowlim_clscpf)%r82d, & + hio_pgrowlim_clscpf => this%hvars(ih_pgrowlim_clscpf)%r82d, & + hio_l2fr_clscpf => this%hvars(ih_l2fr_clscpf)%r82d, & + hio_l2fr_si => this%hvars(ih_l2fr_si)%r81d, & + hio_recl2fr_canopy_pf => this%hvars(ih_recl2fr_canopy_pf)%r82d, & + hio_recl2fr_ustory_pf => this%hvars(ih_recl2fr_ustory_pf)%r82d ) + + gpp_clscpf(:) = 0._r8 + gpp_si = 0._r8 + fnrtc_clscpf(:) = 0._r8 + fnrtc_si = 0._r8 + + cpatch => csite%youngest_patch + do while(associated(cpatch)) - ! history site index - io_si = csite%h_gid + ccohort => cpatch%shortest + do while(associated(ccohort)) - ! unit conversion factor to get x/plant/day -> x/m2/sec - uconv = ccohort%n * ha_per_m2 * days_per_sec - - ! Loop over the different elements. - do el = 1, num_elements - - select case (element_list(el)) - case (carbon12_element) + ! If this is a new cohort, do not make diagnostics + if(ccohort%isnew) cycle + + ! size class index + iscpf = ccohort%size_by_pft_class - ! Excess carbon respired - this%hvars(ih_excess_resp_si)%r81d(io_si) = & - this%hvars(ih_excess_resp_si)%r81d(io_si) + & - ccohort%resp_excess*uconv - - ! Efflux/exudation - this%hvars(ih_cefflux_scpf)%r82d(io_si,iscpf) = & - this%hvars(ih_cefflux_scpf)%r82d(io_si,iscpf) + & - ccohort%daily_c_efflux*uconv - - this%hvars(ih_cefflux_si)%r81d(io_si) = & - this%hvars(ih_cefflux_si)%r81d(io_si)+ & - ccohort%daily_c_efflux*uconv + ! layer by size by pft index + iclscpf = get_layersizetype_class_index(ccohort%canopy_layer,ccohort%dbh,ccohort%pft) + + ! history site index + io_si = csite%h_gid + + ! unit conversion factor to get x/plant/day -> x/m2/sec + uconv = ccohort%n * ha_per_m2 * days_per_sec + + ! Growth Limitations + select case(ccohort%cnp_limiter) + case(2) ! Nitrogen + hio_ngrowlim_clscpf(io_si,iclscpf) = hio_ngrowlim_clscpf(io_si,iclscpf) + & + ccohort%n*ccohort%gpp_acc_hold + case(3) + hio_ngrowlim_clscpf(io_si,iclscpf) = hio_ngrowlim_clscpf(io_si,iclscpf) + & + ccohort%n*ccohort%gpp_acc_hold + end select + - case (nitrogen_element) - - ! Mineralized uptake of NH4, NO3 - fates_hist%hvars(ih_nh4uptake_scpf)%r82d(io_si,iscpf) = & - fates_hist%hvars(ih_nh4uptake_scpf)%r82d(io_si,iscpf) + & - ccohort%daily_nh4_uptake*uconv - - fates_hist%hvars(ih_no3uptake_scpf)%r82d(io_si,iscpf) = & - fates_hist%hvars(ih_no3uptake_scpf)%r82d(io_si,iscpf) + & - ccohort%daily_no3_uptake*uconv - - fates_hist%hvars(ih_nh4uptake_si)%r81d(io_si) = & - fates_hist%hvars(ih_nh4uptake_si)%r81d(io_si) + & - ccohort%daily_nh4_uptake*uconv - - fates_hist%hvars(ih_no3uptake_si)%r81d(io_si) = & - fates_hist%hvars(ih_no3uptake_si)%r81d(io_si) + & - ccohort%daily_no3_uptake*uconv - - ! Symbiotic Fixation - fates_hist%hvars(ih_nfix_si)%r81d(io_si) = & - fates_hist%hvars(ih_nfix_si)%r81d(io_si) + & - ccohort%daily_n_fixation*uconv - - fates_hist%hvars(ih_nfix_scpf)%r82d(io_si,iscpf) = & - fates_hist%hvars(ih_nfix_scpf)%r82d(io_si,iscpf) + & - ccohort%daily_n_fixation*uconv - - ! Efflux/exudation - this%hvars(ih_nefflux_scpf)%r82d(io_si,iscpf) = & - this%hvars(ih_nefflux_scpf)%r82d(io_si,iscpf) + & - ccohort%daily_n_efflux*uconv - - this%hvars(ih_nefflux_si)%r81d(io_si) = & - this%hvars(ih_nefflux_si)%r81d(io_si) + & - ccohort%daily_n_efflux*uconv - - ! Demand - this%hvars(ih_ndemand_scpf)%r82d(io_si,iscpf) = & - this%hvars(ih_ndemand_scpf)%r82d(io_si,iscpf) + & - ccohort%daily_n_demand*uconv - - this%hvars(ih_ndemand_si)%r81d(io_si) = & - this%hvars(ih_ndemand_si)%r81d(io_si) + & - ccohort%daily_n_demand*uconv - - case (phosphorus_element) - - fates_hist%hvars(ih_puptake_scpf)%r82d(io_si,iscpf) = & - fates_hist%hvars(ih_puptake_scpf)%r82d(io_si,iscpf) + & - ccohort%daily_p_uptake*uconv + fnrt_c = ccohort%prt%GetState(fnrt_organ, carbon12_element) + hio_l2fr_clscpf(io_si,iclscpf) = & + hio_l2fr_clscpf(io_si,iclscpf) + ccohort%n*fnrt_c*ccohort%l2fr - fates_hist%hvars(ih_puptake_si)%r81d(io_si) = & - fates_hist%hvars(ih_puptake_si)%r81d(io_si) + & - ccohort%daily_p_uptake*uconv + hio_l2fr_si(io_si) = hio_l2fr_si(io_si) + ccohort%n*fnrt_c*ccohort%l2fr + + ! These are used for normalizing weighted averages + gpp_si = gpp_si + ccohort%n*ccohort%gpp_acc_hold + gpp_clscpf(iclscpf) = gpp_clscpf(iclscpf) + ccohort%n*ccohort%gpp_acc_hold + fnrtc_clscpf(iclscpf) = fnrtc_clscpf(iclscpf) + ccohort%n*fnrt_c + fnrtc_si = fnrtc_si + ccohort%n*fnrt_c + + ! Loop over the different elements. + do el = 1, num_elements - this%hvars(ih_pefflux_scpf)%r82d(io_si,iscpf) = & - this%hvars(ih_pefflux_scpf)%r82d(io_si,iscpf) + & - ccohort%daily_p_efflux*uconv - - this%hvars(ih_pefflux_si)%r81d(io_si) = & - this%hvars(ih_pefflux_si)%r81d(io_si) + & - ccohort%daily_p_efflux*uconv + select case (element_list(el)) + case (carbon12_element) + + ! Excess carbon respired + this%hvars(ih_excess_resp_si)%r81d(io_si) = & + this%hvars(ih_excess_resp_si)%r81d(io_si) + & + ccohort%resp_excess*uconv + + case (nitrogen_element) + + ! Mineralized uptake of NH4, NO3 + fates_hist%hvars(ih_nh4uptake_scpf)%r82d(io_si,iscpf) = & + fates_hist%hvars(ih_nh4uptake_scpf)%r82d(io_si,iscpf) + & + ccohort%daily_nh4_uptake*uconv + + fates_hist%hvars(ih_no3uptake_scpf)%r82d(io_si,iscpf) = & + fates_hist%hvars(ih_no3uptake_scpf)%r82d(io_si,iscpf) + & + ccohort%daily_no3_uptake*uconv + + fates_hist%hvars(ih_nh4uptake_si)%r81d(io_si) = & + fates_hist%hvars(ih_nh4uptake_si)%r81d(io_si) + & + ccohort%daily_nh4_uptake*uconv + + fates_hist%hvars(ih_no3uptake_si)%r81d(io_si) = & + fates_hist%hvars(ih_no3uptake_si)%r81d(io_si) + & + ccohort%daily_no3_uptake*uconv + + ! Symbiotic Fixation + fates_hist%hvars(ih_nfix_si)%r81d(io_si) = & + fates_hist%hvars(ih_nfix_si)%r81d(io_si) + & + ccohort%daily_n_fixation*uconv + + fates_hist%hvars(ih_nfix_scpf)%r82d(io_si,iscpf) = & + fates_hist%hvars(ih_nfix_scpf)%r82d(io_si,iscpf) + & + ccohort%daily_n_fixation*uconv + + ! Efflux/exudation + this%hvars(ih_nefflux_scpf)%r82d(io_si,iscpf) = & + this%hvars(ih_nefflux_scpf)%r82d(io_si,iscpf) + & + ccohort%daily_n_efflux*uconv + + this%hvars(ih_nefflux_si)%r81d(io_si) = & + this%hvars(ih_nefflux_si)%r81d(io_si) + & + ccohort%daily_n_efflux*uconv + + ! Demand + this%hvars(ih_ndemand_scpf)%r82d(io_si,iscpf) = & + this%hvars(ih_ndemand_scpf)%r82d(io_si,iscpf) + & + ccohort%daily_n_demand*uconv + + this%hvars(ih_ndemand_si)%r81d(io_si) = & + this%hvars(ih_ndemand_si)%r81d(io_si) + & + ccohort%daily_n_demand*uconv + + case (phosphorus_element) + + fates_hist%hvars(ih_puptake_scpf)%r82d(io_si,iscpf) = & + fates_hist%hvars(ih_puptake_scpf)%r82d(io_si,iscpf) + & + ccohort%daily_p_uptake*uconv + + fates_hist%hvars(ih_puptake_si)%r81d(io_si) = & + fates_hist%hvars(ih_puptake_si)%r81d(io_si) + & + ccohort%daily_p_uptake*uconv + + this%hvars(ih_pefflux_scpf)%r82d(io_si,iscpf) = & + this%hvars(ih_pefflux_scpf)%r82d(io_si,iscpf) + & + ccohort%daily_p_efflux*uconv + + this%hvars(ih_pefflux_si)%r81d(io_si) = & + this%hvars(ih_pefflux_si)%r81d(io_si) + & + ccohort%daily_p_efflux*uconv + + this%hvars(ih_pdemand_scpf)%r82d(io_si,iscpf) = & + this%hvars(ih_pdemand_scpf)%r82d(io_si,iscpf) + & + ccohort%daily_p_demand*uconv + + this%hvars(ih_pdemand_si)%r81d(io_si) = & + ccohort%daily_p_demand*uconv + end select + end do + + ccohort => ccohort%taller + end do + + cpatch => cpatch%older + end do + + ! Normalize the layer x size x pft arrays + do iclscpf = 1,nclmax*numpft*nlevsclass + if(gpp_clscpf(iclscpf)>nearzero) then + hio_ngrowlim_clscpf(io_si,iclscpf) = hio_ngrowlim_clscpf(io_si,iclscpf) / gpp_clscpf(iclscpf) + hio_pgrowlim_clscpf(io_si,iclscpf) = hio_pgrowlim_clscpf(io_si,iclscpf) / gpp_clscpf(iclscpf) + else + hio_ngrowlim_clscpf(io_si,iclscpf) = hlm_hio_ignore_val + hio_pgrowlim_clscpf(io_si,iclscpf) = hlm_hio_ignore_val + end if + if(fnrtc_clscpf(iclscpf)>nearzero) then + hio_l2fr_clscpf(io_si,iclscpf) = hio_l2fr_clscpf(io_si,iclscpf) / fnrtc_clscpf(iclscpf) + else + hio_l2fr_clscpf(io_si,iclscpf) = hlm_hio_ignore_val + end if + end do + + do ft = 1,numpft + hio_recl2fr_canopy_pf(io_si,ft) = csite%rec_l2fr(ft,1) + hio_recl2fr_ustory_pf(io_si,ft) = csite%rec_l2fr(ft,2) + end do + + if(fnrtc_si>nearzero)then + hio_l2fr_si(io_si) = hio_l2fr_si(io_si)/fnrtc_si + else + hio_l2fr_si(io_si) = hlm_hio_ignore_val + end if + + + + end associate - this%hvars(ih_pdemand_scpf)%r82d(io_si,iscpf) = & - this%hvars(ih_pdemand_scpf)%r82d(io_si,iscpf) + & - ccohort%daily_p_demand*uconv - - this%hvars(ih_pdemand_si)%r81d(io_si) = & - ccohort%daily_p_demand*uconv - end select - end do return end subroutine update_history_nutrflux - - ! ==================================================================================== subroutine update_history_dyn(this,nc,nsites,sites,bc_in) @@ -1894,6 +2006,7 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) use FatesSizeAgeTypeIndicesMod, only : get_height_index use FatesSizeAgeTypeIndicesMod, only : sizetype_class_index use FatesSizeAgeTypeIndicesMod, only : coagetype_class_index + use EDTypesMod , only : nlevleaf use EDParamsMod , only : ED_val_history_height_bin_edges @@ -1969,8 +2082,6 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) real(r8) :: area_frac real(r8) :: crown_depth - real(r8) :: fnrtc_canopy_scpf(numpft*nlevsclass) - real(r8) :: fnrtc_understory_scpf(numpft*nlevsclass) real(r8) :: storen_canopy_scpf(numpft*nlevsclass) real(r8) :: storen_understory_scpf(numpft*nlevsclass) real(r8) :: storep_canopy_scpf(numpft*nlevsclass) @@ -1986,24 +2097,11 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) real(r8), parameter :: tiny = 1.e-5_r8 ! some small number real(r8), parameter :: reallytalltrees = 1000. ! some large number (m) - - ! Set this to true if you want the size-pft l2fr variables to - ! take a mean over the site, otherwise it just tracks the oldest patch - - logical, parameter :: do_site_l2fr_scpf = .false. - - - integer :: tmp associate( hio_npatches_si => this%hvars(ih_npatches_si)%r81d, & hio_ncohorts_si => this%hvars(ih_ncohorts_si)%r81d, & hio_trimming_si => this%hvars(ih_trimming_si)%r81d, & - hio_l2fr_si => this%hvars(ih_l2fr_si)%r81d, & - hio_recl2fr_canopy_pf => this%hvars(ih_recl2fr_canopy_pf)%r82d, & - hio_recl2fr_ustory_pf => this%hvars(ih_recl2fr_ustory_pf)%r82d, & - hio_l2fr_canopy_scpf => this%hvars(ih_l2fr_canopy_scpf)%r82d, & - hio_l2fr_understory_scpf => this%hvars(ih_l2fr_understory_scpf)%r82d, & hio_area_plant_si => this%hvars(ih_area_plant_si)%r81d, & hio_area_trees_si => this%hvars(ih_area_trees_si)%r81d, & hio_canopy_spread_si => this%hvars(ih_canopy_spread_si)%r81d, & @@ -2246,8 +2344,6 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) model_day_int = nint(hlm_model_day) - - ! --------------------------------------------------------------------------------- @@ -2258,9 +2354,7 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) io_si = sites(s)%h_gid - ! These are weighting factors used for calculating l2fr_scpf - fnrtc_canopy_scpf(:) = 0._r8 - fnrtc_understory_scpf(:) = 0._r8 + ! These are weighting factors storen_canopy_scpf(:) = 0._r8 storen_understory_scpf(:) = 0._r8 storep_canopy_scpf(:) = 0._r8 @@ -2277,11 +2371,6 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) sites(s)%mass_balance(element_pos(carbon12_element))%burn_flux_to_atm * & ha_per_m2 * days_per_sec - do ft = 1,numpft - hio_recl2fr_canopy_pf(io_si,ft) = sites(s)%rec_l2fr(ft,1) - hio_recl2fr_ustory_pf(io_si,ft) = sites(s)%rec_l2fr(ft,2) - end do - do el = 1, num_elements ! Total model error [kg/day -> kg/s] (all elements) @@ -2553,23 +2642,6 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) this%hvars(ih_totvegc_si)%r81d(io_si)+ ccohort%n * & total_m / m2_per_ha - - ! These L2FR diagnostics are weighted by fineroot carbon biomass - hio_l2fr_si(io_si) = hio_l2fr_si(io_si) + ccohort%n*fnrt_m/m2_per_ha*ccohort%l2fr - - - ! Constrain L2FR to oldest patch? - if(do_site_l2fr_scpf .or. associated(cpatch,sites(s)%oldest_patch)) then - if (ccohort%canopy_layer .eq. 1) then - hio_l2fr_canopy_scpf(io_si,i_scpf) = & - hio_l2fr_canopy_scpf(io_si,i_scpf) + ccohort%n*fnrt_m *ccohort%l2fr - fnrtc_canopy_scpf(i_scpf) = fnrtc_canopy_scpf(i_scpf) + ccohort%n*fnrt_m - else - hio_l2fr_understory_scpf(io_si,i_scpf) = & - hio_l2fr_understory_scpf(io_si,i_scpf) + ccohort%n*fnrt_m*ccohort%l2fr - fnrtc_understory_scpf(i_scpf) = fnrtc_understory_scpf(i_scpf) + ccohort%n*fnrt_m - end if - end if call bstore_allom(ccohort%dbh,ccohort%pft,ccohort%canopy_trim, store_max) this%hvars(ih_storectfrac_si)%r81d(io_si) = & @@ -3215,12 +3287,6 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) cpatch => cpatch%younger end do patchloop !patch loop - ! Normalize the l2fr value by total biomass - if(this%hvars(ih_fnrtc_si)%r81d(io_si)>nearzero)then - hio_l2fr_si(io_si) = hio_l2fr_si(io_si)/this%hvars(ih_fnrtc_si)%r81d(io_si) - end if - !!hio_l2fr_ema_si(io_si) = hio_l2fr_ema_si(io_si)/this%hvars(ih_fnrtc_si)%r81d(io_si) - ! divide so-far-just-summed but to-be-averaged patch-age-class variables by patch-age-class area to get mean values do ipa2 = 1, nlevage @@ -3456,8 +3522,6 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) this%hvars(ih_storec_scpf)%r82d(io_si,:) = 0._r8 this%hvars(ih_reproc_scpf)%r82d(io_si,:) = 0._r8 - - elseif(element_list(el).eq.nitrogen_element)then this%hvars(ih_totvegn_scpf)%r82d(io_si,:) = 0._r8 @@ -3466,8 +3530,6 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) this%hvars(ih_sapwn_scpf)%r82d(io_si,:) = 0._r8 this%hvars(ih_storen_scpf)%r82d(io_si,:) = 0._r8 this%hvars(ih_repron_scpf)%r82d(io_si,:) = 0._r8 - - elseif(element_list(el).eq.phosphorus_element)then this%hvars(ih_totvegp_scpf)%r82d(io_si,:) = 0._r8 @@ -3635,14 +3697,6 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) do i_pft = 1, numpft do i_scls = 1,nlevsclass i_scpf = (i_pft-1)*nlevsclass + i_scls - if(fnrtc_canopy_scpf(i_scpf)>nearzero)then - hio_l2fr_canopy_scpf(io_si,i_scpf) = & - hio_l2fr_canopy_scpf(io_si,i_scpf)/fnrtc_canopy_scpf(i_scpf) - end if - if(fnrtc_understory_scpf(i_scpf)>nearzero)then - hio_l2fr_understory_scpf(io_si,i_scpf) = & - hio_l2fr_understory_scpf(io_si,i_scpf)/fnrtc_understory_scpf(i_scpf) - end if if( this%hvars(ih_storectfrac_canopy_scpf)%r82d(io_si,i_scpf)>nearzero ) then this%hvars(ih_storectfrac_canopy_scpf)%r82d(io_si,i_scpf) = & @@ -4591,7 +4645,7 @@ subroutine define_history_vars(this, initialize_variables) use FatesIOVariableKindMod, only : site_fuel_r8, site_cwdsc_r8, site_scag_r8 use FatesIOVariableKindMod, only : site_can_r8, site_cnlf_r8, site_cnlfpft_r8 use FatesIOVariableKindMod, only : site_scagpft_r8, site_agepft_r8 - use FatesIOVariableKindMod, only : site_elem_r8, site_elpft_r8 + use FatesIOVariableKindMod, only : site_elem_r8, site_elpft_r8, site_clscpf_r8 use FatesIOVariableKindMod, only : site_elcwd_r8, site_elage_r8 @@ -4626,15 +4680,11 @@ subroutine define_history_vars(this, initialize_variables) ! patch age x pft (site_agepft_r8) : APPF ! canopy layer x leaf layer (site_cnlf_r8) : CLLL ! canopy layer x leaf layer x pft (site_cnlfpft_r8) : CLLLPF - ! canopy layer x pft (site_clpf_r8) : CLPF ! element x cwd size (site_elcwd_r8) : ELDC ! cohort size x patch age (site_scag_r8) : SZAP ! cohort size x patch age x pft (site_scagpft_r8) : SZAPPF ! cohort size x pft (site_size_pft_r8) : SZPF - - - - + ! canopy layer x size x pft (site_clscpf_r8) : CLSZPF ! Site level counting variables @@ -4650,42 +4700,15 @@ subroutine define_history_vars(this, initialize_variables) upfreq=1, ivar=ivar, initialize=initialize_variables, & index=ih_ncohorts_si) - ! Patch variables call this%set_history_var(vname='FATES_TRIMMING', units='1', & long='degree to which canopy expansion is limited by leaf economics (0-1)', & use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & upfreq=1, ivar=ivar, initialize=initialize_variables, & index=ih_trimming_si) - call this%set_history_var(vname='FATES_L2FR', units='kg kg-1', & - long='The leaf to fineroot biomass multiplier for target allometry', & - use_default='active', & - avgflag='A', vtype=site_r8, hlms='CLM:ALM', upfreq=1, & - ivar=ivar, initialize=initialize_variables, index = ih_l2fr_si) - - call this%set_history_var(vname='FATES_RECL2FR_CANOPY_PF', units='kg kg-1', & - long='The leaf to fineroot biomass multiplier for recruits (canopy)', & - use_default='active', & - avgflag='A', vtype=site_pft_r8, hlms='CLM:ALM', upfreq=1, & - ivar=ivar, initialize=initialize_variables, index = ih_recl2fr_canopy_pf) - call this%set_history_var(vname='FATES_RECL2FR_USTORY_PF', units='kg kg-1', & - long='The leaf to fineroot biomass multiplier for recruits (understory)', & - use_default='active', & - avgflag='A', vtype=site_pft_r8, hlms='CLM:ALM', upfreq=1, & - ivar=ivar, initialize=initialize_variables, index = ih_recl2fr_ustory_pf) - - call this%set_history_var(vname='FATES_L2FR_CANOPY_SZPF', units='kg kg-1', & - long='The leaf to fineroot biomass multiplier for target allometry in canopy plants', & - use_default='active', & - avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', upfreq=1, & - ivar=ivar, initialize=initialize_variables, index = ih_l2fr_canopy_scpf) + - call this%set_history_var(vname='FATES_L2FR_USTORY_SZPF', units='kg kg-1', & - long='The leaf to fineroot biomass multiplier for target allometry in understory plants', & - use_default='active', & - avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', upfreq=1, & - ivar=ivar, initialize=initialize_variables, index = ih_l2fr_understory_scpf) call this%set_history_var(vname='FATES_AREA_PLANTS', units='m2 m-2', & long='area occupied by all plants per m2 land area', use_default='active', & @@ -5188,13 +5211,111 @@ subroutine define_history_vars(this, initialize_variables) upfreq=1, ivar=ivar, initialize=initialize_variables, & index = ih_reproc_si) - call this%set_history_var(vname='FATES_CEFFLUX', units='kg m-2 s-1', & - long='carbon efflux, root to soil, in kg carbon per m2 per second', & - use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & - upfreq=5, ivar=ivar, initialize=initialize_variables, & - index = ih_cefflux_si) + ! Output specific to the chemical species dynamics used (parteh) + select case(hlm_parteh_mode) + case (prt_cnp_flex_allom_hyp) + + call this%set_history_var(vname='FATES_L2FR', units='kg kg-1', & + long='The leaf to fineroot biomass multiplier for target allometry', & + use_default='active', & + avgflag='A', vtype=site_r8, hlms='CLM:ALM', upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_l2fr_si) + + call this%set_history_var(vname='FATES_RECL2FR_CANOPY_PF', units='kg kg-1', & + long='The leaf to fineroot biomass multiplier for recruits (canopy)', & + use_default='active', & + avgflag='A', vtype=site_pft_r8, hlms='CLM:ALM', upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_recl2fr_canopy_pf) + + call this%set_history_var(vname='FATES_RECL2FR_USTORY_PF', units='kg kg-1', & + long='The leaf to fineroot biomass multiplier for recruits (understory)', & + use_default='active', & + avgflag='A', vtype=site_pft_r8, hlms='CLM:ALM', upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_recl2fr_ustory_pf) + + call this%set_history_var(vname='FATES_NGROWLIM_CLSZPF', units='', & + long='The fraction of gpp*days where stature growth is limited by N (vs C or P)', & + use_default='inactive', & + avgflag='A', vtype=site_clscpf_r8, hlms='CLM:ALM', upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_ngrowlim_clscpf) + + call this%set_history_var(vname='FATES_PGROWLIM_CLSZPF', units='', & + long='The fraction of gpp*days where stature growth is limited by P (vs N or C) (canopy)', & + use_default='inactive', & + avgflag='A', vtype=site_clscpf_r8, hlms='CLM:ALM', upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_pgrowlim_clscpf) + + call this%set_history_var(vname='FATES_L2FR_CLSZPF', units='kg kg-1', & + long='The leaf to fineroot biomass multiplier for target allometry', & + use_default='inactive', & + avgflag='A', vtype=site_clscpf_r8, hlms='CLM:ALM', upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_l2fr_clscpf) + call this%set_history_var(vname='FATES_NH4UPTAKE_SZPF', & + units='kg m-2 s-1', & + long='ammonium uptake rate by plants by size-class x pft in kg NH4 per m2 per second', & + use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & + hlms='CLM:ALM', upfreq=5, ivar=ivar, & + initialize=initialize_variables, index = ih_nh4uptake_scpf) + + call this%set_history_var(vname='FATES_NO3UPTAKE_SZPF', & + units='kg m-2 s-1', & + long='nitrate uptake rate by plants by size-class x pft in kg NO3 per m2 per second', & + use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & + hlms='CLM:ALM', upfreq=5, ivar=ivar, & + initialize=initialize_variables, index = ih_no3uptake_scpf) + + call this%set_history_var(vname='FATES_NEFFLUX_SZPF', units='kg m-2 s-1', & + long='nitrogen efflux, root to soil, by size-class x pft in kg N per m2 per second', & + use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & + hlms='CLM:ALM', upfreq=5, ivar=ivar, & + initialize=initialize_variables, index = ih_nefflux_scpf) + call this%set_history_var(vname='FATES_NDEMAND_SZPF', units='kg m-2 s-1', & + long='plant N need (algorithm dependent), by size-class x pft in kg N per m2 per second', & + use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & + hlms='CLM:ALM', upfreq=5, ivar=ivar, & + initialize=initialize_variables, index = ih_ndemand_scpf) + + call this%set_history_var(vname='FATES_SYMNFIX_SZPF', units='kg m-2 s-1', & + long='symbiotic dinitrogen fixation, by size-class x pft in kg N per m2 per second', & + use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & + hlms='CLM:ALM', upfreq=5, ivar=ivar, & + initialize=initialize_variables, index = ih_nfix_scpf) + + + call this%set_history_var(vname='FATES_NH4UPTAKE', units='kg m-2 s-1', & + long='ammonium uptake rate by plants in kg NH4 per m2 per second', & + use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & + upfreq=5, ivar=ivar, initialize=initialize_variables, & + index = ih_nh4uptake_si) + + call this%set_history_var(vname='FATES_NO3UPTAKE', units='kg m-2 s-1', & + long='nitrate uptake rate by plants in kg NO3 per m2 per second', & + use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & + upfreq=5, ivar=ivar, initialize=initialize_variables, & + index = ih_no3uptake_si) + + call this%set_history_var(vname='FATES_NEFFLUX', units='kg m-2 s-1', & + long='nitrogen effluxed from plant in kg N per m2 per second (unused)', & + use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & + upfreq=5, ivar=ivar, initialize=initialize_variables, & + index = ih_nefflux_si) + + call this%set_history_var(vname='FATES_NDEMAND', units='kg m-2 s-1', & + long='plant nitrogen need (algorithm dependent) in kg N per m2 per second', & + use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & + upfreq=5, ivar=ivar, initialize=initialize_variables, & + index = ih_ndemand_si) + + call this%set_history_var(vname='FATES_SYMNFIX', units='kg m-2 s-1', & + long='symbiotic dinitrogen fixation in kg N per m2 per second', & + use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & + upfreq=5, ivar=ivar, initialize=initialize_variables, & + index = ih_nfix_si) + + end select + nitrogen_active_if: if(any(element_list(:)==nitrogen_element)) then call this%set_history_var(vname='FATES_STOREN', units='kg m-2', & long='total nitrogen in live plant storage', use_default='active', & @@ -5233,35 +5354,58 @@ subroutine define_history_vars(this, initialize_variables) upfreq=1, ivar=ivar, initialize=initialize_variables, & index = ih_repron_si) - call this%set_history_var(vname='FATES_NH4UPTAKE', units='kg m-2 s-1', & - long='ammonium uptake rate by plants in kg NH4 per m2 per second', & - use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & - upfreq=5, ivar=ivar, initialize=initialize_variables, & - index = ih_nh4uptake_si) + call this%set_history_var(vname='FATES_VEGN_SZPF', units='kg m-2', & + long='total (live) vegetation nitrogen mass by size-class x pft in kg N per m2', & + use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & + hlms='CLM:ALM', upfreq=1, ivar=ivar, & + initialize=initialize_variables, index = ih_totvegn_scpf) - call this%set_history_var(vname='FATES_NO3UPTAKE', units='kg m-2 s-1', & - long='nitrate uptake rate by plants in kg NO3 per m2 per second', & - use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & - upfreq=5, ivar=ivar, initialize=initialize_variables, & - index = ih_no3uptake_si) + call this%set_history_var(vname='FATES_LEAFN_SZPF', units='kg m-2', & + long='leaf nitrogen mass by size-class x pft in kg N per m2', & + use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & + hlms='CLM:ALM', upfreq=1, ivar=ivar, & + initialize=initialize_variables, index = ih_leafn_scpf) - call this%set_history_var(vname='FATES_NEFFLUX', units='kg m-2 s-1', & - long='nitrogen effluxed from plant in kg N per m2 per second (unused)', & - use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & - upfreq=5, ivar=ivar, initialize=initialize_variables, & - index = ih_nefflux_si) + call this%set_history_var(vname='FATES_FROOTN_SZPF', units='kg m-2', & + long='fine-root nitrogen mass by size-class x pft in kg N per m2', & + use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & + hlms='CLM:ALM', upfreq=1, ivar=ivar, & + initialize=initialize_variables, index = ih_fnrtn_scpf) - call this%set_history_var(vname='FATES_NDEMAND', units='kg m-2 s-1', & - long='plant nitrogen need (algorithm dependent) in kg N per m2 per second', & - use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & - upfreq=5, ivar=ivar, initialize=initialize_variables, & - index = ih_ndemand_si) + call this%set_history_var(vname='FATES_SAPWOODN_SZPF', units='kg m-2', & + long='sapwood nitrogen mass by size-class x pft in kg N per m2', & + use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & + hlms='CLM:ALM', upfreq=1, ivar=ivar, & + initialize=initialize_variables, index = ih_sapwn_scpf) - call this%set_history_var(vname='FATES_SYMNFIX', units='kg m-2 s-1', & - long='symbiotic dinitrogen fixation in kg N per m2 per second', & - use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & - upfreq=5, ivar=ivar, initialize=initialize_variables, & - index = ih_nfix_si) + call this%set_history_var(vname='FATES_STOREN_SZPF', units='kg m-2', & + long='storage nitrogen mass by size-class x pft in kg N per m2', & + use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & + hlms='CLM:ALM', upfreq=1, ivar=ivar, & + initialize=initialize_variables, index = ih_storen_scpf) + + call this%set_history_var(vname='FATES_STOREN_TFRAC_CANOPY_SZPF', & + units='1', & + long='storage nitrogen fraction (0-1) of target, in canopy, by size-class x pft', & + use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & + hlms='CLM:ALM', upfreq=1, ivar=ivar, & + initialize=initialize_variables, index = ih_storentfrac_canopy_scpf) + + call this%set_history_var(vname='FATES_STOREN_TFRAC_USTORY_SZPF', & + units='1', & + long='storage nitrogen fraction (0-1) of target, in understory, by size-class x pft', & + use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & + hlms='CLM:ALM', upfreq=1, ivar=ivar, & + initialize=initialize_variables, & + index = ih_storentfrac_understory_scpf) + + call this%set_history_var(vname='FATES_REPRON_SZPF', units='kg m-2', & + long='reproductive nitrogen mass (on plant) by size-class x pft in kg N per m2', & + use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & + hlms='CLM:ALM', upfreq=1, ivar=ivar, & + initialize=initialize_variables, index = ih_repron_scpf) + + end if nitrogen_active_if @@ -6885,98 +7029,13 @@ subroutine define_history_vars(this, initialize_variables) hlms='CLM:ALM', upfreq=1, ivar=ivar, initialize=initialize_variables, & index = ih_reproc_scpf) - call this%set_history_var(vname='FATES_CEFFLUX_SZPF', units='kg m-2 s-1', & - long='carbon efflux, root to soil, by size-class x pft in kg carbon per m2 per second', & - use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & - hlms='CLM:ALM', upfreq=5, ivar=ivar, initialize=initialize_variables, & - index = ih_cefflux_scpf) - ! NITROGEN nitrogen_active_if2: if(any(element_list(:)==nitrogen_element)) then - call this%set_history_var(vname='FATES_VEGN_SZPF', units='kg m-2', & - long='total (live) vegetation nitrogen mass by size-class x pft in kg N per m2', & - use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & - hlms='CLM:ALM', upfreq=1, ivar=ivar, & - initialize=initialize_variables, index = ih_totvegn_scpf) - - call this%set_history_var(vname='FATES_LEAFN_SZPF', units='kg m-2', & - long='leaf nitrogen mass by size-class x pft in kg N per m2', & - use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & - hlms='CLM:ALM', upfreq=1, ivar=ivar, & - initialize=initialize_variables, index = ih_leafn_scpf) - - call this%set_history_var(vname='FATES_FROOTN_SZPF', units='kg m-2', & - long='fine-root nitrogen mass by size-class x pft in kg N per m2', & - use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & - hlms='CLM:ALM', upfreq=1, ivar=ivar, & - initialize=initialize_variables, index = ih_fnrtn_scpf) - call this%set_history_var(vname='FATES_SAPWOODN_SZPF', units='kg m-2', & - long='sapwood nitrogen mass by size-class x pft in kg N per m2', & - use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & - hlms='CLM:ALM', upfreq=1, ivar=ivar, & - initialize=initialize_variables, index = ih_sapwn_scpf) - call this%set_history_var(vname='FATES_STOREN_SZPF', units='kg m-2', & - long='storage nitrogen mass by size-class x pft in kg N per m2', & - use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & - hlms='CLM:ALM', upfreq=1, ivar=ivar, & - initialize=initialize_variables, index = ih_storen_scpf) - - call this%set_history_var(vname='FATES_STOREN_TFRAC_CANOPY_SZPF', & - units='1', & - long='storage nitrogen fraction (0-1) of target, in canopy, by size-class x pft', & - use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & - hlms='CLM:ALM', upfreq=1, ivar=ivar, & - initialize=initialize_variables, index = ih_storentfrac_canopy_scpf) - - call this%set_history_var(vname='FATES_STOREN_TFRAC_USTORY_SZPF', & - units='1', & - long='storage nitrogen fraction (0-1) of target, in understory, by size-class x pft', & - use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & - hlms='CLM:ALM', upfreq=1, ivar=ivar, & - initialize=initialize_variables, & - index = ih_storentfrac_understory_scpf) - - call this%set_history_var(vname='FATES_REPRON_SZPF', units='kg m-2', & - long='reproductive nitrogen mass (on plant) by size-class x pft in kg N per m2', & - use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & - hlms='CLM:ALM', upfreq=1, ivar=ivar, & - initialize=initialize_variables, index = ih_repron_scpf) - - call this%set_history_var(vname='FATES_NH4UPTAKE_SZPF', & - units='kg m-2 s-1', & - long='ammonium uptake rate by plants by size-class x pft in kg NH4 per m2 per second', & - use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & - hlms='CLM:ALM', upfreq=5, ivar=ivar, & - initialize=initialize_variables, index = ih_nh4uptake_scpf) - - call this%set_history_var(vname='FATES_NO3UPTAKE_SZPF', & - units='kg m-2 s-1', & - long='nitrate uptake rate by plants by size-class x pft in kg NO3 per m2 per second', & - use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & - hlms='CLM:ALM', upfreq=5, ivar=ivar, & - initialize=initialize_variables, index = ih_no3uptake_scpf) - - call this%set_history_var(vname='FATES_NEFFLUX_SZPF', units='kg m-2 s-1', & - long='nitrogen efflux, root to soil, by size-class x pft in kg N per m2 per second', & - use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & - hlms='CLM:ALM', upfreq=5, ivar=ivar, & - initialize=initialize_variables, index = ih_nefflux_scpf) - - call this%set_history_var(vname='FATES_NDEMAND_SZPF', units='kg m-2 s-1', & - long='plant N need (algorithm dependent), by size-class x pft in kg N per m2 per second', & - use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & - hlms='CLM:ALM', upfreq=5, ivar=ivar, & - initialize=initialize_variables, index = ih_ndemand_scpf) - - call this%set_history_var(vname='FATES_SYMNFIX_SZPF', units='kg m-2 s-1', & - long='symbiotic dinitrogen fixation, by size-class x pft in kg N per m2 per second', & - use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & - hlms='CLM:ALM', upfreq=5, ivar=ivar, & - initialize=initialize_variables, index = ih_nfix_scpf) + end if nitrogen_active_if2 diff --git a/main/FatesHistoryVariableType.F90 b/main/FatesHistoryVariableType.F90 index 6457e644f1..e5331dcbcf 100644 --- a/main/FatesHistoryVariableType.F90 +++ b/main/FatesHistoryVariableType.F90 @@ -14,7 +14,7 @@ module FatesHistoryVariableType use FatesIOVariableKindMod, only : site_can_r8, site_cnlf_r8, site_cnlfpft_r8 use FatesIOVariableKindMod, only : site_elem_r8, site_elpft_r8 use FatesIOVariableKindMod, only : site_elcwd_r8, site_elage_r8 - use FatesIOVariableKindMod, only : iotype_index, site_agefuel_r8 + use FatesIOVariableKindMod, only : iotype_index, site_agefuel_r8, site_clscpf_r8 implicit none private ! By default everything is private @@ -205,6 +205,10 @@ subroutine Init(this, vname, units, long, use_default, & allocate(this%r82d(lb1:ub1, lb2:ub2)) this%r82d(:,:) = flushval + case(site_clscpf_r8) + allocate(this%r82d(lb1:ub1, lb2:ub2)) + this%r82d(:,:) = flushval + case default write(fates_log(),*) 'Incompatible vtype passed to set_history_var' write(fates_log(),*) 'vtype = ',trim(vtype),' ?' @@ -334,6 +338,8 @@ subroutine Flush(this, thread, dim_bounds, dim_kinds) this%r82d(lb1:ub1, lb2:ub2) = this%flushval case(site_agefuel_r8) this%r82d(lb1:ub1, lb2:ub2) = this%flushval + case(site_clscpf_r8) + this%r82d(lb1:ub1, lb2:ub2) = this%flushval case default write(fates_log(),*) 'fates history variable type undefined while flushing history variables' stop diff --git a/main/FatesIODimensionsMod.F90 b/main/FatesIODimensionsMod.F90 index 522da97653..8707313dbc 100644 --- a/main/FatesIODimensionsMod.F90 +++ b/main/FatesIODimensionsMod.F90 @@ -28,7 +28,7 @@ module FatesIODimensionsMod character(*), parameter, public :: levcnlf = 'fates_levcnlf' ! matches histFileMod character(*), parameter, public :: levcnlfpft = 'fates_levcnlfpf' ! matches histFileMod character(*), parameter, public :: levagefuel = 'fates_levagefuel' ! matches histFileMod - + character(*), parameter, public :: levclscpf = 'fates_levclscpf' character(*), parameter, public :: levelem = 'fates_levelem' character(*), parameter, public :: levelpft = 'fates_levelpft' character(*), parameter, public :: levelcwd = 'fates_levelcwd' @@ -93,6 +93,8 @@ module FatesIODimensionsMod ! levagefuel = This is a strcture that records the boundaries for the ! number of patch age x fuel size class + ! levclscpf = '' number of canopy layers x pft x size class + ! levelem = This records the boundaries for the number of elements ! levelpft = This records the boundaries for elements x pft ! levelcwd = This records the boundaries for element x cwd @@ -148,6 +150,8 @@ module FatesIODimensionsMod integer :: elage_end integer :: agefuel_begin integer :: agefuel_end + integer :: clscpf_begin + integer :: clscpf_end end type fates_bounds_type diff --git a/main/FatesIOVariableKindMod.F90 b/main/FatesIOVariableKindMod.F90 index 93b34ebab3..9981ae0285 100644 --- a/main/FatesIOVariableKindMod.F90 +++ b/main/FatesIOVariableKindMod.F90 @@ -35,7 +35,8 @@ module FatesIOVariableKindMod character(*), parameter, public :: site_scagpft_r8 = 'SI_SCAGPFT_R8' character(*), parameter, public :: site_agepft_r8 = 'SI_AGEPFT_R8' character(*), parameter, public :: site_agefuel_r8 = 'SI_AGEFUEL_R8' - + character(*), parameter, public :: site_clscpf_r8 = 'SI_CLSCPF_R8' + ! Element, and multiplexed element dimensions character(*), parameter, public :: site_elem_r8 = 'SI_ELEM_R8' character(*), parameter, public :: site_elpft_r8 = 'SI_ELEMPFT_R8' diff --git a/main/FatesSizeAgeTypeIndicesMod.F90 b/main/FatesSizeAgeTypeIndicesMod.F90 index d624db1e24..307bc31c94 100644 --- a/main/FatesSizeAgeTypeIndicesMod.F90 +++ b/main/FatesSizeAgeTypeIndicesMod.F90 @@ -5,6 +5,7 @@ module FatesSizeAgeTypeIndicesMod use FatesInterfaceTypesMod, only : nlevage use FatesInterfaceTypesMod, only : nlevheight use FatesInterfaceTypesMod, only : nlevcoage + use EDTypesMod, only : nclmax use EDParamsMod, only : ED_val_history_sizeclass_bin_edges use EDParamsMod, only : ED_val_history_ageclass_bin_edges use EDParamsMod, only : ED_val_history_height_bin_edges @@ -24,7 +25,8 @@ module FatesSizeAgeTypeIndicesMod public :: coagetype_class_index public :: get_coage_class_index public :: get_agefuel_class_index - + public :: get_layersizetype_class_index + contains ! ===================================================================================== @@ -41,6 +43,32 @@ end function get_age_class_index ! ===================================================================================== + function get_layersizetype_class_index(layer,dbh,pft) result(iclscpf) + + ! Get the 1D index for a canopy layer x size x pft triplet + + ! Arguments + integer,intent(in) :: layer + real(r8),intent(in) :: dbh + integer,intent(in) :: pft + + integer :: size_class + integer :: iclscpf + + size_class = get_size_class_index(dbh) + + iclscpf = (pft-1)*nlevsclass*nclmax + (size_class-1)*nclmax + layer + + ! FOR ANALYSIS CODE, REVERSE: (assuming indices starting at 1): + + ! pft = ceiling(real(index,r8)/real(nlevsclass*nclmax,r8)) + ! size_class = ceiling(real(index-(pft-1)*nlevsclass*nclmax,r8)/real(nclmax,r8)) + ! layer = index - ((pft-1)*nlevsclass*nclmax + (size_class-1)*nclmax) + + end function get_layersizetype_class_index + + ! ===================================================================================== + function get_sizeage_class_index(dbh,age) result(size_by_age_class) ! Arguments diff --git a/parteh/PRTAllometricCNPMod.F90 b/parteh/PRTAllometricCNPMod.F90 index 6a6b71bda2..7b8a687985 100644 --- a/parteh/PRTAllometricCNPMod.F90 +++ b/parteh/PRTAllometricCNPMod.F90 @@ -691,6 +691,7 @@ subroutine CNPAdjustFRootTargets(this, target_c, target_dcdd) real(r8), pointer :: pc_store real(r8), parameter :: max_l2fr_cgain_frac = 0.99_r8 + real(r8), parameter :: xc_ratio_correction = 1.2_r8 real(r8), parameter :: wgt = 1._r8/10._r8 ! 10-day smoothing @@ -719,7 +720,7 @@ subroutine CNPAdjustFRootTargets(this, target_c, target_dcdd) store_nut_act = this%GetState(store_organ, nitrogen_element) + & this%bc_inout(acnp_bc_inout_id_netdn)%rval - n_ratio = min(50.0_r8,max(0.02_r8,(store_nut_act/store_nut_max)/(store_c_act/store_c_max))) + n_ratio = xc_ratio_correction*min(50.0_r8,max(0.02_r8,(store_nut_act/store_nut_max)/(store_c_act/store_c_max))) nc_store = wgt*log(n_ratio) + (1._r8-wgt)*nc_store @@ -733,7 +734,7 @@ subroutine CNPAdjustFRootTargets(this, target_c, target_dcdd) store_nut_max = this%GetNutrientTarget(phosphorus_element,store_organ,stoich_growth_min) store_nut_act = this%GetState(store_organ, phosphorus_element) + this%bc_inout(acnp_bc_inout_id_netdp)%rval - p_ratio = min(50.0_r8,max(0.02_r8,(store_nut_act/store_nut_max)/(store_c_act/store_c_max))) + p_ratio = xc_ratio_correction*min(50.0_r8,max(0.02_r8,(store_nut_act/store_nut_max)/(store_c_act/store_c_max))) pc_store = wgt*log(p_ratio) + (1._r8-wgt)*pc_store diff --git a/parteh/PRTGenericMod.F90 b/parteh/PRTGenericMod.F90 index f3e995f18a..40cc75898e 100644 --- a/parteh/PRTGenericMod.F90 +++ b/parteh/PRTGenericMod.F90 @@ -67,8 +67,7 @@ module PRTGenericMod ! ------------------------------------------------------------------------------------- integer, parameter, public :: prt_carbon_allom_hyp = 1 - integer, parameter, public :: prt_cnp_flex_allom_hyp = 2 ! Still under development - + integer, parameter, public :: prt_cnp_flex_allom_hyp = 2 ! ------------------------------------------------------------------------------------- ! Organ types From 434c0e0b0b5894923f59875c2c6860ff540c8b52 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Mon, 8 Aug 2022 13:05:40 -0400 Subject: [PATCH 27/55] Added in CNP limiter logic --- biogeochem/EDCohortDynamicsMod.F90 | 4 +- parteh/PRTAllometricCNPMod.F90 | 196 +++++++++++++++++++++++++---- 2 files changed, 174 insertions(+), 26 deletions(-) diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index e671d8982e..67dde74f5c 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -252,8 +252,8 @@ subroutine create_cohort(currentSite, patchptr, pft, nn, hite, coage, dbh, & new_cohort%l2fr = prt_params%allom_l2fr(pft) - new_cohort%nc_store = 1._r8 ! Assume balanced N/C stores - new_cohort%pc_store = 1._r8 ! Assume balanced P/C stores + new_cohort%nc_store = 0._r8 ! Assume balanced N/C stores ie log(1) = 0 + new_cohort%pc_store = 0._r8 ! Assume balanced P/C stores ie log(1) = 0 ! This sets things like vcmax25top, that depend on the ! leaf age fractions (which are defined by PARTEH) diff --git a/parteh/PRTAllometricCNPMod.F90 b/parteh/PRTAllometricCNPMod.F90 index 7b8a687985..6c1d966125 100644 --- a/parteh/PRTAllometricCNPMod.F90 +++ b/parteh/PRTAllometricCNPMod.F90 @@ -131,6 +131,10 @@ module PRTAllometricCNPMod integer, parameter :: num_intgr_vars = 7 + integer, parameter :: cnp_limited = 0 + integer, parameter :: c_limited = 1 + integer, parameter :: n_limited = 2 + integer, parameter :: p_limited = 3 ! ------------------------------------------------------------------------------------- ! Input/Output Boundary Indices (These are public, and therefore @@ -361,7 +365,7 @@ subroutine DailyPRTAllometricCNP(this) real(r8) :: agw_c_target,agw_dcdd_target real(r8) :: bgw_c_target,bgw_dcdd_target real(r8) :: sapw_area - real(r8) :: store_c_flux + real(r8) :: store_flux integer :: i ! generic organ loop index integer :: i_org ! organ index integer :: i_var ! variable index @@ -378,6 +382,10 @@ subroutine DailyPRTAllometricCNP(this) real(r8) :: p_gain0 real(r8) :: resp_excess0 + real(r8) :: c_alloc_nso ! Allocated C not including changes in storage overflow + real(r8) :: n_alloc_nso ! Allocated N not including changes in storage overflow + real(r8) :: p_alloc_nso ! Allocated P not including changes in storage overflow + ! Used for mass checking, total mass allocated based ! on change in the states, should match gain0's real(r8) :: allocated_c @@ -387,6 +395,8 @@ subroutine DailyPRTAllometricCNP(this) real(r8) :: sum_c ! error checking sum + print*,"ALLOC" + ! If more than 1 leaf age bin is present, this ! call advances leaves in their age, but does ! not actually remove any biomass from the plant @@ -482,23 +492,53 @@ subroutine DailyPRTAllometricCNP(this) c_efflux => this%bc_out(acnp_bc_out_id_cefflux)%rval; c_efflux = 0._r8 n_efflux => this%bc_out(acnp_bc_out_id_nefflux)%rval; n_efflux = 0._r8 p_efflux => this%bc_out(acnp_bc_out_id_pefflux)%rval; p_efflux = 0._r8 - + + ! Bring storage pools down to the first target put overflow into gain pools + store_flux = max(0._r8, this%variables(store_c_id)%val(1) - target_c(store_organ)) + c_gain = c_gain + store_flux + this%variables(store_c_id)%val(1) = this%variables(store_c_id)%val(1) - store_flux + target_n = this%GetNutrientTarget(nitrogen_element,store_organ,stoich_growth_min) + store_flux = max(0._r8, this%variables(store_n_id)%val(1) - target_n) + n_gain = n_gain + store_flux + print*,"n store flux: ",store_flux + this%variables(store_n_id)%val(1) = this%variables(store_n_id)%val(1) - store_flux + target_p = this%GetNutrientTarget(phosphorus_element,store_organ,stoich_growth_min) + store_flux = max(0._r8, this%variables(store_p_id)%val(1) - target_p) + p_gain = p_gain + store_flux + print*,"p store flux: ",store_flux + this%variables(store_p_id)%val(1) = this%variables(store_p_id)%val(1) - store_flux + + n_alloc_nso = 0._r8 + c_alloc_nso = 0._r8 + p_alloc_nso = 0._r8 + do i = 1,num_organs + i_org = l2g_organ_list(i) ! global index from PRTGeneric + i_var = prt_global%sp_organ_map(i_org,carbon12_element) + c_alloc_nso = c_alloc_nso - this%variables(i_var)%val(1) + i_var = prt_global%sp_organ_map(i_org,nitrogen_element) + n_alloc_nso = n_alloc_nso - this%variables(i_var)%val(1) + i_var = prt_global%sp_organ_map(i_org,phosphorus_element) + p_alloc_nso = p_alloc_nso - this%variables(i_var)%val(1) + end do + + ! =================================================================================== ! Step 0. Transfer all stored nutrient into the daily uptake pool. Also ! transfer C storage that is above the target (ie transfer overflow) ! =================================================================================== ! Put overflow storage into the net daily pool - store_c_flux = max(0._r8, this%variables(store_c_id)%val(1) - target_c(store_organ)) - - c_gain = c_gain + store_c_flux - this%variables(store_c_id)%val(1) = this%variables(store_c_id)%val(1) - store_c_flux - + !store_flux = max(0._r8, this%variables(store_c_id)%val(1) - target_c(store_organ)) + !c_gain = c_gain + store_flux + !this%variables(store_c_id)%val(1) = this%variables(store_c_id)%val(1) - store_flux + n_gain = n_gain + sum(this%variables(store_n_id)%val(:)) this%variables(store_n_id)%val(:) = 0._r8 p_gain = p_gain + sum(this%variables(store_p_id)%val(:)) this%variables(store_p_id)%val(:) = 0._r8 + + ! =================================================================================== ! Step 2. Prioritized allocation to replace tissues from turnover, and/or pay @@ -553,8 +593,20 @@ subroutine DailyPRTAllometricCNP(this) ! At this point, at least 1 of the 3 resources have been used up. ! Allocate the remaining resources, or as a last resort, efflux them. ! =================================================================================== + + do i = 1,num_organs + i_org = l2g_organ_list(i) ! global index from PRTGeneric + i_var = prt_global%sp_organ_map(i_org,carbon12_element) + c_alloc_nso = c_alloc_nso + this%variables(i_var)%val(1) + i_var = prt_global%sp_organ_map(i_org,nitrogen_element) + n_alloc_nso = n_alloc_nso + this%variables(i_var)%val(1) + i_var = prt_global%sp_organ_map(i_org,phosphorus_element) + p_alloc_nso = p_alloc_nso + this%variables(i_var)%val(1) + end do - call this%CNPAllocateRemainder(c_gain, n_gain, p_gain, & + call this%CNPAllocateRemainder(c_gain, n_gain, p_gain, & + c_gain0, n_gain0, p_gain0, & + c_alloc_nso, n_alloc_nso, p_alloc_nso, & c_efflux, n_efflux, p_efflux) @@ -689,10 +741,10 @@ subroutine CNPAdjustFRootTargets(this, target_c, target_dcdd) real(r8) :: l2fr_mult real(r8), pointer :: nc_store real(r8), pointer :: pc_store - + !real(r8), parameter :: wgt = 1._r8/10._r8 ! 10-day smoothing real(r8), parameter :: max_l2fr_cgain_frac = 0.99_r8 - real(r8), parameter :: xc_ratio_correction = 1.2_r8 - real(r8), parameter :: wgt = 1._r8/10._r8 ! 10-day smoothing + real(r8), parameter :: xc_ratio_correction = 1.0_r8 + ipft = this%bc_in(acnp_bc_in_id_pft)%ival @@ -722,7 +774,7 @@ subroutine CNPAdjustFRootTargets(this, target_c, target_dcdd) n_ratio = xc_ratio_correction*min(50.0_r8,max(0.02_r8,(store_nut_act/store_nut_max)/(store_c_act/store_c_max))) - nc_store = wgt*log(n_ratio) + (1._r8-wgt)*nc_store + !nc_store = wgt*log(n_ratio) + (1._r8-wgt)*nc_store end if @@ -736,7 +788,7 @@ subroutine CNPAdjustFRootTargets(this, target_c, target_dcdd) store_nut_act = this%GetState(store_organ, phosphorus_element) + this%bc_inout(acnp_bc_inout_id_netdp)%rval p_ratio = xc_ratio_correction*min(50.0_r8,max(0.02_r8,(store_nut_act/store_nut_max)/(store_c_act/store_c_max))) - pc_store = wgt*log(p_ratio) + (1._r8-wgt)*pc_store + !pc_store = wgt*log(p_ratio) + (1._r8-wgt)*pc_store end if @@ -851,7 +903,7 @@ subroutine TrimFineRoot(this) real(r8) :: pc_fnrt real(r8) :: target_fnrt_c real(r8),parameter :: nday_buffer = 0._r8 - real(r8),parameter :: fnrt_opt_eff = 1._r8 ! If we want to transfer resources to storage + real(r8),parameter :: fnrt_opt_eff = 0._r8 ! If we want to transfer resources to storage if(.not.use_unrestricted_contraction)return @@ -1337,9 +1389,7 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & integer, parameter :: grow_lim_type = grow_lim_estNP real :: neq_cgain, peq_cgain ! N and P equivalent c_gain spent on growth real :: cnp_gain ! used as a check to see efficiency of limited growth - integer, parameter :: c_limited = 1 - integer, parameter :: n_limited = 2 - integer, parameter :: p_limited = 3 + leaf_status = this%bc_in(acnp_bc_in_id_lstat)%ival @@ -1350,7 +1400,15 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & l2fr = this%bc_inout(acnp_bc_inout_id_l2fr)%rval ! This variable is not updated in this ! routine, and is therefore not a pointer - + if( c_gain <= calloc_abs_error ) then + limiter = c_limited + if((n_gain <= 0.1_r8*calloc_abs_error) .or. & + (p_gain <= 0.02_r8*calloc_abs_error)) limiter = cnp_limited + else + if(n_gain <= 0.1_r8*calloc_abs_error) limiter = n_limited + if(p_gain <= 0.02_r8*calloc_abs_error) limiter = p_limited + end if + ! If any of these resources is essentially tapped out, ! then there is no point in performing growth ! It also seems impossible that we would be in a leaf-off status @@ -1364,7 +1422,7 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & leaf_status.eq.leaves_off .or. & n_gain <= 0.1_r8*calloc_abs_error .or. & p_gain <= 0.02_r8*calloc_abs_error ) then - limiter = 0 + print*,"lim: ",limiter return end if @@ -1750,19 +1808,27 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & p_gain, phosphorus_element,mask_gorgans(1:n_mask_organs)) end if if_stature_growth - + print*,"lim:",limiter return end subroutine CNPStatureGrowth ! ===================================================================================== - subroutine CNPAllocateRemainder(this, c_gain, n_gain, p_gain, & - c_efflux, n_efflux, p_efflux) + subroutine CNPAllocateRemainder(this, c_gain,n_gain,p_gain, & + c_gain0, n_gain0, p_gain0, & + c_alloc_nso, n_alloc_nso, p_alloc_nso, & + c_efflux, n_efflux, p_efflux) class(cnp_allom_prt_vartypes) :: this real(r8), intent(inout) :: c_gain real(r8), intent(inout) :: n_gain - real(r8), intent(inout) :: p_gain + real(r8), intent(inout) :: p_gain + real(r8), intent(in) :: c_alloc_nso ! Allocated C + real(r8), intent(in) :: n_alloc_nso ! Allocated N + real(r8), intent(in) :: p_alloc_nso ! Allocated P + real(r8), intent(in) :: c_gain0 ! Total C gain for the day + real(r8), intent(in) :: n_gain0 ! Total N gain for the day + real(r8), intent(in) :: p_gain0 ! Total P gain for the day real(r8), intent(inout) :: c_efflux real(r8), intent(inout) :: n_efflux real(r8), intent(inout) :: p_efflux @@ -1777,15 +1843,93 @@ subroutine CNPAllocateRemainder(this, c_gain, n_gain, p_gain, & real(r8) :: store_m_flux ! Flux into storage [kg] real(r8), pointer :: dbh real(r8), pointer :: resp_excess + real(r8), pointer :: nc_store,pc_store integer :: ipft + integer, pointer :: limiter real(r8) :: canopy_trim - + real(r8) :: n_ratio,p_ratio,c_ratio + real(r8) :: nc_ratio,pc_ratio + real(r8), pointer :: l2fr + real(r8), parameter :: wgt = 1._r8/5._r8 ! 10-day smoothing dbh => this%bc_inout(acnp_bc_inout_id_dbh)%rval canopy_trim = this%bc_in(acnp_bc_in_id_ctrim)%rval ipft = this%bc_in(acnp_bc_in_id_pft)%ival resp_excess => this%bc_inout(acnp_bc_inout_id_resp_excess)%rval + nc_store => this%bc_inout(acnp_bc_inout_id_nc_store)%rval + pc_store => this%bc_inout(acnp_bc_inout_id_pc_store)%rval + l2fr => this%bc_inout(acnp_bc_inout_id_l2fr)%rval + limiter => this%bc_out(acnp_bc_out_id_limiter)%ival + + ! Update the F_NPC + + ! n_ratio the ratio of n_gain/n_alloc / c_gain/c_alloc + ! If either n or p uptake is in prescribed mode + ! set the gains to something massive. 1 kilo of pure + ! nutrient should be wayyy more than enough + if(.false.)then + if(c_alloc_nso Date: Tue, 9 Aug 2022 12:56:30 -0400 Subject: [PATCH 28/55] Alternative PID error terms in CNP --- parteh/PRTAllometricCNPMod.F90 | 228 +++++++++++++++------------------ 1 file changed, 101 insertions(+), 127 deletions(-) diff --git a/parteh/PRTAllometricCNPMod.F90 b/parteh/PRTAllometricCNPMod.F90 index 6c1d966125..95049cf95b 100644 --- a/parteh/PRTAllometricCNPMod.F90 +++ b/parteh/PRTAllometricCNPMod.F90 @@ -100,6 +100,15 @@ module PRTAllometricCNPMod integer, parameter :: num_vars = 18 + ! Setpoint Error controller method + integer, parameter, private :: storage_spe = 0 + integer, parameter, private :: binary_limiter_spe = 1 + integer, parameter, private :: daily_gain_ratio_spe = 2 + + integer, parameter, private :: pid_spe_controller = storage_spe + + real(r8), parameter, private :: pid_int_wgt = 1._r8/5._r8 ! n-day smoothing (K on the integral of PID) + ! Global identifiers for the two stoichiometry values integer,public, parameter :: stoich_growth_min = 1 ! Flag for stoichiometry associated with ! minimum needed for growth @@ -382,10 +391,6 @@ subroutine DailyPRTAllometricCNP(this) real(r8) :: p_gain0 real(r8) :: resp_excess0 - real(r8) :: c_alloc_nso ! Allocated C not including changes in storage overflow - real(r8) :: n_alloc_nso ! Allocated N not including changes in storage overflow - real(r8) :: p_alloc_nso ! Allocated P not including changes in storage overflow - ! Used for mass checking, total mass allocated based ! on change in the states, should match gain0's real(r8) :: allocated_c @@ -394,9 +399,6 @@ subroutine DailyPRTAllometricCNP(this) real(r8) :: target_n,target_p real(r8) :: sum_c ! error checking sum - - print*,"ALLOC" - ! If more than 1 leaf age bin is present, this ! call advances leaves in their age, but does ! not actually remove any biomass from the plant @@ -500,28 +502,12 @@ subroutine DailyPRTAllometricCNP(this) target_n = this%GetNutrientTarget(nitrogen_element,store_organ,stoich_growth_min) store_flux = max(0._r8, this%variables(store_n_id)%val(1) - target_n) n_gain = n_gain + store_flux - print*,"n store flux: ",store_flux this%variables(store_n_id)%val(1) = this%variables(store_n_id)%val(1) - store_flux target_p = this%GetNutrientTarget(phosphorus_element,store_organ,stoich_growth_min) store_flux = max(0._r8, this%variables(store_p_id)%val(1) - target_p) p_gain = p_gain + store_flux - print*,"p store flux: ",store_flux this%variables(store_p_id)%val(1) = this%variables(store_p_id)%val(1) - store_flux - n_alloc_nso = 0._r8 - c_alloc_nso = 0._r8 - p_alloc_nso = 0._r8 - do i = 1,num_organs - i_org = l2g_organ_list(i) ! global index from PRTGeneric - i_var = prt_global%sp_organ_map(i_org,carbon12_element) - c_alloc_nso = c_alloc_nso - this%variables(i_var)%val(1) - i_var = prt_global%sp_organ_map(i_org,nitrogen_element) - n_alloc_nso = n_alloc_nso - this%variables(i_var)%val(1) - i_var = prt_global%sp_organ_map(i_org,phosphorus_element) - p_alloc_nso = p_alloc_nso - this%variables(i_var)%val(1) - end do - - ! =================================================================================== ! Step 0. Transfer all stored nutrient into the daily uptake pool. Also ! transfer C storage that is above the target (ie transfer overflow) @@ -594,19 +580,8 @@ subroutine DailyPRTAllometricCNP(this) ! Allocate the remaining resources, or as a last resort, efflux them. ! =================================================================================== - do i = 1,num_organs - i_org = l2g_organ_list(i) ! global index from PRTGeneric - i_var = prt_global%sp_organ_map(i_org,carbon12_element) - c_alloc_nso = c_alloc_nso + this%variables(i_var)%val(1) - i_var = prt_global%sp_organ_map(i_org,nitrogen_element) - n_alloc_nso = n_alloc_nso + this%variables(i_var)%val(1) - i_var = prt_global%sp_organ_map(i_org,phosphorus_element) - p_alloc_nso = p_alloc_nso + this%variables(i_var)%val(1) - end do - call this%CNPAllocateRemainder(c_gain, n_gain, p_gain, & c_gain0, n_gain0, p_gain0, & - c_alloc_nso, n_alloc_nso, p_alloc_nso, & c_efflux, n_efflux, p_efflux) @@ -741,7 +716,7 @@ subroutine CNPAdjustFRootTargets(this, target_c, target_dcdd) real(r8) :: l2fr_mult real(r8), pointer :: nc_store real(r8), pointer :: pc_store - !real(r8), parameter :: wgt = 1._r8/10._r8 ! 10-day smoothing + real(r8), parameter :: max_l2fr_cgain_frac = 0.99_r8 real(r8), parameter :: xc_ratio_correction = 1.0_r8 @@ -753,45 +728,48 @@ subroutine CNPAdjustFRootTargets(this, target_c, target_dcdd) canopy_trim = this%bc_in(acnp_bc_in_id_ctrim)%rval nc_store => this%bc_inout(acnp_bc_inout_id_nc_store)%rval pc_store => this%bc_inout(acnp_bc_inout_id_pc_store)%rval - - ! Step 1: Determine the nutrient to carbon ratio (aka relative health factor) - ! ----------------------------------------------------------------------------------- - - store_c_max = target_c(store_organ) - - store_c_act = this%GetState(store_organ, carbon12_element) + & - this%bc_in(acnp_bc_in_id_netdc)%rval - - if(n_uptake_mode.ne.prescribed_n_uptake)then - - ! Calculate the relative nitrogen storage fraction, - ! over the relative carbon storage fraction. - - store_nut_max = this%GetNutrientTarget(nitrogen_element,store_organ,stoich_growth_min) - - store_nut_act = this%GetState(store_organ, nitrogen_element) + & - this%bc_inout(acnp_bc_inout_id_netdn)%rval - n_ratio = xc_ratio_correction*min(50.0_r8,max(0.02_r8,(store_nut_act/store_nut_max)/(store_c_act/store_c_max))) - !nc_store = wgt*log(n_ratio) + (1._r8-wgt)*nc_store + if(pid_spe_controller == storage_spe) then - end if - - if(p_uptake_mode.ne.prescribed_p_uptake)then - - ! Calculate the relative phosphorus storage fraction, - ! over the relative carbon storage fraction. - - store_nut_max = this%GetNutrientTarget(phosphorus_element,store_organ,stoich_growth_min) - - store_nut_act = this%GetState(store_organ, phosphorus_element) + this%bc_inout(acnp_bc_inout_id_netdp)%rval - p_ratio = xc_ratio_correction*min(50.0_r8,max(0.02_r8,(store_nut_act/store_nut_max)/(store_c_act/store_c_max))) + ! Step 1: Determine the nutrient to carbon ratio (aka relative health factor) + ! ----------------------------------------------------------------------------------- + + store_c_max = target_c(store_organ) + + store_c_act = this%GetState(store_organ, carbon12_element) + & + this%bc_in(acnp_bc_in_id_netdc)%rval + + if(n_uptake_mode.ne.prescribed_n_uptake)then + + ! Calculate the relative nitrogen storage fraction, + ! over the relative carbon storage fraction. + + store_nut_max = this%GetNutrientTarget(nitrogen_element,store_organ,stoich_growth_min) + + store_nut_act = this%GetState(store_organ, nitrogen_element) + & + this%bc_inout(acnp_bc_inout_id_netdn)%rval - !pc_store = wgt*log(p_ratio) + (1._r8-wgt)*pc_store + n_ratio = xc_ratio_correction*min(50.0_r8,max(0.02_r8,(store_nut_act/store_nut_max)/(store_c_act/store_c_max))) + + nc_store = pid_int_wgt*log(n_ratio) + (1._r8-pid_int_wgt)*nc_store + + end if + if(p_uptake_mode.ne.prescribed_p_uptake)then + + ! Calculate the relative phosphorus storage fraction, + ! over the relative carbon storage fraction. + + store_nut_max = this%GetNutrientTarget(phosphorus_element,store_organ,stoich_growth_min) + + store_nut_act = this%GetState(store_organ, phosphorus_element) + this%bc_inout(acnp_bc_inout_id_netdp)%rval + p_ratio = xc_ratio_correction*min(50.0_r8,max(0.02_r8,(store_nut_act/store_nut_max)/(store_c_act/store_c_max))) + + pc_store = pid_int_wgt*log(p_ratio) + (1._r8-pid_int_wgt)*pc_store + + end if end if - ! Use the limiting nutrient species if(n_uptake_mode.eq.prescribed_n_uptake)then @@ -1422,7 +1400,6 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & leaf_status.eq.leaves_off .or. & n_gain <= 0.1_r8*calloc_abs_error .or. & p_gain <= 0.02_r8*calloc_abs_error ) then - print*,"lim: ",limiter return end if @@ -1808,7 +1785,7 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & p_gain, phosphorus_element,mask_gorgans(1:n_mask_organs)) end if if_stature_growth - print*,"lim:",limiter + return end subroutine CNPStatureGrowth @@ -1816,16 +1793,12 @@ end subroutine CNPStatureGrowth subroutine CNPAllocateRemainder(this, c_gain,n_gain,p_gain, & c_gain0, n_gain0, p_gain0, & - c_alloc_nso, n_alloc_nso, p_alloc_nso, & c_efflux, n_efflux, p_efflux) class(cnp_allom_prt_vartypes) :: this real(r8), intent(inout) :: c_gain real(r8), intent(inout) :: n_gain real(r8), intent(inout) :: p_gain - real(r8), intent(in) :: c_alloc_nso ! Allocated C - real(r8), intent(in) :: n_alloc_nso ! Allocated N - real(r8), intent(in) :: p_alloc_nso ! Allocated P real(r8), intent(in) :: c_gain0 ! Total C gain for the day real(r8), intent(in) :: n_gain0 ! Total N gain for the day real(r8), intent(in) :: p_gain0 ! Total P gain for the day @@ -1850,7 +1823,6 @@ subroutine CNPAllocateRemainder(this, c_gain,n_gain,p_gain, & real(r8) :: n_ratio,p_ratio,c_ratio real(r8) :: nc_ratio,pc_ratio real(r8), pointer :: l2fr - real(r8), parameter :: wgt = 1._r8/5._r8 ! 10-day smoothing dbh => this%bc_inout(acnp_bc_inout_id_dbh)%rval canopy_trim = this%bc_in(acnp_bc_in_id_ctrim)%rval @@ -1867,68 +1839,70 @@ subroutine CNPAllocateRemainder(this, c_gain,n_gain,p_gain, & ! If either n or p uptake is in prescribed mode ! set the gains to something massive. 1 kilo of pure ! nutrient should be wayyy more than enough - if(.false.)then - if(c_alloc_nso Date: Sun, 14 Aug 2022 10:04:08 -0400 Subject: [PATCH 29/55] Testing different PID controller methods and data prep methods. --- biogeochem/EDCanopyStructureMod.F90 | 1 - biogeochem/EDCohortDynamicsMod.F90 | 30 +-- main/EDMainMod.F90 | 18 +- main/EDTypesMod.F90 | 15 +- main/FatesHistoryInterfaceMod.F90 | 12 +- main/FatesRestartInterfaceMod.F90 | 40 ++-- parteh/PRTAllometricCNPMod.F90 | 283 ++++++++++++++++++++-------- parteh/PRTAllometricCarbonMod.F90 | 5 +- parteh/PRTGenericMod.F90 | 5 +- 9 files changed, 279 insertions(+), 130 deletions(-) diff --git a/biogeochem/EDCanopyStructureMod.F90 b/biogeochem/EDCanopyStructureMod.F90 index bbca1054e9..9bae9e6a35 100644 --- a/biogeochem/EDCanopyStructureMod.F90 +++ b/biogeochem/EDCanopyStructureMod.F90 @@ -720,7 +720,6 @@ subroutine DemoteFromLayer(currentSite,currentPatch,i_lyr,bc_in) end if ! kill the ones which go into canopy layers that are not allowed - if(currentCohort%canopy_layer>nclmax )then ! put the litter from the terminated cohorts diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index 67dde74f5c..e820f7f6fb 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -94,9 +94,10 @@ module EDCohortDynamicsMod use PRTAllometricCNPMod, only : cnp_allom_prt_vartypes use PRTAllometricCNPMod, only : acnp_bc_in_id_pft, acnp_bc_in_id_ctrim use PRTAllometricCNPMod, only : acnp_bc_in_id_lstat, acnp_bc_inout_id_dbh - use PRTAllometricCNPMod, only : acnp_bc_inout_id_nc_store - use PRTAllometricCNPMod, only : acnp_bc_inout_id_pc_store use PRTAllometricCNPMod, only : acnp_bc_inout_id_l2fr + use PRTAllometricCNPMod, only : acnp_bc_inout_id_emaxc + use PRTAllometricCNPMod, only : acnp_bc_inout_id_xc0 + use PRTAllometricCNPMod, only : acnp_bc_inout_id_emadxcdt use PRTAllometricCNPMod, only : acnp_bc_in_id_nc_repro use PRTAllometricCNPMod, only : acnp_bc_in_id_pc_repro use PRTAllometricCNPMod, only : acnp_bc_inout_id_resp_excess, acnp_bc_in_id_netdc @@ -252,8 +253,9 @@ subroutine create_cohort(currentSite, patchptr, pft, nn, hite, coage, dbh, & new_cohort%l2fr = prt_params%allom_l2fr(pft) - new_cohort%nc_store = 0._r8 ! Assume balanced N/C stores ie log(1) = 0 - new_cohort%pc_store = 0._r8 ! Assume balanced P/C stores ie log(1) = 0 + new_cohort%ema_xc = 0._r8 ! Assume balanced N,P/C stores ie log(1) = 0 + new_cohort%xc0 = 0._r8 ! Assume balanced N,P/C stores ie log(1) = 0 + new_cohort%ema_dxcdt = 0._r8 ! Assume unchanged dXC/dt ! This sets things like vcmax25top, that depend on the ! leaf age fractions (which are defined by PARTEH) @@ -437,8 +439,9 @@ subroutine InitPRTBoundaryConditions(new_cohort,ft,call_id) call new_cohort%prt%RegisterBCInOut(acnp_bc_inout_id_dbh,bc_rval = new_cohort%dbh) call new_cohort%prt%RegisterBCInOut(acnp_bc_inout_id_resp_excess,bc_rval = new_cohort%resp_excess) call new_cohort%prt%RegisterBCInOut(acnp_bc_inout_id_l2fr,bc_rval = new_cohort%l2fr) - call new_cohort%prt%RegisterBCInOut(acnp_bc_inout_id_nc_store,bc_rval = new_cohort%nc_store) - call new_cohort%prt%RegisterBCInOut(acnp_bc_inout_id_pc_store,bc_rval = new_cohort%pc_store) + call new_cohort%prt%RegisterBCInOut(acnp_bc_inout_id_emaxc,bc_rval = new_cohort%ema_xc) + call new_cohort%prt%RegisterBCInOut(acnp_bc_inout_id_emadxcdt,bc_rval = new_cohort%ema_dxcdt) + call new_cohort%prt%RegisterBCInOut(acnp_bc_inout_id_xc0,bc_rval = new_cohort%xc0) call new_cohort%prt%RegisterBCInOut(acnp_bc_inout_id_netdn, bc_rval = new_cohort%daily_n_gain) call new_cohort%prt%RegisterBCInOut(acnp_bc_inout_id_netdp, bc_rval = new_cohort%daily_p_uptake) @@ -1190,10 +1193,12 @@ subroutine fuse_cohorts(currentSite, currentPatch, bc_in) end do end if - currentCohort%nc_store = (currentCohort%n*currentCohort%nc_store & - + nextc%n*nextc%nc_store)/newn - currentCohort%pc_store = (currentCohort%n*currentCohort%pc_store & - + nextc%n*nextc%pc_store)/newn + currentCohort%ema_xc = (currentCohort%n*currentCohort%ema_xc & + + nextc%n*nextc%ema_xc)/newn + currentCohort%ema_dxcdt = (currentCohort%n*currentCohort%ema_dxcdt & + + nextc%n*nextc%ema_dxcdt)/newn + currentCohort%xc0 = (currentCohort%n*currentCohort%xc0 & + + nextc%n*nextc%xc0)/newn ! new cohort age is weighted mean of two cohorts currentCohort%coage = & @@ -1840,8 +1845,9 @@ subroutine copy_cohort( currentCohort,copyc ) n%kp25top = o%kp25top ! Copy over running means - n%nc_store = o%nc_store - n%pc_store = o%pc_store + n%ema_xc = o%ema_xc + n%ema_dxcdt = o%ema_dxcdt + n%xc0 = o%xc0 ! CARBON FLUXES n%gpp_acc_hold = o%gpp_acc_hold diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index 305fbcafb1..0e527e83e5 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -150,7 +150,7 @@ subroutine ed_ecosystem_dynamics(currentSite, bc_in, bc_out) type(ed_patch_type), pointer :: currentPatch integer :: el ! Loop counter for elements integer :: do_patch_dynamics ! for some modes, we turn off patch dynamics - + integer :: co_num !----------------------------------------------------------------------- if ( hlm_masterproc==itrue ) write(fates_log(),'(A,I4,A,I2.2,A,I2.2)') 'FATES Dynamics: ',& @@ -344,6 +344,7 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) real(r8) :: leaf_c_target ! target leaf crabon [kg] real(r8) :: current_npp ! place holder for calculating npp each year in prescribed physiology mode real(r8) :: target_storec + integer :: co_num ! simple cohort counter !----------------------------------------------------------------------- real(r8) :: frac_site_primary @@ -358,8 +359,9 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) ! prior to the growth sequence, where reproductive ! tissues are allocated call UpdateRecruitStoich(currentSite) - - currentPatch => currentSite%youngest_patch + + co_num = 1 + currentPatch => currentSite%oldest_patch do while(associated(currentPatch)) currentPatch%age = currentPatch%age + hlm_freq_day @@ -379,7 +381,7 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) currentPatch%age_class = get_age_class_index(currentPatch%age) ! Update Canopy Biomass Pools - currentCohort => currentPatch%shortest + currentCohort => currentPatch%tallest do while(associated(currentCohort)) ft = currentCohort%pft @@ -461,7 +463,7 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) ! ----------------------------------------------------------------------------- currentCohort%resp_excess = 0._r8 - call currentCohort%prt%DailyPRT() + call currentCohort%prt%DailyPRT(co_num,currentCohort%n) ! Send any efflux/exudates to the labile litter pools in the HLM ! ----------------------------------------------------------------------------- @@ -538,11 +540,11 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) currentCohort%coage_class,currentCohort%coage_by_pft_class) end if - - currentCohort => currentCohort%taller + co_num=co_num+1 + currentCohort => currentCohort%shorter end do - currentPatch => currentPatch%older + currentPatch => currentPatch%younger end do ! We keep a record of the L2FRs of plants diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 4a1b434676..7e1ef6fcc0 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -223,11 +223,16 @@ module EDTypesMod ! Used for CNP - integer :: cnp_limiter ! Which species is limiting growth? ! 0=none,1=C,2=N,3=P - real(r8) :: nc_store ! Exponential moving average of the log of the N/C storage ratio - real(r8) :: pc_store ! Exponential moving average of the log of the P/C storage ratio - real(r8) :: nc_repro ! The NC ratio of a new recruit in this patch - real(r8) :: pc_repro ! The PC ratio of a new recruit in this patch + integer :: cnp_limiter ! Which species is limiting growth? ! 0=none,1=C,2=N,3=P + real(r8) :: ema_xc ! Exponential moving average of the log of the error term + ! that controls the l2fr set-point in the PID controller + ! the term is probably a ratio of storage or a ratio of + ! gain efficiencies + real(r8) :: ema_dxcdt ! The derivative of ema_xc per day + real(r8) :: xc0 ! The value on the previous time-step of the log of + ! the PID error term (not smoothed) + real(r8) :: nc_repro ! The NC ratio of a new recruit in this patch + real(r8) :: pc_repro ! The PC ratio of a new recruit in this patch ! VEGETATION STRUCTURE diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 9e71cb5a29..b5f6c9a6dd 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -1815,6 +1815,9 @@ subroutine update_history_nutrflux(this,csite) gpp_si = 0._r8 fnrtc_clscpf(:) = 0._r8 fnrtc_si = 0._r8 + + ! history site index + io_si = csite%h_gid cpatch => csite%youngest_patch do while(associated(cpatch)) @@ -1823,16 +1826,16 @@ subroutine update_history_nutrflux(this,csite) do while(associated(ccohort)) ! If this is a new cohort, do not make diagnostics - if(ccohort%isnew) cycle + if(ccohort%isnew) then + ccohort => ccohort%taller + cycle + end if ! size class index iscpf = ccohort%size_by_pft_class ! layer by size by pft index iclscpf = get_layersizetype_class_index(ccohort%canopy_layer,ccohort%dbh,ccohort%pft) - - ! history site index - io_si = csite%h_gid ! unit conversion factor to get x/plant/day -> x/m2/sec uconv = ccohort%n * ha_per_m2 * days_per_sec @@ -1952,6 +1955,7 @@ subroutine update_history_nutrflux(this,csite) ! Normalize the layer x size x pft arrays do iclscpf = 1,nclmax*numpft*nlevsclass + if(gpp_clscpf(iclscpf)>nearzero) then hio_ngrowlim_clscpf(io_si,iclscpf) = hio_ngrowlim_clscpf(io_si,iclscpf) / gpp_clscpf(iclscpf) hio_pgrowlim_clscpf(io_si,iclscpf) = hio_pgrowlim_clscpf(io_si,iclscpf) / gpp_clscpf(iclscpf) diff --git a/main/FatesRestartInterfaceMod.F90 b/main/FatesRestartInterfaceMod.F90 index 15604aba25..94fd47b1de 100644 --- a/main/FatesRestartInterfaceMod.F90 +++ b/main/FatesRestartInterfaceMod.F90 @@ -96,7 +96,9 @@ module FatesRestartInterfaceMod integer :: ir_canopy_layer_yesterday_co integer :: ir_canopy_trim_co integer :: ir_l2fr_co - integer :: ir_nc_store_co + integer :: ir_emaxc_co + integer :: ir_emadxcdt_co + integer :: ir_xc0_co integer :: ir_pc_store_co integer :: ir_size_class_lasttimestep_co integer :: ir_dbh_co @@ -700,13 +702,17 @@ subroutine define_restart_vars(this, initialize_variables) long_name='ed cohort - l2fr', units='fraction', flushval = flushzero, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_l2fr_co ) - call this%set_restart_var(vname='fates_nc_store', vtype=cohort_r8, & - long_name='ed cohort - nc_store', units='fraction', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_nc_store_co ) + call this%set_restart_var(vname='fates_emaxc', vtype=cohort_r8, & + long_name='ed cohort - emaxc', units='fraction', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_emaxc_co ) - call this%set_restart_var(vname='fates_pc_store', vtype=cohort_r8, & - long_name='ed cohort - pc_store', units='fraction', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_pc_store_co ) + call this%set_restart_var(vname='fates_emadxcdt', vtype=cohort_r8, & + long_name='ed cohort - emadxcdt', units='fraction', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_emadxcdt_co ) + + call this%set_restart_var(vname='fates_xc0', vtype=cohort_r8, & + long_name='ed cohort - xc0', units='fraction', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_xc0_co ) call this%set_restart_var(vname='fates_size_class_lasttimestep', vtype=cohort_int, & long_name='ed cohort - size-class last timestep', units='index', flushval = flushzero, & @@ -1748,8 +1754,9 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_canopy_layer_yesterday_co => this%rvars(ir_canopy_layer_yesterday_co)%r81d, & rio_canopy_trim_co => this%rvars(ir_canopy_trim_co)%r81d, & rio_l2fr_co => this%rvars(ir_l2fr_co)%r81d, & - rio_nc_store_co => this%rvars(ir_nc_store_co)%r81d, & - rio_pc_store_co => this%rvars(ir_pc_store_co)%r81d, & + rio_emaxc_co => this%rvars(ir_emaxc_co)%r81d, & + rio_emadxcdt_co => this%rvars(ir_emadxcdt_co)%r81d, & + rio_xc0_co => this%rvars(ir_xc0_co)%r81d, & rio_seed_prod_co => this%rvars(ir_seed_prod_co)%r81d, & rio_size_class_lasttimestep => this%rvars(ir_size_class_lasttimestep_co)%int1d, & rio_dbh_co => this%rvars(ir_dbh_co)%r81d, & @@ -1967,8 +1974,9 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_canopy_layer_yesterday_co(io_idx_co) = ccohort%canopy_layer_yesterday rio_canopy_trim_co(io_idx_co) = ccohort%canopy_trim rio_l2fr_co(io_idx_co) = ccohort%l2fr - rio_nc_store_co(io_idx_co) = ccohort%nc_store - rio_pc_store_co(io_idx_co) = ccohort%pc_store + rio_emaxc_co(io_idx_co) = ccohort%ema_xc + rio_emadxcdt_co(io_idx_co) = ccohort%ema_dxcdt + rio_xc0_co(io_idx_co) = ccohort%xc0 rio_seed_prod_co(io_idx_co) = ccohort%seed_prod rio_size_class_lasttimestep(io_idx_co) = ccohort%size_class_lasttimestep rio_dbh_co(io_idx_co) = ccohort%dbh @@ -2575,8 +2583,9 @@ subroutine get_restart_vectors(this, nc, nsites, sites) rio_canopy_layer_yesterday_co => this%rvars(ir_canopy_layer_yesterday_co)%r81d, & rio_canopy_trim_co => this%rvars(ir_canopy_trim_co)%r81d, & rio_l2fr_co => this%rvars(ir_l2fr_co)%r81d, & - rio_nc_store_co => this%rvars(ir_nc_store_co)%r81d, & - rio_pc_store_co => this%rvars(ir_pc_store_co)%r81d, & + rio_emaxc_co => this%rvars(ir_emaxc_co)%r81d, & + rio_emadxcdt_co => this%rvars(ir_emadxcdt_co)%r81d, & + rio_xc0_co => this%rvars(ir_xc0_co)%r81d, & rio_seed_prod_co => this%rvars(ir_seed_prod_co)%r81d, & rio_size_class_lasttimestep => this%rvars(ir_size_class_lasttimestep_co)%int1d, & rio_dbh_co => this%rvars(ir_dbh_co)%r81d, & @@ -2767,8 +2776,9 @@ subroutine get_restart_vectors(this, nc, nsites, sites) ccohort%canopy_layer_yesterday = rio_canopy_layer_yesterday_co(io_idx_co) ccohort%canopy_trim = rio_canopy_trim_co(io_idx_co) ccohort%l2fr = rio_l2fr_co(io_idx_co) - ccohort%nc_store = rio_nc_store_co(io_idx_co) - ccohort%pc_store = rio_pc_store_co(io_idx_co) + ccohort%ema_xc = rio_emaxc_co(io_idx_co) + ccohort%ema_dxcdt = rio_emadxcdt_co(io_idx_co) + ccohort%xc0 = rio_xc0_co(io_idx_co) ccohort%seed_prod = rio_seed_prod_co(io_idx_co) ccohort%size_class_lasttimestep = rio_size_class_lasttimestep(io_idx_co) ccohort%dbh = rio_dbh_co(io_idx_co) diff --git a/parteh/PRTAllometricCNPMod.F90 b/parteh/PRTAllometricCNPMod.F90 index 95049cf95b..de34316837 100644 --- a/parteh/PRTAllometricCNPMod.F90 +++ b/parteh/PRTAllometricCNPMod.F90 @@ -107,7 +107,8 @@ module PRTAllometricCNPMod integer, parameter, private :: pid_spe_controller = storage_spe - real(r8), parameter, private :: pid_int_wgt = 1._r8/5._r8 ! n-day smoothing (K on the integral of PID) + real(r8), parameter, private :: pid_int_wgt = 1._r8/30._r8 ! n-day smoothing (K on the integral of PID) + real(r8), parameter, private :: pid_drv_wgt = 1._r8/30._r8 ! n-day smoothing (K on the derivative of PID) ! Global identifiers for the two stoichiometry values integer,public, parameter :: stoich_growth_min = 1 ! Flag for stoichiometry associated with @@ -160,10 +161,10 @@ module PRTAllometricCNPMod ! is dynamic with CNP integer, public, parameter :: acnp_bc_inout_id_netdn = 4 ! Index for the net daily NH4 input BC integer, public, parameter :: acnp_bc_inout_id_netdp = 5 ! Index for the net daily P input BC - integer, public, parameter :: acnp_bc_inout_id_nc_store = 6 ! Index for the EMA log storage ratio N/C - integer, public, parameter :: acnp_bc_inout_id_pc_store = 7 ! Index for the EMA log storage ratio P/C - - integer, public, parameter :: num_bc_inout = 7 + integer, public, parameter :: acnp_bc_inout_id_emaxc = 6 ! Index for the EMA log storage ratio max(N,P)/C + integer, public, parameter :: acnp_bc_inout_id_xc0 = 7 ! Index for the previous step's log storage ratio max(N,P)/C + integer, public, parameter :: acnp_bc_inout_id_emadxcdt = 8 ! Index for the EMA log storage ratio derivative d max(NP)/C dt + integer, public, parameter :: num_bc_inout = 8 ! ------------------------------------------------------------------------------------- ! Input only Boundary Indices (These are public) @@ -222,6 +223,12 @@ module PRTAllometricCNPMod logical, parameter :: use_gains_in_regulator = .true. logical, parameter :: use_unrestricted_contraction = .true. + + integer, parameter :: pid_ratio = 1 + integer, parameter :: pid_logratio = 2 + + integer, parameter :: pid_method = pid_logratio + ! ------------------------------------------------------------------------------------- ! This is the core type that holds this specific @@ -345,9 +352,11 @@ end subroutine InitPRTGlobalAllometricCNP ! ===================================================================================== - subroutine DailyPRTAllometricCNP(this) + subroutine DailyPRTAllometricCNP(this,co_num,nplant) class(cnp_allom_prt_vartypes) :: this + integer,intent(in) :: co_num ! Cohort index + real(r8),intent(in) :: nplant ! Pointers to in-out bcs real(r8),pointer :: dbh ! Diameter at breast height [cm] @@ -472,7 +481,7 @@ subroutine DailyPRTAllometricCNP(this) ! This routine updates the l2fr (leaf 2 fine-root multiplier) variable ! It will also update the target - call this%CNPAdjustFRootTargets(target_c,target_dcdd) + call this%CNPAdjustFRootTargets(target_c,target_dcdd,co_num,nplant) ! Remember the original C,N,P states to help with final ! evaluation of how much was allocated @@ -694,43 +703,64 @@ subroutine DailyPRTAllometricCNP(this) end subroutine DailyPRTAllometricCNP ! ===================================================================================== - subroutine CNPAdjustFRootTargets(this, target_c, target_dcdd) + subroutine CNPAdjustFRootTargets(this, target_c, target_dcdd,co_num,nplant) + use FatesInterfaceTypesMod , only : hlm_day_of_year + use FatesInterfaceTypesMod , only : hlm_days_per_year + use FatesInterfaceTypesMod , only : hlm_current_year + class(cnp_allom_prt_vartypes) :: this real(r8) :: target_c(:) real(r8) :: target_dcdd(:) - + integer,intent(in) :: co_num + real(r8),intent(in) :: nplant + real(r8), pointer :: l2fr ! leaf to fineroot target biomass scaler integer :: ipft ! PFT index real(r8), pointer :: dbh real(r8) :: canopy_trim - real(r8) :: cnp_store_ratio real(r8) :: store_c_max, store_c_act real(r8) :: store_nut_max, store_nut_act real(r8) :: n_ratio, p_ratio, np_ratio real(r8) :: fnrt_c,leaf_c,store_c,struct_c,sapw_c,c_gain,c_fnrt_expand real(r8) :: l2fr_delta_max + real(r8) :: l2fr_delta_minmax ! Hard cap on maximum change scale*log(2) real(r8) :: l2fr_delta_scale real(r8) :: logi_k real(r8) :: l2fr_mult - real(r8), pointer :: nc_store - real(r8), pointer :: pc_store - + real(r8) :: l2fr_delta + real(r8) :: dxcdt_ratio ! log change (derivative) of the maximum of the N/C and P/C storage ratio + real(r8) :: xc_ratio ! log Maximum of the N/C and P/C storage ratio + real(r8), pointer :: ema_xc ! The exponential moving average of the N-or-P versus C PID error function + real(r8), pointer :: xc0 ! The log of the xc ratio from previous time-step + real(r8), pointer :: ema_dxcdt ! the EMA of the change in log storage ratio + integer :: sup_flag real(r8), parameter :: max_l2fr_cgain_frac = 0.99_r8 real(r8), parameter :: xc_ratio_correction = 1.0_r8 - - - - ipft = this%bc_in(acnp_bc_in_id_pft)%ival - l2fr => this%bc_inout(acnp_bc_inout_id_l2fr)%rval - dbh => this%bc_inout(acnp_bc_inout_id_dbh)%rval - canopy_trim = this%bc_in(acnp_bc_in_id_ctrim)%rval - nc_store => this%bc_inout(acnp_bc_inout_id_nc_store)%rval - pc_store => this%bc_inout(acnp_bc_inout_id_pc_store)%rval + ! This is the relative scaling strength of the derivative term (K_d), + ! compared to the combined proportion and integral term (K_p and K_i) + ! Note the strength of the derivative is should be about half of the period + ! for an oscillation when turned off, to balance the K_p and K_i terms. + ! This will have to be tuned in a sequence of 1, 10, 100, etc... + real(r8) :: l2fr_deriv_scale != 200._r8 + real(r8) :: l2fr_int_scale + + ! If we do not have leaves out, then the relative nutrient vs carbon + ! balancing is meaningless, just leave this routine + if(this%GetState(leaf_organ, carbon12_element)/target_c(leaf_organ) < 0.5_r8) return + - if(pid_spe_controller == storage_spe) then + ipft = this%bc_in(acnp_bc_in_id_pft)%ival + l2fr => this%bc_inout(acnp_bc_inout_id_l2fr)%rval + dbh => this%bc_inout(acnp_bc_inout_id_dbh)%rval + canopy_trim = this%bc_in(acnp_bc_in_id_ctrim)%rval + ema_xc => this%bc_inout(acnp_bc_inout_id_emaxc)%rval + xc0 => this%bc_inout(acnp_bc_inout_id_xc0)%rval + ema_dxcdt => this%bc_inout(acnp_bc_inout_id_emadxcdt)%rval + + if_storage_spe: if(pid_spe_controller == storage_spe) then ! Step 1: Determine the nutrient to carbon ratio (aka relative health factor) ! ----------------------------------------------------------------------------------- @@ -750,10 +780,18 @@ subroutine CNPAdjustFRootTargets(this, target_c, target_dcdd) store_nut_act = this%GetState(store_organ, nitrogen_element) + & this%bc_inout(acnp_bc_inout_id_netdn)%rval - n_ratio = xc_ratio_correction*min(50.0_r8,max(0.02_r8,(store_nut_act/store_nut_max)/(store_c_act/store_c_max))) - - nc_store = pid_int_wgt*log(n_ratio) + (1._r8-pid_int_wgt)*nc_store + !n_ratio = xc_ratio_correction*min(50.0_r8,max(0.02_r8,(store_nut_act/store_nut_max)/(store_c_act/store_c_max))) + !n_ratio = xc_ratio_correction*min(50.0_r8,max(0.02_r8,(store_nut_act/store_nut_max))) + !n_ratio = xc_ratio_correction*min(50.0_r8,max(0.02_r8,1._r8/(store_c_act/store_c_max))) + + if((store_nut_act/store_nut_max) > (store_c_act/store_c_max))then + n_ratio = xc_ratio_correction*min(50.0_r8,max(0.02_r8,(store_c_max/store_c_act))) + else + n_ratio = xc_ratio_correction*min(50.0_r8,max(0.02_r8,(store_nut_act/store_nut_max))) + end if + else + n_ratio = -1._r8 end if if(p_uptake_mode.ne.prescribed_p_uptake)then @@ -763,29 +801,44 @@ subroutine CNPAdjustFRootTargets(this, target_c, target_dcdd) store_nut_max = this%GetNutrientTarget(phosphorus_element,store_organ,stoich_growth_min) - store_nut_act = this%GetState(store_organ, phosphorus_element) + this%bc_inout(acnp_bc_inout_id_netdp)%rval - p_ratio = xc_ratio_correction*min(50.0_r8,max(0.02_r8,(store_nut_act/store_nut_max)/(store_c_act/store_c_max))) + store_nut_act = this%GetState(store_organ, phosphorus_element) + & + this%bc_inout(acnp_bc_inout_id_netdp)%rval - pc_store = pid_int_wgt*log(p_ratio) + (1._r8-pid_int_wgt)*pc_store - - end if - end if - ! Use the limiting nutrient species + !p_ratio = xc_ratio_correction*min(50.0_r8,max(0.02_r8,(store_nut_act/store_nut_max)/(store_c_act/store_c_max))) + p_ratio = xc_ratio_correction*min(50.0_r8,max(0.02_r8,(store_nut_act/store_nut_max))) + !p_ratio = xc_ratio_correction*min(50.0_r8,max(0.02_r8,1._r8/(store_c_act/store_c_max))) - if(n_uptake_mode.eq.prescribed_n_uptake)then - if(p_uptake_mode.eq.prescribed_p_uptake)then - cnp_store_ratio = 1._r8 - return + if((store_nut_act/store_nut_max) > (store_c_act/store_c_max))then + p_ratio = xc_ratio_correction*min(50.0_r8,max(0.02_r8,(store_c_max/store_c_act))) + else + p_ratio = xc_ratio_correction*min(50.0_r8,max(0.02_r8,(store_nut_act/store_nut_max))) + end if + + else - cnp_store_ratio = exp(pc_store) + p_ratio = -1._r8 end if - else - if(p_uptake_mode.eq.prescribed_p_uptake)then - cnp_store_ratio = exp(nc_store) + + ! Use the limiting nutrient species + if(n_uptake_mode.eq.prescribed_n_uptake .and. p_uptake_mode.eq.prescribed_p_uptake)then + ema_xc = 0._r8 + ema_dxcdt = 0._r8 + xc0 = 0.0_r8 + return else - cnp_store_ratio = min(exp(nc_store),exp(pc_store)) + + xc_ratio = log(min(n_ratio,p_ratio)) + + dxcdt_ratio = xc_ratio-xc0 + + ema_xc = pid_int_wgt*xc_ratio + (1._r8-pid_int_wgt)*ema_xc + ema_dxcdt = pid_drv_wgt*dxcdt_ratio + (1._r8-pid_drv_wgt)*ema_dxcdt + xc0 = xc_ratio + + end if - end if + + end if if_storage_spe ! ----------------------------------------------------------------------------- ! To decide the upper limit on expanding root growth, we perform a carbon @@ -822,35 +875,95 @@ subroutine CNPAdjustFRootTargets(this, target_c, target_dcdd) max(0._r8,target_c(struct_organ)-struct_c) - & max(0._r8,target_c(store_organ)-store_c)) - l2fr_delta_max = (c_fnrt_expand + target_c(fnrt_organ))/target_c(fnrt_organ) + if(pid_method==pid_ratio) then + + l2fr_delta_max = (c_fnrt_expand + target_c(fnrt_organ))/target_c(fnrt_organ) + + ! This value could be negative if there is no gain, or less gain + ! than what can replace tissues, just ensure the multiplier is GT 1 + + l2fr_delta_max = max(1._r8,l2fr_delta_max) - ! This value could be negative if there is no gain, or less gain - ! than what can replace tissues, just ensure the multiplier is GT 1 + ! Determine the max change for the doubling timescale + ! 2.0 = l2fr_delta_max^frnt_adapt_tscl + + l2fr_delta_scale = 2._r8**(1._r8/prt_params%fnrt_adapt_tscale(ipft))-1.0_r8 - l2fr_delta_max = max(1._r8,l2fr_delta_max) + ! Calculate the un-regulated l2fr multiplier + + logi_k = EDPftvarcon_inst%dev_arbitrary_pft(ipft) + l2fr_mult = l2fr_delta_scale*(2.0_r8/(1.0_r8 + exp(ema_xc)**logi_k)-1.0_r8)+1.0_r8 + + + if(l2fr_mult>1.0_r8)then + l2fr_mult = min(l2fr_mult,l2fr_delta_max) + end if - ! Determine the max change for the doubling timescale - ! 2.0 = l2fr_delta_max^frnt_adapt_tscl - - l2fr_delta_scale = 2._r8**(1._r8/prt_params%fnrt_adapt_tscale(ipft))-1.0_r8 + l2fr = max(l2fr_min,l2fr * l2fr_mult) - ! Calculate the un-regulated l2fr multiplier - - logi_k = EDPftvarcon_inst%dev_arbitrary_pft(ipft) - l2fr_mult = l2fr_delta_scale*(2.0_r8/(1.0_r8 + cnp_store_ratio**logi_k)-1.0_r8)+1.0_r8 - if(l2fr_mult>1.0_r8)then - l2fr_mult = min(l2fr_mult,l2fr_delta_max) - end if + elseif(pid_method==pid_logratio) then - ! Only update L2FR if some leaves are out - if(this%GetState(leaf_organ, carbon12_element)/target_c(leaf_organ) > 0.5_r8) then + ! When using a log based (additive) PID search method + ! we define 1/fnrt_adapt_tscale as delta we want + ! when we have a 2:1 ratio. For instance if fnrt_adapt_tscale = 100, + ! then we want a scaling parameter that generates a change in l2fr of 1/100 + ! when there is 2:1 ratio of nutrient versus carbon storage. This + ! value is akin to the K_p and K_i terms in a PID controller (and + ! the ema timescale is the relative weight of K_p and K_i) + + l2fr_delta_scale = (1._r8/prt_params%fnrt_adapt_tscale(ipft))/log(2.0_r8) + + ! ema_xc is already in log form to allow for averaging + + ! Want the derivative to be strongest when storage is most disproportionate + l2fr_deriv_scale = 0.0_r8 !0.25*abs(ema_xc/ema_dxcdt) + l2fr_int_scale = 0.0_r8 + + + ! To limit overshoot, when either positive and decending or negative and ascending + ! we have already corrected enough to change the behavior, lets + ! decrease the scaling + + if( ((ema_xc > 0._r8) .and. (ema_dxcdt<0)) .or. ((ema_xc < 0._r8) .and. (ema_dxcdt>0))) then + l2fr_delta_scale = 0.05_r8 * l2fr_delta_scale + sup_flag = 1 + else + sup_flag = 0 + + end if - !l2fr = (1._r8-err_beta)*(l2fr * l2fr_mult) + err_beta*l2fr_deriv - l2fr = max(l2fr_min,l2fr * l2fr_mult) - end if + !l2fr_delta = -l2fr_delta_scale*(min(0.2,max(-0.2,xc_ratio)) + ema_xc*l2fr_int_scale + ema_dxcdt*l2fr_deriv_scale) + l2fr_delta = -l2fr_delta_scale*(xc_ratio + ema_xc*l2fr_int_scale + ema_dxcdt*l2fr_deriv_scale) + + ! Cap growth and shrinkage to avoid large changes + ! (currently capping at projected rate for a 2:1 ratio + l2fr_delta_minmax = l2fr_delta_scale*log(2.0) + ! Don't allow more growth than we have carbon to pay for + l2fr_delta_max = min(l2fr_delta_minmax,l2fr*(c_fnrt_expand + target_c(fnrt_organ))/target_c(fnrt_organ)) + + + l2fr_delta = max(-l2fr_delta_minmax,min(l2fr_delta,l2fr_delta_max)) + + ! Apply the delta, also, avoid generating incredibly small l2fr's, + ! super small l2frs will occur in plants that perpetually get almost + ! now carbon gain, such as newly recruited plants in a dark understory + + l2fr = max(l2fr_min, l2fr + l2fr_delta ) + + !if(co_num==1) + print*,'AAX1',co_num,hlm_current_year,hlm_day_of_year,dbh,nplant,sup_flag,xc_ratio,l2fr + + + else + + write(fates_log(),*) 'unknown PID controller method', pid_method + call endrun(msg=errMsg(sourcefile, __LINE__)) + + end if + ! Find the updated target fineroot biomass call bfineroot(dbh,ipft,canopy_trim, l2fr, target_c(fnrt_organ),target_dcdd(fnrt_organ)) @@ -1816,23 +1929,26 @@ subroutine CNPAllocateRemainder(this, c_gain,n_gain,p_gain, & real(r8) :: store_m_flux ! Flux into storage [kg] real(r8), pointer :: dbh real(r8), pointer :: resp_excess - real(r8), pointer :: nc_store,pc_store + real(r8), pointer :: ema_xc + real(r8), pointer :: ema_dxcdt + real(r8), pointer :: xc0 + real(r8) :: dxcdt_ratio integer :: ipft integer, pointer :: limiter real(r8) :: canopy_trim real(r8) :: n_ratio,p_ratio,c_ratio - real(r8) :: nc_ratio,pc_ratio + real(r8) :: xc_ratio,nc_ratio,pc_ratio real(r8), pointer :: l2fr dbh => this%bc_inout(acnp_bc_inout_id_dbh)%rval canopy_trim = this%bc_in(acnp_bc_in_id_ctrim)%rval ipft = this%bc_in(acnp_bc_in_id_pft)%ival resp_excess => this%bc_inout(acnp_bc_inout_id_resp_excess)%rval - nc_store => this%bc_inout(acnp_bc_inout_id_nc_store)%rval - pc_store => this%bc_inout(acnp_bc_inout_id_pc_store)%rval l2fr => this%bc_inout(acnp_bc_inout_id_l2fr)%rval limiter => this%bc_out(acnp_bc_out_id_limiter)%ival - + ema_xc => this%bc_inout(acnp_bc_inout_id_emaxc)%rval + ema_dxcdt => this%bc_inout(acnp_bc_inout_id_emadxcdt)%rval + xc0 => this%bc_inout(acnp_bc_inout_id_xc0)%rval ! Update the F_NPC ! n_ratio the ratio of n_gain/n_alloc / c_gain/c_alloc @@ -1880,29 +1996,34 @@ subroutine CNPAllocateRemainder(this, c_gain,n_gain,p_gain, & end if end if + xc_ratio = log(min(nc_ratio,pc_ratio)) + + dxcdt_ratio = xc_ratio-xc0 + + ema_xc = pid_int_wgt*xc_ratio + (1._r8-pid_int_wgt)*ema_xc + ema_dxcdt = pid_drv_wgt*dxcdt_ratio + (1._r8-pid_drv_wgt)*ema_dxcdt + xc0 = xc_ratio + + elseif( pid_spe_controller==binary_limiter_spe) then select case(limiter) case(cnp_limited) - nc_ratio = exp(nc_store) - pc_ratio = exp(pc_store) + xc_ratio = exp(ema_xc) case(c_limited) - nc_ratio = 2.0_r8 - pc_ratio = 2.0_r8 + xc_ratio = 2.0_r8 case(n_limited,p_limited) - nc_ratio = 0.5_r8 - pc_ratio = 0.5_r8 + xc_ratio = 0.5_r8 end select - if(n_uptake_mode.eq.prescribed_n_uptake) then - nc_ratio = 1.0_r8 - end if - if(p_uptake_mode.eq.prescribed_p_uptake) then - pc_ratio = 1.0_r8 + if((n_uptake_mode.eq.prescribed_n_uptake) .and. (p_uptake_mode.eq.prescribed_p_uptake) ) then + xc_ratio = 1.0_r8 end if + + ema_xc = pid_int_wgt*log(xc_ratio) + (1._r8-pid_int_wgt)*ema_xc + end if - nc_store = pid_int_wgt*log(nc_ratio) + (1._r8-pid_int_wgt)*nc_store - pc_store = pid_int_wgt*log(pc_ratio) + (1._r8-pid_int_wgt)*pc_store + ! ----------------------------------------------------------------------------------- ! If nutrients are still available, then we can bump up the values in the pools diff --git a/parteh/PRTAllometricCarbonMod.F90 b/parteh/PRTAllometricCarbonMod.F90 index 407d3e2c88..a291f835eb 100644 --- a/parteh/PRTAllometricCarbonMod.F90 +++ b/parteh/PRTAllometricCarbonMod.F90 @@ -238,7 +238,7 @@ end subroutine InitPRTGlobalAllometricCarbon ! ===================================================================================== - subroutine DailyPRTAllometricCarbon(this) + subroutine DailyPRTAllometricCarbon(this,co_num,nplant) ! ----------------------------------------------------------------------------------- ! @@ -283,7 +283,8 @@ subroutine DailyPRTAllometricCarbon(this) ! The class is the only argument class(callom_prt_vartypes) :: this ! this class - + integer,intent(in) :: co_num ! cohort index + real(r8),intent(in) :: nplant ! ----------------------------------------------------------------------------------- ! These are local copies of the in/out boundary condition structure ! ----------------------------------------------------------------------------------- diff --git a/parteh/PRTGenericMod.F90 b/parteh/PRTGenericMod.F90 index 40cc75898e..9dd01047a2 100644 --- a/parteh/PRTGenericMod.F90 +++ b/parteh/PRTGenericMod.F90 @@ -1159,10 +1159,11 @@ end function GetCoordVal ! ==================================================================================== - subroutine DailyPRTBase(this) + subroutine DailyPRTBase(this,co_num,nplant) class(prt_vartypes) :: this - + integer,intent(in) :: co_num ! cohort number + real(r8),intent(in) :: nplant write(fates_log(),*)'Daily PRT Allocation must be extended' call endrun(msg=errMsg(sourcefile, __LINE__)) From 43ee9b93ead585992235d76531ec7434f87bab64 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Fri, 19 Aug 2022 13:58:12 -0400 Subject: [PATCH 30/55] yet more reorganization and PID algorithm testing --- biogeochem/EDPhysiologyMod.F90 | 2 - parteh/PRTAllometricCNPMod.F90 | 155 ++++++++++++++++++--------------- 2 files changed, 86 insertions(+), 71 deletions(-) diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index a260285c42..2573dae56e 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -2647,8 +2647,6 @@ subroutine UpdateRecruitL2FR(csite) rec_l2fr0(ft,cl) = rec_l2fr0(ft,cl) / rec_n(ft,cl) csite%rec_l2fr(ft,cl) = & (1._r8-smth_wgt)*csite%rec_l2fr(ft,cl) + smth_wgt*rec_l2fr0(ft,cl) - - !print*,"REC_L2FR:",cl,csite%rec_l2fr(ft,cl) end if end do end do diff --git a/parteh/PRTAllometricCNPMod.F90 b/parteh/PRTAllometricCNPMod.F90 index de34316837..e79c63ab6d 100644 --- a/parteh/PRTAllometricCNPMod.F90 +++ b/parteh/PRTAllometricCNPMod.F90 @@ -107,8 +107,8 @@ module PRTAllometricCNPMod integer, parameter, private :: pid_spe_controller = storage_spe - real(r8), parameter, private :: pid_int_wgt = 1._r8/30._r8 ! n-day smoothing (K on the integral of PID) - real(r8), parameter, private :: pid_drv_wgt = 1._r8/30._r8 ! n-day smoothing (K on the derivative of PID) + real(r8), parameter, private :: pid_int_wgt = 1._r8/10._r8 ! n-day smoothing (K on the integral of PID) + real(r8), parameter, private :: pid_drv_wgt = 1._r8/10._r8 ! n-day smoothing (K on the derivative of PID) ! Global identifiers for the two stoichiometry values integer,public, parameter :: stoich_growth_min = 1 ! Flag for stoichiometry associated with @@ -481,7 +481,7 @@ subroutine DailyPRTAllometricCNP(this,co_num,nplant) ! This routine updates the l2fr (leaf 2 fine-root multiplier) variable ! It will also update the target - call this%CNPAdjustFRootTargets(target_c,target_dcdd,co_num,nplant) + !call this%CNPAdjustFRootTargets(target_c,target_dcdd,co_num,nplant) ! Remember the original C,N,P states to help with final ! evaluation of how much was allocated @@ -582,6 +582,11 @@ subroutine DailyPRTAllometricCNP(this,co_num,nplant) end do call endrun(msg=errMsg(sourcefile, __LINE__)) end if + + + ! This routine updates the l2fr (leaf 2 fine-root multiplier) variable + ! It will also update the target + !call this%CNPAdjustFRootTargets(target_c,target_dcdd,co_num,nplant) ! =================================================================================== ! Step 3. @@ -591,7 +596,7 @@ subroutine DailyPRTAllometricCNP(this,co_num,nplant) call this%CNPAllocateRemainder(c_gain, n_gain, p_gain, & c_gain0, n_gain0, p_gain0, & - c_efflux, n_efflux, p_efflux) + c_efflux, n_efflux, p_efflux,co_num,nplant,target_c,target_dcdd) if(n_uptake_mode.ne.prescribed_n_uptake) then @@ -730,6 +735,7 @@ subroutine CNPAdjustFRootTargets(this, target_c, target_dcdd,co_num,nplant) real(r8) :: logi_k real(r8) :: l2fr_mult real(r8) :: l2fr_delta + real(r8) :: nc_ratio, pc_ratio real(r8) :: dxcdt_ratio ! log change (derivative) of the maximum of the N/C and P/C storage ratio real(r8) :: xc_ratio ! log Maximum of the N/C and P/C storage ratio real(r8), pointer :: ema_xc ! The exponential moving average of the N-or-P versus C PID error function @@ -739,6 +745,14 @@ subroutine CNPAdjustFRootTargets(this, target_c, target_dcdd,co_num,nplant) real(r8), parameter :: max_l2fr_cgain_frac = 0.99_r8 real(r8), parameter :: xc_ratio_correction = 1.0_r8 + integer, parameter :: pid_c_function = 0 + integer, parameter :: pid_n_function = 1 + integer, parameter :: pid_minnc_function = 2 + integer, parameter :: pid_alogmaxnc_function = 3 + integer, parameter :: pid_ncratio_function = 4 + + !integer, parameter :: pid_function = pid_c_function + ! This is the relative scaling strength of the derivative term (K_d), ! compared to the combined proportion and integral term (K_p and K_i) ! Note the strength of the derivative is should be about half of the period @@ -767,8 +781,8 @@ subroutine CNPAdjustFRootTargets(this, target_c, target_dcdd,co_num,nplant) store_c_max = target_c(store_organ) - store_c_act = this%GetState(store_organ, carbon12_element) + & - this%bc_in(acnp_bc_in_id_netdc)%rval + store_c_act = max(0.001_r8*store_c_max,this%GetState(store_organ, carbon12_element) + & + this%bc_in(acnp_bc_in_id_netdc)%rval) if(n_uptake_mode.ne.prescribed_n_uptake)then @@ -780,15 +794,28 @@ subroutine CNPAdjustFRootTargets(this, target_c, target_dcdd,co_num,nplant) store_nut_act = this%GetState(store_organ, nitrogen_element) + & this%bc_inout(acnp_bc_inout_id_netdn)%rval - !n_ratio = xc_ratio_correction*min(50.0_r8,max(0.02_r8,(store_nut_act/store_nut_max)/(store_c_act/store_c_max))) - !n_ratio = xc_ratio_correction*min(50.0_r8,max(0.02_r8,(store_nut_act/store_nut_max))) - !n_ratio = xc_ratio_correction*min(50.0_r8,max(0.02_r8,1._r8/(store_c_act/store_c_max))) - - if((store_nut_act/store_nut_max) > (store_c_act/store_c_max))then - n_ratio = xc_ratio_correction*min(50.0_r8,max(0.02_r8,(store_c_max/store_c_act))) - else - n_ratio = xc_ratio_correction*min(50.0_r8,max(0.02_r8,(store_nut_act/store_nut_max))) - end if + select case(nint(EDPftvarcon_inst%dev_arbitrary_pft(ipft))) + case(pid_c_function) + n_ratio = store_c_max/store_c_act + case(pid_n_function) + n_ratio = store_nut_act/store_nut_max + case(pid_minnc_function) + if((store_nut_act/store_nut_max) > (store_c_act/store_c_max))then + n_ratio = (store_c_max/store_c_act) + else + n_ratio = (store_nut_act/store_nut_max) + end if + case(pid_alogmaxnc_function) + if( abs(log(store_nut_act/store_nut_max)) < abs(log(store_c_act/store_c_max))) then + n_ratio = (store_c_max/store_c_act) + else + n_ratio = (store_nut_act/store_nut_max) + end if + case(pid_ncratio_function) + n_ratio = (store_nut_act/store_nut_max)/(store_c_act/store_c_max) + end select + + nc_ratio = (store_nut_act/store_nut_max)/(store_c_act/store_c_max) else n_ratio = -1._r8 @@ -804,16 +831,28 @@ subroutine CNPAdjustFRootTargets(this, target_c, target_dcdd,co_num,nplant) store_nut_act = this%GetState(store_organ, phosphorus_element) + & this%bc_inout(acnp_bc_inout_id_netdp)%rval - !p_ratio = xc_ratio_correction*min(50.0_r8,max(0.02_r8,(store_nut_act/store_nut_max)/(store_c_act/store_c_max))) - p_ratio = xc_ratio_correction*min(50.0_r8,max(0.02_r8,(store_nut_act/store_nut_max))) - !p_ratio = xc_ratio_correction*min(50.0_r8,max(0.02_r8,1._r8/(store_c_act/store_c_max))) - - if((store_nut_act/store_nut_max) > (store_c_act/store_c_max))then - p_ratio = xc_ratio_correction*min(50.0_r8,max(0.02_r8,(store_c_max/store_c_act))) - else - p_ratio = xc_ratio_correction*min(50.0_r8,max(0.02_r8,(store_nut_act/store_nut_max))) - end if - + select case(nint(EDPftvarcon_inst%dev_arbitrary_pft(ipft))) + case(pid_c_function) + p_ratio = store_c_max/store_c_act + case(pid_n_function) + p_ratio = store_nut_act/store_nut_max + case(pid_minnc_function) + if((store_nut_act/store_nut_max) > (store_c_act/store_c_max))then + p_ratio = (store_c_max/store_c_act) + else + p_ratio = (store_nut_act/store_nut_max) + end if + case(pid_alogmaxnc_function) + if( abs(log(store_nut_act/store_nut_max)) < abs(log(store_c_act/store_c_max))) then + p_ratio = (store_c_max/store_c_act) + else + p_ratio = (store_nut_act/store_nut_max) + end if + case(pid_ncratio_function) + p_ratio = (store_nut_act/store_nut_max)/(store_c_act/store_c_max) + end select + + pc_ratio = (store_nut_act/store_nut_max)/(store_c_act/store_c_max) else p_ratio = -1._r8 @@ -875,34 +914,7 @@ subroutine CNPAdjustFRootTargets(this, target_c, target_dcdd,co_num,nplant) max(0._r8,target_c(struct_organ)-struct_c) - & max(0._r8,target_c(store_organ)-store_c)) - if(pid_method==pid_ratio) then - - l2fr_delta_max = (c_fnrt_expand + target_c(fnrt_organ))/target_c(fnrt_organ) - - ! This value could be negative if there is no gain, or less gain - ! than what can replace tissues, just ensure the multiplier is GT 1 - - l2fr_delta_max = max(1._r8,l2fr_delta_max) - - ! Determine the max change for the doubling timescale - ! 2.0 = l2fr_delta_max^frnt_adapt_tscl - - l2fr_delta_scale = 2._r8**(1._r8/prt_params%fnrt_adapt_tscale(ipft))-1.0_r8 - - ! Calculate the un-regulated l2fr multiplier - - logi_k = EDPftvarcon_inst%dev_arbitrary_pft(ipft) - l2fr_mult = l2fr_delta_scale*(2.0_r8/(1.0_r8 + exp(ema_xc)**logi_k)-1.0_r8)+1.0_r8 - - - if(l2fr_mult>1.0_r8)then - l2fr_mult = min(l2fr_mult,l2fr_delta_max) - end if - - l2fr = max(l2fr_min,l2fr * l2fr_mult) - - - elseif(pid_method==pid_logratio) then + if(pid_method==pid_logratio) then ! When using a log based (additive) PID search method ! we define 1/fnrt_adapt_tscale as delta we want @@ -914,10 +926,12 @@ subroutine CNPAdjustFRootTargets(this, target_c, target_dcdd,co_num,nplant) l2fr_delta_scale = (1._r8/prt_params%fnrt_adapt_tscale(ipft))/log(2.0_r8) + ! log(2.0_r8)*l2fr_delta_scale = (1._r8/prt_params%fnrt_adapt_tscale(ipft)) + ! ema_xc is already in log form to allow for averaging ! Want the derivative to be strongest when storage is most disproportionate - l2fr_deriv_scale = 0.0_r8 !0.25*abs(ema_xc/ema_dxcdt) + l2fr_deriv_scale = 0.0_r8 !-20.0_r8 !0.25*abs(ema_xc/ema_dxcdt) l2fr_int_scale = 0.0_r8 @@ -925,27 +939,28 @@ subroutine CNPAdjustFRootTargets(this, target_c, target_dcdd,co_num,nplant) ! we have already corrected enough to change the behavior, lets ! decrease the scaling - if( ((ema_xc > 0._r8) .and. (ema_dxcdt<0)) .or. ((ema_xc < 0._r8) .and. (ema_dxcdt>0))) then - l2fr_delta_scale = 0.05_r8 * l2fr_delta_scale + if( ((ema_xc > 0._r8) .and. (ema_dxcdt<0._r8)) .or. ((ema_xc < 0._r8) .and. (ema_dxcdt>0._r8))) then + l2fr_delta_scale = 0.1_r8 * l2fr_delta_scale sup_flag = 1 else sup_flag = 0 - end if !l2fr_delta = -l2fr_delta_scale*(min(0.2,max(-0.2,xc_ratio)) + ema_xc*l2fr_int_scale + ema_dxcdt*l2fr_deriv_scale) l2fr_delta = -l2fr_delta_scale*(xc_ratio + ema_xc*l2fr_int_scale + ema_dxcdt*l2fr_deriv_scale) - + ! Cap growth and shrinkage to avoid large changes ! (currently capping at projected rate for a 2:1 ratio - l2fr_delta_minmax = l2fr_delta_scale*log(2.0) + l2fr_delta_minmax = l2fr_delta_scale*log(20.0) ! Don't allow more growth than we have carbon to pay for - l2fr_delta_max = min(l2fr_delta_minmax,l2fr*(c_fnrt_expand + target_c(fnrt_organ))/target_c(fnrt_organ)) + !! l2fr_delta_max = min(l2fr_delta_minmax,l2fr*(c_fnrt_expand + target_c(fnrt_organ))/target_c(fnrt_organ)) - l2fr_delta = max(-l2fr_delta_minmax,min(l2fr_delta,l2fr_delta_max)) + !! l2fr_delta = max(-l2fr_delta_minmax,min(l2fr_delta,l2fr_delta_max)) + !!l2fr_delta = max(-l2fr_delta_minmax,min(l2fr_delta,l2fr_delta_minmax)) + ! Apply the delta, also, avoid generating incredibly small l2fr's, ! super small l2frs will occur in plants that perpetually get almost @@ -953,9 +968,7 @@ subroutine CNPAdjustFRootTargets(this, target_c, target_dcdd,co_num,nplant) l2fr = max(l2fr_min, l2fr + l2fr_delta ) - !if(co_num==1) - print*,'AAX1',co_num,hlm_current_year,hlm_day_of_year,dbh,nplant,sup_flag,xc_ratio,l2fr - + if(co_num==1) print*,'AAX1',co_num,hlm_current_year,hlm_day_of_year,dbh,nplant,sup_flag,log(nc_ratio),l2fr else @@ -1906,7 +1919,7 @@ end subroutine CNPStatureGrowth subroutine CNPAllocateRemainder(this, c_gain,n_gain,p_gain, & c_gain0, n_gain0, p_gain0, & - c_efflux, n_efflux, p_efflux) + c_efflux, n_efflux, p_efflux,co_num,nplant,target_c,target_dcdd) class(cnp_allom_prt_vartypes) :: this real(r8), intent(inout) :: c_gain @@ -1918,7 +1931,11 @@ subroutine CNPAllocateRemainder(this, c_gain,n_gain,p_gain, & real(r8), intent(inout) :: c_efflux real(r8), intent(inout) :: n_efflux real(r8), intent(inout) :: p_efflux - + integer,intent(in) :: co_num + real(r8),intent(in) :: nplant + real(r8) :: target_c(:) + real(r8) :: target_dcdd(:) + integer :: i real(r8), dimension(num_organs) :: deficit_n real(r8), dimension(num_organs) :: deficit_p @@ -2040,7 +2057,7 @@ subroutine CNPAllocateRemainder(this, c_gain,n_gain,p_gain, & deficit_p(i) = max(0._r8,this%GetDeficit(phosphorus_element,l2g_organ_list(i),target_p)) end do - + ! ----------------------------------------------------------------------------------- ! Nutrient Fluxes proportionally to each pool (these should be fully actualized) ! (this also removes from the gain pools) @@ -2054,8 +2071,8 @@ subroutine CNPAllocateRemainder(this, c_gain,n_gain,p_gain, & call ProportionalNutrAllocation(this,deficit_p(1:num_organs), & p_gain, phosphorus_element, l2g_organ_list(1:num_organs)) - - + call this%CNPAdjustFRootTargets(target_c,target_dcdd,co_num,nplant) + ! ----------------------------------------------------------------------------------- From 8df96ae17d830cf3f7fe0b9c38dbb7eb8d30a020 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Tue, 20 Sep 2022 21:46:44 -0400 Subject: [PATCH 31/55] various code modifications while exploring PID functions --- biogeochem/EDCanopyStructureMod.F90 | 6 + biogeochem/EDPhysiologyMod.F90 | 1 - biogeophys/FatesPlantRespPhotosynthMod.F90 | 3 +- main/EDMainMod.F90 | 31 ++--- parteh/PRTAllometricCNPMod.F90 | 134 ++++++++++++--------- 5 files changed, 98 insertions(+), 77 deletions(-) diff --git a/biogeochem/EDCanopyStructureMod.F90 b/biogeochem/EDCanopyStructureMod.F90 index 9bae9e6a35..a683ef8a11 100644 --- a/biogeochem/EDCanopyStructureMod.F90 +++ b/biogeochem/EDCanopyStructureMod.F90 @@ -720,6 +720,12 @@ subroutine DemoteFromLayer(currentSite,currentPatch,i_lyr,bc_in) end if ! kill the ones which go into canopy layers that are not allowed + + ! USE THIS OVERRIDE IF YOU ARE FORCING A ONE COHORT SIMULATION + ! (also make sure to turn off germination, external seed rain, + ! (use only one PFT, and make sure disturb_frac is 0) + ! (RGK-0822) + !if(currentCohort%canopy_layer>1) then if(currentCohort%canopy_layer>nclmax )then ! put the litter from the terminated cohorts diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 2573dae56e..6e3a1a8bd0 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -751,7 +751,6 @@ subroutine phenology( currentSite, bc_in ) ! continues monotonically, indefinitely model_day_int = nint(hlm_model_day) - ! Use the following layer index to calculate drought conditions ilayer_swater = minloc(abs(bc_in%z_sisl(:)-dphen_soil_depth),dim=1) diff --git a/biogeophys/FatesPlantRespPhotosynthMod.F90 b/biogeophys/FatesPlantRespPhotosynthMod.F90 index 80228bb582..32fa3c04ec 100644 --- a/biogeophys/FatesPlantRespPhotosynthMod.F90 +++ b/biogeophys/FatesPlantRespPhotosynthMod.F90 @@ -346,6 +346,7 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) ! CO2 compensation point (Pa) ! leaf boundary layer conductance of h20 ! constrained vapor pressure + call GetCanopyGasParameters(bc_in(s)%forc_pbot, & ! in bc_in(s)%oair_pa(ifp), & ! in bc_in(s)%t_veg_pa(ifp), & ! in @@ -2127,7 +2128,7 @@ subroutine lowstorage_maintresp_reduction(frac, pft, maintresp_reduction_factor) ! --------------------------------------------------------------------------------- if( frac .lt. 1._r8 )then - if ( EDPftvarcon_inst%maintresp_reduction_curvature(pft) .ne. 1._r8 ) then + if ( abs(EDPftvarcon_inst%maintresp_reduction_curvature(pft)-1._r8) > nearzero ) then maintresp_reduction_factor = (1._r8 - EDPftvarcon_inst%maintresp_reduction_intercept(pft)) + & EDPftvarcon_inst%maintresp_reduction_intercept(pft) * & (1._r8 - EDPftvarcon_inst%maintresp_reduction_curvature(pft)**frac) & diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index 0e527e83e5..fd3fe332d6 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -431,7 +431,6 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) currentCohort%gpp_acc_hold = currentCohort%gpp_acc * real(hlm_days_per_year,r8) currentCohort%resp_acc_hold = currentCohort%resp_acc * real(hlm_days_per_year,r8) - ! Conduct Maintenance Turnover (parteh) if(debug) call currentCohort%prt%CheckMassConservation(ft,3) if(any(currentSite%dstatus == [phen_dstat_moiston,phen_dstat_timeon])) then @@ -470,18 +469,18 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) call EffluxIntoLitterPools(currentSite, currentPatch, currentCohort, bc_in ) - - - - ! Mass balance for N uptake - currentSite%mass_balance(element_pos(nitrogen_element))%net_root_uptake = & - currentSite%mass_balance(element_pos(nitrogen_element))%net_root_uptake + & - (currentCohort%daily_n_gain-currentCohort%daily_n_efflux)*currentCohort%n - - ! Mass balance for P uptake - currentSite%mass_balance(element_pos(phosphorus_element))%net_root_uptake = & - currentSite%mass_balance(element_pos(phosphorus_element))%net_root_uptake + & - (currentCohort%daily_p_uptake-currentCohort%daily_p_efflux)*currentCohort%n + if(element_pos(nitrogen_element)>0) then + ! Mass balance for N uptake + currentSite%mass_balance(element_pos(nitrogen_element))%net_root_uptake = & + currentSite%mass_balance(element_pos(nitrogen_element))%net_root_uptake + & + (currentCohort%daily_n_gain-currentCohort%daily_n_efflux)*currentCohort%n + end if + if(element_pos(phosphorus_element)>0) then + ! Mass balance for P uptake + currentSite%mass_balance(element_pos(phosphorus_element))%net_root_uptake = & + currentSite%mass_balance(element_pos(phosphorus_element))%net_root_uptake + & + (currentCohort%daily_p_uptake-currentCohort%daily_p_efflux)*currentCohort%n + end if ! mass balance for C efflux (if any) currentSite%mass_balance(element_pos(carbon12_element))%net_root_uptake = & @@ -556,8 +555,10 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) ! Update history diagnostics related to Nutrients (if any) ! ----------------------------------------------------------------------------- - - call fates_hist%update_history_nutrflux(currentSite) + select case(hlm_parteh_mode) + case (prt_cnp_flex_allom_hyp) + call fates_hist%update_history_nutrflux(currentSite) + end select ! When plants die, the water goes with them. This effects ! the water balance. diff --git a/parteh/PRTAllometricCNPMod.F90 b/parteh/PRTAllometricCNPMod.F90 index e79c63ab6d..21c4544a41 100644 --- a/parteh/PRTAllometricCNPMod.F90 +++ b/parteh/PRTAllometricCNPMod.F90 @@ -107,8 +107,8 @@ module PRTAllometricCNPMod integer, parameter, private :: pid_spe_controller = storage_spe - real(r8), parameter, private :: pid_int_wgt = 1._r8/10._r8 ! n-day smoothing (K on the integral of PID) - real(r8), parameter, private :: pid_drv_wgt = 1._r8/10._r8 ! n-day smoothing (K on the derivative of PID) + real(r8), parameter, private :: pid_int_wgt = 1._r8/1._r8 ! n-day smoothing (K on the integral of PID) + real(r8), parameter, private :: pid_drv_wgt = 1._r8/20._r8 ! n-day smoothing (K on the derivative of PID) ! Global identifiers for the two stoichiometry values integer,public, parameter :: stoich_growth_min = 1 ! Flag for stoichiometry associated with @@ -504,35 +504,21 @@ subroutine DailyPRTAllometricCNP(this,co_num,nplant) n_efflux => this%bc_out(acnp_bc_out_id_nefflux)%rval; n_efflux = 0._r8 p_efflux => this%bc_out(acnp_bc_out_id_pefflux)%rval; p_efflux = 0._r8 - ! Bring storage pools down to the first target put overflow into gain pools - store_flux = max(0._r8, this%variables(store_c_id)%val(1) - target_c(store_organ)) - c_gain = c_gain + store_flux - this%variables(store_c_id)%val(1) = this%variables(store_c_id)%val(1) - store_flux - target_n = this%GetNutrientTarget(nitrogen_element,store_organ,stoich_growth_min) - store_flux = max(0._r8, this%variables(store_n_id)%val(1) - target_n) - n_gain = n_gain + store_flux - this%variables(store_n_id)%val(1) = this%variables(store_n_id)%val(1) - store_flux - target_p = this%GetNutrientTarget(phosphorus_element,store_organ,stoich_growth_min) - store_flux = max(0._r8, this%variables(store_p_id)%val(1) - target_p) - p_gain = p_gain + store_flux - this%variables(store_p_id)%val(1) = this%variables(store_p_id)%val(1) - store_flux - ! =================================================================================== ! Step 0. Transfer all stored nutrient into the daily uptake pool. Also ! transfer C storage that is above the target (ie transfer overflow) ! =================================================================================== ! Put overflow storage into the net daily pool - !store_flux = max(0._r8, this%variables(store_c_id)%val(1) - target_c(store_organ)) - !c_gain = c_gain + store_flux - !this%variables(store_c_id)%val(1) = this%variables(store_c_id)%val(1) - store_flux + store_flux = max(0._r8, this%variables(store_c_id)%val(1) - target_c(store_organ)) + c_gain = c_gain + store_flux + this%variables(store_c_id)%val(1) = this%variables(store_c_id)%val(1) - store_flux n_gain = n_gain + sum(this%variables(store_n_id)%val(:)) this%variables(store_n_id)%val(:) = 0._r8 p_gain = p_gain + sum(this%variables(store_p_id)%val(:)) this%variables(store_p_id)%val(:) = 0._r8 - ! =================================================================================== @@ -707,6 +693,24 @@ subroutine DailyPRTAllometricCNP(this,co_num,nplant) return end subroutine DailyPRTAllometricCNP + + function SafeLog(val) result(logval) + + ! The log functions used to transform storage ratios + ! need not be large. Even a ratio of 10 is sending a strong signal to the + ! root adaptation algorithm to change course pretty strongly. We set + ! bounds of e3 here to prevent numerical overflows and underflows + + real(r8) :: val + real(r8) :: logval + real(r8), parameter :: safelog_min = 0.001_r8 !Don't pass anything smaller to a log + real(r8), parameter :: safelog_max = 1000._r8 + + logval = log(max(safelog_min,min(safelog_max,val))) + + end function SafeLog + + ! ===================================================================================== subroutine CNPAdjustFRootTargets(this, target_c, target_dcdd,co_num,nplant) @@ -735,7 +739,7 @@ subroutine CNPAdjustFRootTargets(this, target_c, target_dcdd,co_num,nplant) real(r8) :: logi_k real(r8) :: l2fr_mult real(r8) :: l2fr_delta - real(r8) :: nc_ratio, pc_ratio + real(r8) :: cn_ratio, cp_ratio real(r8) :: dxcdt_ratio ! log change (derivative) of the maximum of the N/C and P/C storage ratio real(r8) :: xc_ratio ! log Maximum of the N/C and P/C storage ratio real(r8), pointer :: ema_xc ! The exponential moving average of the N-or-P versus C PID error function @@ -745,6 +749,7 @@ subroutine CNPAdjustFRootTargets(this, target_c, target_dcdd,co_num,nplant) real(r8), parameter :: max_l2fr_cgain_frac = 0.99_r8 real(r8), parameter :: xc_ratio_correction = 1.0_r8 + integer, parameter :: pid_c_function = 0 integer, parameter :: pid_n_function = 1 integer, parameter :: pid_minnc_function = 2 @@ -758,8 +763,9 @@ subroutine CNPAdjustFRootTargets(this, target_c, target_dcdd,co_num,nplant) ! Note the strength of the derivative is should be about half of the period ! for an oscillation when turned off, to balance the K_p and K_i terms. ! This will have to be tuned in a sequence of 1, 10, 100, etc... - real(r8) :: l2fr_deriv_scale != 200._r8 - real(r8) :: l2fr_int_scale + real(r8) :: pid_k_i ! Integral scaling coefficient in PID + real(r8) :: pid_k_d ! Derivative scaling coefficient in PID + real(r8) :: pid_k_p ! Proportional scaling coefficient in PID ! If we do not have leaves out, then the relative nutrient vs carbon ! balancing is meaningless, just leave this routine @@ -791,10 +797,11 @@ subroutine CNPAdjustFRootTargets(this, target_c, target_dcdd,co_num,nplant) store_nut_max = this%GetNutrientTarget(nitrogen_element,store_organ,stoich_growth_min) - store_nut_act = this%GetState(store_organ, nitrogen_element) + & - this%bc_inout(acnp_bc_inout_id_netdn)%rval + store_nut_act = max(0.001_r8*store_nut_max, & + this%GetState(store_organ, nitrogen_element) + & + this%bc_inout(acnp_bc_inout_id_netdn)%rval) - select case(nint(EDPftvarcon_inst%dev_arbitrary_pft(ipft))) + select case(pid_ncratio_function) !nint(EDPftvarcon_inst%dev_arbitrary_pft(ipft)) ) case(pid_c_function) n_ratio = store_c_max/store_c_act case(pid_n_function) @@ -806,16 +813,16 @@ subroutine CNPAdjustFRootTargets(this, target_c, target_dcdd,co_num,nplant) n_ratio = (store_nut_act/store_nut_max) end if case(pid_alogmaxnc_function) - if( abs(log(store_nut_act/store_nut_max)) < abs(log(store_c_act/store_c_max))) then + if( abs(SafeLog(store_nut_act/store_nut_max)) < abs(SafeLog(store_c_act/store_c_max))) then n_ratio = (store_c_max/store_c_act) else n_ratio = (store_nut_act/store_nut_max) end if case(pid_ncratio_function) - n_ratio = (store_nut_act/store_nut_max)/(store_c_act/store_c_max) + n_ratio = (store_c_act/store_c_max)/(store_nut_act/store_nut_max) end select - nc_ratio = (store_nut_act/store_nut_max)/(store_c_act/store_c_max) + cn_ratio = (store_c_act/store_c_max)/(store_nut_act/store_nut_max) else n_ratio = -1._r8 @@ -828,10 +835,11 @@ subroutine CNPAdjustFRootTargets(this, target_c, target_dcdd,co_num,nplant) store_nut_max = this%GetNutrientTarget(phosphorus_element,store_organ,stoich_growth_min) - store_nut_act = this%GetState(store_organ, phosphorus_element) + & - this%bc_inout(acnp_bc_inout_id_netdp)%rval + store_nut_act = max(0.001_r8*store_nut_max, & + this%GetState(store_organ, phosphorus_element) + & + this%bc_inout(acnp_bc_inout_id_netdp)%rval) - select case(nint(EDPftvarcon_inst%dev_arbitrary_pft(ipft))) + select case(pid_ncratio_function) !nint(EDPftvarcon_inst%dev_arbitrary_pft(ipft))) case(pid_c_function) p_ratio = store_c_max/store_c_act case(pid_n_function) @@ -843,16 +851,16 @@ subroutine CNPAdjustFRootTargets(this, target_c, target_dcdd,co_num,nplant) p_ratio = (store_nut_act/store_nut_max) end if case(pid_alogmaxnc_function) - if( abs(log(store_nut_act/store_nut_max)) < abs(log(store_c_act/store_c_max))) then + if( abs(SafeLog(store_nut_act/store_nut_max)) < abs(SafeLog(store_c_act/store_c_max))) then p_ratio = (store_c_max/store_c_act) else p_ratio = (store_nut_act/store_nut_max) end if case(pid_ncratio_function) - p_ratio = (store_nut_act/store_nut_max)/(store_c_act/store_c_max) + p_ratio = (store_c_act/store_c_max)/(store_nut_act/store_nut_max) end select - pc_ratio = (store_nut_act/store_nut_max)/(store_c_act/store_c_max) + cp_ratio = (store_c_act/store_c_max)/(store_nut_act/store_nut_max) else p_ratio = -1._r8 @@ -866,12 +874,28 @@ subroutine CNPAdjustFRootTargets(this, target_c, target_dcdd,co_num,nplant) return else - xc_ratio = log(min(n_ratio,p_ratio)) + xc_ratio = SafeLog(max(n_ratio,p_ratio)) - dxcdt_ratio = xc_ratio-xc0 + ! If xc_ratio has just crossed zero, then + ! reset the integrator. This will be true if + ! the sign of the current ratio is different than + ! the sign of the previous - ema_xc = pid_int_wgt*xc_ratio + (1._r8-pid_int_wgt)*ema_xc + if( (xc_ratio/abs(xc_ratio) - xc0/abs(xc0)) > nearzero ) then + ema_xc = xc_ratio + else + ema_xc = ema_xc + xc_ratio + end if + + dxcdt_ratio = xc_ratio-xc0 + + !ema_xc = pid_int_wgt*xc_ratio + (1._r8-pid_int_wgt)*ema_xc ema_dxcdt = pid_drv_wgt*dxcdt_ratio + (1._r8-pid_drv_wgt)*ema_dxcdt + + + !ema_xc = (1._r8/EDPftvarcon_inst%dev_arbitrary_pft(ipft))*xc_ratio + & + ! (1._r8-(1._r8/EDPftvarcon_inst%dev_arbitrary_pft(ipft)))*ema_xc + xc0 = xc_ratio @@ -926,30 +950,15 @@ subroutine CNPAdjustFRootTargets(this, target_c, target_dcdd,co_num,nplant) l2fr_delta_scale = (1._r8/prt_params%fnrt_adapt_tscale(ipft))/log(2.0_r8) - ! log(2.0_r8)*l2fr_delta_scale = (1._r8/prt_params%fnrt_adapt_tscale(ipft)) - - ! ema_xc is already in log form to allow for averaging - ! Want the derivative to be strongest when storage is most disproportionate - l2fr_deriv_scale = 0.0_r8 !-20.0_r8 !0.25*abs(ema_xc/ema_dxcdt) - l2fr_int_scale = 0.0_r8 - - - ! To limit overshoot, when either positive and decending or negative and ascending - ! we have already corrected enough to change the behavior, lets - ! decrease the scaling - - if( ((ema_xc > 0._r8) .and. (ema_dxcdt<0._r8)) .or. ((ema_xc < 0._r8) .and. (ema_dxcdt>0._r8))) then - l2fr_delta_scale = 0.1_r8 * l2fr_delta_scale - sup_flag = 1 - else - sup_flag = 0 - end if - + pid_k_d = prt_params%fnrt_adapt_tscale(ipft) !-0.1_r8 + pid_k_i = 0.0_r8 !EDPftvarcon_inst%dev_arbitrary_pft(ipft) !-0.0001_r8 + pid_k_p = EDPftvarcon_inst%dev_arbitrary_pft(ipft) !0.0005_r8 - !l2fr_delta = -l2fr_delta_scale*(min(0.2,max(-0.2,xc_ratio)) + ema_xc*l2fr_int_scale + ema_dxcdt*l2fr_deriv_scale) - l2fr_delta = -l2fr_delta_scale*(xc_ratio + ema_xc*l2fr_int_scale + ema_dxcdt*l2fr_deriv_scale) + l2fr_delta = pid_k_p*xc_ratio + pid_k_i*ema_xc + pid_k_d*ema_dxcdt + !l2fr_delta = ema_xc/abs(ema_xc)*l2fr_int_scale + ema_dxcdt*l2fr_deriv_scale + ! Cap growth and shrinkage to avoid large changes ! (currently capping at projected rate for a 2:1 ratio l2fr_delta_minmax = l2fr_delta_scale*log(20.0) @@ -968,7 +977,8 @@ subroutine CNPAdjustFRootTargets(this, target_c, target_dcdd,co_num,nplant) l2fr = max(l2fr_min, l2fr + l2fr_delta ) - if(co_num==1) print*,'AAX1',co_num,hlm_current_year,hlm_day_of_year,dbh,nplant,sup_flag,log(nc_ratio),l2fr + !if((co_num==1) .or. (co_num==2)) print*,'AAX1',co_num,hlm_current_year,hlm_day_of_year, & + ! dbh,nplant,(store_c_act/store_c_max),cn_ratio,SafeLog(cn_ratio),l2fr else @@ -977,6 +987,7 @@ subroutine CNPAdjustFRootTargets(this, target_c, target_dcdd,co_num,nplant) end if + ! Find the updated target fineroot biomass call bfineroot(dbh,ipft,canopy_trim, l2fr, target_c(fnrt_organ),target_dcdd(fnrt_organ)) @@ -2036,8 +2047,11 @@ subroutine CNPAllocateRemainder(this, c_gain,n_gain,p_gain, & xc_ratio = 1.0_r8 end if + dxcdt_ratio = log(xc_ratio)-xc0 ema_xc = pid_int_wgt*log(xc_ratio) + (1._r8-pid_int_wgt)*ema_xc - + ema_dxcdt = pid_drv_wgt*dxcdt_ratio + (1._r8-pid_drv_wgt)*ema_dxcdt + xc0 = log(xc_ratio) + end if From 75a771082759d2fdf9dcd125260c486c8be368c3 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Wed, 21 Sep 2022 22:24:07 -0400 Subject: [PATCH 32/55] Updating parameter names to include PID. Cleaning up parteh CNP code --- parameter_files/fates_params_default.cdl | 29 +- parameter_files/patch_default_bciopt224.xml | 5 +- parteh/PRTAllometricCNPMod.F90 | 335 ++++++-------------- parteh/PRTParametersMod.F90 | 9 +- parteh/PRTParamsFATESMod.F90 | 30 +- 5 files changed, 141 insertions(+), 267 deletions(-) diff --git a/parameter_files/fates_params_default.cdl b/parameter_files/fates_params_default.cdl index 3028fcb968..5cc5cbbbfa 100644 --- a/parameter_files/fates_params_default.cdl +++ b/parameter_files/fates_params_default.cdl @@ -44,9 +44,6 @@ variables: char fates_prt_organ_name(fates_prt_organs, fates_string_length) ; fates_prt_organ_name:units = "unitless - string" ; fates_prt_organ_name:long_name = "Name of plant organs (order must match PRTGenericMod.F90)" ; - double fates_fnrt_adapt_tscale(fates_pft) ; - fates_fnrt_adapt_tscale:units = "fraction" ; - fates_fnrt_adapt_tscale:long_name = "Number of days that is the shortest possible doubling period for CNP fine-root adaptation" ; double fates_alloc_storage_cushion(fates_pft) ; fates_alloc_storage_cushion:units = "fraction" ; fates_alloc_storage_cushion:long_name = "maximum size of storage C pool, relative to maximum size of leaf C pool" ; @@ -159,6 +156,15 @@ variables: double fates_c2b(fates_pft) ; fates_c2b:units = "ratio" ; fates_c2b:long_name = "Carbon to biomass multiplier of bulk structural tissues" ; + double fates_cnp_pid_kd(fates_pft) ; + fates_cnp_pid_kd:units = "unknown" ; + fates_cnp_pid_kd:long_name = "derivative constant of the PID controller on adaptive fine-root biomass" ; + double fates_cnp_pid_ki(fates_pft) ; + fates_cnp_pid_ki:units = "unknown" ; + fates_cnp_pid_ki:long_name = "integral constant of the PID controller on adaptive fine-root biomass" ; + double fates_cnp_pid_kp(fates_pft) ; + fates_cnp_pid_kp:units = "unknown" ; + fates_cnp_pid_kp:long_name = "proportional constant of the PID controller on adaptive fine-root biomass" ; double fates_dev_arbitrary_pft(fates_pft) ; fates_dev_arbitrary_pft:units = "unknown" ; fates_dev_arbitrary_pft:long_name = "Unassociated pft dimensioned free parameter that developers can use for testing arbitrary new hypotheses" ; @@ -505,9 +511,9 @@ variables: double fates_smpso(fates_pft) ; fates_smpso:units = "mm" ; fates_smpso:long_name = "Soil water potential at full stomatal opening" ; - double fates_store_ovrflw_frac(fates_pft) ; - fates_store_ovrflw_frac:units = "fraction" ; - fates_store_ovrflw_frac:long_name = "size of overflow storage (CNP only) as a fraction of storage target" ; + double fates_cnp_store_ovrflw_frac(fates_pft) ; + fates_cnp_store_ovrflw_frac:units = "fraction" ; + fates_cnp_store_ovrflw_frac:long_name = "size of overflow storage (CNP only) as a fraction of storage target" ; double fates_taulnir(fates_pft) ; fates_taulnir:units = "fraction" ; fates_taulnir:long_name = "Leaf transmittance: near-IR" ; @@ -813,9 +819,6 @@ data: "sapwood ", "structure " ; - - fates_fnrt_adapt_tscale = 30.0,30.0,30.0,30.0,30.0,30.0,30.0,30.0, 30.0,30.0,30.0,30.0; - fates_alloc_storage_cushion = 1.2, 1.2, 1.2, 1.2, 1.2, 1.2, 1.2, 1.2, 1.2, 1.2, 1.2, 1.2 ; @@ -907,6 +910,12 @@ data: fates_c2b = 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2 ; + fates_cnp_pid_kd = 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1 ; + + fates_cnp_pid_ki = 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 ; + + fates_cnp_pid_kp = 5e-4, 5e-4, 5e-4, 5e-4, 5e-4, 5e-4, 5e-4, 5e-4, 5e-4, 5e-4, 5e-4, 5e-4 ; + fates_dev_arbitrary_pft = _, _, _, _, _, _, _, _, _, _, _, _ ; fates_displar = 0.67, 0.67, 0.67, 0.67, 0.67, 0.67, 0.67, 0.67, 0.67, 0.67, @@ -1295,7 +1304,7 @@ data: fates_smpso = -66000, -66000, -66000, -66000, -66000, -66000, -66000, -66000, -66000, -66000, -66000, -66000 ; - fates_store_ovrflw_frac = 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0 ; + fates_cnp_store_ovrflw_frac = 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0 ; fates_taulnir = 0.25, 0.1, 0.1, 0.25, 0.25, 0.25, 0.1, 0.25, 0.25, 0.34, 0.34, 0.34 ; diff --git a/parameter_files/patch_default_bciopt224.xml b/parameter_files/patch_default_bciopt224.xml index 73f37057d6..9897db82d6 100644 --- a/parameter_files/patch_default_bciopt224.xml +++ b/parameter_files/patch_default_bciopt224.xml @@ -2,7 +2,7 @@ This parameter dataset was created by Ryan Knox rgknox@lbl.gov. Please contact if using in published work. The calibration uses the following datasets: [1] Ely et al. 2019. Leaf mass area, Panama. NGEE-Tropics data collection.http://dx.doi.org/10.15486/ngt/1411973 and [2] Condit et al. 2019. Complete data from the Barro Colorado 50-ha plot. https://doi.org/10.15146/5xcp-0d46. [3] Koven et al. 2019. Benchmarking and parameter sensitivity of physiological and vegetation dynamics using the functionally assembled terrestrial ecosystem simulator. Biogeosciences. The ECA nutrient aquisition parmeters are unconstrained, the file output naming convention vmn6phi is shorthand for vmax for nitrogen uptake is order e-6 and for phosphorus is excessively high. These parameters were calibrated with the special fates modification in main/EDTypesMod.F90: nclmax = 3 fates_params_default.cdl - fates_params_opt224_040822.cdl + fates_params_opt224_040822_v2.cdl 1 0 @@ -33,8 +33,7 @@ 5 0.4863088 0.0 - 10 - 1 + 1 3 5e-09 5e-09 diff --git a/parteh/PRTAllometricCNPMod.F90 b/parteh/PRTAllometricCNPMod.F90 index 21c4544a41..84713c8b91 100644 --- a/parteh/PRTAllometricCNPMod.F90 +++ b/parteh/PRTAllometricCNPMod.F90 @@ -73,8 +73,6 @@ module PRTAllometricCNPMod ! ! ------------------------------------------------------------------------------------- - - integer, parameter :: leaf_c_id = 1 ! leaf carbon index integer, parameter :: fnrt_c_id = 2 ! fine-root carbon index integer, parameter :: sapw_c_id = 3 ! sapwood carbon index @@ -98,17 +96,7 @@ module PRTAllometricCNPMod ! Total number of state variables integer, parameter :: num_vars = 18 - - - ! Setpoint Error controller method - integer, parameter, private :: storage_spe = 0 - integer, parameter, private :: binary_limiter_spe = 1 - integer, parameter, private :: daily_gain_ratio_spe = 2 - - integer, parameter, private :: pid_spe_controller = storage_spe - - real(r8), parameter, private :: pid_int_wgt = 1._r8/1._r8 ! n-day smoothing (K on the integral of PID) - real(r8), parameter, private :: pid_drv_wgt = 1._r8/20._r8 ! n-day smoothing (K on the derivative of PID) + ! Global identifiers for the two stoichiometry values integer,public, parameter :: stoich_growth_min = 1 ! Flag for stoichiometry associated with @@ -141,10 +129,7 @@ module PRTAllometricCNPMod integer, parameter :: num_intgr_vars = 7 - integer, parameter :: cnp_limited = 0 - integer, parameter :: c_limited = 1 - integer, parameter :: n_limited = 2 - integer, parameter :: p_limited = 3 + ! ------------------------------------------------------------------------------------- ! Input/Output Boundary Indices (These are public, and therefore @@ -201,41 +186,42 @@ module PRTAllometricCNPMod ! ------------------------------------------------------------------------------------- ! Define the size of the coorindate vector. For this hypothesis, there is only ! one pool per each species x organ combination, except for leaves (WHICH HAVE AGE) + ! icd refers to the first index in the leaf array, which is the youngest. Growth + ! and allocation only happens in the youngest bin by definition ! ------------------------------------------------------------------------------------- integer, parameter :: icd = 1 + ! These constants define different methods of dealing with excess carbon at + ! the end of the allocation process, assuming that N or P is limiting growth. + ! You can either exude (send to soil), retain (grow storage without limit), + ! or burn (as respiration to the atm). integer, parameter :: exude_c_store_overflow = 1 integer, parameter :: retain_c_store_overflow = 2 integer, parameter :: burn_c_store_overflow = 3 - integer, parameter :: store_c_overflow = burn_c_store_overflow - ! Following growth, if desired, you can prioritize reproductive - logical, parameter :: prioritize_repro_nutr_growth = .true. + ! These constants define if/how growth is limited by + ! one of the 3 chemical species, 0 indicates there is some + ! degree of co limitation + integer, parameter :: cnp_limited = 0 + integer, parameter :: c_limited = 1 + integer, parameter :: n_limited = 2 + integer, parameter :: p_limited = 3 + - ! Definitions for the regulation functions. These typically translate - ! a storage fraction into a scalar used to regulate resources somehow + ! Following growth, if desired, you can prioritize that + ! reproductive tissues get balanced CNP + logical, parameter :: prioritize_repro_nutr_growth = .true. - integer, parameter :: regulate_linear = 1 ! DEPRECATED - integer, parameter :: regulate_logi = 2 ! DEPRECATED - integer, parameter :: regulate_CN_logi = 3 ! almost deprecated - integer, parameter :: regulate_CN_dfdd = 4 - - logical, parameter :: use_gains_in_regulator = .true. + ! If this parameter is true, then the fine-root l2fr optimization + ! scheme will remove biomass from roots without restriction if the + ! l2fr is getting smaller. logical, parameter :: use_unrestricted_contraction = .true. - integer, parameter :: pid_ratio = 1 - integer, parameter :: pid_logratio = 2 - - integer, parameter :: pid_method = pid_logratio - - ! ------------------------------------------------------------------------------------- ! This is the core type that holds this specific ! plant reactive transport (PRT) module ! ------------------------------------------------------------------------------------- - - type, public, extends(prt_vartypes) :: cnp_allom_prt_vartypes contains @@ -498,7 +484,6 @@ subroutine DailyPRTAllometricCNP(this,co_num,nplant) end do - ! Output only boundary conditions c_efflux => this%bc_out(acnp_bc_out_id_cefflux)%rval; c_efflux = 0._r8 n_efflux => this%bc_out(acnp_bc_out_id_nefflux)%rval; n_efflux = 0._r8 @@ -732,23 +717,21 @@ subroutine CNPAdjustFRootTargets(this, target_c, target_dcdd,co_num,nplant) real(r8) :: store_c_max, store_c_act real(r8) :: store_nut_max, store_nut_act real(r8) :: n_ratio, p_ratio, np_ratio - real(r8) :: fnrt_c,leaf_c,store_c,struct_c,sapw_c,c_gain,c_fnrt_expand + real(r8) :: fnrt_c,leaf_c,store_c,struct_c,sapw_c,c_gain + real(r8) :: c_fnrt_expand real(r8) :: l2fr_delta_max - real(r8) :: l2fr_delta_minmax ! Hard cap on maximum change scale*log(2) - real(r8) :: l2fr_delta_scale real(r8) :: logi_k real(r8) :: l2fr_mult real(r8) :: l2fr_delta real(r8) :: cn_ratio, cp_ratio real(r8) :: dxcdt_ratio ! log change (derivative) of the maximum of the N/C and P/C storage ratio - real(r8) :: xc_ratio ! log Maximum of the N/C and P/C storage ratio - real(r8), pointer :: ema_xc ! The exponential moving average of the N-or-P versus C PID error function - real(r8), pointer :: xc0 ! The log of the xc ratio from previous time-step - real(r8), pointer :: ema_dxcdt ! the EMA of the change in log storage ratio + real(r8) :: cx_logratio ! log Maximum of the C/N and C/P storage ratio + real(r8), pointer :: cx_int ! Integration of the cx_logratio + real(r8), pointer :: cx0 ! The log of the cx ratio from previous time-step + real(r8), pointer :: ema_dcxdt ! the EMA of the change in log storage ratio integer :: sup_flag real(r8), parameter :: max_l2fr_cgain_frac = 0.99_r8 - real(r8), parameter :: xc_ratio_correction = 1.0_r8 - + real(r8), parameter :: pid_drv_wgt = 1._r8/20._r8 ! n-day smoothing (K on the derivative of PID) integer, parameter :: pid_c_function = 0 integer, parameter :: pid_n_function = 1 @@ -756,17 +739,6 @@ subroutine CNPAdjustFRootTargets(this, target_c, target_dcdd,co_num,nplant) integer, parameter :: pid_alogmaxnc_function = 3 integer, parameter :: pid_ncratio_function = 4 - !integer, parameter :: pid_function = pid_c_function - - ! This is the relative scaling strength of the derivative term (K_d), - ! compared to the combined proportion and integral term (K_p and K_i) - ! Note the strength of the derivative is should be about half of the period - ! for an oscillation when turned off, to balance the K_p and K_i terms. - ! This will have to be tuned in a sequence of 1, 10, 100, etc... - real(r8) :: pid_k_i ! Integral scaling coefficient in PID - real(r8) :: pid_k_d ! Derivative scaling coefficient in PID - real(r8) :: pid_k_p ! Proportional scaling coefficient in PID - ! If we do not have leaves out, then the relative nutrient vs carbon ! balancing is meaningless, just leave this routine if(this%GetState(leaf_organ, carbon12_element)/target_c(leaf_organ) < 0.5_r8) return @@ -776,12 +748,10 @@ subroutine CNPAdjustFRootTargets(this, target_c, target_dcdd,co_num,nplant) l2fr => this%bc_inout(acnp_bc_inout_id_l2fr)%rval dbh => this%bc_inout(acnp_bc_inout_id_dbh)%rval canopy_trim = this%bc_in(acnp_bc_in_id_ctrim)%rval - ema_xc => this%bc_inout(acnp_bc_inout_id_emaxc)%rval - xc0 => this%bc_inout(acnp_bc_inout_id_xc0)%rval - ema_dxcdt => this%bc_inout(acnp_bc_inout_id_emadxcdt)%rval + cx_int => this%bc_inout(acnp_bc_inout_id_emaxc)%rval + cx0 => this%bc_inout(acnp_bc_inout_id_xc0)%rval + ema_dcxdt => this%bc_inout(acnp_bc_inout_id_emadxcdt)%rval - if_storage_spe: if(pid_spe_controller == storage_spe) then - ! Step 1: Determine the nutrient to carbon ratio (aka relative health factor) ! ----------------------------------------------------------------------------------- @@ -801,27 +771,29 @@ subroutine CNPAdjustFRootTargets(this, target_c, target_dcdd,co_num,nplant) this%GetState(store_organ, nitrogen_element) + & this%bc_inout(acnp_bc_inout_id_netdn)%rval) - select case(pid_ncratio_function) !nint(EDPftvarcon_inst%dev_arbitrary_pft(ipft)) ) + select case(pid_ncratio_function) case(pid_c_function) - n_ratio = store_c_max/store_c_act + n_ratio = store_c_act/store_c_max case(pid_n_function) - n_ratio = store_nut_act/store_nut_max + n_ratio = store_nut_max/store_nut_act case(pid_minnc_function) if((store_nut_act/store_nut_max) > (store_c_act/store_c_max))then - n_ratio = (store_c_max/store_c_act) + n_ratio = (store_c_act/store_c_max) else - n_ratio = (store_nut_act/store_nut_max) + n_ratio = (store_nut_max/store_nut_act) end if case(pid_alogmaxnc_function) if( abs(SafeLog(store_nut_act/store_nut_max)) < abs(SafeLog(store_c_act/store_c_max))) then - n_ratio = (store_c_max/store_c_act) + n_ratio = (store_c_act/store_c_max) else - n_ratio = (store_nut_act/store_nut_max) + n_ratio = (store_nut_max/store_nut_act) end if case(pid_ncratio_function) n_ratio = (store_c_act/store_c_max)/(store_nut_act/store_nut_max) end select + ! This is more of a diagnostic, to see if the other process functions + ! are as good as the ratio of relative ratios cn_ratio = (store_c_act/store_c_max)/(store_nut_act/store_nut_max) else @@ -839,22 +811,22 @@ subroutine CNPAdjustFRootTargets(this, target_c, target_dcdd,co_num,nplant) this%GetState(store_organ, phosphorus_element) + & this%bc_inout(acnp_bc_inout_id_netdp)%rval) - select case(pid_ncratio_function) !nint(EDPftvarcon_inst%dev_arbitrary_pft(ipft))) + select case(pid_ncratio_function) case(pid_c_function) - p_ratio = store_c_max/store_c_act + p_ratio = store_c_act/store_c_max case(pid_n_function) - p_ratio = store_nut_act/store_nut_max + p_ratio = store_nut_max/store_nut_act case(pid_minnc_function) if((store_nut_act/store_nut_max) > (store_c_act/store_c_max))then - p_ratio = (store_c_max/store_c_act) + p_ratio = (store_c_act/store_c_max) else - p_ratio = (store_nut_act/store_nut_max) + p_ratio = (store_nut_max/store_nut_act) end if case(pid_alogmaxnc_function) if( abs(SafeLog(store_nut_act/store_nut_max)) < abs(SafeLog(store_c_act/store_c_max))) then - p_ratio = (store_c_max/store_c_act) + p_ratio = (store_c_act/store_c_max) else - p_ratio = (store_nut_act/store_nut_max) + p_ratio = (store_nut_max/store_nut_act) end if case(pid_ncratio_function) p_ratio = (store_c_act/store_c_max)/(store_nut_act/store_nut_max) @@ -867,42 +839,50 @@ subroutine CNPAdjustFRootTargets(this, target_c, target_dcdd,co_num,nplant) end if ! Use the limiting nutrient species - if(n_uptake_mode.eq.prescribed_n_uptake .and. p_uptake_mode.eq.prescribed_p_uptake)then - ema_xc = 0._r8 - ema_dxcdt = 0._r8 - xc0 = 0.0_r8 + if( (n_uptake_mode.eq.prescribed_n_uptake) .and. & + (p_uptake_mode.eq.prescribed_p_uptake) )then + cx_int = 0._r8 + ema_dcxdt = 0._r8 + cx0 = 0.0_r8 return else - xc_ratio = SafeLog(max(n_ratio,p_ratio)) + cx_logratio = SafeLog(max(n_ratio,p_ratio)) - ! If xc_ratio has just crossed zero, then + ! If cx_logratio has just crossed zero, then ! reset the integrator. This will be true if ! the sign of the current ratio is different than ! the sign of the previous - if( (xc_ratio/abs(xc_ratio) - xc0/abs(xc0)) > nearzero ) then - ema_xc = xc_ratio + if( (cx_logratio/abs(cx_logratio) - cx0/abs(cx0)) > nearzero ) then + cx_int = cx_logratio else - ema_xc = ema_xc + xc_ratio + cx_int = cx_int + cx_logratio end if - dxcdt_ratio = xc_ratio-xc0 + dxcdt_ratio = cx_logratio-cx0 - !ema_xc = pid_int_wgt*xc_ratio + (1._r8-pid_int_wgt)*ema_xc - ema_dxcdt = pid_drv_wgt*dxcdt_ratio + (1._r8-pid_drv_wgt)*ema_dxcdt - + ema_dcxdt = pid_drv_wgt*dxcdt_ratio + (1._r8-pid_drv_wgt)*ema_dcxdt - !ema_xc = (1._r8/EDPftvarcon_inst%dev_arbitrary_pft(ipft))*xc_ratio + & - ! (1._r8-(1._r8/EDPftvarcon_inst%dev_arbitrary_pft(ipft)))*ema_xc - - xc0 = xc_ratio + cx0 = cx_logratio end if - - end if if_storage_spe + + fnrt_c = this%GetState(fnrt_organ, carbon12_element) + leaf_c = this%GetState(leaf_organ, carbon12_element) + store_c = this%GetState(store_organ, carbon12_element) + struct_c = this%GetState(struct_organ, carbon12_element) + sapw_c = this%GetState(sapw_organ, carbon12_element) + + ! If there is overflow storage, add this to the gain + c_gain = this%bc_in(acnp_bc_in_id_netdc)%rval + max(0._r8,store_c-target_c(store_organ)) + + l2fr_delta = prt_params%pid_kp(ipft)*cx_logratio + & + prt_params%pid_ki(ipft)*cx_int + & + prt_params%pid_kd(ipft)*ema_dcxdt + ! ----------------------------------------------------------------------------- ! To decide the upper limit on expanding root growth, we perform a carbon ! balance. Note that if we are growing roots out more, than we have proportionaly @@ -919,74 +899,32 @@ subroutine CNPAdjustFRootTargets(this, target_c, target_dcdd,co_num,nplant) ! (target_sapw_c-actual_sapw_c) - ! (target_dead_c-actual_dead_c) - ! (target_stor_c-actual_stor_c) - ! ! ------------------------------------------------------------------------------ - - fnrt_c = this%GetState(fnrt_organ, carbon12_element) - leaf_c = this%GetState(leaf_organ, carbon12_element) - store_c = this%GetState(store_organ, carbon12_element) - struct_c = this%GetState(struct_organ, carbon12_element) - sapw_c = this%GetState(sapw_organ, carbon12_element) - - ! If there is overflow storage, add this to the gain - c_gain = this%bc_in(acnp_bc_in_id_netdc)%rval + max(0._r8,store_c-target_c(store_organ)) - + ! This is a rough estimate of the amount of carbon we will have to spend + ! on root expansion after we get back on allometry c_fnrt_expand = max_l2fr_cgain_frac* ( c_gain - & max(0._r8,target_c(fnrt_organ)-fnrt_c) - & max(0._r8,target_c(leaf_organ)-leaf_c) - & max(0._r8,target_c(sapw_organ)-sapw_c) - & max(0._r8,target_c(struct_organ)-struct_c) - & max(0._r8,target_c(store_organ)-store_c)) + + !c_fnrt_expand > (l2fr+l2fr_delta)*target_c(leaf_organ) - l2fr*target_c(leaf_organ) + !c_fnrt_expand = (l2fr+l2fr_delta_max)*target_c(leaf_organ) - l2fr*target_c(leaf_organ) + !c_fnrt_expand = l2fr_delta_max*target_c(leaf_organ) - if(pid_method==pid_logratio) then - - ! When using a log based (additive) PID search method - ! we define 1/fnrt_adapt_tscale as delta we want - ! when we have a 2:1 ratio. For instance if fnrt_adapt_tscale = 100, - ! then we want a scaling parameter that generates a change in l2fr of 1/100 - ! when there is 2:1 ratio of nutrient versus carbon storage. This - ! value is akin to the K_p and K_i terms in a PID controller (and - ! the ema timescale is the relative weight of K_p and K_i) - - l2fr_delta_scale = (1._r8/prt_params%fnrt_adapt_tscale(ipft))/log(2.0_r8) - - ! Want the derivative to be strongest when storage is most disproportionate - pid_k_d = prt_params%fnrt_adapt_tscale(ipft) !-0.1_r8 - pid_k_i = 0.0_r8 !EDPftvarcon_inst%dev_arbitrary_pft(ipft) !-0.0001_r8 - pid_k_p = EDPftvarcon_inst%dev_arbitrary_pft(ipft) !0.0005_r8 - - l2fr_delta = pid_k_p*xc_ratio + pid_k_i*ema_xc + pid_k_d*ema_dxcdt - - !l2fr_delta = ema_xc/abs(ema_xc)*l2fr_int_scale + ema_dxcdt*l2fr_deriv_scale - - ! Cap growth and shrinkage to avoid large changes - ! (currently capping at projected rate for a 2:1 ratio - l2fr_delta_minmax = l2fr_delta_scale*log(20.0) - - ! Don't allow more growth than we have carbon to pay for - !! l2fr_delta_max = min(l2fr_delta_minmax,l2fr*(c_fnrt_expand + target_c(fnrt_organ))/target_c(fnrt_organ)) - - - !! l2fr_delta = max(-l2fr_delta_minmax,min(l2fr_delta,l2fr_delta_max)) - !!l2fr_delta = max(-l2fr_delta_minmax,min(l2fr_delta,l2fr_delta_minmax)) - - - ! Apply the delta, also, avoid generating incredibly small l2fr's, - ! super small l2frs will occur in plants that perpetually get almost - ! now carbon gain, such as newly recruited plants in a dark understory - - l2fr = max(l2fr_min, l2fr + l2fr_delta ) + l2fr_delta_max = max(0._r8,c_fnrt_expand/target_c(leaf_organ)) + + ! Apply the delta, also, avoid generating incredibly small l2fr's, + ! super small l2frs will occur in plants that perpetually get almost + ! now carbon gain, such as newly recruited plants in a dark understory - !if((co_num==1) .or. (co_num==2)) print*,'AAX1',co_num,hlm_current_year,hlm_day_of_year, & - ! dbh,nplant,(store_c_act/store_c_max),cn_ratio,SafeLog(cn_ratio),l2fr - - else - - write(fates_log(),*) 'unknown PID controller method', pid_method - call endrun(msg=errMsg(sourcefile, __LINE__)) - - end if + !l2fr = max(l2fr_min, l2fr + l2fr_delta) + l2fr = max(l2fr_min, l2fr + min(l2fr_delta_max,l2fr_delta)) + + !if((co_num==1) .or. (co_num==2)) print*,'AAX1',co_num,hlm_current_year,hlm_day_of_year, & + ! dbh,nplant,(store_c_act/store_c_max),cn_ratio,SafeLog(cn_ratio),l2fr ! Find the updated target fineroot biomass @@ -1034,8 +972,6 @@ subroutine TrimFineRoot(this) if(fnrt_flux_c>nearzero) then - !EDPftvarcon_inst%dev_arbitrary_pft(ipft) - turn_flux_c = (1._r8 - fnrt_opt_eff)*fnrt_flux_c store_flux_c = fnrt_opt_eff*fnrt_flux_c @@ -1957,104 +1893,15 @@ subroutine CNPAllocateRemainder(this, c_gain,n_gain,p_gain, & real(r8) :: store_m_flux ! Flux into storage [kg] real(r8), pointer :: dbh real(r8), pointer :: resp_excess - real(r8), pointer :: ema_xc - real(r8), pointer :: ema_dxcdt - real(r8), pointer :: xc0 - real(r8) :: dxcdt_ratio integer :: ipft integer, pointer :: limiter real(r8) :: canopy_trim - real(r8) :: n_ratio,p_ratio,c_ratio - real(r8) :: xc_ratio,nc_ratio,pc_ratio - real(r8), pointer :: l2fr dbh => this%bc_inout(acnp_bc_inout_id_dbh)%rval canopy_trim = this%bc_in(acnp_bc_in_id_ctrim)%rval ipft = this%bc_in(acnp_bc_in_id_pft)%ival resp_excess => this%bc_inout(acnp_bc_inout_id_resp_excess)%rval - l2fr => this%bc_inout(acnp_bc_inout_id_l2fr)%rval limiter => this%bc_out(acnp_bc_out_id_limiter)%ival - ema_xc => this%bc_inout(acnp_bc_inout_id_emaxc)%rval - ema_dxcdt => this%bc_inout(acnp_bc_inout_id_emadxcdt)%rval - xc0 => this%bc_inout(acnp_bc_inout_id_xc0)%rval - ! Update the F_NPC - - ! n_ratio the ratio of n_gain/n_alloc / c_gain/c_alloc - ! If either n or p uptake is in prescribed mode - ! set the gains to something massive. 1 kilo of pure - ! nutrient should be wayyy more than enough - - if(pid_spe_controller == daily_gain_ratio_spe) then - - if(c_gain0 Date: Fri, 23 Sep 2022 16:28:07 -0400 Subject: [PATCH 34/55] Updating parameters for CNP, and various code cleaning for CNP --- biogeochem/EDCanopyStructureMod.F90 | 4 +-- biogeochem/EDCohortDynamicsMod.F90 | 39 ++++++++++----------- biogeochem/EDPatchDynamicsMod.F90 | 1 - biogeochem/EDPhysiologyMod.F90 | 19 +++++++--- parameter_files/patch_default_bciopt224.xml | 17 +++++---- parteh/PRTAllometricCNPMod.F90 | 18 +++++----- 6 files changed, 50 insertions(+), 48 deletions(-) diff --git a/biogeochem/EDCanopyStructureMod.F90 b/biogeochem/EDCanopyStructureMod.F90 index aed0c855de..e0b1460768 100644 --- a/biogeochem/EDCanopyStructureMod.F90 +++ b/biogeochem/EDCanopyStructureMod.F90 @@ -18,7 +18,7 @@ module EDCanopyStructureMod use EDCohortDynamicsMod , only : InitPRTObject use EDCohortDynamicsMod , only : InitPRTBoundaryConditions use FatesAllometryMod , only : tree_lai - use FatesAllometryMod , only : tree_sai,bstore_allom + use FatesAllometryMod , only : tree_sai use EDtypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type use EDTypesMod , only : nclmax use EDTypesMod , only : nlevleaf @@ -41,7 +41,6 @@ module EDCanopyStructureMod use PRTGenericMod, only : struct_organ use PRTGenericMod, only : SetState use PRTGenericMod, only : carbon12_element - use FatesRunningMeanMod, only : ema_lpa, ema_60day ! CIME Globals use shr_log_mod , only : errMsg => shr_log_errMsg @@ -143,7 +142,6 @@ subroutine canopy_structure( currentSite , bc_in ) logical :: area_not_balanced ! logical controlling if the patch layer areas ! have successfully been redistributed integer :: return_code ! math checks on variables will return>0 if problems exist - real(r8) :: target_storec ! We only iterate because of possible imprecisions generated by the cohort ! termination process. These should be super small, so at the most ! try to re-balance 3 times. If that doesn't give layer areas diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index 17be68ebc6..b59d81f3ea 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -18,8 +18,6 @@ module EDCohortDynamicsMod use FatesConstantsMod , only : fates_unset_r8 use FatesConstantsMod , only : nearzero use FatesConstantsMod , only : calloc_abs_error - use FatesConstantsMod , only : sec_per_day - use FatesRunningMeanMod , only : ema_lpa, ema_60day, ema_storemem use FatesInterfaceTypesMod , only : hlm_days_per_year use FatesInterfaceTypesMod , only : nleafage use SFParamsMod , only : SF_val_CWD_frac @@ -65,7 +63,6 @@ module EDCohortDynamicsMod use FatesAllometryMod , only : bagw_allom use FatesAllometryMod , only : bbgw_allom use FatesAllometryMod , only : bdead_allom - use FatesAllometryMod , only : bstore_allom use FatesAllometryMod , only : h_allom use FatesAllometryMod , only : carea_allom use FatesAllometryMod , only : ForceDBH @@ -95,9 +92,9 @@ module EDCohortDynamicsMod use PRTAllometricCNPMod, only : acnp_bc_in_id_pft, acnp_bc_in_id_ctrim use PRTAllometricCNPMod, only : acnp_bc_in_id_lstat, acnp_bc_inout_id_dbh use PRTAllometricCNPMod, only : acnp_bc_inout_id_l2fr - use PRTAllometricCNPMod, only : acnp_bc_inout_id_emaxc - use PRTAllometricCNPMod, only : acnp_bc_inout_id_xc0 - use PRTAllometricCNPMod, only : acnp_bc_inout_id_emadxcdt + use PRTAllometricCNPMod, only : acnp_bc_inout_id_cx_int + use PRTAllometricCNPMod, only : acnp_bc_inout_id_cx0 + use PRTAllometricCNPMod, only : acnp_bc_inout_id_emadcxdt use PRTAllometricCNPMod, only : acnp_bc_in_id_nc_repro use PRTAllometricCNPMod, only : acnp_bc_in_id_pc_repro use PRTAllometricCNPMod, only : acnp_bc_inout_id_resp_excess, acnp_bc_in_id_netdc @@ -244,9 +241,9 @@ subroutine create_cohort(currentSite, patchptr, pft, nn, hite, coage, dbh, & new_cohort%l2fr = prt_params%allom_l2fr(pft) - new_cohort%ema_xc = 0._r8 ! Assume balanced N,P/C stores ie log(1) = 0 - new_cohort%xc0 = 0._r8 ! Assume balanced N,P/C stores ie log(1) = 0 - new_cohort%ema_dxcdt = 0._r8 ! Assume unchanged dXC/dt + new_cohort%cx_int = 0._r8 ! Assume balanced N,P/C stores ie log(1) = 0 + new_cohort%cx0 = 0._r8 ! Assume balanced N,P/C stores ie log(1) = 0 + new_cohort%ema_dcxdt = 0._r8 ! Assume unchanged dCX/dt ! This sets things like vcmax25top, that depend on the ! leaf age fractions (which are defined by PARTEH) @@ -429,9 +426,9 @@ subroutine InitPRTBoundaryConditions(new_cohort) call new_cohort%prt%RegisterBCInOut(acnp_bc_inout_id_dbh,bc_rval = new_cohort%dbh) call new_cohort%prt%RegisterBCInOut(acnp_bc_inout_id_resp_excess,bc_rval = new_cohort%resp_excess) call new_cohort%prt%RegisterBCInOut(acnp_bc_inout_id_l2fr,bc_rval = new_cohort%l2fr) - call new_cohort%prt%RegisterBCInOut(acnp_bc_inout_id_emaxc,bc_rval = new_cohort%ema_xc) - call new_cohort%prt%RegisterBCInOut(acnp_bc_inout_id_emadxcdt,bc_rval = new_cohort%ema_dxcdt) - call new_cohort%prt%RegisterBCInOut(acnp_bc_inout_id_xc0,bc_rval = new_cohort%xc0) + call new_cohort%prt%RegisterBCInOut(acnp_bc_inout_id_cx_int,bc_rval = new_cohort%cx_int) + call new_cohort%prt%RegisterBCInOut(acnp_bc_inout_id_emadcxdt,bc_rval = new_cohort%ema_dcxdt) + call new_cohort%prt%RegisterBCInOut(acnp_bc_inout_id_cx0,bc_rval = new_cohort%cx0) call new_cohort%prt%RegisterBCInOut(acnp_bc_inout_id_netdn, bc_rval = new_cohort%daily_n_gain) call new_cohort%prt%RegisterBCInOut(acnp_bc_inout_id_netdp, bc_rval = new_cohort%daily_p_uptake) @@ -1211,12 +1208,12 @@ subroutine fuse_cohorts(currentSite, currentPatch, bc_in) end do end if - currentCohort%ema_xc = (currentCohort%n*currentCohort%ema_xc & - + nextc%n*nextc%ema_xc)/newn - currentCohort%ema_dxcdt = (currentCohort%n*currentCohort%ema_dxcdt & - + nextc%n*nextc%ema_dxcdt)/newn - currentCohort%xc0 = (currentCohort%n*currentCohort%xc0 & - + nextc%n*nextc%xc0)/newn + currentCohort%cx_int = (currentCohort%n*currentCohort%cx_int & + + nextc%n*nextc%cx_int)/newn + currentCohort%ema_dcxdt = (currentCohort%n*currentCohort%ema_dcxdt & + + nextc%n*nextc%ema_dcxdt)/newn + currentCohort%cx0 = (currentCohort%n*currentCohort%cx0 & + + nextc%n*nextc%cx0)/newn ! new cohort age is weighted mean of two cohorts currentCohort%coage = & @@ -1829,9 +1826,9 @@ subroutine copy_cohort( currentCohort,copyc ) n%kp25top = o%kp25top ! Copy over running means - n%ema_xc = o%ema_xc - n%ema_dxcdt = o%ema_dxcdt - n%xc0 = o%xc0 + n%cx_int = o%ema_cx + n%ema_dcxdt = o%ema_dcxdt + n%cx0 = o%cx0 ! CARBON FLUXES n%gpp_acc_hold = o%gpp_acc_hold diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 82ccc3d706..279618f789 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -639,7 +639,6 @@ subroutine spawn_patches( currentSite, bc_in) ! correct boundary condition fields nc%prt => null() call InitPRTObject(nc%prt) - nc%patchptr => new_patch call InitPRTBoundaryConditions(nc) ! (Keeping as an example) diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 2d65b371d4..71a513b84e 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -1434,7 +1434,6 @@ subroutine assign_cohort_SP_properties(currentCohort,htop,tlai,tsai,parea,init,l ! translates them into a FATES structure with one patch and one cohort per PFT ! The leaf area of the cohort is modified each day to match that asserted by the HLM ! -----------------------------------------------------------------------------------! - use EDTypesMod , only : nclmax type(ed_cohort_type), intent(inout), target :: currentCohort @@ -1829,7 +1828,6 @@ subroutine recruitment( currentSite, currentPatch, bc_in ) allocate(temp_cohort) ! create temporary cohort call zero_cohort(temp_cohort) - do ft = 1,numpft ! The following if block is for the prescribed biogeography and/or nocomp modes. @@ -2555,6 +2553,13 @@ end subroutine CWDOut subroutine UpdateRecruitL2FR(csite) + + ! When CNP is active, the l2fr (target leaf to fine-root biomass multiplier) + ! is dynamic. We therefore update what the l2fr for recruits + ! are, taking an exponential moving average of all plants that + ! are within recruit size limitations (less than recruit size + delta) + ! and less than the max_count cohort. + type(ed_site_type) :: csite type(ed_patch_type), pointer :: cpatch type(ed_cohort_type), pointer :: ccohort @@ -2571,6 +2576,8 @@ subroutine UpdateRecruitL2FR(csite) ! Difference in dbh (cm) to consider a plant was recruited fairly recently + if(hlm_parteh_mode .ne. prt_cnp_flex_allom_hyp) return + rec_n(1:numpft,1:nclmax) = 0._r8 rec_l2fr0(1:numpft,1:nclmax) = 0._r8 @@ -2630,6 +2637,9 @@ subroutine UpdateRecruitStoich(csite) ! Update the total plant stoichiometry of a new recruit, based on the updated ! L2FR values + + if(hlm_parteh_mode .ne. prt_cnp_flex_allom_hyp) return + cpatch => csite%youngest_patch do while(associated(cpatch)) cl = cpatch%ncl_p @@ -2660,15 +2670,14 @@ end subroutine UpdateRecruitStoich subroutine SetRecruitL2FR(csite) - ! I DONT THINK THIS ROUTINE IS ACTUALLY NEEDED... - ! TURN THIS OFF IN A B4B TEST - type(ed_site_type) :: csite type(ed_patch_type), pointer :: cpatch type(ed_cohort_type), pointer :: ccohort integer :: ft,cl + if(hlm_parteh_mode .ne. prt_cnp_flex_allom_hyp) return + cpatch => csite%youngest_patch do while(associated(cpatch)) ccohort => cpatch%shortest diff --git a/parameter_files/patch_default_bciopt224.xml b/parameter_files/patch_default_bciopt224.xml index 9897db82d6..1b02e03e4e 100644 --- a/parameter_files/patch_default_bciopt224.xml +++ b/parameter_files/patch_default_bciopt224.xml @@ -2,17 +2,16 @@ This parameter dataset was created by Ryan Knox rgknox@lbl.gov. Please contact if using in published work. The calibration uses the following datasets: [1] Ely et al. 2019. Leaf mass area, Panama. NGEE-Tropics data collection.http://dx.doi.org/10.15486/ngt/1411973 and [2] Condit et al. 2019. Complete data from the Barro Colorado 50-ha plot. https://doi.org/10.15146/5xcp-0d46. [3] Koven et al. 2019. Benchmarking and parameter sensitivity of physiological and vegetation dynamics using the functionally assembled terrestrial ecosystem simulator. Biogeosciences. The ECA nutrient aquisition parmeters are unconstrained, the file output naming convention vmn6phi is shorthand for vmax for nitrogen uptake is order e-6 and for phosphorus is excessively high. These parameters were calibrated with the special fates modification in main/EDTypesMod.F90: nclmax = 3 fates_params_default.cdl - fates_params_opt224_040822_v2.cdl + fates_params_opt224_040822_api24.cdl 1 - 0 - 0 - 1,1,3,4 - 0.03347526,0.024,1e-08,0.0047 - 0.002675,0.0005,0.00015,0.00015 - 0.0,0,0,0 - 0.45,0.25,0,0 - 0.65,0.25,0,0 + 0 + 0 + 1,1,3,4 + 0.03347526,0.024,1e-08,0.0047 + 0.002675,0.0005,0.00015,0.00015 + 0.45,0.25,0,0 + 0.65,0.25,0,0 0.8012471 30.94711 0.0673 diff --git a/parteh/PRTAllometricCNPMod.F90 b/parteh/PRTAllometricCNPMod.F90 index 0dc7c5a12d..38f17053b3 100644 --- a/parteh/PRTAllometricCNPMod.F90 +++ b/parteh/PRTAllometricCNPMod.F90 @@ -148,9 +148,9 @@ module PRTAllometricCNPMod ! is dynamic with CNP integer, public, parameter :: acnp_bc_inout_id_netdn = 4 ! Index for the net daily NH4 input BC integer, public, parameter :: acnp_bc_inout_id_netdp = 5 ! Index for the net daily P input BC - integer, public, parameter :: acnp_bc_inout_id_emaxc = 6 ! Index for the EMA log storage ratio max(N,P)/C - integer, public, parameter :: acnp_bc_inout_id_xc0 = 7 ! Index for the previous step's log storage ratio max(N,P)/C - integer, public, parameter :: acnp_bc_inout_id_emadxcdt = 8 ! Index for the EMA log storage ratio derivative d max(NP)/C dt + integer, public, parameter :: acnp_bc_inout_id_cx_int = 6 ! Index for the EMA log storage ratio max(N,P)/C + integer, public, parameter :: acnp_bc_inout_id_cx0 = 7 ! Index for the previous step's log storage ratio max(N,P)/C + integer, public, parameter :: acnp_bc_inout_id_emadcxdt = 8 ! Index for the EMA log storage ratio derivative d max(NP)/C dt integer, public, parameter :: num_bc_inout = 8 ! ------------------------------------------------------------------------------------- @@ -726,7 +726,7 @@ subroutine CNPAdjustFRootTargets(this, target_c, target_dcdd,co_num,nplant) real(r8) :: l2fr_mult real(r8) :: l2fr_delta real(r8) :: cn_ratio, cp_ratio - real(r8) :: dxcdt_ratio ! log change (derivative) of the maximum of the N/C and P/C storage ratio + real(r8) :: dcxdt_ratio ! log change (derivative) of the maximum of the N/C and P/C storage ratio real(r8) :: cx_logratio ! log Maximum of the C/N and C/P storage ratio real(r8), pointer :: cx_int ! Integration of the cx_logratio real(r8), pointer :: cx0 ! The log of the cx ratio from previous time-step @@ -750,9 +750,9 @@ subroutine CNPAdjustFRootTargets(this, target_c, target_dcdd,co_num,nplant) l2fr => this%bc_inout(acnp_bc_inout_id_l2fr)%rval dbh => this%bc_inout(acnp_bc_inout_id_dbh)%rval canopy_trim = this%bc_in(acnp_bc_in_id_ctrim)%rval - cx_int => this%bc_inout(acnp_bc_inout_id_emaxc)%rval - cx0 => this%bc_inout(acnp_bc_inout_id_xc0)%rval - ema_dcxdt => this%bc_inout(acnp_bc_inout_id_emadxcdt)%rval + cx_int => this%bc_inout(acnp_bc_inout_id_cx_int)%rval + cx0 => this%bc_inout(acnp_bc_inout_id_cx0)%rval + ema_dcxdt => this%bc_inout(acnp_bc_inout_id_emadcxdt)%rval ! Step 1: Determine the nutrient to carbon ratio (aka relative health factor) ! ----------------------------------------------------------------------------------- @@ -862,9 +862,9 @@ subroutine CNPAdjustFRootTargets(this, target_c, target_dcdd,co_num,nplant) cx_int = cx_int + cx_logratio end if - dxcdt_ratio = cx_logratio-cx0 + dcxdt_ratio = cx_logratio-cx0 - ema_dcxdt = pid_drv_wgt*dxcdt_ratio + (1._r8-pid_drv_wgt)*ema_dcxdt + ema_dcxdt = pid_drv_wgt*dcxdt_ratio + (1._r8-pid_drv_wgt)*ema_dcxdt cx0 = cx_logratio From 5d17995cf86cdcdf003cb35826d5cc2b82e61505 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Fri, 23 Sep 2022 19:55:29 -0400 Subject: [PATCH 35/55] Merge resolution fixes between CNP v2 and api24 --- biogeochem/EDCanopyStructureMod.F90 | 6 ++-- biogeochem/EDCohortDynamicsMod.F90 | 2 +- biogeochem/FatesSoilBGCFluxMod.F90 | 2 +- main/EDTypesMod.F90 | 23 ++++++------- main/FatesHistoryInterfaceMod.F90 | 3 +- main/FatesRestartInterfaceMod.F90 | 51 ++++++++++++++--------------- parteh/PRTAllometricCNPMod.F90 | 20 ++++------- parteh/PRTParamsFATESMod.F90 | 10 +++--- 8 files changed, 53 insertions(+), 64 deletions(-) diff --git a/biogeochem/EDCanopyStructureMod.F90 b/biogeochem/EDCanopyStructureMod.F90 index e0b1460768..29e4b6fab0 100644 --- a/biogeochem/EDCanopyStructureMod.F90 +++ b/biogeochem/EDCanopyStructureMod.F90 @@ -678,7 +678,7 @@ subroutine DemoteFromLayer(currentSite,currentPatch,i_lyr,bc_in) endif call copy_cohort(currentCohort, copyc) - call InitPRTBoundaryConditions(copyc,currentCohort%pft,1) + call InitPRTBoundaryConditions(copyc) newarea = currentCohort%c_area - cc_loss copyc%n = currentCohort%n*newarea/currentCohort%c_area @@ -1147,7 +1147,7 @@ subroutine PromoteIntoLayer(currentSite,currentPatch,i_lyr) ! init_value=currentPatch%tveg_lpa%GetMean()) call copy_cohort(currentCohort, copyc) !makes an identical copy... - call InitPRTBoundaryConditions(copyc,currentCohort%pft,2) + call InitPRTBoundaryConditions(copyc) newarea = currentCohort%c_area - cc_gain !new area of existing cohort @@ -2172,7 +2172,7 @@ subroutine UpdateCohortLAI(currentCohort, canopy_layer_tlai, patcharea) real(r8) :: leaf_c ! leaf carbon [kg] ! Obtain the leaf carbon - leaf_c = currentCohort%prt%GetState(leaf_organ,all_carbon_elements) + leaf_c = currentCohort%prt%GetState(leaf_organ,carbon12_element) ! Note that tree_lai has an internal check on the canopy locatoin currentCohort%treelai = tree_lai(leaf_c, currentCohort%pft, currentCohort%c_area, & diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index b59d81f3ea..78ec2a4f8e 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -1826,7 +1826,7 @@ subroutine copy_cohort( currentCohort,copyc ) n%kp25top = o%kp25top ! Copy over running means - n%cx_int = o%ema_cx + n%cx_int = o%cx_int n%ema_dcxdt = o%ema_dcxdt n%cx0 = o%cx0 diff --git a/biogeochem/FatesSoilBGCFluxMod.F90 b/biogeochem/FatesSoilBGCFluxMod.F90 index b176f4c558..19b01b318a 100644 --- a/biogeochem/FatesSoilBGCFluxMod.F90 +++ b/biogeochem/FatesSoilBGCFluxMod.F90 @@ -946,7 +946,7 @@ subroutine FluxIntoLitterPools(csite, bc_in, bc_out) sum_N = sum_N + area_frac*sum(litt%root_fines_frag)*(tot_fnrt_n / tot_fnrt_c) end if do ipft = 1,numpft - sum_N = sum_N + area_frac * prt_params%nitr_recr_stoich(ipft) * & + sum_N = sum_N + area_frac * currentPatch%nitr_repro_stoich(ipft) * & (litt%seed_decay(ipft) + litt%seed_germ_decay(ipft)) end do diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 5f6ce15539..7d6ffd2b5e 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -219,13 +219,10 @@ module EDTypesMod ! Used for CNP integer :: cnp_limiter ! Which species is limiting growth? ! 0=none,1=C,2=N,3=P - real(r8) :: ema_xc ! Exponential moving average of the log of the error term - ! that controls the l2fr set-point in the PID controller - ! the term is probably a ratio of storage or a ratio of - ! gain efficiencies - real(r8) :: ema_dxcdt ! The derivative of ema_xc per day - real(r8) :: xc0 ! The value on the previous time-step of the log of - ! the PID error term (not smoothed) + real(r8) :: cx_int ! The time integration of the log of the relative carbon storage over relative nutrient + real(r8) :: ema_dcxdt ! The derivative of the log of the relative carbon storage over relative nutrient + real(r8) :: cx0 ! The value on the previous time-step of log of the relative carbon + ! storage over relative nutrient real(r8) :: nc_repro ! The NC ratio of a new recruit in this patch real(r8) :: pc_repro ! The PC ratio of a new recruit in this patch @@ -1081,12 +1078,12 @@ subroutine dump_cohort(ccohort) write(fates_log(),*) 'co%hite = ', ccohort%hite write(fates_log(),*) 'co%coage = ', ccohort%coage write(fates_log(),*) 'co%l2fr = ', ccohort%l2fr - write(fates_log(),*) 'leaf carbon = ', ccohort%prt%GetState(leaf_organ,all_carbon_elements) - write(fates_log(),*) 'fineroot carbon = ', ccohort%prt%GetState(fnrt_organ,all_carbon_elements) - write(fates_log(),*) 'sapwood carbon = ', ccohort%prt%GetState(sapw_organ,all_carbon_elements) - write(fates_log(),*) 'structural (dead) carbon = ', ccohort%prt%GetState(struct_organ,all_carbon_elements) - write(fates_log(),*) 'storage carbon = ', ccohort%prt%GetState(store_organ,all_carbon_elements) - write(fates_log(),*) 'reproductive carbon = ', ccohort%prt%GetState(repro_organ,all_carbon_elements) + write(fates_log(),*) 'leaf carbon = ', ccohort%prt%GetState(leaf_organ,carbon12_element) + write(fates_log(),*) 'fineroot carbon = ', ccohort%prt%GetState(fnrt_organ,carbon12_element) + write(fates_log(),*) 'sapwood carbon = ', ccohort%prt%GetState(sapw_organ,carbon12_element) + write(fates_log(),*) 'structural (dead) carbon = ', ccohort%prt%GetState(struct_organ,carbon12_element) + write(fates_log(),*) 'storage carbon = ', ccohort%prt%GetState(store_organ,carbon12_element) + write(fates_log(),*) 'reproductive carbon = ', ccohort%prt%GetState(repro_organ,carbon12_element) write(fates_log(),*) 'co%g_sb_laweight = ', ccohort%g_sb_laweight write(fates_log(),*) 'co%leaf_cost = ', ccohort%leaf_cost write(fates_log(),*) 'co%canopy_layer = ', ccohort%canopy_layer diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index c7efa7edb9..15b3d0485e 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -249,7 +249,6 @@ module FatesHistoryInterfaceMod integer :: ih_fates_fraction_si integer :: ih_ba_weighted_height_si integer :: ih_ca_weighted_height_si - integer :: ih_cwd_elcwd integer :: ih_litter_in_si ! carbon only integer :: ih_litter_out_si ! carbon only integer :: ih_seed_bank_si ! carbon only @@ -5304,7 +5303,7 @@ subroutine define_history_vars(this, initialize_variables) call this%set_history_var(vname='FATES_FROOTC_SL', units='kg m-3', & long='Total carbon in live plant fine-roots over depth', use_default='active', & - avgflag='A', vtype=site_ground_r8, hlms='CLM:ALM', upfreq=1, & + avgflag='A', vtype=site_soil_r8, hlms='CLM:ALM', upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_fnrtc_sl ) call this%set_history_var(vname='FATES_REPROC', units='kg m-2', & diff --git a/main/FatesRestartInterfaceMod.F90 b/main/FatesRestartInterfaceMod.F90 index e7a9a2db8e..c3e9566f2d 100644 --- a/main/FatesRestartInterfaceMod.F90 +++ b/main/FatesRestartInterfaceMod.F90 @@ -97,9 +97,9 @@ module FatesRestartInterfaceMod integer :: ir_canopy_layer_yesterday_co integer :: ir_canopy_trim_co integer :: ir_l2fr_co - integer :: ir_emaxc_co - integer :: ir_emadxcdt_co - integer :: ir_xc0_co + integer :: ir_cx_int_co + integer :: ir_emadcxdt_co + integer :: ir_cx0_co integer :: ir_pc_store_co integer :: ir_size_class_lasttimestep_co integer :: ir_dbh_co @@ -704,17 +704,17 @@ subroutine define_restart_vars(this, initialize_variables) long_name='ed cohort - l2fr', units='fraction', flushval = flushzero, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_l2fr_co ) - call this%set_restart_var(vname='fates_emaxc', vtype=cohort_r8, & - long_name='ed cohort - emaxc', units='fraction', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_emaxc_co ) + call this%set_restart_var(vname='fates_cx_int', vtype=cohort_r8, & + long_name='ed cohort - emacx', units='fraction', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_cx_int_co ) - call this%set_restart_var(vname='fates_emadxcdt', vtype=cohort_r8, & - long_name='ed cohort - emadxcdt', units='fraction', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_emadxcdt_co ) + call this%set_restart_var(vname='fates_emadcxdt', vtype=cohort_r8, & + long_name='ed cohort - emadcxdt', units='fraction', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_emadcxdt_co ) - call this%set_restart_var(vname='fates_xc0', vtype=cohort_r8, & - long_name='ed cohort - xc0', units='fraction', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_xc0_co ) + call this%set_restart_var(vname='fates_cx0', vtype=cohort_r8, & + long_name='ed cohort - cx0', units='fraction', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_cx0_co ) call this%set_restart_var(vname='fates_size_class_lasttimestep', vtype=cohort_int, & long_name='ed cohort - size-class last timestep', units='index', flushval = flushzero, & @@ -1746,9 +1746,9 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_canopy_layer_yesterday_co => this%rvars(ir_canopy_layer_yesterday_co)%r81d, & rio_canopy_trim_co => this%rvars(ir_canopy_trim_co)%r81d, & rio_l2fr_co => this%rvars(ir_l2fr_co)%r81d, & - rio_emaxc_co => this%rvars(ir_emaxc_co)%r81d, & - rio_emadxcdt_co => this%rvars(ir_emadxcdt_co)%r81d, & - rio_xc0_co => this%rvars(ir_xc0_co)%r81d, & + rio_cx_int_co => this%rvars(ir_cx_int_co)%r81d, & + rio_emadcxdt_co => this%rvars(ir_emadcxdt_co)%r81d, & + rio_cx0_co => this%rvars(ir_cx0_co)%r81d, & rio_seed_prod_co => this%rvars(ir_seed_prod_co)%r81d, & rio_size_class_lasttimestep => this%rvars(ir_size_class_lasttimestep_co)%int1d, & rio_dbh_co => this%rvars(ir_dbh_co)%r81d, & @@ -1964,9 +1964,9 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_canopy_layer_yesterday_co(io_idx_co) = ccohort%canopy_layer_yesterday rio_canopy_trim_co(io_idx_co) = ccohort%canopy_trim rio_l2fr_co(io_idx_co) = ccohort%l2fr - rio_emaxc_co(io_idx_co) = ccohort%ema_xc - rio_emadxcdt_co(io_idx_co) = ccohort%ema_dxcdt - rio_xc0_co(io_idx_co) = ccohort%xc0 + rio_cx_int_co(io_idx_co) = ccohort%cx_int + rio_emadcxdt_co(io_idx_co) = ccohort%ema_dcxdt + rio_cx0_co(io_idx_co) = ccohort%cx0 rio_seed_prod_co(io_idx_co) = ccohort%seed_prod rio_size_class_lasttimestep(io_idx_co) = ccohort%size_class_lasttimestep rio_dbh_co(io_idx_co) = ccohort%dbh @@ -2577,9 +2577,9 @@ subroutine get_restart_vectors(this, nc, nsites, sites) rio_canopy_layer_yesterday_co => this%rvars(ir_canopy_layer_yesterday_co)%r81d, & rio_canopy_trim_co => this%rvars(ir_canopy_trim_co)%r81d, & rio_l2fr_co => this%rvars(ir_l2fr_co)%r81d, & - rio_emaxc_co => this%rvars(ir_emaxc_co)%r81d, & - rio_emadxcdt_co => this%rvars(ir_emadxcdt_co)%r81d, & - rio_xc0_co => this%rvars(ir_xc0_co)%r81d, & + rio_cx_int_co => this%rvars(ir_cx_int_co)%r81d, & + rio_emadcxdt_co => this%rvars(ir_emadcxdt_co)%r81d, & + rio_cx0_co => this%rvars(ir_cx0_co)%r81d, & rio_seed_prod_co => this%rvars(ir_seed_prod_co)%r81d, & rio_size_class_lasttimestep => this%rvars(ir_size_class_lasttimestep_co)%int1d, & rio_dbh_co => this%rvars(ir_dbh_co)%r81d, & @@ -2767,9 +2767,9 @@ subroutine get_restart_vectors(this, nc, nsites, sites) ccohort%canopy_layer_yesterday = rio_canopy_layer_yesterday_co(io_idx_co) ccohort%canopy_trim = rio_canopy_trim_co(io_idx_co) ccohort%l2fr = rio_l2fr_co(io_idx_co) - ccohort%ema_xc = rio_emaxc_co(io_idx_co) - ccohort%ema_dxcdt = rio_emadxcdt_co(io_idx_co) - ccohort%xc0 = rio_xc0_co(io_idx_co) + ccohort%cx_int = rio_cx_int_co(io_idx_co) + ccohort%ema_dcxdt = rio_emadcxdt_co(io_idx_co) + ccohort%cx0 = rio_cx0_co(io_idx_co) ccohort%seed_prod = rio_seed_prod_co(io_idx_co) ccohort%size_class_lasttimestep = rio_size_class_lasttimestep(io_idx_co) ccohort%dbh = rio_dbh_co(io_idx_co) @@ -2812,10 +2812,9 @@ subroutine get_restart_vectors(this, nc, nsites, sites) ccohort%status_coh = rio_status_co(io_idx_co) ccohort%isnew = ( rio_isnew_co(io_idx_co) .eq. new_cohort ) - call InitPRTBoundaryConditions(ccohort,ccohort%pft,4) + call InitPRTBoundaryConditions(ccohort) call UpdateCohortBioPhysRates(ccohort) - ! Initialize Plant Hydraulics if(hlm_use_planthydro==itrue)then diff --git a/parteh/PRTAllometricCNPMod.F90 b/parteh/PRTAllometricCNPMod.F90 index 38f17053b3..66b9a55cfa 100644 --- a/parteh/PRTAllometricCNPMod.F90 +++ b/parteh/PRTAllometricCNPMod.F90 @@ -568,7 +568,6 @@ subroutine DailyPRTAllometricCNP(this,co_num,nplant) ! =================================================================================== call this%CNPAllocateRemainder(c_gain, n_gain, p_gain, & - c_gain0, n_gain0, p_gain0, & c_efflux, n_efflux, p_efflux,co_num,nplant,target_c,target_dcdd) @@ -1867,16 +1866,13 @@ end subroutine CNPStatureGrowth ! ===================================================================================== subroutine CNPAllocateRemainder(this, c_gain,n_gain,p_gain, & - c_gain0, n_gain0, p_gain0, & - c_efflux, n_efflux, p_efflux,co_num,nplant,target_c,target_dcdd) + c_efflux, n_efflux, p_efflux, & + co_num,nplant,target_c,target_dcdd) class(cnp_allom_prt_vartypes) :: this real(r8), intent(inout) :: c_gain real(r8), intent(inout) :: n_gain real(r8), intent(inout) :: p_gain - real(r8), intent(in) :: c_gain0 ! Total C gain for the day - real(r8), intent(in) :: n_gain0 ! Total N gain for the day - real(r8), intent(in) :: p_gain0 ! Total P gain for the day real(r8), intent(inout) :: c_efflux real(r8), intent(inout) :: n_efflux real(r8), intent(inout) :: p_efflux @@ -1913,11 +1909,11 @@ subroutine CNPAllocateRemainder(this, c_gain,n_gain,p_gain, & do i = 1, num_organs ! Update the nitrogen and phosphorus deficits - target_n = this%GetNutrientTarget(nitrogen_element,organ_list(i),stoich_growth_min) - deficit_n(i) = max(0._r8,this%GetDeficit(nitrogen_element,organ_list(i),target_n)) + target_n = this%GetNutrientTarget(nitrogen_element,l2g_organ_list(i),stoich_growth_min) + deficit_n(i) = max(0._r8,this%GetDeficit(nitrogen_element,l2g_organ_list(i),target_n)) - target_p = this%GetNutrientTarget(phosphorus_element,organ_list(i),stoich_growth_min) - deficit_p(i) = max(0._r8,this%GetDeficit(phosphorus_element,organ_list(i),target_p)) + target_p = this%GetNutrientTarget(phosphorus_element,l2g_organ_list(i),stoich_growth_min) + deficit_p(i) = max(0._r8,this%GetDeficit(phosphorus_element,l2g_organ_list(i),target_p)) end do @@ -1935,9 +1931,7 @@ subroutine CNPAllocateRemainder(this, c_gain,n_gain,p_gain, & p_gain, phosphorus_element, l2g_organ_list(1:num_organs)) call this%CNPAdjustFRootTargets(target_c,target_dcdd,co_num,nplant) - - - + ! ----------------------------------------------------------------------------------- ! If carbon is still available, lets cram some into storage overflow ! We will do this last, because we wanted the non-overflow storage diff --git a/parteh/PRTParamsFATESMod.F90 b/parteh/PRTParamsFATESMod.F90 index feee2db976..0776c0d412 100644 --- a/parteh/PRTParamsFATESMod.F90 +++ b/parteh/PRTParamsFATESMod.F90 @@ -548,23 +548,23 @@ subroutine PRTReceivePFT(fates_params) data=prt_params%allom_l2fr) name = 'fates_cnp_pid_kp' - call fates_params%RetreiveParameterAllocate(name=name, & + call fates_params%RetrieveParameterAllocate(name=name, & data=prt_params%pid_kp) name = 'fates_cnp_pid_ki' - call fates_params%RetreiveParameterAllocate(name=name, & + call fates_params%RetrieveParameterAllocate(name=name, & data=prt_params%pid_ki) name = 'fates_cnp_pid_kd' - call fates_params%RetreiveParameterAllocate(name=name, & + call fates_params%RetrieveParameterAllocate(name=name, & data=prt_params%pid_kd) name = 'fates_cnp_store_ovrflw_frac' - call fates_params%RetreiveParameterAllocate(name=name, & + call fates_params%RetrieveParameterAllocate(name=name, & data=prt_params%store_ovrflw_frac) name = 'fates_nfix1' - call fates_params%RetreiveParameterAllocate(name=name, & + call fates_params%RetrieveParameterAllocate(name=name, & data=prt_params%nfix_mresp_scfrac) name = 'fates_allom_agb_frac' From 26ee58219548cda3137f51e872c72953261380b7 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Fri, 23 Sep 2022 21:20:28 -0400 Subject: [PATCH 36/55] merge resolutions and parameter stuff --- main/EDPftvarcon.F90 | 20 +++++++++++++------- main/FatesInterfaceMod.F90 | 7 ++++--- main/FatesInterfaceTypesMod.F90 | 4 +++- parameter_files/apichange_24to25.xml | 13 +++++++++++++ 4 files changed, 33 insertions(+), 11 deletions(-) diff --git a/main/EDPftvarcon.F90 b/main/EDPftvarcon.F90 index 51df007c78..aeac0a9f29 100644 --- a/main/EDPftvarcon.F90 +++ b/main/EDPftvarcon.F90 @@ -134,10 +134,16 @@ module EDPftvarcon ! Nutrient Aquisition (ECA & RD) - !real(r8), allocatable :: rd_vmax_n(:) ! maximum production rate for plant n uptake [gN/gC/s] real(r8), allocatable :: decompmicc(:) ! microbial decomposer biomass gC/m3 ! on root surface + real(r8), allocatable :: vmax_nh4(:) ! maximum production rate for plant N uptake + ! For ECA: this is just ammonium: nh4 uptake [gN/gC/s] + ! For RD: this is the uptake of both (we can't have + ! unique parameter for RD, because it want's one demand, + ! and uses this vmax to set the demand, first drawing from + ! NH4 and then NO3 + ! ECA Parameters: See Zhu et al. Multiple soil nutrient competition between plants, ! microbes, and mineral surfaces: model development, parameterization, ! and example applications in several tropical forests. Biogeosciences, @@ -145,9 +151,9 @@ module EDPftvarcon ! KM: Michaeles-Menten half-saturation constants for ECA (plant–enzyme affinity) ! VMAX: Product of the reaction-rate and enzyme abundance for each PFT in ECA ! Note*: units of [gC] is grams carbon of fine-root - + real(r8), allocatable :: eca_km_nh4(:) ! half-saturation constant for plant nh4 uptake [gN/m3] - real(r8), allocatable :: eca_vmax_nh4(:) ! maximum production rate for plant nh4 uptake [gN/gC/s] + real(r8), allocatable :: eca_km_no3(:) ! half-saturation constant for plant no3 uptake [gN/m3] real(r8), allocatable :: eca_vmax_no3(:) ! maximum production rate for plant no3 uptake [gN/gC/s] real(r8), allocatable :: eca_km_p(:) ! half-saturation constant for plant p uptake [gP/m3] @@ -577,7 +583,7 @@ subroutine Register_PFT(this, fates_params) call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'fates_cnp_eca_vmax_nh4' + name = 'fates_cnp_vmax_nh4' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) @@ -928,10 +934,10 @@ subroutine Receive_PFT(this, fates_params) name = 'fates_cnp_eca_km_nh4' call fates_params%RetrieveParameterAllocate(name=name, & data=this%eca_km_nh4) - - name = 'fates_cnp_eca_vmax_nh4' + + name = 'fates_cnp_vmax_nh4' call fates_params%RetrieveParameterAllocate(name=name, & - data=this%eca_vmax_nh4) + data=this%vmax_nh4) name = 'fates_cnp_eca_km_no3' call fates_params%RetrieveParameterAllocate(name=name, & diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 97d772fbc7..98eeb6d0c0 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -202,9 +202,9 @@ subroutine allocate_bcpconst(bc_pconst,nlevdecomp) type(bc_pconst_type), intent(inout) :: bc_pconst integer , intent(in) :: nlevdecomp - + + allocate(bc_pconst%vmax_nh4(numpft)) allocate(bc_pconst%eca_km_nh4(numpft)) - allocate(bc_pconst%eca_vmax_nh4(numpft)) allocate(bc_pconst%eca_km_no3(numpft)) allocate(bc_pconst%eca_vmax_no3(numpft)) allocate(bc_pconst%eca_km_p(numpft)) @@ -226,8 +226,9 @@ subroutine set_bcpconst(bc_pconst,nlevdecomp) integer , intent(in) :: nlevdecomp integer :: j + bc_pconst%vmax_nh4(1:numpft) = EDPftvarcon_inst%vmax_nh4(1:numpft) + bc_pconst%eca_km_nh4(1:numpft) = EDPftvarcon_inst%eca_km_nh4(1:numpft) - bc_pconst%eca_vmax_nh4(1:numpft) = EDPftvarcon_inst%eca_vmax_nh4(1:numpft) bc_pconst%eca_km_no3(1:numpft) = EDPftvarcon_inst%eca_km_no3(1:numpft) bc_pconst%eca_vmax_no3(1:numpft) = EDPftvarcon_inst%eca_vmax_no3(1:numpft) bc_pconst%eca_km_p(1:numpft) = EDPftvarcon_inst%eca_km_p(1:numpft) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 4083c41a9a..be482a96ad 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -741,8 +741,10 @@ module FatesInterfaceTypesMod ! each column is inefficient. Each of these are dimensioned by PFT. integer :: max_plant_comps + + real(r8), pointer :: vmax_nh4(:) + real(r8), pointer :: eca_km_nh4(:) - real(r8), pointer :: eca_vmax_nh4(:) real(r8), pointer :: eca_km_no3(:) real(r8), pointer :: eca_vmax_no3(:) real(r8), pointer :: eca_km_p(:) diff --git a/parameter_files/apichange_24to25.xml b/parameter_files/apichange_24to25.xml index 44f37eefa3..f30eaa4860 100644 --- a/parameter_files/apichange_24to25.xml +++ b/parameter_files/apichange_24to25.xml @@ -20,6 +20,19 @@ fates_cnp_fnrt_adapt_tscale + + fates_cnp_eca_vmax_nh4 + + + fates_cnp_rd_vmax_n + + + fates_cnp_vmax_nh4 + fates_pft + gN/gC/s + maximum (potential) uptake rate of N (for RD) or NH4 (for ECA) per gC of fineroot biomass + 5e-9, 5e-9, 5e-9, 5e-9, 5e-9, 5e-9, 5e-9, 5e-9, 5e-9, 5e-9, 5e-9, 5e-9 + fates_cnp_pid_kd fates_pft From 6e019d2a296cb5576f311c46c1ad372b2c96ca32 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Fri, 23 Sep 2022 21:22:38 -0400 Subject: [PATCH 37/55] Updates to parameter file --- parameter_files/fates_params_default.cdl | 18 ++++++------------ 1 file changed, 6 insertions(+), 12 deletions(-) diff --git a/parameter_files/fates_params_default.cdl b/parameter_files/fates_params_default.cdl index c1388cd90b..221a559e3f 100644 --- a/parameter_files/fates_params_default.cdl +++ b/parameter_files/fates_params_default.cdl @@ -188,9 +188,6 @@ variables: double fates_cnp_eca_lambda_ptase(fates_pft) ; fates_cnp_eca_lambda_ptase:units = "g/m3" ; fates_cnp_eca_lambda_ptase:long_name = "critical value for biochemical production (ECA)" ; - double fates_cnp_eca_vmax_nh4(fates_pft) ; - fates_cnp_eca_vmax_nh4:units = "gN/gC/s" ; - fates_cnp_eca_vmax_nh4:long_name = "maximum production rate for plant nh4 uptake (ECA)" ; double fates_cnp_eca_vmax_no3(fates_pft) ; fates_cnp_eca_vmax_no3:units = "gN/gC/s" ; fates_cnp_eca_vmax_no3:long_name = "maximum production rate for plant no3 uptake (ECA)" ; @@ -221,9 +218,6 @@ variables: double fates_cnp_prescribed_puptake(fates_pft) ; fates_cnp_prescribed_puptake:units = "fraction" ; fates_cnp_prescribed_puptake:long_name = "Prescribed P uptake flux. 0=fully coupled simulation, >0=prescribed (experimental)" ; - double fates_cnp_rd_vmax_n(fates_pft) ; - fates_cnp_rd_vmax_n:units = "gN/gC/s" ; - fates_cnp_rd_vmax_n:long_name = "maximum production rate for compbined (NH4+NO3) uptake (RD)" ; double fates_cnp_store_ovrflw_frac(fates_pft) ; fates_cnp_store_ovrflw_frac:units = "fraction" ; fates_cnp_store_ovrflw_frac:long_name = "size of overflow storage (for excess C,N or P) as a fraction of storage target" ; @@ -233,6 +227,9 @@ variables: double fates_cnp_turnover_phos_retrans(fates_plant_organs, fates_pft) ; fates_cnp_turnover_phos_retrans:units = "fraction" ; fates_cnp_turnover_phos_retrans:long_name = "retranslocation (reabsorbtion) fraction of phosphorus in turnover of scenescing tissues" ; + double fates_cnp_vmax_nh4(fates_pft) ; + fates_cnp_vmax_nh4:units = "gN/gC/s" ; + fates_cnp_vmax_nh4:long_name = "maximum (potential) uptake rate of N (for RD) or NH4 (for ECA) per gC of fineroot biomass" ; double fates_cnp_vmax_p(fates_pft) ; fates_cnp_vmax_p:units = "gP/gC/s" ; fates_cnp_vmax_p:long_name = "maximum production rate for phosphorus (ECA and RD)" ; @@ -971,9 +968,6 @@ data: fates_cnp_eca_lambda_ptase = 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 ; - fates_cnp_eca_vmax_nh4 = 5e-09, 5e-09, 5e-09, 5e-09, 5e-09, 5e-09, 5e-09, - 5e-09, 5e-09, 5e-09, 5e-09, 5e-09 ; - fates_cnp_eca_vmax_no3 = 5e-09, 5e-09, 5e-09, 5e-09, 5e-09, 5e-09, 5e-09, 5e-09, 5e-09, 5e-09, 5e-09, 5e-09 ; @@ -999,9 +993,6 @@ data: fates_cnp_prescribed_puptake = 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 ; - fates_cnp_rd_vmax_n = 5e-09, 5e-09, 5e-09, 5e-09, 5e-09, 5e-09, 5e-09, - 5e-09, 5e-09, 5e-09, 5e-09, 5e-09 ; - fates_cnp_store_ovrflw_frac = 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 ; fates_cnp_turnover_nitr_retrans = @@ -1016,6 +1007,9 @@ data: 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ; + fates_cnp_vmax_nh4 = 5e-09, 5e-09, 5e-09, 5e-09, 5e-09, 5e-09, 5e-09, 5e-09, + 5e-09, 5e-09, 5e-09, 5e-09 ; + fates_cnp_vmax_p = 5e-10, 5e-10, 5e-10, 5e-10, 5e-10, 5e-10, 5e-10, 5e-10, 5e-10, 5e-10, 5e-10, 5e-10 ; From 06757edb661ae1bda939836ef9dc2016f3eadaac Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Fri, 23 Sep 2022 21:31:14 -0400 Subject: [PATCH 38/55] updating patch files --- parameter_files/patch_default_bciopt224.xml | 22 ++++++++++----------- parameter_files/patch_default_e3smtest.xml | 4 ++-- 2 files changed, 13 insertions(+), 13 deletions(-) diff --git a/parameter_files/patch_default_bciopt224.xml b/parameter_files/patch_default_bciopt224.xml index 1b02e03e4e..ba44feab36 100644 --- a/parameter_files/patch_default_bciopt224.xml +++ b/parameter_files/patch_default_bciopt224.xml @@ -2,7 +2,7 @@ This parameter dataset was created by Ryan Knox rgknox@lbl.gov. Please contact if using in published work. The calibration uses the following datasets: [1] Ely et al. 2019. Leaf mass area, Panama. NGEE-Tropics data collection.http://dx.doi.org/10.15486/ngt/1411973 and [2] Condit et al. 2019. Complete data from the Barro Colorado 50-ha plot. https://doi.org/10.15146/5xcp-0d46. [3] Koven et al. 2019. Benchmarking and parameter sensitivity of physiological and vegetation dynamics using the functionally assembled terrestrial ecosystem simulator. Biogeosciences. The ECA nutrient aquisition parmeters are unconstrained, the file output naming convention vmn6phi is shorthand for vmax for nitrogen uptake is order e-6 and for phosphorus is excessively high. These parameters were calibrated with the special fates modification in main/EDTypesMod.F90: nclmax = 3 fates_params_default.cdl - fates_params_opt224_040822_api24.cdl + fates_params_opt224_040822_api25.cdl 1 0 @@ -12,7 +12,7 @@ 0.002675,0.0005,0.00015,0.00015 0.45,0.25,0,0 0.65,0.25,0,0 - 0.8012471 + 0.8012471 30.94711 0.0673 0.976 @@ -31,21 +31,21 @@ 2 5 0.4863088 - 0.0 + 0.0 1 3 - 5e-09 - 5e-09 - 5e-10 - 3e-08 + 5e-09 + 5e-09 + 5e-10 + 3e-08 0.03991654 0.01995827 0.01303514 0.02955703 - 3 - 3 - 0.04680188 - 0.001 + 3 + 3 + 0.04680188 + 0.001 0.8374751 -1 0.5 diff --git a/parameter_files/patch_default_e3smtest.xml b/parameter_files/patch_default_e3smtest.xml index 01111c2200..56dbb9b844 100644 --- a/parameter_files/patch_default_e3smtest.xml +++ b/parameter_files/patch_default_e3smtest.xml @@ -4,7 +4,7 @@ fates_params_e3smtest.cdl 1,2,3,4,5,6,7,8,9,10,11,12 - 0,0,0,0,0,0,0,0,0,0,0,0 - 0,0,0,0,0,0,0,0,0,0,0,0 + 0,0,0,0,0,0,0,0,0,0,0,0 + 0,0,0,0,0,0,0,0,0,0,0,0 From 4465d7cd00fe541950803039d6ab0d319f221366 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Sun, 25 Sep 2022 19:28:12 -0400 Subject: [PATCH 39/55] More merge resolutions between cnp v2 and api24 --- biogeochem/FatesSoilBGCFluxMod.F90 | 2 +- main/FatesHistoryInterfaceMod.F90 | 16 ++++++++-------- parteh/PRTAllometricCNPMod.F90 | 13 +++++++------ parteh/PRTParamsFATESMod.F90 | 4 ++-- 4 files changed, 18 insertions(+), 17 deletions(-) diff --git a/biogeochem/FatesSoilBGCFluxMod.F90 b/biogeochem/FatesSoilBGCFluxMod.F90 index 19b01b318a..ce51586123 100644 --- a/biogeochem/FatesSoilBGCFluxMod.F90 +++ b/biogeochem/FatesSoilBGCFluxMod.F90 @@ -153,7 +153,7 @@ function GetPlantDemand(ccohort,element_id) result(plant_demand) if(element_id.eq.nitrogen_element) then - plant_demand = fnrt_c * EDPftvarcon_inst%eca_vmax_nh4(ccohort%pft) * sec_per_day + plant_demand = fnrt_c * EDPftvarcon_inst%vmax_nh4(ccohort%pft) * sec_per_day elseif(element_id.eq.phosphorus_element) then diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 15b3d0485e..da59b0d803 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -5259,18 +5259,18 @@ subroutine define_history_vars(this, initialize_variables) upfreq=1, ivar=ivar, initialize=initialize_variables, & index = ih_storec_si) - call this%set_history_var(vname='FATES_STOREC_TFRAC', units='kg kg-1', & + call this%set_history_var(vname='FATES_STOREC_TF', units='kg kg-1', & long='Storage C fraction of target', use_default='active', & avgflag='A', vtype=site_r8, hlms='CLM:ALM', upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_storectfrac_si ) - call this%set_history_var(vname='FATES_STOREC_TFRAC_USTORY_SZPF', units='kg kg-1', & + call this%set_history_var(vname='FATES_STOREC_TF_USTORY_SZPF', units='kg kg-1', & long='Storage C fraction of target by size x pft, in the understory', use_default='inactive', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_storectfrac_ustory_scpf ) - call this%set_history_var(vname='FATES_STOREC_TFRAC_CANOPY_SZPF', units='kg kg-1', & + call this%set_history_var(vname='FATES_STOREC_TF_CANOPY_SZPF', units='kg kg-1', & long='Storage C fraction of target by size x pft, in the canopy', use_default='inactive', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_storectfrac_canopy_scpf ) @@ -5423,7 +5423,7 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=site_r8, hlms='CLM:ALM', upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_storen_si) - call this%set_history_var(vname='FATES_STOREN_TFRAC', units='1', & + call this%set_history_var(vname='FATES_STOREN_TF', units='1', & long='storage N fraction of target', use_default='active', & avgflag='A', vtype=site_r8, hlms='CLM:ALM', upfreq=1, ivar=ivar, & initialize=initialize_variables, index = ih_storentfrac_si) @@ -5485,14 +5485,14 @@ subroutine define_history_vars(this, initialize_variables) hlms='CLM:ALM', upfreq=1, ivar=ivar, & initialize=initialize_variables, index = ih_storen_scpf) - call this%set_history_var(vname='FATES_STOREN_TFRAC_CANOPY_SZPF', & + call this%set_history_var(vname='FATES_STOREN_TF_CANOPY_SZPF', & units='1', & long='storage nitrogen fraction (0-1) of target, in canopy, by size-class x pft', & use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & hlms='CLM:ALM', upfreq=1, ivar=ivar, & initialize=initialize_variables, index = ih_storentfrac_canopy_scpf) - call this%set_history_var(vname='FATES_STOREN_TFRAC_USTORY_SZPF', & + call this%set_history_var(vname='FATES_STOREN_TF_USTORY_SZPF', & units='1', & long='storage nitrogen fraction (0-1) of target, in understory, by size-class x pft', & use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & @@ -5519,7 +5519,7 @@ subroutine define_history_vars(this, initialize_variables) upfreq=1, ivar=ivar, initialize=initialize_variables, & index = ih_storep_si) - call this%set_history_var(vname='FATES_STOREP_TFRAC', units='1', & + call this%set_history_var(vname='FATES_STOREP_TF', units='1', & long='storage P fraction of target', use_default='active', & avgflag='A', vtype=site_r8, hlms='CLM:ALM', upfreq=1, & ivar=ivar, initialize=initialize_variables, & @@ -7213,7 +7213,7 @@ subroutine define_history_vars(this, initialize_variables) hlms='CLM:ALM', upfreq=1, ivar=ivar, & initialize=initialize_variables, index = ih_storep_scpf) - call this%set_history_var(vname='FATES_STOREP_TFRAC_CANOPY_SZPF', & + call this%set_history_var(vname='FATES_STOREP_TF_CANOPY_SZPF', & units='1', & long='storage phosphorus fraction (0-1) of target, in canopy, by size-class x pft', & use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & diff --git a/parteh/PRTAllometricCNPMod.F90 b/parteh/PRTAllometricCNPMod.F90 index 66b9a55cfa..36a25d9712 100644 --- a/parteh/PRTAllometricCNPMod.F90 +++ b/parteh/PRTAllometricCNPMod.F90 @@ -739,7 +739,8 @@ subroutine CNPAdjustFRootTargets(this, target_c, target_dcdd,co_num,nplant) integer, parameter :: pid_minnc_function = 2 integer, parameter :: pid_alogmaxnc_function = 3 integer, parameter :: pid_ncratio_function = 4 - + integer, parameter :: pid_function = pid_ncratio_function + ! If we do not have leaves out, then the relative nutrient vs carbon ! balancing is meaningless, just leave this routine if(this%GetState(leaf_organ, carbon12_element)/target_c(leaf_organ) < 0.5_r8) return @@ -772,7 +773,7 @@ subroutine CNPAdjustFRootTargets(this, target_c, target_dcdd,co_num,nplant) this%GetState(store_organ, nitrogen_element) + & this%bc_inout(acnp_bc_inout_id_netdn)%rval) - select case(pid_ncratio_function) + select case(pid_function) case(pid_c_function) n_ratio = store_c_act/store_c_max case(pid_n_function) @@ -812,7 +813,7 @@ subroutine CNPAdjustFRootTargets(this, target_c, target_dcdd,co_num,nplant) this%GetState(store_organ, phosphorus_element) + & this%bc_inout(acnp_bc_inout_id_netdp)%rval) - select case(pid_ncratio_function) + select case(pid_function) case(pid_c_function) p_ratio = store_c_act/store_c_max case(pid_n_function) @@ -914,15 +915,15 @@ subroutine CNPAdjustFRootTargets(this, target_c, target_dcdd,co_num,nplant) !c_fnrt_expand = (l2fr+l2fr_delta_max)*target_c(leaf_organ) - l2fr*target_c(leaf_organ) !c_fnrt_expand = l2fr_delta_max*target_c(leaf_organ) - l2fr_delta_max = max(0._r8,c_fnrt_expand/target_c(leaf_organ)) + !l2fr_delta_max = max(0._r8,c_fnrt_expand/target_c(leaf_organ)) ! Apply the delta, also, avoid generating incredibly small l2fr's, ! super small l2frs will occur in plants that perpetually get almost ! now carbon gain, such as newly recruited plants in a dark understory - !l2fr = max(l2fr_min, l2fr + l2fr_delta) + l2fr = max(l2fr_min, l2fr + l2fr_delta) - l2fr = max(l2fr_min, l2fr + min(l2fr_delta_max,l2fr_delta)) + !l2fr = max(l2fr_min, l2fr + min(l2fr_delta_max,l2fr_delta)) !if((co_num==1) .or. (co_num==2)) print*,'AAX1',co_num,hlm_current_year,hlm_day_of_year, & ! dbh,nplant,(store_c_act/store_c_max),cn_ratio,SafeLog(cn_ratio),l2fr diff --git a/parteh/PRTParamsFATESMod.F90 b/parteh/PRTParamsFATESMod.F90 index 0776c0d412..06e6ae20e8 100644 --- a/parteh/PRTParamsFATESMod.F90 +++ b/parteh/PRTParamsFATESMod.F90 @@ -252,7 +252,7 @@ subroutine PRTRegisterPFT(fates_params) call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'fates_nfix1' + name = 'fates_cnp_nfix1' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) @@ -563,7 +563,7 @@ subroutine PRTReceivePFT(fates_params) call fates_params%RetrieveParameterAllocate(name=name, & data=prt_params%store_ovrflw_frac) - name = 'fates_nfix1' + name = 'fates_cnp_nfix1' call fates_params%RetrieveParameterAllocate(name=name, & data=prt_params%nfix_mresp_scfrac) From d49058402133859f7748f1aa2c4d6c61862415c4 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Tue, 11 Oct 2022 12:25:06 -0400 Subject: [PATCH 40/55] Cleanup in PRTAllometricCNP --- parteh/PRTAllometricCNPMod.F90 | 327 +++++++++++++++------------------ 1 file changed, 148 insertions(+), 179 deletions(-) diff --git a/parteh/PRTAllometricCNPMod.F90 b/parteh/PRTAllometricCNPMod.F90 index 36a25d9712..3df92cfd3c 100644 --- a/parteh/PRTAllometricCNPMod.F90 +++ b/parteh/PRTAllometricCNPMod.F90 @@ -442,7 +442,8 @@ subroutine DailyPRTAllometricCNP(this,co_num,nplant) n_gain0 = n_gain p_gain0 = p_gain c_gain0 = c_gain - + + ! Calculate Carbon allocation targets ! ----------------------------------------------------------------------------------- @@ -674,8 +675,6 @@ subroutine DailyPRTAllometricCNP(this,co_num,nplant) ! then call this%TrimFineRoot() - - return end subroutine DailyPRTAllometricCNP @@ -698,54 +697,50 @@ end function SafeLog ! ===================================================================================== + subroutine CNPAdjustFRootTargets(this, target_c, target_dcdd,co_num,nplant) use FatesInterfaceTypesMod , only : hlm_day_of_year use FatesInterfaceTypesMod , only : hlm_days_per_year use FatesInterfaceTypesMod , only : hlm_current_year - + class(cnp_allom_prt_vartypes) :: this real(r8) :: target_c(:) real(r8) :: target_dcdd(:) integer,intent(in) :: co_num real(r8),intent(in) :: nplant - + real(r8), pointer :: l2fr ! leaf to fineroot target biomass scaler integer :: ipft ! PFT index real(r8), pointer :: dbh real(r8) :: canopy_trim - + integer :: leaf_status real(r8) :: store_c_max, store_c_act real(r8) :: store_nut_max, store_nut_act real(r8) :: n_ratio, p_ratio, np_ratio real(r8) :: fnrt_c,leaf_c,store_c,struct_c,sapw_c,c_gain - real(r8) :: c_fnrt_expand - real(r8) :: l2fr_delta_max - real(r8) :: logi_k - real(r8) :: l2fr_mult real(r8) :: l2fr_delta - real(r8) :: cn_ratio, cp_ratio + real(r8) :: cn_ratio, cp_ratio ! ratio of relative C storage over relative N or P storage real(r8) :: dcxdt_ratio ! log change (derivative) of the maximum of the N/C and P/C storage ratio - real(r8) :: cx_logratio ! log Maximum of the C/N and C/P storage ratio - real(r8), pointer :: cx_int ! Integration of the cx_logratio - real(r8), pointer :: cx0 ! The log of the cx ratio from previous time-step - real(r8), pointer :: ema_dcxdt ! the EMA of the change in log storage ratio - integer :: sup_flag - real(r8), parameter :: max_l2fr_cgain_frac = 0.99_r8 + real(r8) :: cx_logratio ! log Maximum of the C/N and C/P storage ratio + real(r8), pointer :: cx_int ! Integration of the cx_logratio + real(r8), pointer :: cx0 ! The log of the cx ratio from previous time-step + real(r8), pointer :: ema_dcxdt ! the EMA of the change in log storage ratio + real(r8), parameter :: pid_drv_wgt = 1._r8/20._r8 ! n-day smoothing (K on the derivative of PID) - + + ! These are different ways of defining the process function in the PID controller. pid_ncratio_function + ! is perhaps the most complete, in that it gives the true balance of relative C stores to relative N + ! stores. In the future we may just remove the alternatives + integer, parameter :: pid_c_function = 0 integer, parameter :: pid_n_function = 1 integer, parameter :: pid_minnc_function = 2 integer, parameter :: pid_alogmaxnc_function = 3 integer, parameter :: pid_ncratio_function = 4 integer, parameter :: pid_function = pid_ncratio_function - - ! If we do not have leaves out, then the relative nutrient vs carbon - ! balancing is meaningless, just leave this routine - if(this%GetState(leaf_organ, carbon12_element)/target_c(leaf_organ) < 0.5_r8) return - + leaf_status = this%bc_in(acnp_bc_in_id_lstat)%ival ipft = this%bc_in(acnp_bc_in_id_pft)%ival l2fr => this%bc_inout(acnp_bc_inout_id_l2fr)%rval dbh => this%bc_inout(acnp_bc_inout_id_dbh)%rval @@ -753,188 +748,162 @@ subroutine CNPAdjustFRootTargets(this, target_c, target_dcdd,co_num,nplant) cx_int => this%bc_inout(acnp_bc_inout_id_cx_int)%rval cx0 => this%bc_inout(acnp_bc_inout_id_cx0)%rval ema_dcxdt => this%bc_inout(acnp_bc_inout_id_emadcxdt)%rval - - ! Step 1: Determine the nutrient to carbon ratio (aka relative health factor) - ! ----------------------------------------------------------------------------------- - - store_c_max = target_c(store_organ) - - store_c_act = max(0.001_r8*store_c_max,this%GetState(store_organ, carbon12_element) + & - this%bc_in(acnp_bc_in_id_netdc)%rval) - - if(n_uptake_mode.ne.prescribed_n_uptake)then - - ! Calculate the relative nitrogen storage fraction, - ! over the relative carbon storage fraction. - - store_nut_max = this%GetNutrientTarget(nitrogen_element,store_organ,stoich_growth_min) - - store_nut_act = max(0.001_r8*store_nut_max, & - this%GetState(store_organ, nitrogen_element) + & - this%bc_inout(acnp_bc_inout_id_netdn)%rval) - - select case(pid_function) - case(pid_c_function) - n_ratio = store_c_act/store_c_max - case(pid_n_function) - n_ratio = store_nut_max/store_nut_act - case(pid_minnc_function) - if((store_nut_act/store_nut_max) > (store_c_act/store_c_max))then - n_ratio = (store_c_act/store_c_max) - else - n_ratio = (store_nut_max/store_nut_act) - end if - case(pid_alogmaxnc_function) - if( abs(SafeLog(store_nut_act/store_nut_max)) < abs(SafeLog(store_c_act/store_c_max))) then - n_ratio = (store_c_act/store_c_max) - else - n_ratio = (store_nut_max/store_nut_act) - end if - case(pid_ncratio_function) - n_ratio = (store_c_act/store_c_max)/(store_nut_act/store_nut_max) - end select - - ! This is more of a diagnostic, to see if the other process functions - ! are as good as the ratio of relative ratios - cn_ratio = (store_c_act/store_c_max)/(store_nut_act/store_nut_max) - - else - n_ratio = -1._r8 - end if - - if(p_uptake_mode.ne.prescribed_p_uptake)then - - ! Calculate the relative phosphorus storage fraction, - ! over the relative carbon storage fraction. - - store_nut_max = this%GetNutrientTarget(phosphorus_element,store_organ,stoich_growth_min) - - store_nut_act = max(0.001_r8*store_nut_max, & - this%GetState(store_organ, phosphorus_element) + & - this%bc_inout(acnp_bc_inout_id_netdp)%rval) - - select case(pid_function) - case(pid_c_function) - p_ratio = store_c_act/store_c_max - case(pid_n_function) - p_ratio = store_nut_max/store_nut_act - case(pid_minnc_function) - if((store_nut_act/store_nut_max) > (store_c_act/store_c_max))then - p_ratio = (store_c_act/store_c_max) - else - p_ratio = (store_nut_max/store_nut_act) - end if - case(pid_alogmaxnc_function) - if( abs(SafeLog(store_nut_act/store_nut_max)) < abs(SafeLog(store_c_act/store_c_max))) then - p_ratio = (store_c_act/store_c_max) - else - p_ratio = (store_nut_max/store_nut_act) - end if - case(pid_ncratio_function) - p_ratio = (store_c_act/store_c_max)/(store_nut_act/store_nut_max) - end select - - cp_ratio = (store_c_act/store_c_max)/(store_nut_act/store_nut_max) - + + ! Abort if leaves are off + if(leaf_status.eq.leaves_off) return + + + ! Step 1: Determine the process function for the controller. Generally, this is + ! some indicator about the relative health of the plant in terms of carbon versus + ! nutrient. There are a few ways to cast this function, but right now we are using + ! the relative amount of Carbon storage (actual/maximum) divided by the relative amount + ! of nutrient (actual/maximum). We take the natural log of this ratio. And then we take + ! maximum of the two quotients that use nitrogen and phosphorus. + ! ----------------------------------------------------------------------------------- + + store_c_max = target_c(store_organ) + + store_c_act = max(0.001_r8*store_c_max,this%GetState(store_organ, carbon12_element) + & + this%bc_in(acnp_bc_in_id_netdc)%rval) + + if(n_uptake_mode.eq.prescribed_n_uptake)then + n_ratio = -1._r8 + else + + ! Calculate the relative nitrogen storage fraction, + ! over the relative carbon storage fraction. + + store_nut_max = this%GetNutrientTarget(nitrogen_element,store_organ,stoich_growth_min) + + store_nut_act = max(0.001_r8*store_nut_max, & + this%GetState(store_organ, nitrogen_element) + & + this%bc_inout(acnp_bc_inout_id_netdn)%rval) + + select case(pid_function) + case(pid_c_function) + n_ratio = store_c_act/store_c_max + case(pid_n_function) + n_ratio = store_nut_max/store_nut_act + case(pid_minnc_function) + if((store_nut_act/store_nut_max) > (store_c_act/store_c_max))then + n_ratio = (store_c_act/store_c_max) + else + n_ratio = (store_nut_max/store_nut_act) + end if + case(pid_alogmaxnc_function) + if( abs(SafeLog(store_nut_act/store_nut_max)) < abs(SafeLog(store_c_act/store_c_max))) then + n_ratio = (store_c_act/store_c_max) + else + n_ratio = (store_nut_max/store_nut_act) + end if + case(pid_ncratio_function) + n_ratio = (store_c_act/store_c_max)/(store_nut_act/store_nut_max) + end select + + ! This is more of a diagnostic, to see if the other process functions + ! are as good as the ratio of relative ratios + cn_ratio = (store_c_act/store_c_max)/(store_nut_act/store_nut_max) + + end if + + if(p_uptake_mode.eq.prescribed_p_uptake)then + p_ratio = -1._r8 + else + + ! Calculate the relative phosphorus storage fraction, + ! over the relative carbon storage fraction. + + store_nut_max = this%GetNutrientTarget(phosphorus_element,store_organ,stoich_growth_min) + + store_nut_act = max(0.001_r8*store_nut_max, & + this%GetState(store_organ, phosphorus_element) + & + this%bc_inout(acnp_bc_inout_id_netdp)%rval) + + select case(pid_function) + case(pid_c_function) + p_ratio = store_c_act/store_c_max + case(pid_n_function) + p_ratio = store_nut_max/store_nut_act + case(pid_minnc_function) + if((store_nut_act/store_nut_max) > (store_c_act/store_c_max))then + p_ratio = (store_c_act/store_c_max) + else + p_ratio = (store_nut_max/store_nut_act) + end if + case(pid_alogmaxnc_function) + if( abs(SafeLog(store_nut_act/store_nut_max)) < abs(SafeLog(store_c_act/store_c_max))) then + p_ratio = (store_c_act/store_c_max) + else + p_ratio = (store_nut_max/store_nut_act) + end if + case(pid_ncratio_function) + p_ratio = (store_c_act/store_c_max)/(store_nut_act/store_nut_max) + end select + + cp_ratio = (store_c_act/store_c_max)/(store_nut_act/store_nut_max) + + + end if + + ! Use the limiting nutrient species + if( (n_uptake_mode.eq.prescribed_n_uptake) .and. & + (p_uptake_mode.eq.prescribed_p_uptake) )then + cx_int = 0._r8 + ema_dcxdt = 0._r8 + cx0 = 0.0_r8 + return + else + + if (n_uptake_mode.eq.prescribed_n_uptake) then + cx_logratio = SafeLog(p_ratio) + elseif (p_uptake_mode.eq.prescribed_p_uptake) then + cx_logratio = SafeLog(n_ratio) else - p_ratio = -1._r8 + cx_logratio = SafeLog(max(p_ratio,n_ratio)) end if - - ! Use the limiting nutrient species - if( (n_uptake_mode.eq.prescribed_n_uptake) .and. & - (p_uptake_mode.eq.prescribed_p_uptake) )then - cx_int = 0._r8 - ema_dcxdt = 0._r8 - cx0 = 0.0_r8 - return - else - cx_logratio = SafeLog(max(n_ratio,p_ratio)) + ! If cx_logratio has just crossed zero, then + ! reset the integrator. This will be true if + ! the sign of the current ratio is different than + ! the sign of the previous - ! If cx_logratio has just crossed zero, then - ! reset the integrator. This will be true if - ! the sign of the current ratio is different than - ! the sign of the previous + cx_int = cx_int + cx_logratio + ! Reset the integrator if its sign changes + if( abs(cx_logratio)>nearzero .and. abs(cx0)>nearzero) then if( (cx_logratio/abs(cx_logratio) - cx0/abs(cx0)) > nearzero ) then cx_int = cx_logratio - else - cx_int = cx_int + cx_logratio end if - - dcxdt_ratio = cx_logratio-cx0 - - ema_dcxdt = pid_drv_wgt*dcxdt_ratio + (1._r8-pid_drv_wgt)*ema_dcxdt + end if - cx0 = cx_logratio + dcxdt_ratio = cx_logratio-cx0 - - end if + ema_dcxdt = pid_drv_wgt*dcxdt_ratio + (1._r8-pid_drv_wgt)*ema_dcxdt - fnrt_c = this%GetState(fnrt_organ, carbon12_element) - leaf_c = this%GetState(leaf_organ, carbon12_element) - store_c = this%GetState(store_organ, carbon12_element) - struct_c = this%GetState(struct_organ, carbon12_element) - sapw_c = this%GetState(sapw_organ, carbon12_element) + cx0 = cx_logratio - ! If there is overflow storage, add this to the gain - c_gain = this%bc_in(acnp_bc_in_id_netdc)%rval + max(0._r8,store_c-target_c(store_organ)) - + end if + l2fr_delta = prt_params%pid_kp(ipft)*cx_logratio + & - prt_params%pid_ki(ipft)*cx_int + & - prt_params%pid_kd(ipft)*ema_dcxdt - - ! ----------------------------------------------------------------------------- - ! To decide the upper limit on expanding root growth, we perform a carbon - ! balance. Note that if we are growing roots out more, than we have proportionaly - ! more C compared to other resources. Specifically, we want to limit root growth - ! such that allocation to roots can't exceed a certain fraction of the daily - ! available carbon. This fraction is "max_l2fr_cgain_frac". - ! Additional notes. When calculating the "allocation to roots", we consider - ! both the carbon necessary to get the roots "on allometry" plux the carbon - ! necessary to expand them. - ! - ! l2fr_delta_max*target_fnrt_c - target_fnrt_c < - ! c_gain - (target_fnrt_c-actual_fnrt_c) - - ! (target_leaf_c-actual_leaf_c) - - ! (target_sapw_c-actual_sapw_c) - - ! (target_dead_c-actual_dead_c) - - ! (target_stor_c-actual_stor_c) - ! ------------------------------------------------------------------------------ - ! This is a rough estimate of the amount of carbon we will have to spend - ! on root expansion after we get back on allometry - c_fnrt_expand = max_l2fr_cgain_frac* ( c_gain - & - max(0._r8,target_c(fnrt_organ)-fnrt_c) - & - max(0._r8,target_c(leaf_organ)-leaf_c) - & - max(0._r8,target_c(sapw_organ)-sapw_c) - & - max(0._r8,target_c(struct_organ)-struct_c) - & - max(0._r8,target_c(store_organ)-store_c)) - - !c_fnrt_expand > (l2fr+l2fr_delta)*target_c(leaf_organ) - l2fr*target_c(leaf_organ) - !c_fnrt_expand = (l2fr+l2fr_delta_max)*target_c(leaf_organ) - l2fr*target_c(leaf_organ) - !c_fnrt_expand = l2fr_delta_max*target_c(leaf_organ) - - !l2fr_delta_max = max(0._r8,c_fnrt_expand/target_c(leaf_organ)) - + prt_params%pid_ki(ipft)*cx_int + & + prt_params%pid_kd(ipft)*ema_dcxdt + ! Apply the delta, also, avoid generating incredibly small l2fr's, ! super small l2frs will occur in plants that perpetually get almost ! now carbon gain, such as newly recruited plants in a dark understory l2fr = max(l2fr_min, l2fr + l2fr_delta) - - !l2fr = max(l2fr_min, l2fr + min(l2fr_delta_max,l2fr_delta)) - + !if((co_num==1) .or. (co_num==2)) print*,'AAX1',co_num,hlm_current_year,hlm_day_of_year, & - ! dbh,nplant,(store_c_act/store_c_max),cn_ratio,SafeLog(cn_ratio),l2fr - + ! dbh,nplant,(store_c_act/store_c_max),cx_logratio,cx_int,ema_dcxdt,l2fr ! Find the updated target fineroot biomass call bfineroot(dbh,ipft,canopy_trim, l2fr, target_c(fnrt_organ),target_dcdd(fnrt_organ)) return end subroutine CNPAdjustFRootTargets - + ! ===================================================================================== subroutine TrimFineRoot(this) From 68d71c2101a24c2bc64df5b05d453570cfa437bb Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Tue, 11 Oct 2022 17:17:22 -0400 Subject: [PATCH 41/55] More cleanup CNP growth code, removal of unused variables, labels, units and encapsulation of symbiotic fixation routine --- biogeochem/EDCohortDynamicsMod.F90 | 4 +- main/EDTypesMod.F90 | 2 +- parteh/PRTAllometricCNPMod.F90 | 177 +++++------------------------ 3 files changed, 32 insertions(+), 151 deletions(-) diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index 78ec2a4f8e..47ed64fcc6 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -594,7 +594,7 @@ subroutine nan_cohort(cc_p) !RESPIRATION currentCohort%rdark = nan currentCohort%resp_m = nan ! Maintenance respiration. kGC/cohort/year - currentCohort%resp_excess = nan ! Respiration of excess (unallocatable) carbon + currentCohort%resp_excess = nan ! Respiration of excess (unallocatable) carbon (kg/indiv/day) currentCohort%livestem_mr = nan ! Live stem maintenance respiration. kgC/indiv/s-1 currentCohort%livecroot_mr = nan ! Coarse root maintenance respiration. kgC/indiv/s-1 currentCohort%froot_mr = nan ! Fine root maintenance respiration. kgC/indiv/s-1 @@ -707,7 +707,7 @@ subroutine zero_cohort(cc_p) currentCohort%daily_n_demand = -9._r8 ! Fixation is also integrated over the course of the day - ! and must be zeroid upon creation and after plant + ! and must be zeroed upon creation and after plant ! resource allocation currentCohort%daily_n_fixation = 0._r8 diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 7d6ffd2b5e..413ef48c4f 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -214,7 +214,7 @@ module EDTypesMod ! enabled simulations, this is dynamic, will ! vary between allom_l2fr_min and allom_l2fr_max ! parameters, with a tendency driven by - ! nutrient storage) + ! nutrient storage) [g root / g leaf] ! Used for CNP diff --git a/parteh/PRTAllometricCNPMod.F90 b/parteh/PRTAllometricCNPMod.F90 index 3df92cfd3c..6b7f4d252c 100644 --- a/parteh/PRTAllometricCNPMod.F90 +++ b/parteh/PRTAllometricCNPMod.F90 @@ -255,7 +255,7 @@ module PRTAllometricCNPMod class(prt_global_type), public, target, allocatable :: prt_global_acnp character(len=*), parameter, private :: sourcefile = __FILE__ - logical, parameter :: debug = .true. + logical, parameter :: debug = .false. public :: InitPRTGlobalAllometricCNP @@ -376,10 +376,6 @@ subroutine DailyPRTAllometricCNP(this,co_num,nplant) integer :: i_org ! organ index integer :: i_var ! variable index - ! Agruments for allometry functions, that are not in the target_c array - - real(r8) :: max_store_n - ! These are daily mass gains, frozen in time, not drawn from, and thus ! these are only used for evaluating mass balancing at the end real(r8) :: dbh0 @@ -393,7 +389,6 @@ subroutine DailyPRTAllometricCNP(this,co_num,nplant) real(r8) :: allocated_c real(r8) :: allocated_n real(r8) :: allocated_p - real(r8) :: target_n,target_p real(r8) :: sum_c ! error checking sum ! If more than 1 leaf age bin is present, this @@ -404,11 +399,12 @@ subroutine DailyPRTAllometricCNP(this,co_num,nplant) ! In/out boundary conditions - resp_excess => this%bc_inout(acnp_bc_inout_id_resp_excess)%rval; - dbh => this%bc_inout(acnp_bc_inout_id_dbh)%rval; dbh0 = dbh + resp_excess => this%bc_inout(acnp_bc_inout_id_resp_excess)%rval + dbh => this%bc_inout(acnp_bc_inout_id_dbh)%rval + dbh0 = dbh l2fr => this%bc_inout(acnp_bc_inout_id_l2fr)%rval - n_gain => this%bc_inout(acnp_bc_inout_id_netdn)%rval; - p_gain => this%bc_inout(acnp_bc_inout_id_netdp)%rval; + n_gain => this%bc_inout(acnp_bc_inout_id_netdn)%rval + p_gain => this%bc_inout(acnp_bc_inout_id_netdp)%rval ! Assume that there is no other source of excess respiration @@ -433,10 +429,10 @@ subroutine DailyPRTAllometricCNP(this,co_num,nplant) ! set the gains to something massive. 1 kilo of pure ! nutrient should be wayyy more than enough if(n_uptake_mode.eq.prescribed_n_uptake) then - n_gain = 1.e3 + n_gain = 1.e3_r8 end if if(p_uptake_mode.eq.prescribed_p_uptake) then - p_gain = 1.e3 + p_gain = 1.e3_r8 end if n_gain0 = n_gain @@ -701,14 +697,13 @@ end function SafeLog subroutine CNPAdjustFRootTargets(this, target_c, target_dcdd,co_num,nplant) use FatesInterfaceTypesMod , only : hlm_day_of_year - use FatesInterfaceTypesMod , only : hlm_days_per_year use FatesInterfaceTypesMod , only : hlm_current_year class(cnp_allom_prt_vartypes) :: this real(r8) :: target_c(:) real(r8) :: target_dcdd(:) - integer,intent(in) :: co_num - real(r8),intent(in) :: nplant + integer,intent(in) :: co_num ! Used for single plant diagnostics + real(r8),intent(in) :: nplant ! Used for single plant diagnostics real(r8), pointer :: l2fr ! leaf to fineroot target biomass scaler integer :: ipft ! PFT index @@ -717,8 +712,7 @@ subroutine CNPAdjustFRootTargets(this, target_c, target_dcdd,co_num,nplant) integer :: leaf_status real(r8) :: store_c_max, store_c_act real(r8) :: store_nut_max, store_nut_act - real(r8) :: n_ratio, p_ratio, np_ratio - real(r8) :: fnrt_c,leaf_c,store_c,struct_c,sapw_c,c_gain + real(r8) :: n_ratio, p_ratio real(r8) :: l2fr_delta real(r8) :: cn_ratio, cp_ratio ! ratio of relative C storage over relative N or P storage real(r8) :: dcxdt_ratio ! log change (derivative) of the maximum of the N/C and P/C storage ratio @@ -727,7 +721,8 @@ subroutine CNPAdjustFRootTargets(this, target_c, target_dcdd,co_num,nplant) real(r8), pointer :: cx0 ! The log of the cx ratio from previous time-step real(r8), pointer :: ema_dcxdt ! the EMA of the change in log storage ratio - real(r8), parameter :: pid_drv_wgt = 1._r8/20._r8 ! n-day smoothing (K on the derivative of PID) + real(r8), parameter :: pid_drv_wgt = 1._r8/10._r8 ! n-day smoothing of the derivative + ! of the process function in the PID controller ! These are different ways of defining the process function in the PID controller. pid_ncratio_function ! is perhaps the most complete, in that it gives the true balance of relative C stores to relative N @@ -996,32 +991,22 @@ subroutine CNPPrioritizedReplacement(this,c_gain, n_gain, p_gain, target_c) real(r8), dimension(num_organs) :: deficit_p ! Deficit to get to target from current [kg] integer :: i, ii, i_org ! Loop indices (mostly for organs) - integer :: i_var ! variable index + integer :: i_var ! variable index integer :: i_pri ! loop index for priority integer :: ipft ! Plant functional type index of this plant integer :: leaf_status ! Is this plant in a leaf on or off status? - real(r8) :: dbh ! DBH [cm] real(r8) :: canopy_trim ! trim factor for maximum leaf biomass real(r8) :: target_n ! Target mass of N for a given organ [kg] real(r8) :: target_p ! Target mass of P for a given organ [kg] integer :: priority_code ! Index for priority level of each organ real(r8) :: sum_c_demand ! Carbon demanded to bring tissues up to allometry (kg) - real(r8) :: sum_n_deficit ! The nitrogen deficit of all pools for given priority level (kg) - real(r8) :: sum_p_deficit ! The phosphorus deficit of all pools for given priority level (kg) - real(r8) :: store_below_target - real(r8) :: store_target_fraction - real(r8) :: store_demand - real(r8) :: store_c_flux + real(r8) :: store_below_target ! The amount of storage that is less than the target (kg) + real(r8) :: store_target_fraction ! The fraction of actual storage carbon over the target (kg) + real(r8) :: store_demand ! Based on the target fraction, an exponential function defining + ! how much carbon we should try to put back into storage + real(r8) :: store_c_flux ! The amount of C we draw from gains to give back to storage (kg) real(r8) :: sum_c_flux ! The flux to bring tissues up to allometry (kg) - real(r8) :: sum_n_flux ! The flux of nitrogen "" (kg) - real(r8) :: sum_p_flux ! The flux of phosphorus "" (Kg) real(r8) :: c_flux ! carbon flux into an arbitrary pool (kg) - real(r8) :: gr_flux ! carbon flux to fulfill growth respiration of an arbitrary pool (kg) - real(r8) :: n_flux ! nitrogen flux into an arbitrary pool (kg) - real(r8) :: p_flux ! phosphorus flux into an arbitrary pool (kg) - real(r8) :: c_gain_flux ! Flux used to pay back negative carbon gain (from storage) (kgC) - real(r8) :: sapw_area - integer :: n_max_priority ! Maximum possible number of priority levels is ! the total number organs plus 1, which allows ! each organ to have its own level, and ignore @@ -1183,7 +1168,6 @@ subroutine CNPPrioritizedReplacement(this,c_gain, n_gain, p_gain, target_c) ! This is the desired need for carbon store_target_fraction = max(this%variables(store_c_id)%val(1)/target_c(store_organ),0._r8) - store_demand = max(c_gain*(exp(-1.*store_target_fraction**4._r8) - exp( -1.0_r8 )),0._r8) ! The flux is the (positive) minimum of all three @@ -1325,22 +1309,18 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & ! (new uptake + storage) real(r8), intent(inout) :: p_gain ! Total P available for allocation ! (new uptake + storage) - real(r8), intent(in) :: target_c(:) - real(r8), intent(in) :: target_dcdd(:) - + real(r8), intent(in) :: target_c(:) ! target carbon mass for each organ (before growth) + real(r8), intent(in) :: target_dcdd(:) ! target carbon mass derivative (wrt dbh) before growth) + + real(r8), pointer :: dbh integer :: ipft - integer, pointer :: limiter - real(r8) :: canopy_trim - real(r8) :: leaf_status - real(r8) :: l2fr - + integer, pointer :: limiter ! Integer flagging which (C,N,P) is limiting + real(r8) :: canopy_trim ! fraction of crown trimmed + real(r8) :: leaf_status ! leaves on or off? + real(r8) :: l2fr ! leaf to fineroot allometry multiplier integer :: i, ii ! organ index loops (masked and unmasked) integer :: i_org ! global organ index - integer :: istep ! outer step iteration loop - real(r8) :: grow_c_from_c ! carbon transferred into tissues - real(r8) :: grow_c_from_n ! carbon needed to match N transfers to tissues - real(r8) :: grow_c_from_p ! carbon needed to match P transfers to tissues real(r8) :: total_dcostdd ! Total carbon transferred to all pools for unit growth logical :: step_pass ! flag stating if the integration sub-steps passed checks real(r8) :: totalC ! total carbon sent to integrator (kg) @@ -1354,14 +1334,10 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & ! at current stature (dbh) [/] real(r8) :: sum_c_flux ! Sum of the carbon allocated, as reported ! by the ODE solver. [kg] - real(r8) :: np_limit - real(r8) :: n_match - real(r8) :: p_match real(r8) :: c_flux_adj ! Adjustment to total carbon flux during stature growth ! intended to correct integration error (kg/kg) real(r8) :: c_flux ! Carbon flux from the gain pool to an organ (kgC) real(r8) :: n_flux,p_flux - real(r8) :: gr_flux ! Growth respiration flux for the current transaction (kgC) real(r8) :: c_gstature ! Carbon reserved for stature growth (kg) real(r8) :: target_n ! Target mass of N for a given organ [kg] real(r8) :: target_p ! Target mass of P for a given organ [kg] @@ -1409,8 +1385,8 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & integer, parameter :: grow_lim_estNP = 2 ! Estimate equivalent C from N and P integer, parameter :: grow_lim_type = grow_lim_estNP - real :: neq_cgain, peq_cgain ! N and P equivalent c_gain spent on growth - real :: cnp_gain ! used as a check to see efficiency of limited growth + real(r8) :: neq_cgain, peq_cgain ! N and P equivalent c_gain spent on growth + real(r8) :: cnp_gain ! used as a check to see efficiency of limited growth @@ -1858,7 +1834,6 @@ subroutine CNPAllocateRemainder(this, c_gain,n_gain,p_gain, & real(r8) :: target_p real(r8) :: store_c_target ! Target amount of C in storage including "overflow" [kgC] real(r8) :: total_c_flux ! Total C flux from gains into storage and growth R [kgC] - real(r8) :: store_m_flux ! Flux into storage [kg] real(r8), pointer :: dbh real(r8), pointer :: resp_excess integer :: ipft @@ -2261,7 +2236,6 @@ function AllomCNPGrowthDeriv(l_state_array,l_state_mask,cbalance,intgr_params) r real(r8) :: bgw_dcdd_target ! target BG wood biomass derivative wrt d, (kgC/cm) real(r8) :: store_dcdd_target ! target storage biomass derivative wrt d, (kgC/cm) real(r8) :: struct_dcdd_target ! target structural biomass derivative wrt d, (kgC/cm) - real(r8) :: total_dcdd_target ! target total (not reproductive) biomass derivative wrt d, (kgC/cm) real(r8) :: repro_fraction ! fraction of carbon balance directed towards reproduction (kgC/kgC) real(r8) :: total_dcostdd ! carbon cost for non-reproductive pools per unit increment of dbh @@ -2382,99 +2356,6 @@ function AllomCNPGrowthDeriv(l_state_array,l_state_mask,cbalance,intgr_params) r return end function AllomCNPGrowthDeriv - ! ==================================================================================== - - subroutine TargetAllometryCheck(b0_leaf,b0_fnrt,b0_sapw,b0_store,b0_struct, & - bleaf,bfnrt,bsapw,bstore,bstruct, & - bt_leaf,bt_fnrt,bt_sapw,bt_store,bt_struct, & - carbon_balance,ipft,leaf_status, & - grow_leaf,grow_fnrt,grow_sapw,grow_store,grow_struct) - - ! Arguments - real(r8),intent(in) :: b0_leaf !initial - real(r8),intent(in) :: b0_fnrt - real(r8),intent(in) :: b0_sapw - real(r8),intent(in) :: b0_store - real(r8),intent(in) :: b0_struct - real(r8),intent(in) :: bleaf !actual - real(r8),intent(in) :: bfnrt - real(r8),intent(in) :: bsapw - real(r8),intent(in) :: bstore - real(r8),intent(in) :: bstruct - real(r8),intent(in) :: bt_leaf !target - real(r8),intent(in) :: bt_fnrt - real(r8),intent(in) :: bt_sapw - real(r8),intent(in) :: bt_store - real(r8),intent(in) :: bt_struct - real(r8),intent(in) :: carbon_balance !remaining carbon balance - integer,intent(in) :: ipft !Plant functional type - integer,intent(in) :: leaf_status !Phenology status - logical,intent(out) :: grow_leaf !growth flag - logical,intent(out) :: grow_fnrt - logical,intent(out) :: grow_sapw - logical,intent(out) :: grow_store - logical,intent(out) :: grow_struct - ! Local variables - logical :: fine_leaf - logical :: fine_fnrt - logical :: fine_sapw - logical :: fine_store - logical :: fine_struct - logical :: all_fine - ! Local constants - character(len= 3), parameter :: fmth = '(a)' - character(len=27), parameter :: fmtb = '(a,3(1x,es12.5,1x,a),1x,l1)' - character(len=13), parameter :: fmte = '(a,1x,es12.5)' - character(len=10), parameter :: fmti = '(a,1x,i12)' - - - ! First test whether or not each pool looks reasonable. - fine_leaf = (bt_leaf - bleaf ) <= calloc_abs_error - fine_fnrt = (bt_fnrt - bfnrt ) <= calloc_abs_error - fine_sapw = (bt_sapw - bsapw ) <= calloc_abs_error - fine_store = (bt_store - bstore ) <= calloc_abs_error - fine_struct = (bt_struct - bstruct) <= calloc_abs_error - all_fine = fine_leaf .and. fine_fnrt .and. fine_sapw .and. & - fine_store .and. fine_struct - - ! Decide whether or not to grow tissues (but only if all tissues look fine). - ! We grow only when biomass is less than target biomass (with tolerance). - if (all_fine) then - grow_leaf = ( bleaf - bt_leaf ) <= calloc_abs_error - grow_fnrt = ( bfnrt - bt_fnrt ) <= calloc_abs_error - grow_sapw = ( bsapw - bt_sapw ) <= calloc_abs_error - grow_store = ( bstore - bt_store ) <= calloc_abs_error - grow_struct = ( bstruct - bt_struct ) <= calloc_abs_error - else - ! If anything looks not fine, write a detailed report - write(fates_log(),fmt=fmth) '======' - write(fates_log(),fmt=fmth) ' At least one tissue is not on-allometry at the growth step' - write(fates_log(),fmt=fmth) '======' - write(fates_log(),fmt=fmth) '' - write(fates_log(),fmt=fmth) ' Biomass and on-allometry test (''F'' means problem)' - write(fates_log(),fmt=fmth) '------' - write(fates_log(),fmt=fmth) ' Tissue | Initial | Current | Target | On-allometry' - write(fates_log(),fmt=fmtb) ' Leaf |',b0_leaf ,'|',bleaf ,'|',bt_leaf ,'|',fine_leaf - write(fates_log(),fmt=fmtb) ' Fine root |',b0_fnrt ,'|',bfnrt ,'|',bt_fnrt ,'|',fine_fnrt - write(fates_log(),fmt=fmtb) ' Sap wood |',b0_sapw ,'|',bsapw ,'|',bt_sapw ,'|',fine_sapw - write(fates_log(),fmt=fmtb) ' Storage |',b0_store ,'|',bstore ,'|',bt_store ,'|',fine_store - write(fates_log(),fmt=fmtb) ' Structural |',b0_struct ,'|',bstruct ,'|',bt_struct ,'|',fine_struct - write(fates_log(),fmt=fmth) '' - write(fates_log(),fmt=fmth) ' Ancillary information' - write(fates_log(),fmt=fmth) '------' - write(fates_log(),fmt=fmti) ' PFT = ',ipft - write(fates_log(),fmt=fmti) ' leaf_status = ',leaf_status - write(fates_log(),fmt=fmte) ' carbon_balance = ',carbon_balance - write(fates_log(),fmt=fmte) ' calloc_abs_error = ',calloc_abs_error - write(fates_log(),fmt=fmth) '' - write(fates_log(),fmt=fmth) '======' - call endrun(msg=errMsg(sourcefile, __LINE__)) - end if - - return - end subroutine TargetAllometryCheck - - ! ===================================================================================== From cf8971710caadd8f6cf66881b547512a9f346fca Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Fri, 14 Oct 2022 09:50:23 -0400 Subject: [PATCH 42/55] cnp v2, syntax cleanup --- biogeophys/FatesPlantRespPhotosynthMod.F90 | 77 +++++++++++++++------- main/EDTypesMod.F90 | 2 +- parteh/PRTAllometricCNPMod.F90 | 8 +-- 3 files changed, 58 insertions(+), 29 deletions(-) diff --git a/biogeophys/FatesPlantRespPhotosynthMod.F90 b/biogeophys/FatesPlantRespPhotosynthMod.F90 index b56e8073b4..fff5d74ce5 100644 --- a/biogeophys/FatesPlantRespPhotosynthMod.F90 +++ b/biogeophys/FatesPlantRespPhotosynthMod.F90 @@ -30,6 +30,7 @@ module FATESPlantRespPhotosynthMod use FatesConstantsMod, only : molar_mass_water use FatesConstantsMod, only : rgas_J_K_mol use FatesConstantsMod, only : fates_unset_r8 + use FatesConstantsMod, only : tfrz => t_water_freeze_k_1atm use FatesInterfaceTypesMod, only : hlm_use_planthydro use FatesInterfaceTypesMod, only : hlm_parteh_mode use FatesInterfaceTypesMod, only : numpft @@ -128,7 +129,6 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) use FatesConstantsMod, only : g_per_kg use FatesConstantsMod, only : umol_per_mmol use FatesConstantsMod, only : rgas => rgas_J_K_kmol - use FatesConstantsMod, only : tfrz => t_water_freeze_k_1atm use FatesParameterDerivedMod, only : param_derived use FatesAllometryMod, only : bleaf, bstore_allom @@ -240,9 +240,9 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) real(r8) :: cumulative_lai ! the cumulative LAI, top down, to the leaf layer of interest real(r8) :: leaf_psi ! leaf xylem matric potential [MPa] (only meaningful/used w/ hydro) real(r8) :: fnrt_mr_layer ! fine root maintenance respiation per layer [kgC/plant/s] - real(r8) :: c_cost_nfix ! carbon cost of N fixation [kgC/kgN] - real(r8) :: c_spent_nfix ! carbon spent on N fixation, per layer [kgC/plant/timestep] - + + real(r8) :: fnrt_mr_nfix_layer ! fineroot maintenance respiration specifically for symbiotic fixation [kgC/plant/layer/s] + real(r8) :: nfix_layer ! Nitrogen fixed in each layer this timestep [kgN/plant/layer/timestep] real(r8), allocatable :: rootfr_ft(:,:) ! Root fractions per depth and PFT ! ----------------------------------------------------------------------------------- @@ -269,11 +269,7 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) ! (gC/gN/s) ! ------------------------------------------------------------------------ - ! N fixation parameters from Houlton et al (2008) and Fisher et al (2010) - real(r8), parameter :: s_fix = -6.25_r8 ! s parameter from FUN model (fisher et al 2010) - real(r8), parameter :: a_fix = -3.62_r8 ! a parameter from Houlton et al. 2010 (a = -3.62 +/- 0.52) - real(r8), parameter :: b_fix = 0.27_r8 ! b parameter from Houlton et al. 2010 (b = 0.27 +/-0.04) - real(r8), parameter :: c_fix = 25.15_r8 ! c parameter from Houlton et al. 2010 (c = 25.15 +/- 0.66) + ! ----------------------------------------------------------------------------------- ! Photosynthesis and stomatal conductance parameters, from: ! Bonan et al (2011) JGR, 116, doi:10.1029/2010JG001593 @@ -722,18 +718,15 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) fnrt_mr_layer = fnrt_n * ED_val_base_mr_20 * tcsoi * rootfr_ft(ft,j) * maintresp_reduction_factor - currentCohort%froot_mr = currentCohort%froot_mr + fnrt_mr_layer * (1._r8 + prt_params%nfix_mresp_scfrac(ft)) - ! calculate the cost of carbon for N fixation in each soil layer and calculate N fixation rate based on that [kgC / kgN] - c_cost_nfix = s_fix * (exp(a_fix + b_fix * (bc_in(s)%t_soisno_sl(j)-tfrz) & - * (1._r8 - 0.5_r8 * (bc_in(s)%t_soisno_sl(j)-tfrz) / c_fix)) - 2._r8) - - ! Time integrated amount of carbon spent on fixation (in this layer) [kgC/plant/layer/tstep] - c_spent_nfix = fnrt_mr_layer * dtime * prt_params%nfix_mresp_scfrac(ft) + call RootLayerNFixation(bc_in(s)%t_soisno_sl(j),ft,dtime,fnrt_mr_layer,fnrt_mr_nfix_layer,nfix_layer) - currentCohort%daily_n_fixation = currentCohort%daily_n_fixation + c_spent_nfix / c_cost_nfix + currentCohort%froot_mr = currentCohort%froot_mr + fnrt_mr_nfix_layer + fnrt_mr_layer + currentCohort%daily_n_fixation = currentCohort%daily_n_fixation + nfix_layer + + enddo ! Coarse Root MR (kgC/plant/s) (below ground sapwood) @@ -886,6 +879,48 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) end associate end subroutine FatesPlantRespPhotosynthDrive +! =========================================================================================== + + +subroutine RootLayerNFixation(t_soil,ft,dtime,fnrt_mr_layer,fnrt_mr_nfix_layer,nfix_layer) + + real(r8),intent(in) :: t_soil ! Temperature of the current soil layer [degC] + integer,intent(in) :: ft ! Functional type index + real(r8),intent(in) :: dtime ! Time step length [s] + real(r8),intent(in) :: fnrt_mr_layer ! Amount of maintenance respiration in the fine-roots + ! for all non-fixation related processes [kgC/s] + + real(r8),intent(out) :: fnrt_mr_nfix_layer ! The added maintenance respiration due to nfixation + ! to be added as a surcharge to non-fixation MR [kgC] + real(r8),intent(out) :: nfix_layer ! The amount of N fixed in this layer through + ! symbiotic activity [kgN] + + real(r8) :: c_cost_nfix ! carbon cost of N fixation [kgC/kgN] + real(r8) :: c_spent_nfix ! carbon spent on N fixation, per layer [kgC/plant/timestep] + + ! N fixation parameters from Houlton et al (2008) and Fisher et al (2010) + real(r8), parameter :: s_fix = -6.25_r8 ! s parameter from FUN model (fisher et al 2010) + real(r8), parameter :: a_fix = -3.62_r8 ! a parameter from Houlton et al. 2010 (a = -3.62 +/- 0.52) + real(r8), parameter :: b_fix = 0.27_r8 ! b parameter from Houlton et al. 2010 (b = 0.27 +/-0.04) + real(r8), parameter :: c_fix = 25.15_r8 ! c parameter from Houlton et al. 2010 (c = 25.15 +/- 0.66) + + ! Amount of C spent (as part of MR respiration) on symbiotic fixation [kgC/s] + fnrt_mr_nfix_layer = fnrt_mr_layer * prt_params%nfix_mresp_scfrac(ft) + + ! This is the unit carbon cost for nitrogen fixation. It is temperature dependant [kgC/kgN] + c_cost_nfix = s_fix * (exp(a_fix + b_fix * (t_soil-tfrz) & + * (1._r8 - 0.5_r8 * (t_soil-tfrz) / c_fix)) - 2._r8) + + ! Time integrated amount of carbon spent on fixation (in this layer) [kgC/plant/layer/tstep] + c_spent_nfix = fnrt_mr_nfix_layer * dtime + + ! Amount of nitrogen fixed in this layer [kgC/plant/layer/tstep]/[kgC/kgN] = [kgN/plant/layer/tstep] + nfix_layer = c_spent_nfix / c_cost_nfix + + +end subroutine RootLayerNFixation + + ! ======================================================================================= subroutine LeafLayerPhotosynthesis(f_sun_lsl, & ! in @@ -1572,7 +1607,7 @@ function ft1_f(tl, ha) result(ans) ! !!USES use FatesConstantsMod, only : rgas => rgas_J_K_kmol - use FatesConstantsMod, only : tfrz => t_water_freeze_k_1atm + ! ! !ARGUMENTS: real(r8), intent(in) :: tl ! leaf temperature in photosynthesis temperature function (K) @@ -1599,7 +1634,6 @@ function fth_f(tl,hd,se,scaleFactor) result(ans) ! 7/23/16: Copied over from CLM by Ryan Knox ! use FatesConstantsMod, only : rgas => rgas_J_K_kmol - use FatesConstantsMod, only : tfrz => t_water_freeze_k_1atm ! ! !ARGUMENTS: @@ -1631,7 +1665,6 @@ function fth25_f(hd,se)result(ans) !!USES use FatesConstantsMod, only : rgas => rgas_J_K_kmol - use FatesConstantsMod, only : tfrz => t_water_freeze_k_1atm ! ! !ARGUMENTS: @@ -1945,9 +1978,6 @@ subroutine LeafLayerMaintenanceRespiration(lmr25top_ft, & veg_tempk, & lmr) - use FatesConstantsMod, only : tfrz => t_water_freeze_k_1atm - - ! Arguments real(r8), intent(in) :: lmr25top_ft ! canopy top leaf maint resp rate at 25C ! for this pft (umol CO2/m**2/s) @@ -2015,7 +2045,6 @@ subroutine LeafLayerBiophysicalRates( parsun_lsl, & ! --------------------------------------------------------------------------------- use EDPftvarcon , only : EDPftvarcon_inst - use FatesConstantsMod, only : tfrz => t_water_freeze_k_1atm ! Arguments ! ------------------------------------------------------------------------------ diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 413ef48c4f..3a8073d274 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -28,7 +28,7 @@ module EDTypesMod private ! By default everything is private save - integer, parameter, public :: nclmax = 2 ! Maximum number of canopy layers + integer, parameter, public :: nclmax = 3 ! Maximum number of canopy layers integer, parameter, public :: ican_upper = 1 ! Nominal index for the upper canopy integer, parameter, public :: ican_ustory = 2 ! Nominal index for diagnostics that refer ! to understory layers (all layers that diff --git a/parteh/PRTAllometricCNPMod.F90 b/parteh/PRTAllometricCNPMod.F90 index 6b7f4d252c..6de86ea2da 100644 --- a/parteh/PRTAllometricCNPMod.F90 +++ b/parteh/PRTAllometricCNPMod.F90 @@ -797,7 +797,7 @@ subroutine CNPAdjustFRootTargets(this, target_c, target_dcdd,co_num,nplant) ! This is more of a diagnostic, to see if the other process functions ! are as good as the ratio of relative ratios - cn_ratio = (store_c_act/store_c_max)/(store_nut_act/store_nut_max) + cn_ratio = (store_nut_act/store_nut_max) end if @@ -866,7 +866,7 @@ subroutine CNPAdjustFRootTargets(this, target_c, target_dcdd,co_num,nplant) ! Reset the integrator if its sign changes if( abs(cx_logratio)>nearzero .and. abs(cx0)>nearzero) then - if( (cx_logratio/abs(cx_logratio) - cx0/abs(cx0)) > nearzero ) then + if( abs(cx_logratio/abs(cx_logratio) - cx0/abs(cx0)) > nearzero ) then cx_int = cx_logratio end if end if @@ -890,8 +890,8 @@ subroutine CNPAdjustFRootTargets(this, target_c, target_dcdd,co_num,nplant) l2fr = max(l2fr_min, l2fr + l2fr_delta) - !if((co_num==1) .or. (co_num==2)) print*,'AAX1',co_num,hlm_current_year,hlm_day_of_year, & - ! dbh,nplant,(store_c_act/store_c_max),cx_logratio,cx_int,ema_dcxdt,l2fr + if((co_num==1)) print*,'AAX1',co_num,hlm_current_year,hlm_day_of_year, & + dbh,nplant,(store_c_act/store_c_max),cn_ratio,cx_logratio,ema_dcxdt,l2fr ! Find the updated target fineroot biomass call bfineroot(dbh,ipft,canopy_trim, l2fr, target_c(fnrt_organ),target_dcdd(fnrt_organ)) From 91bd8659d377fde6ea8b3bb728b44a8cf7d66caa Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Mon, 17 Oct 2022 11:29:10 -0400 Subject: [PATCH 43/55] cnp cleanup: change p uptake to p gain for consistency, remove temporary argument to the PRTDaily call, remove usage of all_carbon_types from PRTTurnover and various cleaning in PRTAllometricCNP --- biogeochem/EDCohortDynamicsMod.F90 | 16 ++-- biogeochem/FatesSoilBGCFluxMod.F90 | 4 +- main/EDMainMod.F90 | 6 +- main/EDTypesMod.F90 | 2 +- main/FatesHistoryInterfaceMod.F90 | 4 +- main/FatesRestartInterfaceMod.F90 | 4 +- parteh/PRTAllometricCNPMod.F90 | 132 +++++++++-------------------- parteh/PRTAllometricCarbonMod.F90 | 4 +- parteh/PRTGenericMod.F90 | 4 +- parteh/PRTLossFluxesMod.F90 | 21 +---- 10 files changed, 62 insertions(+), 135 deletions(-) diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index 47ed64fcc6..b6b83c1b2f 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -420,8 +420,8 @@ subroutine InitPRTBoundaryConditions(new_cohort) call new_cohort%prt%RegisterBCIn(acnp_bc_in_id_lstat,bc_ival = new_cohort%status_coh) call new_cohort%prt%RegisterBCIn(acnp_bc_in_id_netdc, bc_rval = new_cohort%npp_acc) - call new_cohort%prt%RegisterBCIn(acnp_bc_in_id_nc_repro,bc_rval = new_cohort%nc_repro) !patchptr%nitr_repro_stoich(ft)) - call new_cohort%prt%RegisterBCIn(acnp_bc_in_id_pc_repro,bc_rval = new_cohort%pc_repro) !patchptr%phos_repro_stoich(ft)) + call new_cohort%prt%RegisterBCIn(acnp_bc_in_id_nc_repro,bc_rval = new_cohort%nc_repro) + call new_cohort%prt%RegisterBCIn(acnp_bc_in_id_pc_repro,bc_rval = new_cohort%pc_repro) call new_cohort%prt%RegisterBCInOut(acnp_bc_inout_id_dbh,bc_rval = new_cohort%dbh) call new_cohort%prt%RegisterBCInOut(acnp_bc_inout_id_resp_excess,bc_rval = new_cohort%resp_excess) @@ -431,7 +431,7 @@ subroutine InitPRTBoundaryConditions(new_cohort) call new_cohort%prt%RegisterBCInOut(acnp_bc_inout_id_cx0,bc_rval = new_cohort%cx0) call new_cohort%prt%RegisterBCInOut(acnp_bc_inout_id_netdn, bc_rval = new_cohort%daily_n_gain) - call new_cohort%prt%RegisterBCInOut(acnp_bc_inout_id_netdp, bc_rval = new_cohort%daily_p_uptake) + call new_cohort%prt%RegisterBCInOut(acnp_bc_inout_id_netdp, bc_rval = new_cohort%daily_p_gain) call new_cohort%prt%RegisterBCOut(acnp_bc_out_id_cefflux, bc_rval = new_cohort%daily_c_efflux) call new_cohort%prt%RegisterBCOut(acnp_bc_out_id_nefflux, bc_rval = new_cohort%daily_n_efflux) @@ -581,7 +581,7 @@ subroutine nan_cohort(cc_p) currentCohort%daily_no3_uptake = nan currentCohort%daily_n_gain = nan currentCohort%daily_n_fixation = nan - currentCohort%daily_p_uptake = nan + currentCohort%daily_p_gain = nan currentCohort%daily_c_efflux = nan currentCohort%daily_n_efflux = nan currentCohort%daily_p_efflux = nan @@ -696,7 +696,7 @@ subroutine zero_cohort(cc_p) currentCohort%daily_nh4_uptake = 0._r8 currentCohort%daily_no3_uptake = 0._r8 - currentCohort%daily_p_uptake = 0._r8 + currentCohort%daily_p_gain = 0._r8 currentCohort%daily_c_efflux = 0._r8 currentCohort%daily_n_efflux = 0._r8 @@ -1445,8 +1445,8 @@ subroutine fuse_cohorts(currentSite, currentPatch, bc_in) currentCohort%daily_n_gain = (currentCohort%n*currentCohort%daily_n_gain + & nextc%n*nextc%daily_n_gain)/newn - currentCohort%daily_p_uptake = (currentCohort%n*currentCohort%daily_p_uptake + & - nextc%n*nextc%daily_p_uptake)/newn + currentCohort%daily_p_gain = (currentCohort%n*currentCohort%daily_p_gain + & + nextc%n*nextc%daily_p_gain)/newn @@ -1852,7 +1852,7 @@ subroutine copy_cohort( currentCohort,copyc ) n%daily_no3_uptake = o%daily_no3_uptake n%daily_n_fixation = o%daily_n_fixation n%daily_n_gain = o%daily_n_gain - n%daily_p_uptake = o%daily_p_uptake + n%daily_p_gain = o%daily_p_gain n%daily_c_efflux = o%daily_c_efflux n%daily_n_efflux = o%daily_n_efflux n%daily_p_efflux = o%daily_p_efflux diff --git a/biogeochem/FatesSoilBGCFluxMod.F90 b/biogeochem/FatesSoilBGCFluxMod.F90 index ce51586123..defc0bf2eb 100644 --- a/biogeochem/FatesSoilBGCFluxMod.F90 +++ b/biogeochem/FatesSoilBGCFluxMod.F90 @@ -261,7 +261,7 @@ subroutine UnPackNutrientAquisitionBCs(sites, bc_in) do while (associated(ccohort)) pft = ccohort%pft !ccohort%daily_p_demand = GetPlantDemand(ccohort,phosphorus_element) - ccohort%daily_p_uptake = -9._r8 !EDPftvarcon_inst%prescribed_puptake(pft) * ccohort%daily_p_demand + ccohort%daily_p_gain = -9._r8 !EDPftvarcon_inst%prescribed_puptake(pft) * ccohort%daily_p_demand ccohort => ccohort%shorter end do cpatch => cpatch%younger @@ -277,7 +277,7 @@ subroutine UnPackNutrientAquisitionBCs(sites, bc_in) icomp = icomp+1 ccohort%daily_p_demand = GetPlantDemand(ccohort,phosphorus_element) ! P Uptake: Convert g/m2/day -> kg/plant/day - ccohort%daily_p_uptake = bc_in(s)%plant_p_uptake_flux(icomp,1)*kg_per_g*AREA/ccohort%n + ccohort%daily_p_gain = bc_in(s)%plant_p_uptake_flux(icomp,1)*kg_per_g*AREA/ccohort%n ccohort => ccohort%shorter end do cpatch => cpatch%younger diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index fd4b1fd2b1..b50370b96e 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -456,7 +456,7 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) ! ----------------------------------------------------------------------------- currentCohort%resp_excess = 0._r8 - call currentCohort%prt%DailyPRT(co_num,currentCohort%n) + call currentCohort%prt%DailyPRT() ! Send any efflux/exudates to the labile litter pools in the HLM ! ----------------------------------------------------------------------------- @@ -473,7 +473,7 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) ! Mass balance for P uptake currentSite%mass_balance(element_pos(phosphorus_element))%net_root_uptake = & currentSite%mass_balance(element_pos(phosphorus_element))%net_root_uptake + & - (currentCohort%daily_p_uptake-currentCohort%daily_p_efflux)*currentCohort%n + (currentCohort%daily_p_gain-currentCohort%daily_p_efflux)*currentCohort%n end if ! mass balance for C efflux (if any) @@ -848,7 +848,7 @@ subroutine TotalBalanceCheck (currentSite, call_index ) write(fates_log(),*) 'N efflux: ',currentCohort%daily_n_efflux*currentCohort%n write(fates_log(),*) 'N fixation: ',currentCohort%daily_n_fixation*currentCohort%n elseif(element_list(el).eq.phosphorus_element) then - write(fates_log(),*) 'P uptake: ',currentCohort%daily_p_uptake*currentCohort%n + write(fates_log(),*) 'P uptake: ',currentCohort%daily_p_gain*currentCohort%n write(fates_log(),*) 'P efflux: ',currentCohort%daily_p_efflux*currentCohort%n elseif(element_list(el).eq.carbon12_element) then write(fates_log(),*) 'C efflux: ',currentCohort%daily_c_efflux*currentCohort%n diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 3a8073d274..c2f4f3cb60 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -301,7 +301,7 @@ module EDTypesMod real(r8) :: daily_no3_uptake ! integrated daily uptake of mineralized nitrate through competitive acquisition in soil [kg N / plant/ day] real(r8) :: daily_n_fixation ! Rate of N fixation from the roots [kgN/indiv/day] real(r8) :: daily_n_gain ! sum of fixation and uptake of mineralized nh4/no3 in solution - real(r8) :: daily_p_uptake ! integrated daily uptake of mineralized P through competitive acquisition in soil [kg P / plant/ day] + real(r8) :: daily_p_gain ! integrated daily uptake of mineralized P through competitive acquisition in soil [kg P / plant/ day] real(r8) :: daily_c_efflux ! daily mean efflux of excess carbon from roots into labile pool [kg C/plant/day] real(r8) :: daily_n_efflux ! daily mean efflux of excess nitrogen from roots into labile pool [kg N/plant/day] diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index da59b0d803..0f4fb141c8 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -1895,11 +1895,11 @@ subroutine update_history_nutrflux(this,csite) fates_hist%hvars(ih_puptake_scpf)%r82d(io_si,iscpf) = & fates_hist%hvars(ih_puptake_scpf)%r82d(io_si,iscpf) + & - ccohort%daily_p_uptake*uconv + ccohort%daily_p_gain*uconv fates_hist%hvars(ih_puptake_si)%r81d(io_si) = & fates_hist%hvars(ih_puptake_si)%r81d(io_si) + & - ccohort%daily_p_uptake*uconv + ccohort%daily_p_gain*uconv this%hvars(ih_pefflux_scpf)%r82d(io_si,iscpf) = & this%hvars(ih_pefflux_scpf)%r82d(io_si,iscpf) + & diff --git a/main/FatesRestartInterfaceMod.F90 b/main/FatesRestartInterfaceMod.F90 index c3e9566f2d..6f7dde794e 100644 --- a/main/FatesRestartInterfaceMod.F90 +++ b/main/FatesRestartInterfaceMod.F90 @@ -1993,7 +1993,7 @@ subroutine set_restart_vectors(this,nc,nsites,sites) ! Nutrient uptake/efflux rio_daily_no3_uptake_co(io_idx_co) = ccohort%daily_no3_uptake rio_daily_nh4_uptake_co(io_idx_co) = ccohort%daily_nh4_uptake - rio_daily_p_uptake_co(io_idx_co) = ccohort%daily_p_uptake + rio_daily_p_uptake_co(io_idx_co) = ccohort%daily_p_gain rio_daily_n_fixation_co(io_idx_co) = ccohort%daily_n_fixation rio_daily_n_demand_co(io_idx_co) = ccohort%daily_n_demand @@ -2796,7 +2796,7 @@ subroutine get_restart_vectors(this, nc, nsites, sites) ccohort%daily_nh4_uptake = rio_daily_nh4_uptake_co(io_idx_co) ccohort%daily_no3_uptake = rio_daily_no3_uptake_co(io_idx_co) ccohort%daily_n_fixation = rio_daily_n_fixation_co(io_idx_co) - ccohort%daily_p_uptake = rio_daily_p_uptake_co(io_idx_co) + ccohort%daily_p_gain = rio_daily_p_uptake_co(io_idx_co) ccohort%daily_n_demand = rio_daily_n_demand_co(io_idx_co) ccohort%daily_p_demand = rio_daily_p_demand_co(io_idx_co) diff --git a/parteh/PRTAllometricCNPMod.F90 b/parteh/PRTAllometricCNPMod.F90 index 6de86ea2da..ad943702ba 100644 --- a/parteh/PRTAllometricCNPMod.F90 +++ b/parteh/PRTAllometricCNPMod.F90 @@ -210,7 +210,14 @@ module PRTAllometricCNPMod integer, parameter :: n_limited = 2 integer, parameter :: p_limited = 3 + ! Flags to select using the equivalent carbon method of co-limitation, + ! or to just grow with available carbon and let it fix itself on the + ! next step + integer, parameter :: grow_lim_conly = 1 ! Just use C to decide stature on this step + integer, parameter :: grow_lim_estNP = 2 ! Estimate equivalent C from N and P + integer, parameter :: grow_lim_type = grow_lim_estNP + ! Following growth, if desired, you can prioritize that ! reproductive tissues get balanced CNP logical, parameter :: prioritize_repro_nutr_growth = .true. @@ -340,11 +347,9 @@ end subroutine InitPRTGlobalAllometricCNP ! ===================================================================================== - subroutine DailyPRTAllometricCNP(this,co_num,nplant) + subroutine DailyPRTAllometricCNP(this) class(cnp_allom_prt_vartypes) :: this - integer,intent(in) :: co_num ! Cohort index - real(r8),intent(in) :: nplant ! Pointers to in-out bcs real(r8),pointer :: dbh ! Diameter at breast height [cm] @@ -464,9 +469,7 @@ subroutine DailyPRTAllometricCNP(this,co_num,nplant) ! and then attempt to get them up to stoichiometry targets. ! =================================================================================== - ! This routine updates the l2fr (leaf 2 fine-root multiplier) variable - ! It will also update the target - !call this%CNPAdjustFRootTargets(target_c,target_dcdd,co_num,nplant) + ! Remember the original C,N,P states to help with final ! evaluation of how much was allocated @@ -553,11 +556,6 @@ subroutine DailyPRTAllometricCNP(this,co_num,nplant) call endrun(msg=errMsg(sourcefile, __LINE__)) end if - - ! This routine updates the l2fr (leaf 2 fine-root multiplier) variable - ! It will also update the target - !call this%CNPAdjustFRootTargets(target_c,target_dcdd,co_num,nplant) - ! =================================================================================== ! Step 3. ! At this point, at least 1 of the 3 resources have been used up. @@ -565,7 +563,7 @@ subroutine DailyPRTAllometricCNP(this,co_num,nplant) ! =================================================================================== call this%CNPAllocateRemainder(c_gain, n_gain, p_gain, & - c_efflux, n_efflux, p_efflux,co_num,nplant,target_c,target_dcdd) + c_efflux, n_efflux, p_efflux,target_c,target_dcdd) if(n_uptake_mode.ne.prescribed_n_uptake) then @@ -694,7 +692,7 @@ end function SafeLog ! ===================================================================================== - subroutine CNPAdjustFRootTargets(this, target_c, target_dcdd,co_num,nplant) + subroutine CNPAdjustFRootTargets(this, target_c, target_dcdd) use FatesInterfaceTypesMod , only : hlm_day_of_year use FatesInterfaceTypesMod , only : hlm_current_year @@ -702,17 +700,15 @@ subroutine CNPAdjustFRootTargets(this, target_c, target_dcdd,co_num,nplant) class(cnp_allom_prt_vartypes) :: this real(r8) :: target_c(:) real(r8) :: target_dcdd(:) - integer,intent(in) :: co_num ! Used for single plant diagnostics - real(r8),intent(in) :: nplant ! Used for single plant diagnostics real(r8), pointer :: l2fr ! leaf to fineroot target biomass scaler integer :: ipft ! PFT index real(r8), pointer :: dbh real(r8) :: canopy_trim integer :: leaf_status + integer, pointer :: limiter real(r8) :: store_c_max, store_c_act real(r8) :: store_nut_max, store_nut_act - real(r8) :: n_ratio, p_ratio real(r8) :: l2fr_delta real(r8) :: cn_ratio, cp_ratio ! ratio of relative C storage over relative N or P storage real(r8) :: dcxdt_ratio ! log change (derivative) of the maximum of the N/C and P/C storage ratio @@ -721,20 +717,9 @@ subroutine CNPAdjustFRootTargets(this, target_c, target_dcdd,co_num,nplant) real(r8), pointer :: cx0 ! The log of the cx ratio from previous time-step real(r8), pointer :: ema_dcxdt ! the EMA of the change in log storage ratio - real(r8), parameter :: pid_drv_wgt = 1._r8/10._r8 ! n-day smoothing of the derivative + real(r8), parameter :: pid_drv_wgt = 1._r8/20._r8 ! n-day smoothing of the derivative ! of the process function in the PID controller - ! These are different ways of defining the process function in the PID controller. pid_ncratio_function - ! is perhaps the most complete, in that it gives the true balance of relative C stores to relative N - ! stores. In the future we may just remove the alternatives - - integer, parameter :: pid_c_function = 0 - integer, parameter :: pid_n_function = 1 - integer, parameter :: pid_minnc_function = 2 - integer, parameter :: pid_alogmaxnc_function = 3 - integer, parameter :: pid_ncratio_function = 4 - integer, parameter :: pid_function = pid_ncratio_function - leaf_status = this%bc_in(acnp_bc_in_id_lstat)%ival ipft = this%bc_in(acnp_bc_in_id_pft)%ival l2fr => this%bc_inout(acnp_bc_inout_id_l2fr)%rval @@ -743,7 +728,8 @@ subroutine CNPAdjustFRootTargets(this, target_c, target_dcdd,co_num,nplant) cx_int => this%bc_inout(acnp_bc_inout_id_cx_int)%rval cx0 => this%bc_inout(acnp_bc_inout_id_cx0)%rval ema_dcxdt => this%bc_inout(acnp_bc_inout_id_emadcxdt)%rval - + limiter => this%bc_out(acnp_bc_out_id_limiter)%ival + ! Abort if leaves are off if(leaf_status.eq.leaves_off) return @@ -762,7 +748,7 @@ subroutine CNPAdjustFRootTargets(this, target_c, target_dcdd,co_num,nplant) this%bc_in(acnp_bc_in_id_netdc)%rval) if(n_uptake_mode.eq.prescribed_n_uptake)then - n_ratio = -1._r8 + cn_ratio = -1._r8 else ! Calculate the relative nitrogen storage fraction, @@ -774,35 +760,12 @@ subroutine CNPAdjustFRootTargets(this, target_c, target_dcdd,co_num,nplant) this%GetState(store_organ, nitrogen_element) + & this%bc_inout(acnp_bc_inout_id_netdn)%rval) - select case(pid_function) - case(pid_c_function) - n_ratio = store_c_act/store_c_max - case(pid_n_function) - n_ratio = store_nut_max/store_nut_act - case(pid_minnc_function) - if((store_nut_act/store_nut_max) > (store_c_act/store_c_max))then - n_ratio = (store_c_act/store_c_max) - else - n_ratio = (store_nut_max/store_nut_act) - end if - case(pid_alogmaxnc_function) - if( abs(SafeLog(store_nut_act/store_nut_max)) < abs(SafeLog(store_c_act/store_c_max))) then - n_ratio = (store_c_act/store_c_max) - else - n_ratio = (store_nut_max/store_nut_act) - end if - case(pid_ncratio_function) - n_ratio = (store_c_act/store_c_max)/(store_nut_act/store_nut_max) - end select - - ! This is more of a diagnostic, to see if the other process functions - ! are as good as the ratio of relative ratios - cn_ratio = (store_nut_act/store_nut_max) + cn_ratio = (store_c_act/store_c_max)/(store_nut_act/store_nut_max) end if if(p_uptake_mode.eq.prescribed_p_uptake)then - p_ratio = -1._r8 + cp_ratio = -1._r8 else ! Calculate the relative phosphorus storage fraction, @@ -814,30 +777,8 @@ subroutine CNPAdjustFRootTargets(this, target_c, target_dcdd,co_num,nplant) this%GetState(store_organ, phosphorus_element) + & this%bc_inout(acnp_bc_inout_id_netdp)%rval) - select case(pid_function) - case(pid_c_function) - p_ratio = store_c_act/store_c_max - case(pid_n_function) - p_ratio = store_nut_max/store_nut_act - case(pid_minnc_function) - if((store_nut_act/store_nut_max) > (store_c_act/store_c_max))then - p_ratio = (store_c_act/store_c_max) - else - p_ratio = (store_nut_max/store_nut_act) - end if - case(pid_alogmaxnc_function) - if( abs(SafeLog(store_nut_act/store_nut_max)) < abs(SafeLog(store_c_act/store_c_max))) then - p_ratio = (store_c_act/store_c_max) - else - p_ratio = (store_nut_max/store_nut_act) - end if - case(pid_ncratio_function) - p_ratio = (store_c_act/store_c_max)/(store_nut_act/store_nut_max) - end select - cp_ratio = (store_c_act/store_c_max)/(store_nut_act/store_nut_max) - end if ! Use the limiting nutrient species @@ -850,11 +791,11 @@ subroutine CNPAdjustFRootTargets(this, target_c, target_dcdd,co_num,nplant) else if (n_uptake_mode.eq.prescribed_n_uptake) then - cx_logratio = SafeLog(p_ratio) + cx_logratio = SafeLog(cp_ratio) elseif (p_uptake_mode.eq.prescribed_p_uptake) then - cx_logratio = SafeLog(n_ratio) + cx_logratio = SafeLog(cn_ratio) else - cx_logratio = SafeLog(max(p_ratio,n_ratio)) + cx_logratio = SafeLog(max(cp_ratio,cn_ratio)) end if ! If cx_logratio has just crossed zero, then @@ -890,9 +831,6 @@ subroutine CNPAdjustFRootTargets(this, target_c, target_dcdd,co_num,nplant) l2fr = max(l2fr_min, l2fr + l2fr_delta) - if((co_num==1)) print*,'AAX1',co_num,hlm_current_year,hlm_day_of_year, & - dbh,nplant,(store_c_act/store_c_max),cn_ratio,cx_logratio,ema_dcxdt,l2fr - ! Find the updated target fineroot biomass call bfineroot(dbh,ipft,canopy_trim, l2fr, target_c(fnrt_organ),target_dcdd(fnrt_organ)) @@ -1381,10 +1319,7 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & real(r8) :: intgr_params(num_intgr_parm) - integer, parameter :: grow_lim_conly = 1 ! Just use C to decide stature on this step - integer, parameter :: grow_lim_estNP = 2 ! Estimate equivalent C from N and P - integer, parameter :: grow_lim_type = grow_lim_estNP real(r8) :: neq_cgain, peq_cgain ! N and P equivalent c_gain spent on growth real(r8) :: cnp_gain ! used as a check to see efficiency of limited growth @@ -1406,7 +1341,9 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & if(n_gain <= 0.1_r8*calloc_abs_error) limiter = n_limited if(p_gain <= 0.02_r8*calloc_abs_error) limiter = p_limited end if - + + limiter = 0 + ! If any of these resources is essentially tapped out, ! then there is no point in performing growth ! It also seems impossible that we would be in a leaf-off status @@ -1545,6 +1482,7 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & if(grow_lim_type == grow_lim_conly) then c_gstature = c_gain + limiter = 0 elseif (grow_lim_type == grow_lim_estNP) then call EstimateGrowthNC(this,target_c,target_dcdd,state_mask,avg_nc,avg_pc) @@ -1813,7 +1751,7 @@ end subroutine CNPStatureGrowth subroutine CNPAllocateRemainder(this, c_gain,n_gain,p_gain, & c_efflux, n_efflux, p_efflux, & - co_num,nplant,target_c,target_dcdd) + target_c,target_dcdd) class(cnp_allom_prt_vartypes) :: this real(r8), intent(inout) :: c_gain @@ -1822,8 +1760,6 @@ subroutine CNPAllocateRemainder(this, c_gain,n_gain,p_gain, & real(r8), intent(inout) :: c_efflux real(r8), intent(inout) :: n_efflux real(r8), intent(inout) :: p_efflux - integer,intent(in) :: co_num - real(r8),intent(in) :: nplant real(r8) :: target_c(:) real(r8) :: target_dcdd(:) @@ -1855,9 +1791,14 @@ subroutine CNPAllocateRemainder(this, c_gain,n_gain,p_gain, & ! Update the nitrogen and phosphorus deficits target_n = this%GetNutrientTarget(nitrogen_element,l2g_organ_list(i),stoich_growth_min) - deficit_n(i) = max(0._r8,this%GetDeficit(nitrogen_element,l2g_organ_list(i),target_n)) - target_p = this%GetNutrientTarget(phosphorus_element,l2g_organ_list(i),stoich_growth_min) + + if(l2g_organ_list(i)==store_organ)then + target_n = target_n * (1._r8 + prt_params%store_ovrflw_frac(ipft)) + target_p = target_p * (1._r8 + prt_params%store_ovrflw_frac(ipft)) + end if + + deficit_n(i) = max(0._r8,this%GetDeficit(nitrogen_element,l2g_organ_list(i),target_n)) deficit_p(i) = max(0._r8,this%GetDeficit(phosphorus_element,l2g_organ_list(i),target_p)) end do @@ -1875,7 +1816,10 @@ subroutine CNPAllocateRemainder(this, c_gain,n_gain,p_gain, & call ProportionalNutrAllocation(this,deficit_p(1:num_organs), & p_gain, phosphorus_element, l2g_organ_list(1:num_organs)) - call this%CNPAdjustFRootTargets(target_c,target_dcdd,co_num,nplant) + + ! This routine updates the l2fr (leaf 2 fine-root multiplier) variable + ! It will also update the target + call this%CNPAdjustFRootTargets(target_c,target_dcdd) ! ----------------------------------------------------------------------------------- ! If carbon is still available, lets cram some into storage overflow @@ -1925,7 +1869,7 @@ subroutine CNPAllocateRemainder(this, c_gain,n_gain,p_gain, & end if end if - + ! Figure out what to do with excess carbon and nutrients ! 1) excude through roots cap at 0 to flush out imprecisions diff --git a/parteh/PRTAllometricCarbonMod.F90 b/parteh/PRTAllometricCarbonMod.F90 index a4ad1607c1..b42fbfa01e 100644 --- a/parteh/PRTAllometricCarbonMod.F90 +++ b/parteh/PRTAllometricCarbonMod.F90 @@ -241,7 +241,7 @@ end subroutine InitPRTGlobalAllometricCarbon ! ===================================================================================== - subroutine DailyPRTAllometricCarbon(this,co_num,nplant) + subroutine DailyPRTAllometricCarbon(this) ! ----------------------------------------------------------------------------------- ! @@ -286,8 +286,6 @@ subroutine DailyPRTAllometricCarbon(this,co_num,nplant) ! The class is the only argument class(callom_prt_vartypes) :: this ! this class - integer,intent(in) :: co_num ! cohort index - real(r8),intent(in) :: nplant ! ----------------------------------------------------------------------------------- ! These are local copies of the in/out boundary condition structure ! ----------------------------------------------------------------------------------- diff --git a/parteh/PRTGenericMod.F90 b/parteh/PRTGenericMod.F90 index 9e1aaf8ef8..a8f5b3c183 100644 --- a/parteh/PRTGenericMod.F90 +++ b/parteh/PRTGenericMod.F90 @@ -1159,11 +1159,9 @@ end function GetCoordVal ! ==================================================================================== - subroutine DailyPRTBase(this,co_num,nplant) + subroutine DailyPRTBase(this) class(prt_vartypes) :: this - integer,intent(in) :: co_num ! cohort number - real(r8),intent(in) :: nplant write(fates_log(),*)'Daily PRT Allocation must be extended' call endrun(msg=errMsg(sourcefile, __LINE__)) diff --git a/parteh/PRTLossFluxesMod.F90 b/parteh/PRTLossFluxesMod.F90 index 33eb34b1ea..dcbf73ab10 100644 --- a/parteh/PRTLossFluxesMod.F90 +++ b/parteh/PRTLossFluxesMod.F90 @@ -8,7 +8,6 @@ module PRTLossFluxesMod use PRTGenericMod, only : store_organ use PRTGenericMod, only : repro_organ use PRTGenericMod, only : struct_organ - use PRTGenericMod, only : carbon_elements_list use PRTGenericMod, only : carbon12_element use PRTGenericMod, only : carbon13_element use PRTGenericMod, only : carbon14_element @@ -158,23 +157,11 @@ subroutine PRTPhenologyFlush(prt, ipft, organ_id, c_store_transfer_frac) element_id = prt_global%state_descriptor(i_var)%element_id ! This will filter IN all carbon related variables - if( any(element_id == carbon_elements_list) ) then + if( element_id == carbon12_element ) then - ! No hypotheses exist for how to flush carbon isotopes - ! yet. Please fill this in. - if( (element_id == carbon13_element) .or. & - (element_id == carbon14_element) )then - write(fates_log(),*) ' Phenology flushing routine does not know' - write(fates_log(),*) ' how to handle carbon isotopes. Please' - write(fates_log(),*) ' evaluate the code referenced in this message' - write(fates_log(),*) ' and provide a hypothesis.' - call endrun(msg=errMsg(__FILE__, __LINE__)) - end if - ! Get the variable id of the storage pool for this element (carbon12) i_store = prt_global%sp_organ_map(store_organ,element_id) - do i_pos = 1,i_leaf_pos ! Calculate the mass transferred out of storage into the pool of interest @@ -222,7 +209,7 @@ subroutine PRTPhenologyFlush(prt, ipft, organ_id, c_store_transfer_frac) element_id = prt_global%state_descriptor(i_var)%element_id ! This will filter OUT all carbon related elements - if ( .not. any(element_id == carbon_elements_list) ) then + if ( .not. (element_id == carbon12_element) ) then ! Get the variable id of the storage pool for this element i_store = prt_global%sp_organ_map(store_organ,element_id) @@ -509,7 +496,7 @@ subroutine DeciduousTurnoverSimpleRetranslocation(prt,ipft,organ_id,mass_fractio if( prt_params%organ_param_id(organ_id) < 1 ) then retrans = 0._r8 else - if ( any(element_id == carbon_elements_list) ) then + if ( element_id == carbon12_element ) then retrans = 0._r8 else if( element_id == nitrogen_element ) then retrans = prt_params%turnover_nitr_retrans(ipft,prt_params%organ_param_id(organ_id)) @@ -713,7 +700,7 @@ subroutine MaintTurnoverSimpleRetranslocation(prt,ipft,is_drought) if( prt_params%organ_param_id(organ_id) < 1 ) then retrans_frac = 0._r8 else - if ( any(element_id == carbon_elements_list) ) then + if ( element_id == carbon12_element ) then retrans_frac = 0._r8 else if( element_id == nitrogen_element ) then retrans_frac = prt_params%turnover_nitr_retrans(ipft,prt_params%organ_param_id(organ_id)) From 4ee19d22b6eceac600e760dbc25218a54ad527cc Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Mon, 17 Oct 2022 12:12:36 -0400 Subject: [PATCH 44/55] Reverting nclmax --- main/EDTypesMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index c2f4f3cb60..1f05882433 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -28,7 +28,7 @@ module EDTypesMod private ! By default everything is private save - integer, parameter, public :: nclmax = 3 ! Maximum number of canopy layers + integer, parameter, public :: nclmax = 2 ! Maximum number of canopy layers integer, parameter, public :: ican_upper = 1 ! Nominal index for the upper canopy integer, parameter, public :: ican_ustory = 2 ! Nominal index for diagnostics that refer ! to understory layers (all layers that From b194c1fc9a2561799225568f10f0fd0bbc589ad3 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Wed, 19 Oct 2022 11:38:20 -0400 Subject: [PATCH 45/55] Clean up of fates cnp restart code and testing --- biogeochem/EDCohortDynamicsMod.F90 | 104 ++++++++-------- main/EDMainMod.F90 | 2 +- main/EDTypesMod.F90 | 27 +++-- main/FatesRestartInterfaceMod.F90 | 184 ++++++++++++++--------------- 4 files changed, 165 insertions(+), 152 deletions(-) diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index b6b83c1b2f..e5eaeac366 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -241,10 +241,13 @@ subroutine create_cohort(currentSite, patchptr, pft, nn, hite, coage, dbh, & new_cohort%l2fr = prt_params%allom_l2fr(pft) - new_cohort%cx_int = 0._r8 ! Assume balanced N,P/C stores ie log(1) = 0 - new_cohort%cx0 = 0._r8 ! Assume balanced N,P/C stores ie log(1) = 0 - new_cohort%ema_dcxdt = 0._r8 ! Assume unchanged dCX/dt - + if(hlm_parteh_mode .eq. prt_cnp_flex_allom_hyp) then + new_cohort%cx_int = 0._r8 ! Assume balanced N,P/C stores ie log(1) = 0 + new_cohort%cx0 = 0._r8 ! Assume balanced N,P/C stores ie log(1) = 0 + new_cohort%ema_dcxdt = 0._r8 ! Assume unchanged dCX/dt + new_cohort%cnp_limiter = 0 ! Assume limitations are unknown + end if + ! This sets things like vcmax25top, that depend on the ! leaf age fractions (which are defined by PARTEH) call UpdateCohortBioPhysRates(new_cohort) @@ -581,12 +584,16 @@ subroutine nan_cohort(cc_p) currentCohort%daily_no3_uptake = nan currentCohort%daily_n_gain = nan currentCohort%daily_n_fixation = nan - currentCohort%daily_p_gain = nan - currentCohort%daily_c_efflux = nan - currentCohort%daily_n_efflux = nan - currentCohort%daily_p_efflux = nan - currentCohort%daily_n_demand = nan - currentCohort%daily_p_demand = nan + currentCohort%daily_p_gain = nan + currentCohort%daily_c_efflux = nan + currentCohort%daily_n_efflux = nan + currentCohort%daily_p_efflux = nan + currentCohort%daily_n_demand = nan + currentCohort%daily_p_demand = nan + currentCohort%cx_int = nan + currentCohort%cx0 = nan + currentCohort%ema_dcxdt = nan + currentCohort%cnp_limiter = fates_unset_int currentCohort%c13disc_clm = nan ! C13 discrimination, per mil at indiv/timestep currentCohort%c13disc_acc = nan ! C13 discrimination, per mil at indiv/timestep at indiv/daily at the end of a day @@ -1208,13 +1215,9 @@ subroutine fuse_cohorts(currentSite, currentPatch, bc_in) end do end if - currentCohort%cx_int = (currentCohort%n*currentCohort%cx_int & - + nextc%n*nextc%cx_int)/newn - currentCohort%ema_dcxdt = (currentCohort%n*currentCohort%ema_dcxdt & - + nextc%n*nextc%ema_dcxdt)/newn - currentCohort%cx0 = (currentCohort%n*currentCohort%cx0 & - + nextc%n*nextc%cx0)/newn + + ! new cohort age is weighted mean of two cohorts currentCohort%coage = & (currentCohort%coage * (currentCohort%n/(currentCohort%n + nextc%n))) + & @@ -1435,32 +1438,39 @@ subroutine fuse_cohorts(currentSite, currentPatch, bc_in) currentCohort%asmort = (currentCohort%n*currentCohort%asmort + nextc%n*nextc%asmort)/newn currentCohort%frmort = (currentCohort%n*currentCohort%frmort + nextc%n*nextc%frmort)/newn - ! Nutrient fluxes - currentCohort%daily_nh4_uptake = (currentCohort%n*currentCohort%daily_nh4_uptake + & - nextc%n*nextc%daily_nh4_uptake)/newn - currentCohort%daily_no3_uptake = (currentCohort%n*currentCohort%daily_no3_uptake + & - nextc%n*nextc%daily_no3_uptake)/newn - currentCohort%daily_n_fixation = (currentCohort%n*currentCohort%daily_n_fixation + & - nextc%n*nextc%daily_n_fixation)/newn - currentCohort%daily_n_gain = (currentCohort%n*currentCohort%daily_n_gain + & - nextc%n*nextc%daily_n_gain)/newn - - currentCohort%daily_p_gain = (currentCohort%n*currentCohort%daily_p_gain + & - nextc%n*nextc%daily_p_gain)/newn - - - - currentCohort%daily_p_demand = (currentCohort%n*currentCohort%daily_p_demand + & - nextc%n*nextc%daily_p_demand)/newn - currentCohort%daily_n_demand = (currentCohort%n*currentCohort%daily_n_demand + & - nextc%n*nextc%daily_n_demand)/newn - - currentCohort%daily_c_efflux = (currentCohort%n*currentCohort%daily_c_efflux + & - nextc%n*nextc%daily_c_efflux)/newn - currentCohort%daily_n_efflux = (currentCohort%n*currentCohort%daily_n_efflux + & - nextc%n*nextc%daily_n_efflux)/newn - currentCohort%daily_p_efflux = (currentCohort%n*currentCohort%daily_p_efflux + & - nextc%n*nextc%daily_p_efflux)/newn + ! Nutrients + if(hlm_parteh_mode .eq. prt_cnp_flex_allom_hyp) then + + if(nextc%n > currentCohort%n) currentCohort%cnp_limiter = nextc%cnp_limiter + + currentCohort%cx_int = (currentCohort%n*currentCohort%cx_int + & + nextc%n*nextc%cx_int)/newn + currentCohort%ema_dcxdt = (currentCohort%n*currentCohort%ema_dcxdt + & + nextc%n*nextc%ema_dcxdt)/newn + currentCohort%cx0 = (currentCohort%n*currentCohort%cx0 + & + nextc%n*nextc%cx0)/newn + currentCohort%daily_nh4_uptake = (currentCohort%n*currentCohort%daily_nh4_uptake + & + nextc%n*nextc%daily_nh4_uptake)/newn + currentCohort%daily_no3_uptake = (currentCohort%n*currentCohort%daily_no3_uptake + & + nextc%n*nextc%daily_no3_uptake)/newn + currentCohort%daily_n_fixation = (currentCohort%n*currentCohort%daily_n_fixation + & + nextc%n*nextc%daily_n_fixation)/newn + currentCohort%daily_n_gain = (currentCohort%n*currentCohort%daily_n_gain + & + nextc%n*nextc%daily_n_gain)/newn + currentCohort%daily_p_gain = (currentCohort%n*currentCohort%daily_p_gain + & + nextc%n*nextc%daily_p_gain)/newn + currentCohort%daily_p_demand = (currentCohort%n*currentCohort%daily_p_demand + & + nextc%n*nextc%daily_p_demand)/newn + currentCohort%daily_n_demand = (currentCohort%n*currentCohort%daily_n_demand + & + nextc%n*nextc%daily_n_demand)/newn + currentCohort%daily_c_efflux = (currentCohort%n*currentCohort%daily_c_efflux + & + nextc%n*nextc%daily_c_efflux)/newn + currentCohort%daily_n_efflux = (currentCohort%n*currentCohort%daily_n_efflux + & + nextc%n*nextc%daily_n_efflux)/newn + currentCohort%daily_p_efflux = (currentCohort%n*currentCohort%daily_p_efflux + & + nextc%n*nextc%daily_p_efflux)/newn + end if + ! logging mortality, Yi Xu currentCohort%lmort_direct = (currentCohort%n*currentCohort%lmort_direct + & @@ -1826,10 +1836,12 @@ subroutine copy_cohort( currentCohort,copyc ) n%kp25top = o%kp25top ! Copy over running means - n%cx_int = o%cx_int - n%ema_dcxdt = o%ema_dcxdt - n%cx0 = o%cx0 - + if(hlm_parteh_mode .eq. prt_cnp_flex_allom_hyp) then + n%cx_int = o%cx_int + n%ema_dcxdt = o%ema_dcxdt + n%cx0 = o%cx0 + end if + ! CARBON FLUXES n%gpp_acc_hold = o%gpp_acc_hold n%gpp_acc = o%gpp_acc diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index b50370b96e..3d52612fd7 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -455,7 +455,7 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) ! Growth and Allocation (PARTEH) ! ----------------------------------------------------------------------------- currentCohort%resp_excess = 0._r8 - + call currentCohort%prt%DailyPRT() ! Send any efflux/exudates to the labile litter pools in the HLM diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 1f05882433..28df1cc372 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -28,7 +28,7 @@ module EDTypesMod private ! By default everything is private save - integer, parameter, public :: nclmax = 2 ! Maximum number of canopy layers + integer, parameter, public :: nclmax = 3 ! Maximum number of canopy layers integer, parameter, public :: ican_upper = 1 ! Nominal index for the upper canopy integer, parameter, public :: ican_ustory = 2 ! Nominal index for diagnostics that refer ! to understory layers (all layers that @@ -214,17 +214,10 @@ module EDTypesMod ! enabled simulations, this is dynamic, will ! vary between allom_l2fr_min and allom_l2fr_max ! parameters, with a tendency driven by - ! nutrient storage) [g root / g leaf] + ! nutrient storage) [kg root / kg leaf] - ! Used for CNP - integer :: cnp_limiter ! Which species is limiting growth? ! 0=none,1=C,2=N,3=P - real(r8) :: cx_int ! The time integration of the log of the relative carbon storage over relative nutrient - real(r8) :: ema_dcxdt ! The derivative of the log of the relative carbon storage over relative nutrient - real(r8) :: cx0 ! The value on the previous time-step of log of the relative carbon - ! storage over relative nutrient - real(r8) :: nc_repro ! The NC ratio of a new recruit in this patch - real(r8) :: pc_repro ! The PC ratio of a new recruit in this patch + ! VEGETATION STRUCTURE @@ -295,6 +288,16 @@ module EDTypesMod real(r8) :: c13disc_clm ! carbon 13 discrimination in new synthesized carbon: part-per-mil, at each indiv/timestep real(r8) :: c13disc_acc ! carbon 13 discrimination in new synthesized carbon: part-per-mil, at each indiv/day, at the end of a day + + ! Used for CNP + integer :: cnp_limiter ! Which species is limiting growth? ! 0=none,1=C,2=N,3=P + real(r8) :: cx_int ! The time integration of the log of the relative carbon storage over relative nutrient + real(r8) :: ema_dcxdt ! The derivative of the log of the relative carbon storage over relative nutrient + real(r8) :: cx0 ! The value on the previous time-step of log of the relative carbon + ! storage over relative nutrient + real(r8) :: nc_repro ! The NC ratio of a new recruit, used also for defining reproductive stoich + real(r8) :: pc_repro ! The PC ratio of a new recruit + ! Nutrient Fluxes (if N, P, etc. are turned on) real(r8) :: daily_nh4_uptake ! integrated daily uptake of mineralized ammonium through competitive acquisition in soil [kg N / plant/ day] @@ -310,8 +313,6 @@ module EDTypesMod real(r8) :: daily_n_demand ! The daily amount of N demanded by the plant [kgN/plant/day] real(r8) :: daily_p_demand ! The daily amount of P demanded by the plant [kgN/plant/day] - ! N fixation rate - ! The following four biophysical rates are assumed to be ! at the canopy top, at reference temp 25C, and based on the @@ -538,6 +539,8 @@ module EDTypesMod real(r8) :: btran_ft(maxpft) ! btran calculated seperately for each PFT:- real(r8) :: bstress_sal_ft(maxpft) ! bstress from salinity calculated seperately for each PFT:- + + ! These two variables are only used for external seed rain currently. real(r8) :: nitr_repro_stoich(maxpft) ! The NC ratio of a new recruit in this patch real(r8) :: phos_repro_stoich(maxpft) ! The PC ratio of a new recruit in this patch diff --git a/main/FatesRestartInterfaceMod.F90 b/main/FatesRestartInterfaceMod.F90 index 6f7dde794e..ef5e8a918d 100644 --- a/main/FatesRestartInterfaceMod.F90 +++ b/main/FatesRestartInterfaceMod.F90 @@ -18,6 +18,7 @@ module FatesRestartInterfaceMod use FatesInterfaceTypesMod, only : bc_in_type use FatesInterfaceTypesMod, only : bc_out_type use FatesInterfaceTypesMod, only : hlm_use_planthydro + use FatesInterfaceTypesMod, only : hlm_parteh_mode use FatesInterfaceTypesMod, only : hlm_use_sp use FatesInterfaceTypesMod, only : fates_maxElementsPerSite use EDCohortDynamicsMod, only : UpdateCohortBioPhysRates @@ -27,6 +28,7 @@ module FatesRestartInterfaceMod use FatesHydraulicsMemMod, only : nlevsoi_hyd_max use FatesPlantHydraulicsMod, only : UpdatePlantPsiFTCFromTheta use PRTGenericMod, only : prt_global + use PRTGenericMod, only : prt_cnp_flex_allom_hyp use EDCohortDynamicsMod, only : nan_cohort use EDCohortDynamicsMod, only : zero_cohort use EDCohortDynamicsMod, only : InitPRTObject @@ -97,10 +99,18 @@ module FatesRestartInterfaceMod integer :: ir_canopy_layer_yesterday_co integer :: ir_canopy_trim_co integer :: ir_l2fr_co + integer :: ir_cx_int_co integer :: ir_emadcxdt_co integer :: ir_cx0_co - integer :: ir_pc_store_co + integer :: ir_cnplimiter_co + integer :: ir_daily_nh4_uptake_co + integer :: ir_daily_no3_uptake_co + integer :: ir_daily_n_fixation_co + integer :: ir_daily_p_uptake_co + integer :: ir_daily_n_demand_co + integer :: ir_daily_p_demand_co + integer :: ir_size_class_lasttimestep_co integer :: ir_dbh_co integer :: ir_coage_co @@ -125,12 +135,7 @@ module FatesRestartInterfaceMod integer :: ir_treesai_co integer :: ir_canopy_layer_tlai_pa - integer :: ir_daily_nh4_uptake_co - integer :: ir_daily_no3_uptake_co - integer :: ir_daily_n_fixation_co - integer :: ir_daily_p_uptake_co - integer :: ir_daily_n_demand_co - integer :: ir_daily_p_demand_co + !Logging integer :: ir_lmort_direct_co @@ -704,18 +709,56 @@ subroutine define_restart_vars(this, initialize_variables) long_name='ed cohort - l2fr', units='fraction', flushval = flushzero, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_l2fr_co ) - call this%set_restart_var(vname='fates_cx_int', vtype=cohort_r8, & - long_name='ed cohort - emacx', units='fraction', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_cx_int_co ) - - call this%set_restart_var(vname='fates_emadcxdt', vtype=cohort_r8, & - long_name='ed cohort - emadcxdt', units='fraction', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_emadcxdt_co ) - - call this%set_restart_var(vname='fates_cx0', vtype=cohort_r8, & - long_name='ed cohort - cx0', units='fraction', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_cx0_co ) + if(hlm_parteh_mode .eq. prt_cnp_flex_allom_hyp) then + call this%set_restart_var(vname='fates_cx_int', vtype=cohort_r8, & + long_name='ed cohort - emacx', units='fraction', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_cx_int_co ) + + call this%set_restart_var(vname='fates_emadcxdt', vtype=cohort_r8, & + long_name='ed cohort - emadcxdt', units='fraction', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_emadcxdt_co ) + + call this%set_restart_var(vname='fates_cx0', vtype=cohort_r8, & + long_name='ed cohort - cx0', units='fraction', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_cx0_co ) + + call this%set_restart_var(vname='fates_cnplimiter', vtype=cohort_r8, & + long_name='ed cohort - cnp limiter index', units='index', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_cnplimiter_co ) + + call this%set_restart_var(vname='fates_daily_nh4_uptake', vtype=cohort_r8, & + long_name='fates cohort- daily ammonium [NH4] uptake', & + units='kg/plant/day', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_daily_nh4_uptake_co ) + + call this%set_restart_var(vname='fates_daily_no3_uptake', vtype=cohort_r8, & + long_name='fates cohort- daily ammonium [NO3] uptake', & + units='kg/plant/day', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_daily_no3_uptake_co ) + + call this%set_restart_var(vname='fates_daily_n_fixation', vtype=cohort_r8, & + long_name='fates cohort- daily N symbiotic fixation', & + units='kg/plant/day', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_daily_n_fixation_co ) + + call this%set_restart_var(vname='fates_daily_p_uptake', vtype=cohort_r8, & + long_name='fates cohort- daily phosphorus uptake', & + units='kg/plant/day', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_daily_p_uptake_co ) + + call this%set_restart_var(vname='fates_daily_p_demand', vtype=cohort_r8, & + long_name='fates cohort- daily phosphorus demand', & + units='kgP/plant/day', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_daily_p_demand_co ) + + call this%set_restart_var(vname='fates_daily_n_demand', vtype=cohort_r8, & + long_name='fates cohort- daily nitrogen demand', & + units='kgN/plant/day', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_daily_n_demand_co ) + + end if + call this%set_restart_var(vname='fates_size_class_lasttimestep', vtype=cohort_int, & long_name='ed cohort - size-class last timestep', units='index', flushval = flushzero, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_size_class_lasttimestep_co ) @@ -787,35 +830,7 @@ subroutine define_restart_vars(this, initialize_variables) units='/year', flushval = flushzero, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_cmort_co ) - call this%set_restart_var(vname='fates_daily_nh4_uptake', vtype=cohort_r8, & - long_name='fates cohort- daily ammonium [NH4] uptake', & - units='kg/plant/day', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_daily_nh4_uptake_co ) - call this%set_restart_var(vname='fates_daily_no3_uptake', vtype=cohort_r8, & - long_name='fates cohort- daily ammonium [NO3] uptake', & - units='kg/plant/day', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_daily_no3_uptake_co ) - - call this%set_restart_var(vname='fates_daily_n_fixation', vtype=cohort_r8, & - long_name='fates cohort- daily N symbiotic fixation', & - units='kg/plant/day', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_daily_n_fixation_co ) - - call this%set_restart_var(vname='fates_daily_p_uptake', vtype=cohort_r8, & - long_name='fates cohort- daily phosphorus uptake', & - units='kg/plant/day', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_daily_p_uptake_co ) - - call this%set_restart_var(vname='fates_daily_p_demand', vtype=cohort_r8, & - long_name='fates cohort- daily phosphorus demand', & - units='kgP/plant/day', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_daily_p_demand_co ) - - call this%set_restart_var(vname='fates_daily_n_demand', vtype=cohort_r8, & - long_name='fates cohort- daily nitrogen demand', & - units='kgN/plant/day', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_daily_n_demand_co ) call this%set_restart_var(vname='fates_frmort', vtype=cohort_r8, & long_name='ed cohort - freezing mortality rate', & @@ -1746,9 +1761,6 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_canopy_layer_yesterday_co => this%rvars(ir_canopy_layer_yesterday_co)%r81d, & rio_canopy_trim_co => this%rvars(ir_canopy_trim_co)%r81d, & rio_l2fr_co => this%rvars(ir_l2fr_co)%r81d, & - rio_cx_int_co => this%rvars(ir_cx_int_co)%r81d, & - rio_emadcxdt_co => this%rvars(ir_emadcxdt_co)%r81d, & - rio_cx0_co => this%rvars(ir_cx0_co)%r81d, & rio_seed_prod_co => this%rvars(ir_seed_prod_co)%r81d, & rio_size_class_lasttimestep => this%rvars(ir_size_class_lasttimestep_co)%int1d, & rio_dbh_co => this%rvars(ir_dbh_co)%r81d, & @@ -1766,12 +1778,6 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_bmort_co => this%rvars(ir_bmort_co)%r81d, & rio_hmort_co => this%rvars(ir_hmort_co)%r81d, & rio_cmort_co => this%rvars(ir_cmort_co)%r81d, & - rio_daily_nh4_uptake_co => this%rvars(ir_daily_nh4_uptake_co)%r81d, & - rio_daily_no3_uptake_co => this%rvars(ir_daily_no3_uptake_co)%r81d, & - rio_daily_n_fixation_co => this%rvars(ir_daily_n_fixation_co)%r81d, & - rio_daily_p_uptake_co => this%rvars(ir_daily_p_uptake_co)%r81d, & - rio_daily_n_demand_co => this%rvars(ir_daily_n_demand_co)%r81d, & - rio_daily_p_demand_co => this%rvars(ir_daily_p_demand_co)%r81d, & rio_smort_co => this%rvars(ir_smort_co)%r81d, & rio_asmort_co => this%rvars(ir_asmort_co)%r81d, & rio_frmort_co => this%rvars(ir_frmort_co)%r81d, & @@ -1945,6 +1951,20 @@ subroutine set_restart_vectors(this,nc,nsites,sites) end do end do + rio_l2fr_co(io_idx_co) = ccohort%l2fr + + if(hlm_parteh_mode .eq. prt_cnp_flex_allom_hyp) then + this%rvars(ir_cx_int_co)%r81d(io_idx_co) = ccohort%cx_int + this%rvars(ir_emadcxdt_co)%r81d(io_idx_co) = ccohort%ema_dcxdt + this%rvars(ir_cx0_co)%r81d(io_idx_co) = ccohort%cx0 + this%rvars(ir_cnplimiter_co)%r81d(io_idx_co) = real(ccohort%cnp_limiter,r8) + this%rvars(ir_daily_no3_uptake_co)%r81d(io_idx_co) = ccohort%daily_no3_uptake + this%rvars(ir_daily_nh4_uptake_co)%r81d(io_idx_co) = ccohort%daily_nh4_uptake + this%rvars(ir_daily_p_uptake_co)%r81d(io_idx_co) = ccohort%daily_p_gain + this%rvars(ir_daily_n_fixation_co)%r81d(io_idx_co) = ccohort%daily_n_fixation + this%rvars(ir_daily_n_demand_co)%r81d(io_idx_co) = ccohort%daily_n_demand + this%rvars(ir_daily_p_demand_co)%r81d(io_idx_co) = ccohort%daily_p_demand + end if if(hlm_use_planthydro==itrue)then @@ -1963,10 +1983,7 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_canopy_layer_co(io_idx_co) = ccohort%canopy_layer rio_canopy_layer_yesterday_co(io_idx_co) = ccohort%canopy_layer_yesterday rio_canopy_trim_co(io_idx_co) = ccohort%canopy_trim - rio_l2fr_co(io_idx_co) = ccohort%l2fr - rio_cx_int_co(io_idx_co) = ccohort%cx_int - rio_emadcxdt_co(io_idx_co) = ccohort%ema_dcxdt - rio_cx0_co(io_idx_co) = ccohort%cx0 + rio_seed_prod_co(io_idx_co) = ccohort%seed_prod rio_size_class_lasttimestep(io_idx_co) = ccohort%size_class_lasttimestep rio_dbh_co(io_idx_co) = ccohort%dbh @@ -1990,14 +2007,6 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_asmort_co(io_idx_co) = ccohort%asmort rio_frmort_co(io_idx_co) = ccohort%frmort - ! Nutrient uptake/efflux - rio_daily_no3_uptake_co(io_idx_co) = ccohort%daily_no3_uptake - rio_daily_nh4_uptake_co(io_idx_co) = ccohort%daily_nh4_uptake - rio_daily_p_uptake_co(io_idx_co) = ccohort%daily_p_gain - rio_daily_n_fixation_co(io_idx_co) = ccohort%daily_n_fixation - - rio_daily_n_demand_co(io_idx_co) = ccohort%daily_n_demand - rio_daily_p_demand_co(io_idx_co) = ccohort%daily_p_demand !Logging rio_lmort_direct_co(io_idx_co) = ccohort%lmort_direct @@ -2577,9 +2586,6 @@ subroutine get_restart_vectors(this, nc, nsites, sites) rio_canopy_layer_yesterday_co => this%rvars(ir_canopy_layer_yesterday_co)%r81d, & rio_canopy_trim_co => this%rvars(ir_canopy_trim_co)%r81d, & rio_l2fr_co => this%rvars(ir_l2fr_co)%r81d, & - rio_cx_int_co => this%rvars(ir_cx_int_co)%r81d, & - rio_emadcxdt_co => this%rvars(ir_emadcxdt_co)%r81d, & - rio_cx0_co => this%rvars(ir_cx0_co)%r81d, & rio_seed_prod_co => this%rvars(ir_seed_prod_co)%r81d, & rio_size_class_lasttimestep => this%rvars(ir_size_class_lasttimestep_co)%int1d, & rio_dbh_co => this%rvars(ir_dbh_co)%r81d, & @@ -2597,12 +2603,6 @@ subroutine get_restart_vectors(this, nc, nsites, sites) rio_bmort_co => this%rvars(ir_bmort_co)%r81d, & rio_hmort_co => this%rvars(ir_hmort_co)%r81d, & rio_cmort_co => this%rvars(ir_cmort_co)%r81d, & - rio_daily_nh4_uptake_co => this%rvars(ir_daily_nh4_uptake_co)%r81d, & - rio_daily_no3_uptake_co => this%rvars(ir_daily_no3_uptake_co)%r81d, & - rio_daily_n_fixation_co => this%rvars(ir_daily_n_fixation_co)%r81d, & - rio_daily_p_uptake_co => this%rvars(ir_daily_p_uptake_co)%r81d, & - rio_daily_n_demand_co => this%rvars(ir_daily_n_demand_co)%r81d, & - rio_daily_p_demand_co => this%rvars(ir_daily_p_demand_co)%r81d, & rio_smort_co => this%rvars(ir_smort_co)%r81d, & rio_asmort_co => this%rvars(ir_asmort_co)%r81d, & rio_frmort_co => this%rvars(ir_frmort_co)%r81d, & @@ -2757,19 +2757,24 @@ subroutine get_restart_vectors(this, nc, nsites, sites) end do end do - !ccohort%vcmax25top - !ccohort%jmax25top - !ccohort%tpu25top - !ccohort%kp25top - - ccohort%canopy_layer = rio_canopy_layer_co(io_idx_co) ccohort%canopy_layer_yesterday = rio_canopy_layer_yesterday_co(io_idx_co) ccohort%canopy_trim = rio_canopy_trim_co(io_idx_co) ccohort%l2fr = rio_l2fr_co(io_idx_co) - ccohort%cx_int = rio_cx_int_co(io_idx_co) - ccohort%ema_dcxdt = rio_emadcxdt_co(io_idx_co) - ccohort%cx0 = rio_cx0_co(io_idx_co) + + if(hlm_parteh_mode .eq. prt_cnp_flex_allom_hyp) then + ccohort%cx_int = this%rvars(ir_cx_int_co)%r81d(io_idx_co) + ccohort%ema_dcxdt = this%rvars(ir_emadcxdt_co)%r81d(io_idx_co) + ccohort%cx0 = this%rvars(ir_cx0_co)%r81d(io_idx_co) + ccohort%cnp_limiter = int(this%rvars(ir_cnplimiter_co)%r81d(io_idx_co)) + ccohort%daily_nh4_uptake = this%rvars(ir_daily_nh4_uptake_co)%r81d(io_idx_co) + ccohort%daily_no3_uptake = this%rvars(ir_daily_no3_uptake_co)%r81d(io_idx_co) + ccohort%daily_n_fixation = this%rvars(ir_daily_n_fixation_co)%r81d(io_idx_co) + ccohort%daily_p_gain = this%rvars(ir_daily_p_uptake_co)%r81d(io_idx_co) + ccohort%daily_n_demand = this%rvars(ir_daily_n_demand_co)%r81d(io_idx_co) + ccohort%daily_p_demand = this%rvars(ir_daily_p_demand_co)%r81d(io_idx_co) + end if + ccohort%seed_prod = rio_seed_prod_co(io_idx_co) ccohort%size_class_lasttimestep = rio_size_class_lasttimestep(io_idx_co) ccohort%dbh = rio_dbh_co(io_idx_co) @@ -2792,14 +2797,7 @@ subroutine get_restart_vectors(this, nc, nsites, sites) ccohort%asmort = rio_asmort_co(io_idx_co) ccohort%frmort = rio_frmort_co(io_idx_co) - ! Nutrient uptake / efflux - ccohort%daily_nh4_uptake = rio_daily_nh4_uptake_co(io_idx_co) - ccohort%daily_no3_uptake = rio_daily_no3_uptake_co(io_idx_co) - ccohort%daily_n_fixation = rio_daily_n_fixation_co(io_idx_co) - ccohort%daily_p_gain = rio_daily_p_uptake_co(io_idx_co) - - ccohort%daily_n_demand = rio_daily_n_demand_co(io_idx_co) - ccohort%daily_p_demand = rio_daily_p_demand_co(io_idx_co) + !Logging ccohort%lmort_direct = rio_lmort_direct_co(io_idx_co) From 9e69a0f4ed91c867bb26df6532e7344b738379b4 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Tue, 8 Nov 2022 09:52:40 -0500 Subject: [PATCH 46/55] Added NPP boundary condition with ELM/CLM to enable npp hypothesis on free-living fixers --- biogeochem/FatesSoilBGCFluxMod.F90 | 19 ++++++++++++++++++- main/EDInitMod.F90 | 6 +++++- main/EDTypesMod.F90 | 11 +++++++++-- main/FatesConstantsMod.F90 | 2 +- main/FatesInterfaceMod.F90 | 4 ++++ main/FatesInterfaceTypesMod.F90 | 2 ++ parteh/PRTAllometricCNPMod.F90 | 29 +++++++++++++++++++++++------ 7 files changed, 62 insertions(+), 11 deletions(-) diff --git a/biogeochem/FatesSoilBGCFluxMod.F90 b/biogeochem/FatesSoilBGCFluxMod.F90 index defc0bf2eb..f07d51a46a 100644 --- a/biogeochem/FatesSoilBGCFluxMod.F90 +++ b/biogeochem/FatesSoilBGCFluxMod.F90 @@ -315,6 +315,7 @@ subroutine PrepCH4BCs(csite,bc_in,bc_out) integer :: fp ! patch index of the site real(r8) :: agnpp ! Above ground daily npp real(r8) :: bgnpp ! Below ground daily npp + real(r8) :: site_npp ! Site level NPP gC/m2/year real(r8) :: plant_area ! crown area (m2) of all plants in patch real(r8) :: woody_area ! corwn area (m2) of woody plants in patch real(r8) :: fnrt_c ! Fine root carbon [kg/plant] @@ -325,8 +326,10 @@ subroutine PrepCH4BCs(csite,bc_in,bc_out) real(r8) :: struct_net_alloc real(r8) :: repro_net_alloc + real(r8), parameter :: ema_npp_tscale = 10._r8 ! 10 day + ! Exit if we need not communicate with the hlm's ch4 module - if(.not.(hlm_use_ch4==itrue)) return + if(.not.(hlm_use_ch4==itrue) .and. .not.(hlm_parteh_mode==prt_cnp_flex_allom_hyp) ) return ! Initialize to zero bc_out%annavg_agnpp_pa(:) = 0._r8 @@ -336,6 +339,7 @@ subroutine PrepCH4BCs(csite,bc_in,bc_out) bc_out%frootc_pa(:) = 0._r8 bc_out%root_resp(:) = 0._r8 bc_out%woody_frac_aere_pa(:) = 0._r8 + site_npp = 0._r8 fp = 0 cpatch => csite%oldest_patch @@ -431,6 +435,8 @@ subroutine PrepCH4BCs(csite,bc_in,bc_out) ! gc/m2/yr bc_out%annsum_npp_pa(fp) = (bgnpp+agnpp)*days_per_year*sec_per_day + site_npp = site_npp + bc_out%annsum_npp_pa(fp)*cpatch%area*area_inv + if(plant_area>nearzero) then bc_out%woody_frac_aere_pa(fp) = woody_area/plant_area end if @@ -438,6 +444,17 @@ subroutine PrepCH4BCs(csite,bc_in,bc_out) cpatch => cpatch%younger end do + ! Smoothed [gc/m2/yr] + if(csite%ema_npp<-10000._r8)then + ! Its difficult to come up with a resonable starting smoothing value, so + ! we initialize on a cold-start to -1 + csite%ema_npp = site_npp + else + csite%ema_npp = (1._r8-1._r8/ema_npp_tscale)*csite%ema_npp + (1._r8/ema_npp_tscale)*site_npp + end if + + bc_out%ema_npp = csite%ema_npp + return end subroutine PrepCH4BCs diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index 162195ea5e..9bd9b4b01f 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -342,7 +342,11 @@ subroutine set_site_properties( nsites, sites,bc_in ) do ft = 1,numpft sites(s)%rec_l2fr(ft,:) = prt_params%allom_l2fr(ft) end do - + + ! Its difficult to come up with a resonable starting smoothing value, so + ! we initialize on a cold-start to -1 + sites(s)%ema_npp = -9999._r8 + if(hlm_use_fixed_biogeog.eq.itrue)then ! MAPPING OF FATES PFTs on to HLM_PFTs ! add up the area associated with each FATES PFT diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 28df1cc372..41889ad3b7 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -721,8 +721,15 @@ module EDTypesMod ! Total area of patches in each age bin [m2] real(r8), allocatable :: area_by_age(:) - real(r8), allocatable :: rec_l2fr(:,:) ! A running mean of the l2fr's for the newly - ! recruited, pft x canopy_layer + ! Nutrient relevant + real(r8), allocatable :: rec_l2fr(:,:) ! A running mean of the l2fr's for the newly + ! recruited, pft x canopy_layer + real(r8) :: ema_npp ! An exponential moving average of NPP [gC/m2/year] + ! The lengthscale is hard-coded "ema_npp_tcale" + ! in FatesSoilBGCFluxMod. Used solely to inform bc_out%ema_npp + ! which is used for fixation + + ! SP mode target PFT level variables real(r8), allocatable :: sp_tlai(:) ! target TLAI per FATES pft diff --git a/main/FatesConstantsMod.F90 b/main/FatesConstantsMod.F90 index c60558526d..ee3bd6cfb3 100644 --- a/main/FatesConstantsMod.F90 +++ b/main/FatesConstantsMod.F90 @@ -57,7 +57,7 @@ module FatesConstantsMod ! This flag specifies the scaling of how we present ! nutrient competitors to the HLM's soil BGC model - integer, public :: fates_np_comp_scaling = -1 + integer, public :: fates_np_comp_scaling = fates_unset_int real(fates_r8), parameter, public :: secondary_age_threshold = 94._fates_r8 ! less than this value is young secondary land ! based on average age of global diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 98eeb6d0c0..813178e25b 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -627,6 +627,9 @@ subroutine allocate_bcout(bc_out, nlevsoil_in, nlevdecomp_in) bc_out%rootfr_pa(0,1:nlevsoil_in)=1._r8/real(nlevsoil_in,r8) end if + bc_out%ema_npp = nan + + ! Fates -> BGC fragmentation mass fluxes select case(hlm_parteh_mode) case(prt_carbon_allom_hyp) @@ -635,6 +638,7 @@ subroutine allocate_bcout(bc_out, nlevsoil_in, nlevdecomp_in) allocate(bc_out%litt_flux_lab_c_si(nlevdecomp_in)) case(prt_cnp_flex_allom_hyp) + allocate(bc_out%litt_flux_cel_c_si(nlevdecomp_in)) allocate(bc_out%litt_flux_lig_c_si(nlevdecomp_in)) allocate(bc_out%litt_flux_lab_c_si(nlevdecomp_in)) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index be482a96ad..2e3ce781ed 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -677,6 +677,8 @@ module FatesInterfaceTypesMod real(r8), pointer :: woody_frac_aere_pa(:) ! Woody plant fraction (by crown area) of all plants ! used for calculating patch-level aerenchyma porosity + real(r8) :: ema_npp ! site-level NPP smoothed over time, see PrepCH4BCs() + ! used for N fixation in ELM/CLM right now ! Canopy Structure real(r8), allocatable :: elai_pa(:) ! exposed leaf area index diff --git a/parteh/PRTAllometricCNPMod.F90 b/parteh/PRTAllometricCNPMod.F90 index ad943702ba..01a45e3900 100644 --- a/parteh/PRTAllometricCNPMod.F90 +++ b/parteh/PRTAllometricCNPMod.F90 @@ -1861,15 +1861,32 @@ subroutine CNPAllocateRemainder(this, c_gain,n_gain,p_gain, & ! Estimate the overflow store_c_target = store_c_target * (1._r8 + prt_params%store_ovrflw_frac(ipft)) - total_c_flux = min(c_gain,max(0.0, (store_c_target - this%variables(store_c_id)%val(1)))) + total_c_flux = max(0.0, min(c_gain, store_c_target - this%variables(store_c_id)%val(1))) ! Transfer excess carbon into storage overflow this%variables(store_c_id)%val(1) = this%variables(store_c_id)%val(1) + total_c_flux - c_gain = c_gain - total_c_flux + c_gain = c_gain - total_c_flux end if end if + ! If we had some poor numerical precision resulting + ! in negative gains, use storage to get them back to zero + ! they should be very very small + if(c_gain<-nearzero) then + this%variables(store_c_id)%val(1) = this%variables(store_c_id)%val(1) + c_gain + c_gain = 0 + end if + if(n_gain<-nearzero) then + this%variables(store_n_id)%val(1) = this%variables(store_n_id)%val(1) + n_gain + n_gain = 0 + end if + if(p_gain<-nearzero) then + this%variables(store_p_id)%val(1) = this%variables(store_p_id)%val(1) + p_gain + p_gain = 0 + end if + + ! Figure out what to do with excess carbon and nutrients ! 1) excude through roots cap at 0 to flush out imprecisions @@ -1883,19 +1900,19 @@ subroutine CNPAllocateRemainder(this, c_gain,n_gain,p_gain, & if(n_uptake_mode.eq.prescribed_n_uptake) then n_efflux = 0._r8 else - n_efflux = max(0.0_r8,n_gain) + n_efflux = n_gain n_gain = 0._r8 end if if(p_uptake_mode.eq.prescribed_p_uptake) then p_efflux = 0._r8 else - p_efflux = max(0.0_r8,p_gain) + p_efflux = p_gain p_gain = 0._r8 end if - c_efflux = max(0.0_r8,c_gain) - c_gain = 0.0_r8 + c_efflux = c_gain + c_gain = 0.0_r8 From 20e1c769bbe94462d9fbe1e5f913c2dfc6fe7588 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Wed, 9 Nov 2022 16:42:03 -0500 Subject: [PATCH 47/55] fixes to symbiotic fixation --- biogeochem/EDCohortDynamicsMod.F90 | 20 ++++-- biogeophys/EDAccumulateFluxesMod.F90 | 2 + biogeophys/FatesPlantRespPhotosynthMod.F90 | 5 +- main/EDMainMod.F90 | 6 +- main/EDTypesMod.F90 | 5 +- main/FatesHistoryInterfaceMod.F90 | 6 +- main/FatesRestartInterfaceMod.F90 | 4 +- parteh/PRTAllometricCNPMod.F90 | 79 ++++++++++++---------- 8 files changed, 75 insertions(+), 52 deletions(-) diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index b54c0eea3e..0bc96346af 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -592,7 +592,8 @@ subroutine nan_cohort(cc_p) currentCohort%daily_nh4_uptake = nan currentCohort%daily_no3_uptake = nan currentCohort%daily_n_gain = nan - currentCohort%daily_n_fixation = nan + currentCohort%sym_nfix_daily = nan + currentCohort%sym_nfix_tstep = nan currentCohort%daily_p_gain = nan currentCohort%daily_c_efflux = nan currentCohort%daily_n_efflux = nan @@ -725,7 +726,7 @@ subroutine zero_cohort(cc_p) ! Fixation is also integrated over the course of the day ! and must be zeroed upon creation and after plant ! resource allocation - currentCohort%daily_n_fixation = 0._r8 + currentCohort%sym_nfix_daily = 0._r8 end subroutine zero_cohort @@ -1469,12 +1470,16 @@ subroutine fuse_cohorts(currentSite, currentPatch, bc_in) nextc%n*nextc%ema_dcxdt)/newn currentCohort%cx0 = (currentCohort%n*currentCohort%cx0 + & nextc%n*nextc%cx0)/newn + + ! These variables do not need to be rescaled because they + ! are written to history immediately after calculation + currentCohort%daily_nh4_uptake = (currentCohort%n*currentCohort%daily_nh4_uptake + & nextc%n*nextc%daily_nh4_uptake)/newn currentCohort%daily_no3_uptake = (currentCohort%n*currentCohort%daily_no3_uptake + & nextc%n*nextc%daily_no3_uptake)/newn - currentCohort%daily_n_fixation = (currentCohort%n*currentCohort%daily_n_fixation + & - nextc%n*nextc%daily_n_fixation)/newn + currentCohort%sym_nfix_daily = (currentCohort%n*currentCohort%sym_nfix_daily + & + nextc%n*nextc%sym_nfix_daily)/newn currentCohort%daily_n_gain = (currentCohort%n*currentCohort%daily_n_gain + & nextc%n*nextc%daily_n_gain)/newn currentCohort%daily_p_gain = (currentCohort%n*currentCohort%daily_p_gain + & @@ -1882,9 +1887,12 @@ subroutine copy_cohort( currentCohort,copyc ) n%year_net_uptake = o%year_net_uptake n%ts_net_uptake = o%ts_net_uptake + ! These do not need to be copied because they + ! are written to history before dynamics occurs + ! and cohorts are reformed n%daily_nh4_uptake = o%daily_nh4_uptake n%daily_no3_uptake = o%daily_no3_uptake - n%daily_n_fixation = o%daily_n_fixation + n%sym_nfix_daily = o%sym_nfix_daily n%daily_n_gain = o%daily_n_gain n%daily_p_gain = o%daily_p_gain n%daily_c_efflux = o%daily_c_efflux @@ -2253,7 +2261,7 @@ subroutine DamageRecovery(csite,cpatch,ccohort,newly_recovered) ! Target total dead (structrual) biomass [kgC] call bdead_allom( target_agw_c, target_bgw_c, target_sapw_c, ipft, target_struct_c) ! Target fine-root biomass and deriv. according to allometry and trimming [kgC, kgC/cm] - call bfineroot(dbh,ipft,canopy_trim,target_fnrt_c) + call bfineroot(dbh,ipft,canopy_trim,ccohort%l2fr,target_fnrt_c) ! Target storage carbon [kgC,kgC/cm] call bstore_allom(dbh,ipft,ccohort%crowndamage-1, canopy_trim,target_store_c) ! Target leaf biomass according to allometry and trimming diff --git a/biogeophys/EDAccumulateFluxesMod.F90 b/biogeophys/EDAccumulateFluxesMod.F90 index 8eae0f4a50..559fa5b0af 100644 --- a/biogeophys/EDAccumulateFluxesMod.F90 +++ b/biogeophys/EDAccumulateFluxesMod.F90 @@ -86,6 +86,8 @@ subroutine AccumulateFluxes_ED(nsites, sites, bc_in, bc_out, dt_time) ccohort%gpp_acc = ccohort%gpp_acc + ccohort%gpp_tstep ccohort%resp_acc = ccohort%resp_acc + ccohort%resp_tstep + ccohort%sym_nfix_daily = ccohort%sym_nfix_daily + ccohort%sym_nfix_tstep + ! weighted mean of D13C by gpp if((ccohort%gpp_acc + ccohort%gpp_tstep) .eq. 0.0_r8) then ccohort%c13disc_acc = 0.0_r8 diff --git a/biogeophys/FatesPlantRespPhotosynthMod.F90 b/biogeophys/FatesPlantRespPhotosynthMod.F90 index a404ece479..d313ac9ce2 100644 --- a/biogeophys/FatesPlantRespPhotosynthMod.F90 +++ b/biogeophys/FatesPlantRespPhotosynthMod.F90 @@ -765,7 +765,8 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) ! for now use dev_arbitrary_pft as scaling term between 0 and 1 as additional increment of root respiration used for N fixation ! ------------------------------------------------------------------ currentCohort%froot_mr = 0._r8 - + currentCohort%sym_nfix_tstep = 0._r8 + ! n_fixation is integrated over the course of the day ! this variable is zeroed at the end of the FATES dynamics sequence @@ -780,7 +781,7 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) currentCohort%froot_mr = currentCohort%froot_mr + fnrt_mr_nfix_layer + fnrt_mr_layer - currentCohort%daily_n_fixation = currentCohort%daily_n_fixation + nfix_layer + currentCohort%sym_nfix_tstep = currentCohort%sym_nfix_tstep + nfix_layer enddo diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index 63b27c0dd0..025969b07a 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -525,7 +525,7 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) ! allocation scheme currentCohort%daily_n_gain = currentCohort%daily_nh4_uptake + & - currentCohort%daily_no3_uptake + currentCohort%daily_n_fixation + currentCohort%daily_no3_uptake + currentCohort%sym_nfix_daily currentCohort%resp_excess = 0._r8 @@ -731,7 +731,7 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) currentCohort => currentPatch%shortest do while(associated(currentCohort)) currentCohort%n = max(0._r8,currentCohort%n + currentCohort%dndt * hlm_freq_day ) - currentCohort%daily_n_fixation = 0._r8 + currentCohort%sym_nfix_daily = 0._r8 currentCohort => currentCohort%taller enddo currentPatch => currentPatch%older @@ -968,7 +968,7 @@ subroutine TotalBalanceCheck (currentSite, call_index ) write(fates_log(),*) 'NH4 uptake: ',currentCohort%daily_nh4_uptake*currentCohort%n write(fates_log(),*) 'NO3 uptake: ',currentCohort%daily_no3_uptake*currentCohort%n write(fates_log(),*) 'N efflux: ',currentCohort%daily_n_efflux*currentCohort%n - write(fates_log(),*) 'N fixation: ',currentCohort%daily_n_fixation*currentCohort%n + write(fates_log(),*) 'N fixation: ',currentCohort%sym_nfix_daily*currentCohort%n elseif(element_list(el).eq.phosphorus_element) then write(fates_log(),*) 'P uptake: ',currentCohort%daily_p_gain*currentCohort%n write(fates_log(),*) 'P efflux: ',currentCohort%daily_p_efflux*currentCohort%n diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index ff5404b9b2..5f9ead2229 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -301,7 +301,10 @@ module EDTypesMod real(r8) :: daily_nh4_uptake ! integrated daily uptake of mineralized ammonium through competitive acquisition in soil [kg N / plant/ day] real(r8) :: daily_no3_uptake ! integrated daily uptake of mineralized nitrate through competitive acquisition in soil [kg N / plant/ day] - real(r8) :: daily_n_fixation ! Rate of N fixation from the roots [kgN/indiv/day] + + real(r8) :: sym_nfix_daily ! Accumulated symbiotic N fixation from the roots [kgN/indiv/day] + real(r8) :: sym_nfix_tstep ! Symbiotic N fixation from the roots for the time-step[kgN/indiv/tstep] + real(r8) :: daily_n_gain ! sum of fixation and uptake of mineralized nh4/no3 in solution as well as symbiotic fixation real(r8) :: daily_p_gain ! integrated daily uptake of mineralized P through competitive acquisition in soil [kg P / plant/ day] diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index d8203319cf..1f8c2708b3 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -2002,11 +2002,11 @@ subroutine update_history_nutrflux(this,csite) ! Symbiotic Fixation fates_hist%hvars(ih_nfix_si)%r81d(io_si) = & fates_hist%hvars(ih_nfix_si)%r81d(io_si) + & - ccohort%daily_n_fixation*uconv + ccohort%sym_nfix_daily*uconv fates_hist%hvars(ih_nfix_scpf)%r82d(io_si,iscpf) = & fates_hist%hvars(ih_nfix_scpf)%r82d(io_si,iscpf) + & - ccohort%daily_n_fixation*uconv + ccohort%sym_nfix_daily*uconv ! Efflux/exudation this%hvars(ih_nefflux_scpf)%r82d(io_si,iscpf) = & @@ -2801,7 +2801,7 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) total_m / m2_per_ha - call bstore_allom(ccohort%dbh,ccohort%pft,ccohort%canopy_trim, store_max) + call bstore_allom(ccohort%dbh,ccohort%pft,ccohort%crowndamage,ccohort%canopy_trim, store_max) this%hvars(ih_storectfrac_si)%r81d(io_si) = & this%hvars(ih_storectfrac_si)%r81d(io_si) + ccohort%n * store_max/m2_per_ha diff --git a/main/FatesRestartInterfaceMod.F90 b/main/FatesRestartInterfaceMod.F90 index b23328c59d..040af0400b 100644 --- a/main/FatesRestartInterfaceMod.F90 +++ b/main/FatesRestartInterfaceMod.F90 @@ -2108,7 +2108,7 @@ subroutine set_restart_vectors(this,nc,nsites,sites) this%rvars(ir_daily_no3_uptake_co)%r81d(io_idx_co) = ccohort%daily_no3_uptake this%rvars(ir_daily_nh4_uptake_co)%r81d(io_idx_co) = ccohort%daily_nh4_uptake this%rvars(ir_daily_p_uptake_co)%r81d(io_idx_co) = ccohort%daily_p_gain - this%rvars(ir_daily_n_fixation_co)%r81d(io_idx_co) = ccohort%daily_n_fixation + this%rvars(ir_daily_n_fixation_co)%r81d(io_idx_co) = ccohort%sym_nfix_daily this%rvars(ir_daily_n_demand_co)%r81d(io_idx_co) = ccohort%daily_n_demand this%rvars(ir_daily_p_demand_co)%r81d(io_idx_co) = ccohort%daily_p_demand end if @@ -2989,7 +2989,7 @@ subroutine get_restart_vectors(this, nc, nsites, sites) ccohort%cnp_limiter = int(this%rvars(ir_cnplimiter_co)%r81d(io_idx_co)) ccohort%daily_nh4_uptake = this%rvars(ir_daily_nh4_uptake_co)%r81d(io_idx_co) ccohort%daily_no3_uptake = this%rvars(ir_daily_no3_uptake_co)%r81d(io_idx_co) - ccohort%daily_n_fixation = this%rvars(ir_daily_n_fixation_co)%r81d(io_idx_co) + ccohort%sym_nfix_daily = this%rvars(ir_daily_n_fixation_co)%r81d(io_idx_co) ccohort%daily_p_gain = this%rvars(ir_daily_p_uptake_co)%r81d(io_idx_co) ccohort%daily_n_demand = this%rvars(ir_daily_n_demand_co)%r81d(io_idx_co) ccohort%daily_p_demand = this%rvars(ir_daily_p_demand_co)%r81d(io_idx_co) diff --git a/parteh/PRTAllometricCNPMod.F90 b/parteh/PRTAllometricCNPMod.F90 index 999c8d77ad..ab8e1abb2d 100644 --- a/parteh/PRTAllometricCNPMod.F90 +++ b/parteh/PRTAllometricCNPMod.F90 @@ -163,9 +163,10 @@ module PRTAllometricCNPMod integer, public, parameter :: acnp_bc_in_id_netdc = 4 ! Index for the net daily C input BC integer, public, parameter :: acnp_bc_in_id_nc_repro = 5 integer, public, parameter :: acnp_bc_in_id_pc_repro = 6 + integer, public, parameter :: acnp_bc_in_id_cdamage = 7 ! 0=leaf off, 1=leaf on - integer, parameter :: num_bc_in = 6 + integer, parameter :: num_bc_in = 7 ! ------------------------------------------------------------------------------------- ! Output Boundary Indices (These are public) @@ -180,10 +181,11 @@ module PRTAllometricCNPMod ! Indices for parameters passed to the integrator - integer,private, parameter :: intgr_parm_ctrim = 1 - integer,private, parameter :: intgr_parm_pft = 2 - integer,private, parameter :: intgr_parm_l2fr = 3 - integer,private, parameter :: num_intgr_parm = 3 + integer,private, parameter :: intgr_parm_ctrim = 1 + integer,private, parameter :: intgr_parm_pft = 2 + integer,private, parameter :: intgr_parm_l2fr = 3 + integer,private, parameter :: intgr_parm_cdamage = 4 + integer,private, parameter :: num_intgr_parm = 4 ! ------------------------------------------------------------------------------------- ! Define the size of the coorindate vector. For this hypothesis, there is only @@ -363,11 +365,12 @@ subroutine DailyPRTAllometricCNP(this,phase) real(r8),pointer :: l2fr ! Leaf to fineroot ratio of target biomass ! Input only bcs - integer :: ipft ! Plant Functional Type index - real(r8) :: c_gain ! Daily carbon balance for this cohort [kgC] - real(r8),pointer :: n_gain ! Daily nitrogen uptake through fine-roots [kgN] - real(r8),pointer :: p_gain ! Daily phosphorus uptake through fine-roots [kgN] - real(r8) :: canopy_trim ! The canopy trimming function [0-1] + integer :: ipft ! Plant Functional Type index + real(r8) :: c_gain ! Daily carbon balance for this cohort [kgC] + real(r8),pointer :: n_gain ! Daily nitrogen uptake through fine-roots [kgN] + real(r8),pointer :: p_gain ! Daily phosphorus uptake through fine-roots [kgN] + real(r8) :: canopy_trim ! The canopy trimming function [0-1] + integer :: crown_damage ! Damage status of the crown (for allometry) ! Pointers to output bcs real(r8),pointer :: c_efflux ! Total plant efflux of carbon (kgC) @@ -435,7 +438,8 @@ subroutine DailyPRTAllometricCNP(this,phase) c_gain = this%bc_in(acnp_bc_in_id_netdc)%rval canopy_trim = this%bc_in(acnp_bc_in_id_ctrim)%rval ipft = this%bc_in(acnp_bc_in_id_pft)%ival - + crown_damage = this%bc_in(acnp_bc_in_id_cdamage)%ival + ! If either n or p uptake is in prescribed mode ! set the gains to something massive. 1 kilo of pure ! nutrient should be wayyy more than enough @@ -457,14 +461,14 @@ subroutine DailyPRTAllometricCNP(this,phase) ! Set carbon targets based on the plant's current stature target_c(:) = fates_unset_r8 target_dcdd(:) = fates_unset_r8 - call bsap_allom(dbh,ipft,canopy_trim,sapw_area,target_c(sapw_organ),target_dcdd(sapw_organ)) - call bagw_allom(dbh,ipft,agw_c_target,agw_dcdd_target) + call bsap_allom(dbh,ipft,crown_damage,canopy_trim,sapw_area,target_c(sapw_organ),target_dcdd(sapw_organ)) + call bagw_allom(dbh,ipft,crown_damage,agw_c_target,agw_dcdd_target) call bbgw_allom(dbh,ipft,bgw_c_target,bgw_dcdd_target) call bdead_allom(agw_c_target,bgw_c_target,target_c(sapw_organ),ipft,target_c(struct_organ), & agw_dcdd_target,bgw_dcdd_target,target_dcdd(sapw_organ),target_dcdd(struct_organ)) - call bleaf(dbh,ipft,canopy_trim, target_c(leaf_organ), target_dcdd(leaf_organ)) + call bleaf(dbh,ipft,crown_damage,canopy_trim, target_c(leaf_organ), target_dcdd(leaf_organ)) call bfineroot(dbh,ipft,canopy_trim, l2fr, target_c(fnrt_organ), target_dcdd(fnrt_organ)) - call bstore_allom(dbh,ipft,canopy_trim, target_c(store_organ), target_dcdd(store_organ)) + call bstore_allom(dbh,ipft,crown_damage, canopy_trim, target_c(store_organ), target_dcdd(store_organ)) target_c(repro_organ) = 0._r8 target_dcdd(repro_organ) = 0._r8 @@ -1261,6 +1265,7 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & integer :: ipft integer, pointer :: limiter ! Integer flagging which (C,N,P) is limiting real(r8) :: canopy_trim ! fraction of crown trimmed + integer :: crown_damage ! Damage status level real(r8) :: leaf_status ! leaves on or off? real(r8) :: l2fr ! leaf to fineroot allometry multiplier integer :: i, ii ! organ index loops (masked and unmasked) @@ -1334,6 +1339,7 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & leaf_status = this%bc_in(acnp_bc_in_id_lstat)%ival dbh => this%bc_inout(acnp_bc_inout_id_dbh)%rval ipft = this%bc_in(acnp_bc_in_id_pft)%ival + crown_damage = this%bc_in(acnp_bc_in_id_cdamage)%ival limiter => this%bc_out(acnp_bc_out_id_limiter)%ival canopy_trim = this%bc_in(acnp_bc_in_id_ctrim)%rval l2fr = this%bc_inout(acnp_bc_inout_id_l2fr)%rval ! This variable is not updated in this @@ -1365,15 +1371,12 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & p_gain <= 0.02_r8*calloc_abs_error ) then return end if - - - - intgr_params(:) = fates_unset_r8 intgr_params(intgr_parm_ctrim) = this%bc_in(acnp_bc_in_id_ctrim)%rval intgr_params(intgr_parm_pft) = real(this%bc_in(acnp_bc_in_id_pft)%ival) intgr_params(intgr_parm_l2fr) = this%bc_inout(acnp_bc_inout_id_l2fr)%rval + intgr_params(intgr_parm_cdamage) = real(this%bc_in(acnp_bc_in_id_cdamage)%ival) state_mask(:) = .false. mask_organs(:) = fates_unset_int @@ -1573,7 +1576,7 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & leafc_tp1 = leafc_tp1 + this%variables(i_var)%val(i) end do - call CheckIntegratedAllometries(state_array_out(dbh_id),ipft,canopy_trim, l2fr, & + call CheckIntegratedAllometries(state_array_out(dbh_id),ipft,crown_damage,canopy_trim, l2fr, & leafc_tp1, state_array_out(fnrt_id), state_array_out(sapw_id), & state_array_out(store_id), state_array_out(struct_id), & state_mask(leaf_id), state_mask(fnrt_id), state_mask(sapw_id), & @@ -1669,13 +1672,13 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & storec_tp1 = state_array_out(store_id) structc_tp1 = state_array_out(struct_id) - call bleaf(dbh_tp1,ipft,canopy_trim,leaf_c_target_tp1) + call bleaf(dbh_tp1,ipft,crown_damage,canopy_trim,leaf_c_target_tp1) call bfineroot(dbh_tp1,ipft,canopy_trim,l2fr,fnrt_c_target_tp1) - call bsap_allom(dbh_tp1,ipft,canopy_trim,sapw_area,sapw_c_target_tp1) - call bagw_allom(dbh_tp1,ipft,agw_c_target_tp1) + call bsap_allom(dbh_tp1,ipft,crown_damage,canopy_trim,sapw_area,sapw_c_target_tp1) + call bagw_allom(dbh_tp1,ipft,crown_damage,agw_c_target_tp1) call bbgw_allom(dbh_tp1,ipft,bgw_c_target_tp1) call bdead_allom(agw_c_target_tp1,bgw_c_target_tp1, sapw_c_target_tp1, ipft, struct_c_target_tp1) - call bstore_allom(dbh_tp1,ipft,canopy_trim,store_c_target_tp1) + call bstore_allom(dbh_tp1,ipft,crown_damage,canopy_trim,store_c_target_tp1) write(fates_log(),*) 'leaf_c: ',leafc_tp1, leaf_c_target_tp1,leafc_tp1-leaf_c_target_tp1 write(fates_log(),*) 'fnrt_c: ',fnrtc_tp1, fnrt_c_target_tp1,fnrtc_tp1- fnrt_c_target_tp1 @@ -1781,12 +1784,14 @@ subroutine CNPAllocateRemainder(this, c_gain,n_gain,p_gain, & integer :: ipft integer, pointer :: limiter real(r8) :: canopy_trim - + integer :: crown_damage + dbh => this%bc_inout(acnp_bc_inout_id_dbh)%rval canopy_trim = this%bc_in(acnp_bc_in_id_ctrim)%rval ipft = this%bc_in(acnp_bc_in_id_pft)%ival resp_excess => this%bc_inout(acnp_bc_inout_id_resp_excess)%rval limiter => this%bc_out(acnp_bc_out_id_limiter)%ival + crown_damage = this%bc_in(acnp_bc_in_id_cdamage)%ival ! ----------------------------------------------------------------------------------- ! If nutrients are still available, then we can bump up the values in the pools @@ -1845,7 +1850,7 @@ subroutine CNPAllocateRemainder(this, c_gain,n_gain,p_gain, & elseif(store_c_overflow == burn_c_store_overflow) then ! Update carbon based allometric targets - call bstore_allom(dbh,ipft,canopy_trim, store_c_target) + call bstore_allom(dbh,ipft,crown_damage,canopy_trim, store_c_target) ! Allow some overflow store_c_target = store_c_target * (1._r8 + prt_params%store_ovrflw_frac(ipft)) @@ -1862,7 +1867,7 @@ subroutine CNPAllocateRemainder(this, c_gain,n_gain,p_gain, & elseif(store_c_overflow == exude_c_store_overflow)then ! Update carbon based allometric targets - call bstore_allom(dbh,ipft,canopy_trim, store_c_target) + call bstore_allom(dbh,ipft,crown_damage,canopy_trim, store_c_target) ! Estimate the overflow store_c_target = store_c_target * (1._r8 + prt_params%store_ovrflw_frac(ipft)) @@ -1982,6 +1987,7 @@ function GetNutrientTargetCNP(this,element_id,organ_id,stoich_mode) result(targe real(r8) :: l2fr integer :: ipft integer :: i_cvar + integer :: crown_damage real(r8) :: sapw_area real(r8) :: leaf_c_target,fnrt_c_target real(r8) :: sapw_c_target,agw_c_target @@ -1995,6 +2001,7 @@ function GetNutrientTargetCNP(this,element_id,organ_id,stoich_mode) result(targe l2fr = this%bc_inout(acnp_bc_inout_id_l2fr)%rval nc_repro = this%bc_in(acnp_bc_in_id_nc_repro)%rval pc_repro = this%bc_in(acnp_bc_in_id_pc_repro)%rval + crown_damage = this%bc_in(acnp_bc_in_id_cdamage)%ival ! Storage of nutrients are assumed to have different compartments than ! for carbon, and thus their targets are not associated with a tissue @@ -2003,10 +2010,10 @@ function GetNutrientTargetCNP(this,element_id,organ_id,stoich_mode) result(targe if(organ_id == store_organ) then - call bleaf(dbh,ipft,canopy_trim,leaf_c_target) + call bleaf(dbh,ipft,crown_damage,canopy_trim,leaf_c_target) call bfineroot(dbh,ipft,canopy_trim,l2fr,fnrt_c_target) - call bsap_allom(dbh,ipft,canopy_trim,sapw_area,sapw_c_target) - call bagw_allom(dbh,ipft,agw_c_target) + call bsap_allom(dbh,ipft,crown_damage,canopy_trim,sapw_area,sapw_c_target) + call bagw_allom(dbh,ipft,crown_damage,agw_c_target) call bbgw_allom(dbh,ipft,bgw_c_target) call bdead_allom(agw_c_target,bgw_c_target, sapw_c_target, ipft, struct_c_target) @@ -2187,6 +2194,7 @@ function AllomCNPGrowthDeriv(l_state_array,l_state_mask,cbalance,intgr_params) r ! locals integer :: ipft ! PFT index real(r8) :: canopy_trim ! Canopy trimming function (boundary condition [0-1] + integer :: crown_damage ! Damage class real(r8) :: l2fr ! leaf to fineroot biomass multiplier real(r8) :: leaf_c_target ! target leaf biomass, dummy var (kgC) real(r8) :: fnrt_c_target ! target fine-root biomass, dummy var (kgC) @@ -2225,15 +2233,16 @@ function AllomCNPGrowthDeriv(l_state_array,l_state_mask,cbalance,intgr_params) r canopy_trim = intgr_params(intgr_parm_ctrim) ipft = int(intgr_params(intgr_parm_pft)) l2fr = intgr_params(intgr_parm_l2fr) - - call bleaf(dbh,ipft,canopy_trim,leaf_c_target,leaf_dcdd_target) + crown_damage = int(intgr_params(acnp_bc_in_id_cdamage)) + + call bleaf(dbh,ipft,crown_damage,canopy_trim,leaf_c_target,leaf_dcdd_target) call bfineroot(dbh,ipft,canopy_trim,l2fr,fnrt_c_target,fnrt_dcdd_target) - call bsap_allom(dbh,ipft,canopy_trim,sapw_area,sapw_c_target,sapw_dcdd_target) - call bagw_allom(dbh,ipft,agw_c_target,agw_dcdd_target) + call bsap_allom(dbh,ipft,crown_damage,canopy_trim,sapw_area,sapw_c_target,sapw_dcdd_target) + call bagw_allom(dbh,ipft,crown_damage,agw_c_target,agw_dcdd_target) call bbgw_allom(dbh,ipft,bgw_c_target,bgw_dcdd_target) call bdead_allom(agw_c_target,bgw_c_target, sapw_c_target, ipft, struct_c_target, & agw_dcdd_target, bgw_dcdd_target, sapw_dcdd_target, struct_dcdd_target) - call bstore_allom(dbh,ipft,canopy_trim,store_c_target,store_dcdd_target) + call bstore_allom(dbh,ipft,crown_damage,canopy_trim,store_c_target,store_dcdd_target) if (mask_repro) then ! fraction of carbon going towards reproduction From fa8841e24a761f5fef6a769e7fe3c63312d7417e Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Tue, 15 Nov 2022 12:54:54 -0500 Subject: [PATCH 48/55] update to bci xml parameter patch --- parameter_files/patch_default_bciopt224.xml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/parameter_files/patch_default_bciopt224.xml b/parameter_files/patch_default_bciopt224.xml index ae10a43d8e..8ab504ed31 100644 --- a/parameter_files/patch_default_bciopt224.xml +++ b/parameter_files/patch_default_bciopt224.xml @@ -38,8 +38,8 @@ 0.0 1 3 - 5e-09 - 5e-09 + 5e-09 + 0 5e-10 3e-08 0.03991654 From fb5a9de0af8d9d2cc5d6df0157763b3b4b228751 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Mon, 28 Nov 2022 13:51:59 -0500 Subject: [PATCH 49/55] Updated the fates default parameter file API update xmls --- ...api24.2.0_112822_fates_params_default.cdl} | 23 +++++++++---------- .../{ => archive}/apichange_23to24.xml | 0 .../apichange_24.2to25.xml} | 4 ++-- 3 files changed, 13 insertions(+), 14 deletions(-) rename parameter_files/archive/{fates_params_default_api24.1.0_c221109.cdl => api24.2.0_112822_fates_params_default.cdl} (98%) rename parameter_files/{ => archive}/apichange_23to24.xml (100%) rename parameter_files/{apichange_24to25.xml => archive/apichange_24.2to25.xml} (95%) diff --git a/parameter_files/archive/fates_params_default_api24.1.0_c221109.cdl b/parameter_files/archive/api24.2.0_112822_fates_params_default.cdl similarity index 98% rename from parameter_files/archive/fates_params_default_api24.1.0_c221109.cdl rename to parameter_files/archive/api24.2.0_112822_fates_params_default.cdl index 569e6a1ab6..0c89520e40 100644 --- a/parameter_files/archive/fates_params_default_api24.1.0_c221109.cdl +++ b/parameter_files/archive/api24.2.0_112822_fates_params_default.cdl @@ -1,4 +1,4 @@ -netcdf fates_params_default_api24 { +netcdf fates_params_default { dimensions: fates_NCWD = 4 ; fates_history_age_bins = 7 ; @@ -221,7 +221,6 @@ variables: double fates_cnp_store_ovrflw_frac(fates_pft) ; fates_cnp_store_ovrflw_frac:units = "fraction" ; fates_cnp_store_ovrflw_frac:long_name = "size of overflow storage (for excess C,N or P) as a fraction of storage target" ; - fates_cnp_store_ovrflw_frac:use_case = "None" ; double fates_cnp_turnover_nitr_retrans(fates_plant_organs, fates_pft) ; fates_cnp_turnover_nitr_retrans:units = "fraction" ; fates_cnp_turnover_nitr_retrans:long_name = "retranslocation (reabsorbtion) fraction of nitrogen in turnover of scenescing tissues" ; @@ -500,7 +499,7 @@ variables: fates_recruit_seed_alloc_mature:long_name = "fraction of available carbon balance allocated to seeds in mature plants (adds to fates_seed_alloc)" ; double fates_recruit_seed_dbh_repro_threshold(fates_pft) ; fates_recruit_seed_dbh_repro_threshold:units = "cm" ; - fates_recruit_seed_dbh_repro_threshold:long_name = "the diameter (if any) where the plant will start extra clonal allocation to the seed pool" ; + fates_recruit_seed_dbh_repro_threshold:long_name = "the diameter where the plant will increase allocation to the seed pool by fraction: fates_recruit_seed_alloc_mature" ; double fates_recruit_seed_germination_rate(fates_pft) ; fates_recruit_seed_germination_rate:units = "yr-1" ; fates_recruit_seed_germination_rate:long_name = "fraction of seeds that germinate per year" ; @@ -788,7 +787,7 @@ variables: fates_vai_width_increase_factor:long_name = "factor by which each leaf+stem scattering element increases in VAI width (1 = uniform spacing)" ; // global attributes: - :history = "This parameter file is maintained in version control\nSee https://github.com/NGEET/fates/blob/master/parameter_files/fates_params_default.cdl \nFor changes, use git blame \n" ; + :history = "This file was generated by BatchPatchParams.py:\nCDL Base File = archive/api24.1.0_101722_fates_params_default.cdl\nXML patch file = archive/api24.1.0_101722_patch_params.xml" ; data: fates_history_ageclass_bin_edges = 0, 1, 2, 5, 10, 20, 50 ; @@ -902,7 +901,7 @@ data: fates_allom_d2h3 = -999.9, -999.9, -999.9, -999.9, -999.9, -999.9, -999.9, -999.9, -999.9, -999.9, -999.9, -999.9 ; - fates_allom_dbh_maxheight = 90, 90, 90, 90, 90, 90, 3, 3, 2, 0.35, 0.35, 0.35 ; + fates_allom_dbh_maxheight = 90, 80, 80, 80, 90, 80, 3, 3, 2, 0.35, 0.35, 0.35 ; fates_allom_fmode = 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 ; @@ -1173,7 +1172,7 @@ data: fates_leaf_slamax = 0.0954, 0.0954, 0.0954, 0.0954, 0.0954, 0.0954, 0.012, 0.03, 0.03, 0.03, 0.03, 0.03 ; - fates_leaf_slatop = 0.012, 0.01, 0.024, 0.012, 0.03, 0.03, 0.012, 0.03, + fates_leaf_slatop = 0.012, 0.005, 0.024, 0.009, 0.03, 0.03, 0.012, 0.03, 0.03, 0.03, 0.03, 0.03 ; fates_leaf_stomatal_intercept = 10000, 10000, 10000, 10000, 10000, 10000, @@ -1185,7 +1184,7 @@ data: 4.7, 2.2, 5.3, 1.6 ; fates_leaf_vcmax25top = - 50, 65, 39, 62, 41, 58, 62, 54, 54, 78, 78, 78 ; + 50, 62, 39, 61, 41, 58, 62, 54, 54, 78, 78, 78 ; fates_leaf_vcmaxha = 65330, 65330, 65330, 65330, 65330, 65330, 65330, 65330, 65330, 65330, 65330, 65330 ; @@ -1204,7 +1203,7 @@ data: fates_mort_bmort = 0.014, 0.014, 0.014, 0.014, 0.014, 0.014, 0.014, 0.014, 0.014, 0.014, 0.014, 0.014 ; - fates_mort_freezetol = 2.5, -55, -80, -30, 2.5, -30, -60, -10, -80, -80, + fates_mort_freezetol = 2.5, -55, -80, -30, 2.5, -80, -60, -10, -80, -80, -20, 2.5 ; fates_mort_hf_flc_threshold = 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, @@ -1292,7 +1291,7 @@ data: fates_rad_stem_tauvis = 0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.12, 0.12, 0.12 ; - fates_recruit_height_min = 1.3, 1.3, 1.3, 1.3, 1.3, 1.3, 0.75, 0.75, 0.75, + fates_recruit_height_min = 1.3, 1.3, 1.3, 1.3, 1.3, 1.3, 0.2, 0.2, 0.2, 0.125, 0.125, 0.125 ; fates_recruit_init_density = 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, @@ -1307,8 +1306,8 @@ data: fates_recruit_seed_alloc_mature = 0, 0, 0, 0, 0, 0, 0.9, 0.9, 0.9, 0.9, 0.9, 0.9 ; - fates_recruit_seed_dbh_repro_threshold = 150, 90, 90, 90, 90, 90, 3, 3, 2, - 1.47, 1.47, 1.47 ; + fates_recruit_seed_dbh_repro_threshold = 90, 80, 80, 80, 90, 80, 3, 3, 2, + 0.35, 0.35, 0.35 ; fates_recruit_seed_germination_rate = 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5 ; @@ -1357,7 +1356,7 @@ data: fates_turnover_senleaf_fdrought = 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 ; - fates_wood_density = 0.7, 0.7, 0.7, 0.7, 0.7, 0.7, 0.7, 0.7, 0.7, 0.7, 0.7, + fates_wood_density = 0.7, 0.4, 0.7, 0.53, 0.7, 0.7, 0.7, 0.7, 0.7, 0.7, 0.7, 0.7 ; fates_woody = 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0 ; diff --git a/parameter_files/apichange_23to24.xml b/parameter_files/archive/apichange_23to24.xml similarity index 100% rename from parameter_files/apichange_23to24.xml rename to parameter_files/archive/apichange_23to24.xml diff --git a/parameter_files/apichange_24to25.xml b/parameter_files/archive/apichange_24.2to25.xml similarity index 95% rename from parameter_files/apichange_24to25.xml rename to parameter_files/archive/apichange_24.2to25.xml index a1725eba0f..41d3ea711b 100644 --- a/parameter_files/apichange_24to25.xml +++ b/parameter_files/archive/apichange_24.2to25.xml @@ -13,8 +13,8 @@ the variables --> - fates_params_default.cdl - fates_params_default_api25.cdl + archive/api24.2.0_112822_fates_params_default.cdl + fates_params_default_api25_v2.cdl 1,2,3,4,5,6,7,8,9,10,11,12 From dd6f0670c4c5fd95d5794a0588873fdecdf42d90 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Mon, 28 Nov 2022 20:51:20 -0700 Subject: [PATCH 50/55] fix typo on carbon12_element --- fire/SFMainMod.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/fire/SFMainMod.F90 b/fire/SFMainMod.F90 index efdd51c691..fdb3501bd2 100644 --- a/fire/SFMainMod.F90 +++ b/fire/SFMainMod.F90 @@ -195,9 +195,9 @@ subroutine charecteristics_of_fuel ( currentSite ) if( prt_params%woody(currentCohort%pft) == ifalse)then currentPatch%livegrass = currentPatch%livegrass + & - ( currentCohort%prt%GetState(leaf_organ, carbon12_elements) + & - currentCohort%prt%GetState(sapw_organ, carbon12_elements) + & - currentCohort%prt%GetState(struct_organ, carbon12_elements) ) * & + ( currentCohort%prt%GetState(leaf_organ, carbon12_element) + & + currentCohort%prt%GetState(sapw_organ, carbon12_element) + & + currentCohort%prt%GetState(struct_organ, carbon12_element) ) * & currentCohort%n/currentPatch%area endif From ab7af564b9e6e5da660159f936d09c1a29d24d37 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Tue, 29 Nov 2022 15:24:44 -0700 Subject: [PATCH 51/55] bug fix in fineroot allometry --- biogeochem/FatesAllometryMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/biogeochem/FatesAllometryMod.F90 b/biogeochem/FatesAllometryMod.F90 index 1f4fbaa30d..1a2b16283e 100644 --- a/biogeochem/FatesAllometryMod.F90 +++ b/biogeochem/FatesAllometryMod.F90 @@ -1056,7 +1056,7 @@ subroutine bfineroot(d,ipft,canopy_trim,l2fr,bfr,dbfrdd) bfr = blmax*l2fr if(present(dbfrdd))then - dbfrdd = dbfrmaxdd*l2fr + dbfrdd = dblmaxdd*l2fr end if case DEFAULT From 9f6b8e9ccf96dbcf41bb858bfad71df520abefda Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Tue, 29 Nov 2022 15:25:02 -0700 Subject: [PATCH 52/55] Removed unused variable --- biogeochem/FatesSoilBGCFluxMod.F90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/biogeochem/FatesSoilBGCFluxMod.F90 b/biogeochem/FatesSoilBGCFluxMod.F90 index ff5b2c7653..ae01df7c93 100644 --- a/biogeochem/FatesSoilBGCFluxMod.F90 +++ b/biogeochem/FatesSoilBGCFluxMod.F90 @@ -636,8 +636,6 @@ subroutine FluxIntoLitterPools(csite, bc_in, bc_out) real(r8), pointer :: flux_cel_si(:) real(r8), pointer :: flux_lab_si(:) real(r8), pointer :: flux_lig_si(:) - real(r8), pointer :: efflux_ptr ! Points to the current - ! element's root efflux type(litter_type), pointer :: litt real(r8) :: surface_prof(bc_in%nlevsoil) ! this array is used to distribute From b746edd6ab07c75ec6d2e0af7ef6c68f1ba4944d Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Tue, 29 Nov 2022 18:46:44 -0700 Subject: [PATCH 53/55] Reverting nclmax to 2 --- main/EDTypesMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 5f9ead2229..252709009a 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -27,7 +27,7 @@ module EDTypesMod private ! By default everything is private save - integer, parameter, public :: nclmax = 3 ! Maximum number of canopy layers + integer, parameter, public :: nclmax = 2 ! Maximum number of canopy layers integer, parameter, public :: ican_upper = 1 ! Nominal index for the upper canopy integer, parameter, public :: ican_ustory = 2 ! Nominal index for diagnostics that refer ! to understory layers (all layers that From 89cf208716e988dd2026383007e2c1c8a50e7def Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Wed, 30 Nov 2022 08:09:52 -0700 Subject: [PATCH 54/55] fixed integration array indices for CNP --- parteh/PRTAllometricCNPMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/parteh/PRTAllometricCNPMod.F90 b/parteh/PRTAllometricCNPMod.F90 index ab8e1abb2d..9e53e422a6 100644 --- a/parteh/PRTAllometricCNPMod.F90 +++ b/parteh/PRTAllometricCNPMod.F90 @@ -2233,7 +2233,7 @@ function AllomCNPGrowthDeriv(l_state_array,l_state_mask,cbalance,intgr_params) r canopy_trim = intgr_params(intgr_parm_ctrim) ipft = int(intgr_params(intgr_parm_pft)) l2fr = intgr_params(intgr_parm_l2fr) - crown_damage = int(intgr_params(acnp_bc_in_id_cdamage)) + crown_damage = int(intgr_params(intgr_parm_cdamage)) call bleaf(dbh,ipft,crown_damage,canopy_trim,leaf_c_target,leaf_dcdd_target) call bfineroot(dbh,ipft,canopy_trim,l2fr,fnrt_c_target,fnrt_dcdd_target) From d3279d39ffa10346bc4833f431b380c3156660bd Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 1 Dec 2022 08:06:48 -0700 Subject: [PATCH 55/55] Removed the CLSZPF dimension temporarily to pass clm tests --- main/FatesHistoryInterfaceMod.F90 | 247 +++++++++++------------------- 1 file changed, 91 insertions(+), 156 deletions(-) diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 1f8c2708b3..0b8ac5ecdc 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -218,8 +218,6 @@ module FatesHistoryInterfaceMod integer :: ih_l2fr_clscpf integer :: ih_recl2fr_canopy_pf integer :: ih_recl2fr_ustory_pf - integer :: ih_ngrowlim_clscpf - integer :: ih_pgrowlim_clscpf integer :: ih_nh4uptake_scpf integer :: ih_no3uptake_scpf integer :: ih_puptake_scpf @@ -237,12 +235,6 @@ module FatesHistoryInterfaceMod integer :: ih_nfix_si integer :: ih_nfix_scpf - ! These dimensions are useful for upscaling (weighting clscpf) - integer :: ih_fnrtc_clscpf - integer :: ih_gpp_clscpf - integer :: ih_totvegc_clscpf - - integer :: ih_trimming_si integer :: ih_area_plant_si integer :: ih_area_trees_si @@ -1903,23 +1895,17 @@ subroutine update_history_nutrflux(this,csite) real(r8):: uconv ! combined unit conversion factor ! We use gpp and fineroot C for weighted averages - real(r8) :: gpp_clscpf(nclmax*numpft*nlevsclass) real(r8) :: gpp_si - real(r8) :: fnrtc_clscpf(nclmax*numpft*nlevsclass) real(r8) :: fnrtc_si real(r8) :: fnrt_c associate( & - hio_ngrowlim_clscpf => this%hvars(ih_ngrowlim_clscpf)%r82d, & - hio_pgrowlim_clscpf => this%hvars(ih_pgrowlim_clscpf)%r82d, & - hio_l2fr_clscpf => this%hvars(ih_l2fr_clscpf)%r82d, & + !hio_l2fr_clscpf => this%hvars(ih_l2fr_clscpf)%r82d, & hio_l2fr_si => this%hvars(ih_l2fr_si)%r81d, & hio_recl2fr_canopy_pf => this%hvars(ih_recl2fr_canopy_pf)%r82d, & hio_recl2fr_ustory_pf => this%hvars(ih_recl2fr_ustory_pf)%r82d ) - gpp_clscpf(:) = 0._r8 gpp_si = 0._r8 - fnrtc_clscpf(:) = 0._r8 fnrtc_si = 0._r8 ! history site index @@ -1946,27 +1932,15 @@ subroutine update_history_nutrflux(this,csite) ! unit conversion factor to get x/plant/day -> x/m2/sec uconv = ccohort%n * ha_per_m2 * days_per_sec - ! Growth Limitations - select case(ccohort%cnp_limiter) - case(2) ! Nitrogen - hio_ngrowlim_clscpf(io_si,iclscpf) = hio_ngrowlim_clscpf(io_si,iclscpf) + & - ccohort%n*ccohort%gpp_acc_hold - case(3) - hio_ngrowlim_clscpf(io_si,iclscpf) = hio_ngrowlim_clscpf(io_si,iclscpf) + & - ccohort%n*ccohort%gpp_acc_hold - end select - fnrt_c = ccohort%prt%GetState(fnrt_organ, carbon12_element) - hio_l2fr_clscpf(io_si,iclscpf) = & - hio_l2fr_clscpf(io_si,iclscpf) + ccohort%n*fnrt_c*ccohort%l2fr + !hio_l2fr_clscpf(io_si,iclscpf) = & + ! hio_l2fr_clscpf(io_si,iclscpf) + ccohort%n*fnrt_c*ccohort%l2fr hio_l2fr_si(io_si) = hio_l2fr_si(io_si) + ccohort%n*fnrt_c*ccohort%l2fr ! These are used for normalizing weighted averages gpp_si = gpp_si + ccohort%n*ccohort%gpp_acc_hold - gpp_clscpf(iclscpf) = gpp_clscpf(iclscpf) + ccohort%n*ccohort%gpp_acc_hold - fnrtc_clscpf(iclscpf) = fnrtc_clscpf(iclscpf) + ccohort%n*fnrt_c fnrtc_si = fnrtc_si + ccohort%n*fnrt_c ! Loop over the different elements. @@ -2060,21 +2034,13 @@ subroutine update_history_nutrflux(this,csite) end do ! Normalize the layer x size x pft arrays - do iclscpf = 1,nclmax*numpft*nlevsclass - - if(gpp_clscpf(iclscpf)>nearzero) then - hio_ngrowlim_clscpf(io_si,iclscpf) = hio_ngrowlim_clscpf(io_si,iclscpf) / gpp_clscpf(iclscpf) - hio_pgrowlim_clscpf(io_si,iclscpf) = hio_pgrowlim_clscpf(io_si,iclscpf) / gpp_clscpf(iclscpf) - else - hio_ngrowlim_clscpf(io_si,iclscpf) = hlm_hio_ignore_val - hio_pgrowlim_clscpf(io_si,iclscpf) = hlm_hio_ignore_val - end if - if(fnrtc_clscpf(iclscpf)>nearzero) then - hio_l2fr_clscpf(io_si,iclscpf) = hio_l2fr_clscpf(io_si,iclscpf) / fnrtc_clscpf(iclscpf) - else - hio_l2fr_clscpf(io_si,iclscpf) = hlm_hio_ignore_val - end if - end do + !do iclscpf = 1,nclmax*numpft*nlevsclass + !if(fnrtc_clscpf(iclscpf)>nearzero) then + ! hio_l2fr_clscpf(io_si,iclscpf) = hio_l2fr_clscpf(io_si,iclscpf) / fnrtc_clscpf(iclscpf) + !else + ! hio_l2fr_clscpf(io_si,iclscpf) = hlm_hio_ignore_val + !end if + !end do do ft = 1,numpft hio_recl2fr_canopy_pf(io_si,ft) = csite%rec_l2fr(ft,1) @@ -5085,7 +5051,7 @@ subroutine define_history_vars(this, initialize_variables) ! cohort size x patch age (site_scag_r8) : SZAP ! cohort size x patch age x pft (site_scagpft_r8) : SZAPPF ! cohort size x pft (site_size_pft_r8) : SZPF - ! canopy layer x size x pft (site_clscpf_r8) : CLSZPF + ! canopy layer x size x pft (site_clscpf_r8) : CLSZPF (NOT ACTIVE) ! cohort size x crown damage (site_cdsc_r8) : SZCD ! cohort size x crown damage x pft (site_cdpf_r8) : CDPF @@ -5662,35 +5628,24 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=site_r8, hlms='CLM:ALM', upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_l2fr_si) - call this%set_history_var(vname='FATES_RECL2FR_CANOPY_PF', units='kg kg-1', & + call this%set_history_var(vname='FATES_L2FR_CANOPY_REC_PF', units='kg kg-1', & long='The leaf to fineroot biomass multiplier for recruits (canopy)', & use_default='active', & avgflag='A', vtype=site_pft_r8, hlms='CLM:ALM', upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_recl2fr_canopy_pf) - call this%set_history_var(vname='FATES_RECL2FR_USTORY_PF', units='kg kg-1', & + call this%set_history_var(vname='FATES_L2FR_USTORY_REC_PF', units='kg kg-1', & long='The leaf to fineroot biomass multiplier for recruits (understory)', & use_default='active', & avgflag='A', vtype=site_pft_r8, hlms='CLM:ALM', upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_recl2fr_ustory_pf) - call this%set_history_var(vname='FATES_NGROWLIM_CLSZPF', units='', & - long='The fraction of gpp*days where stature growth is limited by N (vs C or P)', & - use_default='inactive', & - avgflag='A', vtype=site_clscpf_r8, hlms='CLM:ALM', upfreq=1, & - ivar=ivar, initialize=initialize_variables, index = ih_ngrowlim_clscpf) - - call this%set_history_var(vname='FATES_PGROWLIM_CLSZPF', units='', & - long='The fraction of gpp*days where stature growth is limited by P (vs N or C) (canopy)', & - use_default='inactive', & - avgflag='A', vtype=site_clscpf_r8, hlms='CLM:ALM', upfreq=1, & - ivar=ivar, initialize=initialize_variables, index = ih_pgrowlim_clscpf) - - call this%set_history_var(vname='FATES_L2FR_CLSZPF', units='kg kg-1', & - long='The leaf to fineroot biomass multiplier for target allometry', & - use_default='inactive', & - avgflag='A', vtype=site_clscpf_r8, hlms='CLM:ALM', upfreq=1, & - ivar=ivar, initialize=initialize_variables, index = ih_l2fr_clscpf) + !call this%set_history_var(vname='FATES_L2FR_CLSZPF', units='kg kg-1', & + ! long='The leaf to fineroot biomass multiplier for target allometry', & + ! use_default='inactive', & + ! avgflag='A', vtype=site_clscpf_r8, hlms='CLM:ALM', upfreq=1, & + ! ivar=ivar, initialize=initialize_variables, index = ih_l2fr_clscpf) + call this%set_history_var(vname='FATES_NH4UPTAKE_SZPF', & units='kg m-2 s-1', & long='ammonium uptake rate by plants by size-class x pft in kg NH4 per m2 per second', & @@ -5717,7 +5672,7 @@ subroutine define_history_vars(this, initialize_variables) hlms='CLM:ALM', upfreq=5, ivar=ivar, & initialize=initialize_variables, index = ih_ndemand_scpf) - call this%set_history_var(vname='FATES_SYMNFIX_SZPF', units='kg m-2 s-1', & + call this%set_history_var(vname='FATES_NFIX_SYM_SZPF', units='kg m-2 s-1', & long='symbiotic dinitrogen fixation, by size-class x pft in kg N per m2 per second', & use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & hlms='CLM:ALM', upfreq=5, ivar=ivar, & @@ -5748,7 +5703,7 @@ subroutine define_history_vars(this, initialize_variables) upfreq=5, ivar=ivar, initialize=initialize_variables, & index = ih_ndemand_si) - call this%set_history_var(vname='FATES_SYMNFIX', units='kg m-2 s-1', & + call this%set_history_var(vname='FATES_NFIX_SYM', units='kg m-2 s-1', & long='symbiotic dinitrogen fixation in kg N per m2 per second', & use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & upfreq=5, ivar=ivar, initialize=initialize_variables, & @@ -5844,9 +5799,6 @@ subroutine define_history_vars(this, initialize_variables) use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & hlms='CLM:ALM', upfreq=1, ivar=ivar, & initialize=initialize_variables, index = ih_repron_scpf) - - - end if nitrogen_active_if @@ -5910,6 +5862,76 @@ subroutine define_history_vars(this, initialize_variables) upfreq=5, ivar=ivar, initialize=initialize_variables, & index = ih_pdemand_si) + call this%set_history_var(vname='FATES_VEGP_SZPF', units='kg m-2', & + long='total (live) vegetation phosphorus mass by size-class x pft in kg P per m2', & + use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & + hlms='CLM:ALM', upfreq=1, ivar=ivar, & + initialize=initialize_variables, index = ih_totvegp_scpf) + + call this%set_history_var(vname='FATES_LEAFP_SZPF', units='kg m-2', & + long='leaf phosphorus mass by size-class x pft', use_default='inactive', & + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_leafp_scpf ) + + call this%set_history_var(vname='FATES_FROOTP_SZPF', units='kg m-2', & + long='fine-root phosphorus mass by size-class x pft in kg P per m2', & + use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & + hlms='CLM:ALM', upfreq=1, ivar=ivar, & + initialize=initialize_variables, index = ih_fnrtp_scpf) + + call this%set_history_var(vname='FATES_SAPWOODP_SZPF', units='kg m-2', & + long='sapwood phosphorus mass by size-class x pft in kg P per m2', & + use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & + hlms='CLM:ALM', upfreq=1, ivar=ivar, & + initialize=initialize_variables, index = ih_sapwp_scpf) + + call this%set_history_var(vname='FATES_STOREP_SZPF', units='kg m-2', & + long='storage phosphorus mass by size-class x pft in kg P per m2', & + use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & + hlms='CLM:ALM', upfreq=1, ivar=ivar, & + initialize=initialize_variables, index = ih_storep_scpf) + + call this%set_history_var(vname='FATES_STOREP_TF_CANOPY_SZPF', & + units='1', & + long='storage phosphorus fraction (0-1) of target, in canopy, by size-class x pft', & + use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & + hlms='CLM:ALM', upfreq=1, ivar=ivar, & + initialize=initialize_variables, index = ih_storeptfrac_canopy_scpf) + + call this%set_history_var(vname='FATES_STOREP_TF_USTORY_SZPF', & + units='1', & + long='storage phosphorus fraction (0-1) of target, in understory, by size-class x pft', & + use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & + hlms='CLM:ALM', upfreq=1, ivar=ivar, & + initialize=initialize_variables, & + index = ih_storeptfrac_understory_scpf) + + call this%set_history_var(vname='FATES_REPROP_SZPF', units='kg m-2', & + long='reproductive phosphorus mass (on plant) by size-class x pft in kg P per m2', & + use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & + hlms='CLM:ALM', upfreq=1, ivar=ivar, & + initialize=initialize_variables, index = ih_reprop_scpf) + + call this%set_history_var(vname='FATES_PUPTAKE_SZPF', & + units='kg m-2 s-1', & + long='phosphorus uptake rate by plants, by size-class x pft in kg P per m2 per second', & + use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & + hlms='CLM:ALM', upfreq=5, ivar=ivar, & + initialize=initialize_variables, index = ih_puptake_scpf) + + call this%set_history_var(vname='FATES_PEFFLUX_SZPF', & + units='kg m-2 s-1', & + long='phosphorus efflux, root to soil, by size-class x pft in kg P per m2 per second', & + use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & + hlms='CLM:ALM', upfreq=5, ivar=ivar, & + initialize=initialize_variables, index = ih_pefflux_scpf) + + call this%set_history_var(vname='FATES_PDEMAND_SZPF', units='kg m-2 s-1', & + long='plant P need (algorithm dependent), by size-class x pft in kg P per m2 per second', & + use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & + hlms='CLM:ALM', upfreq=5, ivar=ivar, & + initialize=initialize_variables, index = ih_pdemand_scpf) + end if phosphorus_active_if call this%set_history_var(vname='FATES_STRUCTC', units='kg m-2', & @@ -7646,93 +7668,6 @@ subroutine define_history_vars(this, initialize_variables) hlms='CLM:ALM', upfreq=1, ivar=ivar, initialize=initialize_variables, & index = ih_reproc_scpf) - ! NITROGEN - - nitrogen_active_if2: if(any(element_list(:)==nitrogen_element)) then - - - - - - - end if nitrogen_active_if2 - - ! PHOSPHORUS - - phosphorus_active_if2: if(any(element_list(:)==phosphorus_element))then - - call this%set_history_var(vname='FATES_VEGP_SZPF', units='kg m-2', & - long='total (live) vegetation phosphorus mass by size-class x pft in kg P per m2', & - use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & - hlms='CLM:ALM', upfreq=1, ivar=ivar, & - initialize=initialize_variables, index = ih_totvegp_scpf) - - call this%set_history_var(vname='FATES_LEAFP_SZPF', units='kg m-2', & - long='leaf phosphorus mass by size-class x pft', use_default='inactive', & - avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_leafp_scpf ) - - call this%set_history_var(vname='FATES_FROOTP_SZPF', units='kg m-2', & - long='fine-root phosphorus mass by size-class x pft in kg P per m2', & - use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & - hlms='CLM:ALM', upfreq=1, ivar=ivar, & - initialize=initialize_variables, index = ih_fnrtp_scpf) - - call this%set_history_var(vname='FATES_SAPWOODP_SZPF', units='kg m-2', & - long='sapwood phosphorus mass by size-class x pft in kg P per m2', & - use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & - hlms='CLM:ALM', upfreq=1, ivar=ivar, & - initialize=initialize_variables, index = ih_sapwp_scpf) - - call this%set_history_var(vname='FATES_STOREP_SZPF', units='kg m-2', & - long='storage phosphorus mass by size-class x pft in kg P per m2', & - use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & - hlms='CLM:ALM', upfreq=1, ivar=ivar, & - initialize=initialize_variables, index = ih_storep_scpf) - - call this%set_history_var(vname='FATES_STOREP_TF_CANOPY_SZPF', & - units='1', & - long='storage phosphorus fraction (0-1) of target, in canopy, by size-class x pft', & - use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & - hlms='CLM:ALM', upfreq=1, ivar=ivar, & - initialize=initialize_variables, index = ih_storeptfrac_canopy_scpf) - - call this%set_history_var(vname='FATES_STOREP_TF_USTORY_SZPF', & - units='1', & - long='storage phosphorus fraction (0-1) of target, in understory, by size-class x pft', & - use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & - hlms='CLM:ALM', upfreq=1, ivar=ivar, & - initialize=initialize_variables, & - index = ih_storeptfrac_understory_scpf) - - call this%set_history_var(vname='FATES_REPROP_SZPF', units='kg m-2', & - long='reproductive phosphorus mass (on plant) by size-class x pft in kg P per m2', & - use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & - hlms='CLM:ALM', upfreq=1, ivar=ivar, & - initialize=initialize_variables, index = ih_reprop_scpf) - - call this%set_history_var(vname='FATES_PUPTAKE_SZPF', & - units='kg m-2 s-1', & - long='phosphorus uptake rate by plants, by size-class x pft in kg P per m2 per second', & - use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & - hlms='CLM:ALM', upfreq=5, ivar=ivar, & - initialize=initialize_variables, index = ih_puptake_scpf) - - call this%set_history_var(vname='FATES_PEFFLUX_SZPF', & - units='kg m-2 s-1', & - long='phosphorus efflux, root to soil, by size-class x pft in kg P per m2 per second', & - use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & - hlms='CLM:ALM', upfreq=5, ivar=ivar, & - initialize=initialize_variables, index = ih_pefflux_scpf) - - call this%set_history_var(vname='FATES_PDEMAND_SZPF', units='kg m-2 s-1', & - long='plant P need (algorithm dependent), by size-class x pft in kg P per m2 per second', & - use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & - hlms='CLM:ALM', upfreq=5, ivar=ivar, & - initialize=initialize_variables, index = ih_pdemand_scpf) - - end if phosphorus_active_if2 - ! organ-partitioned NPP / allocation fluxes call this%set_history_var(vname='FATES_LEAF_ALLOC', units='kg m-2 s-1', &