Skip to content

Commit

Permalink
Merge branch 'master' into sort_inventory_init
Browse files Browse the repository at this point in the history
  • Loading branch information
@ckoven
ckoven committed Aug 15, 2019
2 parents 4e69321 + 6cd0bb5 commit e3143f3
Show file tree
Hide file tree
Showing 12 changed files with 1,317 additions and 95 deletions.
99 changes: 43 additions & 56 deletions biogeochem/EDPatchDynamicsMod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -348,6 +348,7 @@ subroutine spawn_patches( currentSite, bc_in)
real(r8) :: cwd_ag_local(ncwd) ! initial value of above ground coarse woody debris. KgC/m2
real(r8) :: cwd_bg_local(ncwd) ! initial value of below ground coarse woody debris. KgC/m2
integer :: levcan ! canopy level
real(r8) :: leaf_burn_frac
real(r8) :: leaf_c ! leaf carbon [kg]
real(r8) :: fnrt_c ! fineroot carbon [kg]
real(r8) :: sapw_c ! sapwood carbon [kg]
Expand Down Expand Up @@ -682,6 +683,33 @@ subroutine spawn_patches( currentSite, bc_in)
nc%lmort_direct = currentCohort%lmort_direct
nc%lmort_collateral = currentCohort%lmort_collateral
nc%lmort_infra = currentCohort%lmort_infra

! --------------------------------------------------------------------
! Burn parts of trees that did *not* die in the fire.
! currently we only remove leaves. branch and associated
! sapwood consumption coming soon.
! PART 4) Burn parts of grass that are consumed by the fire.
! grasses are not killed directly by fire. They die by losing all of
! their leaves and starving.
! --------------------------------------------------------------------

leaf_c = nc%prt%GetState(leaf_organ, all_carbon_elements)

if(EDPftvarcon_inst%woody(currentCohort%pft) == 1)then
leaf_burn_frac = currentCohort%fraction_crown_burned
else
leaf_burn_frac = currentPatch%burnt_frac_litter(lg_sf)
endif

call PRTBurnLosses(nc%prt, leaf_organ, leaf_burn_frac)

!KgC/gridcell/day
currentSite%flux_out = currentSite%flux_out + leaf_burn_frac* leaf_c * nc%n

currentSite%total_burn_flux_to_atm = currentSite%total_burn_flux_to_atm + leaf_burn_frac * leaf_c * nc%n

currentCohort%fraction_crown_burned = 0.0_r8
nc%fraction_crown_burned = 0.0_r8


