Skip to content

Commit 5dd0d0e

Browse files
rgknoxrgknox
authored
Merge pull request #521 from rgknox/rgknox-separate-growthresets
Moved structure reset code out of parteh and into edcohortdynamics
2 parents a967063 + 1ace5a1 commit 5dd0d0e

File tree

4 files changed

+127
-80
lines changed

4 files changed

+127
-80
lines changed

‎biogeochem/EDCohortDynamicsMod.F90‎

Lines changed: 92 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -14,6 +14,7 @@ module EDCohortDynamicsMod
1414
use FatesConstantsMod , only : itrue,ifalse
1515
use FatesConstantsMod , only : fates_unset_r8
1616
use FatesConstantsMod , only : nearzero
17+
use FatesConstantsMod , only : calloc_abs_error
1718
use FatesInterfaceMod , only : hlm_days_per_year
1819
use FatesInterfaceMod , only : nleafage
1920
use EDPftvarcon , only : EDPftvarcon_inst
@@ -47,6 +48,10 @@ module EDCohortDynamicsMod
4748
use FatesSizeAgeTypeIndicesMod, only : sizetype_class_index
4849
use FatesAllometryMod , only : bleaf
4950
use FatesAllometryMod , only : bfineroot
51+
use FatesAllometryMod , only : bsap_allom
52+
use FatesAllometryMod , only : bagw_allom
53+
use FatesAllometryMod , only : bbgw_allom
54+
use FatesAllometryMod , only : bdead_allom
5055
use FatesAllometryMod , only : h_allom
5156
use FatesAllometryMod , only : carea_allom
5257
use FatesAllometryMod , only : ForceDBH
@@ -93,6 +98,7 @@ module EDCohortDynamicsMod
9398
public :: count_cohorts
9499
public :: InitPRTCohort
95100
public :: UpdateCohortBioPhysRates
101+
public :: EvaluateAndCorrectDBH
96102

97103
logical, parameter :: debug = .false. ! local debug flag
98104

@@ -1706,4 +1712,90 @@ end subroutine UpdateCohortBioPhysRates
17061712

17071713
! ============================================================================
17081714

1715+
1716+
subroutine EvaluateAndCorrectDBH(currentCohort,delta_dbh,delta_hite)
1717+
1718+
! -----------------------------------------------------------------------------------
1719+
! If the current diameter of a plant is somehow less than what is allometrically
1720+
! consistent with stuctural biomass (or, in the case of grasses, leaf biomass)
1721+
! then correct (increase) the dbh to match that.
1722+
! -----------------------------------------------------------------------------------
1723+
1724+
! argument
1725+
type(ed_cohort_type),intent(inout) :: currentCohort
1726+
real(r8),intent(out) :: delta_dbh
1727+
real(r8),intent(out) :: delta_hite
1728+
1729+
! locals
1730+
real(r8) :: dbh
1731+
real(r8) :: canopy_trim
1732+
integer :: ipft
1733+
real(r8) :: sapw_area
1734+
real(r8) :: target_sapw_c
1735+
real(r8) :: target_agw_c
1736+
real(r8) :: target_bgw_c
1737+
real(r8) :: target_struct_c
1738+
real(r8) :: target_leaf_c
1739+
real(r8) :: struct_c
1740+
real(r8) :: hite_out
1741+
real(r8) :: leaf_c
1742+
1743+
dbh = currentCohort%dbh
1744+
ipft = currentCohort%pft
1745+
canopy_trim = currentCohort%canopy_trim
1746+
1747+
delta_dbh = 0._r8
1748+
delta_hite = 0._r8
1749+
1750+
if( EDPftvarcon_inst%woody(ipft) == itrue) then
1751+
1752+
struct_c = currentCohort%prt%GetState(struct_organ, all_carbon_elements)
1753+
1754+
! Target sapwood biomass according to allometry and trimming [kgC]
1755+
call bsap_allom(dbh,ipft,canopy_trim,sapw_area,target_sapw_c)
1756+
1757+
! Target total above ground biomass in woody/fibrous tissues [kgC]
1758+
call bagw_allom(dbh,ipft,target_agw_c)
1759+
1760+
! Target total below ground biomass in woody/fibrous tissues [kgC]
1761+
call bbgw_allom(dbh,ipft,target_bgw_c)
1762+
1763+
! Target total dead (structrual) biomass [kgC]
1764+
call bdead_allom( target_agw_c, target_bgw_c, target_sapw_c, ipft, target_struct_c)
1765+
1766+
! ------------------------------------------------------------------------------------
1767+
! If structure is larger than target, then we need to correct some integration errors
1768+
! by slightly increasing dbh to match it.
1769+
! For grasses, if leaf biomass is larger than target, then we reset dbh to match
1770+
! -----------------------------------------------------------------------------------
1771+
1772+
if( (struct_c - target_struct_c ) > calloc_abs_error ) then
1773+
call ForceDBH( ipft, canopy_trim, dbh, hite_out, bdead=struct_c )
1774+
delta_dbh = dbh - currentCohort%dbh
1775+
delta_hite = hite_out - currentCohort%hite
1776+
currentCohort%dbh = dbh
1777+
currentCohort%hite = hite_out
1778+
end if
1779+
1780+
else
1781+
1782+
! This returns the sum of leaf carbon over all (age) bins
1783+
leaf_c = currentCohort%prt%GetState(leaf_organ, all_carbon_elements)
1784+
1785+
! Target leaf biomass according to allometry and trimming
1786+
call bleaf(dbh,ipft,canopy_trim,target_leaf_c)
1787+
1788+
if( ( leaf_c - target_leaf_c ) > calloc_abs_error ) then
1789+
call ForceDBH( ipft, canopy_trim, dbh, hite_out, bl=leaf_c )
1790+
delta_dbh = dbh - currentCohort%dbh
1791+
delta_hite = hite_out - currentCohort%hite
1792+
currentCohort%dbh = dbh
1793+
currentCohort%hite = hite_out
1794+
end if
1795+
1796+
end if
1797+
return
1798+
end subroutine EvaluateAndCorrectDBH
1799+
1800+
17091801
end module EDCohortDynamicsMod

