Skip to content

Commit

Permalink
Merge pull request #6 from rgknox/mpaiao-pr-drgt-decid
Browse files Browse the repository at this point in the history
smp and parameter updates
  • Loading branch information
mpaiao authored Jun 28, 2023
2 parents 0a3c66c + 5830b35 commit a1f3dc5
Show file tree
Hide file tree
Showing 13 changed files with 295 additions and 173 deletions.
14 changes: 9 additions & 5 deletions biogeochem/EDCohortDynamicsMod.F90
Original file line number Diff line number Diff line change
Expand Up @@ -33,6 +33,7 @@ Module EDCohortDynamicsMod
use FatesLitterMod , only : ncwd
use FatesLitterMod , only : ndcmpy
use FatesLitterMod , only : litter_type
use FatesLitterMod , only : adjust_SF_CWD_frac
use EDParamsMod , only : max_cohort_per_patch
use EDTypesMod , only : AREA
use EDTypesMod , only : min_npm2, min_nppatch
Expand Down Expand Up @@ -1022,7 +1023,7 @@ subroutine SendCohortToLitter(csite,cpatch,ccohort,nplant,bc_in)
integer :: crowndamage ! the crown damage class of the cohort
integer :: sl ! loop index for soil layers
integer :: dcmpy ! loop index for decomposability

real(r8) :: SF_val_CWD_frac_adj(4) !Updated wood partitioning to CWD based on dbh
!----------------------------------------------------------------------

pft = ccohort%pft
Expand Down Expand Up @@ -1052,29 +1053,32 @@ subroutine SendCohortToLitter(csite,cpatch,ccohort,nplant,bc_in)
litt => cpatch%litter(el)
flux_diags => csite%flux_diags(el)

!adjust how wood is partitioned between the cwd classes based on cohort dbh
call adjust_SF_CWD_frac(ccohort%dbh,ncwd,SF_val_CWD_frac,SF_val_CWD_frac_adj)

do c=1,ncwd

! above ground CWD
litt%ag_cwd(c) = litt%ag_cwd(c) + plant_dens * &
(struct_m+sapw_m) * SF_val_CWD_frac(c) * &
(struct_m+sapw_m) * SF_val_CWD_frac_adj(c) * &
prt_params%allom_agb_frac(pft)

! below ground CWD
do sl=1,csite%nlevsoil
litt%bg_cwd(c,sl) = litt%bg_cwd(c,sl) + plant_dens * &
(struct_m+sapw_m) * SF_val_CWD_frac(c) * &
(struct_m+sapw_m) * SF_val_CWD_frac_adj(c) * &
(1.0_r8 - prt_params%allom_agb_frac(pft)) * &
csite%rootfrac_scr(sl)
enddo

! above ground
flux_diags%cwd_ag_input(c) = flux_diags%cwd_ag_input(c) + &
(struct_m+sapw_m) * SF_val_CWD_frac(c) * &
(struct_m+sapw_m) * SF_val_CWD_frac_adj(c) * &
prt_params%allom_agb_frac(pft) * nplant

! below ground
flux_diags%cwd_bg_input(c) = flux_diags%cwd_bg_input(c) + &
(struct_m + sapw_m) * SF_val_CWD_frac(c) * &
(struct_m + sapw_m) * SF_val_CWD_frac_adj(c) * &
(1.0_r8 - prt_params%allom_agb_frac(pft)) * nplant

