Skip to content

Commit

Permalink
Merge pull request #2 from rgknox/hydro_picard_rootdisagg
Browse files Browse the repository at this point in the history 
merge root density disagregation
  • Loading branch information
@pnlfang
pnlfang authored Jan 18, 2022
2 parents 5f26b11 + b5c38f0 commit ad37b99
Show file tree
Hide file tree
Showing 2 changed files with 48 additions and 15 deletions.
57 changes: 42 additions & 15 deletions biogeophys/FatesPlantHydraulicsMod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1266,7 +1266,7 @@ subroutine FuseCohortHydraulics(currentSite,currentCohort, nextCohort, bc_in, ne
type(ed_site_hydr_type), pointer :: csite_hydr
type(ed_cohort_hydr_type), pointer :: ccohort_hydr ! current cohort hydraulics derived type
type(ed_cohort_hydr_type), pointer :: ncohort_hydr ! donor (next) cohort hydraulics d type
real(r8) :: vol_c1,vol_c2 ! Total water volume in the each cohort
real(r8) :: vol_c1,vol_c2 ! Total water volume in the each cohort
integer :: j,k ! indices
integer :: ft

Expand Down Expand Up @@ -1460,8 +1460,8 @@ subroutine InitHydrSites(sites,bc_in)
! ----------------------------------------------------------------------------------


aggmeth = rhizlayer_aggmeth_balN
aggN = 10
aggmeth = rhizlayer_aggmeth_combine12
aggN = -9

select case(aggmeth)

Expand Down Expand Up @@ -2472,12 +2472,14 @@ subroutine hydraulics_bc ( nsites, sites, bc_in, bc_out, dtime)
real(r8) :: ftc_layer ! fraction of maximum conductance [-]
real(r8) :: weight ! weighting function for each layer when disaggregating rhiz->soil
real(r8) :: sumweight ! sum of weighting functions for disaggregating rhiz -> soil


real(r8) :: sum_l_aroot ! sum of root length of cohort, for disaggregation
real(r8) :: rootfr ! fraction of root mass in soil layer, for disaggregation
real(r8) :: z_fr ! Maximum fine root depth, used in disaggregation

integer, parameter :: soilz_disagg = 0 ! disaggregate rhizosphere layers based on depth
integer, parameter :: soilk_disagg = 1 ! disaggregate rhizosphere layers based on conductance

integer, parameter :: rootflux_disagg = soilz_disagg
integer, parameter :: rootflux_disagg = soilk_disagg


! ----------------------------------------------------------------------------------
Expand Down Expand Up @@ -2717,7 +2719,7 @@ subroutine hydraulics_bc ( nsites, sites, bc_in, bc_out, dtime)

ccohort => ccohort%shorter
enddo !cohort
endif ! not barground patch
endif ! not bareground patch
cpatch => cpatch%younger
enddo !patch

Expand All @@ -2742,7 +2744,33 @@ subroutine hydraulics_bc ( nsites, sites, bc_in, bc_out, dtime)
bc_out(s)%qflx_soil2root_sisl(:) = 0._r8
bc_out(s)%qflx_ro_sisl(:) = 0._r8


! To disaggregate, we need the root density (length) on the soil layer
csite_hydr%rootfr_sl(:) = 0._r8
cpatch => sites(s)%oldest_patch
do while (associated(cpatch))
ccohort=>cpatch%tallest
do while(associated(ccohort))

sum_l_aroot = sum(ccohort_hydr%l_aroot_layer(:))
ft = ccohort%pft

call MaximumRootingDepth(ccohort%dbh,ft,bc_in(s)%zi_sisl(bc_in(s)%nlevsoil),z_fr)

do j_bc = 1,bc_in(s)%nlevsoil

rootfr = zeng2001_crootfr(prt_params%fnrt_prof_a(ft),prt_params%fnrt_prof_b(ft),bc_in(s)%zi_sisl(j_bc),z_fr) - &
zeng2001_crootfr(prt_params%fnrt_prof_a(ft),prt_params%fnrt_prof_b(ft), bc_in(s)%zi_sisl(j_bc)-bc_in(s)%dz_sisl(j_bc),z_fr)

csite_hydr%rootfr_sl(j_bc) = csite_hydr%rootfr_sl(j_bc) + sum_l_aroot*rootfr*ccohort%n

end do

ccohort => ccohort%shorter
enddo !cohort
cpatch => cpatch%younger
enddo !patch


do j=1,csite_hydr%nlevrhiz


Expand Down Expand Up @@ -2777,7 +2805,6 @@ subroutine hydraulics_bc ( nsites, sites, bc_in, bc_out, dtime)
j_t = csite_hydr%map_r2s(j,1)
j_b = csite_hydr%map_r2s(j,2)

! First pass, get sum of weighting factors for disaggregation
sumweight = 0._r8
do j_bc = j_t,j_b
if(rootflux_disagg == soilk_disagg)then
Expand All @@ -2789,13 +2816,13 @@ subroutine hydraulics_bc ( nsites, sites, bc_in, bc_out, dtime)
h2osoi_liqvol = min(eff_por, bc_in(s)%h2o_liq_sisl(j_bc)/(bc_in(s)%dz_sisl(j_bc)*denh2o))
psi_layer = csite_hydr%wrf_soil(j)%p%psi_from_th(h2osoi_liqvol)
ftc_layer = csite_hydr%wkf_soil(j)%p%ftc_from_psi(psi_layer)
weight = bc_in(s)%hksat_sisl(j_bc)*ftc_layer*bc_in(s)%dz_sisl(j_bc)
weight = bc_in(s)%hksat_sisl(j_bc)*ftc_layer*csite_hydr%rootfr_sl(j_bc) !bc_in(s)%dz_sisl(j_bc)
else
weight = bc_in(s)%dz_sisl(j_bc)
weight = csite_hydr%rootfr_sl(j_bc) !bc_in(s)%dz_sisl(j_bc)
end if
elseif(rootflux_disagg == soilz_disagg) then
! weight by depth
weight = bc_in(s)%dz_sisl(j_bc)
weight = csite_hydr%rootfr_sl(j_bc) !bc_in(s)%dz_sisl(j_bc)
else
write(fates_log(),*) 'Unknown rhiz->soil disaggregation method',rootflux_disagg
call endrun(msg=errMsg(sourcefile, __LINE__))
Expand All @@ -2811,12 +2838,12 @@ subroutine hydraulics_bc ( nsites, sites, bc_in, bc_out, dtime)
h2osoi_liqvol = min(eff_por, bc_in(s)%h2o_liq_sisl(j_bc)/(bc_in(s)%dz_sisl(j_bc)*denh2o))
psi_layer = csite_hydr%wrf_soil(j)%p%psi_from_th(h2osoi_liqvol)
ftc_layer = csite_hydr%wkf_soil(j)%p%ftc_from_psi(psi_layer)
weight = bc_in(s)%hksat_sisl(j_bc)*ftc_layer*bc_in(s)%dz_sisl(j_bc)
weight = bc_in(s)%hksat_sisl(j_bc)*ftc_layer*csite_hydr%rootfr_sl(j_bc) !bc_in(s)%dz_sisl(j_bc)
else
weight = bc_in(s)%dz_sisl(j_bc)
weight = csite_hydr%rootfr_sl(j_bc) !bc_in(s)%dz_sisl(j_bc)
end if
elseif(rootflux_disagg == soilz_disagg) then
weight = bc_in(s)%dz_sisl(j_bc)
weight = csite_hydr%rootfr_sl(j_bc) !bc_in(s)%dz_sisl(j_bc)
end if

! Fill the output array to the HLM
Expand Down
6 changes: 6 additions & 0 deletions main/FatesHydraulicsMemMod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -134,6 +134,11 @@ module FatesHydraulicsMemMod

real(r8),allocatable :: rootuptake_sl(:)

! Absorbing root fraction on the soil grid. We need this to
! disaggregate uptake fluxes from the rhizosphere layers to
! the soil layers
real(r8),allocatable :: rootfr_sl(:)

! Root uptake per pft x size class, over set layer depths [kg/ha/m/s]
! These are normalized by depth (in case the desired horizon extends
! beyond the actual rhizosphere)
Expand Down Expand Up @@ -389,6 +394,7 @@ subroutine InitHydrSite(this,numpft,numlevsclass,hydr_solver_type,nlevsoil)
allocate(this%recruit_w_uptake(1:nlevrhiz)); this%recruit_w_uptake = nan

allocate(this%rootuptake_sl(1:nlevsoil)) ; this%rootuptake_sl = nan
allocate(this%rootfr_sl(1:nlevsoil)) ; this%rootfr_sl = 0._r8

allocate(this%sapflow_scpf(1:numlevsclass,1:numpft)) ; this%sapflow_scpf = nan
allocate(this%rootuptake0_scpf(1:numlevsclass,1:numpft)) ; this%rootuptake0_scpf = nan
Expand Down

0 comments on commit ad37b99

Please sign in to comment.