Skip to content

Commit

Permalink
Merge branch 'master' into default-off-logs
Browse files Browse the repository at this point in the history
  • Loading branch information
@rgknox
rgknox committed Apr 26, 2022
2 parents b9c8831 + 253b600 commit 5ca52ce
Show file tree
Hide file tree
Showing 6 changed files with 175 additions and 13 deletions.
122 changes: 119 additions & 3 deletions biogeochem/FatesSoilBGCFluxMod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -55,6 +55,7 @@ module FatesSoilBGCFluxMod
use FatesInterfaceTypesMod, only : hlm_nu_com
use FatesInterfaceTypesMod, only : hlm_parteh_mode
use FatesInterfaceTypesMod, only : hlm_use_ch4
use FatesInterfaceTypesMod, only : hlm_decomp
use FatesConstantsMod , only : prescribed_p_uptake
use FatesConstantsMod , only : prescribed_n_uptake
use FatesConstantsMod , only : coupled_p_uptake
Expand Down Expand Up @@ -930,7 +931,7 @@ subroutine FluxIntoLitterPools(csite, bc_in, bc_out)

! !LOCAL VARIABLES:
type (ed_patch_type), pointer :: currentPatch
type (ed_cohort_type), pointer :: currentCohort
type (ed_cohort_type), pointer :: ccohort
real(r8), pointer :: flux_cel_si(:)
real(r8), pointer :: flux_lab_si(:)
real(r8), pointer :: flux_lig_si(:)
Expand All @@ -954,6 +955,21 @@ subroutine FluxIntoLitterPools(csite, bc_in, bc_out)
integer :: ic ! CWD type index
integer :: ipft ! PFT index

! The following are used for the MIMICS ligC/N boundary condition
real(r8) :: leaf_c, sapw_c ! leaf and sapwood carbon, per plant [kg]
real(r8) :: fnrt_c, struct_c ! fineroot and struct carbon, per plant [kg]
real(r8) :: leaf_n, sapw_n ! leaf and sapwood N, per plant [kg]
real(r8) :: fnrt_n, struct_n ! fineroot and struct N, per plant [kg]
real(r8) :: sum_ligC ! Flux of lignin C [kg/m2/s]
real(r8) :: sum_N ! Flux of all N [kg/m2/s]
real(r8) :: tot_leaf_c ! total leaf C of all cohorts in patch [kg/m2]
real(r8) :: tot_leaf_n ! total leaf N of all cohorts in patch [kg/m2]
real(r8) :: tot_fnrt_c ! total fineroot C of all cohorts in patch [kg/m2]
real(r8) :: tot_fnrt_n ! total fineroot N of all cohorts in patch [kg/m2]
real(r8) :: tot_wood_c ! total wood C of all cohorts in patch [kg/m2]
real(r8) :: tot_wood_n ! total wood N of all cohorts in patch [kg/m2]


! NOTE(rgk, 201705) this parameter was brought over from SoilBiogeochemVerticalProfile
! how steep profile is for surface components (1/ e_folding depth) (1/m)
real(r8), parameter :: surfprof_exp = 10.
Expand Down Expand Up @@ -986,12 +1002,12 @@ subroutine FluxIntoLitterPools(csite, bc_in, bc_out)
do id = 1,nlev_eff_decomp
surface_prof(id) = surface_prof(id)/surface_prof_tot
end do

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

! Zero out the boundary flux arrays
! Make a pointer to the cellulose, labile and lignan
! Make a pointer to the cellulose, labile and lignin
! flux partitions.

select case (element_list(el))
Expand Down Expand Up @@ -1048,6 +1064,7 @@ subroutine FluxIntoLitterPools(csite, bc_in, bc_out)

flux_lig_si(id) = flux_lig_si(id) + &
litt%ag_cwd_frag(ic) * ED_val_cwd_flig * area_frac * surface_prof(id)

end do

do j = 1, nlev_eff_soil
Expand All @@ -1063,6 +1080,9 @@ subroutine FluxIntoLitterPools(csite, bc_in, bc_out)
end do
end do




! leaf and fine root fragmentation fluxes

do id = 1,nlev_eff_decomp
Expand Down Expand Up @@ -1126,6 +1146,102 @@ subroutine FluxIntoLitterPools(csite, bc_in, bc_out)

end do ! do elements

! If we are coupled with MIMICS, then we need some assessment of litter quality
! ie ligC/totalN. If we are not tracking N in the litter flux (ie C-only model)
! then we need to approximate this by estimating the mean C:N ratios of each
! plant organ, and mulitplying that by the different C Fluxes to get a total
! approximate N flux. Note, in C-only, we will not capture any re-absorption.

if(trim(hlm_decomp).eq.'MIMICS') then

! If we track nitrogen (ie cnp or other) then
! we diagnose the c-lig/n ratio directly from the pools
if(element_pos(nitrogen_element)>0) then