‎biogeochem/FatesAllometryMod.F90‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -2200,6 +2200,7 @@ end function decay_coeff_kn
22002200

22012201
! =====================================================================================
22022202

2203+
22032204
subroutine ForceDBH( ipft, canopy_trim, d, h, bdead, bl )
22042205

22052206
! =========================================================================

‎main/EDMainMod.F90‎

Lines changed: 14 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -24,6 +24,7 @@ module EDMainMod
2424
use EDCohortDynamicsMod , only : fuse_cohorts
2525
use EDCohortDynamicsMod , only : sort_cohorts
2626
use EDCohortDynamicsMod , only : count_cohorts
27+
use EDCohortDynamicsMod , only : EvaluateAndCorrectDBH
2728
use EDPatchDynamicsMod , only : disturbance_rates
2829
use EDPatchDynamicsMod , only : fuse_patches
2930
use EDPatchDynamicsMod , only : spawn_patches
@@ -270,7 +271,9 @@ subroutine ed_integrate_state_variables(currentSite, bc_in )
270271
real(r8) :: dbh_old ! dbh of plant before daily PRT [cm]
271272
real(r8) :: hite_old ! height of plant before daily PRT [m]
272273
real(r8) :: leaf_c
273-
274+
real(r8) :: delta_dbh ! correction for dbh
275+
real(r8) :: delta_hite ! correction for hite
276+
274277
!-----------------------------------------------------------------------
275278

276279
small_no = 0.0000000000_r8 ! Obviously, this is arbitrary. RF - changed to zero
@@ -314,8 +317,7 @@ subroutine ed_integrate_state_variables(currentSite, bc_in )
314317
! Apply Plant Allocation and Reactive Transport
315318
! -----------------------------------------------------------------------------
316319

317-
hite_old = currentCohort%hite
318-
dbh_old = currentCohort%dbh
320+
319321

320322
! -----------------------------------------------------------------------------
321323
! Identify the net carbon gain for this dynamics interval
@@ -373,6 +375,15 @@ subroutine ed_integrate_state_variables(currentSite, bc_in )
373375
currentPatch%canopy_layer_tlai, currentCohort%treelai,currentCohort%vcmax25top,7 )
374376

375377

378+
! If the current diameter of a plant is somehow less than what is consistent
379+
! with what is allometrically consistent with the stuctural biomass, then
380+
! correct the dbh to match.
381+
382+
call EvaluateAndCorrectDBH(currentCohort,delta_dbh,delta_hite)
383+
384+
hite_old = currentCohort%hite
385+
dbh_old = currentCohort%dbh
386+
376387
! Conduct Growth (parteh)
377388
call currentCohort%prt%DailyPRT()
378389
call currentCohort%prt%CheckMassConservation(ft,5)

‎parteh/PRTAllometricCarbonMod.F90‎

Lines changed: 20 additions & 77 deletions
Original file line numberDiff line numberDiff line change
@@ -442,84 +442,27 @@ subroutine DailyPRTAllometricCarbon(this)
442442
! -----------------------------------------------------------------------------------
443443
! II. Calculate target size of the biomass compartment for a given dbh.
444444
! -----------------------------------------------------------------------------------
445-
446-
if( EDPftvarcon_inst%woody(ipft) == itrue) then
447-
448445

