Skip to content

Commit

Permalink
Merge resolution with master, resolved kmax_rsurf1 name change in EDP…
Browse files Browse the repository at this point in the history 
…aramsMod.
  • Loading branch information
@rgknox
rgknox committed May 29, 2019
2 parents 7042533 + f1d4bc5 commit 5dbff93
Show file tree
Hide file tree
Showing 18 changed files with 1,034 additions and 646 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
25 changes: 23 additions & 2 deletions biogeochem/EDLoggingMortalityMod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -59,6 +59,9 @@ module EDLoggingMortalityMod

character(len=*), parameter, private :: sourcefile = &
__FILE__


real(r8), public, parameter :: logging_export_frac = 0.8_r8

public :: LoggingMortality_frac
public :: logging_litter_fluxes
Expand Down Expand Up @@ -170,6 +173,8 @@ subroutine LoggingMortality_frac( pft_i, dbh, canopy_layer, lmort_direct, &
real(r8), parameter :: adjustment = 1.0 ! adjustment for mortality rates

if (logging_time) then


if(EDPftvarcon_inst%woody(pft_i) == 1)then ! only set logging rates for trees

! Pass logging rates to cohort level
Expand All @@ -192,8 +197,14 @@ subroutine LoggingMortality_frac( pft_i, dbh, canopy_layer, lmort_direct, &

! Collateral damage to smaller plants below the canopy layer
! will be applied via "understory_death" via the disturbance algorithm
! Important: Degredation rates really only have an impact when
! applied to the canopy layer. So we don't add to degredation
! for collateral damage, even understory collateral damage.

if (canopy_layer .eq. 1) then
lmort_collateral = logging_collateral_frac * adjustment
else
lmort_collateral = 0._r8
endif

else
Expand All @@ -202,6 +213,7 @@ subroutine LoggingMortality_frac( pft_i, dbh, canopy_layer, lmort_direct, &
lmort_infra = 0.0_r8
l_degrad = 0.0_r8
end if

else
lmort_direct = 0.0_r8
lmort_collateral = 0.0_r8
Expand Down Expand Up @@ -309,10 +321,19 @@ subroutine logging_litter_fluxes(currentSite, currentPatch, newPatch, patch_site
(currentCohort%lmort_collateral + currentCohort%lmort_infra)

else

! This routine is only called during disturbance. The litter
! fluxes from non-disturbance generating mortality are
! handled in EDPhysiology. Disturbance generating mortality
! are those cohorts in the top canopy layer, or those
! plants that were impacted. Thus, no direct dead can occur
! here, and indirect are impacts.

if(EDPftvarcon_inst%woody(currentCohort%pft) == 1)then
direct_dead = 0.0_r8
indirect_dead = logging_coll_under_frac * currentCohort%n * &
(patch_site_areadis/currentPatch%area) !kgC/site/day
indirect_dead = logging_coll_under_frac * &
(1._r8-currentPatch%fract_ldist_not_harvested) * currentCohort%n * &
(patch_site_areadis/currentPatch%area) !kgC/site/day
else
! If the cohort of interest is grass, it will not experience
! any mortality associated with the logging disturbance
Expand Down
7 changes: 5 additions & 2 deletions biogeochem/EDMortalityFunctionsMod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -200,15 +200,18 @@ subroutine Mortality_Derivative( currentSite, currentCohort, bc_in)
currentCohort%lmort_infra, &
currentCohort%l_degrad)




if (currentCohort%canopy_layer > 1)then

! Include understory logging mortality rates not associated with disturbance
dndt_logging = (currentCohort%lmort_direct + &
currentCohort%lmort_collateral + &
currentCohort%lmort_infra)/hlm_freq_day

currentCohort%dndt = -1.0_r8 * (cmort+hmort+bmort+frmort+dndt_logging) * currentCohort%n
else
! Mortality from logging in the canopy is ONLY disturbance generating, don't
! update number densities via non-disturbance inducing death
currentCohort%dndt = -(1.0_r8 - fates_mortality_disturbance_fraction) &
* (cmort+hmort+bmort+frmort) * currentCohort%n
endif
Expand Down
21 changes: 12 additions & 9 deletions biogeochem/EDPatchDynamicsMod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -20,6 +20,7 @@ module EDPatchDynamicsMod
use EDTypesMod , only : dtype_ilog
use EDTypesMod , only : dtype_ifire
use EDTypesMod , only : ican_upper
use EDTypesMod , only : lg_sf
use FatesInterfaceMod , only : hlm_use_planthydro
use FatesInterfaceMod , only : hlm_numSWb
use FatesInterfaceMod , only : bc_in_type
Expand Down Expand Up @@ -151,7 +152,7 @@ subroutine disturbance_rates( site_in, bc_in)
call LoggingMortality_frac(currentCohort%pft, currentCohort%dbh, currentCohort%canopy_layer, &
lmort_direct,lmort_collateral,lmort_infra,l_degrad )

currentCohort%lmort_direct = lmort_direct
currentCohort%lmort_direct = lmort_direct
currentCohort%lmort_collateral = lmort_collateral
currentCohort%lmort_infra = lmort_infra
currentCohort%l_degrad = l_degrad
Expand Down Expand Up @@ -186,7 +187,7 @@ subroutine disturbance_rates( site_in, bc_in)

! Logging Disturbance Rate
currentPatch%disturbance_rates(dtype_ilog) = currentPatch%disturbance_rates(dtype_ilog) + &
min(1.0_r8, currentCohort%lmort_direct + &
min(1.0_r8, currentCohort%lmort_direct + &
currentCohort%lmort_collateral + &
currentCohort%lmort_infra + &
currentCohort%l_degrad ) * &
Expand Down Expand Up @@ -226,7 +227,7 @@ subroutine disturbance_rates( site_in, bc_in)
! to still diagnose and track the non-disturbance rate
! ------------------------------------------------------------------------------------------


! DISTURBANCE IS LOGGING
if (currentPatch%disturbance_rates(dtype_ilog) > currentPatch%disturbance_rates(dtype_ifall) .and. &
currentPatch%disturbance_rates(dtype_ilog) > currentPatch%disturbance_rates(dtype_ifire) ) then

Expand All @@ -245,7 +246,7 @@ subroutine disturbance_rates( site_in, bc_in)
currentCohort => currentCohort%taller
enddo !currentCohort

! DISTURBANCE IS FIRE
! DISTURBANCE IS FIRE
elseif (currentPatch%disturbance_rates(dtype_ifire) > currentPatch%disturbance_rates(dtype_ifall) .and. &
currentPatch%disturbance_rates(dtype_ifire) > currentPatch%disturbance_rates(dtype_ilog) ) then

Expand Down Expand Up @@ -275,7 +276,7 @@ subroutine disturbance_rates( site_in, bc_in)
currentCohort => currentCohort%taller
enddo !currentCohort

else ! If fire and loggin are not greater than treefall, just set disturbance rate to tree-fall
else ! If fire and logging are not greater than treefall, just set disturbance rate to tree-fall
! which is most likely a 0.0

currentPatch%disturbance_rate = currentPatch%disturbance_rates(dtype_ifall)
Expand Down Expand Up @@ -477,6 +478,8 @@ subroutine spawn_patches( currentSite, bc_in)

call logging_litter_fluxes(currentSite, currentPatch, new_patch, patch_site_areadis)

if(debug) write(fates_log(),*) "Logging disturbance generated:",patch_site_areadis

elseif ((currentPatch%disturbance_rates(dtype_ifire) > &
currentPatch%disturbance_rates(dtype_ifall)) .and. &
(currentPatch%disturbance_rates(dtype_ifire) > &
Expand Down Expand Up @@ -681,7 +684,7 @@ subroutine spawn_patches( currentSite, bc_in)
nc%lmort_infra = currentCohort%lmort_infra


! Logging is the dominant disturbance
! Logging is the dominant disturbance
elseif ((currentPatch%disturbance_rates(dtype_ilog) > &
currentPatch%disturbance_rates(dtype_ifall)) .and. &
(currentPatch%disturbance_rates(dtype_ilog) > &
Expand Down Expand Up @@ -756,7 +759,7 @@ subroutine spawn_patches( currentSite, bc_in)
! LOGGING SURVIVORSHIP OF UNDERSTORY PLANTS IS SET AS A NEW PARAMETER
! in the fatesparameter files
nc%n = nc%n * (1.0_r8 - &
currentPatch%fract_ldist_not_harvested * logging_coll_under_frac)
(1.0_r8-currentPatch%fract_ldist_not_harvested) * logging_coll_under_frac)

! Step 3: Reduce the number count of cohorts in the
! original/donor/non-disturbed patch to reflect the area change
Expand Down Expand Up @@ -1085,7 +1088,7 @@ subroutine fire_litter_fluxes(currentSite, cp_target, new_patch_target, patch_si
!************************************/
do c = 1,ncwd
burned_litter = new_patch%cwd_ag(c) * patch_site_areadis/new_patch%area * &
currentPatch%burnt_frac_litter(c+1) !kG/m2/day
currentPatch%burnt_frac_litter(c) !kG/m2/day
new_patch%cwd_ag(c) = new_patch%cwd_ag(c) - burned_litter
currentSite%flux_out = currentSite%flux_out + burned_litter * new_patch%area !kG/site/day
currentSite%total_burn_flux_to_atm = currentSite%total_burn_flux_to_atm + &
Expand Down Expand Up @@ -1240,7 +1243,7 @@ subroutine fire_litter_fluxes(currentSite, cp_target, new_patch_target, patch_si
if(EDPftvarcon_inst%woody(currentCohort%pft) == 1)then
burned_leaves = leaf_c * currentCohort%fraction_crown_burned
else
burned_leaves = leaf_c * currentPatch%burnt_frac_litter(6)
burned_leaves = leaf_c * currentPatch%burnt_frac_litter(lg_sf)
endif

if (burned_leaves > 0.0_r8) then
Expand Down
Loading

0 comments on commit 5dbff93

Please sign in to comment.