Skip to content

Commit

Permalink
Merge pull request #1021 from adamhb/regeneration
Browse files Browse the repository at this point in the history 
Environmentally sensitive tree recruitment
  • Loading branch information
@rgknox
rgknox authored Jul 21, 2023
2 parents 43d5e55 + d09b149 commit 3fcc9fc
Show file tree
Hide file tree
Showing 16 changed files with 820 additions and 122 deletions.
75 changes: 69 additions & 6 deletions biogeochem/EDPatchDynamicsMod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -54,6 +54,7 @@ module EDPatchDynamicsMod
use FatesConstantsMod , only : r8 => fates_r8
use FatesConstantsMod , only : itrue, ifalse
use FatesConstantsMod , only : t_water_freeze_k_1atm
use FatesConstantsMod , only : TRS_regeneration
use FatesPlantHydraulicsMod, only : InitHydrCohort
use FatesPlantHydraulicsMod, only : AccumulateMortalityWaterStorage
use FatesPlantHydraulicsMod, only : DeallocateHydrCohort
Expand All @@ -64,6 +65,7 @@ module EDPatchDynamicsMod
use EDLoggingMortalityMod, only : get_harvestable_carbon
use EDLoggingMortalityMod, only : get_harvest_debt
use EDParamsMod , only : fates_mortality_disturbance_fraction
use EDParamsMod , only : regeneration_model
use FatesAllometryMod , only : carea_allom
use FatesAllometryMod , only : set_root_fraction
use FatesConstantsMod , only : g_per_kg
Expand Down Expand Up @@ -93,6 +95,8 @@ module EDPatchDynamicsMod
use SFParamsMod, only : SF_VAL_CWD_FRAC
use EDParamsMod, only : logging_event_code
use EDParamsMod, only : logging_export_frac
use FatesRunningMeanMod, only : ema_sdlng_mdd
use FatesRunningMeanMod, only : ema_sdlng_emerg_h2o, ema_sdlng_mort_par, ema_sdlng2sap_par
use EDParamsMod, only : maxpatch_primary
use EDParamsMod, only : maxpatch_secondary
use EDParamsMod, only : maxpatch_total
Expand Down Expand Up @@ -428,6 +432,7 @@ subroutine spawn_patches( currentSite, bc_in)
real(r8) :: patch_site_areadis ! total area disturbed in m2 per patch per day
real(r8) :: age ! notional age of this patch in years
integer :: el ! element loop index
integer :: pft ! pft loop index
integer :: tnull ! is there a tallest cohort?
integer :: snull ! is there a shortest cohort?
integer :: levcan ! canopy level
Expand Down Expand Up @@ -596,7 +601,7 @@ subroutine spawn_patches( currentSite, bc_in)
patch_site_areadis = currentPatch%area * disturbance_rate


if ( patch_site_areadis > nearzero ) then
if ( patch_site_areadis > nearzero ) then

! figure out whether the receiver patch for disturbance from this patch
! will be primary or secondary land receiver patch is primary forest
Expand Down Expand Up @@ -658,9 +663,19 @@ 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)

if ( regeneration_model == TRS_regeneration ) then
call new_patch%seedling_layer_par24%CopyFromDonor(currentPatch%seedling_layer_par24)
call new_patch%sdlng_mort_par%CopyFromDonor(currentPatch%sdlng_mort_par)
call new_patch%sdlng2sap_par%CopyFromDonor(currentPatch%sdlng2sap_par)
do pft = 1,numpft
call new_patch%sdlng_emerg_smp(pft)%p%CopyFromDonor(currentPatch%sdlng_emerg_smp(pft)%p)
call new_patch%sdlng_mdd(pft)%p%CopyFromDonor(currentPatch%sdlng_mdd(pft)%p)
enddo
end if

call new_patch%tveg_longterm%CopyFromDonor(currentPatch%tveg_longterm)

! --------------------------------------------------------------------------
! The newly formed patch from disturbance (new_patch), has now been given
! some litter from dead plants and pre-existing litter from the donor patches.
Expand Down Expand Up @@ -2103,6 +2118,11 @@ subroutine create_patch(currentSite, new_patch, age, areap, label,nocomp_pft)
! Until bc's are pointed to by sites give veg a default temp [K]
real(r8), parameter :: temp_init_veg = 15._r8+t_water_freeze_k_1atm

real(r8), parameter :: init_seedling_par = 5.0_r8 !arbitrary initialization for
!seedling layer PAR [MJ m-2 d-1]

