From 229b5dcacf0929d14cbdb8acc175c02aa82ead0e Mon Sep 17 00:00:00 2001 From: Marcos Longo Date: Thu, 12 Aug 2021 23:17:52 -0700 Subject: [PATCH 01/11] Added LAI by size class and PFT to the list of output variables. --- main/FatesHistoryInterfaceMod.F90 | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 97f3342b43..9df310735a 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -211,6 +211,9 @@ module FatesHistoryInterfaceMod integer :: ih_bleaf_canopy_si_scpf integer :: ih_bleaf_understory_si_scpf + ! Size-class x PFT LAI states + integer :: ih_lai_canopy_si_scpf + integer :: ih_lai_understory_si_scpf integer :: ih_totvegn_scpf @@ -1867,6 +1870,8 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_bstor_understory_si_scpf => this%hvars(ih_bstor_understory_si_scpf)%r82d, & hio_bleaf_canopy_si_scpf => this%hvars(ih_bleaf_canopy_si_scpf)%r82d, & hio_bleaf_understory_si_scpf => this%hvars(ih_bleaf_understory_si_scpf)%r82d, & + hio_lai_canopy_si_scpf => this%hvars(ih_lai_canopy_si_scpf)%r82d, & + hio_lai_understory_si_scpf => this%hvars(ih_lai_understory_si_scpf)%r82d, & hio_mortality_canopy_si_scpf => this%hvars(ih_mortality_canopy_si_scpf)%r82d, & hio_mortality_understory_si_scpf => this%hvars(ih_mortality_understory_si_scpf)%r82d, & hio_nplant_canopy_si_scpf => this%hvars(ih_nplant_canopy_si_scpf)%r82d, & @@ -2571,6 +2576,8 @@ subroutine update_history_dyn(this,nc,nsites,sites) store_m * ccohort%n hio_bleaf_canopy_si_scpf(io_si,scpf) = hio_bleaf_canopy_si_scpf(io_si,scpf) + & leaf_m * ccohort%n + hio_lai_canopy_si_scpf(io_si,scpf) = hio_lai_canopy_si_scpf(io_si,scpf) + & + ccohort%treelai*ccohort%c_area * AREA_INV hio_canopy_biomass_si(io_si) = hio_canopy_biomass_si(io_si) + n_perm2 * total_m * g_per_kg @@ -2667,6 +2674,8 @@ subroutine update_history_dyn(this,nc,nsites,sites) leaf_m * ccohort%n hio_understory_biomass_si(io_si) = hio_understory_biomass_si(io_si) + & n_perm2 * total_m * g_per_kg + hio_lai_understory_si_scpf(io_si,scpf) = hio_lai_understory_si_scpf(io_si,scpf) + & + ccohort%treelai*ccohort%c_area * AREA_INV !hio_mortality_understory_si_scpf(io_si,scpf) = hio_mortality_understory_si_scpf(io_si,scpf)+ & ! (ccohort%bmort + ccohort%hmort + ccohort%cmort + @@ -5459,6 +5468,11 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_bleaf_canopy_si_scpf ) + call this%set_history_var(vname='LAI_CANOPY_SCPF', units = 'm2/m2', & + long='Leaf area index (LAI) of canopy plants by pft/size', use_default='inactive', & + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_lai_canopy_si_scpf ) + call this%set_history_var(vname='NPLANT_CANOPY_SCPF', units = 'N/ha', & long='stem number of canopy plants density by pft/size', use_default='inactive', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & @@ -5479,6 +5493,11 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_bleaf_understory_si_scpf ) + call this%set_history_var(vname='LAI_UNDERSTORY_SCPF', units = 'm2/m2', & + long='Leaf area index (LAI) of understory plants by pft/size', use_default='inactive', & + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_lai_understory_si_scpf ) + call this%set_history_var(vname='NPLANT_UNDERSTORY_SCPF', units = 'N/ha', & long='stem number of understory plants density by pft/size', use_default='inactive', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & From d44620cb9477750f77de0429e7db4cac69f2ae20 Mon Sep 17 00:00:00 2001 From: Marcos Longo Date: Fri, 29 Oct 2021 17:02:27 -0700 Subject: [PATCH 02/11] A few bug fixes and updates in carbon allocation (see issue #784). 1. Bug fix in DailyPRTAllometricCarbon (parteh/PRTAllometricCarbonMod.F90). When allocating to different tissues, the code was subtracting allocation of tissues before calculating the amount for the next tissue, potentially under-allocating carbon to fine roots. 2. Renamed variable laimemory with leafmemory. We were never tracking the LAI, but leaf carbon, and thus the name is dangerously misleading. 3. Implemented an option carbon allocation routine (DailyPRTAllometricCarbonSimpler in parteh/PRTAllometricCarbonMod.F90). In this routine, I applied much simpler rules for maintenance allocation: it simply checks how much each pool is in deficit, and allocates carbon (storage + carbon_balance) to the pools according to the debt. If there is any carbon left, then the plant finishes filling the storage pool and then allocates to growth. --- biogeochem/EDCohortDynamicsMod.F90 | 26 +- biogeochem/EDPhysiologyMod.F90 | 52 +- biogeophys/FatesPlantRespPhotosynthMod.F90 | 1 + main/EDInitMod.F90 | 8 +- main/EDTypesMod.F90 | 4 +- main/FatesHistoryInterfaceMod.F90 | 2 +- main/FatesInventoryInitMod.F90 | 8 +- main/FatesRestartInterfaceMod.F90 | 14 +- parteh/PRTAllometricCarbonMod.F90 | 629 ++++++++++++++++++++- parteh/PRTParametersMod.F90 | 2 + 10 files changed, 661 insertions(+), 85 deletions(-) diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index b6714ee3e9..1537aad431 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -143,7 +143,7 @@ module EDCohortDynamicsMod subroutine create_cohort(currentSite, patchptr, pft, nn, hite, coage, dbh, & - prt, laimemory, sapwmemory, structmemory, & + prt, leafmemory, sapwmemory, structmemory, & status, recruitstatus,ctrim, clayer, spread, bc_in) ! ! !DESCRIPTION: @@ -177,7 +177,7 @@ subroutine create_cohort(currentSite, patchptr, pft, nn, hite, coage, dbh, & real(r8), intent(in) :: dbh ! dbh: cm class(prt_vartypes),target :: prt ! The allocated PARTEH ! object - real(r8), intent(in) :: laimemory ! target leaf biomass- set from + real(r8), intent(in) :: leafmemory ! target leaf biomass- set from ! previous year: kGC per indiv real(r8), intent(in) :: sapwmemory ! target sapwood biomass- set from ! previous year: kGC per indiv @@ -232,7 +232,7 @@ subroutine create_cohort(currentSite, patchptr, pft, nn, hite, coage, dbh, & new_cohort%canopy_trim = ctrim new_cohort%canopy_layer = clayer new_cohort%canopy_layer_yesterday = real(clayer, r8) - new_cohort%laimemory = laimemory + new_cohort%leafmemory = leafmemory new_cohort%sapwmemory = sapwmemory new_cohort%structmemory = structmemory @@ -525,7 +525,7 @@ subroutine nan_cohort(cc_p) currentCohort%dbh = nan ! 'diameter at breast height' in cm currentCohort%coage = nan ! age of the cohort in years currentCohort%hite = nan ! height: meters - currentCohort%laimemory = nan ! target leaf biomass- set from previous year: kGC per indiv + currentCohort%leafmemory = nan ! target leaf biomass- set from previous year: kGC per indiv currentCohort%sapwmemory = nan ! target sapwood biomass- set from previous year: kGC per indiv currentCohort%structmemory = nan ! target structural biomass- set from previous year: kGC per indiv currentCohort%lai = nan ! leaf area index of cohort m2/m2 @@ -752,7 +752,7 @@ subroutine terminate_cohorts( currentSite, currentPatch, level , call_index, bc_ if (currentcohort%n < min_n_safemath .and. level == 1) then terminate = itrue if ( debug ) then - write(fates_log(),*) 'terminating cohorts 0',currentCohort%n/currentPatch%area,currentCohort%dbh,call_index + write(fates_log(),*) 'terminating cohorts 0',currentCohort%n/currentPatch%area,currentCohort%dbh,currentCohort%pft,call_index endif endif @@ -765,7 +765,7 @@ subroutine terminate_cohorts( currentSite, currentPatch, level , call_index, bc_ (currentCohort%dbh < 0.00001_r8 .and. store_c < 0._r8) ) then terminate = itrue if ( debug ) then - write(fates_log(),*) 'terminating cohorts 1',currentCohort%n/currentPatch%area,currentCohort%dbh,call_index + write(fates_log(),*) 'terminating cohorts 1',currentCohort%n/currentPatch%area,currentCohort%dbh,currentCohort%pft,call_index endif endif @@ -773,7 +773,7 @@ subroutine terminate_cohorts( currentSite, currentPatch, level , call_index, bc_ if (currentCohort%canopy_layer > nclmax ) then terminate = itrue if ( debug ) then - write(fates_log(),*) 'terminating cohorts 2', currentCohort%canopy_layer,call_index + write(fates_log(),*) 'terminating cohorts 2', currentCohort%canopy_layer,currentCohort%pft,call_index endif endif @@ -783,7 +783,7 @@ subroutine terminate_cohorts( currentSite, currentPatch, level , call_index, bc_ terminate = itrue if ( debug ) then write(fates_log(),*) 'terminating cohorts 3', & - sapw_c,leaf_c,fnrt_c,store_c,call_index + sapw_c,leaf_c,fnrt_c,store_c,currentCohort%pft,call_index endif endif @@ -792,7 +792,7 @@ subroutine terminate_cohorts( currentSite, currentPatch, level , call_index, bc_ terminate = itrue if ( debug ) then write(fates_log(),*) 'terminating cohorts 4', & - struct_c,sapw_c,leaf_c,fnrt_c,store_c,call_index + struct_c,sapw_c,leaf_c,fnrt_c,store_c,currentCohort%pft,call_index endif endif @@ -1141,7 +1141,7 @@ subroutine fuse_cohorts(currentSite, currentPatch, bc_in) write(fates_log(),*) 'Cohort I, Cohort II' write(fates_log(),*) 'n:',currentCohort%n,nextc%n write(fates_log(),*) 'isnew:',currentCohort%isnew,nextc%isnew - write(fates_log(),*) 'laimemory:',currentCohort%laimemory,nextc%laimemory + write(fates_log(),*) 'leafmemory:',currentCohort%leafmemory,nextc%leafmemory write(fates_log(),*) 'hite:',currentCohort%hite,nextc%hite write(fates_log(),*) 'coage:',currentCohort%coage,nextc%coage write(fates_log(),*) 'dbh:',currentCohort%dbh,nextc%dbh @@ -1174,8 +1174,8 @@ subroutine fuse_cohorts(currentSite, currentPatch, bc_in) ! ----------------------------------------------------------------- call UpdateCohortBioPhysRates(currentCohort) - currentCohort%laimemory = (currentCohort%n*currentCohort%laimemory & - + nextc%n*nextc%laimemory)/newn + currentCohort%leafmemory = (currentCohort%n*currentCohort%leafmemory & + + nextc%n*nextc%leafmemory)/newn currentCohort%sapwmemory = (currentCohort%n*currentCohort%sapwmemory & + nextc%n*nextc%sapwmemory)/newn @@ -1767,7 +1767,7 @@ subroutine copy_cohort( currentCohort,copyc ) n%dbh = o%dbh n%coage = o%coage n%hite = o%hite - n%laimemory = o%laimemory + n%leafmemory = o%leafmemory n%sapwmemory = o%sapwmemory n%structmemory = o%structmemory n%lai = o%lai diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index fe184dd343..874fe3183b 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -422,8 +422,8 @@ subroutine trim_canopy( currentSite ) real(r8) :: initial_trim ! Initial trim real(r8) :: optimum_trim ! Optimum trim value - real(r8) :: initial_laimem ! Initial laimemory - real(r8) :: optimum_laimem ! Optimum laimemory + real(r8) :: initial_leafmem ! Initial leafmemory + real(r8) :: optimum_leafmem ! Optimum leafmemory !---------------------------------------------------------------------- @@ -443,15 +443,15 @@ subroutine trim_canopy( currentSite ) currentCohort => currentPatch%tallest do while (associated(currentCohort)) - ! Save off the incoming trim and laimemory + ! Save off the incoming trim and leafmemory initial_trim = currentCohort%canopy_trim - initial_laimem = currentCohort%laimemory + initial_leafmem = currentCohort%leafmemory ! Add debug diagnstic output to determine which cohort if (debug) then write(fates_log(),*) 'Current cohort:', icohort write(fates_log(),*) 'Starting canopy trim:', initial_trim - write(fates_log(),*) 'Starting laimemory:', currentCohort%laimemory + write(fates_log(),*) 'Starting leafmemory:', currentCohort%leafmemory endif trimmed = .false. @@ -598,7 +598,7 @@ subroutine trim_canopy( currentSite ) currentCohort%canopy_trim = currentCohort%canopy_trim - & EDPftvarcon_inst%trim_inc(ipft) if (prt_params%evergreen(ipft) /= 1)then - currentCohort%laimemory = currentCohort%laimemory * & + currentCohort%leafmemory = currentCohort%leafmemory * & (1.0_r8 - EDPftvarcon_inst%trim_inc(ipft)) endif @@ -646,15 +646,15 @@ subroutine trim_canopy( currentSite ) ! optimum_trim = (nnu_clai_b(1,1) / cumulative_lai_cohort) * initial_trim - optimum_laimem = (nnu_clai_b(1,1) / cumulative_lai_cohort) * initial_laimem + optimum_leafmem = (nnu_clai_b(1,1) / cumulative_lai_cohort) * initial_leafmem ! Determine if the optimum trim value makes sense. The smallest cohorts tend to have unrealistic fits. if (optimum_trim > 0. .and. optimum_trim < 1.) then currentCohort%canopy_trim = optimum_trim - ! If the cohort pft is not evergreen we reduce the laimemory as well + ! If the cohort pft is not evergreen we reduce the leafmemory as well if (prt_params%evergreen(ipft) /= 1) then - currentCohort%laimemory = optimum_laimem + currentCohort%leafmemory = optimum_leafmem endif trimmed = .true. @@ -1119,14 +1119,14 @@ subroutine phenology_leafonoff(currentSite) ! stop flow of carbon out of bstore. if(store_c>nearzero) then - ! flush either the amount required from the laimemory, or -most- of the storage pool + ! flush either the amount required from the leafmemory, or -most- of the storage pool ! RF: added a criterion to stop the entire store pool emptying and triggering termination mortality ! n.b. this might not be necessary if we adopted a more gradual approach to leaf flushing... store_c_transfer_frac = min((EDPftvarcon_inst%phenflush_fraction(ipft)* & - currentCohort%laimemory)/store_c,(1.0_r8-carbon_store_buffer)) + currentCohort%leafmemory)/store_c,(1.0_r8-carbon_store_buffer)) if(prt_params%woody(ipft).ne.itrue)then - totalmemory=currentCohort%laimemory+currentCohort%sapwmemory+currentCohort%structmemory + totalmemory=currentCohort%leafmemory+currentCohort%sapwmemory+currentCohort%structmemory store_c_transfer_frac = min((EDPftvarcon_inst%phenflush_fraction(ipft)* & totalmemory)/store_c, (1.0_r8-carbon_store_buffer)) endif @@ -1140,7 +1140,7 @@ subroutine phenology_leafonoff(currentSite) if(prt_params%woody(ipft) == itrue) then call PRTPhenologyFlush(currentCohort%prt, ipft, leaf_organ, store_c_transfer_frac) - currentCohort%laimemory = 0.0_r8 + currentCohort%leafmemory = 0.0_r8 else @@ -1148,7 +1148,7 @@ subroutine phenology_leafonoff(currentSite) if (stem_drop_fraction .gt. 0.0_r8) then call PRTPhenologyFlush(currentCohort%prt, ipft, leaf_organ, & - store_c_transfer_frac*currentCohort%laimemory/totalmemory) + store_c_transfer_frac*currentCohort%leafmemory/totalmemory) call PRTPhenologyFlush(currentCohort%prt, ipft, sapw_organ, & store_c_transfer_frac*currentCohort%sapwmemory/totalmemory) @@ -1163,7 +1163,7 @@ subroutine phenology_leafonoff(currentSite) end if - currentCohort%laimemory = 0.0_r8 + currentCohort%leafmemory = 0.0_r8 currentCohort%structmemory = 0.0_r8 currentCohort%sapwmemory = 0.0_r8 @@ -1187,7 +1187,7 @@ subroutine phenology_leafonoff(currentSite) ! Remember what the lai was (leaf mass actually) was for next year ! the same amount back on in the spring... - currentCohort%laimemory = leaf_c + currentCohort%leafmemory = leaf_c ! Drop Leaves (this routine will update the leaf state variables, ! for carbon and any other element that are prognostic. It will @@ -1234,12 +1234,12 @@ subroutine phenology_leafonoff(currentSite) if(store_c>nearzero) then store_c_transfer_frac = & - min((EDPftvarcon_inst%phenflush_fraction(ipft)*currentCohort%laimemory)/store_c, & + min((EDPftvarcon_inst%phenflush_fraction(ipft)*currentCohort%leafmemory)/store_c, & (1.0_r8-carbon_store_buffer)) if(prt_params%woody(ipft).ne.itrue)then - totalmemory=currentCohort%laimemory+currentCohort%sapwmemory+currentCohort%structmemory + totalmemory=currentCohort%leafmemory+currentCohort%sapwmemory+currentCohort%structmemory store_c_transfer_frac = min(EDPftvarcon_inst%phenflush_fraction(ipft)*totalmemory/store_c, & (1.0_r8-carbon_store_buffer)) @@ -1256,7 +1256,7 @@ subroutine phenology_leafonoff(currentSite) call PRTPhenologyFlush(currentCohort%prt, ipft, & leaf_organ, store_c_transfer_frac) - currentCohort%laimemory = 0.0_r8 + currentCohort%leafmemory = 0.0_r8 else @@ -1264,7 +1264,7 @@ subroutine phenology_leafonoff(currentSite) if (stem_drop_fraction .gt. 0.0_r8) then call PRTPhenologyFlush(currentCohort%prt, ipft, leaf_organ, & - store_c_transfer_frac*currentCohort%laimemory/totalmemory) + store_c_transfer_frac*currentCohort%leafmemory/totalmemory) call PRTPhenologyFlush(currentCohort%prt, ipft, sapw_organ, & store_c_transfer_frac*currentCohort%sapwmemory/totalmemory) @@ -1279,7 +1279,7 @@ subroutine phenology_leafonoff(currentSite) end if - currentCohort%laimemory = 0.0_r8 + currentCohort%leafmemory = 0.0_r8 currentCohort%structmemory = 0.0_r8 currentCohort%sapwmemory = 0.0_r8 @@ -1297,7 +1297,7 @@ subroutine phenology_leafonoff(currentSite) currentCohort%status_coh = leaves_off ! Remember what the lai (leaf mass actually) was for next year - currentCohort%laimemory = leaf_c + currentCohort%leafmemory = leaf_c call PRTDeciduousTurnover(currentCohort%prt,ipft, & leaf_organ, leaf_drop_fraction) @@ -1640,7 +1640,7 @@ subroutine recruitment( currentSite, currentPatch, bc_in ) ! Default assumption is that leaves are on cohortstatus = leaves_on - temp_cohort%laimemory = 0.0_r8 + temp_cohort%leafmemory = 0.0_r8 temp_cohort%sapwmemory = 0.0_r8 temp_cohort%structmemory = 0.0_r8 @@ -1649,7 +1649,7 @@ subroutine recruitment( currentSite, currentPatch, bc_in ) ! as "cold", then set the cohort's status to leaves_off, and remember the leaf biomass if ((prt_params%season_decid(ft) == itrue) .and. & (any(currentSite%cstatus == [phen_cstat_nevercold,phen_cstat_iscold]))) then - temp_cohort%laimemory = c_leaf + temp_cohort%leafmemory = c_leaf c_leaf = 0.0_r8 ! If plant is not woody then set sapwood and structural biomass as well @@ -1667,7 +1667,7 @@ subroutine recruitment( currentSite, currentPatch, bc_in ) ! biomass if ((prt_params%stress_decid(ft) == itrue) .and. & (any(currentSite%dstatus == [phen_dstat_timeoff,phen_dstat_moistoff]))) then - temp_cohort%laimemory = c_leaf + temp_cohort%leafmemory = c_leaf c_leaf = 0.0_r8 ! If plant is not woody then set sapwood and structural biomass as well @@ -1854,7 +1854,7 @@ subroutine recruitment( currentSite, currentPatch, bc_in ) ! This initializes the cohort call create_cohort(currentSite,currentPatch, temp_cohort%pft, temp_cohort%n, & temp_cohort%hite, temp_cohort%coage, temp_cohort%dbh, prt, & - temp_cohort%laimemory, temp_cohort%sapwmemory, temp_cohort%structmemory, & + temp_cohort%leafmemory, temp_cohort%sapwmemory, temp_cohort%structmemory, & cohortstatus, recruitstatus, & temp_cohort%canopy_trim, currentPatch%NCL_p, currentSite%spread, bc_in) diff --git a/biogeophys/FatesPlantRespPhotosynthMod.F90 b/biogeophys/FatesPlantRespPhotosynthMod.F90 index 349f6473bf..39a2589728 100644 --- a/biogeophys/FatesPlantRespPhotosynthMod.F90 +++ b/biogeophys/FatesPlantRespPhotosynthMod.F90 @@ -473,6 +473,7 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) end select + ! MLO - Shouldn't these numbers be parameters too? lmr25top = 2.525e-6_r8 * (1.5_r8 ** ((25._r8 - 20._r8)/10._r8)) lmr25top = lmr25top * lnc_top / (umolC_to_kgC * g_per_kg) diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index 9c3059312d..cafd59f3c1 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -560,7 +560,7 @@ subroutine init_cohorts( site_in, patch_in, bc_in) call bstore_allom(temp_cohort%dbh, pft, temp_cohort%canopy_trim, c_store) - temp_cohort%laimemory = 0._r8 + temp_cohort%leafmemory = 0._r8 temp_cohort%sapwmemory = 0._r8 temp_cohort%structmemory = 0._r8 cstatus = leaves_on @@ -570,7 +570,7 @@ subroutine init_cohorts( site_in, patch_in, bc_in) if( prt_params%season_decid(pft) == itrue .and. & any(site_in%cstatus == [phen_cstat_nevercold,phen_cstat_iscold])) then - temp_cohort%laimemory = c_leaf + temp_cohort%leafmemory = c_leaf temp_cohort%sapwmemory = c_sapw * stem_drop_fraction temp_cohort%structmemory = c_struct * stem_drop_fraction c_leaf = 0._r8 @@ -581,7 +581,7 @@ subroutine init_cohorts( site_in, patch_in, bc_in) if ( prt_params%stress_decid(pft) == itrue .and. & any(site_in%dstatus == [phen_dstat_timeoff,phen_dstat_moistoff])) then - temp_cohort%laimemory = c_leaf + temp_cohort%leafmemory = c_leaf temp_cohort%sapwmemory = c_sapw * stem_drop_fraction temp_cohort%structmemory = c_struct * stem_drop_fraction c_leaf = 0._r8 @@ -663,7 +663,7 @@ subroutine init_cohorts( site_in, patch_in, bc_in) call prt_obj%CheckInitialConditions() 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%coage, temp_cohort%dbh, prt_obj, temp_cohort%leafmemory, & temp_cohort%sapwmemory, temp_cohort%structmemory, cstatus, rstatus, & temp_cohort%canopy_trim, 1, site_in%spread, bc_in) diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 5da7babc54..0f82373fa9 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -216,7 +216,7 @@ module EDTypesMod real(r8) :: coage ! cohort age in years real(r8) :: hite ! height: meters integer :: indexnumber ! unique number for each cohort. (within clump?) - real(r8) :: laimemory ! target leaf biomass- set from previous year: kGC per indiv + real(r8) :: leafmemory ! target leaf biomass- set from previous year: kGC per indiv real(r8) :: sapwmemory ! target sapwood biomass- set from previous year: kGC per indiv real(r8) :: structmemory ! target structural biomass- set from previous year: kGC per indiv integer :: canopy_layer ! canopy status of cohort (1 = canopy, 2 = understorey, etc.) @@ -1025,7 +1025,7 @@ subroutine dump_cohort(ccohort) write(fates_log(),*) 'co%dbh = ', ccohort%dbh write(fates_log(),*) 'co%hite = ', ccohort%hite write(fates_log(),*) 'co%coage = ', ccohort%coage - write(fates_log(),*) 'co%laimemory = ', ccohort%laimemory + write(fates_log(),*) 'co%leafmemory = ', ccohort%leafmemory write(fates_log(),*) 'co%sapwmemory = ', ccohort%sapwmemory write(fates_log(),*) 'co%structmemory = ', ccohort%structmemory diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 9df310735a..de104f8179 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -3966,7 +3966,7 @@ subroutine update_history_hydraulics(this,nc,nsites,sites,bc_in,dt_tstep) jsoil = jrhiz + jr1-1 vwc = bc_in(s)%h2o_liqvol_sl(jsoil) - psi = site_hydr%wrf_soil(jrhiz)%p%psi_from_th(vwc) + psi = site_hydr%wrf_soil(jrhiz)%p%psi_from_th(vwc) ! MLO: Any reason for not using smp_sl? vwc_sat = bc_in(s)%watsat_sl(jsoil) layer_areaweight = site_hydr%l_aroot_layer(jrhiz)*pi_const*site_hydr%rs1(jrhiz)**2.0 mean_soil_vwc = mean_soil_vwc + vwc*layer_areaweight diff --git a/main/FatesInventoryInitMod.F90 b/main/FatesInventoryInitMod.F90 index efdebb8708..074c2cb15a 100644 --- a/main/FatesInventoryInitMod.F90 +++ b/main/FatesInventoryInitMod.F90 @@ -1037,7 +1037,7 @@ subroutine set_inventory_edcohort_type1(csite,bc_in,css_file_unit,npatches, & call bstore_allom(temp_cohort%dbh, temp_cohort%pft, temp_cohort%canopy_trim, c_store) - temp_cohort%laimemory = 0._r8 + temp_cohort%leafmemory = 0._r8 temp_cohort%sapwmemory = 0._r8 temp_cohort%structmemory = 0._r8 cstatus = leaves_on @@ -1046,7 +1046,7 @@ subroutine set_inventory_edcohort_type1(csite,bc_in,css_file_unit,npatches, & if( prt_params%season_decid(temp_cohort%pft) == itrue .and. & any(csite%cstatus == [phen_cstat_nevercold,phen_cstat_iscold])) then - temp_cohort%laimemory = c_leaf + temp_cohort%leafmemory = c_leaf temp_cohort%sapwmemory = c_sapw * stem_drop_fraction temp_cohort%structmemory = c_struct * stem_drop_fraction c_leaf = 0._r8 @@ -1057,7 +1057,7 @@ subroutine set_inventory_edcohort_type1(csite,bc_in,css_file_unit,npatches, & if ( prt_params%stress_decid(temp_cohort%pft) == itrue .and. & any(csite%dstatus == [phen_dstat_timeoff,phen_dstat_moistoff])) then - temp_cohort%laimemory = c_leaf + temp_cohort%leafmemory = c_leaf temp_cohort%sapwmemory = c_sapw * stem_drop_fraction temp_cohort%structmemory = c_struct * stem_drop_fraction c_leaf = 0._r8 @@ -1160,7 +1160,7 @@ subroutine set_inventory_edcohort_type1(csite,bc_in,css_file_unit,npatches, & call create_cohort(csite, cpatch, temp_cohort%pft, temp_cohort%n, temp_cohort%hite, & temp_cohort%coage, temp_cohort%dbh, & - prt_obj, temp_cohort%laimemory,temp_cohort%sapwmemory, temp_cohort%structmemory, & + prt_obj, temp_cohort%leafmemory,temp_cohort%sapwmemory, temp_cohort%structmemory, & cstatus, rstatus, temp_cohort%canopy_trim, & 1, csite%spread, bc_in) diff --git a/main/FatesRestartInterfaceMod.F90 b/main/FatesRestartInterfaceMod.F90 index 7ae00ed0b2..51ca1bbf32 100644 --- a/main/FatesRestartInterfaceMod.F90 +++ b/main/FatesRestartInterfaceMod.F90 @@ -97,7 +97,7 @@ module FatesRestartInterfaceMod integer :: ir_coage_co integer :: ir_g_sb_laweight_co integer :: ir_height_co - integer :: ir_laimemory_co + integer :: ir_leafmemory_co integer :: ir_sapwmemory_co integer :: ir_structmemory_co integer :: ir_nplant_co @@ -691,10 +691,10 @@ subroutine define_restart_vars(this, initialize_variables) long_name='ed cohort - plant height', units='m', flushval = flushzero, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_height_co ) - call this%set_restart_var(vname='fates_laimemory', vtype=cohort_r8, & + call this%set_restart_var(vname='fates_leafmemory', vtype=cohort_r8, & long_name='ed cohort - target leaf biomass set from prev year', & units='kgC/indiv', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_laimemory_co ) + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_leafmemory_co ) call this%set_restart_var(vname='fates_sapwmemory', vtype=cohort_r8, & long_name='ed cohort - target sapwood biomass set from prev year', & @@ -1620,7 +1620,7 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_coage_co => this%rvars(ir_coage_co)%r81d, & rio_g_sb_laweight_co => this%rvars(ir_g_sb_laweight_co)%r81d, & rio_height_co => this%rvars(ir_height_co)%r81d, & - rio_laimemory_co => this%rvars(ir_laimemory_co)%r81d, & + rio_leafmemory_co => this%rvars(ir_leafmemory_co)%r81d, & rio_sapwmemory_co => this%rvars(ir_sapwmemory_co)%r81d, & rio_structmemory_co => this%rvars(ir_structmemory_co)%r81d, & rio_nplant_co => this%rvars(ir_nplant_co)%r81d, & @@ -1847,7 +1847,7 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_dbh_co(io_idx_co) = ccohort%dbh rio_coage_co(io_idx_co) = ccohort%coage rio_height_co(io_idx_co) = ccohort%hite - rio_laimemory_co(io_idx_co) = ccohort%laimemory + rio_leafmemory_co(io_idx_co) = ccohort%leafmemory rio_sapwmemory_co(io_idx_co) = ccohort%sapwmemory rio_structmemory_co(io_idx_co) = ccohort%structmemory rio_g_sb_laweight_co(io_idx_co)= ccohort%g_sb_laweight @@ -2404,7 +2404,7 @@ subroutine get_restart_vectors(this, nc, nsites, sites) rio_coage_co => this%rvars(ir_coage_co)%r81d, & rio_g_sb_laweight_co => this%rvars(ir_g_sb_laweight_co)%r81d, & rio_height_co => this%rvars(ir_height_co)%r81d, & - rio_laimemory_co => this%rvars(ir_laimemory_co)%r81d, & + rio_leafmemory_co => this%rvars(ir_leafmemory_co)%r81d, & rio_sapwmemory_co => this%rvars(ir_sapwmemory_co)%r81d, & rio_structmemory_co => this%rvars(ir_structmemory_co)%r81d, & rio_nplant_co => this%rvars(ir_nplant_co)%r81d, & @@ -2604,7 +2604,7 @@ subroutine get_restart_vectors(this, nc, nsites, sites) ccohort%coage = rio_coage_co(io_idx_co) ccohort%g_sb_laweight= rio_g_sb_laweight_co(io_idx_co) ccohort%hite = rio_height_co(io_idx_co) - ccohort%laimemory = rio_laimemory_co(io_idx_co) + ccohort%leafmemory = rio_leafmemory_co(io_idx_co) ccohort%sapwmemory = rio_sapwmemory_co(io_idx_co) ccohort%structmemory= rio_structmemory_co(io_idx_co) ccohort%n = rio_nplant_co(io_idx_co) diff --git a/parteh/PRTAllometricCarbonMod.F90 b/parteh/PRTAllometricCarbonMod.F90 index 5bdf624502..08b47dbbaa 100644 --- a/parteh/PRTAllometricCarbonMod.F90 +++ b/parteh/PRTAllometricCarbonMod.F90 @@ -51,6 +51,9 @@ module PRTAllometricCarbonMod use PRTParametersMod , only : prt_params + use EDTypesMod , only : leaves_on + use EDTypesMod , only : leaves_off + implicit none private @@ -119,6 +122,7 @@ module PRTAllometricCarbonMod contains procedure :: DailyPRT => DailyPRTAllometricCarbon + ! procedure :: DailyPRT => DailyPRTAllometricCarbonSimpler procedure :: FastPRT => FastPRTAllometricCarbon end type callom_prt_vartypes @@ -451,11 +455,12 @@ subroutine DailyPRTAllometricCarbon(this) call bdead_allom( target_agw_c, target_bgw_c, target_sapw_c, ipft, target_struct_c) ! Target leaf biomass according to allometry and trimming - if(leaf_status==2) then + select case (leaf_status) + case (leaves_on) call bleaf(dbh,ipft,canopy_trim,target_leaf_c) - else + case (leaves_off) target_leaf_c = 0._r8 - end if + end select ! Target fine-root biomass and deriv. according to allometry and trimming [kgC, kgC/cm] call bfineroot(dbh,ipft,canopy_trim,target_fnrt_c) @@ -486,23 +491,25 @@ subroutine DailyPRTAllometricCarbon(this) ! 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 - + ! MLO. Edited the code to switch the order of operations. The previous code would + ! subtract leaf flux from carbon balance before estimating the fine root flux, + ! potentially allowing less fluxes to fine roots than possible. leaf_c_flux = min(leaf_c_demand, & max(0.0_r8,(store_c+carbon_balance)* & (leaf_c_demand/total_c_demand))) - - ! Add carbon to the youngest age pool (i.e iexp_leaf = index 1) - carbon_balance = carbon_balance - leaf_c_flux - leaf_c(iexp_leaf) = leaf_c(iexp_leaf) + leaf_c_flux - ! If we are testing b4b, then we pay this even if we don't have the carbon fnrt_c_flux = min(fnrt_c_demand, & max(0.0_r8, (store_c+carbon_balance)* & (fnrt_c_demand/total_c_demand))) + + ! Add carbon to the youngest age pool (i.e iexp_leaf = index 1) and fine roots + leaf_c(iexp_leaf) = leaf_c(iexp_leaf) + leaf_c_flux + fnrt_c = fnrt_c + fnrt_c_flux - carbon_balance = carbon_balance - fnrt_c_flux - fnrt_c = fnrt_c + fnrt_c_flux - + ! Remove fluxes from carbon balance. In case we may have drawn carbon from storage, + ! carbon_balance will become negative, in which case we will deplete carbon from + ! storage in the next step. + carbon_balance = carbon_balance - leaf_c_flux - fnrt_c_flux end if ! ----------------------------------------------------------------------------------- @@ -512,18 +519,22 @@ subroutine DailyPRTAllometricCarbon(this) if( carbon_balance < 0.0_r8 ) then + ! Store_c_flux will be negative, so store_c will be depleted store_c_flux = carbon_balance carbon_balance = carbon_balance - store_c_flux store_c = store_c + store_c_flux else - + ! Accumulate some carbon in storage. If storage is completely depleted, aim to + ! increase storage, but not to replenish completely so we can still use some + ! carbon for growth. store_below_target = max(target_store_c - store_c,0.0_r8) store_target_fraction = max(0.0_r8, store_c/target_store_c ) store_c_flux = min(store_below_target,carbon_balance * & max(exp(-1.*store_target_fraction**4._r8) - exp( -1.0_r8 ),0.0_r8)) + ! Move carbon from carbon balance to storage carbon_balance = carbon_balance - store_c_flux store_c = store_c + store_c_flux @@ -533,24 +544,27 @@ subroutine DailyPRTAllometricCarbon(this) ! V. If carbon is still available, prioritize some allocation to replace ! the rest of the leaf/fineroot deficit ! carbon balance is guaranteed to be >=0 beyond this point + ! MLO. Renamed demand with below target to make it consistent with the + ! definitions at the variable declaration part. ! ----------------------------------------------------------------------------------- - - leaf_c_demand = max(0.0_r8,(target_leaf_c - sum(leaf_c(1:nleafage)))) - fnrt_c_demand = max(0.0_r8,(target_fnrt_c - fnrt_c)) + leaf_below_target = max(0.0_r8,target_leaf_c - sum(leaf_c(1:nleafage))) + fnrt_below_target = max(0.0_r8,target_fnrt_c - fnrt_c) - total_c_demand = leaf_c_demand + fnrt_c_demand - - if( (carbon_balance > nearzero ) .and. (total_c_demand>nearzero)) then + total_below_target = leaf_below_target + fnrt_below_target + + if ( (carbon_balance > nearzero) .and. (total_below_target > nearzero) ) then + ! MLO. Edited the code to switch the order of operations. The previous code would + ! subtract leaf flux from carbon balance before estimating the fine root flux, + ! potentially allowing less fluxes to fine roots than possible. + leaf_c_flux = min(leaf_below_target, & + carbon_balance*leaf_below_target/total_below_target) + fnrt_c_flux = min(fnrt_below_target, & + carbon_balance*fnrt_below_target/total_below_target) - leaf_c_flux = min(leaf_c_demand, & - carbon_balance*(leaf_c_demand/total_c_demand)) - carbon_balance = carbon_balance - leaf_c_flux leaf_c(iexp_leaf) = leaf_c(iexp_leaf) + leaf_c_flux - - fnrt_c_flux = min(fnrt_c_demand, & - carbon_balance*(fnrt_c_demand/total_c_demand)) - carbon_balance = carbon_balance - fnrt_c_flux - fnrt_c = fnrt_c + fnrt_c_flux + fnrt_c = fnrt_c + fnrt_c_flux + + carbon_balance = carbon_balance - leaf_c_flux - fnrt_c_flux end if @@ -690,7 +704,7 @@ subroutine DailyPRTAllometricCarbon(this) c_pool(dbh_id) = dbh ! Only grow leaves if we are in a "leaf-on" status - if(leaf_status==2) then + if(leaf_status == leaves_on) then c_mask(leaf_c_id) = grow_leaf else c_mask(leaf_c_id) = .false. @@ -862,6 +876,565 @@ subroutine DailyPRTAllometricCarbon(this) end subroutine DailyPRTAllometricCarbon ! ===================================================================================== + + + ! ===================================================================================== + + + + + subroutine DailyPRTAllometricCarbonSimpler(this) + + ! ----------------------------------------------------------------------------------- + ! + ! This is the main routine that handles allocation associated with the 1st + ! hypothesis; carbon only, and growth governed by allometry. + ! MLO. This is a slightly simpler alternative I am testing. + ! + ! This routine is explained in the technical documentation in detail. + ! + ! Some points: + ! 1) dbh, while not a PARTEH "state variable", is passed in from FATES (or other + ! model), is integrated along with the mass based state variables, and then + ! passed back to the ecosystem model. It is a "inout" style boundary condition. + ! + ! 2) It is assumed that both growth respiration, and maintenance respiration + ! costs have already been paid, and therefore the "carbon_balance" boundary + ! condition is the net carbon gained by the plant over the coarse of the day. + ! Think of "daily integrated NPP". + ! + ! 3) This routine will completely spend carbon_balance if it enters as a positive + ! value, or replace carbon balance (using storage) if it enters as a negative value. + ! + ! 4) It is assumed that the ecosystem model calling this routine has ensured that + ! the net amount of negative carbon is no greater than that which can be replaced + ! by storage. This routine will crash gracefully if that is not true. + ! + ! 5) Unlike the original sub-routine, here we do not distinguish carbon lost through + ! maintenance from long-term carbon "debt" (i.e. biomass below allometry). We simply + ! seek to bring the plant back to allometry in case there is carbon to do so. We only + ! maintain the priority of replenishing living tissues (plus storage) over structural + ! tissues (which should be sapwood turnover in any case). + ! + ! 6) If there is any carbon balance left after bringing living tissues to allometry, + ! we try to bring heartwood back on allometry. + ! + ! 7) Finally, if carbon is yet still available, it will grow all pools out concurrently + ! including some to reproduction. + ! + ! ---------------------------------------------------------------------------------- + + + ! The class is the only argument + class(callom_prt_vartypes) :: this ! this class + + ! ----------------------------------------------------------------------------------- + ! These are local copies of the in/out boundary condition structure + ! ----------------------------------------------------------------------------------- + + real(r8),pointer :: dbh ! Diameter at breast height [cm] + ! this local will point to both in and out bc's + real(r8),pointer :: carbon_balance ! Daily carbon balance for this cohort [kgC] + + real(r8) :: canopy_trim ! The canopy trimming function [0-1] + integer :: ipft ! Plant Functional Type index + + + real(r8) :: target_leaf_c ! target leaf carbon [kgC] + real(r8) :: target_fnrt_c ! target fine-root carbon [kgC] + real(r8) :: target_sapw_c ! target sapwood carbon [kgC] + real(r8) :: target_store_c ! target storage carbon [kgC] + real(r8) :: target_agw_c ! target above ground carbon in woody tissues [kgC] + real(r8) :: target_bgw_c ! target below ground carbon in woody tissues [kgC] + real(r8) :: target_struct_c ! target structural carbon [kgC] + + real(r8) :: sapw_area ! dummy var, x-section area of sapwood [m2] + + real(r8) :: leaf_below_target ! fineroot biomass below target amount [kgC] + real(r8) :: fnrt_below_target ! fineroot biomass below target amount [kgC] + real(r8) :: sapw_below_target ! sapwood biomass below target amount [kgC] + real(r8) :: store_below_target ! storage biomass below target amount [kgC] + real(r8) :: struct_below_target ! dead (structural) biomass below target amount [kgC] + real(r8) :: total_below_target ! total biomass below the allometric target [kgC] + + real(r8) :: available_carbon ! available carbon to reconstruct tissues + + real(r8) :: flux_adj ! adjustment made to growth flux term to minimize error [kgC] + + logical :: step_pass ! Did the integration step pass? + + real(r8) :: leaf_c_flux ! Transfer into leaves at various stages [kgC] + real(r8) :: fnrt_c_flux ! Transfer into fine-roots at various stages [kgC] + real(r8) :: sapw_c_flux ! Transfer into sapwood at various stages [kgC] + real(r8) :: store_c_flux ! Transfer into storage at various stages [kgC] + real(r8) :: repro_c_flux ! Transfer into reproduction at the final stage [kgC] + real(r8) :: struct_c_flux ! Transfer into structure at various stages [kgC] + + real(r8),dimension(max_nleafage) :: leaf_c0 + + ! Initial value of carbon used to determine net flux + real(r8) :: fnrt_c0 ! during this routine + real(r8) :: sapw_c0 ! "" + real(r8) :: store_c0 ! "" + real(r8) :: repro_c0 ! "" + real(r8) :: struct_c0 ! "" + + logical :: is_hydecid_dormant ! Flag to signal that the cohort is drought deciduous and dormant + logical :: is_deciduous ! Flag to signal this is a deciduous PFT + + logical :: grow_struct + logical :: grow_leaf ! Are leaves at allometric target and should be grown? + logical :: grow_fnrt ! Are fine-roots at allometric target and should be grown? + logical :: grow_sapw ! Is sapwood at allometric target and should be grown? + logical :: grow_store ! Is storage at allometric target and should be grown? + + ! integrator variables + real(r8) :: deltaC ! trial value for substep + integer :: ierr ! error flag for allometric growth step + integer :: nsteps ! number of sub-steps + integer :: istep ! current substep index + real(r8) :: totalC ! total carbon allocated over alometric growth step + real(r8) :: hite_out ! dummy height variable + + integer :: i_var ! index for iterating state variables + integer :: i_age ! index for iterating leaf ages + integer :: nleafage ! number of leaf age classifications + integer :: leaf_status ! are leaves on or off? + real(r8) :: leaf_age_flux ! carbon mass flux between leaf age classification pools + + + ! Integrator variables c_pool are "mostly" carbon variables, but c_pool also includes + ! dbh... + ! ----------------------------------------------------------------------------------- + + real(r8),dimension(n_integration_vars) :: c_pool ! Vector of carbon pools passed to integrator + real(r8),dimension(n_integration_vars) :: c_pool_out ! Vector of carbon pools passed back from integrator + logical,dimension(n_integration_vars) :: c_mask ! Mask of active pools during integration + + 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 + + integer, parameter :: iexp_leaf = 1 ! index 1 is the expanding (i.e. youngest) + ! leaf age class, and therefore + ! all new allocation goes into that pool + + real(r8) :: intgr_params(num_bc_in) ! The boundary conditions to this routine, + ! are pressed into an array that is also + ! passed to the integrators + + 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)) + + + ! ----------------------------------------------------------------------------------- + ! 0. + ! Copy the boundary conditions into readable local variables. + ! We don't use pointers for bc's that ar "in" only, only "in-out" and "out" + ! ----------------------------------------------------------------------------------- + + dbh => this%bc_inout(ac_bc_inout_id_dbh)%rval + 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) + + ! Set some logical flags to simplify "if" blocks + is_hydecid_dormant = ( prt_params%stress_decid(ipft) == 1 ) .and. & + ( leaf_status == leaves_off ) + is_deciduous = ( prt_params%stress_decid(ipft) == 1 ) .or. & + ( prt_params%season_decid(ipft) == 1 ) + + + nleafage = prt_global%state_descriptor(leaf_c_id)%num_pos ! Number of leaf age class + + ! ----------------------------------------------------------------------------------- + ! Call the routine that advances leaves in age. + ! This will move a portion of the leaf mass in each + ! age bin, to the next bin. This will not handle movement + ! of mass from the oldest bin into the litter pool, that is something else. + ! ----------------------------------------------------------------------------------- + + call this%AgeLeaves(ipft,sec_per_day) + + ! ----------------------------------------------------------------------------------- + ! I. Remember the values for the state variables at the beginning of this + ! routines. We will then use that to determine their net allocation and reactive + ! transport flux "%net_alloc" at the end. + ! ----------------------------------------------------------------------------------- + + leaf_c0(1:nleafage) = leaf_c(1:nleafage) ! Set initial leaf carbon + fnrt_c0 = fnrt_c ! Set initial fine-root carbon + sapw_c0 = sapw_c ! Set initial sapwood carbon + store_c0 = store_c ! Set initial storage carbon + repro_c0 = repro_c ! Set initial reproductive carbon + struct_c0 = struct_c ! Set initial structural carbon + + + ! ----------------------------------------------------------------------------------- + ! II. Calculate target size of the biomass compartment for a given dbh. + ! ----------------------------------------------------------------------------------- + ! Target sapwood biomass according to allometry and trimming [kgC] + call bsap_allom(dbh,ipft,canopy_trim,sapw_area,target_sapw_c) + + ! Target total above ground biomass in woody/fibrous tissues [kgC] + call bagw_allom(dbh,ipft,target_agw_c) + + ! Target total below ground biomass in woody/fibrous tissues [kgC] + call bbgw_allom(dbh,ipft,target_bgw_c) + + ! Target total dead (structrual) biomass [kgC] + call bdead_allom( target_agw_c, target_bgw_c, target_sapw_c, ipft, target_struct_c) + + ! Target leaf biomass according to allometry and trimming + select case (leaf_status) + case (leaves_on) + call bleaf(dbh,ipft,canopy_trim,target_leaf_c) + case (leaves_off) + target_leaf_c = 0.0_r8 + end select + + ! Target fine-root biomass and deriv. according to allometry and trimming [kgC, kgC/cm] + call bfineroot(dbh,ipft,canopy_trim,target_fnrt_c) + + ! Target storage carbon [kgC,kgC/cm] + call bstore_allom(dbh,ipft,canopy_trim,target_store_c) + + + ! ----------------------------------------------------------------------------------- + ! III. If carbon is available, bring all the pools as close to the allometry + ! as possible. This also includes the storage pool, even though carbon may + ! be drawn from the storage. + ! ----------------------------------------------------------------------------------- + + ! Identify living organs (plus storage) that are under target. Priority is given + ! to the organs (or storage) that are the most depleted, without a pre-determined + ! sequence. + leaf_below_target = max( 0.0_r8, target_leaf_c - sum(leaf_c(1:nleafage))) + fnrt_below_target = max( 0.0_r8, target_fnrt_c - fnrt_c ) + sapw_below_target = max( 0.0_r8, target_sapw_c - sapw_c ) + store_below_target = max( 0.0_r8, target_store_c - store_c ) + struct_below_target = max( 0.0_r8, target_struct_c - struct_c ) + total_below_target = leaf_below_target + fnrt_below_target + sapw_below_target + & + store_below_target + struct_below_target + + replenish_allom_check: if ( total_below_target > nearzero ) then + ! Available carbon for transfer is the sum of stored carbon and the daily + ! carbon balance. + available_carbon = store_c + carbon_balance + + ! Scale flux so pools can be replenish simultaneously. + leaf_c_flux = min( leaf_below_target, & + available_carbon * leaf_below_target / total_below_target ) + fnrt_c_flux = min( fnrt_below_target, & + available_carbon * fnrt_below_target / total_below_target ) + sapw_c_flux = min( sapw_below_target, & + available_carbon * sapw_below_target / total_below_target ) + store_c_flux = min( store_below_target, & + available_carbon * store_below_target / total_below_target ) + struct_c_flux = min( struct_below_target, & + available_carbon * struct_below_target / total_below_target ) + + ! Replenish pools + leaf_c(iexp_leaf) = leaf_c(iexp_leaf) + leaf_c_flux + fnrt_c = fnrt_c + fnrt_c_flux + sapw_c = sapw_c + sapw_c_flux + store_c = store_c + store_c_flux + struct_c = struct_c + struct_c_flux + + ! Update carbon balance + carbon_balance = carbon_balance - & + ( leaf_c_flux + fnrt_c_flux + sapw_c_flux + & + store_c_flux + struct_c_flux ) + + end if replenish_allom_check + + + ! ----------------------------------------------------------------------------------- + ! IV. If carbon balance is negative, reduce the storage pool. Otherwise, try to + ! fill the storage pool before growing. + ! ----------------------------------------------------------------------------------- + update_storage: if ( carbon_balance < 0.0_r8 .or. is_hydecid_dormant ) then + + + ! If carbon balance is negative, store_c will be depleted. Otherwise, if this is + ! a dormant drought-deciduous plant that somehow managed to score a positive + ! carbon balance with leaves off (very unlikely), then store_c will increase and + ! take all carbon, effectively preventing any chance of growth during lean times. + store_c_flux = carbon_balance + store_c = store_c + store_c_flux + + ! After this operation, carbon_balance should be zero. + carbon_balance = carbon_balance - store_c_flux + + else + ! Non-negative carbon balance. Use left over carbon to fill the storage + ! pool and try to bring it to allometry before trying to grow in size. + store_below_target = max(0.0_r8,target_store_c - store_c) + store_c_flux = min( store_below_target,carbon_balance) + store_c = store_c + store_c_flux + + ! Update carbon balance + carbon_balance = carbon_balance - store_c_flux + + end if update_storage + + + ! ----------------------------------------------------------------------------------- + ! V. If carbon is yet still available ... + ! Our pools are now either on allometry or above (from fusion). + ! We we can increment those pools at or below, + ! including structure and reproduction according to their rates + ! Use an adaptive euler integration. If the error is not nominal, + ! the carbon balance sub-step (deltaC) will be halved and tried again + ! + ! Note that we compare against calloc_abs_error here because it is possible + ! that all the carbon was effectively used up, but a miniscule amount + ! remains due to numerical precision (ie -20 or so), so even though + ! the plant has not been brought to be "on allometry", it thinks it has carbon + ! left to allocate, and thus it must be on allometry when its not. + ! ----------------------------------------------------------------------------------- + if_stature_growth: if ( carbon_balance > calloc_abs_error ) then + + ! This routine checks that actual carbon is not below that targets. It does + ! allow actual pools to be above the target, and in these cases, it sends + ! a false on the "grow_<>" flag, allowing the plant to grow into these pools. + ! It also checks to make sure that structural biomass is not above the target. + + if( (target_store_c - store_c)>calloc_abs_error) then + write(fates_log(),*) 'storage is not on-allometry at the growth step' + write(fates_log(),*) 'exiting' + write(fates_log(),*) 'cbal: ',carbon_balance + write(fates_log(),*) 'near-zero',nearzero + write(fates_log(),*) 'store_c: ',store_c + write(fates_log(),*) 'target c: ',target_store_c + write(fates_log(),*) 'store_c0:', store_c0 + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + + call TargetAllometryCheck(sum(leaf_c(1:nleafage)), fnrt_c, sapw_c, & + store_c, struct_c, & + target_leaf_c, target_fnrt_c, & + target_sapw_c, target_store_c, target_struct_c, & + grow_struct, grow_leaf, grow_fnrt, grow_sapw, grow_store) + + ! -------------------------------------------------------------------------------- + ! The numerical integration of growth requires that the instantaneous state + ! variables are passed in as an array. We call it "c_pool". + ! + ! Initialize the adaptive integrator arrays and flags + ! -------------------------------------------------------------------------------- + + ierr = 1 + totalC = carbon_balance + nsteps = 0 + + c_pool(:) = 0.0_r8 ! Zero state variable array + c_mask(:) = .false. ! This mask tells the integrator + ! which indices are active. Its possible + ! that due to fusion, or previous numerical + ! truncation errors, that one of these pools + ! may be larger than its target! We check + ! this, and if true, then we flag that + ! pool to be ignored. c_mask(i) = .false. + ! For grasses, since they don't grow very + ! large and thus won't accumulate such large + ! errors, we always mask as true. + + c_pool(leaf_c_id) = sum(leaf_c(1:nleafage)) + c_pool(fnrt_c_id) = fnrt_c + c_pool(sapw_c_id) = sapw_c + c_pool(store_c_id) = store_c + c_pool(struct_c_id) = struct_c + c_pool(repro_c_id) = repro_c + c_pool(dbh_id) = dbh + + ! Only grow leaves if we are in a "leaf-on" status + if(leaf_status == leaves_on) then + c_mask(leaf_c_id) = grow_leaf + else + c_mask(leaf_c_id) = .false. + end if + c_mask(fnrt_c_id) = grow_fnrt + c_mask(sapw_c_id) = grow_sapw + c_mask(store_c_id) = grow_store + c_mask(struct_c_id) = grow_struct + c_mask(repro_c_id) = .true. ! Always calculate reproduction on growth + c_mask(dbh_id) = .true. ! Always increment dbh on growth step + + + ! When using the Euler method, we keep things simple. We always try + ! to make the first integration step to span the entirety of the integration + ! window for the independent variable (available carbon) + + if(ODESolve == 2) then + this%ode_opt_step = totalC + end if + + do_solve_check: do while( ierr .ne. 0 ) + + deltaC = min(totalC,this%ode_opt_step) + if(ODESolve == 1) then + call RKF45(AllomCGrowthDeriv,c_pool,c_mask,deltaC,totalC, & + max_trunc_error,intgr_params,c_pool_out,this%ode_opt_step,step_pass) + + elseif(ODESolve == 2) then + call Euler(AllomCGrowthDeriv,c_pool,c_mask,deltaC,totalC,intgr_params,c_pool_out) + ! step_pass = .true. + + ! When integrating along the allometric curve, we have the luxury of perfect + ! hindsite. Ie, after we have made our step, we can see if the amount + ! of each carbon we have matches the target associated with the new dbh. + ! The following call evaluates how close we are to the allometically defined + ! targets. If we are too far (governed by max_trunc_error), then we + ! pass back the pass/fail flag (step_pass) as false. If false, then + ! 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, & + 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), & + c_mask(store_c_id),c_mask(struct_c_id), max_trunc_error, step_pass) + if(step_pass) then + this%ode_opt_step = deltaC + else + this%ode_opt_step = 0.5*deltaC + end if + else + write(fates_log(),*) 'An integrator was chosen that does not exist' + write(fates_log(),*) 'ODESolve = ',ODESolve + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + nsteps = nsteps + 1 + + if (step_pass) then ! If true, then step is accepted + totalC = totalC - deltaC + c_pool(:) = c_pool_out(:) + end if + + if(nsteps > max_substeps ) then + write(fates_log(),*) 'Plant Growth Integrator could not find' + write(fates_log(),*) 'a solution in less than ',max_substeps,' tries' + write(fates_log(),*) 'Aborting' + write(fates_log(),*) 'carbon_balance',carbon_balance + write(fates_log(),*) 'deltaC',deltaC + write(fates_log(),*) 'totalC',totalC + write(fates_log(),*) 'leaf:',grow_leaf,target_leaf_c,target_leaf_c - sum(leaf_c(:)) + write(fates_log(),*) 'fnrt:',grow_fnrt,target_fnrt_c,target_fnrt_c - fnrt_c + write(fates_log(),*) 'sap:',grow_sapw,target_sapw_c, target_sapw_c - sapw_c + write(fates_log(),*) 'store:',grow_store,target_store_c,target_store_c - store_c + write(fates_log(),*) 'dead:',target_struct_c,target_struct_c - struct_c + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + ! + ! TotalC should eventually be whittled down to near zero. + ! The solvers are not perfect, so we can't expect it to be perfectly zero. + ! Note that calloc_abs_error is 1e-9, which is really small (1 microgram of carbon) + ! yet also six orders of magnitude greater than typical rounding errors (~1e-15). + + ! At that point, update the actual states + ! -------------------------------------------------------------------------------- + if_step_pass: if( (totalC < calloc_abs_error) .and. (step_pass) )then + + ierr = 0 + leaf_c_flux = c_pool(leaf_c_id) - sum(leaf_c(1:nleafage)) + fnrt_c_flux = c_pool(fnrt_c_id) - fnrt_c + sapw_c_flux = c_pool(sapw_c_id) - sapw_c + store_c_flux = c_pool(store_c_id) - store_c + struct_c_flux = c_pool(struct_c_id) - struct_c + repro_c_flux = c_pool(repro_c_id) - repro_c + + ! Make an adjustment to flux partitions to make it match remaining c balance + flux_adj = carbon_balance/(leaf_c_flux+fnrt_c_flux+sapw_c_flux + & + store_c_flux+struct_c_flux+repro_c_flux) + + + leaf_c_flux = leaf_c_flux*flux_adj + fnrt_c_flux = fnrt_c_flux*flux_adj + sapw_c_flux = sapw_c_flux*flux_adj + store_c_flux = store_c_flux*flux_adj + struct_c_flux = struct_c_flux*flux_adj + repro_c_flux = repro_c_flux*flux_adj + + carbon_balance = carbon_balance - leaf_c_flux + leaf_c(iexp_leaf) = leaf_c(iexp_leaf) + leaf_c_flux + + carbon_balance = carbon_balance - fnrt_c_flux + fnrt_c = fnrt_c + fnrt_c_flux + + carbon_balance = carbon_balance - sapw_c_flux + sapw_c = sapw_c + sapw_c_flux + + carbon_balance = carbon_balance - store_c_flux + store_c = store_c + store_c_flux + + carbon_balance = carbon_balance - struct_c_flux + struct_c = struct_c + struct_c_flux + + carbon_balance = carbon_balance - repro_c_flux + repro_c = repro_c + repro_c_flux + + dbh = c_pool(dbh_id) + + if( abs(carbon_balance)>calloc_abs_error ) then + write(fates_log(),*) 'carbon conservation error while integrating pools' + write(fates_log(),*) 'along alometric curve' + write(fates_log(),*) 'carbon_balance = ',carbon_balance,totalC + write(fates_log(),*) 'exiting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + end if if_step_pass + + end do do_solve_check + + end if if_stature_growth + + ! Track the net allocations and transport from this routine + ! (the AgeLeaves() routine handled tracking allocation through aging) + + this%variables(leaf_c_id)%net_alloc(icd) = & + this%variables(leaf_c_id)%net_alloc(icd) + (leaf_c(icd) - leaf_c0(icd)) + + this%variables(fnrt_c_id)%net_alloc(icd) = & + this%variables(fnrt_c_id)%net_alloc(icd) + (fnrt_c - fnrt_c0) + + this%variables(sapw_c_id)%net_alloc(icd) = & + this%variables(sapw_c_id)%net_alloc(icd) + (sapw_c - sapw_c0) + + this%variables(store_c_id)%net_alloc(icd) = & + this%variables(store_c_id)%net_alloc(icd) + (store_c - store_c0) + + this%variables(repro_c_id)%net_alloc(icd) = & + this%variables(repro_c_id)%net_alloc(icd) + (repro_c - repro_c0) + + this%variables(struct_c_id)%net_alloc(icd) = & + this%variables(struct_c_id)%net_alloc(icd) + (struct_c - struct_c0) + + + + end associate + + return + end subroutine DailyPRTAllometricCarbonSimpler + + ! ===================================================================================== function AllomCGrowthDeriv(c_pools,c_mask,cbalance,intgr_params) result(dCdx) diff --git a/parteh/PRTParametersMod.F90 b/parteh/PRTParametersMod.F90 index dcf20dbd14..d15abf062b 100644 --- a/parteh/PRTParametersMod.F90 +++ b/parteh/PRTParametersMod.F90 @@ -100,6 +100,8 @@ module PRTParametersMod real(r8), allocatable :: c2b(:) ! Carbon to biomass multiplier [kg/kgC] real(r8), allocatable :: wood_density(:) ! wood density g cm^-3 ... + + ! MLO - Shouldn't this be an integer? real(r8), allocatable :: woody(:) ! Does the plant have wood? (1=yes, 0=no) real(r8), allocatable :: slamax(:) ! Maximum specific leaf area of plant (at bottom) [m2/gC] From 9ee083183c667d17e34c6cb79a5dd0fa6644ef09 Mon Sep 17 00:00:00 2001 From: Marcos Longo Date: Fri, 29 Oct 2021 17:38:15 -0700 Subject: [PATCH 03/11] First set of changes in the drought deciduous phenology to improve its predictability. 1. Implemented option to drive leaves on / leaves off using soil matric potential instead of soil water content, which is more intuitive for setting up thresholds. The choice is controlled by fates_phen_drought_threshold: when it is positive, it continues to use the soil volumetric water content (m3/m3), and when it is negative, it uses soil matric potential (in mm). 2. When drought-deciduous leaves are off, the plant now stops allocating carbon to any living tissue, to reduce carbon losses when carbon balance is necessarily non-positive. 3. The drought-deciduous status is still done at the site level but now it is PFT-dependent because the root distribution is PFT dependent. This required turning 5 site-level variables into site x PFT. 4. Sub-routine phenology_leafonoff (EDPhysiologyMod.F90) was rewritten to reduce duplicated code. Most of the steps for cold deciduous and drought deciduous were the same. The revised routine first checks whether or not it is time o flush or shed leaves, then it uses a common set of commands. --- biogeochem/EDCohortDynamicsMod.F90 | 17 +- biogeochem/EDPhysiologyMod.F90 | 664 +++++++++++------------ main/EDInitMod.F90 | 78 ++- main/EDMainMod.F90 | 2 +- main/EDTypesMod.F90 | 25 +- main/FatesHistoryInterfaceMod.F90 | 92 ++-- main/FatesInventoryInitMod.F90 | 40 +- main/FatesRestartInterfaceMod.F90 | 146 +++-- parameter_files/fates_params_default.cdl | 6 +- parteh/PRTAllometricCarbonMod.F90 | 123 +++-- parteh/PRTLossFluxesMod.F90 | 10 +- 11 files changed, 704 insertions(+), 499 deletions(-) diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index 1537aad431..c8b1e7a133 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -143,7 +143,7 @@ module EDCohortDynamicsMod subroutine create_cohort(currentSite, patchptr, pft, nn, hite, coage, dbh, & - prt, leafmemory, sapwmemory, structmemory, & + prt, leafmemory, fnrtmemory, sapwmemory, structmemory, & status, recruitstatus,ctrim, clayer, spread, bc_in) ! ! !DESCRIPTION: @@ -177,7 +177,9 @@ subroutine create_cohort(currentSite, patchptr, pft, nn, hite, coage, dbh, & real(r8), intent(in) :: dbh ! dbh: cm class(prt_vartypes),target :: prt ! The allocated PARTEH ! object - real(r8), intent(in) :: leafmemory ! target leaf biomass- set from + real(r8), intent(in) :: leafmemory ! target leaf biomass- set from + ! previous year: kGC per indiv + real(r8), intent(in) :: fnrtmemory ! target fine root biomass- set from ! previous year: kGC per indiv real(r8), intent(in) :: sapwmemory ! target sapwood biomass- set from ! previous year: kGC per indiv @@ -232,7 +234,8 @@ subroutine create_cohort(currentSite, patchptr, pft, nn, hite, coage, dbh, & new_cohort%canopy_trim = ctrim new_cohort%canopy_layer = clayer new_cohort%canopy_layer_yesterday = real(clayer, r8) - new_cohort%leafmemory = leafmemory + new_cohort%leafmemory = leafmemory + new_cohort%fnrtmemory = fnrtmemory new_cohort%sapwmemory = sapwmemory new_cohort%structmemory = structmemory @@ -526,6 +529,7 @@ subroutine nan_cohort(cc_p) currentCohort%coage = nan ! age of the cohort in years currentCohort%hite = nan ! height: meters currentCohort%leafmemory = nan ! target leaf biomass- set from previous year: kGC per indiv + currentCohort%fnrtmemory = nan ! target fine-root biomass- set from previous year: kGC per indiv currentCohort%sapwmemory = nan ! target sapwood biomass- set from previous year: kGC per indiv currentCohort%structmemory = nan ! target structural biomass- set from previous year: kGC per indiv currentCohort%lai = nan ! leaf area index of cohort m2/m2 @@ -1142,6 +1146,7 @@ subroutine fuse_cohorts(currentSite, currentPatch, bc_in) write(fates_log(),*) 'n:',currentCohort%n,nextc%n write(fates_log(),*) 'isnew:',currentCohort%isnew,nextc%isnew write(fates_log(),*) 'leafmemory:',currentCohort%leafmemory,nextc%leafmemory + write(fates_log(),*) 'fnrtmemory:',currentCohort%fnrtmemory,nextc%fnrtmemory write(fates_log(),*) 'hite:',currentCohort%hite,nextc%hite write(fates_log(),*) 'coage:',currentCohort%coage,nextc%coage write(fates_log(),*) 'dbh:',currentCohort%dbh,nextc%dbh @@ -1177,11 +1182,14 @@ subroutine fuse_cohorts(currentSite, currentPatch, bc_in) currentCohort%leafmemory = (currentCohort%n*currentCohort%leafmemory & + nextc%n*nextc%leafmemory)/newn + currentCohort%fnrtmemory = (currentCohort%n*currentCohort%fnrtmemory & + + nextc%n*nextc%fnrtmemory)/newn + currentCohort%sapwmemory = (currentCohort%n*currentCohort%sapwmemory & + nextc%n*nextc%sapwmemory)/newn currentCohort%structmemory = (currentCohort%n*currentCohort%structmemory & - + nextc%n*nextc%structmemory)/newn + + nextc%n*nextc%structmemory)/newn currentCohort%canopy_trim = (currentCohort%n*currentCohort%canopy_trim & + nextc%n*nextc%canopy_trim)/newn @@ -1768,6 +1776,7 @@ subroutine copy_cohort( currentCohort,copyc ) n%coage = o%coage n%hite = o%hite n%leafmemory = o%leafmemory + n%fnrtmemory = o%fnrtmemory n%sapwmemory = o%sapwmemory n%structmemory = o%structmemory n%lai = o%lai diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 874fe3183b..3bfb4605ca 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -45,6 +45,8 @@ module EDPhysiologyMod use EDTypesMod , only : num_vegtemp_mem use EDTypesMod , only : maxpft use EDTypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type + use EDTypesMod , only : phen_ref_liqvol + use EDTypesMod , only : phen_ref_smp use EDTypesMod , only : leaves_on use EDTypesMod , only : leaves_off use EDTypesMod , only : min_n_safemath @@ -231,7 +233,7 @@ subroutine PreDisturbanceLitterFluxes( currentSite, currentPatch, bc_in ) ! Calculate seed germination rate, the status flags prevent ! germination from occuring when the site is in a drought ! (for drought deciduous) or too cold (for cold deciduous) - call SeedGermination(litt, currentSite%cstatus, currentSite%dstatus) + call SeedGermination(litt, currentSite%cstatus, currentSite%dstatus(1:numpft)) ! Send fluxes from newly created litter into the litter pools ! This litter flux is from non-disturbance inducing mortality, as well @@ -422,8 +424,8 @@ subroutine trim_canopy( currentSite ) real(r8) :: initial_trim ! Initial trim real(r8) :: optimum_trim ! Optimum trim value - real(r8) :: initial_leafmem ! Initial leafmemory - real(r8) :: optimum_leafmem ! Optimum leafmemory + real(r8) :: initial_leafmem ! Initial leaf memory + real(r8) :: optimum_leafmem ! Optimum leaf memory !---------------------------------------------------------------------- @@ -711,22 +713,21 @@ subroutine phenology( currentSite, bc_in ) integer :: ncolddays ! no days underneath the threshold for leaf drop integer :: i_wmem ! Loop counter for water mem days integer :: i_tmem ! Loop counter for veg temp mem days - integer :: dayssincedleafon ! Days since drought-decid leaf-on started - integer :: dayssincedleafoff ! Days since drought-decid leaf-off started - integer :: dayssincecleafon ! Days since cold-decid leaf-on started - integer :: dayssincecleafoff ! Days since cold-decid leaf-off started - real(r8) :: mean_10day_liqvol ! mean liquid volume (m3/m3) over last 10 days + integer :: ft ! plant functional type index + real(r8) :: mean_10day_liqvol ! mean soil liquid water volume over last 10 days + real(r8) :: mean_10day_smp ! mean soil matric potential over last 10 days real(r8) :: leaf_c ! leaf carbon [kg] real(r8) :: fnrt_c ! fineroot carbon [kg] real(r8) :: sapw_c ! sapwood carbon [kg] real(r8) :: store_c ! storage carbon [kg] real(r8) :: struct_c ! structure carbon [kg] real(r8) :: gdd_threshold ! GDD accumulation function, - integer :: ilayer_swater ! Layer index for soil water - ! which also depends on chilling days. integer :: ncdstart ! beginning of counting period for chilling degree days. integer :: gddstart ! beginning of counting period for growing degree days. - real(r8) :: temp_in_C ! daily averaged temperature in celcius + integer :: nlevroot ! Number of rooting levels to consider + real(r8) :: temp_in_C ! daily averaged temperature in celsius + + logical :: smoist_below_threshold ! Is Soil moisture below threshold? integer, parameter :: canopy_leaf_lifespan = 365 ! Maximum lifespan of drought decid leaves @@ -737,19 +738,18 @@ subroutine phenology( currentSite, bc_in ) ! drought deciduous in perennially wet environments ! that have been forced to drop their leaves, from ! flushing them back immediately. - - real(r8),parameter :: dphen_soil_depth = 0.1 ! Use liquid soil water that is - ! closest to this depth [m] - + integer, parameter :: dd_offon_toler = 30 ! When flushing or shedding leaves, we check that + ! the dates are near last year's dates. This controls + ! the tolerance for deviating from last year. + real(r8), parameter :: smp_off = -0.001_r8 ! Offset to be applied to soil matric potential when + ! taking the log-averages. This avoids FPE in the + ! unlikely case that SMP = 0. (which may occur + ! depending on the hydrology formulation). ! This is the integer model day. The first day of the simulation is 1, and it ! 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) - - ! Parameter of drought decid leaf loss in mm in top layer...FIX(RF,032414) ! - this is arbitrary and poorly understood. Needs work. ED_ !Parameters: defaults from Botta et al. 2000 GCB,6 709-725 @@ -842,15 +842,15 @@ subroutine phenology( currentSite, bc_in ) ! not had occured yet, so set it to last year to get things rolling if (model_day_int < currentSite%cleafoffdate) then - dayssincecleafoff = model_day_int - (currentSite%cleafoffdate - 365) + currentSite%cndaysleafoff = model_day_int - (currentSite%cleafoffdate - 365) else - dayssincecleafoff = model_day_int - currentSite%cleafoffdate + currentSite%cndaysleafoff = model_day_int - currentSite%cleafoffdate end if if (model_day_int < currentSite%cleafondate) then - dayssincecleafon = model_day_int - (currentSite%cleafondate-365) + currentSite%cndaysleafon = model_day_int - (currentSite%cleafondate-365) else - dayssincecleafon = model_day_int - currentSite%cleafondate + currentSite%cndaysleafon = model_day_int - currentSite%cleafondate end if @@ -866,11 +866,11 @@ subroutine phenology( currentSite, bc_in ) if ( (currentSite%cstatus == phen_cstat_iscold .or. & currentSite%cstatus == phen_cstat_nevercold) .and. & (currentSite%grow_deg_days > gdd_threshold) .and. & - (dayssincecleafoff > ED_val_phen_mindayson) .and. & + (currentSite%cndaysleafoff > ED_val_phen_mindayson) .and. & (currentSite%nchilldays >= 1)) then currentSite%cstatus = phen_cstat_notcold ! Set to not-cold status (leaves can come on) currentSite%cleafondate = model_day_int - dayssincecleafon = 0 + currentSite%cndaysleafon = 0 currentSite%grow_deg_days = 0._r8 ! zero GDD for the rest of the year until counting season begins. if ( debug ) write(fates_log(),*) 'leaves on' endif !GDD @@ -889,7 +889,7 @@ subroutine phenology( currentSite, bc_in ) if ( (currentSite%cstatus == phen_cstat_notcold) .and. & (model_day_int > num_vegtemp_mem) .and. & (ncolddays > ED_val_phen_ncolddayslim) .and. & - (dayssincecleafon > ED_val_phen_mindayson) )then + (currentSite%cndaysleafon > ED_val_phen_mindayson) )then currentSite%grow_deg_days = 0._r8 ! The equations for Botta et al ! are for calculations of @@ -897,7 +897,8 @@ subroutine phenology( currentSite, bc_in ) ! clear this value, it will cause ! leaves to flush later in the year currentSite%cstatus = phen_cstat_iscold ! alter status of site to 'leaves off' - currentSite%cleafoffdate = model_day_int ! record leaf off date + currentSite%cleafoffdate = model_day_int ! record leaf off date + currentSite%cndaysleafoff = 0 if ( debug ) write(fates_log(),*) 'leaves off' endif @@ -909,7 +910,7 @@ subroutine phenology( currentSite, bc_in ) ! plants from re-emerging in areas without at least some cold days if( (currentSite%cstatus == phen_cstat_notcold) .and. & - (dayssincecleafoff > 400)) then ! remove leaves after a whole year + (currentSite%cndaysleafoff > 400)) then ! remove leaves after a whole year ! when there is no 'off' period. currentSite%grow_deg_days = 0._r8 @@ -917,6 +918,7 @@ subroutine phenology( currentSite, bc_in ) ! site is never really cold enough ! for cold deciduous currentSite%cleafoffdate = model_day_int ! record leaf off date + currentSite%cndaysleafoff = 0 if ( debug ) write(fates_log(),*) 'leaves off' endif @@ -949,114 +951,154 @@ subroutine phenology( currentSite, bc_in ) ! Why don't the drought deciduous trees grow in the North? ! Is cold decidousness maybe even the same as drought deciduosness there (and so does this ! distinction actually matter??).... + ! MLO. They are probably not the same: unlike cold deciduous temperatures are high when + ! drought deciduous leaves are off, which means that their maintenance respiration is high + ! during the leaf-off season. For them to be viable, we may need different allocation + ! strategies so they don't exhaust their storage to maintain fine roots and sapwood. + + ! Add PFT look to account for different PFT rooting depth profiles. + pft_drgt_loop: do ft=1,numpft + + ! Update soil moisture information memory (we always track the last 10 days) + do i_wmem = numWaterMem,2,-1 !shift memory along one + currentSite%liqvol_memory(i_wmem,ft) = currentSite%liqvol_memory(i_wmem-1,ft) + currentSite%smp_memory (i_wmem,ft) = currentSite%smp_memory (i_wmem-1,ft) + end do - ! Accumulate surface water memory of last 10 days. - ! Liquid volume in ground layer (m3/m3) - do i_wmem = 1,numWaterMem-1 !shift memory along one - currentSite%water_memory(numWaterMem+1-i_wmem) = currentSite%water_memory(numWaterMem-i_wmem) - enddo - currentSite%water_memory(1) = bc_in%h2o_liqvol_sl(ilayer_swater) + ! Find the rooting depth distribution for PFT + call set_root_fraction( currentSite%rootfrac_scr, ft, currentSite%zi_soil, & + bc_in%max_rooting_depth_index_col ) + nlevroot = min(ubound(currentSite%zi_soil,1),bc_in%max_rooting_depth_index_col) + + ! Set the memory to be the weighted average of the soil properties, using the + ! root fraction of each layer as the weighting factor. Because soil matric potential + ! has a very skewed vertical distribution, we average the logarithm of -1*SMP. + ! It is unlike, but SMP can be zero under saturated conditions depending on the hydrological + ! model. To reduce risks of FPE, we include a small offset to SMP before applying log averages. + ! This will bias the average, but the bias should be negligible as long as smp_off is much + ! smaller than the typical values. + currentSite%liqvol_memory(1,ft) = sum( bc_in%h2o_liqvol_sl (1:nlevroot) * & + currentSite%rootfrac_scr(1:nlevroot) ) + currentSite%smp_memory (1,ft) = -exp( sum( log(-(bc_in%smp_sl (1:nlevroot)+smp_off)) * & + currentSite%rootfrac_scr(1:nlevroot) )) - smp_off + + ! Calculate the mean soil moisture ( liquid volume (m3/m3) and matric potential (mm)) + ! over the last 10 days + mean_10day_liqvol = sum(currentSite%liqvol_memory(1:numWaterMem,ft))/real(numWaterMem,r8) + mean_10day_smp = sum(currentSite%smp_memory (1:numWaterMem,ft))/real(numWaterMem,r8) + + ! Compare the moisture with the threshold. + if ( ED_val_phen_drought_threshold >= 0. ) then + ! Liquid volume in reference layer (m3/m3) + smoist_below_threshold = mean_10day_liqvol < ED_val_phen_drought_threshold + else + ! Soil matric potential in reference layer (mm) + smoist_below_threshold = mean_10day_smp < ED_val_phen_drought_threshold + end if - ! Calculate the mean water content over the last 10 days (m3/m3) - mean_10day_liqvol = sum(currentSite%water_memory(1:numWaterMem))/real(numWaterMem,r8) - ! In drought phenology, we often need to force the leaves to stay - ! on or off as moisture fluctuates... + ! In drought phenology, we often need to force the leaves to stay + ! on or off as moisture fluctuates... - ! Calculate days since leaves have come off, but make a provision - ! for the first year of simulation, we have to assume a leaf drop - ! date to start, so if that is in the future, set it to last year + ! Calculate days since leaves have come off, but make a provision + ! for the first year of simulation, we have to assume a leaf drop + ! date to start, so if that is in the future, set it to last year - if (model_day_int < currentSite%dleafoffdate) then - dayssincedleafoff = model_day_int - (currentSite%dleafoffdate-365) - else - dayssincedleafoff = model_day_int - currentSite%dleafoffdate - endif - - ! the leaves are on. How long have they been on? - if (model_day_int < currentSite%dleafondate) then - dayssincedleafon = model_day_int - (currentSite%dleafondate-365) - else - dayssincedleafon = model_day_int - currentSite%dleafondate - endif + if (model_day_int < currentSite%dleafoffdate(ft)) then + currentSite%dndaysleafoff(ft) = model_day_int - (currentSite%dleafoffdate(ft)-365) + else + currentSite%dndaysleafoff(ft) = model_day_int - currentSite%dleafoffdate(ft) + endif - ! LEAF ON: DROUGHT DECIDUOUS WETNESS - ! Here, we used a window of oppurtunity to determine if we are - ! close to the time when then leaves came on last year - - ! Has it been ... - ! a) a year, plus or minus 1 month since we last had leaf-on? - ! b) Has there also been at least a nominaly short amount of "leaf-off" - ! c) is the model day at least > 10 (let soil water spin-up) - ! Note that cold-starts begin in the "leaf-on" - ! status - if ( (currentSite%dstatus == phen_dstat_timeoff .or. & - currentSite%dstatus == phen_dstat_moistoff) .and. & - (model_day_int > numWaterMem) .and. & - (dayssincedleafon >= 365-30 .and. dayssincedleafon <= 365+30 ) .and. & - (dayssincedleafoff > ED_val_phen_doff_time) ) then - - ! If leaves are off, and have been off for at least a few days - ! and the time is consistent with the correct - ! time window... test if the moisture conditions allow for leaf-on - - if ( mean_10day_liqvol >= ED_val_phen_drought_threshold ) then - currentSite%dstatus = phen_dstat_moiston ! set status to leaf-on - currentSite%dleafondate = model_day_int ! save the model day we start flushing - dayssincedleafon = 0 + ! the leaves are on. How long have they been on? + if (model_day_int < currentSite%dleafondate(ft)) then + currentSite%dndaysleafon(ft) = model_day_int - (currentSite%dleafondate(ft)-365) + else + currentSite%dndaysleafon(ft) = model_day_int - currentSite%dleafondate(ft) endif - endif - ! LEAF ON: DROUGHT DECIDUOUS TIME EXCEEDANCE - ! If we still haven't done budburst by end of window, then force it - ! If the status is "phen_dstat_moistoff", it means this site currently has - ! leaves off due to actual moisture limitations. - ! So we trigger bud-burst at the end of the month since - ! last year's bud-burst. If this is imposed, then we set the new - ! status to indicate bud-burst was forced by timing + ! LEAF ON: DROUGHT DECIDUOUS WETNESS + ! Here, we used a window of oppurtunity to determine if we are + ! close to the time when then leaves came on last year + + ! Has it been ... + ! a) a year, plus or minus 1 month since we last had leaf-on? + ! b) Has there also been at least a nominaly short amount of "leaf-off" + ! c) is the model day at least > 10 (let soil water spin-up) + ! Note that cold-starts begin in the "leaf-on" + ! status + if ( (currentSite%dstatus(ft) == phen_dstat_timeoff .or. & + currentSite%dstatus(ft) == phen_dstat_moistoff) .and. & + (model_day_int > numWaterMem) .and. & + (currentSite%dndaysleafon(ft) >= 365-dd_offon_toler .and. & + currentSite%dndaysleafon(ft) <= 365+dd_offon_toler ) .and. & + (currentSite%dndaysleafoff(ft) > ED_val_phen_doff_time) ) then + + ! If leaves are off, and have been off for at least a few days + ! and the time is consistent with the correct + ! time window... test if the moisture conditions allow for leaf-on + if ( .not. smoist_below_threshold ) then + currentSite%dstatus(ft) = phen_dstat_moiston ! set status to leaf-on + currentSite%dleafondate(ft) = model_day_int ! save the model day we start flushing + currentSite%dndaysleafon(ft) = 0 + endif + endif - if( currentSite%dstatus == phen_dstat_moistoff ) then - if ( dayssincedleafon > 365+30 ) then - currentSite%dstatus = phen_dstat_timeon ! force budburst! - currentSite%dleafondate = model_day_int ! record leaf on date - dayssincedleafon = 0 + ! LEAF ON: DROUGHT DECIDUOUS TIME EXCEEDANCE + ! If we still haven't done budburst by end of window, then force it + + ! If the status is "phen_dstat_moistoff", it means this site currently has + ! leaves off due to actual moisture limitations. + ! So we trigger bud-burst at the end of the month since + ! last year's bud-burst. If this is imposed, then we set the new + ! status to indicate bud-burst was forced by timing + + if( currentSite%dstatus(ft) == phen_dstat_moistoff ) then + if ( currentSite%dndaysleafon(ft) > 365+dd_offon_toler ) then + currentSite%dstatus(ft) = phen_dstat_timeon ! force budburst! + currentSite%dleafondate(ft) = model_day_int ! record leaf on date + currentSite%dndaysleafon(ft) = 0 + end if end if - end if - ! But if leaves are off due to time, then we enforce - ! a longer cool-down (because this is a perrenially wet system) + ! But if leaves are off due to time, then we enforce + ! a longer cool-down (because this is a perrenially wet system) - if(currentSite%dstatus == phen_dstat_timeoff ) then - if (dayssincedleafoff > min_daysoff_dforcedflush) then - currentSite%dstatus = phen_dstat_timeon ! force budburst! - currentSite%dleafondate = model_day_int ! record leaf on date - dayssincedleafon = 0 + if(currentSite%dstatus(ft) == phen_dstat_timeoff ) then + if (currentSite%dndaysleafoff(ft) > min_daysoff_dforcedflush) then + currentSite%dstatus(ft) = phen_dstat_timeon ! force budburst! + currentSite%dleafondate(ft) = model_day_int ! record leaf on date + currentSite%dndaysleafon(ft) = 0 + end if end if - end if - ! LEAF OFF: DROUGHT DECIDUOUS LIFESPAN - if the leaf gets to - ! the end of its useful life. A*, E* - ! i.e. Are the leaves rouhgly at the end of their lives? + ! LEAF OFF: DROUGHT DECIDUOUS LIFESPAN - if the leaf gets to + ! the end of its useful life. A*, E* + ! i.e. Are the leaves rouhgly at the end of their lives? - if ( (currentSite%dstatus == phen_dstat_moiston .or. & - currentSite%dstatus == phen_dstat_timeon ) .and. & - (dayssincedleafon > canopy_leaf_lifespan) )then - currentSite%dstatus = phen_dstat_timeoff !alter status of site to 'leaves off' - currentSite%dleafoffdate = model_day_int !record leaf on date - endif + if ( (currentSite%dstatus(ft) == phen_dstat_moiston .or. & + currentSite%dstatus(ft) == phen_dstat_timeon ) .and. & + (currentSite%dndaysleafon(ft) > canopy_leaf_lifespan) )then + currentSite%dstatus(ft) = phen_dstat_timeoff !alter status of site to 'leaves off' + currentSite%dleafoffdate(ft) = model_day_int !record leaf on date + currentSite%dndaysleafoff(ft) = 0 + endif - ! LEAF OFF: DROUGHT DECIDUOUS DRYNESS - if the soil gets too dry, - ! and the leaves have already been on a while... + ! LEAF OFF: DROUGHT DECIDUOUS DRYNESS - if the soil gets too dry, + ! and the leaves have already been on a while... + + if ( (currentSite%dstatus(ft) == phen_dstat_moiston .or. & + currentSite%dstatus(ft) == phen_dstat_timeon ) .and. & + (model_day_int > numWaterMem) .and. & + smoist_below_threshold .and. & + (currentSite%dndaysleafon(ft) > dleafon_drycheck ) ) then + currentSite%dstatus(ft) = phen_dstat_moistoff ! alter status of site to 'leaves off' + currentSite%dleafoffdate(ft) = model_day_int ! record leaf on date + currentSite%dndaysleafoff(ft) = 0 + endif - if ( (currentSite%dstatus == phen_dstat_moiston .or. & - currentSite%dstatus == phen_dstat_timeon ) .and. & - (model_day_int > numWaterMem) .and. & - (mean_10day_liqvol <= ED_val_phen_drought_threshold) .and. & - (dayssincedleafon > dleafon_drycheck ) ) then - currentSite%dstatus = phen_dstat_moistoff ! alter status of site to 'leaves off' - currentSite%dleafoffdate = model_day_int ! record leaf on date - endif + end do pft_drgt_loop call phenology_leafonoff(currentSite) @@ -1078,22 +1120,34 @@ subroutine phenology_leafonoff(currentSite) type(ed_cohort_type), pointer :: currentCohort real(r8) :: leaf_c ! leaf carbon [kg] + real(r8) :: fnrt_c ! fine root carbon [kg] real(r8) :: sapw_c ! sapwood carbon [kg] real(r8) :: struct_c ! structural wood carbon [kg] + + real(r8) :: leaf_deficit ! leaf carbon deficit (to be back on allometry) [kg] + real(r8) :: fnrt_deficit ! fine root carbon (to be back on allometry) [kg] + real(r8) :: sapw_deficit ! sapwood carbon (to be back on allometry) [kg] + real(r8) :: struct_deficit ! structural wood carbon (to be back on allometry) [kg] + real(r8) :: total_deficit ! total carbon deficit (to be back on allometry) [kg] + real(r8) :: store_c ! storage carbon [kg] real(r8) :: store_c_transfer_frac ! Fraction of storage carbon used to flush leaves real(r8) :: totalmemory ! total memory of carbon [kg] + logical :: is_flushing_time ! Time to flush leaves + logical :: is_shedding_time ! Time to shed leaves integer :: ipft real(r8), parameter :: leaf_drop_fraction = 1.0_r8 real(r8), parameter :: carbon_store_buffer = 0.10_r8 real(r8) :: stem_drop_fraction + + logical, parameter :: debug = .true. ! Print debug info? !------------------------------------------------------------------------ currentPatch => CurrentSite%oldest_patch - do while(associated(currentPatch)) + patch_loop: do while(associated(currentPatch)) currentCohort => currentPatch%tallest - do while(associated(currentCohort)) + cohort_loop: do while(associated(currentCohort)) ipft = currentCohort%pft @@ -1103,229 +1157,159 @@ subroutine phenology_leafonoff(currentSite) store_c = currentCohort%prt%GetState(store_organ, all_carbon_elements) leaf_c = currentCohort%prt%GetState(leaf_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) - - stem_drop_fraction = EDPftvarcon_inst%phen_stem_drop_fraction(ipft) - - ! COLD LEAF ON - ! The site level flags signify that it is no-longer too cold - ! for leaves. Time to signal flushing - - if (prt_params%season_decid(ipft) == itrue)then - if ( currentSite%cstatus == phen_cstat_notcold )then ! we have just moved to leaves being on . - if (currentCohort%status_coh == leaves_off)then ! Are the leaves currently off? - currentCohort%status_coh = leaves_on ! Leaves are on, so change status to - ! stop flow of carbon out of bstore. - - if(store_c>nearzero) then - ! flush either the amount required from the leafmemory, or -most- of the storage pool - ! RF: added a criterion to stop the entire store pool emptying and triggering termination mortality - ! n.b. this might not be necessary if we adopted a more gradual approach to leaf flushing... - store_c_transfer_frac = min((EDPftvarcon_inst%phenflush_fraction(ipft)* & - currentCohort%leafmemory)/store_c,(1.0_r8-carbon_store_buffer)) - - if(prt_params%woody(ipft).ne.itrue)then - totalmemory=currentCohort%leafmemory+currentCohort%sapwmemory+currentCohort%structmemory - store_c_transfer_frac = min((EDPftvarcon_inst%phenflush_fraction(ipft)* & - totalmemory)/store_c, (1.0_r8-carbon_store_buffer)) - endif - - else - store_c_transfer_frac = 0.0_r8 - end if - - ! This call will request that storage carbon will be transferred to - ! leaf tissues. It is specified as a fraction of the available storage - if(prt_params%woody(ipft) == itrue) then - - call PRTPhenologyFlush(currentCohort%prt, ipft, leaf_organ, store_c_transfer_frac) - currentCohort%leafmemory = 0.0_r8 - - else - - ! Check that the stem drop fraction is set to non-zero amount otherwise flush all carbon store to leaves - if (stem_drop_fraction .gt. 0.0_r8) then - - call PRTPhenologyFlush(currentCohort%prt, ipft, leaf_organ, & - store_c_transfer_frac*currentCohort%leafmemory/totalmemory) - - call PRTPhenologyFlush(currentCohort%prt, ipft, sapw_organ, & - store_c_transfer_frac*currentCohort%sapwmemory/totalmemory) - - call PRTPhenologyFlush(currentCohort%prt, ipft, struct_organ, & - store_c_transfer_frac*currentCohort%structmemory/totalmemory) - - else - - call PRTPhenologyFlush(currentCohort%prt, ipft, leaf_organ, & - store_c_transfer_frac) - - end if - - currentCohort%leafmemory = 0.0_r8 - currentCohort%structmemory = 0.0_r8 - currentCohort%sapwmemory = 0.0_r8 - - endif - endif !pft phenology - endif ! growing season - - !COLD LEAF OFF - if (currentSite%cstatus == phen_cstat_nevercold .or. & - currentSite%cstatus == phen_cstat_iscold) then ! past leaf drop day? Leaves still on tree? - if (currentCohort%status_coh == leaves_on) then ! leaves have not dropped - - ! leaf off occur on individuals bigger than specific size for grass - if (currentCohort%dbh > EDPftvarcon_inst%phen_cold_size_threshold(ipft) & - .or. prt_params%woody(ipft)==itrue) then - - ! This sets the cohort to the "leaves off" flag - currentCohort%status_coh = leaves_off - - ! Remember what the lai was (leaf mass actually) was for next year - ! the same amount back on in the spring... - - currentCohort%leafmemory = leaf_c - - ! Drop Leaves (this routine will update the leaf state variables, - ! for carbon and any other element that are prognostic. It will - ! also track the turnover masses that will be sent to litter later on) - - call PRTDeciduousTurnover(currentCohort%prt,ipft, & - leaf_organ, leaf_drop_fraction) - - if(prt_params%woody(ipft).ne.itrue)then - - currentCohort%sapwmemory = sapw_c * stem_drop_fraction - - currentCohort%structmemory = struct_c * stem_drop_fraction - - call PRTDeciduousTurnover(currentCohort%prt,ipft, & - sapw_organ, stem_drop_fraction) - - call PRTDeciduousTurnover(currentCohort%prt,ipft, & - struct_organ, stem_drop_fraction) - - endif ! woody plant check - endif ! individual dbh size check - endif !leaf status - endif !currentSite status - endif !season_decid - - ! DROUGHT LEAF ON - ! Site level flag indicates it is no longer in drought condition - ! deciduous plants can flush - - if (prt_params%stress_decid(ipft) == itrue )then - - if (currentSite%dstatus == phen_dstat_moiston .or. & - currentSite%dstatus == phen_dstat_timeon )then - - ! we have just moved to leaves being on . - if (currentCohort%status_coh == leaves_off)then - - !is it the leaf-on day? Are the leaves currently off? - - currentCohort%status_coh = leaves_on ! Leaves are on, so change status to - ! stop flow of carbon out of bstore. - - if(store_c>nearzero) then - - store_c_transfer_frac = & - min((EDPftvarcon_inst%phenflush_fraction(ipft)*currentCohort%leafmemory)/store_c, & - (1.0_r8-carbon_store_buffer)) - - if(prt_params%woody(ipft).ne.itrue)then - - totalmemory=currentCohort%leafmemory+currentCohort%sapwmemory+currentCohort%structmemory - store_c_transfer_frac = min(EDPftvarcon_inst%phenflush_fraction(ipft)*totalmemory/store_c, & - (1.0_r8-carbon_store_buffer)) + stem_drop_fraction = EDPftvarcon_inst%phen_stem_drop_fraction(ipft) - endif - else - store_c_transfer_frac = 0.0_r8 - endif + ! MLO. Sanity check. If this is a deciduous PFT, then leaf status ought to + ! be on or off. If it is something else, stop the run. + if ( prt_params%season_decid(ipft) == itrue .or. & + prt_params%stress_decid(ipft) == itrue ) then + select case(currentCohort%status_coh) + case (leaves_off,leaves_on) + continue + case default + write(fates_log(),'(a)') '---------------------------------------------' + write(fates_log(),'(a)') ' Odd leaf status - Leaves are not off or on. ' + write(fates_log(),'(a)') '---------------------------------------------' + write(fates_log(),'(a,1x,i5)' ) ' PFT = ',ipft + write(fates_log(),'(a,1x,i5)' ) ' Season deciduous = ',prt_params%season_decid(ipft) + write(fates_log(),'(a,1x,i5)' ) ' Stress deciduous = ',prt_params%stress_decid(ipft) + write(fates_log(),'(a,1x,i5)' ) ' Site status = ',currentSite%cstatus + write(fates_log(),'(a,1x,i5)' ) ' Cohort status = ',currentCohort%status_coh + write(fates_log(),'(a,1x,f12.5)') ' DBH = ',currentCohort%dbh + write(fates_log(),'(a,1x,f12.5)') ' Leaf_c = ',leaf_c + write(fates_log(),'(a,1x,f12.5)') ' Store_c = ',store_c + write(fates_log(),'(a,1x,f12.5)') ' Fnrt_c = ',fnrt_c + write(fates_log(),'(a,1x,f12.5)') ' Sapw_c = ',sapw_c + write(fates_log(),'(a,1x,f12.5)') ' Struct_c = ',struct_c + write(fates_log(),'(a)') '---------------------------------------------' + write(fates_log(),'(a)') '' + write(fates_log(),'(a)') '' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end select + end if + + + ! MLO. To avoid duplicating code for drought and cold deciduous PFTs, we first + ! check whether or not it's time to flush or time to shed leaves, then + ! use a common code for flushing or shedding leaves. + if (prt_params%season_decid(ipft) == itrue) then ! Cold deciduous + ! A. Is this the time for COLD LEAVES to switch to ON? + is_flushing_time = ( currentSite%cstatus == phen_cstat_notcold .and. & ! We just moved to leaves being on + currentCohort%status_coh == leaves_off ) ! Leaves are currently off + ! B. Is this the time for COLD LEAVES to switch to OFF? + is_shedding_time = ( currentSite%cstatus == phen_cstat_nevercold .or. & ! Past leaf drop day or... + currentSite%cstatus == phen_cstat_iscold ) .and. & ! Too cold? + currentCohort%status_coh == leaves_on .and. & ! Leaves have not dropped yet + ( currentCohort%dbh > EDPftvarcon_inst%phen_cold_size_threshold(ipft) .or. & ! Grasses are big enough or... + prt_params%woody(ipft) == itrue ) ! this is a woody PFT. + + elseif (prt_params%stress_decid(ipft) == itrue ) then ! Drought deciduous + ! A. Is this the time for DROUGHT LEAVES to switch to ON? + is_flushing_time = ( currentSite%dstatus(ipft) == phen_dstat_moiston .or. & ! Conditions are sufficiently moist + currentSite%dstatus(ipft) == phen_dstat_timeon ) .and. & ! Time to for leaf flushing + currentCohort%status_coh == leaves_off + ! B. Is this the time for DROUGHT LEAVES to switch to OFF? + is_shedding_time = ( currentSite%dstatus(ipft) == phen_dstat_moistoff .or. & ! Too dry or... + currentSite%dstatus(ipft) == phen_dstat_timeoff ) .and. & ! Past leaf drop day. + currentCohort%status_coh == leaves_on ! ! Leaves have not dropped yet + else + ! This PFT is not deciduous. + is_flushing_time = .false. + is_shedding_time = .false. + end if ! (prt_params%season_decid(ipft) == itrue) + + + ! A. This is time to switch to (COLD or DROUGHT) LEAF ON + flush_block: if (is_flushing_time) then + currentCohort%status_coh = leaves_on ! Leaves are on, so change status to + ! stop flow of carbon out of bstore. + + ! Transfer carbon from storage to living tissues (only if there is any carbon in storage) + transf_block: if ( store_c > nearzero ) then + ! Find the total deficit. We no longer distinguish between woody and non-woody + ! PFTs here (as sapwmemory is be the same as sapw_c if this is a woody tissue). + leaf_deficit = max(0.0_r8, currentCohort%leafmemory - leaf_c ) + fnrt_deficit = max(0.0_r8, currentCohort%fnrtmemory - fnrt_c ) + sapw_deficit = max(0.0_r8, currentCohort%sapwmemory - sapw_c ) + struct_deficit = max(0.0_r8, currentCohort%structmemory - struct_c) + total_deficit = leaf_deficit + fnrt_deficit + sapw_deficit + struct_deficit + + ! Flush either the amount required from the memory, or -most- of the storage pool + ! RF: added a criterion to stop the entire store pool emptying and triggering termination mortality + ! n.b. this might not be necessary if we adopted a more gradual approach to leaf flushing... + store_c_transfer_frac = min( EDPftvarcon_inst%phenflush_fraction(ipft) * total_deficit / store_c, & + 1.0_r8 - carbon_store_buffer ) + + ! This call will request that storage carbon will be transferred to + ! each tissue. It is specified as a fraction of the available storage + ! MLO - Just to be safe, skip steps in the unlikely case total_deficit is zero, to avoid FPE errors. + if (total_deficit > nearzero) then + call PRTPhenologyFlush(currentCohort%prt, ipft, leaf_organ, & + store_c_transfer_frac*leaf_deficit/total_deficit) + call PRTPhenologyFlush(currentCohort%prt, ipft, fnrt_organ, & + store_c_transfer_frac*fnrt_deficit/total_deficit) - ! This call will request that storage carbon will be transferred to - ! leaf tissues. It is specified as a fraction of the available storage - if(prt_params%woody(ipft) == itrue) then - - call PRTPhenologyFlush(currentCohort%prt, ipft, & - leaf_organ, store_c_transfer_frac) - - currentCohort%leafmemory = 0.0_r8 - - else - - ! Check that the stem drop fraction is set to non-zero amount otherwise flush all carbon store to leaves - if (stem_drop_fraction .gt. 0.0_r8) then - - call PRTPhenologyFlush(currentCohort%prt, ipft, leaf_organ, & - store_c_transfer_frac*currentCohort%leafmemory/totalmemory) - - call PRTPhenologyFlush(currentCohort%prt, ipft, sapw_organ, & - store_c_transfer_frac*currentCohort%sapwmemory/totalmemory) - - call PRTPhenologyFlush(currentCohort%prt, ipft, struct_organ, & - store_c_transfer_frac*currentCohort%structmemory/totalmemory) - - else - - call PRTPhenologyFlush(currentCohort%prt, ipft, leaf_organ, & - store_c_transfer_frac) - - end if - - currentCohort%leafmemory = 0.0_r8 - currentCohort%structmemory = 0.0_r8 - currentCohort%sapwmemory = 0.0_r8 - - endif ! woody plant check - endif !currentCohort status again? - endif !currentSite status - - !DROUGHT LEAF OFF - if (currentSite%dstatus == phen_dstat_moistoff .or. & - currentSite%dstatus == phen_dstat_timeoff) then - - if (currentCohort%status_coh == leaves_on) then ! leaves have not dropped - - ! This sets the cohort to the "leaves off" flag - currentCohort%status_coh = leaves_off - - ! Remember what the lai (leaf mass actually) was for next year - currentCohort%leafmemory = leaf_c - - call PRTDeciduousTurnover(currentCohort%prt,ipft, & - leaf_organ, leaf_drop_fraction) - - if(prt_params%woody(ipft).ne.itrue)then - - currentCohort%sapwmemory = sapw_c * stem_drop_fraction - currentCohort%structmemory = struct_c * stem_drop_fraction - - call PRTDeciduousTurnover(currentCohort%prt,ipft, & - sapw_organ, stem_drop_fraction) - - call PRTDeciduousTurnover(currentCohort%prt,ipft, & - struct_organ, stem_drop_fraction) - endif + if ( nint(prt_params%woody(ipft)) == ifalse ) then + call PRTPhenologyFlush(currentCohort%prt, ipft, sapw_organ, & + store_c_transfer_frac*sapw_deficit/total_deficit) + call PRTPhenologyFlush(currentCohort%prt, ipft, struct_organ, & + store_c_transfer_frac*struct_deficit/total_deficit) + end if + end if - endif - endif !status - endif !drought dec. + ! Reset memory to ensure we don't add more carbon than needed + currentCohort%leafmemory = 0.0_r8 + currentCohort%fnrtmemory = 0.0_r8 + currentCohort%sapwmemory = 0.0_r8 + currentCohort%structmemory = 0.0_r8 + else + ! Not enough carbon to flush any living tissue. + store_c_transfer_frac = 0.0_r8 + end if transf_block + end if flush_block + + + + ! B. This is time to switch to (COLD or DROUGHT) LEAF OFF + shed_block: if (is_shedding_time) then + ! This sets the cohort to the "leaves off" flag + currentCohort%status_coh = leaves_off + + ! Set memory for all tissues as the current biomass + currentCohort%leafmemory = leaf_c + currentCohort%fnrtmemory = fnrt_c + currentCohort%sapwmemory = sapw_c + currentCohort%structmemory = struct_c + + ! Drop leaves + call PRTDeciduousTurnover(currentCohort%prt,ipft, leaf_organ, leaf_drop_fraction) + + ! For now we don't drop fine roots. They may decay during the leaf off period. We may revisit this + ! in case we have evidence that deciduous PFTs actively shed fine roots too. + + ! If plant is not woody, shed sapwood and heartwood (they may have a minimum amount of woody tissues for + ! running plant hydraulics, and it makes sense to shed them along with leaves when they should be off). + ! MLO - stem_drop_fraction is a PFT parameter, do we really need this check for woody/non-woody PFT? + if ( nint(prt_params%woody(ipft)) == ifalse ) then + ! Shed sapwood and heartwood. + call PRTDeciduousTurnover(currentCohort%prt,ipft,sapw_organ , stem_drop_fraction) + call PRTDeciduousTurnover(currentCohort%prt,ipft,struct_organ, stem_drop_fraction) + end if + end if shed_block - if(debug) call currentCohort%prt%CheckMassConservation(ipft,1) + if(debug) call currentCohort%prt%CheckMassConservation(ipft,1) - currentCohort => currentCohort%shorter - enddo !currentCohort + currentCohort => currentCohort%shorter + end do cohort_loop - currentPatch => currentPatch%younger + currentPatch => currentPatch%younger - enddo !currentPatch + end do patch_loop end subroutine phenology_leafonoff @@ -1519,7 +1503,7 @@ subroutine SeedGermination( litt, cold_stat, drought_stat ) ! !ARGUMENTS type(litter_type) :: litt integer, intent(in) :: cold_stat ! Is the site in cold leaf-off status? - integer, intent(in) :: drought_stat ! Is the site in drought leaf-off status? + integer, dimension(numpft), intent(in) :: drought_stat ! Is the site in drought leaf-off status? ! ! !LOCAL VARIABLES: integer :: pft @@ -1551,7 +1535,7 @@ subroutine SeedGermination( litt, cold_stat, drought_stat ) litt%seed_germ_in(pft) = 0.0_r8 endif if ((prt_params%stress_decid(pft) == itrue ) .and. & - (any(drought_stat == [phen_dstat_timeoff,phen_dstat_moistoff]))) then + (any(drought_stat(pft) == [phen_dstat_timeoff,phen_dstat_moistoff]))) then litt%seed_germ_in(pft) = 0.0_r8 end if @@ -1640,9 +1624,9 @@ subroutine recruitment( currentSite, currentPatch, bc_in ) ! Default assumption is that leaves are on cohortstatus = leaves_on - temp_cohort%leafmemory = 0.0_r8 - temp_cohort%sapwmemory = 0.0_r8 - temp_cohort%structmemory = 0.0_r8 + temp_cohort%leafmemory = 0.0_r8 + temp_cohort%sapwmemory = 0.0_r8 + temp_cohort%structmemory = 0.0_r8 ! But if the plant is seasonally (cold) deciduous, and the site status is flagged @@ -1666,7 +1650,7 @@ subroutine recruitment( currentSite, currentPatch, bc_in ) ! "in a drought", then likewise, set the cohort's status to leaves_off, and remember leaf ! biomass if ((prt_params%stress_decid(ft) == itrue) .and. & - (any(currentSite%dstatus == [phen_dstat_timeoff,phen_dstat_moistoff]))) then + (any(currentSite%dstatus(ft) == [phen_dstat_timeoff,phen_dstat_moistoff]))) then temp_cohort%leafmemory = c_leaf c_leaf = 0.0_r8 @@ -1854,8 +1838,8 @@ subroutine recruitment( currentSite, currentPatch, bc_in ) ! This initializes the cohort call create_cohort(currentSite,currentPatch, temp_cohort%pft, temp_cohort%n, & temp_cohort%hite, temp_cohort%coage, temp_cohort%dbh, prt, & - temp_cohort%leafmemory, temp_cohort%sapwmemory, temp_cohort%structmemory, & - cohortstatus, recruitstatus, & + temp_cohort%leafmemory, temp_cohort%fnrtmemory, temp_cohort%sapwmemory, & + temp_cohort%structmemory, cohortstatus, recruitstatus, & temp_cohort%canopy_trim, currentPatch%NCL_p, currentSite%spread, bc_in) ! Note that if hydraulics is on, the number of cohorts may had diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index cafd59f3c1..279c1236e1 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -170,16 +170,22 @@ subroutine zero_site( site_in ) ! PHENOLOGY site_in%cstatus = fates_unset_int ! are leaves in this pixel on or off? - site_in%dstatus = fates_unset_int + site_in%dstatus(:) = fates_unset_int site_in%grow_deg_days = nan ! growing degree days site_in%snow_depth = nan site_in%nchilldays = fates_unset_int site_in%ncolddays = fates_unset_int - site_in%cleafondate = fates_unset_int ! doy of leaf on - site_in%cleafoffdate = fates_unset_int ! doy of leaf off - site_in%dleafondate = fates_unset_int ! doy of leaf on drought - site_in%dleafoffdate = fates_unset_int ! doy of leaf on drought - site_in%water_memory(:) = nan + site_in%cleafondate = fates_unset_int ! doy of leaf on (cold) + site_in%cleafoffdate = fates_unset_int ! doy of leaf off (cold) + site_in%dleafondate(:) = fates_unset_int ! doy of leaf on (drought) + site_in%dleafoffdate(:) = fates_unset_int ! doy of leaf off (drought) + site_in%cndaysleafon = fates_unset_int ! days since leaf on (cold) + site_in%cndaysleafoff = fates_unset_int ! days since leaf off (cold) + site_in%dndaysleafon(:) = fates_unset_int ! days since leaf on (drought) + site_in%dndaysleafoff(:) = fates_unset_int ! days since leaf off (drought) + + site_in%liqvol_memory(:,:) = nan + site_in%smp_memory(:,:) = nan site_in%vegtemp_memory(:) = nan ! record of last 10 days temperature for senescence model. @@ -249,11 +255,16 @@ subroutine set_site_properties( nsites, sites,bc_in ) real(r8) :: GDD integer :: dstat ! drought status phenology flag real(r8) :: acc_NI - real(r8) :: watermem + real(r8) :: liqvolmem + real(r8) :: smpmem integer :: cleafon ! DOY for cold-decid leaf-on, initial guess integer :: cleafoff ! DOY for cold-decid leaf-off, initial guess integer :: dleafoff ! DOY for drought-decid leaf-off, initial guess integer :: dleafon ! DOY for drought-decid leaf-on, initial guess + integer :: cndleafon ! days since leaf on (cold), initial guess + integer :: cndleafoff ! days since leaf off (cold), initial guess + integer :: dndleafon ! days since leaf on (drought), initial guess + integer :: dndleafoff ! days since leaf off (drought), initial guess integer :: ft ! PFT loop !---------------------------------------------------------------------- @@ -267,13 +278,18 @@ subroutine set_site_properties( nsites, sites,bc_in ) GDD = 30.0_r8 cleafon = 100 - cleafoff = 300 + cleafoff = 300 + cndleafon = 0 + cndleafoff = 0 cstat = phen_cstat_notcold ! Leaves are on acc_NI = 0.0_r8 dstat = phen_dstat_moiston ! Leaves are on - dleafoff = 300 dleafon = 100 - watermem = 0.5_r8 + dleafoff = 300 + dndleafon = 0 + dndleafoff = 0 + liqvolmem = 0.5_r8 + smpmem = 0._r8 do s = 1,nsites sites(s)%nchilldays = 0 @@ -284,15 +300,20 @@ subroutine set_site_properties( nsites, sites,bc_in ) sites(s)%cleafondate = cleafon sites(s)%cleafoffdate = cleafoff - sites(s)%dleafoffdate = dleafoff - sites(s)%dleafondate = dleafon + sites(s)%cndaysleafon = cndleafon + sites(s)%cndaysleafoff = cndleafoff + sites(s)%dleafoffdate(1:numpft) = dleafoff + sites(s)%dleafondate(1:numpft) = dleafon + sites(s)%dndaysleafon(1:numpft) = dndleafon + sites(s)%dndaysleafoff(1:numpft) = dndleafoff sites(s)%grow_deg_days = GDD - sites(s)%water_memory(1:numWaterMem) = watermem + sites(s)%liqvol_memory(1:numWaterMem,1:numpft) = liqvolmem + sites(s)%smp_memory(1:numWaterMem,1:numpft) = smpmem sites(s)%vegtemp_memory(1:num_vegtemp_mem) = 0._r8 sites(s)%cstatus = cstat - sites(s)%dstatus = dstat + sites(s)%dstatus(1:numpft) = dstat sites(s)%acc_NI = acc_NI sites(s)%NF = 0.0_r8 @@ -561,6 +582,7 @@ subroutine init_cohorts( site_in, patch_in, bc_in) call bstore_allom(temp_cohort%dbh, pft, temp_cohort%canopy_trim, c_store) temp_cohort%leafmemory = 0._r8 + temp_cohort%fnrtmemory = 0._r8 temp_cohort%sapwmemory = 0._r8 temp_cohort%structmemory = 0._r8 cstatus = leaves_on @@ -569,22 +591,30 @@ subroutine init_cohorts( site_in, patch_in, bc_in) if( prt_params%season_decid(pft) == itrue .and. & any(site_in%cstatus == [phen_cstat_nevercold,phen_cstat_iscold])) then - - temp_cohort%leafmemory = c_leaf - temp_cohort%sapwmemory = c_sapw * stem_drop_fraction - temp_cohort%structmemory = c_struct * stem_drop_fraction + ! MLO update: sapwmemory and structmemory used to be deficit, despite the + ! name. The code has been updated elsewhere to use these + ! variables as memory variables. + temp_cohort%leafmemory = c_leaf ! Leaf biomass memory + temp_cohort%fnrtmemory = c_fnrt ! Fine root memory + temp_cohort%sapwmemory = c_sapw ! Sapwood memory + temp_cohort%structmemory = c_struct ! Heartwood memory c_leaf = 0._r8 + !c_fnrt = c_fnrt... Do not change fine root, if leaves are off + ! it may steadily decline. c_sapw = (1.0_r8-stem_drop_fraction) * c_sapw c_struct = (1.0_r8-stem_drop_fraction) * c_struct cstatus = leaves_off endif if ( prt_params%stress_decid(pft) == itrue .and. & - any(site_in%dstatus == [phen_dstat_timeoff,phen_dstat_moistoff])) then - temp_cohort%leafmemory = c_leaf - temp_cohort%sapwmemory = c_sapw * stem_drop_fraction - temp_cohort%structmemory = c_struct * stem_drop_fraction + any(site_in%dstatus(pft) == [phen_dstat_timeoff,phen_dstat_moistoff])) then + temp_cohort%leafmemory = c_leaf ! Leaf biomass memory + temp_cohort%fnrtmemory = c_fnrt ! Fine root memory + temp_cohort%sapwmemory = c_sapw ! Sapwood memory + temp_cohort%structmemory = c_struct ! Heartwood memory c_leaf = 0._r8 + !c_fnrt = c_fnrt... Do not change fine root, if leaves are off + ! it may steadily decline. c_sapw = (1.0_r8-stem_drop_fraction) * c_sapw c_struct = (1.0_r8-stem_drop_fraction) * c_struct cstatus = leaves_off @@ -664,8 +694,8 @@ 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%leafmemory, & - temp_cohort%sapwmemory, temp_cohort%structmemory, cstatus, rstatus, & - temp_cohort%canopy_trim, 1, site_in%spread, bc_in) + temp_cohort%fnrtmemory, temp_cohort%sapwmemory, temp_cohort%structmemory, & + cstatus, rstatus, temp_cohort%canopy_trim, 1, site_in%spread, bc_in) deallocate(temp_cohort) ! get rid of temporary cohort diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index 5deb2c5084..cac567d988 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -402,7 +402,7 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) ! Conduct Maintenance Turnover (parteh) if(debug) call currentCohort%prt%CheckMassConservation(ft,3) - if(any(currentSite%dstatus == [phen_dstat_moiston,phen_dstat_timeon])) then + if(any(currentSite%dstatus(ft) == [phen_dstat_moiston,phen_dstat_timeon])) then is_drought = .false. else is_drought = .true. diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 0f82373fa9..6c4c27c33c 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 @@ -90,6 +90,14 @@ module EDTypesMod ! its leaves and should not be trying to allocate ! towards any growth. + + integer, parameter, public :: phen_ref_smp = 2 ! Flag specifying that a drought deciduous plant + ! uses a soil matric potential threshold to + ! decide when to shed or flush leaves + integer, parameter, public :: phen_ref_liqvol = 1 ! Flag specifying that a drought deciduous plant + ! uses a soil moisture (liquid water volume) threshold to + ! decide when to shed or flush leaves + ! Flag to turn on/off salinity effects on the effective "btran" ! btran stress function. @@ -217,6 +225,7 @@ module EDTypesMod real(r8) :: hite ! height: meters integer :: indexnumber ! unique number for each cohort. (within clump?) real(r8) :: leafmemory ! target leaf biomass- set from previous year: kGC per indiv + real(r8) :: fnrtmemory ! target fine-root biomass- set from previous year: kGC per indiv real(r8) :: sapwmemory ! target sapwood biomass- set from previous year: kGC per indiv real(r8) :: structmemory ! target structural biomass- set from previous year: kGC per indiv integer :: canopy_layer ! canopy status of cohort (1 = canopy, 2 = understorey, etc.) @@ -713,7 +722,7 @@ module EDTypesMod ! 400 days, leaves are dropped and flagged as non-cold region ! 1 = this site is in a cold-state where leaves should have fallen ! 2 = this site is in a warm-state where leaves are allowed to flush - integer :: dstatus ! are leaves in this pixel on or off for drought decid + integer :: dstatus(maxpft) ! are leaves in this pixel on or off for drought decid ! 0 = leaves off due to time exceedance ! 1 = leaves off due to moisture avail ! 2 = leaves on due to moisture avail @@ -723,10 +732,15 @@ module EDTypesMod real(r8) :: vegtemp_memory(num_vegtemp_mem) ! record of last 10 days temperature for senescence model. deg C integer :: cleafondate ! model date (day integer) of leaf on (cold):- integer :: cleafoffdate ! model date (day integer) of leaf off (cold):- - integer :: dleafondate ! model date (day integer) of leaf on drought:- - integer :: dleafoffdate ! model date (day integer) of leaf off drought:- + integer :: cndaysleafon ! number of days since leaf on period started (cold) + integer :: cndaysleafoff ! number of days since leaf off period started (cold) + integer :: dleafondate(maxpft) ! model date (day integer) of leaf on drought:- + integer :: dleafoffdate(maxpft) ! model date (day integer) of leaf off drought:- + integer :: dndaysleafon(maxpft) ! number of days since leaf on period started (drought) + integer :: dndaysleafoff(maxpft) ! number of days since leaf off period started (drought) - real(r8) :: water_memory(numWaterMem) ! last 10 days of soil moisture memory... + real(r8) :: liqvol_memory(numWaterMem,maxpft) ! last 10 days of soil liquid water volume (drought phenology) + real(r8) :: smp_memory(numWaterMem,maxpft) ! last 10 days of soil matric potential (drought phenology) ! FIRE @@ -1026,6 +1040,7 @@ subroutine dump_cohort(ccohort) write(fates_log(),*) 'co%hite = ', ccohort%hite write(fates_log(),*) 'co%coage = ', ccohort%coage write(fates_log(),*) 'co%leafmemory = ', ccohort%leafmemory + write(fates_log(),*) 'co%fnrtmemory = ', ccohort%fnrtmemory write(fates_log(),*) 'co%sapwmemory = ', ccohort%sapwmemory write(fates_log(),*) 'co%structmemory = ', ccohort%structmemory diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index de104f8179..2430ecc744 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -341,15 +341,11 @@ module FatesHistoryInterfaceMod integer :: ih_h2oveg_hydro_err_si integer :: ih_site_cstatus_si - integer :: ih_site_dstatus_si integer :: ih_gdd_si integer :: ih_site_nchilldays_si integer :: ih_site_ncolddays_si integer :: ih_cleafoff_si integer :: ih_cleafon_si - integer :: ih_dleafoff_si - integer :: ih_dleafon_si - integer :: ih_meanliqvol_si integer :: ih_nesterov_fire_danger_si integer :: ih_fire_nignitions_si @@ -516,6 +512,12 @@ module FatesHistoryInterfaceMod integer :: ih_canopycrownarea_si_pft integer :: ih_gpp_si_pft integer :: ih_npp_si_pft + integer :: ih_site_dstatus_si_pft + integer :: ih_dleafoff_si_pft + integer :: ih_dleafon_si_pft + integer :: ih_meanliqvol_si_pft + integer :: ih_meansmp_si_pft + ! indices to (site x patch-age) variables integer :: ih_area_si_age @@ -2022,15 +2024,16 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_mortality_canopy_si_scag => this%hvars(ih_mortality_canopy_si_scag)%r82d, & hio_mortality_understory_si_scag => this%hvars(ih_mortality_understory_si_scag)%r82d, & hio_site_cstatus_si => this%hvars(ih_site_cstatus_si)%r81d, & - hio_site_dstatus_si => this%hvars(ih_site_dstatus_si)%r81d, & hio_gdd_si => this%hvars(ih_gdd_si)%r81d, & hio_site_ncolddays_si => this%hvars(ih_site_ncolddays_si)%r81d, & hio_site_nchilldays_si => this%hvars(ih_site_nchilldays_si)%r81d, & hio_cleafoff_si => this%hvars(ih_cleafoff_si)%r81d, & hio_cleafon_si => this%hvars(ih_cleafon_si)%r81d, & - hio_dleafoff_si => this%hvars(ih_dleafoff_si)%r81d, & - hio_dleafon_si => this%hvars(ih_dleafoff_si)%r81d, & - hio_meanliqvol_si => this%hvars(ih_meanliqvol_si)%r81d, & + hio_site_dstatus_si_pft => this%hvars(ih_site_dstatus_si_pft)%r82d, & + hio_dleafoff_si_pft => this%hvars(ih_dleafoff_si_pft)%r82d, & + hio_dleafon_si_pft => this%hvars(ih_dleafon_si_pft)%r82d, & + hio_meanliqvol_si_pft => this%hvars(ih_meanliqvol_si_pft)%r82d, & + hio_meansmp_si_pft => this%hvars(ih_meansmp_si_pft)%r82d, & hio_cbal_err_fates_si => this%hvars(ih_cbal_err_fates_si)%r81d, & hio_err_fates_si => this%hvars(ih_err_fates_si)%r82d ) @@ -2074,9 +2077,8 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_canopy_spread_si(io_si) = sites(s)%spread - ! Update the site statuses (stati?) + ! Update the site status for cold deciduous (drought-deciduous is now PFT dependent) hio_site_cstatus_si(io_si) = real(sites(s)%cstatus,r8) - hio_site_dstatus_si(io_si) = real(sites(s)%dstatus,r8) !count number of days for leaves off hio_site_nchilldays_si(io_si) = real(sites(s)%nchilldays,r8) @@ -2084,15 +2086,22 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_gdd_si(io_si) = sites(s)%grow_deg_days - hio_cleafoff_si(io_si) = real(model_day_int - sites(s)%cleafoffdate,r8) - hio_cleafon_si(io_si) = real(model_day_int - sites(s)%cleafondate,r8) - hio_dleafoff_si(io_si) = real(model_day_int - sites(s)%dleafoffdate,r8) - hio_dleafon_si(io_si) = real(model_day_int - sites(s)%dleafondate,r8) - - if(model_day_int>numWaterMem)then - hio_meanliqvol_si(io_si) = & - sum(sites(s)%water_memory(1:numWaterMem))/real(numWaterMem,r8) - end if + hio_cleafoff_si(io_si) = real(sites(s)%cndaysleafon ,r8) + hio_cleafon_si(io_si) = real(sites(s)%cndaysleafoff,r8) + + ! Update drought deciduous information (now separated by PFT). + do i_pft = 1,numpft + hio_site_dstatus_si_pft(io_si,i_pft) = real(sites(s)%dstatus(i_pft),r8) + hio_dleafoff_si_pft(io_si,i_pft) = real(sites(s)%dndaysleafon (i_pft),r8) + hio_dleafon_si_pft(io_si,i_pft) = real(sites(s)%dndaysleafoff(i_pft),r8) + + if(model_day_int>numWaterMem)then + hio_meanliqvol_si_pft(io_si,i_pft) = & + sum(sites(s)%liqvol_memory(1:numWaterMem,i_pft))/real(numWaterMem,r8) + hio_meansmp_si_pft(io_si,i_pft) = & + sum(sites(s)%smp_memory(1:numWaterMem,i_pft))/real(numWaterMem,r8) + end if + end do ! track total wood product accumulation at the site level hio_woodproduct_si(io_si) = sites(s)%resources_management%trunk_product_site & @@ -4276,12 +4285,6 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_site_cstatus_si ) - call this%set_history_var(vname='SITE_DROUGHT_STATUS', units='0,1,2,3', & - long='Site level drought status, <2 too dry for leaves, >=2 not-too dry', & - use_default='active', & - avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, upfreq=1, & - ivar=ivar, initialize=initialize_variables, index = ih_site_dstatus_si) - call this%set_history_var(vname='SITE_GDD', units='degC', & long='site level growing degree days', & use_default='active', & @@ -4312,29 +4315,42 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_cleafon_si) + call this%set_history_var(vname='CANOPY_SPREAD', units='0-1', & + long='Scaling factor between tree basal area and canopy area', & + use_default='active', & + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_canopy_spread_si) + + !MLO - Moved these to here because they are now PFT variables. + call this%set_history_var(vname='SITE_DROUGHT_STATUS', units='0,1,2,3', & + long='Site level drought status by PFT, <2 too dry for leaves, >=2 not-too dry', & + use_default='active', & + avgflag='A', vtype=site_pft_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_site_dstatus_si_pft) + call this%set_history_var(vname='SITE_DAYSINCE_DROUGHTLEAFOFF', units='days', & - long='site level days elapsed since drought leaf drop', & + long='site level days elapsed since drought leaf drop by PFT', & use_default='active', & - avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, upfreq=1, & - ivar=ivar, initialize=initialize_variables, index = ih_dleafoff_si) + avgflag='A', vtype=site_pft_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_dleafoff_si_pft) call this%set_history_var(vname='SITE_DAYSINCE_DROUGHTLEAFON', units='days', & - long='site level days elapsed since drought leaf flush', & + long='site level days elapsed since drought leaf flush by PFT', & use_default='active', & - avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, upfreq=1, & - ivar=ivar, initialize=initialize_variables, index = ih_dleafon_si) + avgflag='A', vtype=site_pft_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_dleafon_si_pft) call this%set_history_var(vname='SITE_MEANLIQVOL_DROUGHTPHEN', units='m3/m3', & - long='site level mean liquid water volume for drought phen', & + long='site level mean liquid water volume for drought phen by PFT', & use_default='active', & - avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, upfreq=1, & - ivar=ivar, initialize=initialize_variables, index = ih_meanliqvol_si) + avgflag='A', vtype=site_pft_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_meanliqvol_si_pft) - call this%set_history_var(vname='CANOPY_SPREAD', units='0-1', & - long='Scaling factor between tree basal area and canopy area', & + call this%set_history_var(vname='SITE_MEANSMP_DROUGHTPHEN', units='mm', & + long='site level mean soil matric potential for drought phen by PFT', & use_default='active', & - avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & - ivar=ivar, initialize=initialize_variables, index = ih_canopy_spread_si) + avgflag='A', vtype=site_pft_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_meansmp_si_pft) call this%set_history_var(vname='PFTbiomass', units='gC/m2', & long='total PFT level biomass', use_default='active', & diff --git a/main/FatesInventoryInitMod.F90 b/main/FatesInventoryInitMod.F90 index 074c2cb15a..2c3054c779 100644 --- a/main/FatesInventoryInitMod.F90 +++ b/main/FatesInventoryInitMod.F90 @@ -1038,31 +1038,44 @@ subroutine set_inventory_edcohort_type1(csite,bc_in,css_file_unit,npatches, & call bstore_allom(temp_cohort%dbh, temp_cohort%pft, temp_cohort%canopy_trim, c_store) temp_cohort%leafmemory = 0._r8 + temp_cohort%fnrtmemory = 0._r8 temp_cohort%sapwmemory = 0._r8 - temp_cohort%structmemory = 0._r8 + temp_cohort%structmemory = 0._r8 cstatus = leaves_on 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 - temp_cohort%leafmemory = c_leaf - temp_cohort%sapwmemory = c_sapw * stem_drop_fraction - temp_cohort%structmemory = c_struct * stem_drop_fraction + ! MLO update: sapwmemory and structmemory used to be deficit, despite the + ! name. The code has been updated elsewhere to use these + ! variables as memory variables. + temp_cohort%leafmemory = c_leaf ! Leaf biomass memory + temp_cohort%fnrtmemory = c_fnrt ! Fine root memory + temp_cohort%sapwmemory = c_sapw ! Sapwood memory + temp_cohort%structmemory = c_struct ! Heartwood memory c_leaf = 0._r8 - c_sapw = (1._r8 - stem_drop_fraction) * c_sapw - c_struct = (1._r8 - stem_drop_fraction) * c_struct + !c_fnrt = c_fnrt... Do not change fine root, if leaves are off + ! fine roots may steadily decline depending on the PFT. + c_sapw = (1._r8 - stem_drop_fraction) * c_sapw + c_struct = (1._r8 - stem_drop_fraction) * c_struct cstatus = leaves_off endif if ( prt_params%stress_decid(temp_cohort%pft) == itrue .and. & - any(csite%dstatus == [phen_dstat_timeoff,phen_dstat_moistoff])) then - temp_cohort%leafmemory = c_leaf - temp_cohort%sapwmemory = c_sapw * stem_drop_fraction - temp_cohort%structmemory = c_struct * stem_drop_fraction + any(csite%dstatus(temp_cohort%pft) == [phen_dstat_timeoff,phen_dstat_moistoff])) then + ! MLO update: sapwmemory and structmemory used to be deficit, despite the + ! name. The code has been updated elsewhere to use these + ! variables as memory variables. + temp_cohort%leafmemory = c_leaf ! Leaf biomass memory + temp_cohort%fnrtmemory = c_fnrt ! Fine root memory + temp_cohort%sapwmemory = c_sapw ! Sapwood memory + temp_cohort%structmemory = c_struct ! Heartwood memory c_leaf = 0._r8 - c_sapw = (1._r8 - stem_drop_fraction) * c_sapw - c_struct = (1._r8 - stem_drop_fraction) * c_struct + !c_fnrt = c_fnrt... Do not change fine root, if leaves are off + ! fine roots may steadily decline depending on the PFT. + c_sapw = (1._r8 - stem_drop_fraction) * c_sapw + c_struct = (1._r8 - stem_drop_fraction) * c_struct cstatus = leaves_off endif @@ -1160,7 +1173,8 @@ subroutine set_inventory_edcohort_type1(csite,bc_in,css_file_unit,npatches, & call create_cohort(csite, cpatch, temp_cohort%pft, temp_cohort%n, temp_cohort%hite, & temp_cohort%coage, temp_cohort%dbh, & - prt_obj, temp_cohort%leafmemory,temp_cohort%sapwmemory, temp_cohort%structmemory, & + prt_obj, temp_cohort%leafmemory, temp_cohort%fnrtmemory, & + temp_cohort%sapwmemory, temp_cohort%structmemory, & cstatus, rstatus, temp_cohort%canopy_trim, & 1, csite%spread, bc_in) diff --git a/main/FatesRestartInterfaceMod.F90 b/main/FatesRestartInterfaceMod.F90 index 51ca1bbf32..dfdd3fcc59 100644 --- a/main/FatesRestartInterfaceMod.F90 +++ b/main/FatesRestartInterfaceMod.F90 @@ -77,13 +77,12 @@ module FatesRestartInterfaceMod integer :: ir_npatch_si integer :: ir_cd_status_si - integer :: ir_dd_status_si integer :: ir_nchill_days_si integer :: ir_ncold_days_si integer :: ir_leafondate_si integer :: ir_leafoffdate_si - integer :: ir_dleafondate_si - integer :: ir_dleafoffdate_si + integer :: ir_cndaysleafon_si + integer :: ir_cndaysleafoff_si integer :: ir_acc_ni_si integer :: ir_gdd_si integer :: ir_snow_depth_si @@ -98,6 +97,7 @@ module FatesRestartInterfaceMod integer :: ir_g_sb_laweight_co integer :: ir_height_co integer :: ir_leafmemory_co + integer :: ir_fnrtmemory_co integer :: ir_sapwmemory_co integer :: ir_structmemory_co integer :: ir_nplant_co @@ -170,7 +170,13 @@ module FatesRestartInterfaceMod ! Site level - integer :: ir_watermem_siwm + integer :: ir_dd_status_sift + integer :: ir_dleafondate_sift + integer :: ir_dleafoffdate_sift + integer :: ir_dndaysleafon_sift + integer :: ir_dndaysleafoff_sift + integer :: ir_liqvolmem_siwmft + integer :: ir_smpmem_siwmft integer :: ir_vegtempmem_sitm integer :: ir_seed_bank_sift integer :: ir_spread_si @@ -587,10 +593,6 @@ subroutine define_restart_vars(this, initialize_variables) long_name='status flag for cold deciduous plants', units='unitless', flushval = flushinvalid, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_cd_status_si ) - call this%set_restart_var(vname='fates_drought_dec_status', vtype=site_int, & - long_name='status flag for drought deciduous plants', units='unitless', flushval = flushinvalid, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_dd_status_si ) - call this%set_restart_var(vname='fates_chilling_days', vtype=site_int, & long_name='chilling day counter', units='unitless', flushval = flushinvalid, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_nchill_days_si ) @@ -600,20 +602,20 @@ subroutine define_restart_vars(this, initialize_variables) hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_ncold_days_si ) call this%set_restart_var(vname='fates_leafondate', vtype=site_int, & - long_name='the day of year for leaf on', units='day of year', flushval = flushinvalid, & + long_name='the day of year for leaf on (cold deciduous)', units='day of year', flushval = flushinvalid, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_leafondate_si ) call this%set_restart_var(vname='fates_leafoffdate', vtype=site_int, & - long_name='the day of year for leaf off', units='day of year', flushval = flushinvalid, & + long_name='the day of year for leaf off (cold deciduous)', units='day of year', flushval = flushinvalid, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_leafoffdate_si ) - call this%set_restart_var(vname='fates_drought_leafondate', vtype=site_int, & - long_name='the day of year for drought based leaf-on', units='day of year', flushval = flushinvalid, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_dleafondate_si ) + call this%set_restart_var(vname='fates_ndaysleafon', vtype=site_int, & + long_name='number of days since leaf on (cold deciduous)', units='days', flushval = flushinvalid, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_cndaysleafon_si ) - call this%set_restart_var(vname='fates_drought_leafoffdate', vtype=site_int, & - long_name='the day of year for drought based leaf-off', units='day of year', flushval = flushinvalid, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_dleafoffdate_si ) + call this%set_restart_var(vname='fates_ndaysleafoff', vtype=site_int, & + long_name='number of days since leaf off (cold deciduous)', units='days', flushval = flushinvalid, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_cndaysleafoff_si ) call this%set_restart_var(vname='fates_acc_nesterov_id', vtype=site_r8, & long_name='a nesterov index accumulator', units='unitless', flushval = flushzero, & @@ -696,6 +698,11 @@ subroutine define_restart_vars(this, initialize_variables) units='kgC/indiv', flushval = flushzero, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_leafmemory_co ) + call this%set_restart_var(vname='fates_fnrtmemory', vtype=cohort_r8, & + long_name='ed cohort - target fine-root biomass set from prev year', & + units='kgC/indiv', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_fnrtmemory_co ) + call this%set_restart_var(vname='fates_sapwmemory', vtype=cohort_r8, & long_name='ed cohort - target sapwood biomass set from prev year', & units='kgC/indiv', flushval = flushzero, & @@ -1099,10 +1106,35 @@ subroutine define_restart_vars(this, initialize_variables) ! site x time level vars ! - call this%set_restart_var(vname='fates_water_memory', vtype=cohort_r8, & + call this%set_restart_var(vname='fates_drought_dec_status', vtype=cohort_int, & + long_name='status flag for drought deciduous plants', units='unitless', flushval = flushinvalid, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_dd_status_sift ) + + call this%set_restart_var(vname='fates_drought_leafondate', vtype=cohort_int, & + long_name='the day of year for drought based leaf-on', units='day of year', flushval = flushinvalid, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_dleafondate_sift ) + + call this%set_restart_var(vname='fates_drought_leafoffdate', vtype=cohort_int, & + long_name='the day of year for drought based leaf-off', units='day of year', flushval = flushinvalid, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_dleafoffdate_sift ) + + call this%set_restart_var(vname='fates_drought_ndaysleafon', vtype=cohort_int, & + long_name='number of days since leaf on (drought deciduous)', units='days', flushval = flushinvalid, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_dndaysleafon_sift ) + + call this%set_restart_var(vname='fates_drought_ndaysleafoff', vtype=cohort_int, & + long_name='number of days since leaf off (drought deciduous)', units='days', flushval = flushinvalid, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_dndaysleafoff_sift ) + + call this%set_restart_var(vname='fates_liqvol_memory', vtype=cohort_r8, & long_name='last 10 days of volumetric soil water, by site x day-index', & units='m3/m3', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_watermem_siwm ) + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_liqvolmem_siwmft ) + + call this%set_restart_var(vname='fates_smp_memory', vtype=cohort_r8, & + long_name='last 10 days of soil matric potential, by site x day-index', & + units='mm', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_smpmem_siwmft ) call this%set_restart_var(vname='fates_vegtemp_memory', vtype=cohort_r8, & long_name='last 10 days of 24-hour vegetation temperature, by site x day-index', & @@ -1597,13 +1629,12 @@ subroutine set_restart_vectors(this,nc,nsites,sites) associate( rio_npatch_si => this%rvars(ir_npatch_si)%int1d, & rio_cd_status_si => this%rvars(ir_cd_status_si)%int1d, & - rio_dd_status_si => this%rvars(ir_dd_status_si)%int1d, & rio_nchill_days_si => this%rvars(ir_nchill_days_si)%int1d, & rio_ncold_days_si => this%rvars(ir_ncold_days_si)%int1d, & rio_leafondate_si => this%rvars(ir_leafondate_si)%int1d, & rio_leafoffdate_si => this%rvars(ir_leafoffdate_si)%int1d, & - rio_dleafondate_si => this%rvars(ir_dleafondate_si)%int1d, & - rio_dleafoffdate_si => this%rvars(ir_dleafoffdate_si)%int1d, & + rio_cndaysleafon_si => this%rvars(ir_cndaysleafon_si)%int1d, & + rio_cndaysleafoff_si => this%rvars(ir_cndaysleafoff_si)%int1d, & rio_acc_ni_si => this%rvars(ir_acc_ni_si)%r81d, & rio_gdd_si => this%rvars(ir_gdd_si)%r81d, & rio_snow_depth_si => this%rvars(ir_snow_depth_si)%r81d, & @@ -1621,6 +1652,7 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_g_sb_laweight_co => this%rvars(ir_g_sb_laweight_co)%r81d, & rio_height_co => this%rvars(ir_height_co)%r81d, & rio_leafmemory_co => this%rvars(ir_leafmemory_co)%r81d, & + rio_fnrtmemory_co => this%rvars(ir_fnrtmemory_co)%r81d, & rio_sapwmemory_co => this%rvars(ir_sapwmemory_co)%r81d, & rio_structmemory_co => this%rvars(ir_structmemory_co)%r81d, & rio_nplant_co => this%rvars(ir_nplant_co)%r81d, & @@ -1663,7 +1695,13 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_patchdistturbcat_pa => this%rvars(ir_patchdistturbcat_pa)%int1d, & rio_agesinceanthrodist_pa => this%rvars(ir_agesinceanthrodist_pa)%r81d, & rio_area_pa => this%rvars(ir_area_pa)%r81d, & - rio_watermem_siwm => this%rvars(ir_watermem_siwm)%r81d, & + rio_dd_status_sift => this%rvars(ir_dd_status_sift)%int1d, & + rio_dleafondate_sift => this%rvars(ir_dleafondate_sift)%int1d, & + rio_dleafoffdate_sift => this%rvars(ir_dleafoffdate_sift)%int1d, & + rio_dndaysleafon_sift => this%rvars(ir_dndaysleafon_sift)%int1d, & + rio_dndaysleafoff_sift => this%rvars(ir_dndaysleafoff_sift)%int1d, & + rio_liqvolmem_siwmft => this%rvars(ir_liqvolmem_siwmft)%r81d, & + rio_smpmem_siwmft => this%rvars(ir_smpmem_siwmft)%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, & @@ -1848,6 +1886,7 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_coage_co(io_idx_co) = ccohort%coage rio_height_co(io_idx_co) = ccohort%hite rio_leafmemory_co(io_idx_co) = ccohort%leafmemory + rio_fnrtmemory_co(io_idx_co) = ccohort%fnrtmemory rio_sapwmemory_co(io_idx_co) = ccohort%sapwmemory rio_structmemory_co(io_idx_co) = ccohort%structmemory rio_g_sb_laweight_co(io_idx_co)= ccohort%g_sb_laweight @@ -2043,14 +2082,25 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_fmortcflux_usto_si(io_idx_si) = sites(s)%fmort_carbonflux_ustory rio_cd_status_si(io_idx_si) = sites(s)%cstatus - rio_dd_status_si(io_idx_si) = sites(s)%dstatus rio_nchill_days_si(io_idx_si) = sites(s)%nchilldays rio_ncold_days_si(io_idx_si) = sites(s)%ncolddays rio_leafondate_si(io_idx_si) = sites(s)%cleafondate rio_leafoffdate_si(io_idx_si) = sites(s)%cleafoffdate + rio_cndaysleafon_si(io_idx_si) = sites(s)%cndaysleafon + rio_cndaysleafoff_si(io_idx_si) = sites(s)%cndaysleafoff + + ! Drought-deciduous phenology are now PFT dependent + io_idx_si_pft = io_idx_co_1st + do i_pft = 1,numpft + rio_dd_status_sift(io_idx_si_pft) = sites(s)%dstatus(i_pft) + rio_dleafondate_sift(io_idx_si_pft) = sites(s)%dleafondate(i_pft) + rio_dleafoffdate_sift(io_idx_si_pft) = sites(s)%dleafoffdate(i_pft) + rio_dndaysleafon_sift(io_idx_si_pft) = sites(s)%dndaysleafon(i_pft) + rio_dndaysleafoff_sift(io_idx_si_pft) = sites(s)%dndaysleafoff(i_pft) + + io_idx_si_pft = io_idx_si_pft + 1 + end do - rio_dleafondate_si(io_idx_si) = sites(s)%dleafondate - rio_dleafoffdate_si(io_idx_si) = sites(s)%dleafoffdate rio_acc_ni_si(io_idx_si) = sites(s)%acc_NI rio_gdd_si(io_idx_si) = sites(s)%grow_deg_days rio_snow_depth_si(io_idx_si) = sites(s)%snow_depth @@ -2062,8 +2112,11 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_npatch_si(io_idx_si) = patchespersite 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 + do i_pft=1,numpft + rio_liqvolmem_siwmft( io_idx_si_wmem ) = sites(s)%liqvol_memory(i,i_pft) + rio_smpmem_siwmft( io_idx_si_wmem ) = sites(s)%smp_memory(i,i_pft) + io_idx_si_wmem = io_idx_si_wmem + 1 + end do end do do i = 1, num_vegtemp_mem @@ -2381,13 +2434,12 @@ subroutine get_restart_vectors(this, nc, nsites, sites) associate( rio_npatch_si => this%rvars(ir_npatch_si)%int1d, & rio_cd_status_si => this%rvars(ir_cd_status_si)%int1d, & - rio_dd_status_si => this%rvars(ir_dd_status_si)%int1d, & rio_nchill_days_si => this%rvars(ir_nchill_days_si)%int1d, & rio_ncold_days_si => this%rvars(ir_ncold_days_si)%int1d, & rio_leafondate_si => this%rvars(ir_leafondate_si)%int1d, & rio_leafoffdate_si => this%rvars(ir_leafoffdate_si)%int1d, & - rio_dleafondate_si => this%rvars(ir_dleafondate_si)%int1d, & - rio_dleafoffdate_si => this%rvars(ir_dleafoffdate_si)%int1d, & + rio_cndaysleafon_si => this%rvars(ir_cndaysleafon_si)%int1d, & + rio_cndaysleafoff_si => this%rvars(ir_cndaysleafoff_si)%int1d, & rio_acc_ni_si => this%rvars(ir_acc_ni_si)%r81d, & rio_gdd_si => this%rvars(ir_gdd_si)%r81d, & rio_snow_depth_si => this%rvars(ir_snow_depth_si)%r81d, & @@ -2405,6 +2457,7 @@ subroutine get_restart_vectors(this, nc, nsites, sites) rio_g_sb_laweight_co => this%rvars(ir_g_sb_laweight_co)%r81d, & rio_height_co => this%rvars(ir_height_co)%r81d, & rio_leafmemory_co => this%rvars(ir_leafmemory_co)%r81d, & + rio_fnrtmemory_co => this%rvars(ir_fnrtmemory_co)%r81d, & rio_sapwmemory_co => this%rvars(ir_sapwmemory_co)%r81d, & rio_structmemory_co => this%rvars(ir_structmemory_co)%r81d, & rio_nplant_co => this%rvars(ir_nplant_co)%r81d, & @@ -2447,7 +2500,13 @@ subroutine get_restart_vectors(this, nc, nsites, sites) rio_patchdistturbcat_pa => this%rvars(ir_patchdistturbcat_pa)%int1d, & rio_agesinceanthrodist_pa => this%rvars(ir_agesinceanthrodist_pa)%r81d, & rio_area_pa => this%rvars(ir_area_pa)%r81d, & - rio_watermem_siwm => this%rvars(ir_watermem_siwm)%r81d, & + rio_dd_status_sift => this%rvars(ir_dd_status_sift)%int1d, & + rio_dleafondate_sift => this%rvars(ir_dleafondate_sift)%int1d, & + rio_dleafoffdate_sift => this%rvars(ir_dleafoffdate_sift)%int1d, & + rio_dndaysleafon_sift => this%rvars(ir_dndaysleafon_sift)%int1d, & + rio_dndaysleafoff_sift => this%rvars(ir_dndaysleafoff_sift)%int1d, & + rio_liqvolmem_siwmft => this%rvars(ir_liqvolmem_siwmft)%r81d, & + rio_smpmem_siwmft => this%rvars(ir_smpmem_siwmft)%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, & @@ -2605,6 +2664,7 @@ subroutine get_restart_vectors(this, nc, nsites, sites) ccohort%g_sb_laweight= rio_g_sb_laweight_co(io_idx_co) ccohort%hite = rio_height_co(io_idx_co) ccohort%leafmemory = rio_leafmemory_co(io_idx_co) + ccohort%fnrtmemory = rio_fnrtmemory_co(io_idx_co) ccohort%sapwmemory = rio_sapwmemory_co(io_idx_co) ccohort%structmemory= rio_structmemory_co(io_idx_co) ccohort%n = rio_nplant_co(io_idx_co) @@ -2784,8 +2844,11 @@ subroutine get_restart_vectors(this, nc, nsites, sites) end if 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 + do i_pft=1,numpft + sites(s)%liqvol_memory(i,i_pft) = rio_liqvolmem_siwmft( io_idx_si_wmem ) + sites(s)%smp_memory(i,i_pft) = rio_smpmem_siwmft( io_idx_si_wmem ) + io_idx_si_wmem = io_idx_si_wmem + 1 + end do end do do i = 1, num_vegtemp_mem @@ -2857,13 +2920,24 @@ subroutine get_restart_vectors(this, nc, nsites, sites) ! Site level phenology status flags sites(s)%cstatus = rio_cd_status_si(io_idx_si) - sites(s)%dstatus = rio_dd_status_si(io_idx_si) sites(s)%nchilldays = rio_nchill_days_si(io_idx_si) sites(s)%ncolddays = rio_ncold_days_si(io_idx_si) sites(s)%cleafondate = rio_leafondate_si(io_idx_si) sites(s)%cleafoffdate = rio_leafoffdate_si(io_idx_si) - sites(s)%dleafondate = rio_dleafondate_si(io_idx_si) - sites(s)%dleafoffdate = rio_dleafoffdate_si(io_idx_si) + sites(s)%cndaysleafon = rio_cndaysleafon_si(io_idx_si) + sites(s)%cndaysleafoff = rio_cndaysleafoff_si(io_idx_si) + + ! Fill drought-deciduous variables, which are now PFT variables. + io_idx_si_pft = io_idx_co_1st + do i_pft = 1,numpft + sites(s)%dstatus(i_pft) = rio_dd_status_sift(io_idx_si_pft) + sites(s)%dleafondate(i_pft) = rio_dleafondate_sift(io_idx_si_pft) + sites(s)%dleafoffdate(i_pft) = rio_dleafoffdate_sift(io_idx_si_pft) + sites(s)%dndaysleafon(i_pft) = rio_dndaysleafon_sift(io_idx_si_pft) + sites(s)%dndaysleafoff(i_pft) = rio_dndaysleafoff_sift(io_idx_si_pft) + io_idx_si_pft = io_idx_si_pft + 1 + end do + sites(s)%acc_NI = rio_acc_ni_si(io_idx_si) sites(s)%grow_deg_days = rio_gdd_si(io_idx_si) sites(s)%snow_depth = rio_snow_depth_si(io_idx_si) diff --git a/parameter_files/fates_params_default.cdl b/parameter_files/fates_params_default.cdl index 674c0a5ee7..1feba22e98 100644 --- a/parameter_files/fates_params_default.cdl +++ b/parameter_files/fates_params_default.cdl @@ -720,8 +720,8 @@ variables: fates_phen_doff_time:units = "days" ; fates_phen_doff_time:long_name = "day threshold compared against days since leaves became off-allometry" ; double fates_phen_drought_threshold ; - fates_phen_drought_threshold:units = "m3/m3" ; - fates_phen_drought_threshold:long_name = "liquid volume in soil layer, threashold for drought phenology" ; + fates_phen_drought_threshold:units = "m3/m3 or mm" ; + fates_phen_drought_threshold:long_name = "threshold for drought phenology; the quantity depends on the sign: if positive, the threshold is volumetric soil moisture (m3/m3). If negative, the threshold is soil matric potentical (mm)." ; double fates_phen_mindayson ; fates_phen_mindayson:units = "days" ; fates_phen_mindayson:long_name = "day threshold compared against days since leaves became on-allometry" ; @@ -1463,7 +1463,7 @@ data: fates_phen_doff_time = 100 ; - fates_phen_drought_threshold = 0.15 ; + fates_phen_drought_threshold = -140000. ; fates_phen_mindayson = 90 ; diff --git a/parteh/PRTAllometricCarbonMod.F90 b/parteh/PRTAllometricCarbonMod.F90 index 08b47dbbaa..92433c52c3 100644 --- a/parteh/PRTAllometricCarbonMod.F90 +++ b/parteh/PRTAllometricCarbonMod.F90 @@ -342,6 +342,9 @@ subroutine DailyPRTAllometricCarbon(this) real(r8) :: repro_c0 ! "" real(r8) :: struct_c0 ! "" + logical :: is_hydecid_dormant ! Flag to signal that the cohort is drought deciduous and dormant + logical :: is_deciduous ! Flag to signal this is a deciduous PFT + logical :: grow_struct logical :: grow_leaf ! Are leaves at allometric target and should be grown? logical :: grow_fnrt ! Are fine-roots at allometric target and should be grown? @@ -411,7 +414,12 @@ subroutine DailyPRTAllometricCarbon(this) 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) - + ! Set some logical flags to simplify "if" blocks + is_hydecid_dormant = ( prt_params%stress_decid(ipft) == 1 ) .and. & + ( leaf_status == leaves_off ) + is_deciduous = ( prt_params%stress_decid(ipft) == 1 ) .or. & + ( prt_params%season_decid(ipft) == 1 ) + nleafage = prt_global%state_descriptor(leaf_c_id)%num_pos ! Number of leaf age class @@ -441,7 +449,7 @@ subroutine DailyPRTAllometricCarbon(this) ! ----------------------------------------------------------------------------------- ! II. Calculate target size of the biomass compartment for a given dbh. ! ----------------------------------------------------------------------------------- - + ! Target sapwood biomass according to allometry and trimming [kgC] call bsap_allom(dbh,ipft,canopy_trim,sapw_area,target_sapw_c) @@ -455,13 +463,8 @@ subroutine DailyPRTAllometricCarbon(this) call bdead_allom( target_agw_c, target_bgw_c, target_sapw_c, ipft, target_struct_c) ! Target leaf biomass according to allometry and trimming - select case (leaf_status) - case (leaves_on) - call bleaf(dbh,ipft,canopy_trim,target_leaf_c) - case (leaves_off) - target_leaf_c = 0._r8 - end select - + call bleaf(dbh,ipft,canopy_trim,target_leaf_c) + ! Target fine-root biomass and deriv. according to allometry and trimming [kgC, kgC/cm] call bfineroot(dbh,ipft,canopy_trim,target_fnrt_c) @@ -469,25 +472,64 @@ subroutine DailyPRTAllometricCarbon(this) call bstore_allom(dbh,ipft,canopy_trim,target_store_c) + + ! ----------------------------------------------------------------------------------- + ! II 1/2. For drougth-deciduous plants, we assume that plants in LEAVES OFF status + ! do not rebuild any tissues lost to turnover. Any excess carbon balance + ! that they might have goes to storage (n.b. probably overly cautious, + ! because plants with no leaves should have zero or negative carbon balance, + ! unless there is some shady carbon market going on across cohorts...). + ! ----------------------------------------------------------------------------------- + if ( is_hydecid_dormant ) then + ! Drought deciduous, leaves off. Target is zero for all active tissues + target_leaf_c = 0.0_r8 + target_fnrt_c = 0.0_r8 + target_sapw_c = 0.0_r8 + + elseif ( leaf_status == leaves_off ) then + ! Cold deciduous. For now we let them rebuild fine root and sapwood. Note that + ! this assumption is less of an issue for cold deciduous because turnover rates + ! are lower during winter. + target_leaf_c = 0.0_r8 + end if + + + ! ----------------------------------------------------------------------------------- ! III. Prioritize some amount of carbon to replace leaf/root turnover ! Make sure it isnt a negative payment, and either pay what is available ! or forcefully pay from storage. + ! MLO. Added a few conditions to decide what to do in case plants are deciduous. + ! Specifically, drought deciduous with leaves off should not replace fine + ! roots. They will be in negative carbon balance, and unlike cold deciduous, + ! the turnover rates will be high during the dry season (turnover is + ! temperature-dependent, but not moisture-dependent). Allocating carbon + ! to high-maintanence tissues will drain the storage with little benefit for + ! these plants. ! ----------------------------------------------------------------------------------- - - if( prt_params%evergreen(ipft) ==1 ) then + if ( is_hydecid_dormant ) then + ! Drought deciduous, dormant state. Set demands to both leaves and roots to zero. + leaf_c_demand = 0.0_r8 + fnrt_c_demand = 0.0_r8 + elseif ( is_deciduous ) then + ! Either cold deciduous plant, or drought deciduous with leaves on. Maintain roots. + leaf_c_demand = 0.0_r8 + fnrt_c_demand = max(0.0_r8, & + prt_params%leaf_stor_priority(ipft)*this%variables(fnrt_c_id)%turnover(icd)) + else + ! Evergreen PFT. Try to meet demands for both leaves and fine roots. + ! If this is not evergreen, this PFT isn't expected by FATES, and we assume + ! evergreen. leaf_c_demand = max(0.0_r8, & prt_params%leaf_stor_priority(ipft)*sum(this%variables(leaf_c_id)%turnover(:))) - else - leaf_c_demand = 0.0_r8 + fnrt_c_demand = max(0.0_r8, & + prt_params%leaf_stor_priority(ipft)*this%variables(fnrt_c_id)%turnover(icd)) end if - - fnrt_c_demand = max(0.0_r8, & - prt_params%leaf_stor_priority(ipft)*this%variables(fnrt_c_id)%turnover(icd)) total_c_demand = leaf_c_demand + fnrt_c_demand - - if (total_c_demand> nearzero ) then + + + if ( total_c_demand > 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 @@ -495,13 +537,13 @@ subroutine DailyPRTAllometricCarbon(this) ! subtract leaf flux from carbon balance before estimating the fine root flux, ! potentially allowing less fluxes to fine roots than possible. leaf_c_flux = min(leaf_c_demand, & - max(0.0_r8,(store_c+carbon_balance)* & - (leaf_c_demand/total_c_demand))) + max(0.0_r8, & + (store_c+carbon_balance)*leaf_c_demand/total_c_demand)) ! If we are testing b4b, then we pay this even if we don't have the carbon fnrt_c_flux = min(fnrt_c_demand, & - max(0.0_r8, (store_c+carbon_balance)* & - (fnrt_c_demand/total_c_demand))) - + max(0.0_r8, & + (store_c+carbon_balance)*fnrt_c_demand/total_c_demand)) + ! Add carbon to the youngest age pool (i.e iexp_leaf = index 1) and fine roots leaf_c(iexp_leaf) = leaf_c(iexp_leaf) + leaf_c_flux fnrt_c = fnrt_c + fnrt_c_flux @@ -518,7 +560,7 @@ subroutine DailyPRTAllometricCarbon(this) ! ----------------------------------------------------------------------------------- if( carbon_balance < 0.0_r8 ) then - + ! Store_c_flux will be negative, so store_c will be depleted store_c_flux = carbon_balance carbon_balance = carbon_balance - store_c_flux @@ -1099,12 +1141,7 @@ subroutine DailyPRTAllometricCarbonSimpler(this) call bdead_allom( target_agw_c, target_bgw_c, target_sapw_c, ipft, target_struct_c) ! Target leaf biomass according to allometry and trimming - select case (leaf_status) - case (leaves_on) - call bleaf(dbh,ipft,canopy_trim,target_leaf_c) - case (leaves_off) - target_leaf_c = 0.0_r8 - end select + call bleaf(dbh,ipft,canopy_trim,target_leaf_c) ! Target fine-root biomass and deriv. according to allometry and trimming [kgC, kgC/cm] call bfineroot(dbh,ipft,canopy_trim,target_fnrt_c) @@ -1113,6 +1150,29 @@ subroutine DailyPRTAllometricCarbonSimpler(this) call bstore_allom(dbh,ipft,canopy_trim,target_store_c) + + ! ----------------------------------------------------------------------------------- + ! II 1/2. For drougth-deciduous plants, we assume that plants in LEAVES OFF status + ! do not rebuild any tissues lost to turnover. + ! ----------------------------------------------------------------------------------- + if ( is_hydecid_dormant ) then + ! Drought deciduous, leaves off. Do not try to get back on allometry. + target_leaf_c = 0.0_r8 + target_fnrt_c = 0.0_r8 + target_sapw_c = 0.0_r8 + target_agw_c = 0.0_r8 + target_bgw_c = 0.0_r8 + target_struct_c = 0.0_r8 + target_store_c = 0.0_r8 + + elseif ( leaf_status == leaves_off ) then + ! Cold deciduous. For now we let them rebuild fine root and sapwood. Note that + ! this assumption is less of an issue for cold deciduous because turnover rates + ! are lower during winter. + target_leaf_c = 0.0_r8 + end if + + ! ----------------------------------------------------------------------------------- ! III. If carbon is available, bring all the pools as close to the allometry ! as possible. This also includes the storage pool, even though carbon may @@ -1435,7 +1495,8 @@ subroutine DailyPRTAllometricCarbonSimpler(this) end subroutine DailyPRTAllometricCarbonSimpler ! ===================================================================================== - + + function AllomCGrowthDeriv(c_pools,c_mask,cbalance,intgr_params) result(dCdx) ! --------------------------------------------------------------------------------- diff --git a/parteh/PRTLossFluxesMod.F90 b/parteh/PRTLossFluxesMod.F90 index 13b09b2e37..faba7b50a0 100644 --- a/parteh/PRTLossFluxesMod.F90 +++ b/parteh/PRTLossFluxesMod.F90 @@ -109,8 +109,9 @@ subroutine PRTPhenologyFlush(prt, ipft, organ_id, c_store_transfer_frac) ! those parameters and clauses need to be added !if(organ_id .ne. leaf_organ) then - if(organ_id .ne. leaf_organ .AND. prt_params%woody(ipft) == itrue) then - write(fates_log(),*) 'Deciduous drop and re-flushing only allowed in leaves' + if( organ_id /= leaf_organ .and. organ_id /= fnrt_organ .AND. & + prt_params%woody(ipft) == itrue ) then + write(fates_log(),*) 'Deciduous drop and re-flushing only allowed in leaves and fine roots' write(fates_log(),*) ' leaf_organ: ',leaf_organ write(fates_log(),*) ' organ: ',organ_id write(fates_log(),*) 'Exiting' @@ -424,8 +425,9 @@ subroutine PRTDeciduousTurnover(prt,ipft,organ_id,mass_fraction) ! those parameters and clauses need to be added !if(organ_id .ne. leaf_organ) then - if(organ_id .ne. leaf_organ .AND. prt_params%woody(ipft) == itrue) then - write(fates_log(),*) 'Deciduous drop and re-flushing only allowed in leaves' + if( organ_id /= leaf_organ .and. organ_id /= fnrt_organ .AND. & + prt_params%woody(ipft) == itrue) then + write(fates_log(),*) 'Deciduous drop and re-flushing only allowed in leaves and fine roots' write(fates_log(),*) ' leaf_organ: ',leaf_organ write(fates_log(),*) ' organ: ',organ_id write(fates_log(),*) 'Exiting' From cf6b05b6dbe6f037d5693ca4c3982f2747d96e91 Mon Sep 17 00:00:00 2001 From: Marcos Longo Date: Mon, 1 Nov 2021 08:30:13 -0700 Subject: [PATCH 04/11] Updated reproduction, the routine had not been updated with the new definitions of sapwood and structural memory. --- biogeochem/EDPhysiologyMod.F90 | 21 +++++++++++++++++---- 1 file changed, 17 insertions(+), 4 deletions(-) diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 3bfb4605ca..f84b84557c 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -1626,6 +1626,7 @@ subroutine recruitment( currentSite, currentPatch, bc_in ) cohortstatus = leaves_on temp_cohort%leafmemory = 0.0_r8 temp_cohort%sapwmemory = 0.0_r8 + temp_cohort%sapwmemory = 0.0_r8 temp_cohort%structmemory = 0.0_r8 @@ -1634,12 +1635,19 @@ subroutine recruitment( currentSite, currentPatch, bc_in ) if ((prt_params%season_decid(ft) == itrue) .and. & (any(currentSite%cstatus == [phen_cstat_nevercold,phen_cstat_iscold]))) then temp_cohort%leafmemory = c_leaf + temp_cohort%fnrtmemory = c_fnrt c_leaf = 0.0_r8 + !c_fnrt = c_fnrt ! For now we do not drop fine roots, but keep memory. + + ! If plant is not woody then set sapwood and structural biomass as well if (prt_params%woody(ft).ne.itrue) then - temp_cohort%sapwmemory = c_sapw * stem_drop_fraction - temp_cohort%structmemory = c_struct * stem_drop_fraction + ! MLO update: sapwmemory and structmemory used to be deficit, despite the + ! name. The code has been updated elsewhere to use these + ! variables as memory variables. + temp_cohort%sapwmemory = c_sapw + temp_cohort%structmemory = c_struct c_sapw = (1.0_r8 - stem_drop_fraction) * c_sapw c_struct = (1.0_r8 - stem_drop_fraction) * c_struct endif @@ -1652,12 +1660,17 @@ subroutine recruitment( currentSite, currentPatch, bc_in ) if ((prt_params%stress_decid(ft) == itrue) .and. & (any(currentSite%dstatus(ft) == [phen_dstat_timeoff,phen_dstat_moistoff]))) then temp_cohort%leafmemory = c_leaf + temp_cohort%fnrtmemory = c_fnrt c_leaf = 0.0_r8 + !c_fnrt = c_fnrt ! For now we do not drop fine roots, but keep memory. ! If plant is not woody then set sapwood and structural biomass as well if(prt_params%woody(ft).ne.itrue)then - temp_cohort%sapwmemory = c_sapw * stem_drop_fraction - temp_cohort%structmemory = c_struct * stem_drop_fraction + ! MLO update: sapwmemory and structmemory used to be deficit, despite the + ! name. The code has been updated elsewhere to use these + ! variables as memory variables. + temp_cohort%sapwmemory = c_sapw + temp_cohort%structmemory = c_struct c_sapw = (1.0_r8 - stem_drop_fraction) * c_sapw c_struct = (1.0_r8 - stem_drop_fraction) * c_struct endif From 4eba25f3bd3376cf28a2fe66e590bf2be2973705 Mon Sep 17 00:00:00 2001 From: Marcos Longo Date: Wed, 3 Nov 2021 14:48:25 -0700 Subject: [PATCH 05/11] Added option (hlm_parteh_mode = 0) to use the simpler carbon allocation approach. --- biogeochem/EDCohortDynamicsMod.F90 | 16 +++++++--- biogeochem/EDPatchDynamicsMod.F90 | 3 +- biogeochem/EDPhysiologyMod.F90 | 3 +- biogeochem/FatesSoilBGCFluxMod.F90 | 6 ++-- biogeophys/FatesPlantRespPhotosynthMod.F90 | 8 +++-- main/EDInitMod.F90 | 3 +- main/EDMainMod.F90 | 1 + main/EDPftvarcon.F90 | 24 +++++++++----- main/FatesHistoryInterfaceMod.F90 | 1 + main/FatesInterfaceMod.F90 | 7 ++-- main/FatesInventoryInitMod.F90 | 3 +- parteh/PRTAllometricCarbonMod.F90 | 37 ++++++++++++++++++---- parteh/PRTGenericMod.F90 | 1 + parteh/PRTParamsFATESMod.F90 | 25 ++++++++------- 14 files changed, 96 insertions(+), 42 deletions(-) diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index 1537aad431..0c105b4e0f 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -66,7 +66,8 @@ module EDCohortDynamicsMod use FatesAllometryMod , only : ForceDBH use FatesAllometryMod , only : tree_lai, tree_sai use FatesAllometryMod , only : set_root_fraction - use PRTGenericMod, only : prt_carbon_allom_hyp + use PRTGenericMod, only : prt_carbon_allom_hyp + use PRTGenericMod, only : prt_csimpler_allom_hyp use PRTGenericMod, only : prt_cnp_flex_allom_hyp use PRTGenericMod, only : prt_vartypes use PRTGenericMod, only : all_carbon_elements @@ -82,6 +83,7 @@ module EDCohortDynamicsMod use PRTGenericMod, only : SetState use PRTAllometricCarbonMod, only : callom_prt_vartypes + use PRTAllometricCarbonMod, only : csimpler_allom_prt_vartypes use PRTAllometricCarbonMod, only : ac_bc_inout_id_netdc use PRTAllometricCarbonMod, only : ac_bc_in_id_pft use PRTAllometricCarbonMod, only : ac_bc_in_id_ctrim @@ -384,7 +386,7 @@ subroutine InitPRTBoundaryConditions(new_cohort) select case(hlm_parteh_mode) - case (prt_carbon_allom_hyp) + case (prt_csimpler_allom_hyp,prt_carbon_allom_hyp) ! Register boundary conditions for the Carbon Only Allometric Hypothesis @@ -447,15 +449,21 @@ subroutine InitPRTObject(prt) ! Potential Extended types class(callom_prt_vartypes), pointer :: c_allom_prt + class(csimpler_allom_prt_vartypes), pointer :: csimpler_allom_prt class(cnp_allom_prt_vartypes), pointer :: cnp_allom_prt select case(hlm_parteh_mode) + case (prt_csimpler_allom_hyp) + + allocate(csimpler_allom_prt) + prt => csimpler_allom_prt + case (prt_carbon_allom_hyp) - + allocate(c_allom_prt) prt => c_allom_prt - + case (prt_cnp_flex_allom_hyp) allocate(cnp_allom_prt) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 61de6d6ddd..3c353c02aa 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -79,7 +79,8 @@ module EDPatchDynamicsMod use PRTGenericMod, only : struct_organ use PRTLossFluxesMod, only : PRTBurnLosses use FatesInterfaceTypesMod, only : hlm_parteh_mode - use PRTGenericMod, only : prt_carbon_allom_hyp + use PRTGenericMod, only : prt_csimpler_allom_hyp + use PRTGenericMod, only : prt_carbon_allom_hyp use PRTGenericMod, only : prt_cnp_flex_allom_hyp use SFParamsMod, only : SF_VAL_CWD_FRAC use EDParamsMod, only : logging_event_code diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 874fe3183b..4061443ab0 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -83,6 +83,7 @@ module EDPhysiologyMod use FatesAllometryMod , only : carea_allom use FatesAllometryMod , only : CheckIntegratedAllometries use FatesAllometryMod, only : set_root_fraction + use PRTGenericMod, only : prt_csimpler_allom_hyp use PRTGenericMod, only : prt_carbon_allom_hyp use PRTGenericMod, only : prt_cnp_flex_allom_hyp use PRTGenericMod, only : prt_vartypes @@ -1794,7 +1795,7 @@ subroutine recruitment( currentSite, currentPatch, bc_in ) end select select case(hlm_parteh_mode) - case (prt_carbon_allom_hyp,prt_cnp_flex_allom_hyp ) + case (prt_csimpler_allom_hyp,prt_carbon_allom_hyp,prt_cnp_flex_allom_hyp ) ! Put all of the leaf mass into the first bin call SetState(prt,leaf_organ, element_id,m_leaf,1) diff --git a/biogeochem/FatesSoilBGCFluxMod.F90 b/biogeochem/FatesSoilBGCFluxMod.F90 index 9f210e8404..49731d0118 100644 --- a/biogeochem/FatesSoilBGCFluxMod.F90 +++ b/biogeochem/FatesSoilBGCFluxMod.F90 @@ -15,6 +15,7 @@ module FatesSoilBGCFluxMod use PRTGenericMod , only : num_elements use PRTGenericMod , only : element_list use PRTGenericMod , only : element_pos + use PRTGenericMod , only : prt_csimpler_allom_hyp use PRTGenericMod , only : prt_carbon_allom_hyp use PRTGenericMod , only : prt_cnp_flex_allom_hyp use PRTGenericMod , only : prt_vartypes @@ -219,7 +220,8 @@ subroutine UnPackNutrientAquisitionBCs(sites, bc_in) end do ! We can exit if this is a c-only simulation - if(hlm_parteh_mode.eq.prt_carbon_allom_hyp) then + select case (hlm_parteh_mode) + case (prt_csimpler_allom_hyp,prt_carbon_allom_hyp) ! These can now be zero'd do s = 1, nsites bc_in(s)%plant_nh4_uptake_flux(:,:) = 0._r8 @@ -227,7 +229,7 @@ subroutine UnPackNutrientAquisitionBCs(sites, bc_in) bc_in(s)%plant_p_uptake_flux(:,:) = 0._r8 end do return - end if + end select do s = 1, nsites diff --git a/biogeophys/FatesPlantRespPhotosynthMod.F90 b/biogeophys/FatesPlantRespPhotosynthMod.F90 index 39a2589728..f9edcd3308 100644 --- a/biogeophys/FatesPlantRespPhotosynthMod.F90 +++ b/biogeophys/FatesPlantRespPhotosynthMod.F90 @@ -36,6 +36,7 @@ module FATESPlantRespPhotosynthMod use PRTGenericMod, only : max_nleafage use EDTypesMod, only : do_fates_salinity use EDParamsMod, only : q10_mr + use PRTGenericMod, only : prt_csimpler_allom_hyp use PRTGenericMod, only : prt_carbon_allom_hyp use PRTGenericMod, only : prt_cnp_flex_allom_hyp use PRTGenericMod, only : all_carbon_elements @@ -395,7 +396,8 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) 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 + (hlm_parteh_mode .ne. prt_csimpler_allom_hyp .and. & + hlm_parteh_mode .ne. prt_carbon_allom_hyp) ) then if (hlm_use_planthydro.eq.itrue ) then @@ -453,7 +455,7 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) ! Then scale this value at the top of the canopy for canopy depth ! Leaf nitrogen concentration at the top of the canopy (g N leaf / m**2 leaf) select case(hlm_parteh_mode) - case (prt_carbon_allom_hyp) + case (prt_csimpler_allom_hyp,prt_carbon_allom_hyp) lnc_top = prt_params%nitr_stoich_p1(ft,prt_params%organ_param_id(leaf_organ))/slatop(ft) @@ -611,7 +613,7 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) fnrt_c = currentCohort%prt%GetState(fnrt_organ, all_carbon_elements) select case(hlm_parteh_mode) - case (prt_carbon_allom_hyp) + case (prt_csimpler_allom_hyp,prt_carbon_allom_hyp) live_stem_n = prt_params%allom_agb_frac(currentCohort%pft) * & sapw_c * prt_params%nitr_stoich_p1(ft,prt_params%organ_param_id(sapw_organ)) diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index cafd59f3c1..cca98d5db7 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -55,6 +55,7 @@ module EDInitMod use FatesAllometryMod , only : bstore_allom use PRTGenericMod , only : StorageNutrientTarget use FatesInterfaceTypesMod, only : hlm_parteh_mode + use PRTGenericMod, only : prt_csimpler_allom_hyp use PRTGenericMod, only : prt_carbon_allom_hyp use PRTGenericMod, only : prt_cnp_flex_allom_hyp use PRTGenericMod, only : prt_vartypes @@ -639,7 +640,7 @@ subroutine init_cohorts( site_in, patch_in, bc_in) end select select case(hlm_parteh_mode) - case (prt_carbon_allom_hyp,prt_cnp_flex_allom_hyp ) + case (prt_csimpler_allom_hyp,prt_carbon_allom_hyp,prt_cnp_flex_allom_hyp ) ! Put all of the leaf mass into the first bin call SetState(prt_obj,leaf_organ, element_id,m_leaf,1) diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index 5deb2c5084..202aa4d977 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -25,6 +25,7 @@ module EDMainMod use FatesInterfaceTypesMod , only : hlm_masterproc use FatesInterfaceTypesMod , only : numpft use PRTGenericMod , only : prt_carbon_allom_hyp + use PRTGenericMod , only : prt_csimpler_allom_hyp use PRTGenericMod , only : prt_cnp_flex_allom_hyp use PRTGenericMod , only : nitrogen_element use PRTGenericMod , only : phosphorus_element diff --git a/main/EDPftvarcon.F90 b/main/EDPftvarcon.F90 index b6f17bdd70..12347c8172 100644 --- a/main/EDPftvarcon.F90 +++ b/main/EDPftvarcon.F90 @@ -17,7 +17,9 @@ module EDPftvarcon use FatesLitterMod, only : ilabile,icellulose,ilignin use PRTGenericMod, only : leaf_organ, fnrt_organ, store_organ use PRTGenericMod, only : sapw_organ, struct_organ, repro_organ - use PRTGenericMod, only : prt_cnp_flex_allom_hyp,prt_carbon_allom_hyp + use PRTGenericMod, only : prt_csimpler_allom_hyp + use PRTGenericMod, only : prt_carbon_allom_hyp + use PRTGenericMod, only : prt_cnp_flex_allom_hyp use FatesInterfaceTypesMod, only : hlm_nitrogen_spec, hlm_phosphorus_spec use FatesInterfaceTypesMod, only : hlm_parteh_mode use FatesInterfaceTypesMod, only : hlm_nu_com @@ -1501,8 +1503,9 @@ subroutine FatesCheckParams(is_master) if(.not.is_master) return - if (hlm_parteh_mode .eq. prt_cnp_flex_allom_hyp) then - + select case (hlm_parteh_mode) + case (prt_cnp_flex_allom_hyp) + ! Check to see if either RD/ECA/MIC is turned on if (.not.( (trim(hlm_nu_com).eq.'RD') .or. (trim(hlm_nu_com).eq.'ECA'))) then @@ -1537,14 +1540,19 @@ subroutine FatesCheckParams(is_master) end if end if - elseif (hlm_parteh_mode .ne. prt_carbon_allom_hyp) then - + case (prt_carbon_allom_hyp,prt_carbon_allom_hyp) + ! No additional checks needed for now. + continue + + case default + write(fates_log(),*) 'FATES Plant Allocation and Reactive Transport has' - write(fates_log(),*) 'only 2 modules supported, allometric carbon and CNP.' - write(fates_log(),*) 'fates_parteh_mode must be set to 1 or 2 in the namelist' + write(fates_log(),*) 'only 3 modules supported, simpler allometric carbon,' + write(fates_log(),*) 'default allometric carbon, and CNP.' + write(fates_log(),*) 'fates_parteh_mode must be set to 0, 1 or 2 in the namelist' write(fates_log(),*) 'Aborting' call endrun(msg=errMsg(sourcefile, __LINE__)) - end if + end select ! If any PFTs are specified as either prescribed N or P uptake ! then they all must be ! diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index de104f8179..a2391ba9b2 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -68,6 +68,7 @@ module FatesHistoryInterfaceMod use PRTGenericMod , only : all_carbon_elements use PRTGenericMod , only : carbon12_element use PRTGenericMod , only : nitrogen_element, phosphorus_element + use PRTGenericMod , only : prt_csimpler_allom_hyp use PRTGenericMod , only : prt_carbon_allom_hyp implicit none diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 0156beb2dc..733ac093e9 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -55,6 +55,7 @@ module FatesInterfaceMod use PRTGenericMod , only : element_list use PRTGenericMod , only : element_pos use EDParamsMod , only : eca_plant_escalar + use PRTGenericMod , only : prt_csimpler_allom_hyp use PRTGenericMod , only : prt_carbon_allom_hyp use PRTGenericMod , only : prt_cnp_flex_allom_hyp use PRTGenericMod , only : carbon12_element @@ -288,7 +289,7 @@ subroutine zero_bcs(fates,s) ! Fates -> BGC fragmentation mass fluxes select case(hlm_parteh_mode) - case(prt_carbon_allom_hyp) + case(prt_csimpler_allom_hyp,prt_carbon_allom_hyp) fates%bc_out(s)%litt_flux_cel_c_si(:) = 0._r8 fates%bc_out(s)%litt_flux_lig_c_si(:) = 0._r8 fates%bc_out(s)%litt_flux_lab_c_si(:) = 0._r8 @@ -601,7 +602,7 @@ subroutine allocate_bcout(bc_out, nlevsoil_in, nlevdecomp_in) ! Fates -> BGC fragmentation mass fluxes select case(hlm_parteh_mode) - case(prt_carbon_allom_hyp) + case(prt_csimpler_allom_hyp,prt_carbon_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)) @@ -880,7 +881,7 @@ subroutine InitPARTEHGlobals() ! automatically. select case(hlm_parteh_mode) - case(prt_carbon_allom_hyp) + case(prt_csimpler_allom_hyp,prt_carbon_allom_hyp) num_elements = 1 allocate(element_list(num_elements)) diff --git a/main/FatesInventoryInitMod.F90 b/main/FatesInventoryInitMod.F90 index 074c2cb15a..ed56ebfaaa 100644 --- a/main/FatesInventoryInitMod.F90 +++ b/main/FatesInventoryInitMod.F90 @@ -48,6 +48,7 @@ module FatesInventoryInitMod use EDPftvarcon , only : EDPftvarcon_inst use FatesInterfaceTypesMod, only : hlm_parteh_mode use EDCohortDynamicsMod, only : InitPRTObject + use PRTGenericMod, only : prt_csimpler_allom_hyp use PRTGenericMod, only : prt_carbon_allom_hyp use PRTGenericMod, only : prt_cnp_flex_allom_hyp use PRTGenericMod, only : prt_vartypes @@ -1133,7 +1134,7 @@ subroutine set_inventory_edcohort_type1(csite,bc_in,css_file_unit,npatches, & end select select case(hlm_parteh_mode) - case (prt_carbon_allom_hyp,prt_cnp_flex_allom_hyp ) + case (prt_csimpler_allom_hyp,prt_carbon_allom_hyp,prt_cnp_flex_allom_hyp ) ! Equally distribute leaf mass into available age-bins do iage = 1,nleafage diff --git a/parteh/PRTAllometricCarbonMod.F90 b/parteh/PRTAllometricCarbonMod.F90 index 08b47dbbaa..9f827370b2 100644 --- a/parteh/PRTAllometricCarbonMod.F90 +++ b/parteh/PRTAllometricCarbonMod.F90 @@ -117,16 +117,24 @@ module PRTAllometricCarbonMod ! ------------------------------------------------------------------------------------- - type, public, extends(prt_vartypes) :: callom_prt_vartypes + type, public, extends(prt_vartypes) :: callom_prt_vartypes - contains + contains - procedure :: DailyPRT => DailyPRTAllometricCarbon - ! procedure :: DailyPRT => DailyPRTAllometricCarbonSimpler - procedure :: FastPRT => FastPRTAllometricCarbon + procedure :: DailyPRT => DailyPRTAllometricCarbon + procedure :: FastPRT => FastPRTAllometricCarbon end type callom_prt_vartypes - + + type, public, extends(prt_vartypes) :: csimpler_allom_prt_vartypes + + contains + + procedure :: DailyPRT => DailyPRTAllometricCarbonSimpler + procedure :: FastPRT => FastPRTAllometricCarbonSimpler + + end type csimpler_allom_prt_vartypes + ! ------------------------------------------------------------------------------------ ! ! This next class is an extention of the base instance that maps state variables @@ -926,7 +934,7 @@ subroutine DailyPRTAllometricCarbonSimpler(this) ! The class is the only argument - class(callom_prt_vartypes) :: this ! this class + class(csimpler_allom_prt_vartypes) :: this ! this class ! ----------------------------------------------------------------------------------- ! These are local copies of the in/out boundary condition structure @@ -1673,5 +1681,20 @@ subroutine FastPRTAllometricCarbon(this) end subroutine FastPRTAllometricCarbon + ! ===================================================================================== + + subroutine FastPRTAllometricCarbonSimpler(this) + + implicit none + class(csimpler_allom_prt_vartypes) :: this ! this class + + ! This routine does nothing, because in the carbon only allometric RT model + ! we currently don't have any fast-timestep processes + ! Think of this as a stub. + + + return + end subroutine FastPRTAllometricCarbonSimpler + end module PRTAllometricCarbonMod diff --git a/parteh/PRTGenericMod.F90 b/parteh/PRTGenericMod.F90 index 76d0e01eda..32c7deb5cf 100644 --- a/parteh/PRTGenericMod.F90 +++ b/parteh/PRTGenericMod.F90 @@ -66,6 +66,7 @@ module PRTGenericMod ! These should each have their own module ! ------------------------------------------------------------------------------------- + integer, parameter, public :: prt_csimpler_allom_hyp = 0 integer, parameter, public :: prt_carbon_allom_hyp = 1 integer, parameter, public :: prt_cnp_flex_allom_hyp = 2 ! Still under development diff --git a/parteh/PRTParamsFATESMod.F90 b/parteh/PRTParamsFATESMod.F90 index dce172d47d..758080e1b9 100644 --- a/parteh/PRTParamsFATESMod.F90 +++ b/parteh/PRTParamsFATESMod.F90 @@ -17,7 +17,9 @@ module PRTInitParamsFatesMod use FatesGlobals, only : fates_log use shr_log_mod, only : errMsg => shr_log_errMsg use EDPftvarcon, only : EDPftvarcon_inst - use PRTGenericMod, only : prt_cnp_flex_allom_hyp,prt_carbon_allom_hyp + use PRTGenericMod, only : prt_cnp_flex_allom_hyp + use PRTGenericMod, only : prt_carbon_allom_hyp + use PRTGenericMod, only : prt_csimpler_allom_hyp use FatesAllometryMod , only : h_allom use FatesAllometryMod , only : h2d_allom use FatesAllometryMod , only : bagw_allom @@ -1005,12 +1007,12 @@ subroutine PRTCheckParams(is_master) ! Check to make sure the organ ids are valid if this is the ! cnp_flex_allom_hypothesis - if ((hlm_parteh_mode .eq. prt_cnp_flex_allom_hyp) .or. & - (hlm_parteh_mode .eq. prt_carbon_allom_hyp) ) then + select case (hlm_parteh_mode) + case (prt_csimpler_allom_hyp,prt_carbon_allom_hyp,prt_cnp_flex_allom_hyp) do io = 1,norgans if(prt_params%organ_id(io) == repro_organ) then - write(fates_log(),*) 'with flexible cnp or c-only alloc hypothesese' + write(fates_log(),*) 'with flexible cnp or c-only alloc hypotheses' write(fates_log(),*) 'reproductive tissues are a special case' write(fates_log(),*) 'and therefore should not be included in' write(fates_log(),*) 'the parameter file organ list' @@ -1027,7 +1029,7 @@ subroutine PRTCheckParams(is_master) end if end do - end if + end select pftloop: do ipft = 1,npft @@ -1119,9 +1121,10 @@ subroutine PRTCheckParams(is_master) ! should not be re-translocating mass upon turnover. ! Note to advanced users. Feel free to remove these checks... ! ------------------------------------------------------------------- - - if ((hlm_parteh_mode .eq. prt_cnp_flex_allom_hyp) .or. & - (hlm_parteh_mode .eq. prt_carbon_allom_hyp) ) then + select case (hlm_parteh_mode) + case (prt_csimpler_allom_hyp,prt_carbon_allom_hyp,prt_cnp_flex_allom_hyp) + if ((hlm_parteh_mode .eq. ) .or. & + (hlm_parteh_mode .eq. ) ) then do i = 1,norgans io = prt_params%organ_id(i) @@ -1249,8 +1252,8 @@ subroutine PRTCheckParams(is_master) ! end if ! end if - if ((hlm_parteh_mode .eq. prt_cnp_flex_allom_hyp) .or. & - (hlm_parteh_mode .eq. prt_carbon_allom_hyp) ) then + select case (hlm_parteh_mode) + case (prt_csimpler_allom_hyp,prt_carbon_allom_hyp,prt_cnp_flex_allom_hyp) ! The first nitrogen stoichiometry is used in all cases if ( (any(prt_params%nitr_stoich_p1(ipft,:) < 0.0_r8)) .or. & (any(prt_params%nitr_stoich_p1(ipft,:) >= 1.0_r8))) then @@ -1260,7 +1263,7 @@ subroutine PRTCheckParams(is_master) write(fates_log(),*) ' Aborting' call endrun(msg=errMsg(sourcefile, __LINE__)) end if - end if + end select if(hlm_parteh_mode .eq. prt_cnp_flex_allom_hyp) then From 089bf2357960b2e9c975140b76c3260bbc140e5e Mon Sep 17 00:00:00 2001 From: Marcos Longo Date: Wed, 3 Nov 2021 15:21:08 -0700 Subject: [PATCH 06/11] Resolved conflict that I had forgotten to resolve. --- main/EDInitMod.F90 | 60 +--------------------------------------------- 1 file changed, 1 insertion(+), 59 deletions(-) diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index d24f9b144b..70391629fb 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -856,7 +856,7 @@ subroutine init_cohorts( site_in, patch_in, bc_in) end select select case(hlm_parteh_mode) - case (prt_carbon_allom_hyp,prt_cnp_flex_allom_hyp ) + case (prt_csimpler_allom_hyp,prt_carbon_allom_hyp,prt_cnp_flex_allom_hyp ) ! Put all of the leaf mass into the first bin call SetState(prt_obj,leaf_organ, element_id,m_leaf,1) @@ -875,64 +875,6 @@ subroutine init_cohorts( site_in, patch_in, bc_in) call endrun(msg=errMsg(sourcefile, __LINE__)) end select -<<<<<<< HEAD - if ( debug ) write(fates_log(),*) 'EDInitMod.F90 call create_cohort ' - - temp_cohort%coage = 0.0_r8 - - - ! -------------------------------------------------------------------------------- - ! Initialize the mass of every element in every organ of the organ - ! -------------------------------------------------------------------------------- - - prt_obj => null() - call InitPRTObject(prt_obj) - - do el = 1,num_elements - - element_id = element_list(el) - - ! If this is carbon12, then the initialization is straight forward - ! otherwise, we use stoichiometric ratios - select case(element_id) - case(carbon12_element) - - m_struct = c_struct - m_leaf = c_leaf - m_fnrt = c_fnrt - m_sapw = c_sapw - m_store = c_store - m_repro = 0._r8 - - case(nitrogen_element) - - m_struct = c_struct*prt_params%nitr_stoich_p2(pft,prt_params%organ_param_id(struct_organ)) - 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_store = StorageNutrientTarget(pft,element_id,m_leaf,m_fnrt,m_sapw,m_struct) - - case(phosphorus_element) - - m_struct = c_struct*prt_params%phos_stoich_p2(pft,prt_params%organ_param_id(struct_organ)) - 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_store = StorageNutrientTarget(pft,element_id,m_leaf,m_fnrt,m_sapw,m_struct) - - end select - - select case(hlm_parteh_mode) - case (prt_csimpler_allom_hyp,prt_carbon_allom_hyp,prt_cnp_flex_allom_hyp ) - - ! Put all of the leaf mass into the first bin - call SetState(prt_obj,leaf_organ, element_id,m_leaf,1) - do iage = 2,nleafage - call SetState(prt_obj,leaf_organ, element_id,0._r8,iage) -======= ->>>>>>> 3ebf2b925bd652d9ff8a18781693b5aed1e61154 end do call prt_obj%CheckInitialConditions() From 944455a704868bdbd1ca1243247e0d1a02010ce4 Mon Sep 17 00:00:00 2001 From: Marcos Longo Date: Wed, 3 Nov 2021 15:42:42 -0700 Subject: [PATCH 07/11] Fixed ctrl-c ctrl-v mistake when resolving conflicts (sigh). --- main/EDPftvarcon.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/main/EDPftvarcon.F90 b/main/EDPftvarcon.F90 index b8f4621fbb..18fd81ca87 100644 --- a/main/EDPftvarcon.F90 +++ b/main/EDPftvarcon.F90 @@ -1536,7 +1536,7 @@ subroutine FatesCheckParams(is_master) end if end if - case (prt_carbon_allom_hyp,prt_carbon_allom_hyp) + case (prt_csimpler_allom_hyp,prt_carbon_allom_hyp) ! No additional checks needed for now. continue From 0ad213dac4db970c7b4069c799f085d7e297a2eb Mon Sep 17 00:00:00 2001 From: Marcos Longo Date: Wed, 3 Nov 2021 15:52:11 -0700 Subject: [PATCH 08/11] Deleted if statement that was replaced with select case (sigh again). --- parteh/PRTParamsFATESMod.F90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/parteh/PRTParamsFATESMod.F90 b/parteh/PRTParamsFATESMod.F90 index d7ded1a529..7a54c060f2 100644 --- a/parteh/PRTParamsFATESMod.F90 +++ b/parteh/PRTParamsFATESMod.F90 @@ -1132,8 +1132,6 @@ subroutine PRTCheckParams(is_master) ! ------------------------------------------------------------------- select case (hlm_parteh_mode) case (prt_csimpler_allom_hyp,prt_carbon_allom_hyp,prt_cnp_flex_allom_hyp) - if ((hlm_parteh_mode .eq. ) .or. & - (hlm_parteh_mode .eq. ) ) then do i = 1,norgans io = prt_params%organ_id(i) From d653c832a6310627ebb8af124789e8fdf0b1d883 Mon Sep 17 00:00:00 2001 From: Marcos Longo Date: Wed, 3 Nov 2021 16:01:06 -0700 Subject: [PATCH 09/11] Fixing another typo in PRTParamsFATESMod.F90 (forgot to replace end if with end select). And now all tests for hlm_parteh_mode use select case, which is safer for options in any case. --- parteh/PRTParamsFATESMod.F90 | 19 ++++++++++--------- 1 file changed, 10 insertions(+), 9 deletions(-) diff --git a/parteh/PRTParamsFATESMod.F90 b/parteh/PRTParamsFATESMod.F90 index 7a54c060f2..62620f7d44 100644 --- a/parteh/PRTParamsFATESMod.F90 +++ b/parteh/PRTParamsFATESMod.F90 @@ -1166,10 +1166,11 @@ subroutine PRTCheckParams(is_master) end if end do - end if - - if (hlm_parteh_mode .eq. prt_cnp_flex_allom_hyp) then - + end select + + select case (hlm_parteh_mode) + case (prt_cnp_flex_allom_hyp) + ! Make sure nutrient storage fractions are positive if( prt_params%nitr_store_ratio(ipft) < 0._r8 ) then write(fates_log(),*) 'With parteh allometric CNP hypothesis' @@ -1236,9 +1237,8 @@ subroutine PRTCheckParams(is_master) end if end do - - end if - + + end select ! Growth respiration ! if (parteh_mode .eq. prt_carbon_allom_hyp) then @@ -1272,7 +1272,8 @@ subroutine PRTCheckParams(is_master) end if end select - if(hlm_parteh_mode .eq. prt_cnp_flex_allom_hyp) then + select case (hlm_parteh_mode) + case (prt_cnp_flex_allom_hyp) do i = 1,norgans if ( (prt_params%nitr_stoich_p1(ipft,i) < 0._r8) .or. & @@ -1310,7 +1311,7 @@ subroutine PRTCheckParams(is_master) call endrun(msg=errMsg(sourcefile, __LINE__)) end if - end if + end select ! Check turnover time-scales From 80377ebd9365f969a3543becee4617f3529cae7d Mon Sep 17 00:00:00 2001 From: Marcos Longo Date: Thu, 11 Nov 2021 15:00:25 -0800 Subject: [PATCH 10/11] Revised soil water stress tracking for drought deciduous. I updated the soil moisture / soil matric potential variable to skip the topmost layer. I did not change the rooting depth profile, instead I simply ignored the contribution of the top most layer. This layer dries out rather quickly and experience very negative values, which ultimately keeps plants under "leaves off" state for too long. --- biogeochem/EDPhysiologyMod.F90 | 37 +++++++++++++++++++--------------- 1 file changed, 21 insertions(+), 16 deletions(-) diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 461b4288eb..fb7bf0a008 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -725,6 +725,7 @@ subroutine phenology( currentSite, bc_in ) real(r8) :: store_c ! storage carbon [kg] real(r8) :: struct_c ! structure carbon [kg] real(r8) :: gdd_threshold ! GDD accumulation function, + real(r8) :: rootfrac_notop ! Total rooting fraction excluding the top soil layer integer :: ncdstart ! beginning of counting period for chilling degree days. integer :: gddstart ! beginning of counting period for growing degree days. integer :: nlevroot ! Number of rooting levels to consider @@ -744,10 +745,6 @@ subroutine phenology( currentSite, bc_in ) integer, parameter :: dd_offon_toler = 30 ! When flushing or shedding leaves, we check that ! the dates are near last year's dates. This controls ! the tolerance for deviating from last year. - real(r8), parameter :: smp_off = -0.001_r8 ! Offset to be applied to soil matric potential when - ! taking the log-averages. This avoids FPE in the - ! unlikely case that SMP = 0. (which may occur - ! depending on the hydrology formulation). ! This is the integer model day. The first day of the simulation is 1, and it ! continues monotonically, indefinitely model_day_int = nint(hlm_model_day) @@ -963,7 +960,7 @@ subroutine phenology( currentSite, bc_in ) pft_drgt_loop: do ft=1,numpft ! Update soil moisture information memory (we always track the last 10 days) - do i_wmem = numWaterMem,2,-1 !shift memory along one + do i_wmem = numWaterMem,2,-1 !shift memory to previous day, to make room for current day currentSite%liqvol_memory(i_wmem,ft) = currentSite%liqvol_memory(i_wmem-1,ft) currentSite%smp_memory (i_wmem,ft) = currentSite%smp_memory (i_wmem-1,ft) end do @@ -971,19 +968,27 @@ subroutine phenology( currentSite, bc_in ) ! Find the rooting depth distribution for PFT call set_root_fraction( currentSite%rootfrac_scr, ft, currentSite%zi_soil, & bc_in%max_rooting_depth_index_col ) - nlevroot = min(ubound(currentSite%zi_soil,1),bc_in%max_rooting_depth_index_col) + nlevroot = max(2,min(ubound(currentSite%zi_soil,1),bc_in%max_rooting_depth_index_col)) + + ! The top most layer is typically very thin (~ 2cm) and dries rather quickly. Despite + ! being thin, it can have a non-negligible rooting fraction (e.g., using + ! exponential_2p_root_profile with default parameters make the top layer to contain + ! about 7% of the total fine root density). To avoid overestimating dryness, we + ! ignore the top layer when calculating the memory. + rootfrac_notop = sum(currentSite%rootfrac_scr(2:nlevroot)) + if ( rootfrac_notop <= nearzero ) then + ! Unlikely, but just in case all roots are in the first layer, we use the second + ! layer the second layer (to avoid FPE issues). + currentSite%rootfrac_scr(2) = 1.0_r8 + rootfrac_notop = 1.0_r8 + end if ! Set the memory to be the weighted average of the soil properties, using the - ! root fraction of each layer as the weighting factor. Because soil matric potential - ! has a very skewed vertical distribution, we average the logarithm of -1*SMP. - ! It is unlike, but SMP can be zero under saturated conditions depending on the hydrological - ! model. To reduce risks of FPE, we include a small offset to SMP before applying log averages. - ! This will bias the average, but the bias should be negligible as long as smp_off is much - ! smaller than the typical values. - currentSite%liqvol_memory(1,ft) = sum( bc_in%h2o_liqvol_sl (1:nlevroot) * & - currentSite%rootfrac_scr(1:nlevroot) ) - currentSite%smp_memory (1,ft) = -exp( sum( log(-(bc_in%smp_sl (1:nlevroot)+smp_off)) * & - currentSite%rootfrac_scr(1:nlevroot) )) - smp_off + ! root fraction of each layer (except the topmost one) as the weighting factor. + currentSite%liqvol_memory(1,ft) = sum( bc_in%h2o_liqvol_sl (2:nlevroot) * & + currentSite%rootfrac_scr(2:nlevroot) ) / rootfrac_notop + currentSite%smp_memory (1,ft) = sum( bc_in%smp_sl (2:nlevroot) * & + currentSite%rootfrac_scr(2:nlevroot) ) / rootfrac_notop ! Calculate the mean soil moisture ( liquid volume (m3/m3) and matric potential (mm)) ! over the last 10 days From f3643aa173ae6245aef8b2a6258aaf9862bcc59c Mon Sep 17 00:00:00 2001 From: Marcos Longo Date: Tue, 15 Feb 2022 08:13:33 -0800 Subject: [PATCH 11/11] Added option for semi-drought deciduous, similar to the ED2 drought deciduous phenology. A few new settings were included in fates_params_default.cdl to account for deciduousness: 1. The drought deciduous model is set by fates_phen_drought_model: 0 - FATES uses the default approach. 1 - FATES uses the semi-deciduous approach. 2. If fates_phen_drought_model = 1, the deciduousness will be defined by two soil moisture (or soil matric potential) thresholds. fates_phen_drought_threshold - Lower threshold, below which plants will be completely leafless. fates_phen_moist_threshold - Upper threshold, above which plants will have fully flushed canopy. 3. Regardless of the drought deciduous model, a new variable fates_phen_fnrt_drop_fraction was included to allow drought-deciduous plants to actively "shed" fine roots. 0 - Fine roots will not be shed (though the code will stop allocating to fine roots if plants are shedding leaves). 1 - Fine roots will be shed at the same rate as leaves. Values between 0 and 1 are accepted and will allow for slower shedding of fine roots. This option allows for partial leaf abscission and flushing. Complete loss of leaf canopy will occur when soil moisture/matric potent --- biogeochem/EDCohortDynamicsMod.F90 | 37 +- biogeochem/EDPhysiologyMod.F90 | 580 +++++++++++++++-------- biogeochem/FatesAllometryMod.F90 | 62 ++- main/EDInitMod.F90 | 98 ++-- main/EDParamsMod.F90 | 32 +- main/EDPftvarcon.F90 | 66 ++- main/EDTypesMod.F90 | 37 +- main/FatesHistoryInterfaceMod.F90 | 9 + main/FatesInventoryInitMod.F90 | 98 ++-- main/FatesRestartInterfaceMod.F90 | 36 ++ parameter_files/fates_params_default.cdl | 19 +- parteh/PRTAllometricCNPMod.F90 | 266 +++++++---- parteh/PRTAllometricCarbonMod.F90 | 571 ++++++++++++---------- parteh/PRTParametersMod.F90 | 5 +- parteh/PRTParamsFATESMod.F90 | 29 +- 15 files changed, 1297 insertions(+), 648 deletions(-) diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index cc98943483..b070933b3a 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -90,9 +90,15 @@ module EDCohortDynamicsMod use PRTAllometricCarbonMod, only : ac_bc_in_id_ctrim use PRTAllometricCarbonMod, only : ac_bc_inout_id_dbh use PRTAllometricCarbonMod, only : ac_bc_in_id_lstat + use PRTAllometricCarbonMod, only : ac_bc_in_id_efleaf + use PRTAllometricCarbonMod, only : ac_bc_in_id_effnrt + use PRTAllometricCarbonMod, only : ac_bc_in_id_efstem 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_efleaf + use PRTAllometricCNPMod, only : acnp_bc_in_id_effnrt + use PRTAllometricCNPMod, only : acnp_bc_in_id_efstem 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 @@ -147,7 +153,8 @@ module EDCohortDynamicsMod subroutine create_cohort(currentSite, patchptr, pft, nn, hite, coage, dbh, & prt, leafmemory, fnrtmemory, sapwmemory, structmemory, & - status, recruitstatus,ctrim, carea, clayer, spread, bc_in) + elongf_leaf, elongf_fnrt, elongf_stem, status, & + recruitstatus, ctrim, carea, clayer, spread, bc_in) ! ! !DESCRIPTION: ! create new cohort @@ -170,7 +177,7 @@ subroutine create_cohort(currentSite, patchptr, pft, nn, hite, coage, dbh, & integer, intent(in) :: clayer ! canopy status of cohort ! (1 = canopy, 2 = understorey, etc.) integer, intent(in) :: status ! growth status of plant - ! (2 = leaves on , 1 = leaves off) + ! (1 = abscissing, 2 = flushing) integer, intent(in) :: recruitstatus ! recruit status of plant ! (1 = recruitment , 0 = other) real(r8), intent(in) :: nn ! number of individuals in cohort @@ -178,6 +185,12 @@ subroutine create_cohort(currentSite, patchptr, pft, nn, hite, coage, dbh, & real(r8), intent(in) :: hite ! height: meters real(r8), intent(in) :: coage ! cohort age in years real(r8), intent(in) :: dbh ! dbh: cm + real(r8), intent(in) :: elongf_leaf ! leaf elongation factor (fraction) + real(r8), intent(in) :: elongf_fnrt ! fine-root "elongation factor" (fraction) + real(r8), intent(in) :: elongf_stem ! stem "elongation factor" (fraction) + ! For all elongation factors: + ! 0 means fully abscissed + ! 1 means fully flushed class(prt_vartypes),target :: prt ! The allocated PARTEH ! object real(r8), intent(in) :: leafmemory ! target leaf biomass- set from @@ -231,6 +244,9 @@ subroutine create_cohort(currentSite, patchptr, pft, nn, hite, coage, dbh, & new_cohort%pft = pft new_cohort%status_coh = status + new_cohort%efleaf_coh = elongf_leaf + new_cohort%effnrt_coh = elongf_fnrt + new_cohort%efstem_coh = elongf_stem new_cohort%n = nn new_cohort%hite = hite new_cohort%dbh = dbh @@ -405,12 +421,18 @@ 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) + call new_cohort%prt%RegisterBCIn(ac_bc_in_id_efleaf,bc_rval = new_cohort%efleaf_coh) + call new_cohort%prt%RegisterBCIn(ac_bc_in_id_effnrt,bc_rval = new_cohort%effnrt_coh) + call new_cohort%prt%RegisterBCIn(ac_bc_in_id_efstem,bc_rval = new_cohort%efstem_coh) case (prt_cnp_flex_allom_hyp) call new_cohort%prt%RegisterBCIn(acnp_bc_in_id_pft,bc_ival = new_cohort%pft) 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_efleaf,bc_rval = new_cohort%efleaf_coh) + call new_cohort%prt%RegisterBCIn(acnp_bc_in_id_effnrt,bc_rval = new_cohort%effnrt_coh) + call new_cohort%prt%RegisterBCIn(acnp_bc_in_id_efstem,bc_rval = new_cohort%efstem_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) @@ -532,7 +554,10 @@ subroutine nan_cohort(cc_p) currentCohort%canopy_layer = fates_unset_int ! canopy status of cohort (1 = canopy, 2 = understorey, etc.) currentCohort%canopy_layer_yesterday = nan ! recent canopy status of cohort (1 = canopy, 2 = understorey, etc.) currentCohort%NV = fates_unset_int ! Number of leaf layers: - - currentCohort%status_coh = fates_unset_int ! growth status of plant (2 = leaves on , 1 = leaves off) + currentCohort%status_coh = fates_unset_int ! growth status of plant (2 = flushing , 1 = fully abscissed, 3 = abscissing) + currentCohort%efleaf_coh = nan ! leaf elongation factor (fraction from 0 (fully abscissed) to 1 (fully flushed) + currentCohort%effnrt_coh = nan ! fine-root "elongation factor" (fraction from 0 (fully abscissed) to 1 (fully flushed) + currentCohort%efstem_coh = nan ! stem "elongation factor" (fraction from 0 (fully abscissed) to 1 (fully flushed) currentCohort%size_class = fates_unset_int ! size class index currentCohort%size_class_lasttimestep = fates_unset_int ! size class index currentCohort%size_by_pft_class = fates_unset_int ! size by pft classification index @@ -650,6 +675,9 @@ subroutine zero_cohort(cc_p) currentCohort%NV = 0 currentCohort%status_coh = 0 + currentCohort%efleaf_coh = 0._r8 + currentCohort%effnrt_coh = 0._r8 + currentCohort%efstem_coh = 0._r8 currentCohort%rdark = 0._r8 currentCohort%resp_m = 0._r8 currentCohort%resp_m_def = 0._r8 @@ -1803,6 +1831,9 @@ subroutine copy_cohort( currentCohort,copyc ) n%canopy_layer_yesterday = o%canopy_layer_yesterday n%nv = o%nv n%status_coh = o%status_coh + n%efleaf_coh = o%efleaf_coh + n%effnrt_coh = o%effnrt_coh + n%efstem_coh = o%efstem_coh n%canopy_trim = o%canopy_trim n%excl_weight = o%excl_weight n%prom_weight = o%prom_weight diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index fb7bf0a008..12de37bd43 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -48,10 +48,9 @@ module EDPhysiologyMod use EDTypesMod , only : num_vegtemp_mem use EDTypesMod , only : maxpft use EDTypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type - use EDTypesMod , only : phen_ref_liqvol - use EDTypesMod , only : phen_ref_smp use EDTypesMod , only : leaves_on use EDTypesMod , only : leaves_off + use EDTypesMod , only : leaves_pshed use EDTypesMod , only : min_n_safemath use PRTGenericMod , only : num_elements use PRTGenericMod , only : element_list @@ -64,6 +63,9 @@ module EDPhysiologyMod use EDTypesMod , only : phen_dstat_moistoff use EDTypesMod , only : phen_dstat_moiston use EDTypesMod , only : phen_dstat_timeon + use EDTypesMod , only : phen_dstat_pshed + use EDTypesMod , only : drgt_phen_model_smoist + use EDTypesMod , only : drgt_phen_model_gradual use EDTypesMod , only : init_recruit_trim use shr_log_mod , only : errMsg => shr_log_errMsg use FatesGlobals , only : fates_log @@ -602,10 +604,6 @@ subroutine trim_canopy( currentSite ) if (currentCohort%hite > EDPftvarcon_inst%hgt_min(ipft)) then currentCohort%canopy_trim = currentCohort%canopy_trim - & EDPftvarcon_inst%trim_inc(ipft) - if (prt_params%evergreen(ipft) /= 1)then - currentCohort%leafmemory = currentCohort%leafmemory * & - (1.0_r8 - EDPftvarcon_inst%trim_inc(ipft)) - endif trimmed = .true. @@ -698,7 +696,11 @@ subroutine phenology( currentSite, bc_in ) ! ! !USES: use FatesConstantsMod, only : tfrz => t_water_freeze_k_1atm - use EDParamsMod, only : ED_val_phen_drought_threshold, ED_val_phen_doff_time + use EDParamsMod, only : phen_drought_model + use EDParamsMod, only : ED_val_phen_doff_time + use EDParamsMod, only : ED_val_phen_drought_threshold + use EDParamsMod, only : ED_val_phen_moist_threshold + use EDParamsMod, only : ED_val_phen_doff_time use EDParamsMod, only : ED_val_phen_a, ED_val_phen_b, ED_val_phen_c, ED_val_phen_chiltemp use EDParamsMod, only : ED_val_phen_mindayson, ED_val_phen_ncolddayslim, ED_val_phen_coldtemp @@ -730,8 +732,17 @@ subroutine phenology( currentSite, bc_in ) integer :: gddstart ! beginning of counting period for growing degree days. integer :: nlevroot ! Number of rooting levels to consider real(r8) :: temp_in_C ! daily averaged temperature in celsius - - logical :: smoist_below_threshold ! Is Soil moisture below threshold? + real(r8) :: elongf_prev ! Elongation factor from previous time + real(r8) :: elongf_1st ! First guess for elongation factor + + logical :: smoist_below_threshold ! Is soil moisture below threshold? + logical :: recent_flush ! Last full flushing event is still very recent. + logical :: recent_abscission ! Last abscission event is still very recent. + logical :: exceed_min_on_period ! Have leaves been flushed for a minimum period of time? + logical :: exceed_min_off_period ! Have leaves been off for a minimum period of time? + logical :: prolonged_on_period ! Has leaves been flushed for too long? + logical :: prolonged_off_period ! Have leaves been abscissed for too long? + logical :: last_flush_long_ago ! Has it been a very long time since last flushing? integer, parameter :: canopy_leaf_lifespan = 365 ! Maximum lifespan of drought decid leaves @@ -745,6 +756,14 @@ subroutine phenology( currentSite, bc_in ) integer, parameter :: dd_offon_toler = 30 ! When flushing or shedding leaves, we check that ! the dates are near last year's dates. This controls ! the tolerance for deviating from last year. + + real(r8), parameter :: elongf_min = 0.05_r8 ! Minimum elongation factor. If elongation factor + ! reaches or falls below elongf_min, we assume + ! complete abscission. This avoids carrying out + ! a residual amount of leaves, which may create + ! computational problems. The current threshold + ! is the same used in ED-2.2. + ! This is the integer model day. The first day of the simulation is 1, and it ! continues monotonically, indefinitely model_day_int = nint(hlm_model_day) @@ -936,29 +955,11 @@ subroutine phenology( currentSite, bc_in ) ! to come into equlibirium. ! E*: If the soil is always wet, the leaves come on at the beginning of the window, and then ! last for their lifespan. - ! ISSUES - ! 1. It's not clear what water content we should track. Here we are tracking the top layer, - ! but we probably should track something like BTRAN, but BTRAN is defined for each PFT, - ! and there could potentially be more than one stress-dec PFT.... ? - ! 2. In the beginning, the window is set at an arbitrary time of the year, so the leaves - ! might come on in the dry season, using up stored reserves - ! for the stress-dec plants, and potentially killing them. To get around this, - ! we need to read in the 'leaf on' date from some kind of start-up file - ! but we would need that to happen for every resolution, etc. - ! 3. Will this methodology properly kill off the stress-dec trees where there is no - ! water stress? What about where the wet period coincides with the warm period? - ! We would just get them overlapping with the cold-dec trees, even though that isn't appropriate - ! Why don't the drought deciduous trees grow in the North? - ! Is cold decidousness maybe even the same as drought deciduosness there (and so does this - ! distinction actually matter??).... - ! MLO. They are probably not the same: unlike cold deciduous temperatures are high when - ! drought deciduous leaves are off, which means that their maintenance respiration is high - ! during the leaf-off season. For them to be viable, we may need different allocation - ! strategies so they don't exhaust their storage to maintain fine roots and sapwood. ! Add PFT look to account for different PFT rooting depth profiles. pft_drgt_loop: do ft=1,numpft + ! Update soil moisture information memory (we always track the last 10 days) do i_wmem = numWaterMem,2,-1 !shift memory to previous day, to make room for current day currentSite%liqvol_memory(i_wmem,ft) = currentSite%liqvol_memory(i_wmem-1,ft) @@ -1004,107 +1005,211 @@ subroutine phenology( currentSite, bc_in ) smoist_below_threshold = mean_10day_smp < ED_val_phen_drought_threshold end if - - ! In drought phenology, we often need to force the leaves to stay - ! on or off as moisture fluctuates... - - ! Calculate days since leaves have come off, but make a provision - ! for the first year of simulation, we have to assume a leaf drop - ! date to start, so if that is in the future, set it to last year + ! Calculate days since last flushing and shedding event, but make a provision + ! for the first year of simulation, we have to assume leaf drop / leaf flush + ! dates to start, so if that is in the future, set it to last year if (model_day_int < currentSite%dleafoffdate(ft)) then currentSite%dndaysleafoff(ft) = model_day_int - (currentSite%dleafoffdate(ft)-365) else currentSite%dndaysleafoff(ft) = model_day_int - currentSite%dleafoffdate(ft) - endif - - ! the leaves are on. How long have they been on? + end if if (model_day_int < currentSite%dleafondate(ft)) then currentSite%dndaysleafon(ft) = model_day_int - (currentSite%dleafondate(ft)-365) else currentSite%dndaysleafon(ft) = model_day_int - currentSite%dleafondate(ft) - endif + end if - ! LEAF ON: DROUGHT DECIDUOUS WETNESS - ! Here, we used a window of oppurtunity to determine if we are - ! close to the time when then leaves came on last year - - ! Has it been ... - ! a) a year, plus or minus 1 month since we last had leaf-on? - ! b) Has there also been at least a nominaly short amount of "leaf-off" - ! c) is the model day at least > 10 (let soil water spin-up) - ! Note that cold-starts begin in the "leaf-on" - ! status - if ( (currentSite%dstatus(ft) == phen_dstat_timeoff .or. & - currentSite%dstatus(ft) == phen_dstat_moistoff) .and. & - (model_day_int > numWaterMem) .and. & - (currentSite%dndaysleafon(ft) >= 365-dd_offon_toler .and. & - currentSite%dndaysleafon(ft) <= 365+dd_offon_toler ) .and. & - (currentSite%dndaysleafoff(ft) > ED_val_phen_doff_time) ) then - - ! If leaves are off, and have been off for at least a few days - ! and the time is consistent with the correct - ! time window... test if the moisture conditions allow for leaf-on - if ( .not. smoist_below_threshold ) then - currentSite%dstatus(ft) = phen_dstat_moiston ! set status to leaf-on - currentSite%dleafondate(ft) = model_day_int ! save the model day we start flushing + ! Elongation factor from the previous step. + elongf_prev = currentSite%elong_factor(ft) + + + + + + ! Find elongation factor by comparing the moisture with the thresholds. + case_drought_phen: select case (phen_drought_model) + case (drgt_phen_model_smoist) + !------ + ! Default drought deciduous phenology. + !------ + + ! In drought phenology, we often need to force the leaves to stay + ! on or off as moisture fluctuates... + + + ! Save some conditions in logical variables to simplify code below + exceed_min_on_period = & + any( currentSite%dstatus(ft) == [phen_dstat_timeon,phen_dstat_moiston] ) .and. & + (currentSite%dndaysleafon(ft) > dleafon_drycheck) + exceed_min_off_period = & + ( currentSite%dstatus(ft) == phen_dstat_timeoff ) .and. & + ( currentSite%dndaysleafoff(ft) > min_daysoff_dforcedflush ) + prolonged_on_period = & + any( currentSite%dstatus(ft) == [phen_dstat_timeon,phen_dstat_moiston] ) .and. & + ( currentSite%dndaysleafon(ft) > canopy_leaf_lifespan ) + prolonged_off_period = & + any( currentSite%dstatus(ft) == [phen_dstat_timeoff,phen_dstat_moistoff] ) .and. & + ( currentSite%dndaysleafoff(ft) > ED_val_phen_doff_time ) .and. & + ( currentSite%dndaysleafon(ft) >= 365-dd_offon_toler ) .and. & + ( currentSite%dndaysleafon(ft) <= 365+dd_offon_toler ) + last_flush_long_ago = & + ( currentSite%dstatus(ft) == phen_dstat_moistoff ) .and. & + ( currentSite%dndaysleafon(ft) > 365+dd_offon_toler ) + + + ! Revision of the conditions to simplify nested if and added an if/elseif/else + ! structure to ensure only up to one change occurs at any given time (ML 20211120). + drought_smoist_ifelse: if (model_day_int <= numWaterMem) then + ! Too early in the simulation. Do not change phenology status as we need to + ! populate the soil moisture memory. + continue + + elseif ( prolonged_off_period .and. ( .not. smoist_below_threshold ) ) then + ! LEAF ON: DROUGHT DECIDUOUS WETNESS + ! Here, we used a window of oppurtunity to determine if we are + ! close to the time when then leaves came on last year + ! The following conditions must be met + ! a) a year, plus or minus 1 month since we last had leaf-on? + ! b) Has there also been at least a nominaly short amount of "leaf-off"? + ! c) Is the soil moisture sufficiently high? + currentSite%dstatus(ft) = phen_dstat_moiston ! set status to leaf-on + currentSite%dleafondate(ft) = model_day_int ! save the model day we start flushing currentSite%dndaysleafon(ft) = 0 - endif - endif - - ! LEAF ON: DROUGHT DECIDUOUS TIME EXCEEDANCE - ! If we still haven't done budburst by end of window, then force it + currentSite%elong_factor(ft) = 1. - ! If the status is "phen_dstat_moistoff", it means this site currently has - ! leaves off due to actual moisture limitations. - ! So we trigger bud-burst at the end of the month since - ! last year's bud-burst. If this is imposed, then we set the new - ! status to indicate bud-burst was forced by timing + elseif ( last_flush_long_ago ) then + ! LEAF ON: DROUGHT DECIDUOUS TIME EXCEEDANCE + ! If we still haven't done budburst by end of window, then force it - if( currentSite%dstatus(ft) == phen_dstat_moistoff ) then - if ( currentSite%dndaysleafon(ft) > 365+dd_offon_toler ) then + ! If the status is "phen_dstat_moistoff", it means this site currently has + ! leaves off due to actual moisture limitations. + ! So we trigger bud-burst at the end of the month since + ! last year's bud-burst. If this is imposed, then we set the new + ! status to indicate bud-burst was forced by timing currentSite%dstatus(ft) = phen_dstat_timeon ! force budburst! currentSite%dleafondate(ft) = model_day_int ! record leaf on date currentSite%dndaysleafon(ft) = 0 - end if - end if - - ! But if leaves are off due to time, then we enforce - ! a longer cool-down (because this is a perrenially wet system) + currentSite%elong_factor(ft) = 1. - if(currentSite%dstatus(ft) == phen_dstat_timeoff ) then - if (currentSite%dndaysleafoff(ft) > min_daysoff_dforcedflush) then + elseif ( exceed_min_off_period ) then + ! LEAF ON: DROUGHT DECIDUOUS EXCEEDED MINIMUM OFF PERIOD + ! Leaves were off due to time, not really moisture, so we allow them to + ! flush again as soon as they exceed a minimum off time + ! This typically occurs in a perennially wet system. currentSite%dstatus(ft) = phen_dstat_timeon ! force budburst! currentSite%dleafondate(ft) = model_day_int ! record leaf on date currentSite%dndaysleafon(ft) = 0 - end if - end if + currentSite%elong_factor(ft) = 1. - ! LEAF OFF: DROUGHT DECIDUOUS LIFESPAN - if the leaf gets to - ! the end of its useful life. A*, E* - ! i.e. Are the leaves rouhgly at the end of their lives? - - if ( (currentSite%dstatus(ft) == phen_dstat_moiston .or. & - currentSite%dstatus(ft) == phen_dstat_timeon ) .and. & - (currentSite%dndaysleafon(ft) > canopy_leaf_lifespan) )then + elseif ( prolonged_on_period ) then + ! LEAF OFF: DROUGHT DECIDUOUS LIFESPAN + ! Are the leaves rouhgly at the end of their lives? If so, shed leaves + ! even if it is not dry. currentSite%dstatus(ft) = phen_dstat_timeoff !alter status of site to 'leaves off' currentSite%dleafoffdate(ft) = model_day_int !record leaf on date currentSite%dndaysleafoff(ft) = 0 - endif + currentSite%elong_factor(ft) = 0. - ! LEAF OFF: DROUGHT DECIDUOUS DRYNESS - if the soil gets too dry, - ! and the leaves have already been on a while... - - if ( (currentSite%dstatus(ft) == phen_dstat_moiston .or. & - currentSite%dstatus(ft) == phen_dstat_timeon ) .and. & - (model_day_int > numWaterMem) .and. & - smoist_below_threshold .and. & - (currentSite%dndaysleafon(ft) > dleafon_drycheck ) ) then - currentSite%dstatus(ft) = phen_dstat_moistoff ! alter status of site to 'leaves off' - currentSite%dleafoffdate(ft) = model_day_int ! record leaf on date - currentSite%dndaysleafoff(ft) = 0 - endif + elseif ( exceed_min_on_period .and. smoist_below_threshold ) then + ! LEAF OFF: DROUGHT DECIDUOUS DRYNESS - if the soil gets too dry, + ! and the leaves have already been on a while... + currentSite%dstatus(ft) = phen_dstat_moistoff ! alter status of site to 'leaves off' + currentSite%dleafoffdate(ft) = model_day_int ! record leaf on date + currentSite%dndaysleafoff(ft) = 0 + currentSite%elong_factor(ft) = 0. + end if drought_smoist_ifelse + + + case (drgt_phen_model_gradual) + !------ + ! ED2-like deciduous. We compare the moisture with the lower and upper + ! thresholds. If the moisture is in between the thresholds, we must also + ! check whether or not the drought is developing or regressing. + !------ + + + ! First guess elongation factor + if (ED_val_phen_drought_threshold >= 0.) then + elongf_1st = elongf_min + (1.0_r8 - elongf_min ) * & + ( mean_10day_liqvol - ED_val_phen_drought_threshold ) / & + ( ED_val_phen_moist_threshold - ED_val_phen_drought_threshold ) + else + elongf_1st = elongf_min + (1.0_r8 - elongf_min ) * & + ( mean_10day_smp - ED_val_phen_drought_threshold ) / & + ( ED_val_phen_moist_threshold - ED_val_phen_drought_threshold ) + end if + elongf_1st = max(0.0_r8,min(1.0_r8,elongf_1st)) + + + + ! Save some conditions in logical variables to simplify code below + recent_flush = elongf_prev >= elongf_min .and. & + ( currentSite%dndaysleafon(ft) <= dleafon_drycheck ) + recent_abscission = elongf_prev < elongf_min .and. & + ( currentSite%dndaysleafoff(ft) <= min_daysoff_dforcedflush ) + prolonged_on_period = all( [elongf_prev,elongf_1st] >= elongf_min ) .and. & + ( currentSite%dndaysleafon(ft) > canopy_leaf_lifespan ) + last_flush_long_ago = all( [elongf_prev,elongf_1st] < elongf_min ) .and. & + ( currentSite%dndaysleafon(ft) > 365+dd_offon_toler ) + + + ! Make sure elongation factor is bounded and check for special cases. + drought_gradual_ifelse: if ( model_day_int <= numWaterMem ) then + ! Too early in the simulation, keep the same elongation factor as the day before. + currentSite%elong_factor(ft) = elongf_prev + + elseif ( prolonged_on_period ) then + ! Leaves have been on for too long and exceeded leaf lifespan. Force abscission + currentSite%elong_factor(ft) = 0.0_r8 ! Force full budburst + currentSite%dstatus(ft) = phen_dstat_timeoff ! Flag that this has been forced + currentSite%dleafoffdate(ft) = model_day_int ! Record leaf off date + currentSite%dndaysleafoff(ft) = 0 ! Reset clock + + elseif ( last_flush_long_ago ) then + ! Plant has not flushed at all for a very long time. Force flushing + currentSite%elong_factor(ft) = elongf_min ! Force minimum budburst + currentSite%dstatus(ft) = phen_dstat_timeon ! Flag that this has been forced + currentSite%dleafondate(ft) = model_day_int ! Record leaf on date + currentSite%dndaysleafon(ft) = 0 ! Reset clock + + elseif ( recent_flush .and. elongf_1st < elongf_prev ) then + ! Leaves have only recently reached flushed status. Elongation factor cannot decrease + currentSite%elong_factor(ft) = elongf_prev ! Elongation factor cannot decrease + currentSite%dstatus(ft) = phen_dstat_timeon ! Flag that this has been forced + + elseif ( recent_abscission .and. elongf_1st > elongf_min ) then + ! Leaves have only recently abscissed. Prevent plant to flush leaves. + currentSite%elong_factor(ft) = 0.0_r8 ! Elongation factor must remain 0. + currentSite%dstatus(ft) = phen_dstat_timeoff ! Flag that this has been forced + + elseif ( elongf_1st < elongf_min ) then + ! First guess of elongation factor below minimum. Impose full abscission. + currentSite%elong_factor(ft) = 0.0_r8 + + if (elongf_prev >= elongf_min ) then + ! This is the first day moisture fell below minimum. Flag change of status. + currentSite%dstatus(ft) = phen_dstat_moistoff ! Flag that this has not been forced + currentSite%dleafoffdate(ft) = model_day_int ! Record leaf off date + currentSite%dndaysleafoff(ft) = 0 ! Reset clock + end if + else + ! First guess of elongation factor is valid, use it. + currentSite%elong_factor(ft) = elongf_1st + + + if (elongf_prev < elongf_min ) then + ! This is the first day moisture allows leaves to exist. Flag change of status. + currentSite%dstatus(ft) = phen_dstat_moiston ! Flag that this has not been forced + currentSite%dleafondate(ft) = model_day_int ! Record leaf on date + currentSite%dndaysleafon(ft) = 0 ! Reset clock + elseif (elongf_1st < elongf_prev) then + currentSite%dstatus(ft) = phen_dstat_pshed ! Flag partial shedding, + ! but do not reset the clock + end if + end if drought_gradual_ifelse + end select case_drought_phen end do pft_drgt_loop call phenology_leafonoff(currentSite) @@ -1132,11 +1237,25 @@ subroutine phenology_leafonoff(currentSite) real(r8) :: sapw_c ! sapwood carbon [kg] real(r8) :: struct_c ! structural wood carbon [kg] - real(r8) :: leaf_deficit ! leaf carbon deficit (to be back on allometry) [kg] - real(r8) :: fnrt_deficit ! fine root carbon (to be back on allometry) [kg] - real(r8) :: sapw_deficit ! sapwood carbon (to be back on allometry) [kg] - real(r8) :: struct_deficit ! structural wood carbon (to be back on allometry) [kg] - real(r8) :: total_deficit ! total carbon deficit (to be back on allometry) [kg] + real(r8) :: a_sapw0 ! target sapwood cross section area [m2] (dummy) + real(r8) :: c_agw0 ! target Above ground biomass [kgC] + real(r8) :: c_bgw0 ! target Below ground biomass [kgC] + + real(r8) :: leaf_target ! target leaf carbon (allometry scaled by elongation factor) [kg] + real(r8) :: fnrt_target ! target fine root carbon (allometry scaled by elongation factor) [kg] + real(r8) :: sapw_target ! target sapwood carbon (allometry scaled by elongation factor) [kg] + real(r8) :: struct_target ! target structural wood carbon (allometry scaled by elongation factor) [kg] + + real(r8) :: leaf_deficit ! leaf carbon deficit (relative to target) [kg] + real(r8) :: fnrt_deficit ! fine root carbon deficit (relative to target) [kg] + real(r8) :: sapw_deficit ! sapwood carbon deficit (relative to target) [kg] + real(r8) :: struct_deficit ! structural wood carbon deficit (relative to target) [kg] + real(r8) :: total_deficit ! total carbon deficit (relative to target) [kg] + + real(r8) :: eff_leaf_drop_fraction ! Effective leaf drop fraction + real(r8) :: eff_fnrt_drop_fraction ! Effective fine-root drop fraction + real(r8) :: eff_sapw_drop_fraction ! Effective sapwood drop fraction + real(r8) :: eff_struct_drop_fraction ! Effective structural wood drop fraction real(r8) :: store_c ! storage carbon [kg] real(r8) :: store_c_transfer_frac ! Fraction of storage carbon used to flush leaves @@ -1146,6 +1265,7 @@ subroutine phenology_leafonoff(currentSite) integer :: ipft real(r8), parameter :: leaf_drop_fraction = 1.0_r8 real(r8), parameter :: carbon_store_buffer = 0.10_r8 + real(r8) :: fnrt_drop_fraction real(r8) :: stem_drop_fraction logical, parameter :: debug = .true. ! Print debug info? @@ -1163,12 +1283,22 @@ subroutine phenology_leafonoff(currentSite) if(debug) call currentCohort%prt%CheckMassConservation(ipft,0) + ! Update memory variables to ensure they are up to date with recent growth. + call bleaf(currentCohort%dbh,ipft,currentCohort%canopy_trim,currentCohort%leafmemory) + call bfineroot(currentCohort%dbh,ipft,currentCohort%canopy_trim,currentCohort%fnrtmemory) + call bsap_allom(currentCohort%dbh,ipft,currentCohort%canopy_trim,a_sapw0, currentCohort%sapwmemory) + call bagw_allom(currentCohort%dbh,ipft,c_agw0) + call bbgw_allom(currentCohort%dbh,ipft,c_bgw0) + call bdead_allom(c_agw0,c_bgw0,currentCohort%sapwmemory,ipft,currentCohort%structmemory) + + ! Get current carbon pools store_c = currentCohort%prt%GetState(store_organ, all_carbon_elements) leaf_c = currentCohort%prt%GetState(leaf_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) + fnrt_drop_fraction = EDPftvarcon_inst%phen_fnrt_drop_fraction(ipft) stem_drop_fraction = EDPftvarcon_inst%phen_stem_drop_fraction(ipft) @@ -1177,24 +1307,27 @@ subroutine phenology_leafonoff(currentSite) if ( prt_params%season_decid(ipft) == itrue .or. & prt_params%stress_decid(ipft) == itrue ) then select case(currentCohort%status_coh) - case (leaves_off,leaves_on) + case (leaves_off,leaves_on,leaves_pshed) continue case default - write(fates_log(),'(a)') '---------------------------------------------' - write(fates_log(),'(a)') ' Odd leaf status - Leaves are not off or on. ' - write(fates_log(),'(a)') '---------------------------------------------' + write(fates_log(),'(a)') '--------------------------------------------------------------------' + write(fates_log(),'(a)') ' Odd leaf status - Leaves are not off, on, or partially abscissing. ' + write(fates_log(),'(a)') '--------------------------------------------------------------------' write(fates_log(),'(a,1x,i5)' ) ' PFT = ',ipft - write(fates_log(),'(a,1x,i5)' ) ' Season deciduous = ',prt_params%season_decid(ipft) - write(fates_log(),'(a,1x,i5)' ) ' Stress deciduous = ',prt_params%stress_decid(ipft) - write(fates_log(),'(a,1x,i5)' ) ' Site status = ',currentSite%cstatus - write(fates_log(),'(a,1x,i5)' ) ' Cohort status = ',currentCohort%status_coh - write(fates_log(),'(a,1x,f12.5)') ' DBH = ',currentCohort%dbh - write(fates_log(),'(a,1x,f12.5)') ' Leaf_c = ',leaf_c - write(fates_log(),'(a,1x,f12.5)') ' Store_c = ',store_c - write(fates_log(),'(a,1x,f12.5)') ' Fnrt_c = ',fnrt_c - write(fates_log(),'(a,1x,f12.5)') ' Sapw_c = ',sapw_c - write(fates_log(),'(a,1x,f12.5)') ' Struct_c = ',struct_c - write(fates_log(),'(a)') '---------------------------------------------' + write(fates_log(),'(a,1x,i5)' ) ' Season deciduous = ',prt_params%season_decid(ipft) + write(fates_log(),'(a,1x,i5)' ) ' Stress deciduous = ',prt_params%stress_decid(ipft) + write(fates_log(),'(a,1x,i5)' ) ' Site status = ',currentSite%cstatus + write(fates_log(),'(a,1x,i5)' ) ' Cohort status = ',currentCohort%status_coh + write(fates_log(),'(a,1x,f12.5)') ' Leaf elongation = ',currentCohort%efleaf_coh + write(fates_log(),'(a,1x,f12.5)') ' Fine-root elongation = ',currentCohort%effnrt_coh + write(fates_log(),'(a,1x,f12.5)') ' Stem elongation = ',currentCohort%efstem_coh + write(fates_log(),'(a,1x,f12.5)') ' DBH = ',currentCohort%dbh + write(fates_log(),'(a,1x,f12.5)') ' Leaf_c = ',leaf_c + write(fates_log(),'(a,1x,f12.5)') ' Store_c = ',store_c + write(fates_log(),'(a,1x,f12.5)') ' Fnrt_c = ',fnrt_c + write(fates_log(),'(a,1x,f12.5)') ' Sapw_c = ',sapw_c + write(fates_log(),'(a,1x,f12.5)') ' Struct_c = ',struct_c + write(fates_log(),'(a)') '--------------------------------------------------------------------' write(fates_log(),'(a)') '' write(fates_log(),'(a)') '' call endrun(msg=errMsg(sourcefile, __LINE__)) @@ -1206,31 +1339,56 @@ subroutine phenology_leafonoff(currentSite) ! check whether or not it's time to flush or time to shed leaves, then ! use a common code for flushing or shedding leaves. if (prt_params%season_decid(ipft) == itrue) then ! Cold deciduous + ! Set elongation factor to 0 or 1 (partial shedding not defined for cold deciduous) + select case (currentSite%cstatus) + case (phen_cstat_nevercold,phen_cstat_iscold) + currentCohort%efleaf_coh = 0.0_r8 + case (phen_cstat_notcold) + currentCohort%efleaf_coh = 1.0_r8 + end select + ! A. Is this the time for COLD LEAVES to switch to ON? is_flushing_time = ( currentSite%cstatus == phen_cstat_notcold .and. & ! We just moved to leaves being on currentCohort%status_coh == leaves_off ) ! Leaves are currently off ! B. Is this the time for COLD LEAVES to switch to OFF? - is_shedding_time = ( currentSite%cstatus == phen_cstat_nevercold .or. & ! Past leaf drop day or... - currentSite%cstatus == phen_cstat_iscold ) .and. & ! Too cold? - currentCohort%status_coh == leaves_on .and. & ! Leaves have not dropped yet + is_shedding_time = any(currentSite%cstatus == [phen_cstat_nevercold,phen_cstat_iscold]) .and. & ! Past leaf drop day or too cold + currentCohort%status_coh == leaves_on .and. & ! Leaves have not dropped yet ( currentCohort%dbh > EDPftvarcon_inst%phen_cold_size_threshold(ipft) .or. & ! Grasses are big enough or... prt_params%woody(ipft) == itrue ) ! this is a woody PFT. elseif (prt_params%stress_decid(ipft) == itrue ) then ! Drought deciduous + ! Use elongation factor + currentCohort%efleaf_coh = currentSite%elong_factor(ipft) + + ! A. Is this the time for DROUGHT LEAVES to switch to ON? - is_flushing_time = ( currentSite%dstatus(ipft) == phen_dstat_moiston .or. & ! Conditions are sufficiently moist - currentSite%dstatus(ipft) == phen_dstat_timeon ) .and. & ! Time to for leaf flushing - currentCohort%status_coh == leaves_off + is_flushing_time = any( currentSite%dstatus(ipft) == [phen_dstat_moiston,phen_dstat_timeon] ) .and. & ! Leaf flushing time (moisture or time) + any( currentCohort%status_coh == [leaves_off,leaves_pshed] ) ! B. Is this the time for DROUGHT LEAVES to switch to OFF? - is_shedding_time = ( currentSite%dstatus(ipft) == phen_dstat_moistoff .or. & ! Too dry or... - currentSite%dstatus(ipft) == phen_dstat_timeoff ) .and. & ! Past leaf drop day. - currentCohort%status_coh == leaves_on ! ! Leaves have not dropped yet + ! This will be true when leaves are abscissing (partially or fully) due to moisture or time + is_shedding_time = any( currentSite%dstatus(ipft) == [phen_dstat_moistoff,phen_dstat_timeoff,phen_dstat_pshed] ) .and. & + any( currentCohort%status_coh == [leaves_on,leaves_pshed] ) else ! This PFT is not deciduous. - is_flushing_time = .false. - is_shedding_time = .false. + is_flushing_time = .false. + is_shedding_time = .false. + currentCohort%efleaf_coh = 1.0_r8 end if ! (prt_params%season_decid(ipft) == itrue) + ! Find the effective "elongation factor" for fine roots and stems. The effective drop fraction is + ! a combination of the elongation factor (e) and the drop fraction (x), which will ensure + ! that the remaining tissue biomass will be exactly e when x=1, and exactly the original + ! biomass when x = 0. For leaves it is always assumed that the drop fraction is one. + currentCohort%effnrt_coh = 1.0_r8 - (1.0_r8 - currentCohort%efleaf_coh ) * fnrt_drop_fraction + currentCohort%efstem_coh = 1.0_r8 - (1.0_r8 - currentCohort%efleaf_coh ) * stem_drop_fraction + + ! Find the target biomass for each tissue when accounting for elongation factors. + ! Note that the target works for both flushing and shedding leaves. + leaf_target = currentCohort%efleaf_coh * currentCohort%leafmemory + fnrt_target = currentCohort%effnrt_coh * currentCohort%fnrtmemory + sapw_target = currentCohort%efstem_coh * currentCohort%sapwmemory + struct_target = currentCohort%efstem_coh * currentCohort%structmemory + ! A. This is time to switch to (COLD or DROUGHT) LEAF ON flush_block: if (is_flushing_time) then @@ -1240,11 +1398,11 @@ subroutine phenology_leafonoff(currentSite) ! Transfer carbon from storage to living tissues (only if there is any carbon in storage) transf_block: if ( store_c > nearzero ) then ! Find the total deficit. We no longer distinguish between woody and non-woody - ! PFTs here (as sapwmemory is be the same as sapw_c if this is a woody tissue). - leaf_deficit = max(0.0_r8, currentCohort%leafmemory - leaf_c ) - fnrt_deficit = max(0.0_r8, currentCohort%fnrtmemory - fnrt_c ) - sapw_deficit = max(0.0_r8, currentCohort%sapwmemory - sapw_c ) - struct_deficit = max(0.0_r8, currentCohort%structmemory - struct_c) + ! PFTs here (as sapwmemory is the same as sapw_c if this is a woody tissue). + leaf_deficit = max(0.0_r8, leaf_target - leaf_c ) + fnrt_deficit = max(0.0_r8, fnrt_target - fnrt_c ) + sapw_deficit = max(0.0_r8, sapw_target - sapw_c ) + struct_deficit = max(0.0_r8, struct_target - struct_c) total_deficit = leaf_deficit + fnrt_deficit + sapw_deficit + struct_deficit ! Flush either the amount required from the memory, or -most- of the storage pool @@ -1269,12 +1427,6 @@ subroutine phenology_leafonoff(currentSite) store_c_transfer_frac*struct_deficit/total_deficit) end if end if - - ! Reset memory to ensure we don't add more carbon than needed - currentCohort%leafmemory = 0.0_r8 - currentCohort%fnrtmemory = 0.0_r8 - currentCohort%sapwmemory = 0.0_r8 - currentCohort%structmemory = 0.0_r8 else ! Not enough carbon to flush any living tissue. store_c_transfer_frac = 0.0_r8 @@ -1285,28 +1437,37 @@ subroutine phenology_leafonoff(currentSite) ! B. This is time to switch to (COLD or DROUGHT) LEAF OFF shed_block: if (is_shedding_time) then - ! This sets the cohort to the "leaves off" flag - currentCohort%status_coh = leaves_off + if ( currentCohort%efleaf_coh > 0.0_r8 ) then + ! Partial shedding + currentCohort%status_coh = leaves_pshed + else + ! Complete abscission + currentCohort%status_coh = leaves_off + end if - ! Set memory for all tissues as the current biomass - currentCohort%leafmemory = leaf_c - currentCohort%fnrtmemory = fnrt_c - currentCohort%sapwmemory = sapw_c - currentCohort%structmemory = struct_c + ! Find the effective fraction to drop. This fraction must be calculated every time + ! because we must account for partial abscission. The simplest approach is to simply + ! use the ratio between the target and the original biomass of each pool. The + ! max(tissue_c,nearzero) is overly cautious, because leaf_c = 0 would imply that + ! leaves are already off, and this wouldn't be considered shedding time. + eff_leaf_drop_fraction = max( 0.0_r8, min( 1.0_r8,1.0_r8 - leaf_target / max( leaf_c , nearzero ) ) ) + eff_fnrt_drop_fraction = max( 0.0_r8, min( 1.0_r8,1.0_r8 - fnrt_target / max( fnrt_c , nearzero ) ) ) + eff_sapw_drop_fraction = max( 0.0_r8, min( 1.0_r8,1.0_r8 - sapw_target / max( sapw_c , nearzero ) ) ) + eff_struct_drop_fraction = max( 0.0_r8, min( 1.0_r8,1.0_r8 - struct_target / max( struct_c, nearzero ) ) ) ! Drop leaves - call PRTDeciduousTurnover(currentCohort%prt,ipft, leaf_organ, leaf_drop_fraction) + call PRTDeciduousTurnover(currentCohort%prt,ipft, leaf_organ, eff_leaf_drop_fraction) - ! For now we don't drop fine roots. They may decay during the leaf off period. We may revisit this - ! in case we have evidence that deciduous PFTs actively shed fine roots too. + ! Drop fine roots + call PRTDeciduousTurnover(currentCohort%prt,ipft, fnrt_organ, eff_fnrt_drop_fraction) ! If plant is not woody, shed sapwood and heartwood (they may have a minimum amount of woody tissues for ! running plant hydraulics, and it makes sense to shed them along with leaves when they should be off). ! MLO - stem_drop_fraction is a PFT parameter, do we really need this check for woody/non-woody PFT? if ( nint(prt_params%woody(ipft)) == ifalse ) then ! Shed sapwood and heartwood. - call PRTDeciduousTurnover(currentCohort%prt,ipft,sapw_organ , stem_drop_fraction) - call PRTDeciduousTurnover(currentCohort%prt,ipft,struct_organ, stem_drop_fraction) + call PRTDeciduousTurnover(currentCohort%prt,ipft,sapw_organ , eff_sapw_drop_fraction ) + call PRTDeciduousTurnover(currentCohort%prt,ipft,struct_organ, eff_struct_drop_fraction) end if end if shed_block @@ -1773,7 +1934,7 @@ subroutine SeedGermination( litt, cold_stat, drought_stat ) litt%seed_germ_in(pft) = 0.0_r8 endif if ((prt_params%stress_decid(pft) == itrue ) .and. & - (any(drought_stat(pft) == [phen_dstat_timeoff,phen_dstat_moistoff]))) then + (any(drought_stat(pft) == [phen_dstat_timeoff,phen_dstat_moistoff,phen_dstat_pshed]))) then litt%seed_germ_in(pft) = 0.0_r8 end if @@ -1817,11 +1978,14 @@ subroutine recruitment( currentSite, currentPatch, bc_in ) real(r8) :: c_leaf ! target leaf biomass [kgC] real(r8) :: c_fnrt ! target fine root biomass [kgC] real(r8) :: c_sapw ! target sapwood biomass [kgC] - real(r8) :: a_sapw ! target sapwood cross section are [m2] (dummy) + real(r8) :: a_sapw ! target sapwood cross section area [m2] (dummy) real(r8) :: c_agw ! target Above ground biomass [kgC] real(r8) :: c_bgw ! target Below ground biomass [kgC] real(r8) :: c_struct ! target Structural biomass [kgc] real(r8) :: c_store ! target Storage biomass [kgC] + real(r8) :: elongf_leaf ! leaf elongation factor [fraction] + real(r8) :: elongf_fnrt ! fine-root "elongation factor" [fraction] + real(r8) :: elongf_stem ! stem "elongation factor" [fraction] real(r8) :: m_leaf ! leaf mass (element agnostic) [kg] real(r8) :: m_fnrt ! fine-root mass (element agnostic) [kg] real(r8) :: m_sapw ! sapwood mass (element agnostic) [kg] @@ -1833,6 +1997,7 @@ subroutine recruitment( currentSite, currentPatch, bc_in ) real(r8) :: mass_avail ! The mass of each nutrient/carbon available in the seed_germination pool [kg] real(r8) :: mass_demand ! Total mass demanded by the plant to achieve the stoichiometric targets ! of all the organs in the recruits. Used for both [kg per plant] and [kg per cohort] + real(r8) :: fnrt_drop_fraction real(r8) :: stem_drop_fraction !---------------------------------------------------------------------- @@ -1847,7 +2012,8 @@ subroutine recruitment( currentSite, currentPatch, bc_in ) temp_cohort%pft = ft temp_cohort%hite = EDPftvarcon_inst%hgt_min(ft) temp_cohort%coage = 0.0_r8 - stem_drop_fraction = EDPftvarcon_inst%phen_stem_drop_fraction(ft) + fnrt_drop_fraction = EDPftvarcon_inst%phen_fnrt_drop_fraction(ft) + stem_drop_fraction = EDPftvarcon_inst%phen_stem_drop_fraction(ft) call h2d_allom(temp_cohort%hite,ft,temp_cohort%dbh) @@ -1860,58 +2026,62 @@ subroutine recruitment( currentSite, currentPatch, bc_in ) call bdead_allom(c_agw,c_bgw,c_sapw,ft,c_struct) call bstore_allom(temp_cohort%dbh,ft,temp_cohort%canopy_trim,c_store) - ! Default assumption is that leaves are on + ! Default assumption is that leaves are on and fully flushed cohortstatus = leaves_on - temp_cohort%leafmemory = 0.0_r8 - temp_cohort%fnrtmemory = 0.0_r8 - temp_cohort%sapwmemory = 0.0_r8 - temp_cohort%structmemory = 0.0_r8 + elongf_leaf = 1.0_r8 + elongf_fnrt = 1.0_r8 + elongf_stem = 1.0_r8 + + ! MLO update 20211123. The "memory" variables are now always set to the on-allometry state + ! (accounting for canopy trimming when necessary). We no longer reset them to zero when + ! leaves are flushing. This makes partial deciduousness a bit easier to implement. + temp_cohort%leafmemory = c_leaf + temp_cohort%fnrtmemory = c_fnrt + temp_cohort%sapwmemory = c_sapw + temp_cohort%structmemory = c_struct ! But if the plant is seasonally (cold) deciduous, and the site status is flagged ! as "cold", then set the cohort's status to leaves_off, and remember the leaf biomass if ((prt_params%season_decid(ft) == itrue) .and. & (any(currentSite%cstatus == [phen_cstat_nevercold,phen_cstat_iscold]))) then - temp_cohort%leafmemory = c_leaf - temp_cohort%fnrtmemory = c_fnrt - c_leaf = 0.0_r8 - !c_fnrt = c_fnrt ! For now we do not drop fine roots, but keep memory. - - ! If plant is not woody then set sapwood and structural biomass as well - if (prt_params%woody(ft).ne.itrue) then - ! MLO update: sapwmemory and structmemory used to be deficit, despite the - ! name. The code has been updated elsewhere to use these - ! variables as memory variables. - temp_cohort%sapwmemory = c_sapw - temp_cohort%structmemory = c_struct - c_sapw = (1.0_r8 - stem_drop_fraction) * c_sapw - c_struct = (1.0_r8 - stem_drop_fraction) * c_struct - endif - cohortstatus = leaves_off - endif + elongf_leaf = 0.0_r8 + elongf_fnrt = 1.0_r8 - fnrt_drop_fraction + elongf_stem = 1.0_r8 - stem_drop_fraction + + + c_leaf = elongf_leaf * c_leaf + c_fnrt = elongf_fnrt * c_fnrt + c_sapw = elongf_stem * c_sapw + c_struct = elongf_stem * c_struct - ! Or.. if the plant is drought deciduous, and the site status is flagged as - ! "in a drought", then likewise, set the cohort's status to leaves_off, and remember leaf - ! biomass - if ((prt_params%stress_decid(ft) == itrue) .and. & - (any(currentSite%dstatus(ft) == [phen_dstat_timeoff,phen_dstat_moistoff]))) then - temp_cohort%leafmemory = c_leaf - temp_cohort%fnrtmemory = c_fnrt - c_leaf = 0.0_r8 - !c_fnrt = c_fnrt ! For now we do not drop fine roots, but keep memory. - - ! If plant is not woody then set sapwood and structural biomass as well - if(prt_params%woody(ft).ne.itrue)then - ! MLO update: sapwmemory and structmemory used to be deficit, despite the - ! name. The code has been updated elsewhere to use these - ! variables as memory variables. - temp_cohort%sapwmemory = c_sapw - temp_cohort%structmemory = c_struct - c_sapw = (1.0_r8 - stem_drop_fraction) * c_sapw - c_struct = (1.0_r8 - stem_drop_fraction) * c_struct - endif cohortstatus = leaves_off - endif + end if + + ! Or.. if the plant is drought deciduous, make sure leaf status is consistent with the + ! leaf elongation factor. + ! For tissues other than leaves, the actual drop fraction is a combination of the + ! elongation factor (e) and the drop fraction (x), which will ensure that the remaining + ! tissue biomass will be exactly e when x=1, and exactly the original biomass when x = 0. + if ( prt_params%stress_decid(ft) == itrue ) then + elongf_leaf = currentSite%elong_factor(ft) + elongf_fnrt = 1.0_r8 - (1.0_r8 - elongf_leaf ) * fnrt_drop_fraction + elongf_stem = 1.0_r8 - (1.0_r8 - elongf_leaf ) * stem_drop_fraction + + c_leaf = elongf_leaf * c_leaf + c_fnrt = elongf_fnrt * c_fnrt + c_sapw = elongf_stem * c_sapw + c_struct = elongf_stem * c_struct + + ! For the initial state, we always assume that leaves are flushing (instead of partially abscissing) + ! whenever the elongation factor is non-zero. If the elongation factor is zero, then leaves are in + ! the "off" state. + if ( elongf_leaf > 0.0_r8 ) then + cohortstatus = leaves_on + else + cohortstatus = leaves_off + end if + end if ! Cycle through available carbon and nutrients, find the limiting element @@ -2087,8 +2257,8 @@ subroutine recruitment( currentSite, currentPatch, bc_in ) call create_cohort(currentSite,currentPatch, temp_cohort%pft, temp_cohort%n, & temp_cohort%hite, temp_cohort%coage, temp_cohort%dbh, prt, & temp_cohort%leafmemory, temp_cohort%fnrtmemory, temp_cohort%sapwmemory, & - temp_cohort%structmemory, cohortstatus, recruitstatus, & - temp_cohort%canopy_trim,temp_cohort%c_area, & + temp_cohort%structmemory, elongf_leaf, elongf_fnrt, elongf_stem, cohortstatus, & + recruitstatus, temp_cohort%canopy_trim,temp_cohort%c_area, & currentPatch%NCL_p, currentSite%spread, bc_in) ! Note that if hydraulics is on, the number of cohorts may had diff --git a/biogeochem/FatesAllometryMod.F90 b/biogeochem/FatesAllometryMod.F90 index 34c06e8ddd..29dbd06668 100644 --- a/biogeochem/FatesAllometryMod.F90 +++ b/biogeochem/FatesAllometryMod.F90 @@ -158,6 +158,7 @@ module FatesAllometryMod ! ============================================================================ subroutine CheckIntegratedAllometries(dbh,ipft,canopy_trim, & + elongf_leaf, elongf_fnrt, elongf_stem, & bl,bfr,bsap,bstore,bdead, & grow_leaf, grow_fr, grow_sap, grow_store, grow_dead, & max_err, l_pass) @@ -173,6 +174,9 @@ 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) :: elongf_leaf ! Leaf elongation factor + real(r8),intent(in) :: elongf_fnrt ! Fine-root elongation factor + real(r8),intent(in) :: elongf_stem ! Stem elongation factor 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] @@ -203,6 +207,7 @@ subroutine CheckIntegratedAllometries(dbh,ipft,canopy_trim, & if (grow_leaf) then call bleaf(dbh,ipft,canopy_trim,bl_diag) + bl_diag = bl_diag * elongf_leaf if( abs(bl_diag-bl) > max_err ) then if(verbose_logging) then write(fates_log(),*) 'disparity in integrated/diagnosed leaf carbon' @@ -217,6 +222,7 @@ subroutine CheckIntegratedAllometries(dbh,ipft,canopy_trim, & if (grow_fr) then call bfineroot(dbh,ipft,canopy_trim,bfr_diag) + bfr_diag = bfr_diag * elongf_fnrt if( abs(bfr_diag-bfr) > max_err ) then if(verbose_logging) then write(fates_log(),*) 'disparity in integrated/diagnosed fineroot carbon' @@ -231,6 +237,7 @@ subroutine CheckIntegratedAllometries(dbh,ipft,canopy_trim, & if (grow_sap) then call bsap_allom(dbh,ipft,canopy_trim,asap_diag,bsap_diag) + bsap_diag = bsap_diag * elongf_stem if( abs(bsap_diag-bsap) > max_err ) then if(verbose_logging) then write(fates_log(),*) 'disparity in integrated/diagnosed sapwood carbon' @@ -261,7 +268,9 @@ subroutine CheckIntegratedAllometries(dbh,ipft,canopy_trim, & call bsap_allom(dbh,ipft,canopy_trim,asap_diag,bsap_diag) call bagw_allom(dbh,ipft,bagw_diag) call bbgw_allom(dbh,ipft,bbgw_diag) - call bdead_allom( bagw_diag, bbgw_diag, bsap_diag, ipft, bdead_diag ) + call bdead_allom( bagw_diag, bbgw_diag, bsap_diag, ipft, bdead_diag ) + bdead_diag = bdead_diag * elongf_stem + if( abs(bdead_diag-bdead) > max_err ) then if(verbose_logging) then write(fates_log(),*) 'disparity in integrated/diagnosed structural carbon' @@ -868,6 +877,8 @@ subroutine bsap_allom(d,ipft,canopy_trim,sapw_area,bsap,dbsapdd) real(r8) :: dhdd real(r8) :: bl real(r8) :: dbldd + real(r8) :: blmax ! maximum leaf biomss per allometry + real(r8) :: dblmaxdd real(r8) :: bbgw real(r8) :: dbbgwdd real(r8) :: bagw @@ -885,7 +896,7 @@ subroutine bsap_allom(d,ipft,canopy_trim,sapw_area,bsap,dbsapdd) ! Currently only one sapwood allometry model. the slope ! of the la:sa to diameter line is zero. ! --------------------------------------------------------------------- - case(1) ! linearly related to leaf area based on target leaf biomass + case(1) ! linearly related to leaf area based on target TRIMMED leaf biomass ! and slatop (no provisions for slamax) call h_allom(d,ipft,h,dhdd) @@ -901,6 +912,28 @@ subroutine bsap_allom(d,ipft,canopy_trim,sapw_area,bsap,dbsapdd) ! (this comes into play typically in very small plants) bsap_cap = max_frac*(bagw+bbgw) + if(bsap>bsap_cap) then + bsap = bsap_cap + if(present(dbsapdd))then + dbsapdd = max_frac*(dbagwdd+dbbgwdd) + end if + end if + case(2) ! linearly related to leaf area based on target UNTRIMMED leaf biomass + ! and slatop (no provisions for slamax) + + call h_allom(d,ipft,h,dhdd) + call blmax_allom(d,ipft,blmax,dblmaxdd) + call bsap_ltarg_slatop(d,h,dhdd,blmax,dblmaxdd,ipft,sapw_area,bsap,dbsapdd) + + ! Perform a capping/check on total woody biomass + call bagw_allom(d,ipft,bagw,dbagwdd) + call bbgw_allom(d,ipft,bbgw,dbbgwdd) + + ! Force sapwood to be less than a maximum fraction of total biomass + ! We omit the sapwood area from this calculation + ! (this comes into play typically in very small plants) + bsap_cap = max_frac*(bagw+bbgw) + if(bsap>bsap_cap) then bsap = bsap_cap if(present(dbsapdd))then @@ -1009,30 +1042,35 @@ subroutine bstore_allom(d,ipft,canopy_trim,bstore,dbstoredd) real(r8),intent(in) :: canopy_trim ! Crown trimming function [0-1] real(r8),intent(out) :: bstore ! allometric target storage [kgC] real(r8),intent(out),optional :: dbstoredd ! change storage per cm [kgC/cm] - - real(r8) :: bl ! Allometric target leaf biomass - real(r8) :: dbldd ! Allometric target change in leaf biomass per cm - - + + real(r8) :: bl ! Allometric target leaf biomass (TRIMMED) + real(r8) :: dbldd ! Allometric target change in leaf biomass per cm (TRIMMED) + real(r8) :: blmax ! Allometric target leaf biomass (UNTRIMMED) + real(r8) :: dblmaxdd ! Allometric target change in leaf biomass per cm (UNTRIMMED) + + ! TODO: allom_stmode needs to be added to the parameter file - associate( allom_stmode => prt_params%allom_stmode(ipft), & cushion => prt_params%cushion(ipft) ) select case(int(allom_stmode)) - case(1) ! Storage is constant proportionality of trimmed maximum leaf + case(1) ! Storage is constant proportionality of TRIMMED maximum leaf ! biomass (ie cushion * bleaf) - call bleaf(d,ipft,canopy_trim,bl,dbldd) call bstore_blcushion(d,bl,dbldd,cushion,ipft,bstore,dbstoredd) - + + case(2) ! Storage is constant proportionality of UNTRIMMED maximum leaf + ! biomass (ie cushion * bleaf) + call blmax_allom(d,ipft,blmax,dblmaxdd) + call bstore_blcushion(d,blmax,dblmaxdd,cushion,ipft,bstore,dbstoredd) + case DEFAULT write(fates_log(),*) 'An undefined fine storage allometry was specified: ', & allom_stmode write(fates_log(),*) 'Aborting' call endrun(msg=errMsg(sourcefile, __LINE__)) end select - + end associate return end subroutine bstore_allom diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index 261e5ab45a..f2be3bb0fb 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -200,6 +200,7 @@ subroutine zero_site( site_in ) site_in%cndaysleafoff = fates_unset_int ! days since leaf off (cold) site_in%dndaysleafon(:) = fates_unset_int ! days since leaf on (drought) site_in%dndaysleafoff(:) = fates_unset_int ! days since leaf off (drought) + site_in%elong_factor(:) = nan ! Elongation factor (0 - full abscission; 1 - fully flushed) site_in%liqvol_memory(:,:) = nan site_in%smp_memory(:,:) = nan @@ -274,6 +275,7 @@ subroutine set_site_properties( nsites, sites,bc_in ) real(r8) :: acc_NI real(r8) :: liqvolmem real(r8) :: smpmem + real(r8) :: elong_factor ! Elongation factor (0 - fully off; 1 - fully on) integer :: cleafon ! DOY for cold-decid leaf-on, initial guess integer :: cleafoff ! DOY for cold-decid leaf-off, initial guess integer :: dleafoff ! DOY for drought-decid leaf-off, initial guess @@ -310,6 +312,7 @@ subroutine set_site_properties( nsites, sites,bc_in ) dndleafoff = 0 liqvolmem = 0.5_r8 smpmem = 0._r8 + elong_factor = 1._r8 do s = 1,nsites sites(s)%nchilldays = 0 @@ -334,6 +337,7 @@ subroutine set_site_properties( nsites, sites,bc_in ) sites(s)%cstatus = cstat sites(s)%dstatus(1:numpft) = dstat + sites(s)%elong_factor(1:numpft) = elong_factor sites(s)%acc_NI = acc_NI sites(s)%NF = 0.0_r8 @@ -704,7 +708,11 @@ subroutine init_cohorts( site_in, patch_in, bc_in) real(r8) :: m_sapw ! Generic mass for sapwood [kg] real(r8) :: m_store ! Generic mass for storage [kg] real(r8) :: m_repro ! Generic mass for reproductive tissues [kg] - real(r8) :: stem_drop_fraction + real(r8) :: elongf_leaf ! Leaf elongation factor + real(r8) :: elongf_fnrt ! Fine-root "elongation factor" + real(r8) :: elongf_stem ! Stem "elongation factor" + real(r8) :: fnrt_drop_fraction ! Fraction of fine roots to absciss when leaves absciss + real(r8) :: stem_drop_fraction ! Fraction of stems to absciss when leaves absciss integer, parameter :: rstatus = 0 integer init @@ -795,49 +803,61 @@ subroutine init_cohorts( site_in, patch_in, bc_in) call bstore_allom(temp_cohort%dbh, pft, temp_cohort%canopy_trim, c_store) - temp_cohort%leafmemory = 0._r8 - temp_cohort%fnrtmemory = 0._r8 - temp_cohort%sapwmemory = 0._r8 - temp_cohort%structmemory = 0._r8 - cstatus = leaves_on - + ! MLO update 20211123. The "memory" variables are now always set to the + ! on-allometry state (accounting for canopy trimming when necessary). + ! We no longer reset them to zero when leaves are flushing. This makes + ! partial deciduousness a bit easier to implement. + temp_cohort%leafmemory = c_leaf + temp_cohort%fnrtmemory = c_fnrt + temp_cohort%sapwmemory = c_sapw + temp_cohort%structmemory = c_struct + + ! Assume leaves are fully flushed, and update if needed. + cstatus = leaves_on + elongf_leaf = 1.0_r8 + elongf_fnrt = 1.0_r8 + elongf_stem = 1.0_r8 + + fnrt_drop_fraction = EDPftvarcon_inst%phen_fnrt_drop_fraction(temp_cohort%pft) stem_drop_fraction = EDPftvarcon_inst%phen_stem_drop_fraction(temp_cohort%pft) if(hlm_use_sp.eq.ifalse)then ! do not override SP vales with phenology if( prt_params%season_decid(pft) == itrue .and. & any(site_in%cstatus == [phen_cstat_nevercold,phen_cstat_iscold])) then - ! MLO update: sapwmemory and structmemory used to be deficit, despite the - ! name. The code has been updated elsewhere to use these - ! variables as memory variables. - temp_cohort%leafmemory = c_leaf ! Leaf biomass memory - temp_cohort%fnrtmemory = c_fnrt ! Fine root memory - temp_cohort%sapwmemory = c_sapw ! Sapwood memory - temp_cohort%structmemory = c_struct ! Heartwood memory - c_leaf = 0._r8 - !c_fnrt = c_fnrt... Do not change fine root, if leaves are off - ! it may steadily decline. - c_sapw = (1.0_r8-stem_drop_fraction) * c_sapw - c_struct = (1.0_r8-stem_drop_fraction) * c_struct - cstatus = leaves_off - endif + elongf_leaf = 0._r8 + elongf_fnrt = 1.0_r8 - fnrt_drop_fraction + elongf_stem = 1.0_r8 - stem_drop_fraction + + c_leaf = elongf_leaf * c_leaf + c_fnrt = elongf_fnrt * c_fnrt + c_sapw = elongf_stem * c_sapw + c_struct = elongf_stem * c_struct - if ( prt_params%stress_decid(pft) == itrue .and. & - any(site_in%dstatus(pft) == [phen_dstat_timeoff,phen_dstat_moistoff])) then - ! MLO update: sapwmemory and structmemory used to be deficit, despite the - ! name. The code has been updated elsewhere to use these - ! variables as memory variables. - temp_cohort%leafmemory = c_leaf ! Leaf biomass memory - temp_cohort%fnrtmemory = c_fnrt ! Fine root memory - temp_cohort%sapwmemory = c_sapw ! Sapwood memory - temp_cohort%structmemory = c_struct ! Heartwood memory - c_leaf = 0._r8 - !c_fnrt = c_fnrt... Do not change fine root, if leaves are off - ! it may steadily decline. - c_sapw = (1.0_r8-stem_drop_fraction) * c_sapw - c_struct = (1.0_r8-stem_drop_fraction) * c_struct cstatus = leaves_off - endif + elseif ( prt_params%stress_decid(pft) == itrue) then + ! If the plant is drought deciduous, make sure leaf status is + ! always consistent with the leaf elongation factor. For tissues + ! other than leaves, the actual drop fraction is a combination of the + ! elongation factor (e) and the drop fraction (x), which will ensure + ! that the remaining tissue biomass will be exactly e when x=1, and + ! exactly the original biomass when x = 0. + elongf_leaf = site_in%elong_factor(pft) + elongf_fnrt = 1.0_r8 - (1.0_r8 - elongf_leaf ) * fnrt_drop_fraction + elongf_stem = 1.0_r8 - (1.0_r8 - elongf_leaf ) * stem_drop_fraction + + + c_leaf = elongf_leaf * c_leaf + c_fnrt = elongf_fnrt * c_fnrt + c_sapw = elongf_stem * c_sapw + c_struct = elongf_stem * c_struct + + if (elongf_leaf > 0.0_r8) then + cstatus = leaves_on + else + cstatus = leaves_off + end if + end if end if ! SP mode @@ -915,9 +935,9 @@ 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%leafmemory, & - temp_cohort%fnrtmemory, temp_cohort%sapwmemory, temp_cohort%structmemory, & - cstatus, rstatus, temp_cohort%canopy_trim, temp_cohort%c_area,1, & - site_in%spread, bc_in) + temp_cohort%fnrtmemory, temp_cohort%sapwmemory, temp_cohort%structmemory, & + elongf_leaf, elongf_fnrt, elongf_stem, cstatus, rstatus, & + temp_cohort%canopy_trim, temp_cohort%c_area, 1, site_in%spread, bc_in) deallocate(temp_cohort) ! get rid of temporary cohort diff --git a/main/EDParamsMod.F90 b/main/EDParamsMod.F90 index 1f10aa2c7f..b142047e7d 100644 --- a/main/EDParamsMod.F90 +++ b/main/EDParamsMod.F90 @@ -36,7 +36,12 @@ module EDParamsMod integer,protected, public :: photo_tempsens_model ! switch for choosing the model that defines the temperature ! sensitivity of photosynthetic parameters (vcmax, jmax). ! 1=non-acclimating (NOT YET IMPLEMENTED) - + + integer,protected, public :: phen_drought_model ! Switch for chooshing the drought-deciduous phenology model + ! 0 = Default FATES ( leaves on/off based on 10-day average soil moisture threshold in rooting zone ) + ! 1 = ED2-like (partial deciduousness based on 10-day average soil moisture upper and lower threshold in rooting zone) + ! Other options coming at some point. + real(r8),protected, public :: fates_mortality_disturbance_fraction ! the fraction of canopy mortality that results in disturbance real(r8),protected, public :: ED_val_comp_excln real(r8),protected, public :: ED_val_init_litter @@ -46,6 +51,7 @@ module EDParamsMod real(r8),protected, public :: ED_val_cwd_flig real(r8),protected, public :: ED_val_base_mr_20 real(r8),protected, public :: ED_val_phen_drought_threshold + real(r8),protected, public :: ED_val_phen_moist_threshold real(r8),protected, public :: ED_val_phen_doff_time real(r8),protected, public :: ED_val_phen_a real(r8),protected, public :: ED_val_phen_b @@ -96,6 +102,7 @@ module EDParamsMod character(len=param_string_length),parameter,public :: ED_name_photo_temp_acclim_timescale = "fates_photo_temp_acclim_timescale" character(len=param_string_length),parameter,public :: name_photo_tempsens_model = "fates_photo_tempsens_model" character(len=param_string_length),parameter,public :: name_maintresp_model = "fates_maintresp_model" + character(len=param_string_length),parameter,public :: name_phen_drought_model = "fates_phen_drought_model" character(len=param_string_length),parameter,public :: ED_name_hydr_htftype_node = "fates_hydr_htftype_node" character(len=param_string_length),parameter,public :: ED_name_mort_disturb_frac = "fates_mort_disturb_frac" character(len=param_string_length),parameter,public :: ED_name_comp_excln = "fates_comp_excln" @@ -106,6 +113,7 @@ module EDParamsMod character(len=param_string_length),parameter,public :: ED_name_cwd_flig= "fates_cwd_flig" character(len=param_string_length),parameter,public :: ED_name_base_mr_20= "fates_base_mr_20" character(len=param_string_length),parameter,public :: ED_name_phen_drought_threshold= "fates_phen_drought_threshold" + character(len=param_string_length),parameter,public :: ED_name_phen_moist_threshold= "fates_phen_moist_threshold" character(len=param_string_length),parameter,public :: ED_name_phen_doff_time= "fates_phen_doff_time" character(len=param_string_length),parameter,public :: ED_name_phen_a= "fates_phen_a" character(len=param_string_length),parameter,public :: ED_name_phen_b= "fates_phen_b" @@ -214,6 +222,7 @@ subroutine FatesParamsInit() photo_temp_acclim_timescale = nan photo_tempsens_model = -9 maintresp_model = -9 + phen_drought_model = -9 fates_mortality_disturbance_fraction = nan ED_val_comp_excln = nan ED_val_init_litter = nan @@ -223,6 +232,7 @@ subroutine FatesParamsInit() ED_val_cwd_flig = nan ED_val_base_mr_20 = nan ED_val_phen_drought_threshold = nan + ED_val_phen_moist_threshold = nan ED_val_phen_doff_time = nan ED_val_phen_a = nan ED_val_phen_b = nan @@ -297,7 +307,10 @@ subroutine FatesRegisterParams(fates_params) call fates_params%RegisterParameter(name=name_maintresp_model,dimension_shape=dimension_shape_scalar, & dimension_names=dim_names_scalar) - + + call fates_params%RegisterParameter(name=name_phen_drought_model,dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) + call fates_params%RegisterParameter(name=name_theta_cj_c3, dimension_shape=dimension_shape_scalar, & dimension_names=dim_names_scalar) @@ -331,6 +344,9 @@ subroutine FatesRegisterParams(fates_params) call fates_params%RegisterParameter(name=ED_name_phen_drought_threshold, dimension_shape=dimension_shape_scalar, & dimension_names=dim_names_scalar) + call fates_params%RegisterParameter(name=ED_name_phen_moist_threshold, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) + call fates_params%RegisterParameter(name=ED_name_phen_doff_time, dimension_shape=dimension_shape_scalar, & dimension_names=dim_names_scalar) @@ -479,7 +495,11 @@ subroutine FatesReceiveParams(fates_params) call fates_params%RetreiveParameter(name=name_maintresp_model, & data=tmpreal) maintresp_model = nint(tmpreal) - + + call fates_params%RetreiveParameter(name=name_phen_drought_model, & + data=tmpreal) + phen_drought_model = nint(tmpreal) + call fates_params%RetreiveParameter(name=ED_name_mort_disturb_frac, & data=fates_mortality_disturbance_fraction) @@ -507,6 +527,9 @@ subroutine FatesReceiveParams(fates_params) call fates_params%RetreiveParameter(name=ED_name_phen_drought_threshold, & data=ED_val_phen_drought_threshold) + call fates_params%RetreiveParameter(name=ED_name_phen_moist_threshold, & + data=ED_val_phen_moist_threshold) + call fates_params%RetreiveParameter(name=ED_name_phen_doff_time, & data=ED_val_phen_doff_time) @@ -633,6 +656,7 @@ subroutine FatesReceiveParams(fates_params) hydr_htftype_node(:) = nint(hydr_htftype_real(:)) deallocate(hydr_htftype_real) + end subroutine FatesReceiveParams ! ===================================================================================== @@ -653,6 +677,7 @@ subroutine FatesReportParams(is_master) write(fates_log(),fmt0) 'photo_temp_acclim_timescale = ',photo_temp_acclim_timescale write(fates_log(),fmti) 'hydr_htftype_node = ',hydr_htftype_node write(fates_log(),fmt0) 'fates_mortality_disturbance_fraction = ',fates_mortality_disturbance_fraction + write(fates_log(),fmti) 'phen_drought_model = ',phen_drought_model write(fates_log(),fmt0) 'ED_val_comp_excln = ',ED_val_comp_excln write(fates_log(),fmt0) 'ED_val_init_litter = ',ED_val_init_litter write(fates_log(),fmt0) 'ED_val_nignitions = ',ED_val_nignitions @@ -661,6 +686,7 @@ subroutine FatesReportParams(is_master) write(fates_log(),fmt0) 'ED_val_cwd_flig = ',ED_val_cwd_flig write(fates_log(),fmt0) 'ED_val_base_mr_20 = ', ED_val_base_mr_20 write(fates_log(),fmt0) 'ED_val_phen_drought_threshold = ',ED_val_phen_drought_threshold + write(fates_log(),fmt0) 'ED_val_phen_moist_threshold = ',ED_val_phen_moist_threshold write(fates_log(),fmt0) 'ED_val_phen_doff_time = ',ED_val_phen_doff_time write(fates_log(),fmt0) 'ED_val_phen_a = ',ED_val_phen_a write(fates_log(),fmt0) 'ED_val_phen_b = ',ED_val_phen_b diff --git a/main/EDPftvarcon.F90 b/main/EDPftvarcon.F90 index b3c9887f27..bbeeefa6da 100644 --- a/main/EDPftvarcon.F90 +++ b/main/EDPftvarcon.F90 @@ -8,6 +8,7 @@ module EDPftvarcon ! !USES: use EDTypesMod , only : maxSWb, ivis, inir use EDTypesMod , only : n_uptake_mode, p_uptake_mode + use EDTypesMod , only : drgt_phen_model_gradual use FatesConstantsMod, only : r8 => fates_r8 use FatesConstantsMod, only : nearzero use FatesConstantsMod, only : itrue, ifalse @@ -169,7 +170,8 @@ module EDPftvarcon ! on bud-burst [kgC/kgC] real(r8), allocatable :: phen_cold_size_threshold(:) ! stem/leaf drop occurs on DBH size of decidious non-woody ! (coastal grass) plants larger than the threshold value - real(r8), allocatable :: phen_stem_drop_fraction(:) ! Fraction of stem dropped/senescened for decidious + real(r8), allocatable :: phen_fnrt_drop_fraction(:) ! Fraction of fine roots abscissed when leaves absciss + real(r8), allocatable :: phen_stem_drop_fraction(:) ! Fraction of stem abscissed when leaves absciss, for deciduous ! non-woody (grass) plants ! Nutrient Aquisition parameters @@ -572,6 +574,10 @@ 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_phen_fnrt_drop_fraction' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + ! Nutrient competition parameters @@ -915,6 +921,10 @@ subroutine Receive_PFT(this, fates_params) call fates_params%RetreiveParameterAllocate(name=name, & data=this%phen_stem_drop_fraction) + name = 'fates_phen_fnrt_drop_fraction' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%phen_fnrt_drop_fraction) + name = 'fates_prescribed_nuptake' call fates_params%RetreiveParameterAllocate(name=name, & data=this%prescribed_nuptake) @@ -1431,6 +1441,7 @@ subroutine FatesReportPFTParams(is_master) write(fates_log(),fmt0) 'taus = ',EDPftvarcon_inst%taus write(fates_log(),fmt0) 'phenflush_fraction',EDpftvarcon_inst%phenflush_fraction write(fates_log(),fmt0) 'phen_cold_size_threshold = ',EDPftvarcon_inst%phen_cold_size_threshold + write(fates_log(),fmt0) 'phen_fnrt_drop_fraction',EDpftvarcon_inst%phen_fnrt_drop_fraction write(fates_log(),fmt0) 'phen_stem_drop_fraction',EDpftvarcon_inst%phen_stem_drop_fraction write(fates_log(),fmt0) 'fire_alpha_SH = ',EDPftvarcon_inst%fire_alpha_SH write(fates_log(),fmt0) 'allom_frbstor_repro = ',EDPftvarcon_inst%allom_frbstor_repro @@ -1476,7 +1487,12 @@ subroutine FatesCheckParams(is_master) ! ----------------------------------------------------------------------------------- use FatesConstantsMod , only : fates_check_param_set use FatesConstantsMod , only : itrue, ifalse - use EDParamsMod , only : logging_mechanical_frac, logging_collateral_frac, logging_direct_frac + use EDParamsMod , only : logging_mechanical_frac + use EDParamsMod , only : logging_collateral_frac + use EDParamsMod , only : logging_direct_frac + use EDParamsMod , only : phen_drought_model + use EDParamsMod , only : ED_val_phen_drought_threshold + use EDParamsMod , only : ED_val_phen_moist_threshold use FatesInterfaceTypesMod , only : hlm_use_fixed_biogeog ! Argument @@ -1680,8 +1696,18 @@ subroutine FatesCheckParams(is_master) write(fates_log(),*) ' Aborting' call endrun(msg=errMsg(sourcefile, __LINE__)) end if + if ( ( EDPftvarcon_inst%phen_fnrt_drop_fraction(ipft) < 0.0_r8 ) .or. & + ( EDPFtvarcon_inst%phen_fnrt_drop_fraction(ipft) > 1.0_r8 ) ) then + write(fates_log(),*) ' Abscission rate for fine roots must be between 0 and 1 for ' + write(fates_log(),*) ' deciduous PFTs.' + write(fates_log(),*) ' PFT#: ',ipft + write(fates_log(),*) ' evergreen flag: (shold be 0):',int(prt_params%evergreen(ipft)) + write(fates_log(),*) ' phen_fnrt_drop_fraction: ', EDPFtvarcon_inst%phen_fnrt_drop_fraction(ipft) + write(fates_log(),*) ' Aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if if ( ( EDPftvarcon_inst%phen_stem_drop_fraction(ipft) < 0.0_r8 ) .or. & - ( EDPFtvarcon_inst%phen_stem_drop_fraction(ipft) > 1 ) ) then + ( EDPFtvarcon_inst%phen_stem_drop_fraction(ipft) > 1.0_r8 ) ) then write(fates_log(),*) ' Deciduous non-wood plants must keep 0-100% of their stems' write(fates_log(),*) ' during the deciduous period.' write(fates_log(),*) ' PFT#: ',ipft @@ -1786,6 +1812,40 @@ subroutine FatesCheckParams(is_master) !! end do + ! When using the the gradual (ED2-like) phenology, we must ensure that the lower + ! and upper thresholds are consistent (i.e., that both are based on either soil + ! water content or soil matric potential). + select case (phen_drought_model) + case(drgt_phen_model_gradual) + + if (ED_val_phen_drought_threshold*ED_val_phen_moist_threshold < 0._r8) then + ! In case the product of the lower and upper thresholds is negative, the + ! thresholds are inconsistent as both should be defined using the same + ! quantity. + write(fates_log(),*) ' When using gradual (ED2-like) drought deciduous phenology,' + write(fates_log(),*) ' the moist threshold should be have the same sign as' + write(fates_log(),*) ' the dry threshold. Positive = soil water content [m3/m3],' + write(fates_log(),*) ' Negative = soil matric potential [mm].' + write(fates_log(),*) ' fates_phen_drought_threshold (dry threshold) = ',ED_val_phen_drought_threshold + write(fates_log(),*) ' fates_phen_moist_threshold (moist threshold) = ',ED_val_phen_moist_threshold + write(fates_log(),*) ' Aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + + elseif ( ED_val_phen_drought_threshold >= ED_val_phen_moist_threshold) then + write(fates_log(),*) ' When using gradual (ED2-like) drought deciduous phenology,' + write(fates_log(),*) ' the moist threshold should be greater than the dry threshold.' + write(fates_log(),*) ' By greater we mean more positive or less negative, and' + write(fates_log(),*) ' they cannot be the identical.' + write(fates_log(),*) ' fates_phen_drought_threshold (dry threshold) = ',ED_val_phen_drought_threshold + write(fates_log(),*) ' fates_phen_moist_threshold (moist threshold) = ',ED_val_phen_moist_threshold + write(fates_log(),*) ' Aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + end select + + + return end subroutine FatesCheckParams diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index f149fd189e..d49dd743ac 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -84,19 +84,22 @@ module EDTypesMod ! can be approximated to be equal to the visible band + integer, parameter, public :: leaves_pshed = 3 ! Flag specifying that a deciduous plant has leaves + ! but is shedding them (partial shedding). This plant + ! should not allocate carbon towards growth or + ! reproduction. integer, parameter, public :: leaves_on = 2 ! Flag specifying that a deciduous plant has leaves ! and should be allocating to them as well integer, parameter, public :: leaves_off = 1 ! Flag specifying that a deciduous plant has dropped ! its leaves and should not be trying to allocate ! towards any growth. - - integer, parameter, public :: phen_ref_smp = 2 ! Flag specifying that a drought deciduous plant - ! uses a soil matric potential threshold to - ! decide when to shed or flush leaves - integer, parameter, public :: phen_ref_liqvol = 1 ! Flag specifying that a drought deciduous plant - ! uses a soil moisture (liquid water volume) threshold to - ! decide when to shed or flush leaves + integer, parameter, public :: drgt_phen_model_smoist = 0 ! Switch for the default FATES drought + ! deciduous phenology. + integer, parameter, public :: drgt_phen_model_gradual = 1 ! Switch for the ED2-like drought deciduous + ! phenology, which allows for gradual + ! abscission and flushing by using two + ! thresholds. ! Flag to turn on/off salinity effects on the effective "btran" ! btran stress function. @@ -145,10 +148,11 @@ module EDTypesMod integer, parameter, public :: phen_cstat_iscold = 1 ! This (location/plant) is in a cold-state where leaves should have fallen integer, parameter, public :: phen_cstat_notcold = 2 ! This site is in a warm-state where leaves are allowed to flush - integer, parameter, public :: phen_dstat_timeoff = 0 ! Leaves off due to time exceedance (drought phenology) - integer, parameter, public :: phen_dstat_moistoff = 1 ! Leaves off due to moisture avail (drought phenology) - integer, parameter, public :: phen_dstat_moiston = 2 ! Leaves on due to moisture avail (drought phenology) - integer, parameter, public :: phen_dstat_timeon = 3 ! Leaves on due to time exceedance (drought phenology) + integer, parameter, public :: phen_dstat_timeoff = 0 ! Leaves off due to time exceedance (drought phenology) + integer, parameter, public :: phen_dstat_moistoff = 1 ! Leaves off due to moisture avail (drought phenology) + integer, parameter, public :: phen_dstat_moiston = 2 ! Leaves on due to moisture avail (drought phenology) + integer, parameter, public :: phen_dstat_timeon = 3 ! Leaves on due to time exceedance (drought phenology) + integer, parameter, public :: phen_dstat_pshed = 4 ! Leaves partially abscissing (drought phenology) ! SPITFIRE @@ -242,6 +246,11 @@ module EDTypesMod real(r8) :: prom_weight ! How much of this cohort is promoted each year, as a proportion of all cohorts:- integer :: nv ! Number of leaf layers: - integer :: status_coh ! growth status of plant (2 = leaves on , 1 = leaves off) + real(r8) :: efleaf_coh ! Elongation factor for leaves (fraction) + real(r8) :: effnrt_coh ! Elongation factor for fine roots (fraction) + real(r8) :: efstem_coh ! Elongation factor for stem (fraction) + ! For all the elongation factors, zero means fully abscissed, and + ! one means fully flushed. real(r8) :: c_area ! areal extent of canopy (m2) real(r8) :: treelai ! lai of an individual within cohort leaf area (m2) / crown area (m2) real(r8) :: treesai ! stem area index of an indiv. within cohort: stem area (m2) / crown area (m2) @@ -730,6 +739,7 @@ module EDTypesMod ! 1 = leaves off due to moisture avail ! 2 = leaves on due to moisture avail ! 3 = leaves on due to time exceedance + ! 4 = leaves partially on (ED2-like phenology) integer :: nchilldays ! num chilling days: (for botta gdd trheshold calculation) integer :: ncolddays ! num cold days: (must exceed threshold to drop leaves) real(r8) :: vegtemp_memory(num_vegtemp_mem) ! record of last 10 days temperature for senescence model. deg C @@ -741,6 +751,8 @@ module EDTypesMod integer :: dleafoffdate(maxpft) ! model date (day integer) of leaf off drought:- integer :: dndaysleafon(maxpft) ! number of days since leaf on period started (drought) integer :: dndaysleafoff(maxpft) ! number of days since leaf off period started (drought) + real(r8) :: elong_factor(maxpft) ! Elongation factor (ED2-like phenology). This is zero when leaves are + ! completely off, and one when they are completely flushed. real(r8) :: liqvol_memory(numWaterMem,maxpft) ! last 10 days of soil liquid water volume (drought phenology) real(r8) :: smp_memory(numWaterMem,maxpft) ! last 10 days of soil matric potential (drought phenology) @@ -1062,6 +1074,9 @@ subroutine dump_cohort(ccohort) write(fates_log(),*) 'co%canopy_layer_yesterday = ', ccohort%canopy_layer_yesterday write(fates_log(),*) 'co%nv = ', ccohort%nv write(fates_log(),*) 'co%status_coh = ', ccohort%status_coh + write(fates_log(),*) 'co%efleaf_coh = ', ccohort%efleaf_coh + write(fates_log(),*) 'co%effnrt_coh = ', ccohort%effnrt_coh + write(fates_log(),*) 'co%efstem_coh = ', ccohort%efstem_coh write(fates_log(),*) 'co%canopy_trim = ', ccohort%canopy_trim write(fates_log(),*) 'co%excl_weight = ', ccohort%excl_weight write(fates_log(),*) 'co%prom_weight = ', ccohort%prom_weight diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 140259775c..eb9f736411 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -518,6 +518,7 @@ module FatesHistoryInterfaceMod integer :: ih_dleafon_si_pft integer :: ih_meanliqvol_si_pft integer :: ih_meansmp_si_pft + integer :: ih_elong_factor_si_pft ! indices to (site x patch-age) variables @@ -2036,6 +2037,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_dleafon_si_pft => this%hvars(ih_dleafon_si_pft)%r82d, & hio_meanliqvol_si_pft => this%hvars(ih_meanliqvol_si_pft)%r82d, & hio_meansmp_si_pft => this%hvars(ih_meansmp_si_pft)%r82d, & + hio_elong_factor_si_pft => this%hvars(ih_elong_factor_si_pft)%r82d, & hio_cbal_err_fates_si => this%hvars(ih_cbal_err_fates_si)%r81d, & hio_err_fates_si => this%hvars(ih_err_fates_si)%r82d ) @@ -2096,6 +2098,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_site_dstatus_si_pft(io_si,i_pft) = real(sites(s)%dstatus(i_pft),r8) hio_dleafoff_si_pft(io_si,i_pft) = real(sites(s)%dndaysleafon (i_pft),r8) hio_dleafon_si_pft(io_si,i_pft) = real(sites(s)%dndaysleafoff(i_pft),r8) + hio_elong_factor_si_pft(io_si,i_pft) = sites(s)%elong_factor(i_pft) if(model_day_int>numWaterMem)then hio_meanliqvol_si_pft(io_si,i_pft) = & @@ -4350,6 +4353,12 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=site_pft_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_meansmp_si_pft) + call this%set_history_var(vname='SITE_ELONG_FACTOR', units='1', & + long='site level mean elongation factor (partial flushing or abscission) by PFT', & + use_default='active', & + avgflag='A', vtype=site_pft_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_elong_factor_si_pft) + call this%set_history_var(vname='PFTbiomass', units='gC/m2', & long='total PFT level biomass', use_default='active', & avgflag='A', vtype=site_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & diff --git a/main/FatesInventoryInitMod.F90 b/main/FatesInventoryInitMod.F90 index c3f0969b57..2db3bf119d 100644 --- a/main/FatesInventoryInitMod.F90 +++ b/main/FatesInventoryInitMod.F90 @@ -915,7 +915,11 @@ subroutine set_inventory_edcohort_type1(csite,bc_in,css_file_unit,npatches, & real(r8) :: m_sapw ! Generic mass for sapwood [kg] real(r8) :: m_store ! Generic mass for storage [kg] real(r8) :: m_repro ! Generic mass for reproductive tissues [kg] - real(r8) :: stem_drop_fraction + real(r8) :: elongf_leaf ! Leaf elongation factor + real(r8) :: elongf_fnrt ! Fine-root "elongation factor" + real(r8) :: elongf_stem ! Stem "elongation factor" + real(r8) :: fnrt_drop_fraction ! Fine-root abscission fraction + real(r8) :: stem_drop_fraction ! Stem abscission fraction integer :: i_pft, ncohorts_to_create character(len=128),parameter :: wr_fmt = & @@ -1039,47 +1043,63 @@ subroutine set_inventory_edcohort_type1(csite,bc_in,css_file_unit,npatches, & call bstore_allom(temp_cohort%dbh, temp_cohort%pft, temp_cohort%canopy_trim, c_store) - temp_cohort%leafmemory = 0._r8 - temp_cohort%fnrtmemory = 0._r8 - temp_cohort%sapwmemory = 0._r8 - temp_cohort%structmemory = 0._r8 + + ! MLO update 20211123. The "memory" variables are now always set to the on-allometry state + ! (accounting for canopy trimming when necessary). We no longer reset them to zero when + ! leaves are flushing. This makes partial deciduousness a bit easier to implement. + temp_cohort%leafmemory = c_leaf + temp_cohort%fnrtmemory = c_fnrt + temp_cohort%sapwmemory = c_sapw + temp_cohort%structmemory = c_struct + cstatus = leaves_on + elongf_leaf = 1.0_r8 + elongf_fnrt = 1.0_r8 + elongf_stem = 1.0_r8 - stem_drop_fraction = EDPftvarcon_inst%phen_stem_drop_fraction(temp_cohort%pft) + fnrt_drop_fraction = EDPftvarcon_inst%phen_fnrt_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 - ! MLO update: sapwmemory and structmemory used to be deficit, despite the - ! name. The code has been updated elsewhere to use these - ! variables as memory variables. - temp_cohort%leafmemory = c_leaf ! Leaf biomass memory - temp_cohort%fnrtmemory = c_fnrt ! Fine root memory - temp_cohort%sapwmemory = c_sapw ! Sapwood memory - temp_cohort%structmemory = c_struct ! Heartwood memory - c_leaf = 0._r8 - !c_fnrt = c_fnrt... Do not change fine root, if leaves are off - ! fine roots may steadily decline depending on the PFT. - c_sapw = (1._r8 - stem_drop_fraction) * c_sapw - c_struct = (1._r8 - stem_drop_fraction) * c_struct - cstatus = leaves_off - endif - - if ( prt_params%stress_decid(temp_cohort%pft) == itrue .and. & - any(csite%dstatus(temp_cohort%pft) == [phen_dstat_timeoff,phen_dstat_moistoff])) then - ! MLO update: sapwmemory and structmemory used to be deficit, despite the - ! name. The code has been updated elsewhere to use these - ! variables as memory variables. - temp_cohort%leafmemory = c_leaf ! Leaf biomass memory - temp_cohort%fnrtmemory = c_fnrt ! Fine root memory - temp_cohort%sapwmemory = c_sapw ! Sapwood memory - temp_cohort%structmemory = c_struct ! Heartwood memory - c_leaf = 0._r8 - !c_fnrt = c_fnrt... Do not change fine root, if leaves are off - ! fine roots may steadily decline depending on the PFT. - c_sapw = (1._r8 - stem_drop_fraction) * c_sapw - c_struct = (1._r8 - stem_drop_fraction) * c_struct - cstatus = leaves_off - endif + elongf_leaf = 0.0_r8 + elongf_fnrt = 1._r8 - fnrt_drop_fraction + elongf_stem = 1._r8 - stem_drop_fraction + + c_leaf = elongf_leaf * c_leaf + c_fnrt = elongf_fnrt * c_fnrt + c_sapw = elongf_stem * c_sapw + c_struct = elongf_stem * c_struct + + cstatus = leaves_off + elseif ( prt_params%stress_decid(temp_cohort%pft) == itrue ) then + ! Drought deciduous. For the default approach, elongation factor is either + ! zero (full abscission) or one (fully flushed), but this can also be a + ! fraction in other approaches. Here we assume that leaves are "on" (i.e. + ! either fully flushed or growing) if elongation factor is not 0 for the + ! initial conditions. + ! + ! For tissues other than leaves, the actual drop fraction is a combination + ! of the elongation factor (e) and the drop fraction (x), which will ensure + ! that the remaining tissue biomass will be exactly e when x=1, and exactly + ! the original biomass when x = 0. + elongf_leaf = csite%elong_factor(temp_cohort%pft) + elongf_fnrt = 1.0_r8 - (1.0_r8 - elongf_leaf ) * fnrt_drop_fraction + elongf_stem = 1.0_r8 - (1.0_r8 - elongf_leaf ) * stem_drop_fraction + + + c_leaf = elongf_leaf * c_leaf + c_fnrt = elongf_fnrt * c_fnrt + c_sapw = elongf_stem * c_sapw + c_struct = elongf_stem * c_struct + if (elongf_leaf > 0.0_r8) then + ! Assume leaves are growing even if they are not fully flushed. + cstatus = leaves_on + else + ! Leaves are off (abscissing). + cstatus = leaves_off + end if + end if prt_obj => null() call InitPRTObject(prt_obj) @@ -1176,8 +1196,8 @@ subroutine set_inventory_edcohort_type1(csite,bc_in,css_file_unit,npatches, & call create_cohort(csite, cpatch, temp_cohort%pft, temp_cohort%n, temp_cohort%hite, & temp_cohort%coage, temp_cohort%dbh, & prt_obj, temp_cohort%leafmemory, temp_cohort%fnrtmemory, & - temp_cohort%sapwmemory, temp_cohort%structmemory, & - cstatus, rstatus, temp_cohort%canopy_trim,temp_cohort%c_area, & + temp_cohort%sapwmemory, temp_cohort%structmemory, elongf_leaf, elongf_fnrt, & + elongf_stem, cstatus, rstatus, temp_cohort%canopy_trim,temp_cohort%c_area, & 1, csite%spread, bc_in) deallocate(temp_cohort) ! get rid of temporary cohort diff --git a/main/FatesRestartInterfaceMod.F90 b/main/FatesRestartInterfaceMod.F90 index 6d56d7dca6..e8fc97e0bd 100644 --- a/main/FatesRestartInterfaceMod.F90 +++ b/main/FatesRestartInterfaceMod.F90 @@ -148,6 +148,9 @@ module FatesRestartInterfaceMod integer :: ir_resp_tstep_co integer :: ir_pft_co integer :: ir_status_co + integer :: ir_efleaf_co + integer :: ir_effnrt_co + integer :: ir_efstem_co integer :: ir_isnew_co ! Litter @@ -184,6 +187,7 @@ module FatesRestartInterfaceMod integer :: ir_dleafoffdate_sift integer :: ir_dndaysleafon_sift integer :: ir_dndaysleafoff_sift + integer :: ir_elong_factor_sift integer :: ir_liqvolmem_siwmft integer :: ir_smpmem_siwmft integer :: ir_vegtempmem_sitm @@ -875,6 +879,18 @@ subroutine define_restart_vars(this, initialize_variables) long_name='ed cohort - plant phenology status', units='unitless', flushval = flushzero, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_status_co ) + call this%set_restart_var(vname='fates_efleaf_coh', vtype=cohort_r8, & + long_name='ed cohort - leaf elongation factor', units='unitless', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_efleaf_co ) + + call this%set_restart_var(vname='fates_effnrt_coh', vtype=cohort_r8, & + long_name='ed cohort - fine-root elongation factor', units='unitless', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_effnrt_co ) + + call this%set_restart_var(vname='fates_efstem_coh', vtype=cohort_r8, & + long_name='ed cohort - stem elongation factor', units='unitless', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_efstem_co ) + call this%set_restart_var(vname='fates_isnew', vtype=cohort_int, & long_name='ed cohort - binary flag specifying if a plant has experienced a full day cycle', & units='0/1', flushval = flushone, & @@ -1167,6 +1183,10 @@ subroutine define_restart_vars(this, initialize_variables) long_name='number of days since leaf off (drought deciduous)', units='days', flushval = flushinvalid, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_dndaysleafoff_sift ) + call this%set_restart_var(vname='fates_elong_factor', vtype=cohort_r8, & + long_name='leaf elongation factor (0 - completely abscissed; 1 - completely flushed)', units='unitless', flushval = flushinvalid, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_elong_factor_sift ) + call this%set_restart_var(vname='fates_liqvol_memory', vtype=cohort_r8, & long_name='last 10 days of volumetric soil water, by site x day-index', & units='m3/m3', flushval = flushzero, & @@ -1728,6 +1748,9 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_resp_tstep_co => this%rvars(ir_resp_tstep_co)%r81d, & rio_pft_co => this%rvars(ir_pft_co)%int1d, & rio_status_co => this%rvars(ir_status_co)%int1d, & + rio_efleaf_co => this%rvars(ir_efleaf_co)%r81d, & + rio_effnrt_co => this%rvars(ir_effnrt_co)%r81d, & + rio_efstem_co => this%rvars(ir_efstem_co)%r81d, & rio_isnew_co => this%rvars(ir_isnew_co)%int1d, & rio_gnd_alb_dif_pasb => this%rvars(ir_gnd_alb_dif_pasb)%r81d, & rio_gnd_alb_dir_pasb => this%rvars(ir_gnd_alb_dir_pasb)%r81d, & @@ -1743,6 +1766,7 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_dleafoffdate_sift => this%rvars(ir_dleafoffdate_sift)%int1d, & rio_dndaysleafon_sift => this%rvars(ir_dndaysleafon_sift)%int1d, & rio_dndaysleafoff_sift => this%rvars(ir_dndaysleafoff_sift)%int1d, & + rio_elong_factor_sift => this%rvars(ir_elong_factor_sift)%r81d, & rio_liqvolmem_siwmft => this%rvars(ir_liqvolmem_siwmft)%r81d, & rio_smpmem_siwmft => this%rvars(ir_smpmem_siwmft)%r81d, & rio_vegtempmem_sitm => this%rvars(ir_vegtempmem_sitm)%r81d, & @@ -1974,6 +1998,9 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_resp_tstep_co(io_idx_co) = ccohort%resp_tstep rio_pft_co(io_idx_co) = ccohort%pft rio_status_co(io_idx_co) = ccohort%status_coh + rio_efleaf_co(io_idx_co) = ccohort%efleaf_coh + rio_effnrt_co(io_idx_co) = ccohort%effnrt_coh + rio_efstem_co(io_idx_co) = ccohort%efstem_coh if ( ccohort%isnew ) then rio_isnew_co(io_idx_co) = new_cohort else @@ -2167,6 +2194,7 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_dleafoffdate_sift(io_idx_si_pft) = sites(s)%dleafoffdate(i_pft) rio_dndaysleafon_sift(io_idx_si_pft) = sites(s)%dndaysleafon(i_pft) rio_dndaysleafoff_sift(io_idx_si_pft) = sites(s)%dndaysleafoff(i_pft) + rio_elong_factor_sift(io_idx_si_pft) = sites(s)%elong_factor(i_pft) io_idx_si_pft = io_idx_si_pft + 1 end do @@ -2564,6 +2592,9 @@ subroutine get_restart_vectors(this, nc, nsites, sites) rio_resp_tstep_co => this%rvars(ir_resp_tstep_co)%r81d, & rio_pft_co => this%rvars(ir_pft_co)%int1d, & rio_status_co => this%rvars(ir_status_co)%int1d, & + rio_efleaf_co => this%rvars(ir_efleaf_co)%r81d, & + rio_effnrt_co => this%rvars(ir_effnrt_co)%r81d, & + rio_efstem_co => this%rvars(ir_efstem_co)%r81d, & rio_isnew_co => this%rvars(ir_isnew_co)%int1d, & rio_gnd_alb_dif_pasb => this%rvars(ir_gnd_alb_dif_pasb)%r81d, & rio_gnd_alb_dir_pasb => this%rvars(ir_gnd_alb_dir_pasb)%r81d, & @@ -2579,6 +2610,7 @@ subroutine get_restart_vectors(this, nc, nsites, sites) rio_dleafoffdate_sift => this%rvars(ir_dleafoffdate_sift)%int1d, & rio_dndaysleafon_sift => this%rvars(ir_dndaysleafon_sift)%int1d, & rio_dndaysleafoff_sift => this%rvars(ir_dndaysleafoff_sift)%int1d, & + rio_elong_factor_sift => this%rvars(ir_elong_factor_sift)%r81d, & rio_liqvolmem_siwmft => this%rvars(ir_liqvolmem_siwmft)%r81d, & rio_smpmem_siwmft => this%rvars(ir_smpmem_siwmft)%r81d, & rio_vegtempmem_sitm => this%rvars(ir_vegtempmem_sitm)%r81d, & @@ -2780,6 +2812,9 @@ subroutine get_restart_vectors(this, nc, nsites, sites) ccohort%resp_tstep = rio_resp_tstep_co(io_idx_co) ccohort%pft = rio_pft_co(io_idx_co) ccohort%status_coh = rio_status_co(io_idx_co) + ccohort%efleaf_coh = rio_efleaf_co(io_idx_co) + ccohort%effnrt_coh = rio_effnrt_co(io_idx_co) + ccohort%efstem_coh = rio_efstem_co(io_idx_co) ccohort%isnew = ( rio_isnew_co(io_idx_co) .eq. new_cohort ) call UpdateCohortBioPhysRates(ccohort) @@ -3037,6 +3072,7 @@ subroutine get_restart_vectors(this, nc, nsites, sites) sites(s)%dleafoffdate(i_pft) = rio_dleafoffdate_sift(io_idx_si_pft) sites(s)%dndaysleafon(i_pft) = rio_dndaysleafon_sift(io_idx_si_pft) sites(s)%dndaysleafoff(i_pft) = rio_dndaysleafoff_sift(io_idx_si_pft) + sites(s)%elong_factor(i_pft) = rio_elong_factor_sift(io_idx_si_pft) io_idx_si_pft = io_idx_si_pft + 1 end do diff --git a/parameter_files/fates_params_default.cdl b/parameter_files/fates_params_default.cdl index e30409f83d..e261313ebd 100644 --- a/parameter_files/fates_params_default.cdl +++ b/parameter_files/fates_params_default.cdl @@ -403,6 +403,9 @@ variables: double fates_phen_evergreen(fates_pft) ; fates_phen_evergreen:units = "logical flag" ; fates_phen_evergreen:long_name = "Binary flag for evergreen leaf habit" ; + double fates_phen_fnrt_drop_fraction(fates_pft) ; + fates_phen_fnrt_drop_fraction:units = "fraction" ; + fates_phen_fnrt_drop_fraction:long_name = "fraction of fine roots to drop during drought/cold" ; double fates_phen_season_decid(fates_pft) ; fates_phen_season_decid:units = "logical flag" ; fates_phen_season_decid:long_name = "Binary flag for seasonal-deciduous leaf habit" ; @@ -719,12 +722,18 @@ variables: double fates_phen_doff_time ; fates_phen_doff_time:units = "days" ; fates_phen_doff_time:long_name = "day threshold compared against days since leaves became off-allometry" ; + double fates_phen_drought_model ; + fates_phen_drought_model:units = "none" ; + fates_phen_drought_model:long_name = "which method to use for drought phenology: 0 - FATES default; 1 - Semi-deciduous (ED2-like)" ; double fates_phen_drought_threshold ; fates_phen_drought_threshold:units = "m3/m3 or mm" ; - fates_phen_drought_threshold:long_name = "threshold for drought phenology; the quantity depends on the sign: if positive, the threshold is volumetric soil moisture (m3/m3). If negative, the threshold is soil matric potentical (mm)." ; + fates_phen_drought_threshold:long_name = "threshold for drought phenology (or lower threshold when fates_phen_drought_model = 2); the quantity depends on the sign: if positive, the threshold is volumetric soil moisture (m3/m3). If negative, the threshold is soil matric potentical (mm)." ; double fates_phen_mindayson ; fates_phen_mindayson:units = "days" ; fates_phen_mindayson:long_name = "day threshold compared against days since leaves became on-allometry" ; + double fates_phen_moist_threshold ; + fates_phen_moist_threshold:units = "m3/m3 or mm" ; + fates_phen_moist_threshold:long_name = "upper threshold for drought phenology (only for fates_phen_drought_model=2); the quantity depends on the sign: if positive, the threshold is volumetric soil moisture (m3/m3). If negative, the threshold is soil matric potentical (mm)." ; double fates_phen_ncolddayslim ; fates_phen_ncolddayslim:units = "days" ; fates_phen_ncolddayslim:long_name = "day threshold exceedance for temperature leaf-drop" ; @@ -1170,6 +1179,8 @@ data: fates_phen_evergreen = 1, 1, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0 ; + fates_phen_fnrt_drop_fraction = 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ; + fates_phen_season_decid = 0, 0, 1, 0, 0, 1, 0, 0, 1, 1, 0, 0 ; fates_phen_stem_drop_fraction = 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ; @@ -1463,10 +1474,14 @@ data: fates_phen_doff_time = 100 ; - fates_phen_drought_threshold = -140000. ; + fates_phen_drought_model = 0 ; + + fates_phen_drought_threshold = -203943.2 ; fates_phen_mindayson = 90 ; + fates_phen_moist_threshold = -122365.9 ; + fates_phen_ncolddayslim = 5 ; fates_photo_temp_acclim_timescale = 30 ; diff --git a/parteh/PRTAllometricCNPMod.F90 b/parteh/PRTAllometricCNPMod.F90 index 5617d71e5d..b566a6fb9f 100644 --- a/parteh/PRTAllometricCNPMod.F90 +++ b/parteh/PRTAllometricCNPMod.F90 @@ -55,7 +55,7 @@ module PRTAllometricCNPMod use FatesConstantsMod , only : fates_unset_int use FatesConstantsMod , only : sec_per_day use PRTParametersMod , only : prt_params - use EDTypesMod , only : leaves_on,leaves_off + use EDTypesMod , only : leaves_on,leaves_off,leaves_pshed implicit none private @@ -143,16 +143,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 - - ! 0=leaf off, 1=leaf on - integer, parameter :: num_bc_in = 7 + 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_efleaf = 8 ! Leaf elongation factor + integer, public, parameter :: acnp_bc_in_id_effnrt = 9 ! Fine-root "elongation factor" + integer, public, parameter :: acnp_bc_in_id_efstem = 10 ! Stem "elongation factor" + integer, parameter :: num_bc_in = 10 ! ------------------------------------------------------------------------------------- ! Output Boundary Indices (These are public) @@ -334,6 +335,9 @@ 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) :: elongf_leaf ! Leaf elongation factor [0-1] + real(r8) :: elongf_fnrt ! Fine-root "elongation factor" [0-1] + real(r8) :: elongf_stem ! Stem "elongation factor" [0-1] ! Pointers to output bcs real(r8),pointer :: c_efflux ! Total plant efflux of carbon (kgC) @@ -396,6 +400,9 @@ 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 + elongf_leaf = this%bc_in(acnp_bc_in_id_efleaf)%rval + elongf_fnrt = this%bc_in(acnp_bc_in_id_effnrt)%rval + elongf_stem = this%bc_in(acnp_bc_in_id_efstem)%rval ! Output only boundary conditions c_efflux => this%bc_out(acnp_bc_out_id_cefflux)%rval; c_efflux = 0._r8 @@ -441,6 +448,17 @@ subroutine DailyPRTAllometricCNP(this) target_c(repro_id) = 0._r8 target_dcdd(repro_id) = 0._r8 + ! Correct tissue targets based on the elongation factor + target_c(leaf_id) = elongf_leaf * target_c(leaf_id) + target_c(fnrt_id) = elongf_fnrt * target_c(fnrt_id) + target_c(sapw_id) = elongf_stem * target_c(sapw_id) + target_c(struct_id) = elongf_stem * target_c(struct_id) + ! MLO - Need to check whether or not the multiplication for the growth is correct or not. + target_dcdd(leaf_id) = elongf_leaf * target_dcdd(leaf_id) + target_dcdd(fnrt_id) = elongf_fnrt * target_dcdd(fnrt_id) + target_dcdd(sapw_id) = elongf_stem * target_dcdd(sapw_id) + target_dcdd(struct_id) = elongf_stem * target_dcdd(struct_id) + ! 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 @@ -647,6 +665,9 @@ 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] real(r8) :: c_gain0 + real(r8) :: elongf_leaf ! Leaf elongation factor + real(r8) :: elongf_fnrt ! Fine-root "elongation factor" + real(r8) :: elongf_stem ! Stem "elongation factor" 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) @@ -674,6 +695,9 @@ subroutine CNPPrioritizedReplacement(this, & c_gain0 = c_gain leaf_status = this%bc_in(acnp_bc_in_id_lstat)%ival + elongf_leaf = this%bc_in(acnp_bc_in_id_efleaf)%rval + elongf_fnrt = this%bc_in(acnp_bc_in_id_effnrt)%rval + elongf_stem = this%bc_in(acnp_bc_in_id_efstem)%rval ipft = this%bc_in(acnp_bc_in_id_pft)%ival canopy_trim = this%bc_in(acnp_bc_in_id_ctrim)%rval @@ -700,7 +724,8 @@ subroutine CNPPrioritizedReplacement(this, & ! 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)) & + if( ( any(leaf_status == [leaves_off,leaves_pshed]) .or. & + (prt_params%evergreen(ipft) .ne. itrue) ) & .and. (organ_list(ii).eq.leaf_organ)) cycle ! 1 is the highest priority code possible @@ -865,7 +890,7 @@ subroutine CNPPrioritizedReplacement(this, & ! 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(any(leaf_status == [leaves_off,leaves_pshed]) .and. (organ_list(ii).eq.leaf_organ)) cycle ! 1 is the highest priority code possible if( priority_code == i_pri ) then @@ -1009,7 +1034,10 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & real(r8), pointer :: dbh integer :: ipft real(r8) :: canopy_trim - real(r8) :: leaf_status + integer :: leaf_status + real(r8) :: elongf_leaf + real(r8) :: elongf_fnrt + real(r8) :: elongf_stem integer :: i, ii ! organ index loops (masked and unmasked) integer :: istep ! outer step iteration loop @@ -1088,6 +1116,9 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & integer, parameter :: p_limited = 3 leaf_status = this%bc_in(acnp_bc_in_id_lstat)%ival + elongf_leaf = this%bc_in(acnp_bc_in_id_efleaf)%rval + elongf_fnrt = this%bc_in(acnp_bc_in_id_effnrt)%rval + elongf_stem = this%bc_in(acnp_bc_in_id_efstem)%rval 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 @@ -1105,16 +1136,21 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & 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 + any(leaf_status == [leaves_off,leaves_pshed]) ) then return 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(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,r8) + intgr_params(acnp_bc_in_id_lstat) = real(this%bc_in(acnp_bc_in_id_lstat)%ival,r8) + intgr_params(acnp_bc_in_id_efleaf) = this%bc_in(acnp_bc_in_id_efleaf)%rval + intgr_params(acnp_bc_in_id_effnrt) = this%bc_in(acnp_bc_in_id_effnrt)%rval + intgr_params(acnp_bc_in_id_efstem) = this%bc_in(acnp_bc_in_id_efstem)%rval + + + state_mask(:) = .false. mask_organs(:) = fates_unset_int @@ -1358,6 +1394,7 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & end do call CheckIntegratedAllometries(state_array_out(dbh_id),ipft,canopy_trim, & + elongf_leaf, elongf_fnrt, elongf_stem, & 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), & @@ -1434,6 +1471,9 @@ 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(),*) 'elongf_leaf: ',elongf_leaf + write(fates_log(),*) 'elongf_fnrt: ',elongf_fnrt + write(fates_log(),*) 'elongf_stem: ',elongf_stem 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) @@ -1454,7 +1494,13 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & 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) - + + ! Correct the targets based on the elongation factors + leaf_c_target_tp1 = elongf_leaf * leaf_c_target_tp1 + fnrt_c_target_tp1 = elongf_fnrt * fnrt_c_target_tp1 + sapw_c_target_tp1 = elongf_stem * sapw_c_target_tp1 + struct_c_target_tp1 = elongf_stem * struct_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 write(fates_log(),*) 'sapw_c: ',sapwc_tp1, sapw_c_target_tp1 ,sapwc_tp1- sapw_c_target_tp1 @@ -1710,15 +1756,19 @@ 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) :: elongf_leaf + real(r8) :: elongf_fnrt + real(r8) :: elongf_stem + - - - 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 + elongf_leaf = this%bc_in(acnp_bc_in_id_efleaf)%rval + elongf_fnrt = this%bc_in(acnp_bc_in_id_effnrt)%rval + elongf_stem = this%bc_in(acnp_bc_in_id_efstem)%rval i_cvar = prt_global%sp_organ_map(organ_id,carbon12_element) - + ! Storage of nutrients are assumed to have different compartments than ! for carbon, and thus their targets are not associated with a tissue ! but is more represented as a fraction of the maximum amount of nutrient @@ -1733,6 +1783,12 @@ function GetNutrientTargetCNP(this,element_id,organ_id,stoich_mode) result(targe call bbgw_allom(dbh,ipft,bgw_c_target) call bdead_allom(agw_c_target,bgw_c_target, sapw_c_target, ipft, struct_c_target) + ! Correct the targets based on the elongation factors + leaf_c_target = elongf_leaf * leaf_c_target + fnrt_c_target = elongf_fnrt * fnrt_c_target + sapw_c_target = elongf_stem * sapw_c_target + struct_c_target = elongf_stem * struct_c_target + ! Target for storage is a fraction of the sum target of all ! non-reproductive organs @@ -2102,7 +2158,10 @@ function AllomCNPGrowthDeriv(l_state_array,l_state_mask,cbalance,intgr_params) r 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 - + + real(r8) :: elongf_leaf ! Leaf elongation factor (0-1) + real(r8) :: elongf_fnrt ! Fine-root "elongation factor" (0-1) + real(r8) :: elongf_stem ! Stem "elongation factor" (0-1) associate( dbh => l_state_array(dbh_id), & leaf_c => l_state_array(leaf_id), & @@ -2122,6 +2181,9 @@ function AllomCNPGrowthDeriv(l_state_array,l_state_mask,cbalance,intgr_params) r canopy_trim = intgr_params(acnp_bc_in_id_ctrim) ipft = int(intgr_params(acnp_bc_in_id_pft)) + elongf_leaf = intgr_params(acnp_bc_in_id_efleaf) + elongf_fnrt = intgr_params(acnp_bc_in_id_effnrt) + elongf_stem = intgr_params(acnp_bc_in_id_efstem) call bleaf(dbh,ipft,canopy_trim,leaf_c_target,leaf_dcdd_target) call bfineroot(dbh,ipft,canopy_trim,fnrt_c_target,fnrt_dcdd_target) @@ -2132,6 +2194,17 @@ function AllomCNPGrowthDeriv(l_state_array,l_state_mask,cbalance,intgr_params) r 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) + ! Apply correction for partially deciduous plants. + leaf_c_target = elongf_leaf * leaf_c_target + fnrt_c_target = elongf_fnrt * fnrt_c_target + sapw_c_target = elongf_stem * sapw_c_target + struct_c_target = elongf_stem * struct_c_target + ! MLO - Need to double check that it is correct to apply factor to both stocks and growth + leaf_dcdd_target = elongf_leaf * leaf_dcdd_target + fnrt_dcdd_target = elongf_fnrt * fnrt_dcdd_target + sapw_dcdd_target = elongf_stem * sapw_dcdd_target + struct_dcdd_target = elongf_stem * struct_dcdd_target + if (mask_repro) then ! fraction of carbon going towards reproduction if (dbh <= prt_params%dbh_repro_threshold(ipft)) then @@ -2222,72 +2295,101 @@ end function AllomCNPGrowthDeriv ! ==================================================================================== - subroutine TargetAllometryCheck(bleaf,bfroot,bsap,bstore,bdead, & - bt_leaf,bt_froot,bt_sap,bt_store,bt_dead, & - grow_leaf,grow_froot,grow_sapw,grow_store) + 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, & + elongf_leaf,elongf_fnrt,elongf_stem,ipft,leaf_status, & + grow_leaf,grow_fnrt,grow_sapw,grow_store,grow_struct) ! Arguments - real(r8),intent(in) :: bleaf !actual - real(r8),intent(in) :: bfroot - real(r8),intent(in) :: bsap + 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) :: bdead - real(r8),intent(in) :: bt_leaf !target - real(r8),intent(in) :: bt_froot - real(r8),intent(in) :: bt_sap + 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_dead - logical,intent(out) :: grow_leaf !growth flag - logical,intent(out) :: grow_froot + real(r8),intent(in) :: bt_struct + real(r8),intent(in) :: carbon_balance !remaining carbon balance + real(r8),intent(in) :: elongf_leaf !elongation factors + real(r8),intent(in) :: elongf_fnrt + real(r8),intent(in) :: elongf_stem + 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 - - if( (bt_leaf - bleaf)>calloc_abs_error) then - write(fates_log(),*) 'leaves are not on-allometry at the growth step' - write(fates_log(),*) 'exiting',bleaf,bt_leaf - call endrun(msg=errMsg(sourcefile, __LINE__)) - elseif( (bleaf - bt_leaf)>calloc_abs_error) then - ! leaf is above allometry, ignore - grow_leaf = .false. - else - grow_leaf = .true. - end if - - if( (bt_froot - bfroot)>calloc_abs_error) then - write(fates_log(),*) 'fineroots are not on-allometry at the growth step' - write(fates_log(),*) 'exiting',bfroot, bt_froot - call endrun(msg=errMsg(sourcefile, __LINE__)) - elseif( ( bfroot-bt_froot)>calloc_abs_error ) then - grow_froot = .false. - else - grow_froot = .true. - end if - - if( (bt_sap - bsap)>calloc_abs_error) then - write(fates_log(),*) 'sapwood is not on-allometry at the growth step' - write(fates_log(),*) 'exiting',bsap, bt_sap - call endrun(msg=errMsg(sourcefile, __LINE__)) - elseif( ( bsap-bt_sap)>calloc_abs_error ) then - grow_sapw = .false. + 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 - grow_sapw = .true. - end if - - if( (bt_store - bstore)>calloc_abs_error) then - write(fates_log(),*) 'storage is not on-allometry at the growth step' - write(fates_log(),*) 'exiting',bstore,bt_store + ! 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) ' elongf_leaf = ',elongf_leaf + write(fates_log(),fmt=fmte) ' elongf_fnrt = ',elongf_fnrt + write(fates_log(),fmt=fmte) ' elongf_stem = ',elongf_stem + 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__)) - elseif( ( bstore-bt_store)>calloc_abs_error ) then - grow_store = .false. - else - grow_store = .true. end if - if( (bt_dead - bdead)>calloc_abs_error) then - write(fates_log(),*) 'structure not on-allometry at the growth step' - write(fates_log(),*) 'exiting',bdead,bt_dead - call endrun(msg=errMsg(sourcefile, __LINE__)) - end if + return end subroutine TargetAllometryCheck diff --git a/parteh/PRTAllometricCarbonMod.F90 b/parteh/PRTAllometricCarbonMod.F90 index f7f92b3dd8..90375e8fb4 100644 --- a/parteh/PRTAllometricCarbonMod.F90 +++ b/parteh/PRTAllometricCarbonMod.F90 @@ -53,6 +53,7 @@ module PRTAllometricCarbonMod use EDTypesMod , only : leaves_on use EDTypesMod , only : leaves_off + use EDTypesMod , only : leaves_pshed implicit none private @@ -93,10 +94,13 @@ module PRTAllometricCarbonMod integer, parameter :: num_bc_inout = 2 ! Number of in & output boundary conditions - integer, public, parameter :: ac_bc_in_id_pft = 1 ! Index for the PFT input BC - integer, public, parameter :: ac_bc_in_id_ctrim = 2 ! Index for the canopy trim function - integer, public, parameter :: ac_bc_in_id_lstat = 3 ! Leaf status (on or off) - integer, parameter :: num_bc_in = 3 ! Number of input boundary conditions + integer, public, parameter :: ac_bc_in_id_pft = 1 ! Index for the PFT input BC + integer, public, parameter :: ac_bc_in_id_ctrim = 2 ! Index for the canopy trim function + integer, public, parameter :: ac_bc_in_id_lstat = 3 ! Leaf status (on or off) + integer, public, parameter :: ac_bc_in_id_efleaf = 4 ! Elongation factor (leaves) + integer, public, parameter :: ac_bc_in_id_effnrt = 5 ! "Elongation factor" (fine roots) + integer, public, parameter :: ac_bc_in_id_efstem = 6 ! "Elongation factor" (stem) + integer, parameter :: num_bc_in = 6 ! Number of input boundary conditions ! THere are no purely output boundary conditions integer, parameter :: num_bc_out = 0 ! Number of purely output boundary condtions @@ -325,6 +329,9 @@ subroutine DailyPRTAllometricCarbon(this) real(r8) :: struct_below_target ! dead (structural) biomass below target amount [kgC] real(r8) :: total_below_target ! total biomass below the allometric target [kgC] + real(r8) :: allocation_factor ! allocation factor (relative to demand) to + ! reconstruct tissues + real(r8) :: flux_adj ! adjustment made to growth flux term to minimize error [kgC] real(r8) :: store_target_fraction ! ratio between storage and leaf biomass when on allometry [kgC] @@ -373,6 +380,10 @@ subroutine DailyPRTAllometricCarbon(this) integer :: leaf_status ! are leaves on (2) or off (1) real(r8) :: leaf_age_flux ! carbon mass flux between leaf age classification pools + real(r8) :: elongf_leaf ! Leaf elongation factor + real(r8) :: elongf_fnrt ! Fine-root "elongation factor" + real(r8) :: elongf_stem ! Stem "elongation factor" + ! Integegrator variables c_pool is "mostly" carbon variables, it also includes ! dbh... @@ -417,18 +428,25 @@ subroutine DailyPRTAllometricCarbon(this) 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 + elongf_leaf = this%bc_in(ac_bc_in_id_efleaf)%rval + elongf_fnrt = this%bc_in(ac_bc_in_id_effnrt)%rval + elongf_stem = this%bc_in(ac_bc_in_id_efstem)%rval + + 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,r8) + intgr_params(ac_bc_in_id_lstat) = real(this%bc_in(ac_bc_in_id_lstat)%ival,r8) + intgr_params(ac_bc_in_id_efleaf) = this%bc_in(ac_bc_in_id_efleaf)%rval + intgr_params(ac_bc_in_id_effnrt) = this%bc_in(ac_bc_in_id_effnrt)%rval + intgr_params(ac_bc_in_id_efstem) = this%bc_in(ac_bc_in_id_efstem)%rval + - 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) - ! Set some logical flags to simplify "if" blocks is_hydecid_dormant = ( prt_params%stress_decid(ipft) == 1 ) .and. & - ( leaf_status == leaves_off ) + any(leaf_status == [leaves_off,leaves_pshed] ) is_deciduous = ( prt_params%stress_decid(ipft) == 1 ) .or. & ( prt_params%season_decid(ipft) == 1 ) - nleafage = prt_global%state_descriptor(leaf_c_id)%num_pos ! Number of leaf age class ! ----------------------------------------------------------------------------------- @@ -452,7 +470,7 @@ subroutine DailyPRTAllometricCarbon(this) store_c0 = store_c ! Set initial storage carbon repro_c0 = repro_c ! Set initial reproductive carbon struct_c0 = struct_c ! Set initial structural carbon - + ! ----------------------------------------------------------------------------------- ! II. Calculate target size of the biomass compartment for a given dbh. @@ -482,23 +500,24 @@ subroutine DailyPRTAllometricCarbon(this) ! ----------------------------------------------------------------------------------- - ! II 1/2. For drougth-deciduous plants, we assume that plants in LEAVES OFF status - ! do not rebuild any tissues lost to turnover. Any excess carbon balance - ! that they might have goes to storage (n.b. probably overly cautious, - ! because plants with no leaves should have zero or negative carbon balance, - ! unless there is some shady carbon market going on across cohorts...). + ! II 1/2. Update target biomass based on the leaf elongation factor and the abscission + ! fraction for each non-leaf tissue. Elongation factor is binary for + ! cold-deciduous and original drought-deciduous, and always one for + ! evergreens. In case the plant is shedding leaves, we impose that any + ! positive carbon balance necessarily goes to storage, even if this causes + ! storage to go above allometry. ! ----------------------------------------------------------------------------------- - if ( is_hydecid_dormant ) then - ! Drought deciduous, leaves off. Target is zero for all active tissues + if (is_hydecid_dormant) then target_leaf_c = 0.0_r8 target_fnrt_c = 0.0_r8 target_sapw_c = 0.0_r8 - - elseif ( leaf_status == leaves_off ) then - ! Cold deciduous. For now we let them rebuild fine root and sapwood. Note that - ! this assumption is less of an issue for cold deciduous because turnover rates - ! are lower during winter. - target_leaf_c = 0.0_r8 + target_struct_c = 0.0_r8 + target_store_c = target_store_c + max(0.0_r8,carbon_balance) + else + target_leaf_c = elongf_leaf * target_leaf_c + target_fnrt_c = elongf_fnrt * target_fnrt_c + target_sapw_c = elongf_stem * target_sapw_c + target_struct_c = elongf_stem * target_struct_c end if @@ -539,18 +558,16 @@ subroutine DailyPRTAllometricCarbon(this) if ( total_c_demand > nearzero ) then - ! We pay this even if we don't have the carbon + ! We pay this even if we don't have positive carbon balance. ! Just don't pay so much carbon that storage+carbon_balance can't pay for it + allocation_factor = max(0.0_r8,min(1.0_r8,(store_c+carbon_balance)/total_c_demand)) + + ! MLO. Edited the code to switch the order of operations. The previous code would ! subtract leaf flux from carbon balance before estimating the fine root flux, ! potentially allowing less fluxes to fine roots than possible. - leaf_c_flux = min(leaf_c_demand, & - max(0.0_r8, & - (store_c+carbon_balance)*leaf_c_demand/total_c_demand)) - ! If we are testing b4b, then we pay this even if we don't have the carbon - fnrt_c_flux = min(fnrt_c_demand, & - max(0.0_r8, & - (store_c+carbon_balance)*fnrt_c_demand/total_c_demand)) + leaf_c_flux = leaf_c_demand * allocation_factor + fnrt_c_flux = fnrt_c_demand * allocation_factor ! Add carbon to the youngest age pool (i.e iexp_leaf = index 1) and fine roots leaf_c(iexp_leaf) = leaf_c(iexp_leaf) + leaf_c_flux @@ -578,7 +595,7 @@ subroutine DailyPRTAllometricCarbon(this) ! Accumulate some carbon in storage. If storage is completely depleted, aim to ! increase storage, but not to replenish completely so we can still use some ! carbon for growth. - store_below_target = max(target_store_c - store_c,0.0_r8) + store_below_target = max(0.0_r8,target_store_c - store_c) store_target_fraction = max(0.0_r8, store_c/target_store_c ) store_c_flux = min(store_below_target,carbon_balance * & @@ -603,13 +620,14 @@ subroutine DailyPRTAllometricCarbon(this) total_below_target = leaf_below_target + fnrt_below_target if ( (carbon_balance > nearzero) .and. (total_below_target > nearzero) ) then + ! Find fraction of carbon to be allocated to leaves and fine roots + allocation_factor = min(1.0_r8, carbon_balance / total_below_target) + ! MLO. Edited the code to switch the order of operations. The previous code would ! subtract leaf flux from carbon balance before estimating the fine root flux, ! potentially allowing less fluxes to fine roots than possible. - leaf_c_flux = min(leaf_below_target, & - carbon_balance*leaf_below_target/total_below_target) - fnrt_c_flux = min(fnrt_below_target, & - carbon_balance*fnrt_below_target/total_below_target) + leaf_c_flux = leaf_below_target * allocation_factor + fnrt_c_flux = fnrt_below_target * allocation_factor leaf_c(iexp_leaf) = leaf_c(iexp_leaf) + leaf_c_flux fnrt_c = fnrt_c + fnrt_c_flux @@ -626,40 +644,32 @@ subroutine DailyPRTAllometricCarbon(this) ! ----------------------------------------------------------------------------------- if( carbon_balance > nearzero ) then - leaf_below_target = max(target_leaf_c - sum(leaf_c(1:nleafage)),0.0_r8) - fnrt_below_target = max(target_fnrt_c - fnrt_c,0.0_r8) - sapw_below_target = max(target_sapw_c - sapw_c,0.0_r8) - store_below_target = max(target_store_c - store_c,0.0_r8) - + leaf_below_target = max(0.0_r8,target_leaf_c - sum(leaf_c(1:nleafage))) + fnrt_below_target = max(0.0_r8,target_fnrt_c - fnrt_c) + sapw_below_target = max(0.0_r8,target_sapw_c - sapw_c) + store_below_target = max(0.0_r8,target_store_c - store_c) + total_below_target = leaf_below_target + fnrt_below_target + & sapw_below_target + store_below_target - - if ( total_below_target > nearzero ) then - - if( total_below_target > carbon_balance) then - leaf_c_flux = carbon_balance * leaf_below_target/total_below_target - fnrt_c_flux = carbon_balance * fnrt_below_target/total_below_target - sapw_c_flux = carbon_balance * sapw_below_target/total_below_target - store_c_flux = carbon_balance * store_below_target/total_below_target - else - leaf_c_flux = leaf_below_target - fnrt_c_flux = fnrt_below_target - sapw_c_flux = sapw_below_target - store_c_flux = store_below_target - end if - carbon_balance = carbon_balance - leaf_c_flux - leaf_c(iexp_leaf) = leaf_c(iexp_leaf) + leaf_c_flux - - carbon_balance = carbon_balance - fnrt_c_flux - fnrt_c = fnrt_c + fnrt_c_flux - - carbon_balance = carbon_balance - sapw_c_flux - sapw_c = sapw_c + sapw_c_flux - - carbon_balance = carbon_balance - store_c_flux - store_c = store_c + store_c_flux - + if ( total_below_target > nearzero ) then + ! Find allocation factor based on available carbon and total demand to meet target. + allocation_factor = min(1.0_r8, carbon_balance / total_below_target) + + ! Find fluxes to individual pools + leaf_c_flux = leaf_below_target * allocation_factor + fnrt_c_flux = fnrt_below_target * allocation_factor + sapw_c_flux = sapw_below_target * allocation_factor + store_c_flux = store_below_target * allocation_factor + + leaf_c(iexp_leaf) = leaf_c(iexp_leaf) + leaf_c_flux + fnrt_c = fnrt_c + fnrt_c_flux + sapw_c = sapw_c + sapw_c_flux + store_c = store_c + store_c_flux + + carbon_balance = carbon_balance - & + ( leaf_c_flux + fnrt_c_flux + & + sapw_c_flux + store_c_flux ) end if end if @@ -670,9 +680,9 @@ subroutine DailyPRTAllometricCarbon(this) if( carbon_balance > nearzero ) then - struct_below_target = max(target_struct_c - struct_c ,0.0_r8) + struct_below_target = max(0.0_r8,target_struct_c - struct_c) - if ( struct_below_target > 0.0_r8) then + if ( struct_below_target > nearzero) then struct_c_flux = min(carbon_balance,struct_below_target) carbon_balance = carbon_balance - struct_c_flux @@ -681,7 +691,27 @@ subroutine DailyPRTAllometricCarbon(this) end if end if - + + + + ! ----------------------------------------------------------------------------------- + ! VII 1/2: If plant is semi-deciduous, there will be cases in which plant's carbon + ! balance is positive but plant is losing leaves, in which case the plant + ! should not invest in growth. Likewise, when plants are flushing but the + ! elongation factor is small, we may have need to "shed" excess storage by + ! placing it as carbon_balance again (not the neatest solution, but other- + ! wise the solver may fail to find a solution). + ! ----------------------------------------------------------------------------------- + select_stash_grow: select case (leaf_status) + case (leaves_off,leaves_pshed) + ! There is carbon balance, but plant is shedding leaves. We stash the carbon + ! to storage even if it makes their storage too large. + store_c_flux = carbon_balance + carbon_balance = carbon_balance - store_c_flux + store_c = store_c + store_c_flux + end select select_stash_grow + + ! ----------------------------------------------------------------------------------- ! VIII. If carbon is yet still available ... ! Our pools are now either on allometry or above (from fusion). @@ -696,31 +726,21 @@ subroutine DailyPRTAllometricCarbon(this) ! the plant has not been brought to be "on allometry", it thinks it has carbon ! left to allocate, and thus it must be on allometry when its not. ! ----------------------------------------------------------------------------------- - if_stature_growth: if( carbon_balance > calloc_abs_error ) then - + + ! This routine checks that actual carbon is not below that targets. It does ! allow actual pools to be above the target, and in these cases, it sends ! a false on the "grow_<>" flag, allowing the plant to grow into these pools. ! It also checks to make sure that structural biomass is not above the target. - if( (target_store_c - store_c)>calloc_abs_error) then - write(fates_log(),*) 'storage is not on-allometry at the growth step' - write(fates_log(),*) 'exiting' - write(fates_log(),*) 'cbal: ',carbon_balance - write(fates_log(),*) 'near-zero',nearzero - write(fates_log(),*) 'store_c: ',store_c - write(fates_log(),*) 'target c: ',target_store_c - write(fates_log(),*) 'store_c0:', store_c0 - call endrun(msg=errMsg(sourcefile, __LINE__)) - end if - - - call TargetAllometryCheck(sum(leaf_c(1:nleafage)), fnrt_c, sapw_c, & - store_c, struct_c, & - target_leaf_c, target_fnrt_c, & - target_sapw_c, target_store_c, target_struct_c, & - grow_struct, grow_leaf, grow_fnrt, grow_sapw, grow_store) + call TargetAllometryCheck(sum(leaf_c0(1:nleafage)),fnrt_c0,sapw_c0,store_c0,struct_c0, & + sum(leaf_c(1:nleafage)), fnrt_c, sapw_c,store_c, struct_c, & + target_leaf_c, target_fnrt_c, target_sapw_c, & + target_store_c, target_struct_c, & + carbon_balance, & + elongf_leaf,elongf_fnrt,elongf_stem,ipft,leaf_status, & + grow_leaf, grow_fnrt, grow_sapw, grow_store, grow_struct) ! -------------------------------------------------------------------------------- ! The numerical integration of growth requires that the instantaneous state @@ -753,16 +773,27 @@ subroutine DailyPRTAllometricCarbon(this) c_pool(repro_c_id) = repro_c c_pool(dbh_id) = dbh - ! Only grow leaves if we are in a "leaf-on" status - if(leaf_status == leaves_on) then - c_mask(leaf_c_id) = grow_leaf + ! Only grow leaves if we are in a "leaf-on" status. For drought-deciduous, we + ! interrupt growth for all tissues when in dormant mode. + if (is_hydecid_dormant) then + c_mask(leaf_c_id) = .false. + c_mask(fnrt_c_id) = .false. + c_mask(sapw_c_id) = .false. + c_mask(struct_c_id) = .false. + else - c_mask(leaf_c_id) = .false. + select case (leaf_status) + case (leaves_on) + c_mask(leaf_c_id) = grow_leaf + case default + c_mask(leaf_c_id) = .false. + end select + c_mask(fnrt_c_id) = grow_fnrt + c_mask(sapw_c_id) = grow_sapw + c_mask(struct_c_id) = grow_struct + end if - c_mask(fnrt_c_id) = grow_fnrt - c_mask(sapw_c_id) = grow_sapw c_mask(store_c_id) = grow_store - c_mask(struct_c_id) = grow_struct c_mask(repro_c_id) = .true. ! Always calculate reproduction on growth c_mask(dbh_id) = .true. ! Always increment dbh on growth step @@ -796,6 +827,7 @@ subroutine DailyPRTAllometricCarbon(this) ! we remember the current step size as a good next guess. call CheckIntegratedAllometries(c_pool_out(dbh_id),ipft,canopy_trim, & + elongf_leaf, elongf_fnrt, elongf_stem, & 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), & @@ -894,7 +926,6 @@ subroutine DailyPRTAllometricCarbon(this) end if if_step_pass end do do_solve_check - end if if_stature_growth ! Track the net allocations and transport from this routine @@ -1007,7 +1038,8 @@ subroutine DailyPRTAllometricCarbonSimpler(this) real(r8) :: struct_below_target ! dead (structural) biomass below target amount [kgC] real(r8) :: total_below_target ! total biomass below the allometric target [kgC] - real(r8) :: available_carbon ! available carbon to reconstruct tissues + real(r8) :: allocation_factor ! allocation factor (relative to demand) to + ! reconstruct tissues real(r8) :: flux_adj ! adjustment made to growth flux term to minimize error [kgC] @@ -1052,6 +1084,10 @@ subroutine DailyPRTAllometricCarbonSimpler(this) integer :: leaf_status ! are leaves on or off? real(r8) :: leaf_age_flux ! carbon mass flux between leaf age classification pools + real(r8) :: elongf_leaf ! Leaf elongation factor + real(r8) :: elongf_fnrt ! Fine-root "elongation factor" + real(r8) :: elongf_stem ! Stem "elongation factor" + ! Integrator variables c_pool are "mostly" carbon variables, but c_pool also includes ! dbh... @@ -1070,6 +1106,10 @@ subroutine DailyPRTAllometricCarbonSimpler(this) integer, parameter :: iexp_leaf = 1 ! index 1 is the expanding (i.e. youngest) ! leaf age class, and therefore ! all new allocation goes into that pool + character(len= 9), parameter :: fmti = '(a,1x,i5)' + character(len=13), parameter :: fmt0 = '(a,1x,es12.5)' + character(len=19), parameter :: fmth = '(a,1x,a5,3(1x,a12))' + character(len=22), parameter :: fmtg = '(a,5x,l1,3(1x,es12.5))' real(r8) :: intgr_params(num_bc_in) ! The boundary conditions to this routine, ! are pressed into an array that is also @@ -1096,14 +1136,21 @@ subroutine DailyPRTAllometricCarbonSimpler(this) 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) + elongf_leaf = this%bc_in(ac_bc_in_id_efleaf)%rval + elongf_fnrt = this%bc_in(ac_bc_in_id_effnrt)%rval + elongf_stem = this%bc_in(ac_bc_in_id_efstem)%rval + + 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,r8) + intgr_params(ac_bc_in_id_lstat) = real(this%bc_in(ac_bc_in_id_lstat)%ival,r8) + intgr_params(ac_bc_in_id_efleaf) = this%bc_in(ac_bc_in_id_efleaf)%rval + intgr_params(ac_bc_in_id_effnrt) = this%bc_in(ac_bc_in_id_effnrt)%rval + intgr_params(ac_bc_in_id_efstem) = this%bc_in(ac_bc_in_id_efstem)%rval ! Set some logical flags to simplify "if" blocks is_hydecid_dormant = ( prt_params%stress_decid(ipft) == 1 ) .and. & - ( leaf_status == leaves_off ) + any( leaf_status == [leaves_off,leaves_pshed] ) is_deciduous = ( prt_params%stress_decid(ipft) == 1 ) .or. & ( prt_params%season_decid(ipft) == 1 ) @@ -1160,24 +1207,24 @@ subroutine DailyPRTAllometricCarbonSimpler(this) ! ----------------------------------------------------------------------------------- - ! II 1/2. For drougth-deciduous plants, we assume that plants in LEAVES OFF status - ! do not rebuild any tissues lost to turnover. + ! II 1/2. Update target biomass based on the leaf elongation factor and the abscission + ! fraction for each non-leaf tissue. Elongation factor is binary for + ! cold-deciduous and original drought-deciduous, and always one for + ! evergreens. In case the plant is shedding leaves, we impose that any + ! positive carbon balance necessarily goes to storage, even if this causes + ! storage to go above allometry. ! ----------------------------------------------------------------------------------- - if ( is_hydecid_dormant ) then - ! Drought deciduous, leaves off. Do not try to get back on allometry. + if (is_hydecid_dormant) then target_leaf_c = 0.0_r8 target_fnrt_c = 0.0_r8 target_sapw_c = 0.0_r8 - target_agw_c = 0.0_r8 - target_bgw_c = 0.0_r8 target_struct_c = 0.0_r8 - target_store_c = 0.0_r8 - - elseif ( leaf_status == leaves_off ) then - ! Cold deciduous. For now we let them rebuild fine root and sapwood. Note that - ! this assumption is less of an issue for cold deciduous because turnover rates - ! are lower during winter. - target_leaf_c = 0.0_r8 + target_store_c = target_store_c + max(0.0_r8,carbon_balance) + else + target_leaf_c = elongf_leaf * target_leaf_c + target_fnrt_c = elongf_fnrt * target_fnrt_c + target_sapw_c = elongf_stem * target_sapw_c + target_struct_c = elongf_stem * target_struct_c end if @@ -1201,19 +1248,14 @@ subroutine DailyPRTAllometricCarbonSimpler(this) replenish_allom_check: if ( total_below_target > nearzero ) then ! Available carbon for transfer is the sum of stored carbon and the daily ! carbon balance. - available_carbon = store_c + carbon_balance - - ! Scale flux so pools can be replenish simultaneously. - leaf_c_flux = min( leaf_below_target, & - available_carbon * leaf_below_target / total_below_target ) - fnrt_c_flux = min( fnrt_below_target, & - available_carbon * fnrt_below_target / total_below_target ) - sapw_c_flux = min( sapw_below_target, & - available_carbon * sapw_below_target / total_below_target ) - store_c_flux = min( store_below_target, & - available_carbon * store_below_target / total_below_target ) - struct_c_flux = min( struct_below_target, & - available_carbon * struct_below_target / total_below_target ) + allocation_factor = min(1.0_r8, (store_c + carbon_balance) / total_below_target ) + + ! Scale flux so pools can be replenished simultaneously. + leaf_c_flux = leaf_below_target * allocation_factor + fnrt_c_flux = fnrt_below_target * allocation_factor + sapw_c_flux = sapw_below_target * allocation_factor + store_c_flux = store_below_target * allocation_factor + struct_c_flux = struct_below_target * allocation_factor ! Replenish pools leaf_c(iexp_leaf) = leaf_c(iexp_leaf) + leaf_c_flux @@ -1234,13 +1276,8 @@ subroutine DailyPRTAllometricCarbonSimpler(this) ! IV. If carbon balance is negative, reduce the storage pool. Otherwise, try to ! fill the storage pool before growing. ! ----------------------------------------------------------------------------------- - update_storage: if ( carbon_balance < 0.0_r8 .or. is_hydecid_dormant ) then - - - ! If carbon balance is negative, store_c will be depleted. Otherwise, if this is - ! a dormant drought-deciduous plant that somehow managed to score a positive - ! carbon balance with leaves off (very unlikely), then store_c will increase and - ! take all carbon, effectively preventing any chance of growth during lean times. + update_storage: if ( carbon_balance < 0.0_r8 ) then + ! If carbon balance is negative, store_c will be depleted. store_c_flux = carbon_balance store_c = store_c + store_c_flux @@ -1280,24 +1317,13 @@ subroutine DailyPRTAllometricCarbonSimpler(this) ! allow actual pools to be above the target, and in these cases, it sends ! a false on the "grow_<>" flag, allowing the plant to grow into these pools. ! It also checks to make sure that structural biomass is not above the target. - - if( (target_store_c - store_c)>calloc_abs_error) then - write(fates_log(),*) 'storage is not on-allometry at the growth step' - write(fates_log(),*) 'exiting' - write(fates_log(),*) 'cbal: ',carbon_balance - write(fates_log(),*) 'near-zero',nearzero - write(fates_log(),*) 'store_c: ',store_c - write(fates_log(),*) 'target c: ',target_store_c - write(fates_log(),*) 'store_c0:', store_c0 - call endrun(msg=errMsg(sourcefile, __LINE__)) - end if - - - call TargetAllometryCheck(sum(leaf_c(1:nleafage)), fnrt_c, sapw_c, & - store_c, struct_c, & - target_leaf_c, target_fnrt_c, & - target_sapw_c, target_store_c, target_struct_c, & - grow_struct, grow_leaf, grow_fnrt, grow_sapw, grow_store) + call TargetAllometryCheck(sum(leaf_c0(1:nleafage)),fnrt_c0,sapw_c0,store_c0,struct_c0, & + sum(leaf_c(1:nleafage)), fnrt_c, sapw_c,store_c, struct_c, & + target_leaf_c, target_fnrt_c, target_sapw_c, & + target_store_c, target_struct_c, & + carbon_balance, & + elongf_leaf,elongf_fnrt,elongf_stem,ipft,leaf_status, & + grow_leaf, grow_fnrt, grow_sapw, grow_store, grow_struct) ! -------------------------------------------------------------------------------- ! The numerical integration of growth requires that the instantaneous state @@ -1330,16 +1356,27 @@ subroutine DailyPRTAllometricCarbonSimpler(this) c_pool(repro_c_id) = repro_c c_pool(dbh_id) = dbh - ! Only grow leaves if we are in a "leaf-on" status - if(leaf_status == leaves_on) then - c_mask(leaf_c_id) = grow_leaf + ! Only grow leaves if we are in a "leaf-on" status. For drought-deciduous, we + ! interrupt growth for all tissues when in dormant mode. + if (is_hydecid_dormant) then + c_mask(leaf_c_id) = .false. + c_mask(fnrt_c_id) = .false. + c_mask(sapw_c_id) = .false. + c_mask(struct_c_id) = .false. + else - c_mask(leaf_c_id) = .false. + select case (leaf_status) + case (leaves_on) + c_mask(leaf_c_id) = grow_leaf + case default + c_mask(leaf_c_id) = .false. + end select + c_mask(fnrt_c_id) = grow_fnrt + c_mask(sapw_c_id) = grow_sapw + c_mask(struct_c_id) = grow_struct + end if - c_mask(fnrt_c_id) = grow_fnrt - c_mask(sapw_c_id) = grow_sapw c_mask(store_c_id) = grow_store - c_mask(struct_c_id) = grow_struct c_mask(repro_c_id) = .true. ! Always calculate reproduction on growth c_mask(dbh_id) = .true. ! Always increment dbh on growth step @@ -1355,11 +1392,12 @@ subroutine DailyPRTAllometricCarbonSimpler(this) do_solve_check: do while( ierr .ne. 0 ) deltaC = min(totalC,this%ode_opt_step) - if(ODESolve == 1) then + sel_ODESolve: select case (ODESolve) + case (1) call RKF45(AllomCGrowthDeriv,c_pool,c_mask,deltaC,totalC, & max_trunc_error,intgr_params,c_pool_out,this%ode_opt_step,step_pass) - elseif(ODESolve == 2) then + case (2) call Euler(AllomCGrowthDeriv,c_pool,c_mask,deltaC,totalC,intgr_params,c_pool_out) ! step_pass = .true. @@ -1373,20 +1411,22 @@ subroutine DailyPRTAllometricCarbonSimpler(this) ! we remember the current step size as a good next guess. call CheckIntegratedAllometries(c_pool_out(dbh_id),ipft,canopy_trim, & + elongf_leaf, elongf_fnrt, elongf_stem, & 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), & c_mask(store_c_id),c_mask(struct_c_id), max_trunc_error, step_pass) + if(step_pass) then this%ode_opt_step = deltaC else this%ode_opt_step = 0.5*deltaC end if - else + case default write(fates_log(),*) 'An integrator was chosen that does not exist' write(fates_log(),*) 'ODESolve = ',ODESolve call endrun(msg=errMsg(sourcefile, __LINE__)) - end if + end select sel_ODESolve nsteps = nsteps + 1 @@ -1396,17 +1436,25 @@ subroutine DailyPRTAllometricCarbonSimpler(this) end if if(nsteps > max_substeps ) then - write(fates_log(),*) 'Plant Growth Integrator could not find' - write(fates_log(),*) 'a solution in less than ',max_substeps,' tries' - write(fates_log(),*) 'Aborting' - write(fates_log(),*) 'carbon_balance',carbon_balance - write(fates_log(),*) 'deltaC',deltaC - write(fates_log(),*) 'totalC',totalC - write(fates_log(),*) 'leaf:',grow_leaf,target_leaf_c,target_leaf_c - sum(leaf_c(:)) - write(fates_log(),*) 'fnrt:',grow_fnrt,target_fnrt_c,target_fnrt_c - fnrt_c - write(fates_log(),*) 'sap:',grow_sapw,target_sapw_c, target_sapw_c - sapw_c - write(fates_log(),*) 'store:',grow_store,target_store_c,target_store_c - store_c - write(fates_log(),*) 'dead:',target_struct_c,target_struct_c - struct_c + write(fates_log(),fmt=*) '---~---' + write(fates_log(),fmt=*) 'Plant Growth Integrator could not find' + write(fates_log(),fmt=*) 'a solution in less than ',max_substeps,' tries.' + write(fates_log(),fmt=*) 'Aborting!' + write(fates_log(),fmt=*) '---~---' + write(fates_log(),fmt=fmti) 'Leaf status =',leaf_status + write(fates_log(),fmt=fmt0) 'Carbon_balance =',carbon_balance + write(fates_log(),fmt=fmt0) 'Elongf_leaf =',elongf_leaf + write(fates_log(),fmt=fmt0) 'Elongf_fnrt =',elongf_fnrt + write(fates_log(),fmt=fmt0) 'Elongf_stem =',elongf_stem + write(fates_log(),fmt=fmt0) 'deltaC =',deltaC + write(fates_log(),fmt=fmt0) 'totalC =',totalC + write(fates_log(),fmt=fmth) ' Tissue |', ' Grow',' Current',' Target' ,' Deficit' + write(fates_log(),fmt=fmtg) ' Leaf |', grow_leaf , sum(leaf_c(:)),target_leaf_c , target_leaf_c - sum(leaf_c(:)) + write(fates_log(),fmt=fmtg) ' Fine root |', grow_fnrt , fnrt_c,target_fnrt_c , target_fnrt_c - fnrt_c + write(fates_log(),fmt=fmtg) ' Sapwood |', grow_sapw , sapw_c,target_sapw_c , target_sapw_c - sapw_c + write(fates_log(),fmt=fmtg) ' Storage |', grow_store , store_c,target_store_c , target_store_c - store_c + write(fates_log(),fmt=fmtg) ' Structural |', grow_struct , struct_c,target_struct_c, target_struct_c - struct_c + write(fates_log(),fmt=*) '---~---' call endrun(msg=errMsg(sourcefile, __LINE__)) end if @@ -1532,7 +1580,10 @@ 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) :: canopy_trim ! Canopy trimming function (boundary condition) [0-1] + real(r8) :: elongf_leaf ! Leaf elongation factor (boundary condition) [0-1] + real(r8) :: elongf_fnrt ! Fine-root "elongation factor" (boundary condition) [0-1] + real(r8) :: elongf_stem ! Stem "elongation factor" (boundary condition) [0-1] 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) @@ -1569,7 +1620,9 @@ 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)) - + elongf_leaf = intgr_params(ac_bc_in_id_efleaf) + elongf_fnrt = intgr_params(ac_bc_in_id_effnrt) + elongf_stem = intgr_params(ac_bc_in_id_efstem) call bleaf(dbh,ipft,canopy_trim,ct_leaf,ct_dleafdd) call bfineroot(dbh,ipft,canopy_trim,ct_fnrt,ct_dfnrtdd) @@ -1580,7 +1633,18 @@ function AllomCGrowthDeriv(c_pools,c_mask,cbalance,intgr_params) result(dCdx) call bdead_allom(ct_agw,ct_bgw, ct_sap, ipft, ct_dead, & ct_dagwdd, ct_dbgwdd, ct_dsapdd, ct_ddeaddd) call bstore_allom(dbh,ipft,canopy_trim,ct_store,ct_dstoredd) - + + ! Apply elongation factor correction to targets + ct_leaf = elongf_leaf * ct_leaf + ct_fnrt = elongf_fnrt * ct_fnrt + ct_sap = elongf_stem * ct_sap + ct_dead = elongf_stem * ct_dead + ! MLO - Need to double check that it is correct to multiply derivatives too. + ct_dleafdd = elongf_leaf * ct_dleafdd + ct_dfnrtdd = elongf_fnrt * ct_dfnrtdd + ct_dsapdd = elongf_stem * ct_dsapdd + ct_ddeaddd = elongf_stem * ct_ddeaddd + ! fraction of carbon going towards reproduction if (dbh <= prt_params%dbh_repro_threshold(ipft)) then ! cap on leaf biomass repro_fraction = prt_params%seed_alloc(ipft) @@ -1650,78 +1714,99 @@ end function AllomCGrowthDeriv ! ==================================================================================== - subroutine TargetAllometryCheck(bleaf,bfroot,bsap,bstore,bdead, & - bt_leaf,bt_froot,bt_sap,bt_store,bt_dead, & - grow_dead,grow_leaf,grow_froot,grow_sapw,grow_store) + 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, & + elongf_leaf,elongf_fnrt,elongf_stem,ipft,leaf_status, & + grow_leaf,grow_fnrt,grow_sapw,grow_store,grow_struct) ! Arguments - real(r8),intent(in) :: bleaf !actual - real(r8),intent(in) :: bfroot - real(r8),intent(in) :: bsap + 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) :: bdead - real(r8),intent(in) :: bt_leaf !target - real(r8),intent(in) :: bt_froot - real(r8),intent(in) :: bt_sap + 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_dead - logical,intent(out) :: grow_leaf !growth flag - logical,intent(out) :: grow_froot + real(r8),intent(in) :: bt_struct + real(r8),intent(in) :: carbon_balance !remaining carbon balance + real(r8),intent(in) :: elongf_leaf !elongation factors + real(r8),intent(in) :: elongf_fnrt + real(r8),intent(in) :: elongf_stem + 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_dead - - if( (bt_leaf - bleaf)>calloc_abs_error) then - write(fates_log(),*) 'leaves are not on-allometry at the growth step' - write(fates_log(),*) 'exiting',bleaf,bt_leaf - call endrun(msg=errMsg(sourcefile, __LINE__)) - elseif( (bleaf - bt_leaf)>calloc_abs_error) then - ! leaf is above allometry, ignore - grow_leaf = .false. + 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 - grow_leaf = .true. - end if - - if( (bt_froot - bfroot)>calloc_abs_error) then - write(fates_log(),*) 'fineroots are not on-allometry at the growth step' - write(fates_log(),*) 'exiting',bfroot, bt_froot + ! 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) ' elongf_leaf = ',elongf_leaf + write(fates_log(),fmt=fmte) ' elongf_fnrt = ',elongf_fnrt + write(fates_log(),fmt=fmte) ' elongf_stem = ',elongf_stem + 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__)) - elseif( ( bfroot-bt_froot)>calloc_abs_error ) then - grow_froot = .false. - else - grow_froot = .true. end if - - if( (bt_sap - bsap)>calloc_abs_error) then - write(fates_log(),*) 'sapwood is not on-allometry at the growth step' - write(fates_log(),*) 'exiting',bsap, bt_sap - call endrun(msg=errMsg(sourcefile, __LINE__)) - elseif( ( bsap-bt_sap)>calloc_abs_error ) then - grow_sapw = .false. - else - grow_sapw = .true. - end if - - if( (bt_store - bstore)>calloc_abs_error) then - write(fates_log(),*) 'storage is not on-allometry at the growth step' - write(fates_log(),*) 'exiting',bstore,bt_store - call endrun(msg=errMsg(sourcefile, __LINE__)) - elseif( ( bstore-bt_store)>calloc_abs_error ) then - grow_store = .false. - else - grow_store = .true. - end if - - if( (bt_dead - bdead)>calloc_abs_error) then - write(fates_log(),*) 'structure not on-allometry at the growth step' - write(fates_log(),*) 'exiting',bdead,bt_dead - call endrun(msg=errMsg(sourcefile, __LINE__)) - elseif( (bdead-bt_dead)> calloc_abs_error) then - grow_dead = .false. - else - grow_dead = .true. - end if - return end subroutine TargetAllometryCheck diff --git a/parteh/PRTParametersMod.F90 b/parteh/PRTParametersMod.F90 index e2fd5cb137..36e648c9ab 100644 --- a/parteh/PRTParametersMod.F90 +++ b/parteh/PRTParametersMod.F90 @@ -17,7 +17,10 @@ module PRTParametersMod integer, allocatable :: season_decid(:) ! Is the plant seasonally deciduous (1=yes, 0=no) integer, allocatable :: evergreen(:) ! Is the plant an evergreen (1=yes, 0=no) - + ! Drop fraction for tissues other than leaves (PFT-dependent) + real(r8), allocatable :: phen_fnrt_drop_fraction(:) ! Abscission fraction of fine roots + real(r8), allocatable :: phen_stem_drop_fraction(:) ! Abscission fraction of stems + ! Growth and Turnover Parameters real(r8), allocatable :: senleaf_long_fdrought(:) ! Multiplication factor for leaf longevity of senescent ! leaves during drought( 1.0 indicates no change) diff --git a/parteh/PRTParamsFATESMod.F90 b/parteh/PRTParamsFATESMod.F90 index 62620f7d44..ba0d9cafad 100644 --- a/parteh/PRTParamsFATESMod.F90 +++ b/parteh/PRTParamsFATESMod.F90 @@ -165,6 +165,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_phen_fnrt_drop_fraction' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_phen_stem_drop_fraction' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + name = 'fates_fnrt_prof_a' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) @@ -413,6 +421,14 @@ subroutine PRTReceivePFT(fates_params) call ArrayNint(tmpreal,prt_params%evergreen) deallocate(tmpreal) + name = 'fates_phen_fnrt_drop_fraction' + call fates_params%RetreiveParameterAllocate(name=name, & + data=prt_params%phen_fnrt_drop_fraction) + + name = 'fates_phen_stem_drop_fraction' + call fates_params%RetreiveParameterAllocate(name=name, & + data=prt_params%phen_stem_drop_fraction) + name = 'fates_leaf_slamax' call fates_params%RetreiveParameterAllocate(name=name, & data=prt_params%slamax) @@ -842,7 +858,8 @@ subroutine FatesReportPFTParams(is_master) logical, intent(in) :: is_master ! Only log if this is the master proc logical, parameter :: debug_report = .false. - character(len=32),parameter :: fmt0 = '(a,100(F12.4,1X))' + character(len=15),parameter :: fmti = '(a,100(I12,1X))' + character(len=17),parameter :: fmt0 = '(a,100(F12.4,1X))' integer :: npft,ipft @@ -858,9 +875,11 @@ subroutine FatesReportPFTParams(is_master) end if write(fates_log(),*) '----------- FATES PARTEH Parameters -----------------' - write(fates_log(),fmt0) 'stress_decid = ',prt_params%stress_decid - write(fates_log(),fmt0) 'season_decid = ',prt_params%season_decid - write(fates_log(),fmt0) 'evergreen = ',prt_params%evergreen + write(fates_log(),fmti) 'stress_decid = ',prt_params%stress_decid + write(fates_log(),fmti) 'season_decid = ',prt_params%season_decid + write(fates_log(),fmti) 'evergreen = ',prt_params%evergreen + write(fates_log(),fmt0) 'phen_fnrt_drop_fraction = ',prt_params%phen_fnrt_drop_fraction + write(fates_log(),fmt0) 'phen_stem_drop_fraction = ',prt_params%phen_stem_drop_fraction write(fates_log(),fmt0) 'wood_density = ',prt_params%wood_density write(fates_log(),fmt0) 'dbh max height = ',prt_params%allom_dbh_maxheight write(fates_log(),fmt0) 'dbh mature = ',prt_params%dbh_repro_threshold @@ -920,7 +939,7 @@ subroutine FatesReportPFTParams(is_master) write(fates_log(),fmt0) 'turnover_carb_retrans = ',prt_params%turnover_carb_retrans write(fates_log(),fmt0) 'turnover_nitr_retrans = ',prt_params%turnover_nitr_retrans write(fates_log(),fmt0) 'turnover_phos_retrans = ',prt_params%turnover_phos_retrans - write(fates_log(),fmt0) 'organ_id = ',prt_params%organ_id + write(fates_log(),fmti) 'organ_id = ',prt_params%organ_id write(fates_log(),fmt0) 'nitr_store_ratio = ',prt_params%nitr_store_ratio write(fates_log(),fmt0) 'phos_store_ratio = ',prt_params%phos_store_ratio write(fates_log(),*) '-------------------------------------------------'