Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Update DemoteFromLayer to use terminate cohorts #829

Merged
merged 4 commits into from
Feb 28, 2022
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
18 changes: 5 additions & 13 deletions biogeochem/EDCanopyStructureMod.F90
Original file line number Diff line number Diff line change
Expand Up @@ -14,10 +14,9 @@ module EDCanopyStructureMod
use EDPftvarcon , only : EDPftvarcon_inst
use PRTParametersMod , only : prt_params
use FatesAllometryMod , only : carea_allom
use EDCohortDynamicsMod , only : copy_cohort, terminate_cohorts, fuse_cohorts
use EDCohortDynamicsMod , only : copy_cohort, terminate_cohorts, terminate_cohort, fuse_cohorts
use EDCohortDynamicsMod , only : InitPRTObject
use EDCohortDynamicsMod , only : InitPRTBoundaryConditions
use EDCohortDynamicsMod , only : SendCohortToLitter
use FatesAllometryMod , only : tree_lai
use FatesAllometryMod , only : tree_sai
use EDtypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type
Expand Down Expand Up @@ -718,22 +717,15 @@ subroutine DemoteFromLayer(currentSite,currentPatch,i_lyr,bc_in)
end if

! kill the ones which go into canopy layers that are not allowed

if(currentCohort%canopy_layer>nclmax )then

! put the litter from the terminated cohorts
! straight into the fragmenting pools
call SendCohortToLitter(currentSite,currentPatch, &
currentCohort,currentCohort%n,bc_in)

currentCohort%n = 0.0_r8
currentCohort%c_area = 0.0_r8
currentCohort%canopy_layer = i_lyr

end if

call terminate_cohort(currentSite,currentPatch,currentCohort,bc_in)
deallocate(currentCohort)
else
call carea_allom(currentCohort%dbh,currentCohort%n, &
currentSite%spread,currentCohort%pft,currentCohort%c_area)
end if

endif !canopy layer = i_ly

Expand Down
152 changes: 94 additions & 58 deletions biogeochem/EDCohortDynamicsMod.F90
Original file line number Diff line number Diff line change
Expand Up @@ -113,6 +113,7 @@ module EDCohortDynamicsMod
public :: zero_cohort
public :: nan_cohort
public :: terminate_cohorts
public :: terminate_cohort
public :: fuse_cohorts
public :: insert_cohort
public :: sort_cohorts
Expand Down Expand Up @@ -713,10 +714,9 @@ end subroutine zero_cohort
subroutine terminate_cohorts( currentSite, currentPatch, level , call_index, bc_in)
!
! !DESCRIPTION:
! terminates cohorts when they get too small
! terminates all cohorts when they get too small
!
! !USES:

