Skip to content
Draft
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
29 changes: 22 additions & 7 deletions biogeochem/EDCanopyStructureMod.F90
Original file line number Diff line number Diff line change
Expand Up @@ -939,10 +939,25 @@ subroutine UpdateFatesAvgSnowDepth(sites,bc_in)
type(ed_site_type) , intent(inout), target :: sites(:)
type(bc_in_type) , intent(in) :: bc_in(:)

! Local
type (fates_patch_type) , pointer :: currentPatch

integer :: s
integer :: ifp

do s = 1, size(sites,dim=1)
sites(s)%snow_depth = bc_in(s)%snow_depth_si * bc_in(s)%frac_sno_eff_si

currentPatch => sites(s)%oldest_patch

do while(associated(currentPatch))

ifp = currentPatch%patchno
currentPatch%snow_depth = sites(s)%bc_in(ifp)%snow_depth * sites(s)%bc_in(ifp)%frac_snow_eff

currentPatch => currentPatch%younger

end do

end do

return
Expand Down Expand Up @@ -1124,15 +1139,15 @@ subroutine leaf_area_profile( currentSite )
( real(iv,r8)/currentCohort%NV * crown_depth )

fraction_exposed = 1.0_r8
if(currentSite%snow_depth > layer_top_height)then
if(cpatch%snow_depth > layer_top_height)then
fraction_exposed = 0._r8
endif
if(currentSite%snow_depth < layer_bottom_height)then
if(cpatch%snow_depth < layer_bottom_height)then
fraction_exposed = 1._r8
endif
if(currentSite%snow_depth >= layer_bottom_height .and. &
currentSite%snow_depth <= layer_top_height) then !only partly hidden...
fraction_exposed = 1._r8 - max(0._r8,(min(1.0_r8,(currentSite%snow_depth -layer_bottom_height)/ &
if(cpatch%snow_depth >= layer_bottom_height .and. &
cpatch%snow_depth <= layer_top_height) then !only partly hidden...
fraction_exposed = 1._r8 - max(0._r8,(min(1.0_r8,(cpatch%snow_depth -layer_bottom_height)/ &
(layer_top_height-layer_bottom_height ))))
endif

Expand Down Expand Up @@ -1170,7 +1185,7 @@ subroutine leaf_area_profile( currentSite )
currentCohort%treesai, &
currentCohort%height, &
iv,currentCohort%nv,currentCohort%pft, &
currentSite%snow_depth, &
cpatch%snow_depth, &
vai_top,vai_bot, &
elai_layer,esai_layer,tlai_layer,tsai_layer)

Expand Down
7 changes: 3 additions & 4 deletions biogeochem/EDCohortDynamicsMod.F90
Original file line number Diff line number Diff line change
Expand Up @@ -486,7 +486,7 @@ subroutine terminate_cohort(currentSite, currentPatch, currentCohort, bc_in, ter

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

! Set pointers and deallocate the current cohort from the list
Expand All @@ -513,7 +513,7 @@ end subroutine terminate_cohort

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

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

! -----------------------------------------------------------------------------------
! This routine transfers the existing mass in all pools and all elements
Expand All @@ -537,7 +537,6 @@ subroutine SendCohortToLitter(csite,cpatch,ccohort,nplant,bc_in)
type (fates_cohort_type) , target :: ccohort
real(r8) :: nplant ! Number (absolute)
! of plants to transfer
type(bc_in_type), intent(in) :: bc_in

type(litter_type), pointer :: litt ! Litter object for each element
type(elem_diag_type),pointer :: elflux_diags
Expand All @@ -564,7 +563,7 @@ subroutine SendCohortToLitter(csite,cpatch,ccohort,nplant,bc_in)
plant_dens = nplant/cpatch%area

call set_root_fraction(csite%rootfrac_scr, pft, csite%zi_soil, &
bc_in%max_rooting_depth_index_col)
csite%bc_in(cpatch%patchno)%max_rooting_depth_index_col)

do el=1,num_elements

Expand Down
5 changes: 2 additions & 3 deletions biogeochem/EDLoggingMortalityMod.F90
Original file line number Diff line number Diff line change
Expand Up @@ -770,7 +770,7 @@ end subroutine get_harvest_rate_carbon

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

subroutine logging_litter_fluxes(currentSite, currentPatch, newPatch, patch_site_areadis, bc_in)
subroutine logging_litter_fluxes(currentSite, currentPatch, newPatch, patch_site_areadis)

! -------------------------------------------------------------------------------------------
!
Expand Down Expand Up @@ -816,7 +816,6 @@ subroutine logging_litter_fluxes(currentSite, currentPatch, newPatch, patch_site
type(fates_patch_type) , intent(inout), target :: currentPatch
type(fates_patch_type) , intent(inout), target :: newPatch
real(r8) , intent(in) :: patch_site_areadis
type(bc_in_type) , intent(in) :: bc_in


!LOCAL VARIABLES:
Expand Down Expand Up @@ -953,7 +952,7 @@ subroutine logging_litter_fluxes(currentSite, currentPatch, newPatch, patch_site

call set_root_fraction(currentSite%rootfrac_scr, pft, &
currentSite%zi_soil, &
bc_in%max_rooting_depth_index_col)
currentSite%bc_in(currentPatch%patchno)%max_rooting_depth_index_col)

ag_wood = (direct_dead+indirect_dead) * (struct_m + sapw_m ) * &
prt_params%allom_agb_frac(currentCohort%pft)
Expand Down
25 changes: 11 additions & 14 deletions biogeochem/EDPatchDynamicsMod.F90
Original file line number Diff line number Diff line change
Expand Up @@ -758,7 +758,7 @@ subroutine spawn_patches( currentSite, bc_in )
select case(i_disturbance_type)
case (dtype_ilog)
call logging_litter_fluxes(currentSite, currentPatch, &
newPatch, patch_site_areadis,bc_in)
newPatch, patch_site_areadis)

! if transitioning from primary to secondary, then may need to change nocomp pft,
! so tag as having transitioned LU
Expand All @@ -767,13 +767,13 @@ subroutine spawn_patches( currentSite, bc_in )
end if
case (dtype_ifire)
call fire_litter_fluxes(currentSite, currentPatch, &
newPatch, patch_site_areadis,bc_in)
newPatch, patch_site_areadis)
case (dtype_ifall)
call mortality_litter_fluxes(currentSite, currentPatch, &
newPatch, patch_site_areadis,bc_in)
newPatch, patch_site_areadis)
case (dtype_ilandusechange)
call landusechange_litter_fluxes(currentSite, currentPatch, &
newPatch, patch_site_areadis,bc_in, &
newPatch, patch_site_areadis, &
clearing_matrix(i_donorpatch_landuse_type,i_landusechange_receiverpatchlabel))