! Sum totalN fluxes over depth [g/m2]
sum_N = sum((bc_out%litt_flux_cel_n_si(1:nlev_eff_soil) + &
bc_out%litt_flux_lig_n_si(1:nlev_eff_soil) + &
bc_out%litt_flux_lab_n_si(1:nlev_eff_soil)) * &
bc_in%dz_sisl(1:nlev_eff_soil))

else

! In this case (Carbon Only), we use the stoichiometry parameters to estimate
! the C:N of live vegetation and the seedbank, and use that
! as a proxy for the C:N of the litter flux

sum_N = 0._r8

currentPatch => csite%oldest_patch
do while (associated(currentPatch))

litt => currentPatch%litter(element_pos(carbon12_element))
area_frac = currentPatch%area*area_inv

tot_leaf_c = 0._r8
tot_leaf_n = 0._r8
tot_fnrt_c = 0._r8
tot_fnrt_n = 0._r8
tot_wood_c = 0._r8
tot_wood_n = 0._r8

ccohort => currentPatch%tallest
do while (associated(ccohort))
ipft = ccohort%pft
leaf_c = ccohort%n * area_inv * ccohort%prt%GetState(leaf_organ, carbon12_element)
sapw_c = ccohort%n * area_inv * ccohort%prt%GetState(sapw_organ, carbon12_element)
fnrt_c = ccohort%n * area_inv * ccohort%prt%GetState(fnrt_organ, carbon12_element)
struct_c = ccohort%n * area_inv * ccohort%prt%GetState(struct_organ, carbon12_element)
leaf_n = leaf_c * prt_params%nitr_stoich_p1(ipft,prt_params%organ_param_id(leaf_organ))
sapw_n = sapw_c * prt_params%nitr_stoich_p1(ipft,prt_params%organ_param_id(sapw_organ))
fnrt_n = fnrt_c * prt_params%nitr_stoich_p1(ipft,prt_params%organ_param_id(fnrt_organ))
struct_n = struct_c * prt_params%nitr_stoich_p1(ipft,prt_params%organ_param_id(struct_organ))
tot_leaf_c = tot_leaf_c + leaf_c
tot_leaf_n = tot_leaf_n + leaf_n
tot_fnrt_c = tot_fnrt_c + fnrt_c
tot_fnrt_n = tot_fnrt_n + fnrt_n
tot_wood_c = tot_wood_c + sapw_c + struct_c
tot_wood_n = tot_wood_n + sapw_n + struct_n
ccohort => ccohort%shorter
end do

if(tot_wood_c>nearzero) then
sum_N = sum_N + area_frac*sum(litt%ag_cwd_frag)*(tot_wood_n/tot_wood_c)
sum_N = sum_N + area_frac*sum(litt%bg_cwd_frag)*(tot_wood_n/tot_wood_c)
end if
if(tot_leaf_c>nearzero)then
sum_N = sum_N + area_frac*sum(litt%leaf_fines_frag)*(tot_leaf_n / tot_leaf_c)
end if
if(tot_fnrt_c>nearzero)then
sum_N = sum_N + area_frac*sum(litt%root_fines_frag)*(tot_fnrt_n / tot_fnrt_c)
end if
do ipft = 1,numpft
sum_N = sum_N + area_frac * prt_params%nitr_recr_stoich(ipft) * &
(litt%seed_decay(ipft) + litt%seed_germ_decay(ipft))
end do

currentPatch => currentPatch%younger
end do

! Convert from kg/m2/day -> g/m2/s
sum_N = sum_N * days_per_sec * g_per_kg

end if

! Sum over layers and multiply by depth g/m3/s * m -> g/m2/s
sum_ligC = sum(bc_out%litt_flux_lig_c_si(1:nlev_eff_soil) * bc_in%dz_sisl(1:nlev_eff_soil))

if(sum_N>nearzero)then
bc_out%litt_flux_ligc_per_n = sum_ligC / sum_N
else
bc_out%litt_flux_ligc_per_n = 0._r8
end if

end if




return
end subroutine FluxIntoLitterPools

Expand Down
2 changes: 1 addition & 1 deletion main/EDPftvarcon.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -59,7 +59,7 @@ module EDPftvarcon

