Skip to content

Commit

Permalink
Merge pull request #521 from rgknox/rgknox-separate-growthresets
Browse files Browse the repository at this point in the history 
Moved structure reset code out of parteh and into edcohortdynamics
  • Loading branch information
@rgknox
rgknox authored Apr 15, 2019
2 parents a967063 + 1ace5a1 commit 5dd0d0e
Show file tree
Hide file tree
Showing 4 changed files with 127 additions and 80 deletions.
92 changes: 92 additions & 0 deletions biogeochem/EDCohortDynamicsMod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -14,6 +14,7 @@ module EDCohortDynamicsMod
use FatesConstantsMod , only : itrue,ifalse
use FatesConstantsMod , only : fates_unset_r8
use FatesConstantsMod , only : nearzero
use FatesConstantsMod , only : calloc_abs_error
use FatesInterfaceMod , only : hlm_days_per_year
use FatesInterfaceMod , only : nleafage
use EDPftvarcon , only : EDPftvarcon_inst
Expand Down Expand Up @@ -47,6 +48,10 @@ module EDCohortDynamicsMod
use FatesSizeAgeTypeIndicesMod, only : sizetype_class_index
use FatesAllometryMod , only : bleaf
use FatesAllometryMod , only : bfineroot
use FatesAllometryMod , only : bsap_allom
use FatesAllometryMod , only : bagw_allom
use FatesAllometryMod , only : bbgw_allom
use FatesAllometryMod , only : bdead_allom
use FatesAllometryMod , only : h_allom
use FatesAllometryMod , only : carea_allom
use FatesAllometryMod , only : ForceDBH
Expand Down Expand Up @@ -93,6 +98,7 @@ module EDCohortDynamicsMod
public :: count_cohorts
public :: InitPRTCohort
public :: UpdateCohortBioPhysRates
public :: EvaluateAndCorrectDBH

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

Expand Down Expand Up @@ -1706,4 +1712,90 @@ end subroutine UpdateCohortBioPhysRates

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


subroutine EvaluateAndCorrectDBH(currentCohort,delta_dbh,delta_hite)

! -----------------------------------------------------------------------------------
! If the current diameter of a plant is somehow less than what is allometrically
! consistent with stuctural biomass (or, in the case of grasses, leaf biomass)
! then correct (increase) the dbh to match that.
! -----------------------------------------------------------------------------------

! argument
type(ed_cohort_type),intent(inout) :: currentCohort
real(r8),intent(out) :: delta_dbh
real(r8),intent(out) :: delta_hite

! locals
real(r8) :: dbh
real(r8) :: canopy_trim
integer :: ipft
real(r8) :: sapw_area
real(r8) :: target_sapw_c
real(r8) :: target_agw_c
real(r8) :: target_bgw_c
real(r8) :: target_struct_c
real(r8) :: target_leaf_c
real(r8) :: struct_c
real(r8) :: hite_out
real(r8) :: leaf_c

dbh = currentCohort%dbh
ipft = currentCohort%pft
canopy_trim = currentCohort%canopy_trim

delta_dbh = 0._r8
delta_hite = 0._r8

if( EDPftvarcon_inst%woody(ipft) == itrue) then

struct_c = currentCohort%prt%GetState(struct_organ, all_carbon_elements)

! 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)

! ------------------------------------------------------------------------------------
! If structure is larger than target, then we need to correct some integration errors
! by slightly increasing dbh to match it.
! For grasses, if leaf biomass is larger than target, then we reset dbh to match
! -----------------------------------------------------------------------------------

if( (struct_c - target_struct_c ) > calloc_abs_error ) then
call ForceDBH( ipft, canopy_trim, dbh, hite_out, bdead=struct_c )
delta_dbh = dbh - currentCohort%dbh
delta_hite = hite_out - currentCohort%hite
currentCohort%dbh = dbh
currentCohort%hite = hite_out
end if

else

! This returns the sum of leaf carbon over all (age) bins
leaf_c = currentCohort%prt%GetState(leaf_organ, all_carbon_elements)

! Target leaf biomass according to allometry and trimming
call bleaf(dbh,ipft,canopy_trim,target_leaf_c)

if( ( leaf_c - target_leaf_c ) > calloc_abs_error ) then
call ForceDBH( ipft, canopy_trim, dbh, hite_out, bl=leaf_c )
delta_dbh = dbh - currentCohort%dbh
delta_hite = hite_out - currentCohort%hite
currentCohort%dbh = dbh
currentCohort%hite = hite_out
end if