! if land use change, then may need to change nocomp pft, so tag as having transitioned LU
Expand Down Expand Up @@ -2142,7 +2142,7 @@ end subroutine TransLitterNewPatch
! ============================================================================

subroutine fire_litter_fluxes(currentSite, currentPatch, &
newPatch, patch_site_areadis, bc_in)
newPatch, patch_site_areadis)
!
! !DESCRIPTION:
! CWD pool burned by a fire.
Expand All @@ -2161,7 +2161,6 @@ subroutine fire_litter_fluxes(currentSite, currentPatch, &
type(fates_patch_type) , intent(inout), target :: currentPatch ! Donor Patch
type(fates_patch_type) , intent(inout), target :: newPatch ! New Patch
real(r8) , intent(in) :: patch_site_areadis ! Area being donated
type(bc_in_type) , intent(in) :: bc_in

!
! !LOCAL VARIABLES:
Expand Down Expand Up @@ -2304,7 +2303,7 @@ subroutine fire_litter_fluxes(currentSite, currentPatch, &
site_mass%burn_flux_to_atm = site_mass%burn_flux_to_atm + burned_mass

call set_root_fraction(currentSite%rootfrac_scr, pft, currentSite%zi_soil, &
bc_in%max_rooting_depth_index_col)
currentSite%bc_in(currentPatch%patchno)%max_rooting_depth_index_col)

! Contribution of dead trees to root litter (no root burn flux to atm)
do dcmpy=1,ndcmpy
Expand Down Expand Up @@ -2381,7 +2380,7 @@ end subroutine fire_litter_fluxes
! ============================================================================

subroutine mortality_litter_fluxes(currentSite, currentPatch, &
newPatch, patch_site_areadis,bc_in)
newPatch, patch_site_areadis)
!
! !DESCRIPTION:
! Carbon going from mortality associated with disturbance into CWD pools.
Expand All @@ -2403,7 +2402,6 @@ subroutine mortality_litter_fluxes(currentSite, currentPatch, &
type(fates_patch_type) , intent(inout), target :: currentPatch
type(fates_patch_type) , intent(inout), target :: newPatch
real(r8) , intent(in) :: patch_site_areadis
type(bc_in_type) , intent(in) :: bc_in
!
! !LOCAL VARIABLES:
type(fates_cohort_type), pointer :: currentCohort
Expand Down Expand Up @@ -2531,7 +2529,7 @@ subroutine mortality_litter_fluxes(currentSite, currentPatch, &
bg_wood = num_dead * (struct_m + sapw_m) * (1.0_r8-prt_params%allom_agb_frac(pft))

call set_root_fraction(currentSite%rootfrac_scr, pft, currentSite%zi_soil, &
bc_in%max_rooting_depth_index_col)
currentSite%bc_in(currentPatch%patchno)%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)
Expand Down Expand Up @@ -2614,8 +2612,8 @@ end subroutine mortality_litter_fluxes
! ============================================================================

subroutine landusechange_litter_fluxes(currentSite, currentPatch, &
newPatch, patch_site_areadis, bc_in, &
clearing_matrix_element)
newPatch, patch_site_areadis, clearing_matrix_element)

