From a3b094f290ece99730658b0d7c1c5fd2365cb3ee Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Fri, 1 Oct 2021 10:05:33 -0400 Subject: [PATCH] cleaning up root depth branch --- biogeochem/EDCanopyStructureMod.F90 | 12 ++++++------ biogeochem/FatesAllometryMod.F90 | 2 +- biogeophys/FatesPlantHydraulicsMod.F90 | 24 +++++++++--------------- fire/SFMainMod.F90 | 2 +- main/FatesHistoryInterfaceMod.F90 | 5 +++-- main/FatesHydraulicsMemMod.F90 | 10 +++++----- 6 files changed, 25 insertions(+), 30 deletions(-) diff --git a/biogeochem/EDCanopyStructureMod.F90 b/biogeochem/EDCanopyStructureMod.F90 index 08e6c0513f..586a4b39af 100644 --- a/biogeochem/EDCanopyStructureMod.F90 +++ b/biogeochem/EDCanopyStructureMod.F90 @@ -1601,19 +1601,19 @@ subroutine leaf_area_profile( currentSite ) currentCohort => currentPatch%shortest do while(associated(currentCohort)) ft = currentCohort%pft - min_chite = currentCohort%hite - currentCohort%hite * EDPftvarcon_inst%crown(ft) + min_chite = currentCohort%hite - currentCohort%hite * prt_params%crown(ft) max_chite = currentCohort%hite do iv = 1,N_HITE_BINS frac_canopy(iv) = 0.0_r8 ! this layer is in the middle of the canopy if(max_chite > maxh(iv).and.min_chite < minh(iv))then - frac_canopy(iv)= min(1.0_r8,dh / (currentCohort%hite*EDPftvarcon_inst%crown(ft))) + frac_canopy(iv)= min(1.0_r8,dh / (currentCohort%hite*prt_params%crown(ft))) ! this is the layer with the bottom of the canopy in it. elseif(min_chite < maxh(iv).and.min_chite > minh(iv).and.max_chite > maxh(iv))then - frac_canopy(iv) = (maxh(iv) -min_chite ) / (currentCohort%hite*EDPftvarcon_inst%crown(ft)) + frac_canopy(iv) = (maxh(iv) -min_chite ) / (currentCohort%hite*prt_params%crown(ft)) ! this is the layer with the top of the canopy in it. elseif(max_chite > minh(iv).and.max_chite < maxh(iv).and.min_chite < minh(iv))then - frac_canopy(iv) = (max_chite - minh(iv)) / (currentCohort%hite*EDPftvarcon_inst%crown(ft)) + frac_canopy(iv) = (max_chite - minh(iv)) / (currentCohort%hite*prt_params%crown(ft)) elseif(max_chite < maxh(iv).and.min_chite > minh(iv))then !the whole cohort is within this layer. frac_canopy(iv) = 1.0_r8 endif @@ -1709,11 +1709,11 @@ subroutine leaf_area_profile( currentSite ) layer_top_hite = currentCohort%hite - & ( real(iv-1,r8)/currentCohort%NV * currentCohort%hite * & - EDPftvarcon_inst%crown(currentCohort%pft) ) + prt_params%crown(currentCohort%pft) ) layer_bottom_hite = currentCohort%hite - & ( real(iv,r8)/currentCohort%NV * currentCohort%hite * & - EDPftvarcon_inst%crown(currentCohort%pft) ) + prt_params%crown(currentCohort%pft) ) fraction_exposed = 1.0_r8 if(currentSite%snow_depth > layer_top_hite)then diff --git a/biogeochem/FatesAllometryMod.F90 b/biogeochem/FatesAllometryMod.F90 index c8a38abd8c..6b315d4ef8 100644 --- a/biogeochem/FatesAllometryMod.F90 +++ b/biogeochem/FatesAllometryMod.F90 @@ -2005,7 +2005,7 @@ subroutine CrownDepth(height,ft,crown_depth) ! Original FATES crown depth heigh used for hydraulics ! crown_depth = min(height,0.1_r8) - crown_depth = prt_params%crown(ft) * plant_height + crown_depth = prt_params%crown(ft) * height return diff --git a/biogeophys/FatesPlantHydraulicsMod.F90 b/biogeophys/FatesPlantHydraulicsMod.F90 index 87cb52fe0d..586d1b3c68 100644 --- a/biogeophys/FatesPlantHydraulicsMod.F90 +++ b/biogeophys/FatesPlantHydraulicsMod.F90 @@ -85,8 +85,6 @@ module FatesPlantHydraulicsMod use FatesHydraulicsMemMod, only: aroot_p_media use FatesHydraulicsMemMod, only: rhiz_p_media use FatesHydraulicsMemMod, only: nlevsoi_hyd_max -! use FatesHydraulicsMemMod, only: cohort_recruit_water_layer -! use FatesHydraulicsMemMod, only: recruit_water_avail_layer use FatesHydraulicsMemMod, only: rwccap, rwcft use FatesHydraulicsMemMod, only: ignore_layer1 @@ -1707,8 +1705,6 @@ subroutine ConstrainRecruitNumber(csite,ccohort, bc_in) integer :: element_id ! global element identifier index real(r8) :: leaf_m, store_m, sapw_m ! Element mass in organ tissues real(r8) :: fnrt_m, struct_m, repro_m ! Element mass in organ tissues - real(r8) :: cohort_recruit_water_layer(csite_hydr%nlevrhiz) - real(r8) :: recruit_water_avail_layer(csite_hydr%nlevrhiz) cpatch => ccohort%patchptr csite_hydr => csite%si_hydr @@ -1720,11 +1716,9 @@ subroutine ConstrainRecruitNumber(csite,ccohort, bc_in) sum_l_aroot = sum(ccohort_hydr%l_aroot_layer(:)) do j=1,csite_hydr%nlevrhiz - cohort_recruit_water_layer(j) = recruitw*ccohort_hydr%l_aroot_layer(j)/sum_l_aroot + csite_hydr%cohort_recruit_water_layer(j) = recruitw*ccohort_hydr%l_aroot_layer(j)/sum_l_aroot end do - recruit_water_avail_layer(:) = 0._r8 - do j=1,csite_hydr%nlevrhiz watres_local = csite_hydr%wrf_soil(j)%p%th_from_psi(bc_in%smpmin_si*denh2o*grav_earth*m_per_mm*mpa_per_pa) @@ -1733,14 +1727,14 @@ subroutine ConstrainRecruitNumber(csite,ccohort, bc_in) total_water_min = sum(csite_hydr%v_shell(j,:)*watres_local) !assumes that only 50% is available for recruit water.... - recruit_water_avail_layer(j)=0.5_r8*max(0.0_r8,total_water-total_water_min) + csite_hydr%recruit_water_avail_layer(j)=0.5_r8*max(0.0_r8,total_water-total_water_min) end do nmin = 1.0e+36 do j=1,csite_hydr%nlevrhiz - if(cohort_recruit_water_layer(j)>nearzero) then - n = recruit_water_avail_layer(j)/cohort_recruit_water_layer(j) + if(csite_hydr%cohort_recruit_water_layer(j)>nearzero) then + n = csite_hydr%recruit_water_avail_layer(j)/csite_hydr%cohort_recruit_water_layer(j) nmin = min(n, nmin) endif end do @@ -4315,7 +4309,7 @@ function zeng2001_crootfr(a, b, z, z_max) result(crootfr) if(present(z_max))then ! If the soil depth is larger than the maximum rooting depth of the cohort, ! then the cumulative root fraction of that layer equals that of the maximum rooting depth - crootfr = 1._r8 - .5_r8*(exp(-a*min(z,z_max)) + exp(-b*min(z,z_max)) + crootfr = 1._r8 - .5_r8*(exp(-a*min(z,z_max)) + exp(-b*min(z,z_max))) crootfr_max = 1._r8 - .5_r8*(exp(-a*z_max) + exp(-b*z_max)) crootfr = crootfr/crootfr_max end if @@ -4337,7 +4331,7 @@ end function zeng2001_crootfr ! ===================================================================================== -subroutine shellGeom(l_aroot, rs1, area_site, dz, r_out_shell, r_node_shell, v_shell) +subroutine shellGeom(l_aroot_in, rs1_in, area_site, dz, r_out_shell, r_node_shell, v_shell) ! ! !DESCRIPTION: Updates size of 'representative' rhizosphere -- node radii, volumes. ! As fine root biomass (and thus absorbing root length) increases, this characteristic @@ -4364,11 +4358,11 @@ subroutine shellGeom(l_aroot, rs1, area_site, dz, r_out_shell, r_node_shell, v_s integer :: k ! rhizosphere shell indicies integer :: nshells ! We don't use the global because of unit testing - ! When we have no roots, we use a nominal + + ! When we have no roots, we may choose to use a nominal ! value of 1cm per cubic meter to define the rhizosphere shells ! this "should" help with the transition when roots grow into a layer - - real(r8), parameter :: nominal_l_aroot = 0.01_r8 ! m/m3 + ! real(r8), parameter :: nominal_l_aroot = 0.01_r8 ! m/m3 !----------------------------------------------------------------------- diff --git a/fire/SFMainMod.F90 b/fire/SFMainMod.F90 index 00470cc6de..1d08ae2e51 100644 --- a/fire/SFMainMod.F90 +++ b/fire/SFMainMod.F90 @@ -937,7 +937,7 @@ subroutine crown_damage ( currentSite ) (currentCohort%hite-crown_depth))) then currentCohort%fraction_crown_burned = (currentPatch%Scorch_ht(currentCohort%pft) - & - (currentCohort%hite - crown_depth)/crown_depth + (currentCohort%hite - crown_depth))/crown_depth else ! Flames over top of canopy. diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 3699353de5..a6e93d2a34 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -1775,6 +1775,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) real(r8) :: struct_m_net_alloc real(r8) :: repro_m_net_alloc real(r8) :: area_frac + real(r8) :: crown_depth type(ed_patch_type),pointer :: cpatch type(ed_cohort_type),pointer :: ccohort @@ -2231,8 +2232,8 @@ subroutine update_history_dyn(this,nc,nsites,sites) endif ! what fraction of a cohort's crown is in this height bin? frac_canopy_in_bin = (min(bintop,ccohort%hite) - & - max(binbottom,ccohort%hite * (1._r8 - EDPftvarcon_inst%crown(ft)))) / & - (ccohort%hite * EDPftvarcon_inst%crown(ft)) + max(binbottom,ccohort%hite-crown_depth)) / & + (crown_depth) ! hio_leaf_height_dist_si_height(io_si,i_heightbin) = & hio_leaf_height_dist_si_height(io_si,i_heightbin) + & diff --git a/main/FatesHydraulicsMemMod.F90 b/main/FatesHydraulicsMemMod.F90 index 9fe0f03acd..f971b4f55b 100644 --- a/main/FatesHydraulicsMemMod.F90 +++ b/main/FatesHydraulicsMemMod.F90 @@ -70,9 +70,7 @@ module FatesHydraulicsMemMod ! ---------------------------------------------------------------------------------------------- !temporatory variables - !real(r8), public :: cohort_recruit_water_layer(nlevsoi_hyd_max) ! the recruit water requirement for a - ! single individual at different layer (kg H2o/m2) - !real(r8), public :: recruit_water_avail_layer(nlevsoi_hyd_max) ! the recruit water avaibility from soil (kg H2o/m2) + type, public :: ed_site_hydr_type @@ -185,10 +183,12 @@ module FatesHydraulicsMemMod real(r8), allocatable :: q_flux(:) real(r8), allocatable :: dftc_dpsi_node(:) real(r8), allocatable :: ftc_node(:) - - real(r8), allocatable :: kmax_up(:) real(r8), allocatable :: kmax_dn(:) + + ! Scratch arrays + real(r8) :: cohort_recruit_water_layer(nlevsoi_hyd_max) ! the recruit water requirement for a + real(r8) :: recruit_water_avail_layer(nlevsoi_hyd_max) ! the recruit water avaibility from soil (kg H2o/m2) contains