Skip to content

Commit

Permalink
Merge remote-tracking branch 'jfneedham_repo/JFN-nocomp-init-large-si…
Browse files Browse the repository at this point in the history 
…zes' into JFN-nocomp-init-large-sizes
  • Loading branch information
Jessica F Needham committed Mar 23, 2023
2 parents e50b27b + df7dd3f commit 7ebb166
Show file tree
Hide file tree
Showing 24 changed files with 5,316 additions and 240 deletions.
3 changes: 3 additions & 0 deletions biogeochem/EDCohortDynamicsMod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -612,6 +612,7 @@ subroutine nan_cohort(cc_p)
!RESPIRATION
currentCohort%rdark = nan
currentCohort%resp_m = nan ! Maintenance respiration. kGC/cohort/year
currentCohort%resp_m_unreduced = nan ! Diagnostic-only unreduced Maintenance respiration. kGC/cohort/year
currentCohort%resp_excess = nan ! Respiration of excess (unallocatable) carbon (kg/indiv/day)
currentCohort%livestem_mr = nan ! Live stem maintenance respiration. kgC/indiv/s-1
currentCohort%livecroot_mr = nan ! Coarse root maintenance respiration. kgC/indiv/s-1
Expand Down Expand Up @@ -669,6 +670,7 @@ subroutine zero_cohort(cc_p)
currentCohort%status_coh = 0
currentCohort%rdark = 0._r8
currentCohort%resp_m = 0._r8
currentCohort%resp_m_unreduced = 0._r8
currentCohort%resp_excess = 0._r8
currentCohort%resp_g_tstep = 0._r8
currentCohort%livestem_mr = 0._r8
Expand Down Expand Up @@ -1941,6 +1943,7 @@ subroutine copy_cohort( currentCohort,copyc )
!RESPIRATION
n%rdark = o%rdark
n%resp_m = o%resp_m
n%resp_m_unreduced= o%resp_m_unreduced
n%resp_excess = o%resp_excess
n%resp_g_tstep = o%resp_g_tstep
n%livestem_mr = o%livestem_mr
Expand Down
123 changes: 67 additions & 56 deletions biogeochem/EDLoggingMortalityMod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -191,6 +191,7 @@ subroutine IsItLoggingTime(is_master,currentSite)
return
end subroutine IsItLoggingTime


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