!
! !DESCRIPTION:
! CWD pool from land use change.
Expand All @@ -2630,7 +2628,6 @@ subroutine landusechange_litter_fluxes(currentSite, currentPatch, &
type(fates_patch_type) , intent(inout), target :: currentPatch ! Donor Patch
type(fates_patch_type) , intent(inout), target :: newPatch ! New Patch
real(r8) , intent(in) :: patch_site_areadis ! Area being donated
type(bc_in_type) , intent(in) :: bc_in
logical , intent(in) :: clearing_matrix_element ! whether or not to clear vegetation

!
Expand Down Expand Up @@ -2771,7 +2768,7 @@ subroutine landusechange_litter_fluxes(currentSite, currentPatch, &
site_mass%burn_flux_to_atm = site_mass%burn_flux_to_atm + burned_mass

call set_root_fraction(currentSite%rootfrac_scr, pft, currentSite%zi_soil, &
bc_in%max_rooting_depth_index_col)
currentSite%bc_in(currentPatch%patchno)%max_rooting_depth_index_col)

! Contribution of dead trees to root litter (no root burn flux to atm)
do dcmpy=1,ndcmpy
Expand Down
21 changes: 12 additions & 9 deletions biogeochem/EDPhysiologyMod.F90
Original file line number Diff line number Diff line change
Expand Up @@ -425,7 +425,7 @@ end subroutine GenerateDamageAndLitterFluxes

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

subroutine PreDisturbanceLitterFluxes( currentSite, currentPatch, bc_in )
subroutine PreDisturbanceLitterFluxes( currentSite, currentPatch)

! -----------------------------------------------------------------------------------
!
Expand All @@ -446,7 +446,6 @@ subroutine PreDisturbanceLitterFluxes( currentSite, currentPatch, bc_in )
! !ARGUMENTS
type(ed_site_type), intent(inout) :: currentSite
type(fates_patch_type), intent(inout) :: currentPatch
type(bc_in_type), intent(in) :: bc_in

!
! !LOCAL VARIABLES:
Expand Down Expand Up @@ -476,12 +475,12 @@ subroutine PreDisturbanceLitterFluxes( currentSite, currentPatch, bc_in )
! Send fluxes from newly created litter into the litter pools
! This litter flux is from non-disturbance inducing mortality, as well
! as litter fluxes from live trees
call CWDInput(currentSite, currentPatch, litt,bc_in)
call CWDInput(currentSite, currentPatch, litt)

! Only calculate fragmentation flux over layers that are active
! (RGK-Mar2019) SHOULD WE MAX THIS AT 1? DONT HAVE TO

nlev_eff_decomp = max(bc_in%max_rooting_depth_index_col, 1)
nlev_eff_decomp = max(currentSite%bc_in(currentPatch%patchno)%max_rooting_depth_index_col, 1)
call CWDOut(litt,currentPatch%fragmentation_scaler,nlev_eff_decomp)

! Fragmentation flux to soil decomposition model [kg/site/day]
Expand Down Expand Up @@ -924,6 +923,7 @@ subroutine phenology( currentSite, bc_in )
integer :: i_wmem ! Loop counter for water mem days
integer :: i_tmem ! Loop counter for veg temp mem days
integer :: ipft ! plant functional type index
integer :: ifp ! fates patch index
integer :: j ! Soil layer index
real(r8) :: mean_10day_liqvol ! mean soil liquid volume over last 10 days [m3/m3]
real(r8) :: mean_10day_smp ! mean soil matric potential over last 10 days [mm]
Expand Down Expand Up @@ -1187,10 +1187,14 @@ subroutine phenology( currentSite, bc_in )
currentSite%smp_memory (i_wmem,ipft) = currentSite%smp_memory (i_wmem-1,ipft)
end do

! Temporarily set the bc index to one for multi-column fates refactor
ifp = 1

! Find the rooting depth distribution for PFT
call set_root_fraction( currentSite%rootfrac_scr, ipft, currentSite%zi_soil, &
bc_in%max_rooting_depth_index_col )
nlevroot = max(2,min(ubound(currentSite%zi_soil,1),bc_in%max_rooting_depth_index_col))
currentSite%bc_in(ifp)%max_rooting_depth_index_col )
nlevroot = max(2,min(ubound(currentSite%zi_soil,1), &
currentSite%bc_in(ifp)%max_rooting_depth_index_col))

