Skip to content

Commit

Permalink
Merge tag 'sci.1.72.2_api.34.0.0' into jfn-recruit-cflux-histvar
Browse files Browse the repository at this point in the history 
User control of fates history diagnostics by dimension, via namelist setting: fates_history_dimlevel. Control is split between high frequency and dynamics frequency variables, where 0 turns off diagnostics, 1 is for site level and 2 is for high-dimensional variables. Used to speed up the model when no higher dimension varaibles are desired
  • Loading branch information
@glemieux
glemieux committed Mar 15, 2024
2 parents e541edb + 5e39a38 commit c8780c6
Show file tree
Hide file tree
Showing 20 changed files with 7,770 additions and 6,759 deletions.
3 changes: 2 additions & 1 deletion biogeochem/EDCanopyStructureMod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -11,6 +11,7 @@ module EDCanopyStructureMod
use FatesConstantsMod , only : nearzero, area_error_1
use FatesConstantsMod , only : rsnbl_math_prec
use FatesConstantsMod , only : nocomp_bareground
use FatesConstantsMod, only : i_term_mort_type_canlev
use FatesGlobals , only : fates_log
use EDPftvarcon , only : EDPftvarcon_inst
use PRTParametersMod , only : prt_params
Expand Down Expand Up @@ -741,7 +742,7 @@ subroutine DemoteFromLayer(currentSite,currentPatch,i_lyr,bc_in)
if(currentCohort%canopy_layer>nclmax )then
! put the litter from the terminated cohorts
! straight into the fragmenting pools
call terminate_cohort(currentSite,currentPatch,currentCohort,bc_in)
call terminate_cohort(currentSite,currentPatch,currentCohort,bc_in,i_term_mort_type_canlev)
deallocate(currentCohort, stat=istat, errmsg=smsg)
if (istat/=0) then
write(fates_log(),*) 'dealloc012: fail on deallocate(currentCohort):'//trim(smsg)
Expand Down
36 changes: 27 additions & 9 deletions biogeochem/EDCohortDynamicsMod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -120,6 +120,10 @@ Module EDCohortDynamicsMod
use PRTAllometricCNPMod, only : acnp_bc_out_id_pefflux, acnp_bc_out_id_limiter
use PRTAllometricCNPMod, only : acnp_bc_in_id_cdamage
use DamageMainMod, only : undamaged_class
use FatesConstantsMod, only : n_term_mort_types
use FatesConstantsMod, only : i_term_mort_type_cstarv
use FatesConstantsMod, only : i_term_mort_type_canlev
use FatesConstantsMod, only : i_term_mort_type_numdens