real(r8), allocatable :: lf_flab(:) ! Leaf litter labile fraction [-]
real(r8), allocatable :: lf_fcel(:) ! Leaf litter cellulose fraction [-]
real(r8), allocatable :: lf_flig(:) ! Leaf litter lignan fraction [-]
real(r8), allocatable :: lf_flig(:) ! Leaf litter lignin fraction [-]
real(r8), allocatable :: fr_flab(:) ! Fine-root litter labile fraction [-]
real(r8), allocatable :: fr_fcel(:) ! Fine-root litter cellulose fraction [-]
real(r8), allocatable :: fr_flig(:) ! Fine-root litter lignatn fraction [-]
Expand Down
37 changes: 35 additions & 2 deletions main/FatesInterfaceMod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -36,6 +36,7 @@ module FatesInterfaceMod
use FatesGlobals , only : fates_global_verbose
use FatesGlobals , only : fates_log
use FatesGlobals , only : endrun => fates_endrun
use FatesConstantsMod , only : fates_unset_r8
use FatesLitterMod , only : ncwd
use FatesLitterMod , only : ndcmpy
use EDPftvarcon , only : FatesReportPFTParams
Expand Down Expand Up @@ -304,6 +305,10 @@ subroutine zero_bcs(fates,s)
fates%bc_out(s)%rootr_pasl(:,:) = 0.0_r8
fates%bc_out(s)%btran_pa(:) = 0.0_r8

! MIMIC litter quality, always initialize to unset
fates%bc_out(s)%litt_flux_ligc_per_n = fates_unset_r8


! Fates -> BGC fragmentation mass fluxes
select case(hlm_parteh_mode)
case(prt_carbon_allom_hyp)
Expand Down Expand Up @@ -624,7 +629,6 @@ subroutine allocate_bcout(bc_out, nlevsoil_in, nlevdecomp_in)
bc_out%rootfr_pa(0,1:nlevsoil_in)=1._r8/real(nlevsoil_in,r8)
end if


! Fates -> BGC fragmentation mass fluxes
select case(hlm_parteh_mode)
case(prt_carbon_allom_hyp)
Expand Down Expand Up @@ -1275,6 +1279,7 @@ subroutine set_fates_ctrlparms(tag,ival,rval,cval)
hlm_masterproc = unset_int
hlm_ipedof = unset_int
hlm_nu_com = 'unset'
hlm_decomp = 'unset'
hlm_nitrogen_spec = unset_int
hlm_phosphorus_spec = unset_int
hlm_max_patch_per_site = unset_int
Expand Down Expand Up @@ -1422,11 +1427,33 @@ subroutine set_fates_ctrlparms(tag,ival,rval,cval)
call endrun(msg=errMsg(sourcefile, __LINE__))
end if

if(trim(hlm_decomp) .eq. 'unset') then
if (fates_global_verbose()) then
write(fates_log(),*) 'FATES dimension/parameter unset: hlm_decomp, exiting'
write(fates_log(),*) 'valid: MIMICS, CENTURY, CTC'
end if
call endrun(msg=errMsg(sourcefile, __LINE__))
end if
if( .not. ((trim(hlm_decomp) .eq. 'MIMICS') .or. &
(trim(hlm_decomp) .eq. 'CENTURY') .or. &
(trim(hlm_decomp) .eq. 'CTC') .or. &
(trim(hlm_decomp) .eq. 'NONE')) ) then
if (fates_global_verbose()) then
write(fates_log(),*) 'FATES dimension/parameter unset: hlm_decomp, exiting'
write(fates_log(),*) 'valid: NONE, MIMICS, CENTURY, CTC, yours: ',trim(hlm_decomp)
end if
call endrun(msg=errMsg(sourcefile, __LINE__))
end if

! TEMPORARY TESTING OVERRIDE !!!!!!!!
! hlm_decomp = 'MIMICS'

if(trim(hlm_nu_com) .eq. 'unset') then
write(fates_log(),*) 'FATES dimension/parameter unset: hlm_nu_com, exiting'
call endrun(msg=errMsg(sourcefile, __LINE__))
end if


if(hlm_nitrogen_spec .eq. unset_int) then
write(fates_log(),*) 'FATES parameters unset: hlm_nitrogen_spec, exiting'
call endrun(msg=errMsg(sourcefile, __LINE__))
Expand Down Expand Up @@ -1468,7 +1495,7 @@ subroutine set_fates_ctrlparms(tag,ival,rval,cval)
write(fates_log(), *) 'switch for the HLMs CH4 module unset: hlm_use_ch4, exiting'
call endrun(msg=errMsg(sourcefile, __LINE__))
end if

if(hlm_use_vertsoilc .eq. unset_int) then
write(fates_log(), *) 'switch for the HLMs soil carbon discretization unset: hlm_use_vertsoilc, exiting'
call endrun(msg=errMsg(sourcefile, __LINE__))
Expand Down Expand Up @@ -1757,6 +1784,12 @@ subroutine set_fates_ctrlparms(tag,ival,rval,cval)
write(fates_log(),*) 'Transfering the nutrient competition name = ',trim(cval)
end if

case('decomp_method')
hlm_decomp = trim(cval)
if (fates_global_verbose()) then
write(fates_log(),*) 'Transfering the decomp method name = ',trim(cval)
end if