449-
! Target sapwood biomass according to allometry and trimming [kgC]
450-
call bsap_allom(dbh,ipft,canopy_trim,sapw_area,target_sapw_c)
451-
452-
! Target total above ground biomass in woody/fibrous tissues [kgC]
453-
call bagw_allom(dbh,ipft,target_agw_c)
454-
455-
! Target total below ground biomass in woody/fibrous tissues [kgC]
456-
call bbgw_allom(dbh,ipft,target_bgw_c)
457-
458-
! Target total dead (structrual) biomass [kgC]
459-
call bdead_allom( target_agw_c, target_bgw_c, target_sapw_c, ipft, target_struct_c)
460-
461-
! ------------------------------------------------------------------------------------
462-
! If structure is larger than target, then we need to correct some integration errors
463-
! by slightly increasing dbh to match it.
464-
! For grasses, if leaf biomass is larger than target, then we reset dbh to match
465-
! -----------------------------------------------------------------------------------
466-
467-
if( (struct_c - target_struct_c ) > calloc_abs_error ) then
468-
469-
call ForceDBH( ipft, canopy_trim, dbh, hite_out, bdead=struct_c )
470-
471-
! Set the structural target biomass to the current structural boimass [kgC]
472-
target_struct_c = struct_c
473-
474-
! Target sapwood biomass according to allometry and trimming [kgC]
475-
call bsap_allom(dbh,ipft,canopy_trim,sapw_area,target_sapw_c)
476-
477-
end if
478-
479-
480-
! Target leaf biomass according to allometry and trimming
481-
call bleaf(dbh,ipft,canopy_trim,target_leaf_c)
482-
483-
! Target fine-root biomass and deriv. according to allometry and trimming [kgC, kgC/cm]
484-
call bfineroot(dbh,ipft,canopy_trim,target_fnrt_c)
485-
486-
! Target storage carbon [kgC,kgC/cm]
487-
call bstore_allom(dbh,ipft,canopy_trim,target_store_c)
488-
489-
else
490-
491-
! Target leaf biomass according to allometry and trimming
492-
call bleaf(dbh,ipft,canopy_trim,target_leaf_c)
493-
494-
495-
if( ( sum(leaf_c) - target_leaf_c ) > calloc_abs_error ) then
496-
497-
call ForceDBH( ipft, canopy_trim, dbh, hite_out, bl=sum(leaf_c) )
498-
499-
target_leaf_c = sum(leaf_c)
500-
501-
end if
502-
503-
! Target fine-root biomass and deriv. according to allometry and trimming [kgC, kgC/cm]
504-
call bfineroot(dbh,ipft,canopy_trim,target_fnrt_c)
505-
506-
! Target sapwood biomass according to allometry and trimming [kgC]
507-
call bsap_allom(dbh,ipft,canopy_trim,sapw_area,target_sapw_c)
508-
509-
! Target total above ground biomass in woody/fibrous tissues [kgC]
510-
call bagw_allom(dbh,ipft,target_agw_c)
511-
512-
! Target total below ground biomass in woody/fibrous tissues [kgC]
513-
call bbgw_allom(dbh,ipft,target_bgw_c)
514-
515-
! Target total dead (structrual) biomass and [kgC]
516-
call bdead_allom( target_agw_c, target_bgw_c, target_sapw_c, ipft, target_struct_c)
517-
518-
! Target storage carbon [kgC]
519-
call bstore_allom(dbh,ipft,canopy_trim,target_store_c)
520-
521-
522-
end if
446+
! Target sapwood biomass according to allometry and trimming [kgC]
447+
call bsap_allom(dbh,ipft,canopy_trim,sapw_area,target_sapw_c)
448+
449+
! Target total above ground biomass in woody/fibrous tissues [kgC]
450+
call bagw_allom(dbh,ipft,target_agw_c)
451+
452+
! Target total below ground biomass in woody/fibrous tissues [kgC]
453+
call bbgw_allom(dbh,ipft,target_bgw_c)
454+
455+
! Target total dead (structrual) biomass [kgC]
456+
call bdead_allom( target_agw_c, target_bgw_c, target_sapw_c, ipft, target_struct_c)
457+
458+
! Target leaf biomass according to allometry and trimming
459+
call bleaf(dbh,ipft,canopy_trim,target_leaf_c)
460+
461+
! Target fine-root biomass and deriv. according to allometry and trimming [kgC, kgC/cm]
462+
call bfineroot(dbh,ipft,canopy_trim,target_fnrt_c)
463+
464+
! Target storage carbon [kgC,kgC/cm]
465+
call bstore_allom(dbh,ipft,canopy_trim,target_store_c)
523466

524467

525468
! -----------------------------------------------------------------------------------

0 commit comments

Comments
 (0)