use shr_infnan_mod, only : nan => shr_infnan_nan, assignment(=)
use shr_log_mod, only : errMsg => shr_log_errMsg
Expand Down Expand Up @@ -382,12 +386,14 @@ subroutine terminate_cohorts( currentSite, currentPatch, level , call_index, bc_
integer :: terminate ! do we terminate (itrue) or not (ifalse)
integer :: istat ! return status code
character(len=255) :: smsg
integer :: termination_type
!----------------------------------------------------------------------

currentCohort => currentPatch%shortest
do while (associated(currentCohort))

terminate = ifalse
termination_type = 0
tallerCohort => currentCohort%taller

leaf_c = currentCohort%prt%GetState(leaf_organ, carbon12_element)
Expand All @@ -400,6 +406,7 @@ subroutine terminate_cohorts( currentSite, currentPatch, level , call_index, bc_
! Check if number density is so low is breaks math (level 1)
if (currentcohort%n < min_n_safemath .and. level == 1) then
terminate = itrue
termination_type = i_term_mort_type_numdens
if ( debug ) then
write(fates_log(),*) 'terminating cohorts 0',currentCohort%n/currentPatch%area,currentCohort%dbh,currentCohort%pft,call_index
endif
Expand All @@ -413,6 +420,7 @@ subroutine terminate_cohorts( currentSite, currentPatch, level , call_index, bc_
currentCohort%n <= min_nppatch .or. &
(currentCohort%dbh < 0.00001_r8 .and. store_c < 0._r8) ) then
terminate = itrue
termination_type = i_term_mort_type_numdens
if ( debug ) then
write(fates_log(),*) 'terminating cohorts 1',currentCohort%n/currentPatch%area,currentCohort%dbh,currentCohort%pft,call_index
endif
Expand All @@ -421,6 +429,7 @@ subroutine terminate_cohorts( currentSite, currentPatch, level , call_index, bc_
! Outside the maximum canopy layer
if (currentCohort%canopy_layer > nclmax ) then
terminate = itrue
termination_type = i_term_mort_type_canlev
if ( debug ) then
write(fates_log(),*) 'terminating cohorts 2', currentCohort%canopy_layer,currentCohort%pft,call_index
endif
Expand All @@ -430,6 +439,7 @@ subroutine terminate_cohorts( currentSite, currentPatch, level , call_index, bc_
if ( ( sapw_c+leaf_c+fnrt_c ) < 1e-10_r8 .or. &
store_c < 1e-10_r8) then
terminate = itrue
termination_type = i_term_mort_type_cstarv
if ( debug ) then
write(fates_log(),*) 'terminating cohorts 3', &
sapw_c,leaf_c,fnrt_c,store_c,currentCohort%pft,call_index
Expand All @@ -439,6 +449,7 @@ subroutine terminate_cohorts( currentSite, currentPatch, level , call_index, bc_
! Total cohort biomass is negative
if ( ( struct_c+sapw_c+leaf_c+fnrt_c+store_c ) < 0._r8) then
terminate = itrue
termination_type = i_term_mort_type_cstarv
if ( debug ) then
write(fates_log(),*) 'terminating cohorts 4', &
struct_c,sapw_c,leaf_c,fnrt_c,store_c,currentCohort%pft,call_index
Expand All @@ -448,7 +459,7 @@ subroutine terminate_cohorts( currentSite, currentPatch, level , call_index, bc_
endif ! if (.not.currentCohort%isnew .and. level == 2) then

if (terminate == itrue) then
call terminate_cohort(currentSite, currentPatch, currentCohort, bc_in)
call terminate_cohort(currentSite, currentPatch, currentCohort, bc_in, termination_type)
deallocate(currentCohort, stat=istat, errmsg=smsg)
if (istat/=0) then
write(fates_log(),*) 'dealloc001: fail on terminate_cohorts:deallocate(currentCohort):'//trim(smsg)
Expand All @@ -461,7 +472,7 @@ subroutine terminate_cohorts( currentSite, currentPatch, level , call_index, bc_
end subroutine terminate_cohorts

!-------------------------------------------------------------------------------------!
subroutine terminate_cohort(currentSite, currentPatch, currentCohort, bc_in)
subroutine terminate_cohort(currentSite, currentPatch, currentCohort, bc_in, termination_type)
!
! !DESCRIPTION:
! Terminates an individual cohort and updates the site-level
Expand All @@ -474,6 +485,7 @@ subroutine terminate_cohort(currentSite, currentPatch, currentCohort, bc_in)
type (fates_patch_type) , intent(inout), target :: currentPatch
type (fates_cohort_type), intent(inout), target :: currentCohort
type(bc_in_type), intent(in) :: bc_in
integer, intent(in) :: termination_type

! !LOCAL VARIABLES:
type (fates_cohort_type) , pointer :: shorterCohort
Expand All @@ -491,6 +503,12 @@ subroutine terminate_cohort(currentSite, currentPatch, currentCohort, bc_in)

!----------------------------------------------------------------------

! check termination_type; it should not be 0
if (termination_type == 0) then
write(fates_log(),*) 'termination_type=0'
call endrun(msg=errMsg(sourcefile, __LINE__))
endif

leaf_c = currentCohort%prt%GetState(leaf_organ, carbon12_element)
store_c = currentCohort%prt%GetState(store_organ, carbon12_element)
sapw_c = currentCohort%prt%GetState(sapw_organ, carbon12_element)
Expand All @@ -506,16 +524,16 @@ subroutine terminate_cohort(currentSite, currentPatch, currentCohort, bc_in)

! Update the site-level carbon flux and individuals count for the appropriate canopy layer
if(levcan==ican_upper) then
currentSite%term_nindivs_canopy(currentCohort%size_class,currentCohort%pft) = &
currentSite%term_nindivs_canopy(currentCohort%size_class,currentCohort%pft) + currentCohort%n
currentSite%term_nindivs_canopy(termination_type,currentCohort%size_class,currentCohort%pft) = &
currentSite%term_nindivs_canopy(termination_type,currentCohort%size_class,currentCohort%pft) + currentCohort%n

currentSite%term_carbonflux_canopy(currentCohort%pft) = currentSite%term_carbonflux_canopy(currentCohort%pft) + &
currentSite%term_carbonflux_canopy(termination_type,currentCohort%pft) = currentSite%term_carbonflux_canopy(termination_type,currentCohort%pft) + &
currentCohort%n * (struct_c+sapw_c+leaf_c+fnrt_c+store_c+repro_c)
else
currentSite%term_nindivs_ustory(currentCohort%size_class,currentCohort%pft) = &
currentSite%term_nindivs_ustory(currentCohort%size_class,currentCohort%pft) + currentCohort%n
currentSite%term_nindivs_ustory(termination_type,currentCohort%size_class,currentCohort%pft) = &
currentSite%term_nindivs_ustory(termination_type,currentCohort%size_class,currentCohort%pft) + currentCohort%n

currentSite%term_carbonflux_ustory(currentCohort%pft) = currentSite%term_carbonflux_ustory(currentCohort%pft) + &
currentSite%term_carbonflux_ustory(termination_type,currentCohort%pft) = currentSite%term_carbonflux_ustory(termination_type,currentCohort%pft) + &
currentCohort%n * (struct_c+sapw_c+leaf_c+fnrt_c+store_c+repro_c)
end if

Expand Down Expand Up @@ -553,7 +571,7 @@ subroutine terminate_cohort(currentSite, currentPatch, currentCohort, bc_in)

call currentCohort%FreeMemory()

end subroutine terminate_cohort
end subroutine terminate_cohort

! =====================================================================================

Expand Down
86 changes: 66 additions & 20 deletions biogeochem/EDMortalityFunctionsMod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -12,7 +12,14 @@ module EDMortalityFunctionsMod
use FatesCohortMod , only : fates_cohort_type
use EDTypesMod , only : ed_site_type
use EDParamsMod, only : maxpft
use EDParamsMod , only : mort_cstarvation_model
use FatesConstantsMod , only : itrue,ifalse
use FatesConstantsMod , only : cstarvation_model_lin
use FatesConstantsMod , only : cstarvation_model_exp
use FatesConstantsMod , only : nearzero
use FatesConstantsMod , only : ihard_stress_decid
use FatesConstantsMod , only : isemi_stress_decid
use FatesConstantsMod , only : leaves_off
use FatesAllometryMod , only : bleaf
use FatesAllometryMod , only : storage_fraction_of_target
use FatesInterfaceTypesMod , only : bc_in_type
Expand All @@ -25,6 +32,7 @@ module EDMortalityFunctionsMod

use PRTGenericMod, only : carbon12_element
use PRTGenericMod, only : store_organ
use PRTParametersMod , only : prt_params
use shr_log_mod , only : errMsg => shr_log_errMsg

implicit none
Expand Down Expand Up @@ -90,14 +98,27 @@ subroutine mortality_rates( cohort_in,bc_in, btran_ft, mean_temp, &
real(r8) :: min_fmc_ar ! minimum fraction of maximum conductivity for absorbing root
real(r8) :: min_fmc ! minimum fraction of maximum conductivity for whole plant
real(r8) :: flc ! fractional loss of conductivity
logical :: is_decid_dormant ! Flag to signal that the cohort is deciduous and dormant


real(r8), parameter :: frost_mort_buffer = 5.0_r8 ! 5deg buffer for freezing mortality
logical, parameter :: test_zero_mortality = .false. ! Developer test which
! may help to debug carbon imbalances
! and the like

! Check if the PFT is deciduous and leaves are completely abscised. If this is the case,
! we prevent hydraulic failure mortality to occur as plants are leafless. For now,
! semi-deciduous plants with senescing leaves may still die of hydraulic failure, but in
! the future we could accelerate senescence to avoid mortality. Note that both drought
! deciduous and cold deciduous are considered here to be consistent with the idea that
! plants without leaves cannot die of hydraulic failure.
is_decid_dormant = & !
( prt_params%stress_decid(cohort_in%pft) == ihard_stress_decid .or. & ! Drought deciduous
prt_params%stress_decid(cohort_in%pft) == isemi_stress_decid .or. & ! Semi-deciduous
prt_params%season_decid(cohort_in%pft) == itrue ) .and. & ! Cold deciduous
( cohort_in%status_coh == leaves_off ) ! ! Fully abscised


! Size Dependent Senescence
! Size Dependent Senescence
! rate (r) and inflection point (ip) define the increase in mortality rate with dbh
mort_r_size_senescence = EDPftvarcon_inst%mort_r_size_senescence(cohort_in%pft)
mort_ip_size_senescence = EDPftvarcon_inst%mort_ip_size_senescence(cohort_in%pft)
Expand Down Expand Up @@ -139,10 +160,11 @@ subroutine mortality_rates( cohort_in,bc_in, btran_ft, mean_temp, &

bmort = EDPftvarcon_inst%bmort(cohort_in%pft)

! Proxy for hydraulic failure induced mortality.
! Proxy for hydraulic failure induced mortality.
hf_sm_threshold = EDPftvarcon_inst%hf_sm_threshold(cohort_in%pft)
hf_flc_threshold = EDPftvarcon_inst%hf_flc_threshold(cohort_in%pft)
if(hlm_use_planthydro.eq.itrue)then

if (hlm_use_planthydro == itrue) then
!note the flc is set as the fraction of max conductivity in hydro
min_fmc_ag = minval(cohort_in%co_hydr%ftc_ag(:))
min_fmc_tr = cohort_in%co_hydr%ftc_troot
Expand All @@ -156,36 +178,60 @@ subroutine mortality_rates( cohort_in,bc_in, btran_ft, mean_temp, &
else
hmort = 0.0_r8
endif

else
if( ( btran_ft(cohort_in%pft) <= hf_sm_threshold ) .and. &
( ( minval(bc_in%t_soisno_sl) - tfrz ) > soil_tfrz_thresh ) ) then
! When FATES-Hydro is off, hydraulic failure mortality occurs only when btran
! falls below a threshold and plants have leaves.
if ( (.not. is_decid_dormant) .and. &
( btran_ft(cohort_in%pft) <= hf_sm_threshold ) .and. &
( ( minval(bc_in%t_soisno_sl) - tfrz ) > soil_tfrz_thresh ) ) then
hmort = EDPftvarcon_inst%mort_scalar_hydrfailure(cohort_in%pft)
else
hmort = 0.0_r8
endif
endif
end if
end if

! Carbon Starvation induced mortality.
if ( cohort_in%dbh > 0._r8 ) then

! We compare storage with leaf biomass if plant were fully flushed, otherwise
! mortality would be underestimated for plants that lost all leaves and have no
! storage to flush new ones.
! MLO. Why isn't this comparing with storage allometry (i.e., accounting for
! cushion)?
! Find the current ratio between storage biomass and leaf biomass, which will be
! used to define carbon starvation mortality. The reference leaf biomass is
! always for when plants are fully flushed (but accounting for damage and
! trimming).
call bleaf(cohort_in%dbh,cohort_in%pft,cohort_in%crowndamage,cohort_in%canopy_trim, &
1.0_r8, target_leaf_c)
store_c = cohort_in%prt%GetState(store_organ,carbon12_element)

call storage_fraction_of_target(target_leaf_c, store_c, frac)
if( frac .lt. 1._r8) then
cmort = max(0.0_r8,EDPftvarcon_inst%mort_scalar_cstarvation(cohort_in%pft) * &
(1.0_r8 - frac))
else

! Select the carbon starvation mortality model (linear or exponential)s.
select case (mort_cstarvation_model)
case (cstarvation_model_lin)
! Linear model. Carbon starvation mortality will be zero when fraction of
! storage is greater than or equal to mort_upthresh_cstarvation, and will
! increase to the maximum mortality (mort_scalar_cstarvation) when frac = 0.
cmort = EDPftvarcon_inst%mort_scalar_cstarvation(cohort_in%pft) * &
max(0.0_r8, (EDPftvarcon_inst%mort_upthresh_cstarvation(cohort_in%pft)-frac) / &
EDPftvarcon_inst%mort_upthresh_cstarvation(cohort_in%pft) )

case (cstarvation_model_exp)
! Exponential model. Maximum carbon starvation mortality
! (mort_scalar_cstarvation) occurs when frac=0. Parameter
! mort_upthresh_cstarvation controls the the e-folding factor for frac. The
! smaller the mort_upthresh_cstarvation, the faster the mortality will decay.
cmort = EDPftvarcon_inst%mort_scalar_cstarvation(cohort_in%pft) * &
exp(- frac / EDPftvarcon_inst%mort_upthresh_cstarvation(cohort_in%pft))

case default
write(fates_log(),*) &
'Invalid carbon starvation model (',mort_cstarvation_model,').'
call endrun(msg=errMsg(sourcefile, __LINE__))
end select

! Make sure the mortality is set to zero when tiny.
if (cmort <= nearzero) then
cmort = 0.0_r8
endif
end if


else
write(fates_log(),*) 'dbh problem in mortality_rates', &
cohort_in%dbh,cohort_in%pft,cohort_in%n,cohort_in%canopy_layer
Expand Down
21 changes: 13 additions & 8 deletions biogeochem/FatesAllometryMod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -616,20 +616,25 @@ end subroutine bleaf
subroutine storage_fraction_of_target(c_store_target, c_store, frac)

!--------------------------------------------------------------------------------
! returns the storage pool as a fraction of its target (only if it is below its target)
! used in both the carbon starvation mortlaity scheme as well as the optional
! respiration throttling logic
! This subroutine returns the ratio between the storage pool and the target
! storage. This subroutine is used both the carbon starvation mortality scheme
! and the optional respiration throttling. We impose checks so it cannot go negative
! due to truncation errors, but this function can return values greater than 1.
!
! Fractions exceeding do not impact the default linear carbon starvation model
! (mort_cstarvation_model=2), because mortality becomes zero, but they allow carbon
! starvation mortality rates to continue decaying when the exponential carbon
! starvation model is used (mort_cstarvation_model=2).
!
! Fraction values above 1 do not impact lowstorage_maintresp_reduction either,
! as that routine imposes no reduction once the fraction exceeds 1.
!--------------------------------------------------------------------------------

real(r8),intent(in) :: c_store_target ! target storage carbon [kg]
real(r8),intent(in) :: c_store ! storage carbon [kg]
real(r8),intent(out) :: frac

if( c_store_target > 0._r8 .and. c_store <= c_store_target )then
frac = c_store/ c_store_target
else
frac = 1._r8
endif
frac = max(0._r8, c_store / max( c_store_target, nearzero) )

end subroutine storage_fraction_of_target

Expand Down
Loading

0 comments on commit c8780c6

Please sign in to comment.