subroutine LoggingMortality_frac( pft_i, dbh, canopy_layer, lmort_direct, &
Expand Down Expand Up @@ -343,6 +344,7 @@ subroutine LoggingMortality_frac( pft_i, dbh, canopy_layer, lmort_direct, &

end subroutine LoggingMortality_frac


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

subroutine get_harvest_rate_area (patch_anthro_disturbance_label, hlm_harvest_catnames, hlm_harvest_rates, &
Expand Down Expand Up @@ -421,13 +423,14 @@ subroutine get_harvest_rate_area (patch_anthro_disturbance_label, hlm_harvest_ca
harvest_rate = harvest_rate / hlm_days_per_year
else if(icode .eq. 4) then
! logging event once a month
if(hlm_current_day.eq.1 ) then
if(hlm_current_day.eq.1) then
harvest_rate = harvest_rate / months_per_year
end if
end if

end subroutine get_harvest_rate_area


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

subroutine get_harvestable_carbon (csite, site_area, hlm_harvest_catnames, harvestable_forest_c )
Expand Down Expand Up @@ -710,12 +713,13 @@ subroutine logging_litter_fluxes(currentSite, currentPatch, newPatch, patch_site


!USES:
use SFParamsMod, only : SF_val_cwd_frac
use EDtypesMod, only : area
use EDtypesMod, only : ed_site_type
use EDtypesMod, only : ed_patch_type
use EDtypesMod, only : ed_cohort_type
use FatesAllometryMod , only : carea_allom
use SFParamsMod, only : SF_val_cwd_frac
use EDtypesMod, only : area
use EDtypesMod, only : ed_site_type
use EDtypesMod, only : ed_patch_type
use EDtypesMod, only : ed_cohort_type
use FatesConstantsMod, only : rsnbl_math_prec
use FatesAllometryMod, only : carea_allom


! !ARGUMENTS:
Expand All @@ -733,34 +737,35 @@ subroutine logging_litter_fluxes(currentSite, currentPatch, newPatch, patch_site
type(litter_type),pointer :: new_litt
type(litter_type),pointer :: cur_litt

real(r8) :: direct_dead ! Mortality count through direct logging
real(r8) :: indirect_dead ! Mortality count through: impacts, infrastructure and collateral damage
real(r8) :: trunk_product_site ! flux of carbon in trunk products exported off site [ kgC/site ]
! (note we are accumulating over the patch, but scale is site level)
real(r8) :: delta_litter_stock ! flux of carbon in total litter flux [ kgC/site ]
real(r8) :: delta_biomass_stock ! total flux of carbon through mortality (litter+product) [ kgC/site ]
real(r8) :: delta_individual ! change in plant number through mortality [ plants/site ]
real(r8) :: leaf_litter ! Leafy biomass transferred through mortality [kgC/site]
real(r8) :: root_litter ! Rooty + storage biomass transferred through mort [kgC/site]
real(r8) :: ag_wood ! above ground wood mass [kg]
real(r8) :: bg_wood ! below ground wood mass [kg]
real(r8) :: remainder_area ! current patch's remaining area after donation [m2]
real(r8) :: leaf_m ! leaf element mass [kg]
real(r8) :: fnrt_m ! fineroot element mass [kg]
real(r8) :: sapw_m ! sapwood element mass [kg]
real(r8) :: store_m ! storage element mass [kg]
real(r8) :: struct_m ! structure element mass [kg]
real(r8) :: repro_m ! reproductive mass [kg]
real(r8) :: retain_frac ! fraction of litter retained in the donor patch
real(r8) :: donate_frac ! fraction of litter sent to newly formed patch
real(r8) :: dcmpy_frac ! fraction going into each decomposability pool
integer :: dcmpy ! index for decomposability pools
integer :: element_id ! parteh global element index
integer :: pft ! pft index
integer :: c ! cwd index
integer :: nlevsoil ! number of soil layers
integer :: ilyr ! soil layer loop index
integer :: el ! elemend loop index
real(r8) :: direct_dead ! Mortality count through direct logging
real(r8) :: indirect_dead ! Mortality count through: impacts, infrastructure and collateral damage
real(r8) :: trunk_product_site ! flux of carbon in trunk products exported off site [ kgC/site ]
! (note we are accumulating over the patch, but scale is site level)
real(r8) :: delta_litter_stock ! flux of carbon in total litter flux [ kgC/site ]
real(r8) :: delta_biomass_stock ! total flux of carbon through mortality (litter+product) [ kgC/site ]
real(r8) :: delta_individual ! change in plant number through mortality [ plants/site ]
real(r8) :: leaf_litter ! Leafy biomass transferred through mortality [kgC/site]
real(r8) :: root_litter ! Rooty + storage biomass transferred through mort [kgC/site]
real(r8) :: ag_wood ! above ground wood mass [kg]
real(r8) :: bg_wood ! below ground wood mass [kg]
real(r8) :: remainder_area ! current patch's remaining area after donation [m2]
real(r8) :: leaf_m ! leaf element mass [kg]
real(r8) :: fnrt_m ! fineroot element mass [kg]
real(r8) :: sapw_m ! sapwood element mass [kg]
real(r8) :: store_m ! storage element mass [kg]
real(r8) :: struct_m ! structure element mass [kg]
real(r8) :: repro_m ! reproductive mass [kg]
real(r8) :: retain_frac ! fraction of litter retained in the donor patch
real(r8) :: retain_m2 ! area normalization for litter mass destined to old patch [m-2]
real(r8) :: donate_m2 ! area normalization for litter mass destined to new patch [m-2]
real(r8) :: dcmpy_frac ! fraction going into each decomposability pool
integer :: dcmpy ! index for decomposability pools
integer :: element_id ! parteh global element index
integer :: pft ! pft index
integer :: c ! cwd index
integer :: nlevsoil ! number of soil layers
integer :: ilyr ! soil layer loop index
integer :: el ! elemend loop index


nlevsoil = currentSite%nlevsoil
Expand All @@ -769,17 +774,22 @@ subroutine logging_litter_fluxes(currentSite, currentPatch, newPatch, patch_site
! mass sent to that patch, by the area it will have remaining
! after it donates area.
! i.e. subtract the area it is donating.

remainder_area = currentPatch%area - patch_site_areadis


! Calculate the fraction of litter to be retained versus donated
! vis-a-vis the new and donor patch

retain_frac = (1.0_r8-harvest_litter_localization) * &
remainder_area/(newPatch%area+remainder_area)
donate_frac = 1.0_r8-retain_frac

if(remainder_area > rsnbl_math_prec) then
retain_m2 = retain_frac/remainder_area
donate_m2 = (1.0_r8-retain_frac)/newPatch%area
else
retain_m2 = 0._r8
donate_m2 = 1._r8/newPatch%area
end if


do el = 1,num_elements

element_id = element_list(el)
Expand All @@ -788,13 +798,13 @@ subroutine logging_litter_fluxes(currentSite, currentPatch, newPatch, patch_site
cur_litt => currentPatch%litter(el) ! Litter pool of "current" patch
new_litt => newPatch%litter(el) ! Litter pool of "new" patch


! Zero some site level accumulator diagnsotics
trunk_product_site = 0.0_r8
delta_litter_stock = 0.0_r8
delta_biomass_stock = 0.0_r8
delta_individual = 0.0_r8


! -----------------------------------------------------------------------------
! Part 1: Send parts of dying plants to the litter pool.
! -----------------------------------------------------------------------------
Expand Down Expand Up @@ -864,19 +874,19 @@ subroutine logging_litter_fluxes(currentSite, currentPatch, newPatch, patch_site
do c = 1,ncwd-1

new_litt%ag_cwd(c) = new_litt%ag_cwd(c) + &
ag_wood * SF_val_CWD_frac(c) * donate_frac/newPatch%area
ag_wood * SF_val_CWD_frac(c) * donate_m2
cur_litt%ag_cwd(c) = cur_litt%ag_cwd(c) + &
ag_wood * SF_val_CWD_frac(c) * retain_frac/remainder_area
ag_wood * SF_val_CWD_frac(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_frac/newPatch%area
SF_val_CWD_frac(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_frac/remainder_area
SF_val_CWD_frac(c) * retain_m2
end do


Expand Down Expand Up @@ -905,20 +915,20 @@ 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_frac/newPatch%area
SF_val_CWD_frac(ncwd) * donate_m2

cur_litt%ag_cwd(ncwd) = cur_litt%ag_cwd(ncwd) + ag_wood * &
SF_val_CWD_frac(ncwd) * retain_frac/remainder_area
SF_val_CWD_frac(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_frac/newPatch%area
SF_val_CWD_frac(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_frac/remainder_area
SF_val_CWD_frac(ncwd) * retain_m2

end do

Expand All @@ -943,11 +953,11 @@ subroutine logging_litter_fluxes(currentSite, currentPatch, newPatch, patch_site
do ilyr = 1,nlevsoil
new_litt%bg_cwd(ncwd,ilyr) = new_litt%bg_cwd(ncwd,ilyr) + &
bg_wood * currentSite%rootfrac_scr(ilyr) * &
donate_frac/newPatch%area
donate_m2

cur_litt%bg_cwd(ncwd,ilyr) = cur_litt%bg_cwd(ncwd,ilyr) + &
bg_wood * currentSite%rootfrac_scr(ilyr) * &
retain_frac/remainder_area
retain_m2
end do

flux_diags%cwd_bg_input(ncwd) = flux_diags%cwd_bg_input(ncwd) + &
Expand All @@ -974,10 +984,10 @@ subroutine logging_litter_fluxes(currentSite, currentPatch, newPatch, patch_site
ag_wood * logging_export_frac

new_litt%ag_cwd(ncwd) = new_litt%ag_cwd(ncwd) + ag_wood * &
(1._r8-logging_export_frac)*donate_frac/newPatch%area
(1._r8-logging_export_frac)*donate_m2

cur_litt%ag_cwd(ncwd) = cur_litt%ag_cwd(ncwd) + ag_wood * &
(1._r8-logging_export_frac)*retain_frac/remainder_area
(1._r8-logging_export_frac)*retain_m2

! ---------------------------------------------------------------------------
! Handle fluxes of leaf, root and storage carbon into litter pools.
Expand All @@ -993,20 +1003,20 @@ subroutine logging_litter_fluxes(currentSite, currentPatch, newPatch, patch_site
dcmpy_frac = GetDecompyFrac(pft,leaf_organ,dcmpy)

new_litt%leaf_fines(dcmpy) = new_litt%leaf_fines(dcmpy) + &
leaf_litter * donate_frac/newPatch%area * dcmpy_frac
leaf_litter * donate_m2 * dcmpy_frac

cur_litt%leaf_fines(dcmpy) = cur_litt%leaf_fines(dcmpy) + &
leaf_litter * retain_frac/remainder_area * dcmpy_frac
leaf_litter * retain_m2 * dcmpy_frac

dcmpy_frac = GetDecompyFrac(pft,fnrt_organ,dcmpy)
do ilyr = 1,nlevsoil
new_litt%root_fines(dcmpy,ilyr) = new_litt%root_fines(dcmpy,ilyr) + &
root_litter * currentSite%rootfrac_scr(ilyr) * dcmpy_frac * &
donate_frac/newPatch%area
donate_m2

cur_litt%root_fines(dcmpy,ilyr) = cur_litt%root_fines(dcmpy,ilyr) + &
root_litter * currentSite%rootfrac_scr(ilyr) * dcmpy_frac * &
retain_frac/remainder_area
retain_m2
end do
end do

Expand Down Expand Up @@ -1078,6 +1088,7 @@ subroutine logging_litter_fluxes(currentSite, currentPatch, newPatch, patch_site
return
end subroutine logging_litter_fluxes


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

subroutine UpdateHarvestC(currentSite,bc_out)
Expand Down
11 changes: 10 additions & 1 deletion biogeochem/EDPatchDynamicsMod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -95,7 +95,7 @@ module EDPatchDynamicsMod
use EDParamsMod, only : maxpatch_primary
use EDParamsMod, only : maxpatch_secondary
use EDParamsMod, only : maxpatch_total
use FatesRunningMeanMod, only : ema_24hr, fixed_24hr, ema_lpa
use FatesRunningMeanMod, only : ema_24hr, fixed_24hr, ema_lpa, ema_longterm

! CIME globals
use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=)
Expand Down Expand Up @@ -657,6 +657,7 @@ subroutine spawn_patches( currentSite, bc_in)
! --------------------------------------------------------------------------
call new_patch%tveg24%CopyFromDonor(currentPatch%tveg24)
call new_patch%tveg_lpa%CopyFromDonor(currentPatch%tveg_lpa)
call new_patch%tveg_longterm%CopyFromDonor(currentPatch%tveg_longterm)


! --------------------------------------------------------------------------
Expand Down Expand Up @@ -2108,6 +2109,8 @@ subroutine create_patch(currentSite, new_patch, age, areap, label,nocomp_pft)
call new_patch%tveg24%InitRMean(fixed_24hr,init_value=temp_init_veg,init_offset=real(hlm_current_tod,r8) )
allocate(new_patch%tveg_lpa)
call new_patch%tveg_lpa%InitRmean(ema_lpa,init_value=temp_init_veg)
allocate(new_patch%tveg_longterm)
call new_patch%tveg_longterm%InitRmean(ema_longterm,init_value=temp_init_veg)

! Litter
! Allocate, Zero Fluxes, and Initialize to "unset" values
Expand Down Expand Up @@ -2679,6 +2682,7 @@ subroutine fuse_2_patches(csite, dp, rp)
! Weighted mean of the running means
call rp%tveg24%FuseRMean(dp%tveg24,rp%area*inv_sum_area)
call rp%tveg_lpa%FuseRMean(dp%tveg_lpa,rp%area*inv_sum_area)
call rp%tveg_longterm%FuseRMean(dp%tveg_longterm,rp%area*inv_sum_area)

rp%fuel_eff_moist = (dp%fuel_eff_moist*dp%area + rp%fuel_eff_moist*rp%area) * inv_sum_area
rp%livegrass = (dp%livegrass*dp%area + rp%livegrass*rp%area) * inv_sum_area
Expand Down Expand Up @@ -3071,6 +3075,11 @@ subroutine dealloc_patch(cpatch)
write(fates_log(),*) 'dealloc011: fail on deallocate(cpatch%tveg_lpa):'//trim(smsg)
call endrun(msg=errMsg(sourcefile, __LINE__))
endif
deallocate(cpatch%tveg_longterm, stat=istat, errmsg=smsg)
if (istat/=0) then
write(fates_log(),*) 'dealloc012: fail on deallocate(cpatch%tveg_longterm):'//trim(smsg)
call endrun(msg=errMsg(sourcefile, __LINE__))
endif

return
end subroutine dealloc_patch
Expand Down
4 changes: 2 additions & 2 deletions biogeochem/EDPhysiologyMod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1085,9 +1085,9 @@ subroutine phenology( currentSite, bc_in )
! and thus %nchilldays will never go from zero to 1. The following logic
! when coupled with this fact will essentially prevent cold-deciduous
! plants from re-emerging in areas without at least some cold days

if( (currentSite%cstatus == phen_cstat_notcold) .and. &
(dayssincecleafoff > 400)) then ! remove leaves after a whole year
(dayssincecleafoff > 400)) then ! remove leaves after a whole year,
! when there is no 'off' period.
currentSite%grow_deg_days = 0._r8

Expand Down
Loading

0 comments on commit 7ebb166

Please sign in to comment.