@@ -128,22 +128,6 @@ module FatesAllometryMod
128128 character (len=* ), parameter :: sourcefile = __FILE__
129129
130130
131- ! The code will call the wrapper routine "set_root_fraction"
132- ! in at least two different context. In one context it will query
133- ! set_root_fraction to describe the depth profile of hydraulicly
134- ! active roots. In the other context, it will ask the wrapper
135- ! to define the profile of roots as litter. We allow these
136- ! two contexts to differ. While not fully implemented, the use
137- ! will have control parameters to choose from different relationships
138- ! in these two contexts. The calling function, therefore
139- ! has to tell the wrapper function which context (water or biomass)
140- ! is being querried. So that we don't have to do messy string
141- ! parsing, we have two pre-defined flags.
142-
143- integer , parameter , public :: i_hydro_rootprof_context = 1
144- integer , parameter , public :: i_biomass_rootprof_context = 2
145-
146-
147131 ! If testing b4b with older versions, do not remove sapwood
148132 ! Our old methods with saldarriaga did not remove sapwood from the
149133 ! bdead pool. But newer allometries are providing total agb
@@ -1977,7 +1961,8 @@ end subroutine carea_2pwr
19771961
19781962 ! =========================================================================
19791963
1980- subroutine set_root_fraction (root_fraction , ft , zi , icontext )
1964+ subroutine set_root_fraction (root_fraction , ft , zi )
1965+
19811966 !
19821967 ! !DESCRIPTION:
19831968 ! Calculates the fractions of the root biomass in each layer for each pft.
@@ -1992,7 +1977,6 @@ subroutine set_root_fraction(root_fraction, ft, zi, icontext )
19921977 real (r8 ),intent (inout ) :: root_fraction(:) ! Normalized profile
19931978 integer , intent (in ) :: ft ! functional typpe
19941979 real (r8 ),intent (in ) :: zi(0 :) ! Center of depth [m]
1995- integer ,intent (in ) :: icontext
19961980
19971981 ! Parameters
19981982 !
@@ -2009,8 +1993,8 @@ subroutine set_root_fraction(root_fraction, ft, zi, icontext )
20091993 ! exponential.
20101994 ! All methods return a normalized profile.
20111995
2012- integer , parameter :: exponential_1p_profile_type = 1
2013- integer , parameter :: jackson_beta_profile_type = 2
1996+ integer , parameter :: jackson_beta_profile_type = 1
1997+ integer , parameter :: exponential_1p_profile_type = 2
20141998 integer , parameter :: exponential_2p_profile_type = 3
20151999
20162000 integer :: root_profile_type
@@ -2027,40 +2011,21 @@ subroutine set_root_fraction(root_fraction, ft, zi, icontext )
20272011 call endrun(msg= errMsg(sourcefile, __LINE__))
20282012 end if
20292013
2030- if (icontext == i_hydro_rootprof_context) then
2031-
2032- root_profile_type = exponential_2p_profile_type
2033-
2034- else if (icontext == i_biomass_rootprof_context) then
2035-
2036- root_profile_type = jackson_beta_profile_type
2037-
2038- else
2039- write (fates_log(),* ) ' An undefined context for calculating root profiles was provided'
2040- write (fates_log(),* ) ' There are only two contexts, hydraulic and biomass, pick one.'
2041- write (fates_log(),* ) ' Aborting'
2042- call endrun(msg= errMsg(sourcefile, __LINE__))
2043- end if
2044-
20452014
2046- select case (root_profile_type )
2015+ select case (nint (EDPftvarcon_inst % fnrt_prof_mode(ft)) )
20472016 case ( exponential_1p_profile_type )
2048- call exponential_1p_root_profile(root_fraction, ft, zi)
2017+ call exponential_1p_root_profile(root_fraction, ft, zi, EDPftvarcon_inst % fnrt_prof_a(ft) )
20492018 case ( jackson_beta_profile_type )
2050- call jackson_beta_root_profile(root_fraction, ft, zi)
2019+ call jackson_beta_root_profile(root_fraction, ft, zi, EDPftvarcon_inst % fnrt_prof_a(ft) )
20512020 case ( exponential_2p_profile_type )
2052- call exponential_2p_root_profile(root_fraction, ft, zi)
2021+ call exponential_2p_root_profile(root_fraction, ft, zi, &
2022+ EDPftvarcon_inst% fnrt_prof_a(ft),EDPftvarcon_inst% fnrt_prof_b(ft))
20532023 case default
20542024 write (fates_log(),* ) ' An undefined root profile type was specified'
20552025 write (fates_log(),* ) ' Aborting'
20562026 call endrun(msg= errMsg(sourcefile, __LINE__))
20572027 end select
20582028
2059- ! if( abs(sum(root_fraction)-1.0_r8) > 1.e-9_r8 ) then
2060- ! write(fates_log(),*) 'Root fractions should add up to 1'
2061- ! write(fates_log(),*) root_fraction
2062- ! call endrun(msg=errMsg(sourcefile, __LINE__))
2063- ! end if
20642029
20652030 correction = 1._r8 - sum (root_fraction)
20662031 corr_id = maxloc (root_fraction)
@@ -2073,27 +2038,49 @@ end subroutine set_root_fraction
20732038
20742039 ! =====================================================================================
20752040
2076- subroutine exponential_2p_root_profile (root_fraction , ft , zi )
2041+ subroutine exponential_2p_root_profile (root_fraction , ft , zi , a , b )
20772042 !
20782043 ! !ARGUMENTS
20792044 real (r8 ),intent (out ) :: root_fraction(:)
20802045 integer ,intent (in ) :: ft
20812046 real (r8 ),intent (in ) :: zi(0 :)
2047+ real (r8 ),intent (in ) :: a ! Exponential shape parameter a
2048+ real (r8 ),intent (in ) :: b ! Exponential shape parameter b
20822049
20832050 ! Locals
20842051 integer :: nlevsoil ! Number of soil layers
20852052 integer :: lev ! soil layer index
20862053 real (r8 ) :: sum_rootfr ! sum of root fraction for normalization
2087-
2054+
2055+
2056+ ! Original default parameters:
2057+ !
2058+ ! broadleaf_evergreen_tropical_tree
2059+ ! needleleaf_evergreen_extratrop_tree
2060+ ! needleleaf_colddecid_extratrop_tree
2061+ ! broadleaf_evergreen_extratrop_tree
2062+ ! broadleaf_hydrodecid_tropical_tree
2063+ ! broadleaf_colddecid_extratrop_tree
2064+ ! broadleaf_evergreen_extratrop_shrub
2065+ ! broadleaf_hydrodecid_extratrop_shrub
2066+ ! broadleaf_colddecid_extratrop_shrub
2067+ ! arctic_c3_grass
2068+ ! cool_c3_grass
2069+ ! c4_grass
2070+ !
2071+ ! a = 7, 7, 7, 7, 6, 6, 7, 7, 7, 11, 11, 11 ;
2072+ ! b = 1, 2, 2, 1, 2, 2, 1.5, 1.5, 1.5, 2, 2, 2 ;
2073+
2074+
20882075 nlevsoil = ubound (zi,1 )
20892076
20902077 sum_rootfr = 0.0_r8
20912078 do lev = 1 , nlevsoil
20922079 root_fraction(lev) = .5_r8 * ( &
2093- exp (- EDPftvarcon_inst % roota_par(ft) * zi(lev-1 )) &
2094- + exp (- EDPftvarcon_inst % rootb_par(ft) * zi(lev-1 )) &
2095- - exp (- EDPftvarcon_inst % roota_par(ft) * zi(lev)) &
2096- - exp (- EDPftvarcon_inst % rootb_par(ft) * zi(lev)))
2080+ exp (- a * zi(lev-1 )) &
2081+ + exp (- b * zi(lev-1 )) &
2082+ - exp (- a * zi(lev)) &
2083+ - exp (- b * zi(lev)))
20972084
20982085 sum_rootfr = sum_rootfr + root_fraction(lev)
20992086 end do
@@ -2106,30 +2093,32 @@ end subroutine exponential_2p_root_profile
21062093
21072094 ! =====================================================================================
21082095
2109- subroutine exponential_1p_root_profile (root_fraction , ft , zi )
2096+ subroutine exponential_1p_root_profile (root_fraction , ft , zi , a )
21102097
21112098 !
21122099 ! !ARGUMENTS
21132100 real (r8 ),intent (out ) :: root_fraction(:)
21142101 integer ,intent (in ) :: ft
21152102 real (r8 ),intent (in ) :: zi(0 :)
2116-
2103+ real (r8 ),intent (in ) :: a ! Exponential shape parameter a
2104+
21172105 !
21182106 ! LOCAL VARIABLES:
21192107 integer :: lev ! soil depth layer index
21202108 integer :: nlevsoil ! number of soil layers
21212109 real (r8 ) :: depth ! Depth to middle of layer [m]
21222110 real (r8 ) :: sum_rootfr ! sum of rooting profile for normalization
21232111
2124- real (r8 ), parameter :: rootprof_exp = 3 . ! how steep profile is
2112+ ! Typical default parameter is a = 3.
2113+ ! how steep profile is
21252114 ! for root C inputs (1/ e-folding depth) (1/m)
21262115
21272116 nlevsoil = ubound (zi,1 )
21282117
21292118 ! define rooting profile from exponential parameters
21302119 sum_rootfr = 0.0_r8
21312120 do lev = 1 , nlevsoil
2132- root_fraction(lev) = exp (- rootprof_exp * 0.5 * (zi(lev)+ zi(lev-1 )) )
2121+ root_fraction(lev) = exp (- a * 0.5 * (zi(lev)+ zi(lev-1 )) )
21332122 sum_rootfr = sum_rootfr + root_fraction(lev)
21342123 end do
21352124
@@ -2142,33 +2131,32 @@ end subroutine exponential_1p_root_profile
21422131
21432132 ! =====================================================================================
21442133
2145- subroutine jackson_beta_root_profile (root_fraction , ft , zi )
2134+ subroutine jackson_beta_root_profile (root_fraction , ft , zi , a )
2135+
2136+ ! -----------------------------------------------------------------------------------
2137+ ! use beta distribution parameter from Jackson et al., 1996
2138+ ! -----------------------------------------------------------------------------------
21462139
2147-
21482140 ! !ARGUMENTS
21492141 real (r8 ),intent (out ) :: root_fraction(:) ! fraction of root mass in each soil layer
21502142 integer ,intent (in ) :: ft ! functional type
21512143 real (r8 ),intent (in ) :: zi(0 :) ! depth of layer interfaces 0-nlevsoil
2152-
2144+ real (r8 ),intent (in ) :: a ! Exponential shape parameter a
2145+
21532146 !
21542147 ! LOCAL VARIABLES:
21552148 integer :: lev ! soil depth layer index
21562149 integer :: nlevsoil ! number of soil layers
21572150 real (r8 ) :: sum_rootfr ! sum of rooting profile, for normalization
21582151
2159- ! Note cdk 2016/08 we actually want to use the carbon index here rather than the water index.
2160- ! Doing so will be answer changing though so perhaps easiest to do this in steps.
2161- integer , parameter :: rooting_profile_varindex_water = 1
2152+ ! Original defaults in fates, a = 0.976 (all Pfts)
21622153
21632154 nlevsoil = ubound (zi,1 )
2164- ! use beta distribution parameter from Jackson et al., 1996
2155+
21652156 sum_rootfr = 0.0_r8
21662157 do lev = 1 , nlevsoil
21672158 root_fraction(lev) = &
2168- ( EDPftvarcon_inst% rootprof_beta(ft, rooting_profile_varindex_water) ** &
2169- ( zi(lev-1 )* 100._r8 ) - &
2170- EDPftvarcon_inst% rootprof_beta(ft, rooting_profile_varindex_water) ** &
2171- ( zi(lev)* 100._r8 ) )
2159+ ( a ** ( zi(lev-1 )* 100._r8 ) - a ** ( zi(lev)* 100._r8 ) )
21722160 sum_rootfr = sum_rootfr + root_fraction(lev)
21732161 end do
21742162
0 commit comments