! Logging is the dominant disturbance
Expand Down Expand Up @@ -1063,9 +1091,8 @@ subroutine fire_litter_fluxes(currentSite, cp_target, new_patch_target, patch_si
real(r8) :: bcroot ! amount of below ground coarse root per cohort kgC. (goes into CWD_BG)
real(r8) :: bstem ! amount of above ground stem biomass per cohort kgC.(goes into CWG_AG)
real(r8) :: dead_tree_density ! no trees killed by fire per m2
real(r8) :: dead_tree_num ! total number of trees killed by fire
reaL(r8) :: burned_litter ! amount of each litter pool burned by fire. kgC/m2/day
real(r8) :: burned_leaves ! amount of tissue consumed by fire for leaves. KgC/individual/day
real(r8) :: leaf_burn_frac ! fraction of leaves burned
real(r8) :: leaf_c ! leaf carbon [kg]
real(r8) :: fnrt_c ! fineroot carbon [kg]
real(r8) :: sapw_c ! sapwood carbon [kg]
Expand All @@ -1087,7 +1114,7 @@ subroutine fire_litter_fluxes(currentSite, cp_target, new_patch_target, patch_si
!PART 1) Burn the fractions of existing litter in the new patch that were consumed by the fire.
!************************************/
do c = 1,ncwd
burned_litter = new_patch%cwd_ag(c) * patch_site_areadis/new_patch%area * &
burned_litter = currentPatch%cwd_ag(c) * patch_site_areadis/new_patch%area * &
currentPatch%burnt_frac_litter(c) !kG/m2/day
new_patch%cwd_ag(c) = new_patch%cwd_ag(c) - burned_litter
currentSite%flux_out = currentSite%flux_out + burned_litter * new_patch%area !kG/site/day
Expand All @@ -1096,7 +1123,7 @@ subroutine fire_litter_fluxes(currentSite, cp_target, new_patch_target, patch_si
enddo

do p = 1,numpft
burned_litter = new_patch%leaf_litter(p) * patch_site_areadis/new_patch%area * &
burned_litter = currentPatch%leaf_litter(p) * patch_site_areadis/new_patch%area * &
currentPatch%burnt_frac_litter(dl_sf)
new_patch%leaf_litter(p) = new_patch%leaf_litter(p) - burned_litter
currentSite%flux_out = currentSite%flux_out + burned_litter * new_patch%area !kG/site/day
Expand Down Expand Up @@ -1129,23 +1156,28 @@ subroutine fire_litter_fluxes(currentSite, cp_target, new_patch_target, patch_si
bstem = (sapw_c + struct_c) * EDPftvarcon_inst%allom_agb_frac(p)
! coarse root biomass per tree
bcroot = (sapw_c + struct_c) * (1.0_r8 - EDPftvarcon_inst%allom_agb_frac(p) )
! density of dead trees per m2.
dead_tree_density = (currentCohort%fire_mort * currentCohort%n*patch_site_areadis/currentPatch%area) / AREA

! Total number of dead trees
dead_tree_num = currentCohort%fire_mort * currentCohort%n*patch_site_areadis/currentPatch%area

! density of dead trees per m2 (spread over the new and pre-existing patch)
dead_tree_density = dead_tree_num / (new_patch%area + currentPatch%area-patch_site_areadis )

if( hlm_use_planthydro == itrue ) then
call AccumulateMortalityWaterStorage(currentSite,currentCohort,dead_tree_density*AREA)
call AccumulateMortalityWaterStorage(currentSite,currentCohort,dead_tree_num)
end if

! Unburned parts of dead tree pool.
! Unburned leaves and roots

new_patch%leaf_litter(p) = new_patch%leaf_litter(p) + dead_tree_density * leaf_c * (1.0_r8-currentCohort%fraction_crown_burned)

new_patch%root_litter(p) = new_patch%root_litter(p) + dead_tree_density * (fnrt_c+store_c)
new_patch%leaf_litter(p) = new_patch%leaf_litter(p) + &
dead_tree_density * leaf_c * (1.0_r8-currentCohort%fraction_crown_burned)

currentPatch%leaf_litter(p) = currentPatch%leaf_litter(p) + dead_tree_density * &
leaf_c * (1.0_r8-currentCohort%fraction_crown_burned)

new_patch%root_litter(p) = new_patch%root_litter(p) + dead_tree_density * (fnrt_c+store_c)

currentPatch%root_litter(p) = currentPatch%root_litter(p) + dead_tree_density * &
(fnrt_c + store_c)

Expand All @@ -1160,7 +1192,7 @@ subroutine fire_litter_fluxes(currentSite, cp_target, new_patch_target, patch_si

! below ground coarse woody debris from burned trees
do c = 1,ncwd
new_patch%cwd_bg(c) = new_patch%cwd_bg(c) + dead_tree_density * SF_val_CWD_frac(c) * bcroot
new_patch%cwd_bg(c) = new_patch%cwd_bg(c) + dead_tree_density * SF_val_CWD_frac(c) * bcroot
currentPatch%cwd_bg(c) = currentPatch%cwd_bg(c) + dead_tree_density * SF_val_CWD_frac(c) * bcroot

! track as diagnostic fluxes
Expand Down Expand Up @@ -1225,51 +1257,6 @@ subroutine fire_litter_fluxes(currentSite, cp_target, new_patch_target, patch_si
currentCohort => currentCohort%taller

enddo ! currentCohort

!************************************/
! PART 3) Burn parts of trees that did *not* die in the fire.
! currently we only remove leaves. branch and assocaited sapwood consumption coming soon.
! PART 4) Burn parts of grass that are consumed by the fire.
! grasses are not killed directly by fire. They die by losing all of their leaves and starving.
!************************************/
currentCohort => new_patch%shortest
do while(associated(currentCohort))

sapw_c = currentCohort%prt%GetState(sapw_organ, all_carbon_elements)
leaf_c = currentCohort%prt%GetState(leaf_organ, all_carbon_elements)

call carea_allom(currentCohort%dbh,currentCohort%n,currentSite%spread,currentCohort%pft,currentCohort%c_area)

if(EDPftvarcon_inst%woody(currentCohort%pft) == 1)then
burned_leaves = leaf_c * currentCohort%fraction_crown_burned
else
burned_leaves = leaf_c * currentPatch%burnt_frac_litter(lg_sf)
endif

if (burned_leaves > 0.0_r8) then

! Remove burned leaves from the pool
if(leaf_c>nearzero) then
leaf_burn_frac = burned_leaves/leaf_c
else
leaf_burn_frac = 0.0_r8
end if
call PRTBurnLosses(currentCohort%prt, leaf_organ, leaf_burn_frac)

!KgC/gridcell/day
currentSite%flux_out = currentSite%flux_out + burned_leaves * currentCohort%n * &
patch_site_areadis/currentPatch%area * AREA

currentSite%total_burn_flux_to_atm = currentSite%total_burn_flux_to_atm+ burned_leaves * currentCohort%n * &
patch_site_areadis/currentPatch%area * AREA

endif
currentCohort%fraction_crown_burned = 0.0_r8

currentCohort => currentCohort%taller

enddo

endif !currentPatch%fire.

end subroutine fire_litter_fluxes
Expand Down
50 changes: 29 additions & 21 deletions biogeophys/FatesPlantHydraulicsMod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -39,6 +39,7 @@ module FatesPlantHydraulicsMod
use FatesConstantsMod, only : pi_const
use FatesConstantsMod, only : cm2_per_m2
use FatesConstantsMod, only : g_per_kg
use FatesConstantsMod, only : nearzero

use EDParamsMod , only : hydr_kmax_rsurf1
use EDParamsMod , only : hydr_kmax_rsurf2
Expand Down Expand Up @@ -2290,7 +2291,7 @@ subroutine hydraulics_bc ( nsites, sites,bc_in,bc_out,dtime )
real(r8), parameter :: small_theta_num = 1.e-7_r8 ! avoids theta values equalling thr or ths [m3 m-3]

! hydraulics timestep adjustments for acceptable water balance error
integer :: maxiter = 1 ! maximum iterations for timestep reduction [-]
integer :: maxiter = 5 ! maximum iterations for timestep reduction [-]
integer :: imult = 3 ! iteration index multiplier [-]
real(r8) :: we_area_outer ! 1D plant-soil continuum water error [kgh2o m-2 individual-1]

Expand Down Expand Up @@ -2474,13 +2475,17 @@ subroutine hydraulics_bc ( nsites, sites,bc_in,bc_out,dtime )
do while(associated(ccohort))
ccohort_hydr => ccohort%co_hydr
gscan_patch = gscan_patch + ccohort%g_sb_laweight
if (gscan_patch < 0._r8) then
write(fates_log(),*) 'ERROR: negative gscan_patch!'
call endrun(msg=errMsg(sourcefile, __LINE__))
end if
ccohort => ccohort%shorter
enddo !cohort

! The HLM predicted transpiration flux even though no leaves are present?
if(bc_in(s)%qflx_transp_pa(ifp) > 1.e-10_r8 .and. gscan_patch<nearzero)then
write(fates_log(),*) 'ERROR in plant hydraulics.'
write(fates_log(),*) 'The HLM predicted a non-zero total transpiration flux'
write(fates_log(),*) 'for this patch, yet there is no leaf-area-weighted conductance?'
call endrun(msg=errMsg(sourcefile, __LINE__))
end if

ccohort=>cpatch%tallest
do while(associated(ccohort))
ccohort_hydr => ccohort%co_hydr
Expand All @@ -2492,18 +2497,21 @@ subroutine hydraulics_bc ( nsites, sites,bc_in,bc_out,dtime )
ccohort_hydr%rootuptake = 0._r8

! Relative transpiration of this cohort from the whole patch
!! qflx_rel_tran_coh = ccohort%g_sb_laweight/gscan_patch
! [mm H2O/cohort/s] = [mm H2O / patch / s] / [cohort/patch]

qflx_tran_veg_patch_coh = bc_in(s)%qflx_transp_pa(ifp) * ccohort%g_sb_laweight/gscan_patch
if(ccohort%g_sb_laweight>nearzero) then
qflx_tran_veg_patch_coh = bc_in(s)%qflx_transp_pa(ifp) * ccohort%g_sb_laweight/gscan_patch

qflx_tran_veg_indiv = qflx_tran_veg_patch_coh * cpatch%area* &
min(1.0_r8,cpatch%total_canopy_area/cpatch%area)/ccohort%n !AREA / ccohort%n
else
qflx_tran_veg_patch_coh = 0._r8
qflx_tran_veg_indiv = 0._r8
end if

qflx_tran_veg_indiv = qflx_tran_veg_patch_coh * cpatch%area* &
min(1.0_r8,cpatch%total_canopy_area/cpatch%area)/ccohort%n !AREA / ccohort%n

! [mm H2O/cohort/s] = [mm H2O / patch / s] / [cohort/patch]
!! qflx_tran_veg_patch_coh = qflx_trans_patch_vol * qflx_rel_tran_coh

call updateWaterDepTreeHydProps(sites(s),ccohort,bc_in(s))
call updateWaterDepTreeHydProps(sites(s),ccohort,bc_in(s))
if(site_hydr%nlevsoi_hyd > 1) then
! BUCKET APPROXIMATION OF THE SOIL-ROOT HYDRAULIC GRADIENT (weighted average across layers)
!call map2d_to_1d_shells(soilstate_inst, waterstate_inst, g, c, rs1(c,1), ccohort_hydr%l_aroot_layer*ccohort%n, &
Expand Down Expand Up @@ -3471,7 +3479,7 @@ subroutine Hydraulics_1DSolve(cc_p, ft, z_node, v_node, ths_node, thr_node, kmax
end if
end do
if(catch_nan) then
write(fates_log(),*)'EDPlantHydraulics returns nan at k = ', char(index_nan)
write(fates_log(),*)'EDPlantHydraulics returns nan at k = ', index_nan
call endrun(msg=errMsg(sourcefile, __LINE__))
end if

Expand Down Expand Up @@ -3776,7 +3784,7 @@ subroutine flc_from_psi(ft, pm, psi_node, flc_node, site_hydr, bc_in )
bc_in%bsw_sisl(1), &
flc_node)
case default
write(fates_log(),*) 'ERROR: invalid soil water characteristic function specified, iswc = '//char(iswc)
write(fates_log(),*) 'ERROR: invalid soil water characteristic function specified, iswc = ', iswc
call endrun(msg=errMsg(sourcefile, __LINE__))
end select
end if
Expand Down Expand Up @@ -3830,7 +3838,7 @@ subroutine dflcdpsi_from_psi(ft, pm, psi_node, dflcdpsi_node, site_hydr, bc_in )
bc_in%bsw_sisl(1), &
dflcdpsi_node)
case default
write(fates_log(),*) 'ERROR: invalid soil water characteristic function specified, iswc = '//char(iswc)
write(fates_log(),*) 'ERROR: invalid soil water characteristic function specified, iswc = ', iswc
call endrun(msg=errMsg(sourcefile, __LINE__))
end select
end if
Expand Down Expand Up @@ -3878,7 +3886,7 @@ subroutine th_from_psi(ft, pm, psi_node, th_node, site_hydr, bc_in)
call psi_from_th(ft, pm, th_node, psi_check )

if(psi_check > -1.e-8_r8) then
write(fates_log(),*)'bisect_pv returned positive value for water potential at pm = ', char(pm)
write(fates_log(),*)'bisect_pv returned positive value for water potential at pm = ', pm
call endrun(msg=errMsg(sourcefile, __LINE__))
end if

Expand Down Expand Up @@ -3909,7 +3917,7 @@ subroutine th_from_psi(ft, pm, psi_node, th_node, site_hydr, bc_in)
bc_in%watsat_sisl(1), &
th_node)
case default
write(fates_log(),*) 'invalid soil water characteristic function specified, iswc = '//char(iswc)
write(fates_log(),*) 'invalid soil water characteristic function specified, iswc = ', iswc
call endrun(msg=errMsg(sourcefile, __LINE__))
end select
end if
Expand Down Expand Up @@ -4027,7 +4035,7 @@ subroutine psi_from_th(ft, pm, th_node, psi_node, site_hydr, bc_in)
bc_in%bsw_sisl(1), &
psi_node)
case default
write(fates_log(),*) 'ERROR: invalid soil water characteristic function specified, iswc = '//char(iswc)
write(fates_log(),*) 'ERROR: invalid soil water characteristic function specified, iswc = ', iswc
call endrun(msg=errMsg(sourcefile, __LINE__))
end select

Expand Down Expand Up @@ -4078,7 +4086,7 @@ subroutine dpsidth_from_th(ft, pm, th_node, y, site_hydr, bc_in)
bc_in%bsw_sisl(1), &
y)
case default
write(fates_log(),*) 'ERROR: invalid soil water characteristic function specified, iswc = '//char(iswc)
write(fates_log(),*) 'ERROR: invalid soil water characteristic function specified, iswc = ', iswc
call endrun(msg=errMsg(sourcefile, __LINE__))
end select
end if
Expand Down
4 changes: 2 additions & 2 deletions fire/SFMainMod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1021,8 +1021,8 @@ subroutine post_fire_mortality ( currentSite )
! Equation 22 in Thonicke et al. 2010.
currentCohort%crownfire_mort = EDPftvarcon_inst%crown_kill(currentCohort%pft)*currentCohort%fraction_crown_burned**3.0_r8
! Equation 18 in Thonicke et al. 2010.
currentCohort%fire_mort = currentCohort%crownfire_mort+currentCohort%cambial_mort- &
(currentCohort%crownfire_mort*currentCohort%cambial_mort) !joint prob.
currentCohort%fire_mort = max(0._r8,min(1.0_r8,currentCohort%crownfire_mort+currentCohort%cambial_mort- &
(currentCohort%crownfire_mort*currentCohort%cambial_mort))) !joint prob.
else
currentCohort%fire_mort = 0.0_r8 !I have changed this to zero and made the mode of death removal of leaves...
endif !trees
Expand Down
Loading

0 comments on commit e3143f3

Please sign in to comment.