real(r8), parameter :: init_seedling_smp = -26652.0_r8 !arbitrary initialization of smp [mm]
integer :: pft !pft index

! !LOCAL VARIABLES:
!---------------------------------------------------------------------
Expand All @@ -2123,9 +2143,30 @@ 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)


if ( regeneration_model == TRS_regeneration ) then
allocate(new_patch%seedling_layer_par24)
call new_patch%seedling_layer_par24%InitRMean(fixed_24hr,init_value=init_seedling_par, init_offset=real(hlm_current_tod,r8))
allocate(new_patch%sdlng_mort_par)
call new_patch%sdlng_mort_par%InitRMean(ema_sdlng_mort_par,init_value=temp_init_veg)
allocate(new_patch%sdlng2sap_par)
call new_patch%sdlng2sap_par%InitRMean(ema_sdlng2sap_par,init_value=init_seedling_par)
allocate(new_patch%sdlng_mdd(numpft))
allocate(new_patch%sdlng_emerg_smp(numpft))
do pft = 1,numpft
allocate(new_patch%sdlng_mdd(pft)%p)
call new_patch%sdlng_mdd(pft)%p%InitRMean(ema_sdlng_mdd, init_value=0.0_r8)
allocate(new_patch%sdlng_emerg_smp(pft)%p)
call new_patch%sdlng_emerg_smp(pft)%p%InitRMean(ema_sdlng_emerg_h2o,init_value=init_seedling_smp)
enddo
end if


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 @@ -2658,7 +2699,7 @@ subroutine fuse_2_patches(csite, dp, rp)
type (ed_cohort_type), pointer :: nextc ! Remembers next cohort in list
type (ed_cohort_type), pointer :: storesmallcohort
type (ed_cohort_type), pointer :: storebigcohort
integer :: c,p !counters for pft and litter size class.
integer :: c,p,pft ! counters for pft and litter size class
integer :: tnull,snull ! are the tallest and shortest cohorts associated?
integer :: el ! loop counting index for elements
type(ed_patch_type), pointer :: youngerp ! pointer to the patch younger than donor
Expand Down Expand Up @@ -2696,8 +2737,19 @@ 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)

if ( regeneration_model == TRS_regeneration ) then
call rp%seedling_layer_par24%FuseRMean(dp%seedling_layer_par24,rp%area*inv_sum_area)
call rp%sdlng_mort_par%FuseRMean(dp%sdlng_mort_par,rp%area*inv_sum_area)
call rp%sdlng2sap_par%FuseRMean(dp%sdlng2sap_par,rp%area*inv_sum_area)
do pft = 1,numpft
call rp%sdlng_emerg_smp(pft)%p%FuseRMean(dp%sdlng_emerg_smp(pft)%p,rp%area*inv_sum_area)
call rp%sdlng_mdd(pft)%p%FuseRMean(dp%sdlng_mdd(pft)%p,rp%area*inv_sum_area)
enddo
end if

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
rp%sum_fuel = (dp%sum_fuel*dp%area + rp%sum_fuel*rp%area) * inv_sum_area
Expand Down Expand Up @@ -3033,7 +3085,7 @@ subroutine dealloc_patch(cpatch)

type(ed_cohort_type), pointer :: ccohort ! current
type(ed_cohort_type), pointer :: ncohort ! next
integer :: el ! loop counter for elements
integer :: el,pft ! loop counter for elements and pfts

! First Deallocate the cohort space
! -----------------------------------------------------------------------------------
Expand Down Expand Up @@ -3079,6 +3131,18 @@ subroutine dealloc_patch(cpatch)
endif

! Deallocate any running means
if ( regeneration_model == TRS_regeneration ) then
deallocate(cpatch%seedling_layer_par24)
deallocate(cpatch%sdlng_mort_par)
deallocate(cpatch%sdlng2sap_par)
do pft = 1, numpft
deallocate(cpatch%sdlng_mdd(pft)%p)
deallocate(cpatch%sdlng_emerg_smp(pft)%p)
enddo
deallocate(cpatch%sdlng_mdd)
deallocate(cpatch%sdlng_emerg_smp)
end if

deallocate(cpatch%tveg24, stat=istat, errmsg=smsg)
if (istat/=0) then
write(fates_log(),*) 'dealloc010: fail on deallocate(cpatch%tveg24):'//trim(smsg)
Expand All @@ -3094,7 +3158,6 @@ subroutine dealloc_patch(cpatch)
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
Loading

0 comments on commit 3fcc9fc

Please sign in to comment.