case('inventory_ctrl_file')
hlm_inventory_ctrl_file = trim(cval)
if (fates_global_verbose()) then
Expand Down
21 changes: 17 additions & 4 deletions main/FatesInterfaceTypesMod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -46,7 +46,11 @@ module FatesInterfaceTypesMod
! specficially packaged for them.
! This string sets which filter is enacted.


character(len=16), public :: hlm_decomp ! This string defines which soil decomposition
! scheme is active
! expected values are one of CENTURY,MIMICS,CTC


character(len=16), public :: hlm_nu_com ! This string defines which soil
! nutrient competition scheme is in use.
! current options with
Expand Down Expand Up @@ -593,15 +597,21 @@ module FatesInterfaceTypesMod
! Mass fluxes to BGC from fragmentation of litter into decomposing pools

real(r8), allocatable :: litt_flux_cel_c_si(:) ! cellulose carbon litter, fates->BGC g/m3/s
real(r8), allocatable :: litt_flux_lig_c_si(:) ! lignan carbon litter, fates->BGC g/m3/s
real(r8), allocatable :: litt_flux_lig_c_si(:) ! lignin carbon litter, fates->BGC g/m3/s
real(r8), allocatable :: litt_flux_lab_c_si(:) ! labile carbon litter, fates->BGC g/m3/s
real(r8), allocatable :: litt_flux_cel_n_si(:) ! cellulose nitrogen litter, fates->BGC g/m3/s
real(r8), allocatable :: litt_flux_lig_n_si(:) ! lignan nitrogen litter, fates->BGC g/m3/s
real(r8), allocatable :: litt_flux_lig_n_si(:) ! lignin nitrogen litter, fates->BGC g/m3/s
real(r8), allocatable :: litt_flux_lab_n_si(:) ! labile nitrogen litter, fates->BGC g/m3/s
real(r8), allocatable :: litt_flux_cel_p_si(:) ! cellulose phosphorus litter, fates->BGC g/m3/s
real(r8), allocatable :: litt_flux_lig_p_si(:) ! lignan phosphorus litter, fates->BGC g/m3/s
real(r8), allocatable :: litt_flux_lig_p_si(:) ! lignin phosphorus litter, fates->BGC g/m3/s
real(r8), allocatable :: litt_flux_lab_p_si(:) ! labile phosphorus litter, fates->BGC g/m3/s


! MIMICS Boundary Conditions
! -----------------------------------------------------------------------------------
real(r8) :: litt_flux_ligc_per_n ! lignin carbon per total nitrogen
! in the fragmentation flux, per square meter [g/g]


! Nutrient competition boundary conditions
! (These are all pointer allocations, this is because the host models
Expand Down Expand Up @@ -641,6 +651,9 @@ module FatesInterfaceTypesMod
! for use in ELMs CTC/RD [g/m2/s]





! CH4 Boundary Conditions
! -----------------------------------------------------------------------------------
real(r8), pointer :: annavg_agnpp_pa(:) ! annual average patch npp above ground (gC/m2/s)
Expand Down
4 changes: 2 additions & 2 deletions main/FatesInventoryInitMod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -734,7 +734,7 @@ subroutine set_inventory_edpatch_type1(newpatch,pss_file_unit,ipa,ios,patch_name
! water (NA) Water content of soil (NOT USED)
! fsc (kg/m2) Fast Soil Carbon
! stsc (kg/m2) Structural Soil Carbon
! stsl (kg/m2) Structural Soil Lignan
! stsl (kg/m2) Structural Soil Lignin
! ssc (kg/m2) Slow Soil Carbon
! psc (NA) Passive Soil Carbon (NOT USED)
! msn (kg/m2) Mineralized Soil Nitrogen
Expand Down Expand Up @@ -763,7 +763,7 @@ subroutine set_inventory_edpatch_type1(newpatch,pss_file_unit,ipa,ios,patch_name
real(r8) :: p_water ! Patch water (unused)
real(r8) :: p_fsc ! Patch fast soil carbon
real(r8) :: p_stsc ! Patch structural soil carbon
real(r8) :: p_stsl ! Patch structural soil lignans
real(r8) :: p_stsl ! Patch structural soil lignins
real(r8) :: p_ssc ! Patch slow soil carbon
real(r8) :: p_psc ! Patch P soil carbon
real(r8) :: p_msn ! Patch mean soil nitrogen
Expand Down
2 changes: 1 addition & 1 deletion parteh/PRTGenericMod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -279,7 +279,7 @@ module PRTGenericMod
! examples are carbon12_element
! nitrogen_element, etc.

integer, public :: element_pos(num_organ_types) ! This is the reverse lookup
integer, public :: element_pos(num_element_types) ! This is the reverse lookup
! for element types. Pick an element
! global index, and it gives you
! the position in the element_list
Expand Down

0 comments on commit 5ca52ce

Please sign in to comment.