!
! !ARGUMENTS
type (ed_site_type) , intent(inout), target :: currentSite
Expand Down Expand Up @@ -746,8 +746,6 @@ subroutine terminate_cohorts( currentSite, currentPatch, level , call_index, bc_
real(r8) :: repro_c ! reproductive carbon [kg]
real(r8) :: struct_c ! structural carbon [kg]
integer :: terminate ! do we terminate (itrue) or not (ifalse)
integer :: c ! counter for litter size class.
integer :: levcan ! canopy level
!----------------------------------------------------------------------

currentCohort => currentPatch%shortest
Expand Down Expand Up @@ -814,64 +812,102 @@ subroutine terminate_cohorts( currentSite, currentPatch, level , call_index, bc_
endif ! if (.not.currentCohort%isnew .and. level == 2) then

if (terminate == itrue) then

! preserve a record of the to-be-terminated cohort for mortality accounting
levcan = currentCohort%canopy_layer

if( hlm_use_planthydro == itrue ) &
call AccumulateMortalityWaterStorage(currentSite,currentCohort,currentCohort%n)

if(levcan==ican_upper) then
currentSite%term_nindivs_canopy(currentCohort%size_class,currentCohort%pft) = &
currentSite%term_nindivs_canopy(currentCohort%size_class,currentCohort%pft) + currentCohort%n

currentSite%term_carbonflux_canopy = currentSite%term_carbonflux_canopy + &
currentCohort%n * (struct_c+sapw_c+leaf_c+fnrt_c+store_c+repro_c)
else
currentSite%term_nindivs_ustory(currentCohort%size_class,currentCohort%pft) = &
currentSite%term_nindivs_ustory(currentCohort%size_class,currentCohort%pft) + currentCohort%n

currentSite%term_carbonflux_ustory = currentSite%term_carbonflux_ustory + &
currentCohort%n * (struct_c+sapw_c+leaf_c+fnrt_c+store_c+repro_c)
end if

! put the litter from the terminated cohorts
! straight into the fragmenting pools

if (currentCohort%n.gt.0.0_r8) then
call SendCohortToLitter(currentSite,currentPatch, &
currentCohort,currentCohort%n,bc_in)
end if

! Set pointers and remove the current cohort from the list
shorterCohort => currentCohort%shorter

if (.not. associated(tallerCohort)) then
currentPatch%tallest => shorterCohort
if(associated(shorterCohort)) shorterCohort%taller => null()
else
tallerCohort%shorter => shorterCohort

endif

if (.not. associated(shorterCohort)) then
currentPatch%shortest => tallerCohort
if(associated(tallerCohort)) tallerCohort%shorter => null()
else
shorterCohort%taller => tallerCohort
endif


call DeallocateCohort(currentCohort)
deallocate(currentCohort)
nullify(currentCohort)

endif
currentCohort => tallerCohort
call terminate_cohort(currentSite, currentPatch, currentCohort, bc_in)
deallocate(currentCohort)
endif
currentCohort => tallerCohort
enddo

end subroutine terminate_cohorts

!-------------------------------------------------------------------------------------!
subroutine terminate_cohort(currentSite, currentPatch, currentCohort, bc_in)
!
! !DESCRIPTION:
! Terminates an individual cohort and updates the site-level
! updates the carbon flux and nuber of individuals appropriately
!
! !USES:
!
! !ARGUMENTS
type (ed_site_type) , intent(inout), target :: currentSite
type (ed_patch_type) , intent(inout), target :: currentPatch
type (ed_cohort_type), intent(inout), target :: currentCohort
type(bc_in_type), intent(in) :: bc_in

! !LOCAL VARIABLES:
type (ed_cohort_type) , pointer :: shorterCohort
type (ed_cohort_type) , pointer :: tallerCohort

real(r8) :: leaf_c ! leaf carbon [kg]
real(r8) :: store_c ! storage carbon [kg]
real(r8) :: sapw_c ! sapwood carbon [kg]
real(r8) :: fnrt_c ! fineroot carbon [kg]
real(r8) :: repro_c ! reproductive carbon [kg]
real(r8) :: struct_c ! structural carbon [kg]
integer :: terminate ! do we terminate (itrue) or not (ifalse)
integer :: c ! counter for litter size class.
integer :: levcan ! canopy level
!----------------------------------------------------------------------

leaf_c = currentCohort%prt%GetState(leaf_organ, carbon12_element)
store_c = currentCohort%prt%GetState(store_organ, carbon12_element)
sapw_c = currentCohort%prt%GetState(sapw_organ, carbon12_element)
fnrt_c = currentCohort%prt%GetState(fnrt_organ, carbon12_element)
struct_c = currentCohort%prt%GetState(struct_organ, carbon12_element)
repro_c = currentCohort%prt%GetState(repro_organ, carbon12_element)

! preserve a record of the to-be-terminated cohort for mortality accounting
levcan = currentCohort%canopy_layer

if( hlm_use_planthydro == itrue ) &
call AccumulateMortalityWaterStorage(currentSite,currentCohort,currentCohort%n)

! Update the site-level carbon flux and individuals count for the appropriate canopy layer
if(levcan==ican_upper) then
currentSite%term_nindivs_canopy(currentCohort%size_class,currentCohort%pft) = &
currentSite%term_nindivs_canopy(currentCohort%size_class,currentCohort%pft) + currentCohort%n

currentSite%term_carbonflux_canopy = currentSite%term_carbonflux_canopy + &
currentCohort%n * (struct_c+sapw_c+leaf_c+fnrt_c+store_c+repro_c)
else
currentSite%term_nindivs_ustory(currentCohort%size_class,currentCohort%pft) = &
currentSite%term_nindivs_ustory(currentCohort%size_class,currentCohort%pft) + currentCohort%n

currentSite%term_carbonflux_ustory = currentSite%term_carbonflux_ustory + &
currentCohort%n * (struct_c+sapw_c+leaf_c+fnrt_c+store_c+repro_c)
end if

! put the litter from the terminated cohorts
! straight into the fragmenting pools

if (currentCohort%n.gt.0.0_r8) then
call SendCohortToLitter(currentSite,currentPatch, &
currentCohort,currentCohort%n,bc_in)
end if

! Set pointers and deallocate the current cohort from the list
shorterCohort => currentCohort%shorter
tallerCohort => currentCohort%taller

if (.not. associated(tallerCohort)) then
currentPatch%tallest => shorterCohort
if(associated(shorterCohort)) shorterCohort%taller => null()
else
tallerCohort%shorter => shorterCohort
endif

if (.not. associated(shorterCohort)) then
currentPatch%shortest => tallerCohort
if(associated(tallerCohort)) tallerCohort%shorter => null()
else
shorterCohort%taller => tallerCohort
endif

call DeallocateCohort(currentCohort)

end subroutine terminate_cohort

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

subroutine SendCohortToLitter(csite,cpatch,ccohort,nplant,bc_in)
Expand Down