! The top most layer is typically very thin (~ 2cm) and dries rather quickly. Despite
! being thin, it can have a non-negligible rooting fraction (e.g., using
Expand Down Expand Up @@ -2799,7 +2803,7 @@ end subroutine recruitment

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

subroutine CWDInput( currentSite, currentPatch, litt, bc_in)
subroutine CWDInput( currentSite, currentPatch, litt )

!
! !DESCRIPTION:
Expand All @@ -2818,7 +2822,6 @@ subroutine CWDInput( currentSite, currentPatch, litt, bc_in)
type(ed_site_type), intent(inout), target :: currentSite
type(fates_patch_type),intent(inout), target :: currentPatch
type(litter_type),intent(inout),target :: litt
type(bc_in_type),intent(in) :: bc_in

!
! !LOCAL VARIABLES:
Expand Down Expand Up @@ -2893,7 +2896,7 @@ subroutine CWDInput( currentSite, currentPatch, litt, bc_in)

pft = currentCohort%pft
call set_root_fraction(currentSite%rootfrac_scr, pft, currentSite%zi_soil, &
bc_in%max_rooting_depth_index_col)
currentSite%bc_in(currentPatch%patchno)%max_rooting_depth_index_col)

store_m_turnover = currentCohort%prt%GetTurnover(store_organ,element_id)
fnrt_m_turnover = currentCohort%prt%GetTurnover(fnrt_organ,element_id)
Expand Down
1 change: 1 addition & 0 deletions biogeochem/FatesPatchMod.F90
Original file line number Diff line number Diff line change
Expand Up @@ -128,6 +128,7 @@ module FatesPatchMod
real(r8) :: total_tree_area ! area that is covered by woody vegetation [m2]
real(r8) :: total_grass_area ! area that is covered by non-woody vegetation [m2]
real(r8) :: zstar ! height of smallest canopy tree, only meaningful in "strict PPA" mode [m]
real(r8) :: snow_depth ! patch-level snow depth (used for ELAI/TLAI calcs)

! exposed leaf area in each canopy layer, pft, and leaf layer [m2 leaf/m2 contributing crown area]
real(r8), allocatable :: elai_profile(:,:,:) ! nclmax,maxpft,nlevleaf)
Expand Down
9 changes: 4 additions & 5 deletions biogeochem/FatesSoilBGCFluxMod.F90
Original file line number Diff line number Diff line change
Expand Up @@ -331,7 +331,7 @@ subroutine PrepCH4BCs(csite,bc_in,bc_out)
pft = ccohort%pft

call set_root_fraction(csite%rootfrac_scr, pft, csite%zi_soil, &
bc_in%max_rooting_depth_index_col )
csite%bc_in(cpatch%patchno)%max_rooting_depth_index_col )

fnrt_c = ccohort%prt%GetState(fnrt_organ, carbon12_element)

Expand Down Expand Up @@ -488,7 +488,7 @@ subroutine PrepNutrientAquisitionBCs(csite, bc_in, bc_out)
bc_out%ft_index(icomp) = pft

call set_root_fraction(csite%rootfrac_scr, pft, csite%zi_soil, &
bc_in%max_rooting_depth_index_col )
csite%bc_in(cpatch%patchno)%max_rooting_depth_index_col )

fnrt_c = ccohort%prt%GetState(fnrt_organ, carbon12_element)

Expand Down Expand Up @@ -541,7 +541,7 @@ end subroutine PrepNutrientAquisitionBCs

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

subroutine EffluxIntoLitterPools(csite, cpatch, ccohort, bc_in )
subroutine EffluxIntoLitterPools(csite, cpatch, ccohort)

! -----------------------------------------------------------------------------------
! This subroutine just handles the transfer of exudation/efflux from plants
Expand All @@ -554,7 +554,6 @@ subroutine EffluxIntoLitterPools(csite, cpatch, ccohort, bc_in )
type(ed_site_type), intent(inout) :: csite
type(fates_patch_type), intent(inout) :: cpatch
type(fates_cohort_type), intent(inout),target :: ccohort
type(bc_in_type), intent(in) :: bc_in

! locals
integer :: el ! element loop index
Expand All @@ -564,7 +563,7 @@ subroutine EffluxIntoLitterPools(csite, cpatch, ccohort, bc_in )

call set_root_fraction(csite%rootfrac_scr, &
ccohort%pft, csite%zi_soil, &
bc_in%max_rooting_depth_index_col )
csite%bc_in(cpatch%patchno)%max_rooting_depth_index_col )

! Loop over the different elements.
do el = 1, num_elements
Expand Down
Loading