Skip to content

Commit

Permalink
Merge pull request #1 from rgknox/carbon-alloc-sci1.55.2
Browse files Browse the repository at this point in the history 
Carbon alloc sci1.55.2
  • Loading branch information
@mpaiao
mpaiao authored Mar 7, 2022
2 parents 079fc12 + eba3bb0 commit 3cef215
Show file tree
Hide file tree
Showing 22 changed files with 2,573 additions and 970 deletions.
22 changes: 7 additions & 15 deletions biogeochem/EDCanopyStructureMod.F90
View file
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 Expand Up @@ -1237,7 +1229,7 @@ subroutine canopy_spread( currentSite )
do while (associated(currentCohort))
call carea_allom(currentCohort%dbh,currentCohort%n, &
currentSite%spread,currentCohort%pft,currentCohort%c_area)
if( ( int(prt_params%woody(currentCohort%pft)) .eq. itrue ) .and. &
if( (prt_params%woody(currentCohort%pft) .eq. itrue ) .and. &
(currentCohort%canopy_layer .eq. 1 ) ) then
sitelevel_canopyarea = sitelevel_canopyarea + currentCohort%c_area
endif
Expand Down Expand Up @@ -1348,7 +1340,7 @@ subroutine canopy_summarization( nsites, sites, bc_in )

if(currentCohort%canopy_layer==1)then
currentPatch%total_canopy_area = currentPatch%total_canopy_area + currentCohort%c_area
if( int(prt_params%woody(ft))==itrue)then
if( prt_params%woody(ft)==itrue)then
currentPatch%total_tree_area = currentPatch%total_tree_area + currentCohort%c_area
endif
endif
Expand Down
158 changes: 97 additions & 61 deletions biogeochem/EDCohortDynamicsMod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -115,6 +115,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 @@ -721,10 +722,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 @@ -754,8 +754,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 @@ -822,64 +820,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 Expand Up @@ -2003,7 +2039,7 @@ subroutine UpdateCohortBioPhysRates(currentCohort)

ipft = currentCohort%pft

if(sum(frac_leaf_aclass(1:nleafage))>nearzero) then
if(sum(frac_leaf_aclass(1:nleafage))>nearzero .and. hlm_use_sp .eq. ifalse) then


frac_leaf_aclass(1:nleafage) = frac_leaf_aclass(1:nleafage) / &
Expand All @@ -2021,7 +2057,7 @@ subroutine UpdateCohortBioPhysRates(currentCohort)
currentCohort%kp25top = sum(param_derived%kp25top(ipft,1:nleafage) * &
frac_leaf_aclass(1:nleafage))

elseif (hlm_use_sp .eq. itrue .and. hlm_is_restart .eq. itrue) then
elseif (hlm_use_sp .eq. itrue) then

currentCohort%vcmax25top = EDPftvarcon_inst%vcmax25top(ipft,1)
currentCohort%jmax25top = param_derived%jmax25top(ipft,1)
Expand Down Expand Up @@ -2079,7 +2115,7 @@ subroutine EvaluateAndCorrectDBH(currentCohort,delta_dbh,delta_hite)
delta_dbh = 0._r8
delta_hite = 0._r8

if( int(prt_params%woody(currentCohort%pft)) == itrue) then
if( prt_params%woody(currentCohort%pft) == itrue) then

struct_c = currentCohort%prt%GetState(struct_organ, all_carbon_elements)

Expand Down
4 changes: 2 additions & 2 deletions biogeochem/EDLoggingMortalityMod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -258,7 +258,7 @@ subroutine LoggingMortality_frac( pft_i, dbh, canopy_layer, lmort_direct, &

! transfer of area to secondary land is based on overall area affected, not just logged crown area
! l_degrad accounts for the affected area between logged crowns
if(int(prt_params%woody(pft_i)) == 1)then ! only set logging rates for trees
if(prt_params%woody(pft_i) == 1)then ! only set logging rates for trees

! direct logging rates, based on dbh min and max criteria
if (dbh >= logging_dbhmin .and. .not. &
Expand Down Expand Up @@ -542,7 +542,7 @@ subroutine logging_litter_fluxes(currentSite, currentPatch, newPatch, patch_site
! plants that were impacted. Thus, no direct dead can occur
! here, and indirect are impacts.

if(int(prt_params%woody(pft)) == itrue) then
if(prt_params%woody(pft) == itrue) then
direct_dead = 0.0_r8
indirect_dead = logging_coll_under_frac * &
(1._r8-currentPatch%fract_ldist_not_harvested) * currentCohort%n * &
Expand Down
Loading

0 comments on commit 3cef215

Please sign in to comment.