end if
return
end subroutine EvaluateAndCorrectDBH


end module EDCohortDynamicsMod
1 change: 1 addition & 0 deletions biogeochem/FatesAllometryMod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2200,6 +2200,7 @@ end function decay_coeff_kn

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


subroutine ForceDBH( ipft, canopy_trim, d, h, bdead, bl )

! =========================================================================
Expand Down
17 changes: 14 additions & 3 deletions main/EDMainMod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -24,6 +24,7 @@ module EDMainMod
use EDCohortDynamicsMod , only : fuse_cohorts
use EDCohortDynamicsMod , only : sort_cohorts
use EDCohortDynamicsMod , only : count_cohorts
use EDCohortDynamicsMod , only : EvaluateAndCorrectDBH
use EDPatchDynamicsMod , only : disturbance_rates
use EDPatchDynamicsMod , only : fuse_patches
use EDPatchDynamicsMod , only : spawn_patches
Expand Down Expand Up @@ -270,7 +271,9 @@ subroutine ed_integrate_state_variables(currentSite, bc_in )
real(r8) :: dbh_old ! dbh of plant before daily PRT [cm]
real(r8) :: hite_old ! height of plant before daily PRT [m]
real(r8) :: leaf_c

real(r8) :: delta_dbh ! correction for dbh
real(r8) :: delta_hite ! correction for hite

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

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

hite_old = currentCohort%hite
dbh_old = currentCohort%dbh


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


! If the current diameter of a plant is somehow less than what is consistent
! with what is allometrically consistent with the stuctural biomass, then
! correct the dbh to match.

call EvaluateAndCorrectDBH(currentCohort,delta_dbh,delta_hite)

hite_old = currentCohort%hite
dbh_old = currentCohort%dbh

! Conduct Growth (parteh)
call currentCohort%prt%DailyPRT()
call currentCohort%prt%CheckMassConservation(ft,5)
Expand Down
97 changes: 20 additions & 77 deletions parteh/PRTAllometricCarbonMod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -442,84 +442,27 @@ subroutine DailyPRTAllometricCarbon(this)
! -----------------------------------------------------------------------------------
! II. Calculate target size of the biomass compartment for a given dbh.
! -----------------------------------------------------------------------------------

if( EDPftvarcon_inst%woody(ipft) == itrue) then


! 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)

! ------------------------------------------------------------------------------------
! If structure is larger than target, then we need to correct some integration errors
! by slightly increasing dbh to match it.
! For grasses, if leaf biomass is larger than target, then we reset dbh to match
! -----------------------------------------------------------------------------------

if( (struct_c - target_struct_c ) > calloc_abs_error ) then

call ForceDBH( ipft, canopy_trim, dbh, hite_out, bdead=struct_c )

! Set the structural target biomass to the current structural boimass [kgC]
target_struct_c = struct_c

! Target sapwood biomass according to allometry and trimming [kgC]
call bsap_allom(dbh,ipft,canopy_trim,sapw_area,target_sapw_c)

end if


! Target leaf biomass according to allometry and trimming
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)

! Target storage carbon [kgC,kgC/cm]
call bstore_allom(dbh,ipft,canopy_trim,target_store_c)

else

! Target leaf biomass according to allometry and trimming
call bleaf(dbh,ipft,canopy_trim,target_leaf_c)


if( ( sum(leaf_c) - target_leaf_c ) > calloc_abs_error ) then

call ForceDBH( ipft, canopy_trim, dbh, hite_out, bl=sum(leaf_c) )

target_leaf_c = sum(leaf_c)

end if

! Target fine-root biomass and deriv. according to allometry and trimming [kgC, kgC/cm]
call bfineroot(dbh,ipft,canopy_trim,target_fnrt_c)

! 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 and [kgC]
call bdead_allom( target_agw_c, target_bgw_c, target_sapw_c, ipft, target_struct_c)

! Target storage carbon [kgC]
call bstore_allom(dbh,ipft,canopy_trim,target_store_c)


end if
! 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
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)

! Target storage carbon [kgC,kgC/cm]
call bstore_allom(dbh,ipft,canopy_trim,target_store_c)


! -----------------------------------------------------------------------------------
Expand Down

0 comments on commit 5dd0d0e

Please sign in to comment.