enddo
Expand Down
42 changes: 23 additions & 19 deletions biogeochem/EDLoggingMortalityMod.F90
Original file line number Diff line number Diff line change
Expand Up @@ -22,6 +22,7 @@ module EDLoggingMortalityMod
use FatesLitterMod , only : ncwd
use FatesLitterMod , only : ndcmpy
use FatesLitterMod , only : litter_type
use FatesLitterMod , only : adjust_SF_CWD_frac
use EDTypesMod , only : ed_site_type
use EDTypesMod , only : ed_resources_management_type
use EDTypesMod , only : dtype_ilog
Expand Down Expand Up @@ -766,7 +767,7 @@ subroutine logging_litter_fluxes(currentSite, currentPatch, newPatch, patch_site
integer :: nlevsoil ! number of soil layers
integer :: ilyr ! soil layer loop index
integer :: el ! elemend loop index

real(r8) :: SF_val_CWD_frac_adj(4) !Updated wood partitioning to CWD based on dbh

nlevsoil = currentSite%nlevsoil

Expand Down Expand Up @@ -870,37 +871,40 @@ subroutine logging_litter_fluxes(currentSite, currentPatch, newPatch, patch_site
prt_params%allom_agb_frac(currentCohort%pft)
bg_wood = (direct_dead+indirect_dead) * (struct_m + sapw_m ) * &
(1._r8 - prt_params%allom_agb_frac(currentCohort%pft))

do c = 1,ncwd-1

!adjust how wood is partitioned between the cwd classes based on cohort dbh
call adjust_SF_CWD_frac(currentCohort%dbh,ncwd,SF_val_CWD_frac,SF_val_CWD_frac_adj)

do c = 1,ncwd-1

new_litt%ag_cwd(c) = new_litt%ag_cwd(c) + &
ag_wood * SF_val_CWD_frac(c) * donate_m2
ag_wood * SF_val_CWD_frac_adj(c) * donate_m2
cur_litt%ag_cwd(c) = cur_litt%ag_cwd(c) + &
ag_wood * SF_val_CWD_frac(c) * retain_m2
ag_wood * SF_val_CWD_frac_adj(c) * retain_m2

do ilyr = 1,nlevsoil

new_litt%bg_cwd(c,ilyr) = new_litt%bg_cwd(c,ilyr) + &
bg_wood * currentSite%rootfrac_scr(ilyr) * &
SF_val_CWD_frac(c) * donate_m2
SF_val_CWD_frac_adj(c) * donate_m2

cur_litt%bg_cwd(c,ilyr) = cur_litt%bg_cwd(c,ilyr) + &
bg_wood * currentSite%rootfrac_scr(ilyr) * &
SF_val_CWD_frac(c) * retain_m2
SF_val_CWD_frac_adj(c) * retain_m2
end do


! Diagnostics on fluxes into the AG and BG CWD pools
flux_diags%cwd_ag_input(c) = flux_diags%cwd_ag_input(c) + &
SF_val_CWD_frac(c) * ag_wood
SF_val_CWD_frac_adj(c) * ag_wood

flux_diags%cwd_bg_input(c) = flux_diags%cwd_bg_input(c) + &
SF_val_CWD_frac(c) * bg_wood
SF_val_CWD_frac_adj(c) * bg_wood

! Diagnostic specific to resource management code
if( element_id .eq. carbon12_element) then
delta_litter_stock = delta_litter_stock + &
(ag_wood + bg_wood) * SF_val_CWD_frac(c)
(ag_wood + bg_wood) * SF_val_CWD_frac_adj(c)
end if

enddo
Expand All @@ -915,39 +919,39 @@ subroutine logging_litter_fluxes(currentSite, currentPatch, newPatch, patch_site
(1._r8 - prt_params%allom_agb_frac(currentCohort%pft))

new_litt%ag_cwd(ncwd) = new_litt%ag_cwd(ncwd) + ag_wood * &
SF_val_CWD_frac(ncwd) * donate_m2
SF_val_CWD_frac_adj(ncwd) * donate_m2

cur_litt%ag_cwd(ncwd) = cur_litt%ag_cwd(ncwd) + ag_wood * &
SF_val_CWD_frac(ncwd) * retain_m2
SF_val_CWD_frac_adj(ncwd) * retain_m2

do ilyr = 1,nlevsoil

new_litt%bg_cwd(ncwd,ilyr) = new_litt%bg_cwd(ncwd,ilyr) + &
bg_wood * currentSite%rootfrac_scr(ilyr) * &
SF_val_CWD_frac(ncwd) * donate_m2
SF_val_CWD_frac_adj(ncwd) * donate_m2

cur_litt%bg_cwd(ncwd,ilyr) = cur_litt%bg_cwd(ncwd,ilyr) + &
bg_wood * currentSite%rootfrac_scr(ilyr) * &
SF_val_CWD_frac(ncwd) * retain_m2
SF_val_CWD_frac_adj(ncwd) * retain_m2

end do

flux_diags%cwd_ag_input(ncwd) = flux_diags%cwd_ag_input(ncwd) + &
SF_val_CWD_frac(ncwd) * ag_wood
SF_val_CWD_frac_adj(ncwd) * ag_wood

flux_diags%cwd_bg_input(ncwd) = flux_diags%cwd_bg_input(ncwd) + &
SF_val_CWD_frac(ncwd) * bg_wood
SF_val_CWD_frac_adj(ncwd) * bg_wood

if( element_id .eq. carbon12_element) then
delta_litter_stock = delta_litter_stock + &
(ag_wood+bg_wood) * SF_val_CWD_frac(ncwd)
(ag_wood+bg_wood) * SF_val_CWD_frac_adj(ncwd)
end if

! ---------------------------------------------------------------------------------------
! Handle below-ground trunk flux for directly logged trees (c = ncwd)
! ----------------------------------------------------------------------------------------

bg_wood = direct_dead * (struct_m + sapw_m ) * SF_val_CWD_frac(ncwd) * &
bg_wood = direct_dead * (struct_m + sapw_m ) * SF_val_CWD_frac_adj(ncwd) * &
(1._r8 - prt_params%allom_agb_frac(currentCohort%pft))

do ilyr = 1,nlevsoil
Expand All @@ -974,7 +978,7 @@ subroutine logging_litter_fluxes(currentSite, currentPatch, newPatch, patch_site

ag_wood = direct_dead * (struct_m + sapw_m ) * &
prt_params%allom_agb_frac(currentCohort%pft) * &
SF_val_CWD_frac(ncwd)
SF_val_CWD_frac_adj(ncwd)

trunk_product_site = trunk_product_site + &
ag_wood * logging_export_frac
Expand Down
46 changes: 30 additions & 16 deletions biogeochem/EDPatchDynamicsMod.F90
Original file line number Diff line number Diff line change
Expand Up @@ -16,6 +16,7 @@ module EDPatchDynamicsMod
use FatesLitterMod , only : ncwd
use FatesLitterMod , only : ndcmpy
use FatesLitterMod , only : litter_type
use FatesLitterMod , only : adjust_SF_CWD_frac
use EDTypesMod , only : homogenize_seed_pfts
use EDTypesMod , only : n_dbh_bins, area, patchfusion_dbhbin_loweredges
use EDtypesMod , only : force_patchfuse_min_biomass
Expand Down Expand Up @@ -760,14 +761,13 @@ subroutine spawn_patches( currentSite, bc_in)
currentSite%imort_carbonflux(currentCohort%pft) = &
currentSite%imort_carbonflux(currentCohort%pft) + &
(nc%n * ED_val_understorey_death / hlm_freq_day ) * &
total_c * g_per_kg * days_per_sec * years_per_day * ha_per_m2
total_c * days_per_sec * years_per_day * ha_per_m2

currentSite%imort_abg_flux(currentCohort%size_class, currentCohort%pft) = &
currentSite%imort_abg_flux(currentCohort%size_class, currentCohort%pft) + &
(nc%n * ED_val_understorey_death / hlm_freq_day ) * &
( (sapw_c + struct_c + store_c) * prt_params%allom_agb_frac(currentCohort%pft) + &
leaf_c ) * &
g_per_kg * days_per_sec * years_per_day * ha_per_m2
leaf_c ) * days_per_sec * years_per_day * ha_per_m2


! Step 2: Apply survivor ship function based on the understory death fraction
Expand Down Expand Up @@ -1020,7 +1020,14 @@ subroutine spawn_patches( currentSite, bc_in)
currentSite%imort_carbonflux(currentCohort%pft) + &
(nc%n * currentPatch%fract_ldist_not_harvested * &
logging_coll_under_frac/ hlm_freq_day ) * &
total_c * g_per_kg * days_per_sec * years_per_day * ha_per_m2
total_c * days_per_sec * years_per_day * ha_per_m2

currentSite%imort_abg_flux(currentCohort%size_class, currentCohort%pft) = &
currentSite%imort_abg_flux(currentCohort%size_class, currentCohort%pft) + &
(nc%n * currentPatch%fract_ldist_not_harvested * &
logging_coll_under_frac/ hlm_freq_day ) * &
( ( sapw_c + struct_c + store_c) * prt_params%allom_agb_frac(currentCohort%pft) + &
leaf_c ) * days_per_sec * years_per_day * ha_per_m2


! Step 2: Apply survivor ship function based on the understory death fraction
Expand Down Expand Up @@ -1659,7 +1666,7 @@ subroutine fire_litter_fluxes(currentSite, currentPatch, &
integer :: pft ! loop index for plant functional types
integer :: dcmpy ! loop index for decomposability pool
integer :: element_id ! parteh compatible global element index

real(r8) :: SF_val_CWD_frac_adj(4) !Updated wood partitioning to CWD based on dbh
!---------------------------------------------------------------------

! Only do this if there was a fire in this actual patch.
Expand Down Expand Up @@ -1792,9 +1799,13 @@ subroutine fire_litter_fluxes(currentSite, currentPatch, &
bcroot = (sapw_m + struct_m) * (1.0_r8 - prt_params%allom_agb_frac(pft) )

! below ground coarse woody debris from burned trees

!adjust the how wood is partitioned between the cwd classes based on cohort dbh
call adjust_SF_CWD_frac(currentCohort%dbh,ncwd,SF_val_CWD_frac,SF_val_CWD_frac_adj)

do c = 1,ncwd
do sl = 1,currentSite%nlevsoil
donatable_mass = num_dead_trees * SF_val_CWD_frac(c) * &
donatable_mass = num_dead_trees * SF_val_CWD_frac_adj(c) * &
bcroot * currentSite%rootfrac_scr(sl)

new_litt%bg_cwd(c,sl) = new_litt%bg_cwd(c,sl) + &
Expand All @@ -1815,10 +1826,10 @@ subroutine fire_litter_fluxes(currentSite, currentPatch, &
! Above ground coarse woody debris from twigs and small branches
! a portion of this pool may burn
do c = 1,ncwd
donatable_mass = num_dead_trees * SF_val_CWD_frac(c) * bstem
donatable_mass = num_dead_trees * SF_val_CWD_frac_adj(c) * bstem
if (c == 1 .or. c == 2) then
donatable_mass = donatable_mass * (1.0_r8-currentCohort%fraction_crown_burned)
burned_mass = num_dead_trees * SF_val_CWD_frac(c) * bstem * &
burned_mass = num_dead_trees * SF_val_CWD_frac_adj(c) * bstem * &
currentCohort%fraction_crown_burned
site_mass%burn_flux_to_atm = site_mass%burn_flux_to_atm + burned_mass
endif
Expand Down Expand Up @@ -1891,7 +1902,8 @@ subroutine mortality_litter_fluxes(currentSite, currentPatch, &
integer :: el ! element loop index
integer :: sl ! soil layer index
integer :: element_id ! parteh compatible global element index
real(r8) :: dcmpy_frac ! decomposability fraction
real(r8) :: dcmpy_frac ! decomposability fraction
real(r8) :: SF_val_CWD_frac_adj(4) !Updated wood partitioning to CWD based on dbh
!---------------------------------------------------------------------

remainder_area = currentPatch%area - patch_site_areadis
Expand Down Expand Up @@ -1989,24 +2001,26 @@ subroutine mortality_litter_fluxes(currentSite, currentPatch, &
call set_root_fraction(currentSite%rootfrac_scr, pft, currentSite%zi_soil, &
bc_in%max_rooting_depth_index_col)

! Adjust how wood is partitioned between the cwd classes based on cohort dbh
call adjust_SF_CWD_frac(currentCohort%dbh,ncwd,SF_val_CWD_frac,SF_val_CWD_frac_adj)

do c=1,ncwd

! Transfer wood of dying trees to AG CWD pools
new_litt%ag_cwd(c) = new_litt%ag_cwd(c) + ag_wood * &
SF_val_CWD_frac(c) * donate_m2
SF_val_CWD_frac_adj(c) * donate_m2

curr_litt%ag_cwd(c) = curr_litt%ag_cwd(c) + ag_wood * &
SF_val_CWD_frac(c) * retain_m2
SF_val_CWD_frac_adj(c) * retain_m2

! Transfer wood of dying trees to BG CWD pools
do sl = 1,currentSite%nlevsoil
new_litt%bg_cwd(c,sl) = new_litt%bg_cwd(c,sl) + bg_wood * &
currentSite%rootfrac_scr(sl) * SF_val_CWD_frac(c) * &
currentSite%rootfrac_scr(sl) * SF_val_CWD_frac_adj(c) * &
donate_m2

curr_litt%bg_cwd(c,sl) = curr_litt%bg_cwd(c,sl) + bg_wood * &
currentSite%rootfrac_scr(sl) * SF_val_CWD_frac(c) * &
currentSite%rootfrac_scr(sl) * SF_val_CWD_frac_adj(c) * &
retain_m2
end do
end do
Expand Down Expand Up @@ -2042,10 +2056,10 @@ subroutine mortality_litter_fluxes(currentSite, currentPatch, &
! track diagnostic fluxes
do c=1,ncwd
flux_diags%cwd_ag_input(c) = &
flux_diags%cwd_ag_input(c) + SF_val_CWD_frac(c) * ag_wood
flux_diags%cwd_ag_input(c) + SF_val_CWD_frac_adj(c) * ag_wood

flux_diags%cwd_bg_input(c) = &
flux_diags%cwd_bg_input(c) + SF_val_CWD_frac(c) * bg_wood
flux_diags%cwd_bg_input(c) + SF_val_CWD_frac_adj(c) * bg_wood
end do

flux_diags%leaf_litter_input(pft) = flux_diags%leaf_litter_input(pft) + &
Expand Down
Loading

0 comments on commit a1f3dc5

Please sign in to comment.