From b0c2dc4c466f22c8467051d1ed8ac5213c523713 Mon Sep 17 00:00:00 2001 From: Sean Swenson Date: Mon, 7 May 2018 14:04:52 -0600 Subject: [PATCH 01/76] add vegetation/stem heat capacity --- src/biogeophys/BalanceCheckMod.F90 | 3 +- src/biogeophys/CanopyFluxesMod.F90 | 241 +++++++++++++++++++------ src/biogeophys/EnergyFluxType.F90 | 27 ++- src/biogeophys/FrictionVelocityMod.F90 | 80 +++++++- src/biogeophys/SoilFluxesMod.F90 | 3 +- src/biogeophys/TemperatureType.F90 | 9 + 6 files changed, 302 insertions(+), 61 deletions(-) diff --git a/src/biogeophys/BalanceCheckMod.F90 b/src/biogeophys/BalanceCheckMod.F90 index 91de50944f..cadc8274b6 100644 --- a/src/biogeophys/BalanceCheckMod.F90 +++ b/src/biogeophys/BalanceCheckMod.F90 @@ -197,6 +197,7 @@ subroutine BalanceCheck( bounds, & qflx_glcice_dyn_water_flux => glacier_smb_inst%qflx_glcice_dyn_water_flux_col, & ! Input: [real(r8) (:)] water flux needed for balance check due to glc_dyn_runoff_routing (mm H2O/s) (positive means addition of water to the system) + hs_canopy => energyflux_inst%hs_canopy_patch , & ! Input: [real(r8) (:) ] change in heat content of stem (W/m**2) [+ to atm] eflx_lwrad_out => energyflux_inst%eflx_lwrad_out_patch , & ! Input: [real(r8) (:) ] emitted infrared (longwave) radiation (W/m**2) eflx_lwrad_net => energyflux_inst%eflx_lwrad_net_patch , & ! Input: [real(r8) (:) ] net infrared (longwave) rad (W/m**2) [+ = to atm] eflx_sh_tot => energyflux_inst%eflx_sh_tot_patch , & ! Input: [real(r8) (:) ] total sensible heat flux (W/m**2) [+ to atm] @@ -501,7 +502,7 @@ subroutine BalanceCheck( bounds, & if (.not. lun%urbpoi(l)) then errseb(p) = sabv(p) + sabg_chk(p) + forc_lwrad(c) - eflx_lwrad_out(p) & - - eflx_sh_tot(p) - eflx_lh_tot(p) - eflx_soil_grnd(p) + - eflx_sh_tot(p) - eflx_lh_tot(p) - eflx_soil_grnd(p) - hs_canopy(p) else errseb(p) = sabv(p) + sabg(p) & - eflx_lwrad_net(p) & diff --git a/src/biogeophys/CanopyFluxesMod.F90 b/src/biogeophys/CanopyFluxesMod.F90 index 7c9feb8a25..872e077c3c 100644 --- a/src/biogeophys/CanopyFluxesMod.F90 +++ b/src/biogeophys/CanopyFluxesMod.F90 @@ -15,7 +15,7 @@ module CanopyFluxesMod use abortutils , only : endrun use clm_varctl , only : iulog, use_cn, use_lch4, use_c13, use_c14, use_cndv, use_fates, & use_luna, use_hydrstress - use clm_varpar , only : nlevgrnd, nlevsno + use clm_varpar , only : nlevgrnd, nlevsno, mxpft use clm_varcon , only : namep use pftconMod , only : pftcon use decompMod , only : bounds_type @@ -167,7 +167,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ! less than 0.1 W/m2; or the iterative steps over 40. ! ! !USES: - use shr_const_mod , only : SHR_CONST_RGAS + use shr_const_mod , only : SHR_CONST_RGAS, shr_const_pi use clm_time_manager , only : get_step_size, get_prev_date,is_end_curr_day use clm_varcon , only : sb, cpair, hvap, vkc, grav, denice use clm_varcon , only : denh2o, tfrz, csoilc, tlsai_crit, alpha_aero @@ -228,25 +228,18 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, real(r8) :: dtime ! land model time step (sec) real(r8) :: zldis(bounds%begp:bounds%endp) ! reference height "minus" zero displacement height [m] - real(r8) :: zeta ! dimensionless height used in Monin-Obukhov theory real(r8) :: wc ! convective velocity [m/s] real(r8) :: dth(bounds%begp:bounds%endp) ! diff of virtual temp. between ref. height and surface real(r8) :: dthv(bounds%begp:bounds%endp) ! diff of vir. poten. temp. between ref. height and surface real(r8) :: dqh(bounds%begp:bounds%endp) ! diff of humidity between ref. height and surface - real(r8) :: obu(bounds%begp:bounds%endp) ! Monin-Obukhov length (m) - real(r8) :: um(bounds%begp:bounds%endp) ! wind speed including the stablity effect [m/s] real(r8) :: ur(bounds%begp:bounds%endp) ! wind speed at reference height [m/s] - real(r8) :: uaf(bounds%begp:bounds%endp) ! velocity of air within foliage [m/s] real(r8) :: temp1(bounds%begp:bounds%endp) ! relation for potential temperature profile real(r8) :: temp12m(bounds%begp:bounds%endp) ! relation for potential temperature profile applied at 2-m real(r8) :: temp2(bounds%begp:bounds%endp) ! relation for specific humidity profile real(r8) :: temp22m(bounds%begp:bounds%endp) ! relation for specific humidity profile applied at 2-m - real(r8) :: ustar(bounds%begp:bounds%endp) ! friction velocity [m/s] real(r8) :: tstar ! temperature scaling parameter real(r8) :: qstar ! moisture scaling parameter real(r8) :: thvstar ! virtual potential temperature scaling parameter - real(r8) :: taf(bounds%begp:bounds%endp) ! air temperature within canopy space [K] - real(r8) :: qaf(bounds%begp:bounds%endp) ! humidity of canopy air [kg/kg] real(r8) :: rpp ! fraction of potential evaporation from leaf [-] real(r8) :: rppdry ! fraction of potential evaporation through transp [-] real(r8) :: cf ! heat transfer coefficient from leaves [-] @@ -256,11 +249,13 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, real(r8) :: wta ! heat conductance for air [m/s] real(r8) :: wtg(bounds%begp:bounds%endp) ! heat conductance for ground [m/s] real(r8) :: wtl ! heat conductance for leaf [m/s] + real(r8) :: wtstem ! heat conductance for stem [m/s] real(r8) :: wta0(bounds%begp:bounds%endp) ! normalized heat conductance for air [-] real(r8) :: wtl0(bounds%begp:bounds%endp) ! normalized heat conductance for leaf [-] real(r8) :: wtg0 ! normalized heat conductance for ground [-] + real(r8) :: wtstem0(bounds%begp:bounds%endp) ! normalized heat conductance for stem [-] real(r8) :: wtal(bounds%begp:bounds%endp) ! normalized heat conductance for air and leaf [-] - real(r8) :: wtga ! normalized heat cond. for air and ground [-] + real(r8) :: wtga(bounds%begp:bounds%endp) ! normalized heat cond. for air and ground [-] real(r8) :: wtaq ! latent heat conductance for air [m/s] real(r8) :: wtlq ! latent heat conductance for leaf [m/s] real(r8) :: wtgq(bounds%begp:bounds%endp) ! latent heat conductance for ground [m/s] @@ -295,6 +290,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, real(r8) :: efsh ! sensible heat from leaf [mm/s] real(r8) :: obuold(bounds%begp:bounds%endp) ! monin-obukhov length from previous iteration real(r8) :: tlbef(bounds%begp:bounds%endp) ! leaf temperature from previous iteration [K] + real(r8) :: tsbef(bounds%begp:bounds%endp) ! stem temperature from previous iteration [K] real(r8) :: ecidif ! excess energies [W/m2] real(r8) :: err(bounds%begp:bounds%endp) ! balance error real(r8) :: erre ! balance error @@ -355,6 +351,30 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, integer :: iv logical :: is_end_day ! is end of current day + real(r8) :: cp_veg(bounds%begp:bounds%endp) !heat capacity of veg + real(r8) :: cp_stem(bounds%begp:bounds%endp) !heat capacity of stems + real(r8) :: dt_stem(bounds%begp:bounds%endp) + real(r8) :: fstem(bounds%begp:bounds%endp) !fraction of stem + real(r8) :: bhd(0:mxpft) !stem breast-height-diameter + real(r8) :: wood_density, carea_stem + real(r8) :: lw_stem(bounds%begp:bounds%endp) !internal longwave stem + real(r8) :: lw_leaf(bounds%begp:bounds%endp) !internal longwave leaf + real(r8) :: sa_stem(bounds%begp:bounds%endp) !surface area stem m2/m2_ground + real(r8) :: sa_leaf(bounds%begp:bounds%endp) !surface area leaf m2/m2_ground + real(r8) :: sa_internal(bounds%begp:bounds%endp) !min(sa_stem,sa_leaf) + real(r8) :: uuc(bounds%begp:bounds%endp) ! undercanopy windspeed + ! biomass parameters + real(r8), parameter :: c_to_b = 2.0_r8 !(g biomass /g C) + real(r8), parameter :: ntree = 0.4_r8 !(number of trees / m2) + real(r8), parameter :: rstem = 100._r8 !stem resistance (s/m) + + real(r8), parameter :: k_vert = 0.1 !vertical distribution of stem + real(r8), parameter :: k_cyl_vol = 1.0 !departure from cylindrical volume + real(r8), parameter :: k_cyl_area = 1.0 !departure from cylindrical area + real(r8), parameter :: k_internal = 0.0 !self-absorbtion of leaf/stem longwave + + + integer :: dummy_to_make_pgi_happy !------------------------------------------------------------------------------ @@ -362,6 +382,8 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, SHR_ASSERT_ALL((ubound(leafn_patch) == (/bounds%endp/)), errMsg(sourcefile, __LINE__)) associate( & + t_stem => temperature_inst%t_stem_patch , & ! Output: [real(r8) (:) ] stem temperature (Kelvin) + hs_canopy => energyflux_inst%hs_canopy_patch , & ! Output: [real(r8) (:) ] change in heat storage of stem (W/m**2) [+ to atm] soilresis => soilstate_inst%soilresis_col , & ! Input: [real(r8) (:) ] soil evaporative resistance snl => col%snl , & ! Input: [integer (:) ] number of snow layers dayl => grc%dayl , & ! Input: [real(r8) (:) ] daylength (s) @@ -504,8 +526,22 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, eflx_sh_snow => energyflux_inst%eflx_sh_snow_patch , & ! Output: [real(r8) (:) ] sensible heat flux from snow (W/m**2) [+ to atm] eflx_sh_h2osfc => energyflux_inst%eflx_sh_h2osfc_patch , & ! Output: [real(r8) (:) ] sensible heat flux from soil (W/m**2) [+ to atm] eflx_sh_soil => energyflux_inst%eflx_sh_soil_patch , & ! Output: [real(r8) (:) ] sensible heat flux from soil (W/m**2) [+ to atm] + eflx_sh_stem => energyflux_inst%eflx_sh_stem_patch , & ! Output: [real(r8) (:) ] sensible heat flux from stems (W/m**2) [+ to atm] eflx_sh_veg => energyflux_inst%eflx_sh_veg_patch , & ! Output: [real(r8) (:) ] sensible heat flux from leaves (W/m**2) [+ to atm] eflx_sh_grnd => energyflux_inst%eflx_sh_grnd_patch , & ! Output: [real(r8) (:) ] sensible heat flux from ground (W/m**2) [+ to atm] + rah1 => frictionvel_inst%rah1_patch , & ! Output: [real(r8) (:) ] aerodynamical resistance [s/m] + rah2 => frictionvel_inst%rah2_patch , & ! Output: [real(r8) (:) ] aerodynamical resistance [s/m] + raw1 => frictionvel_inst%raw1_patch , & ! Output: [real(r8) (:) ] aerodynamical resistance [s/m] + raw2 => frictionvel_inst%raw2_patch , & ! Output: [real(r8) (:) ] aerodynamical resistance [s/m] + ustar => frictionvel_inst%ustar_patch , & ! Output: [real(r8) (:) ] friction velocity [m/s] + um => frictionvel_inst%um_patch , & ! Output: [real(r8) (:) ] wind speed including the stablity effect [m/s] + uaf => frictionvel_inst%uaf_patch , & ! Output: [real(r8) (:) ] canopy air speed [m/s] + taf => frictionvel_inst%taf_patch , & ! Output: [real(r8) (:) ] canopy air temperature [K] + qaf => frictionvel_inst%qaf_patch , & ! Output: [real(r8) (:) ] canopy air humidity [kg/kg] + obu => frictionvel_inst%obu_patch , & ! Output: [real(r8) (:) ] Monin-Obukhov length [m] + zeta => frictionvel_inst%zeta_patch , & ! Output: [real(r8) (:) ] dimensionless stability parameter + vpd => frictionvel_inst%vpd_patch , & ! Output: [real(r8) (:) ] vapor pressure deficit [Pa] + begp => bounds%begp , & endp => bounds%endp , & begg => bounds%begg , & @@ -584,8 +620,51 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, obuold(p) = 0._r8 btran(p) = btran0 btran2(p) = btran0 + hs_canopy(p) = 0._r8 end do +! set bhd (should be done on parameter file) + bhd(1:16) = (/0.15,0.15,0.15,0.2,0.2,0.2,0.2,0.1,0.02,0.02,0.02,0.004,0.004,0.004,0.004,0.004/) + + ! calculate biomass heat capacities + do f = 1, fn + p = filterp(f) + + ! fraction of stem receiving incoming radiation + fstem(p) = (esai(p))/(elai(p)+esai(p)) + fstem(p) = k_vert * fstem(p) + ! leaf and stem surface area + sa_leaf(p) = elai(p) +! double in spirit of full surface area for sensible heat + sa_leaf(p) = 2.*sa_leaf(p) + sa_stem(p) = ntree*(htop(p)*shr_const_pi*bhd(patch%itype(p))) +! adjust for departure of cylindrical stem model + sa_stem(p) = k_cyl_area * sa_stem(p) +! internal longwave fluxes between leaf and stem +! surface area term must be equal, remainder cancels +! (use same area of interaction i.e. ignore leaf <-> leaf) + sa_internal(p) = min(sa_leaf(p),sa_stem(p)) + sa_internal(p) = k_internal * sa_internal(p) + +!scs: specify heat capacity of vegetation +!(lma * c2b = lma_dry, lma * c2b * (fw/(1-fw)) = lma_wet, sum these) +! lma_dry has units of kg dry mass /m2 here (table 2 of bonan 2017) +! cdry_biomass = 1400 J/kg/K, cwater = 4188 J/kg/K +! boreal needleleaf lma*c2b ~ 0.25 kg dry mass/m2(leaf) + cp_veg(p) = (0.25_r8 * elai(p)) * (1400._r8 + (0.7/(1.-0.7))*4188._r8) + +! wood density could vary by pft... + wood_density = 5.e2_r8 ! kg/m3 lindroth2010 uses ~4.e2 + carea_stem = shr_const_pi * (bhd(patch%itype(p))*0.5)**2 + +! cp-stem will have units J/k/ground_area (here assuming 1 stem/m2) + cp_stem(p) = (1400._r8 + (0.7/(1.-0.7))*4188._r8) +! use weight of dry wood + cp_stem(p) = cp_stem(p) * ntree * wood_density * htop(p) * carea_stem +! adjust for departure from cylindrical stem model + cp_stem(p) = k_cyl_vol * cp_stem(p) + enddo + ! calculate daylength control for Vcmax do f = 1, fn p=filterp(f) @@ -772,6 +851,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, g = patch%gridcell(p) tlbef(p) = t_veg(p) + tsbef(p) = t_stem(p) del2(p) = del(p) ! Determine aerodynamic resistances @@ -784,6 +864,9 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, uaf(p) = um(p)*sqrt( 1._r8/(ram1(p)*um(p)) ) + ! empirical undercanopy wind speed + uuc(p) = min(0.4_r8,(0.03_r8*um(p)/ustar(p))) + ! Use pft parameter for leaf characteristic width ! dleaf_patch if this is not an fates patch. ! Otherwise, the value has already been loaded @@ -812,18 +895,26 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, !! modify csoilc value (0.004) if the under-canopy is in stable condition - if (use_undercanopy_stability .and. (taf(p) - t_grnd(c) ) > 0._r8) then - ! decrease the value of csoilc by dividing it with (1+gamma*min(S, 10.0)) - ! ria ("gmanna" in Sakaguchi&Zeng, 2008) is a constant (=0.5) - ricsoilc = csoilc / (1.00_r8 + ria*min( ri, 10.0_r8) ) - csoilcn = csoilb*w + ricsoilc*(1._r8-w) - else - csoilcn = csoilb*w + csoilc*(1._r8-w) - end if +!!$ if (use_undercanopy_stability .and. (taf(p) - t_grnd(c) ) > 0._r8) then +!!$ ! decrease the value of csoilc by dividing it with (1+gamma*min(S, 10.0)) +!!$ ! ria ("gmanna" in Sakaguchi&Zeng, 2008) is a constant (=0.5) +!!$ ricsoilc = csoilc / (1.00_r8 + ria*min( ri, 10.0_r8) ) +!!$ csoilcn = csoilb*w + ricsoilc*(1._r8-w) +!!$ else +!!$ csoilcn = csoilb*w + csoilc*(1._r8-w) +!!$ end if +! Commenting-out ria correction + csoilcn = csoilb*w + csoilc*(1._r8-w) !! Sakaguchi changes for stability formulation ends here - rah(p,2) = 1._r8/(csoilcn*uaf(p)) + if (use_undercanopy_stability) then + ! use uuc for ground fluxes (keep uaf for canopy terms) + rah(p,2) = 1._r8/(csoilcn*uuc(p)) + else + rah(p,2) = 1._r8/(csoilcn*uaf(p)) + endif + raw(p,2) = rah(p,2) if (use_lch4) then grnd_ch4_cond(p) = 1._r8/(raw(p,1)+raw(p,2)) @@ -835,6 +926,13 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, svpts(p) = el(p) ! pa eah(p) = forc_pbot(c) * qaf(p) / 0.622_r8 ! pa rhaf(p) = eah(p)/svpts(p) +! add history fields + rah1(p) = rah(p,1) + raw1(p) = raw(p,1) + rah2(p) = rah(p,2) + raw2(p) = raw(p,2) + vpd(p) = max((svpts(p) - eah(p)), 50._r8) * 0.001_r8 + end do if ( use_fates ) then @@ -892,16 +990,26 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ! Moved the original subroutine in-line... wta = 1._r8/rah(p,1) ! air - wtl = (elai(p)+esai(p))/rb(p) ! leaf + wtl = sa_leaf(p)/rb(p) ! leaf wtg(p) = 1._r8/rah(p,2) ! ground - wtshi = 1._r8/(wta+wtl+wtg(p)) + ! wtstem = sa_stem(p)/rb(p) ! stem + ! add resistance between internal stem temperature and canopy air + wtstem = sa_stem(p)/(rstem + rb(p)) ! stem + + wtshi = 1._r8/(wta+wtl+wtstem+wtg(p)) + wtl0(p) = wtl*wtshi ! leaf wtg0 = wtg(p)*wtshi ! ground wta0(p) = wta*wtshi ! air - wtga = wta0(p)+wtg0 ! ground + air - wtal(p) = wta0(p)+wtl0(p) ! air + leaf + wtstem0(p) = wtstem*wtshi ! stem + wtga(p) = wta0(p)+wtg0+wtstem0(p) ! ground + air + stem + wtal(p) = wta0(p)+wtl0(p)+wtstem0(p) ! air + leaf + stem + + ! internal longwave fluxes between leaf and stem + lw_stem(p) = sa_internal(p) * emv(p) * sb*t_stem(p)**4 + lw_leaf(p) = sa_internal(p) * emv(p) * sb*t_veg(p)**4 ! Fraction of potential evaporation from leaf @@ -916,7 +1024,8 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, canopy_cond(p) = (laisun(p)/(rb(p)+rssun(p)) + laisha(p)/(rb(p)+rssha(p)))/max(elai(p), 0.01_r8) end if - efpot = forc_rho(c)*wtl*(qsatl(p)-qaf(p)) +! should be the same expression used in Photosynthesis/getqflx + efpot = forc_rho(c)*(elai(p)+esai(p))/rb(p)*(qsatl(p)-qaf(p)) ! When the hydraulic stress parameterization is active calculate rpp ! but not transpiration @@ -989,7 +1098,8 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, dc1 = forc_rho(c)*cpair*wtl dc2 = hvap*forc_rho(c)*wtlq - efsh = dc1*(wtga*t_veg(p)-wtg0*t_grnd(c)-wta0(p)*thm(p)) + efsh = dc1*(wtga(p)*t_veg(p)-wtg0*t_grnd(c)-wta0(p)*thm(p)-wtstem0(p)*t_stem(p)) + eflx_sh_stem(p) = forc_rho(c)*cpair*wtstem*((wta0(p)+wtg0+wtl0(p))*t_stem(p)-wtg0*t_grnd(c)-wta0(p)*thm(p)-wtl0(p)*t_veg(p)) efe(p) = dc2*(wtgaq*qsatl(p)-wtgq0*qg(c)-wtaq0(p)*forc_q(c)) ! Evaporation flux from foliage @@ -1005,9 +1115,14 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, +(1._r8-frac_sno(c)-frac_h2osfc(c))*t_soisno(c,1)**4 & +frac_h2osfc(c)*t_h2osfc(c)**4) - dt_veg(p) = (sabv(p) + air(p) + bir(p)*t_veg(p)**4 + & - cir(p)*lw_grnd - efsh - efe(p)) / & - (- 4._r8*bir(p)*t_veg(p)**3 +dc1*wtga +dc2*wtgaq*qsatldT(p)) + dt_veg(p) = ((1.-fstem(p))*(sabv(p) + air(p) & + + bir(p)*t_veg(p)**4 + cir(p)*lw_grnd) & + - efsh - efe(p) - lw_leaf(p) + lw_stem(p) & + - (cp_veg(p)/dtime)*(t_veg(p) - tlbef(p))) & + / ((1.-fstem(p))*(- 4._r8*bir(p)*t_veg(p)**3) & + + 4._r8*sa_internal(p)*emv(p)*sb*t_veg(p)**3 & + +dc1*wtga(p) +dc2*wtgaq*qsatldT(p) + cp_veg(p)/dtime) + t_veg(p) = tlbef(p) + dt_veg(p) dels = dt_veg(p) del(p) = abs(dels) @@ -1015,10 +1130,14 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, if (del(p) > delmax) then dt_veg(p) = delmax*dels/del(p) t_veg(p) = tlbef(p) + dt_veg(p) - err(p) = sabv(p) + air(p) + bir(p)*tlbef(p)**3*(tlbef(p) + & - 4._r8*dt_veg(p)) + cir(p)*lw_grnd - & - (efsh + dc1*wtga*dt_veg(p)) - (efe(p) + & - dc2*wtgaq*qsatldT(p)*dt_veg(p)) + err(p) = (1.-fstem(p))*(sabv(p) + air(p) & + + bir(p)*tlbef(p)**3*(tlbef(p) + & + 4._r8*dt_veg(p)) + cir(p)*lw_grnd) & + -sa_internal(p)*emv(p)*sb*tlbef(p)**3*(tlbef(p) + 4._r8*dt_veg(p)) & + + lw_stem(p) & + - (efsh + dc1*wtga(p)*dt_veg(p)) - (efe(p) + & + dc2*wtgaq*qsatldT(p)*dt_veg(p)) & + - (cp_veg(p)/dtime)*(t_veg(p) - tlbef(p)) end if ! Fluxes from leaves to canopy space @@ -1026,7 +1145,8 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ! result in an imbalance in "hvap*qflx_evap_veg" and ! "efe + dc2*wtgaq*qsatdt_veg" - efpot = forc_rho(c)*wtl*(wtgaq*(qsatl(p)+qsatldT(p)*dt_veg(p)) & + efpot = forc_rho(c)*(elai(p)+esai(p))/rb(p) & + *(wtgaq*(qsatl(p)+qsatldT(p)*dt_veg(p)) & -wtgq0*qg(c)-wtaq0(p)*forc_q(c)) qflx_evap_veg(p) = rpp*efpot @@ -1059,7 +1179,11 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ! The energy loss due to above two limits is added to ! the sensible heat flux. - eflx_sh_veg(p) = efsh + dc1*wtga*dt_veg(p) + err(p) + erre + hvap*ecidif + eflx_sh_veg(p) = efsh + dc1*wtga(p)*dt_veg(p) + err(p) + erre + hvap*ecidif + + ! Update SH and lw_leaf for changes in t_veg + eflx_sh_stem(p) = eflx_sh_stem(p) + forc_rho(c)*cpair*wtstem*(-wtl0(p)*dt_veg(p)) + lw_leaf(p) = sa_internal(p)*emv(p)*sb*tlbef(p)**3*(tlbef(p) + 4._r8*dt_veg(p)) ! Re-calculate saturated vapor pressure, specific humidity, and their ! derivatives at the leaf surface @@ -1070,7 +1194,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ! temperature, canopy vapor pressure, aerodynamic temperature, and ! Monin-Obukhov stability parameter for next iteration. - taf(p) = wtg0*t_grnd(c) + wta0(p)*thm(p) + wtl0(p)*t_veg(p) + taf(p) = wtg0*t_grnd(c) + wta0(p)*thm(p) + wtl0(p)*t_veg(p) + wtstem0(p)*t_stem(p) qaf(p) = wtlq0(p)*qsatl(p) + wtgq0*qg(c) + forc_q(c)*wtaq0(p) ! Update Monin-Obukhov length and wind speed including the @@ -1084,17 +1208,17 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, qstar = temp2(p)*dqh(p) thvstar = tstar*(1._r8+0.61_r8*forc_q(c)) + 0.61_r8*forc_th(c)*qstar - zeta = zldis(p)*vkc*grav*thvstar/(ustar(p)**2*thv(c)) + zeta(p) = zldis(p)*vkc*grav*thvstar/(ustar(p)**2*thv(c)) - if (zeta >= 0._r8) then !stable - zeta = min(zetamax,max(zeta,0.01_r8)) + if (zeta(p) >= 0._r8) then !stable + zeta(p) = min(zetamax,max(zeta(p),0.01_r8)) um(p) = max(ur(p),0.1_r8) else !unstable - zeta = max(-100._r8,min(zeta,-0.01_r8)) + zeta(p) = max(-100._r8,min(zeta(p),-0.01_r8)) wc = beta*(-grav*ustar(p)*thvstar*zii/thv(c))**0.333_r8 um(p) = sqrt(ur(p)*ur(p)+wc*wc) end if - obu(p) = zldis(p)/zeta + obu(p) = zldis(p)/zeta(p) if (obuold(p)*obu(p) < 0._r8) nmozsgn(p) = nmozsgn(p)+1 if (nmozsgn(p) >= 4) obu(p) = zldis(p)/(-0.01_r8) @@ -1144,25 +1268,39 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, +(1._r8-frac_sno(c)-frac_h2osfc(c))*t_soisno(c,1)**4 & +frac_h2osfc(c)*t_h2osfc(c)**4) - err(p) = sabv(p) + air(p) + bir(p)*tlbef(p)**3*(tlbef(p) + 4._r8*dt_veg(p)) & - !+ cir(p)*t_grnd(c)**4 - eflx_sh_veg(p) - hvap*qflx_evap_veg(p) - + cir(p)*lw_grnd - eflx_sh_veg(p) - hvap*qflx_evap_veg(p) + err(p) = (1.-fstem(p))*(sabv(p) + air(p) + bir(p)*tlbef(p)**3 & + *(tlbef(p) + 4._r8*dt_veg(p)) + cir(p)*lw_grnd) & + - lw_leaf(p) + lw_stem(p) - eflx_sh_veg(p) - hvap*qflx_evap_veg(p) & + - ((t_veg(p)-tlbef(p))*cp_veg(p)/dtime) + + ! Update stem temperature; adjust outgoing longwave + ! does not account for changes in SH or internal LW, + ! as that would change result for t_veg above + dt_stem(p) = (fstem(p)*(sabv(p) + air(p) + bir(p)*tsbef(p)**4 & + + cir(p)*lw_grnd) - eflx_sh_stem(p) & + + lw_leaf(p)- lw_stem(p))/(cp_stem(p)/dtime & + - fstem(p)*bir(p)*4.*tsbef(p)**3) + + hs_canopy(p) = dt_stem(p)*cp_stem(p)/dtime & + +(t_veg(p)-tlbef(p))*cp_veg(p)/dtime + + t_stem(p) = t_stem(p) + dt_stem(p) + + delt = wtal(p)*t_grnd(c)-wtl0(p)*t_veg(p)-wta0(p)*thm(p)-wtstem0(p)*t_stem(p) ! Fluxes from ground to canopy space - delt = wtal(p)*t_grnd(c)-wtl0(p)*t_veg(p)-wta0(p)*thm(p) taux(p) = -forc_rho(c)*forc_u(g)/ram1(p) tauy(p) = -forc_rho(c)*forc_v(g)/ram1(p) eflx_sh_grnd(p) = cpair*forc_rho(c)*wtg(p)*delt ! compute individual sensible heat fluxes - delt_snow = wtal(p)*t_soisno(c,snl(c)+1)-wtl0(p)*t_veg(p)-wta0(p)*thm(p) - eflx_sh_snow(p) = cpair*forc_rho(c)*wtg(p)*delt_snow + delt_snow = wtal(p)*t_soisno(c,snl(c)+1)-wtl0(p)*t_veg(p)-wta0(p)*thm(p)-wtstem0(p)*t_stem(p) + delt_soil = wtal(p)*t_soisno(c,1)-wtl0(p)*t_veg(p)-wta0(p)*thm(p)-wtstem0(p)*t_stem(p) + delt_h2osfc = wtal(p)*t_h2osfc(c)-wtl0(p)*t_veg(p)-wta0(p)*thm(p)-wtstem0(p)*t_stem(p) - delt_soil = wtal(p)*t_soisno(c,1)-wtl0(p)*t_veg(p)-wta0(p)*thm(p) + eflx_sh_snow(p) = cpair*forc_rho(c)*wtg(p)*delt_snow eflx_sh_soil(p) = cpair*forc_rho(c)*wtg(p)*delt_soil - - delt_h2osfc = wtal(p)*t_h2osfc(c)-wtl0(p)*t_veg(p)-wta0(p)*thm(p) eflx_sh_h2osfc(p) = cpair*forc_rho(c)*wtg(p)*delt_h2osfc qflx_evap_soi(p) = forc_rho(c)*wtgq(p)*delq(p) @@ -1227,13 +1365,12 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ! Downward longwave radiation below the canopy dlrad(p) = (1._r8-emv(p))*emg(c)*forc_lwrad(c) + & - emv(p)*emg(c)*sb*tlbef(p)**3*(tlbef(p) + 4._r8*dt_veg(p)) + emv(p)*emg(c)*sb*(tlbef(p)**3*(tlbef(p) + 4._r8*dt_veg(p))*(1.-fstem(p))+tsbef(p)**3*(tsbef(p) + 4._r8*dt_stem(p))*fstem(p)) ! Upward longwave radiation above the canopy ulrad(p) = ((1._r8-emg(c))*(1._r8-emv(p))*(1._r8-emv(p))*forc_lwrad(c) & - + emv(p)*(1._r8+(1._r8-emg(c))*(1._r8-emv(p)))*sb*tlbef(p)**3*(tlbef(p) + & - 4._r8*dt_veg(p)) + emg(c)*(1._r8-emv(p))*sb*lw_grnd) + + emv(p)*(1._r8+(1._r8-emg(c))*(1._r8-emv(p)))*sb*((1.-fstem(p))*tlbef(p)**3*(tlbef(p) + 4._r8*dt_veg(p))+fstem(p)*tsbef(p)**3*(tsbef(p) + 4._r8*dt_stem(p))) + emg(c)*(1._r8-emv(p))*sb*lw_grnd) ! Derivative of soil energy flux with respect to soil temperature diff --git a/src/biogeophys/EnergyFluxType.F90 b/src/biogeophys/EnergyFluxType.F90 index 0869e4136e..6b1bc02d1a 100644 --- a/src/biogeophys/EnergyFluxType.F90 +++ b/src/biogeophys/EnergyFluxType.F90 @@ -21,6 +21,7 @@ module EnergyFluxType type, public :: energyflux_type ! Fluxes + real(r8), pointer :: eflx_sh_stem_patch (:) ! patch sensible heat flux from stem (W/m**2) [+ to atm] real(r8), pointer :: eflx_h2osfc_to_snow_col (:) ! col snow melt to h2osfc heat flux (W/m**2) real(r8), pointer :: eflx_sh_grnd_patch (:) ! patch sensible heat flux from ground (W/m**2) [+ to atm] real(r8), pointer :: eflx_sh_veg_patch (:) ! patch sensible heat flux from leaves (W/m**2) [+ to atm] @@ -101,6 +102,9 @@ module EnergyFluxType ! Latent heat real(r8), pointer :: htvp_col (:) ! latent heat of vapor of water (or sublimation) [j/kg] + ! Canopy heat + real(r8), pointer :: hs_canopy_patch (:) ! patch change in heat content of canopy (leaf+stem) (W/m**2) [+ to atm] + ! Balance Checks real(r8), pointer :: errsoi_patch (:) ! soil/lake energy conservation error (W/m**2) real(r8), pointer :: errsoi_col (:) ! soil/lake energy conservation error (W/m**2) @@ -191,6 +195,7 @@ subroutine InitAllocate(this, bounds) allocate( this%eflx_sh_tot_u_patch (begp:endp)) ; this%eflx_sh_tot_u_patch (:) = nan allocate( this%eflx_sh_tot_r_patch (begp:endp)) ; this%eflx_sh_tot_r_patch (:) = nan allocate( this%eflx_sh_grnd_patch (begp:endp)) ; this%eflx_sh_grnd_patch (:) = nan + allocate( this%eflx_sh_stem_patch (begp:endp)) ; this%eflx_sh_stem_patch (:) = nan allocate( this%eflx_sh_veg_patch (begp:endp)) ; this%eflx_sh_veg_patch (:) = nan allocate( this%eflx_sh_precip_conversion_col(begc:endc)) ; this%eflx_sh_precip_conversion_col(:) = nan allocate( this%eflx_lh_tot_u_patch (begp:endp)) ; this%eflx_lh_tot_u_patch (:) = nan @@ -246,6 +251,8 @@ subroutine InitAllocate(this, bounds) allocate( this%htvp_col (begc:endc)) ; this%htvp_col (:) = nan + allocate( this%hs_canopy_patch (begp:endp)) ; this%hs_canopy_patch (:) = nan + allocate(this%rresis_patch (begp:endp,1:nlevgrnd)) ; this%rresis_patch (:,:) = nan allocate(this%btran_patch (begp:endp)) ; this%btran_patch (:) = nan allocate(this%btran_min_patch (begp:endp)) ; this%btran_min_patch (:) = nan @@ -433,6 +440,16 @@ subroutine InitHistory(this, bounds, is_simple_buildtemp) avgflag='A', long_name='sensible heat from veg', & ptr_patch=this%eflx_sh_veg_patch, set_lake=0._r8, c2l_scale_type='urbanf') + this%eflx_sh_stem_patch(begp:endp) = spval + call hist_addfld1d (fname='FSH_STEM', units='W/m^2', & + avgflag='A', long_name='sensible heat from stem', & + ptr_patch=this%eflx_sh_stem_patch, c2l_scale_type='urbanf',default = 'inactive') + + this%hs_canopy_patch(begp:endp) = spval + call hist_addfld1d (fname='HS_CANOPY', units='W/m^2', & + avgflag='A', long_name='heat change of stem', & + ptr_patch=this%hs_canopy_patch, set_lake=0._r8, c2l_scale_type='urbanf',default='inactive') + this%eflx_sh_grnd_patch(begp:endp) = spval call hist_addfld1d (fname='FSH_G', units='W/m^2', & avgflag='A', long_name='sensible heat from ground', & @@ -530,12 +547,10 @@ subroutine InitHistory(this, bounds, is_simple_buildtemp) ptr_patch=this%cgrnds_patch, default='inactive', c2l_scale_type='urbanf') end if - if (use_cn) then - this%eflx_gnet_patch(begp:endp) = spval - call hist_addfld1d (fname='EFLX_GNET', units='W/m^2', & - avgflag='A', long_name='net heat flux into ground', & - ptr_patch=this%eflx_gnet_patch, default='inactive', c2l_scale_type='urbanf') - end if + this%eflx_gnet_patch(begp:endp) = spval + call hist_addfld1d (fname='EFLX_GNET', units='W/m^2', & + avgflag='A', long_name='net heat flux into ground', & + ptr_patch=this%eflx_gnet_patch, default='inactive', c2l_scale_type='urbanf') this%eflx_grnd_lake_patch(begp:endp) = spval call hist_addfld1d (fname='EFLX_GRND_LAKE', units='W/m^2', & diff --git a/src/biogeophys/FrictionVelocityMod.F90 b/src/biogeophys/FrictionVelocityMod.F90 index ce793aa9bc..0b32c39c0a 100644 --- a/src/biogeophys/FrictionVelocityMod.F90 +++ b/src/biogeophys/FrictionVelocityMod.F90 @@ -52,6 +52,20 @@ module FrictionVelocityMod real(r8), pointer, public :: z0mg_col (:) ! col roughness length over ground, momentum [m] real(r8), pointer, public :: z0hg_col (:) ! col roughness length over ground, sensible heat [m] real(r8), pointer, public :: z0qg_col (:) ! col roughness length over ground, latent heat [m] + ! variables to add history output from CanopyFluxesMod + real(r8), pointer, public :: rah1_patch (:) ! patch sensible heat flux resistance [s/m] + real(r8), pointer, public :: rah2_patch (:) ! patch below-canopy sensible heat flux resistance [s/m] + real(r8), pointer, public :: raw1_patch (:) ! patch moisture flux resistance [s/m] + real(r8), pointer, public :: raw2_patch (:) ! patch below-canopy moisture flux resistance [s/m] + real(r8), pointer, public :: ustar_patch (:) ! patch friction velocity [m/s] + real(r8), pointer, public :: um_patch (:) ! patch wind speed including the stablity effect [m/s] + real(r8), pointer, public :: uaf_patch (:) ! patch canopy air speed [m/s] + real(r8), pointer, public :: taf_patch (:) ! patch canopy air temperature [K] + real(r8), pointer, public :: qaf_patch (:) ! patch canopy humidity [kg/kg] + real(r8), pointer, public :: obu_patch (:) ! patch Monin-Obukhov length [m] + real(r8), pointer, public :: zeta_patch (:) ! patch dimensionless stability parameter + real(r8), pointer, public :: vpd_patch (:) ! patch vapor pressure deficit [Pa] + contains @@ -129,6 +143,18 @@ subroutine InitAllocate(this, bounds) allocate(this%z0mg_col (begc:endc)) ; this%z0mg_col (:) = nan allocate(this%z0qg_col (begc:endc)) ; this%z0qg_col (:) = nan allocate(this%z0hg_col (begc:endc)) ; this%z0hg_col (:) = nan + allocate(this%rah1_patch (begp:endp)) ; this%rah1_patch (:) = nan + allocate(this%rah2_patch (begp:endp)) ; this%rah2_patch (:) = nan + allocate(this%raw1_patch (begp:endp)) ; this%raw1_patch (:) = nan + allocate(this%raw2_patch (begp:endp)) ; this%raw2_patch (:) = nan + allocate(this%um_patch (begp:endp)) ; this%um_patch (:) = nan + allocate(this%uaf_patch (begp:endp)) ; this%uaf_patch (:) = nan + allocate(this%taf_patch (begp:endp)) ; this%taf_patch (:) = nan + allocate(this%qaf_patch (begp:endp)) ; this%qaf_patch (:) = nan + allocate(this%ustar_patch (begp:endp)) ; this%ustar_patch (:) = nan + allocate(this%obu_patch (begp:endp)) ; this%obu_patch (:) = nan + allocate(this%zeta_patch (begp:endp)) ; this%zeta_patch (:) = nan + allocate(this%vpd_patch (begp:endp)) ; this%vpd_patch (:) = nan end subroutine InitAllocate @@ -201,7 +227,59 @@ subroutine InitHistory(this, bounds) ptr_patch=this%fv_patch, default='inactive') end if - if (use_cn) then + call hist_addfld1d (fname='RAH1', units='s/m', & + avgflag='A', long_name='aerodynamical resistance ', & + ptr_patch=this%rah1_patch, default='inactive') + this%rah2_patch(begp:endp) = spval + call hist_addfld1d (fname='RAH2', units='s/m', & + avgflag='A', long_name='aerodynamical resistance ', & + ptr_patch=this%rah2_patch, default='inactive') + this%raw1_patch(begp:endp) = spval + call hist_addfld1d (fname='RAW1', units='s/m', & + avgflag='A', long_name='aerodynamical resistance ', & + ptr_patch=this%raw1_patch, default='inactive') + this%raw2_patch(begp:endp) = spval + call hist_addfld1d (fname='RAW2', units='s/m', & + avgflag='A', long_name='aerodynamical resistance ', & + ptr_patch=this%raw2_patch, default='inactive') + this%ustar_patch(begp:endp) = spval + call hist_addfld1d (fname='USTAR', units='s/m', & + avgflag='A', long_name='aerodynamical resistance ', & + ptr_patch=this%ustar_patch, default='inactive') + this%um_patch(begp:endp) = spval + call hist_addfld1d (fname='UM', units='m/s', & + avgflag='A', long_name='wind speed plus stability effect', & + ptr_patch=this%um_patch, default='inactive') + this%uaf_patch(begp:endp) = spval + call hist_addfld1d (fname='UAF', units='m/s', & + avgflag='A', long_name='canopy air speed ', & + ptr_patch=this%uaf_patch, default='inactive') + this%taf_patch(begp:endp) = spval + call hist_addfld1d (fname='TAF', units='K', & + avgflag='A', long_name='canopy air temperature', & + ptr_patch=this%taf_patch, default='inactive') + this%qaf_patch(begp:endp) = spval + call hist_addfld1d (fname='QAF', units='kg/kg', & + avgflag='A', long_name='canopy air humidity', & + ptr_patch=this%qaf_patch, default='inactive') + this%obu_patch(begp:endp) = spval + call hist_addfld1d (fname='OBU', units='m', & + avgflag='A', long_name='Monin-Obukhov length', & + ptr_patch=this%obu_patch, default='inactive') + this%zeta_patch(begp:endp) = spval + call hist_addfld1d (fname='ZETA', units='unitless', & + avgflag='A', long_name='dimensionless stability parameter', & + ptr_patch=this%zeta_patch, default='inactive') + this%vpd_patch(begp:endp) = spval + call hist_addfld1d (fname='VPD', units='Pa', & + avgflag='A', long_name='vpd', & + ptr_patch=this%vpd_patch, default='inactive') + this%rb1_patch(begp:endp) = spval + call hist_addfld1d (fname='RB', units='s/m', & + avgflag='A', long_name='leaf boundary resistance', & + ptr_patch=this%rb1_patch, default='inactive') + + if (use_cn) then this%z0hv_patch(begp:endp) = spval call hist_addfld1d (fname='Z0HV', units='m', & avgflag='A', long_name='roughness length over vegetation, sensible heat', & diff --git a/src/biogeophys/SoilFluxesMod.F90 b/src/biogeophys/SoilFluxesMod.F90 index 1dabba664d..7ce0d57e9b 100644 --- a/src/biogeophys/SoilFluxesMod.F90 +++ b/src/biogeophys/SoilFluxesMod.F90 @@ -83,6 +83,7 @@ subroutine SoilFluxes (bounds, num_urbanl, filter_urbanl, & !----------------------------------------------------------------------- associate( & + eflx_sh_stem => energyflux_inst%eflx_sh_stem_patch , & ! Output: [real(r8) (:) ] sensible heat flux from stems (W/m**2) [+ to atm] eflx_h2osfc_to_snow_col => energyflux_inst%eflx_h2osfc_to_snow_col , & ! Input: [real(r8) (:) ] col snow melt to h2osfc heat flux (W/m**2) forc_lwrad => atm2lnd_inst%forc_lwrad_downscaled_col , & ! Input: [real(r8) (:) ] downward infrared (longwave) radiation (W/m**2) @@ -302,7 +303,7 @@ subroutine SoilFluxes (bounds, num_urbanl, filter_urbanl, & ! Total fluxes (vegetation + ground) - eflx_sh_tot(p) = eflx_sh_veg(p) + eflx_sh_grnd(p) + eflx_sh_tot(p) = eflx_sh_veg(p) + eflx_sh_stem(p) + eflx_sh_grnd(p) qflx_evap_tot(p) = qflx_evap_veg(p) + qflx_evap_soi(p) eflx_lh_tot(p)= hvap*qflx_evap_veg(p) + htvp(c)*qflx_evap_soi(p) if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then diff --git a/src/biogeophys/TemperatureType.F90 b/src/biogeophys/TemperatureType.F90 index e2516505e7..ed0185f261 100644 --- a/src/biogeophys/TemperatureType.F90 +++ b/src/biogeophys/TemperatureType.F90 @@ -22,6 +22,7 @@ module TemperatureType type, public :: temperature_type ! Temperatures + real(r8), pointer :: t_stem_patch (:) ! patch stem temperatu\re (Kelvin) real(r8), pointer :: t_veg_patch (:) ! patch vegetation temperature (Kelvin) real(r8), pointer :: t_veg_day_patch (:) ! patch daytime accumulative vegetation temperature (Kelvinx*nsteps), LUNA specific, from midnight to current step real(r8), pointer :: t_veg_night_patch (:) ! patch night-time accumulative vegetation temperature (Kelvin*nsteps), LUNA specific, from midnight to current step @@ -186,6 +187,7 @@ subroutine InitAllocate(this, bounds) begg = bounds%begg; endg= bounds%endg ! Temperatures + allocate(this%t_stem_patch (begp:endp)) ; this%t_stem_patch (:) = nan allocate(this%t_veg_patch (begp:endp)) ; this%t_veg_patch (:) = nan if(use_luna) then allocate(this%t_veg_day_patch (begp:endp)) ; this%t_veg_day_patch (:) = spval @@ -378,6 +380,11 @@ subroutine InitHistory(this, bounds, is_simple_buildtemp, is_prog_buildtemp ) avgflag='A', long_name='Urban daily maximum of average 2-m temperature', & ptr_patch=this%t_ref2m_max_u_patch, set_nourb=spval, default='inactive') + this%t_stem_patch(begp:endp) = spval + call hist_addfld1d (fname='TSTEM', units='K', & + avgflag='A', long_name='stem temperature', & + ptr_patch=this%t_stem_patch, default='inactive') + this%t_veg_patch(begp:endp) = spval call hist_addfld1d (fname='TV', units='K', & avgflag='A', long_name='vegetation temperature', & @@ -770,6 +777,8 @@ subroutine InitCold(this, bounds, & this%t_veg_patch(p) = 283._r8 end if + this%t_stem_patch(p) = this%t_veg_patch(p) + if (use_vancouver) then this%t_ref2m_patch(p) = 297.56 else if (use_mexicocity) then From caca8dd07668e65ef672e2d82bdf230686bae51f Mon Sep 17 00:00:00 2001 From: Ronny Meier Date: Fri, 1 Jun 2018 12:02:45 +0200 Subject: [PATCH 02/76] Attribution of a soil column to each natural vegetation patch Author: Ronny Meier modified: initGridCellsMod.F90 and subgridMod.F90 Modification is not fully completed yet. Switch will be added later on in namelist. --- src/main/initGridCellsMod.F90 | 78 +++++++++++++++++++++++++++++++++-- src/main/subgridMod.F90 | 18 ++++++-- 2 files changed, 89 insertions(+), 7 deletions(-) diff --git a/src/main/initGridCellsMod.F90 b/src/main/initGridCellsMod.F90 index e7053130db..0bb499ddba 100644 --- a/src/main/initGridCellsMod.F90 +++ b/src/main/initGridCellsMod.F90 @@ -38,6 +38,7 @@ module initGridCellsMod ! ! !PRIVATE MEMBER FUNCTIONS: private set_landunit_veg_compete + private set_landunit_veg_noncompete private set_landunit_wet_lake private set_landunit_ice_mec private set_landunit_crop_noncompete @@ -73,6 +74,7 @@ subroutine initGridcells(glc_behavior) integer :: nclumps ! number of clumps on this processor type(bounds_type) :: bounds_proc type(bounds_type) :: bounds_clump + logical :: sesc = .TRUE. ! switch for separated soil columns of natural vegetation !------------------------------------------------------------------------ ! Notes about how this routine is arranged, and its implications for the arrangement @@ -132,11 +134,17 @@ subroutine initGridcells(glc_behavior) li = bounds_clump%begl-1 ci = bounds_clump%begc-1 pi = bounds_clump%begp-1 + ! Determine naturally vegetated landunit do gdc = bounds_clump%begg,bounds_clump%endg - call set_landunit_veg_compete( & - ltype=istsoil, gi=gdc, li=li, ci=ci, pi=pi) + if(sesc) then + call set_landunit_veg_noncompete( & + ltype=istsoil, gi=gdc, li=li, ci=ci, pi=pi) + else + call set_landunit_veg_compete( & + ltype=istsoil, gi=gdc, li=li, ci=ci, pi=pi) + end if end do ! Determine crop landunit @@ -246,7 +254,7 @@ subroutine set_landunit_veg_compete (ltype, gi, li, ci, pi) ! Set decomposition properties call subgrid_get_info_natveg(gi, & - npatches=npatches, ncols=ncols, nlunits=nlunits) + npatches=npatches, ncols=ncols, nlunits=nlunits, sesc=.FALSE.) wtlunit2gcell = wt_lunit(gi, ltype) nlunits_added = 0 @@ -274,6 +282,70 @@ subroutine set_landunit_veg_compete (ltype, gi, li, ci, pi) SHR_ASSERT(npatches_added == npatches, errMsg(sourcefile, __LINE__)) end subroutine set_landunit_veg_compete + + !------------------------------------------------------------------------ + subroutine set_landunit_veg_noncompete (ltype, gi, li, ci, pi) + ! + ! !DESCRIPTION: + ! Initialize vegetated landunit without competition (called if sesc switch + ! is true) + ! + ! !USES + use clm_instur, only : wt_lunit, wt_nat_patch + use subgridMod, only : subgrid_get_info_natveg, natveg_patch_exists + use clm_varpar, only : numpft, maxpatch_pft, natpft_lb, natpft_ub + ! + ! !ARGUMENTS: + integer , intent(in) :: ltype ! landunit type + integer , intent(in) :: gi ! gridcell index + integer , intent(inout) :: li ! landunit index + integer , intent(inout) :: ci ! column index + integer , intent(inout) :: pi ! patch index + ! + ! !LOCAL VARIABLES: + integer :: m ! index + integer :: npatches ! number of patches in landunit + integer :: ncols + integer :: nlunits + integer :: npatches_added ! number of patches actually added + integer :: ncols_added ! number of columns actually added + integer :: nlunits_added ! number of landunits actually added + real(r8) :: wtlunit2gcell ! landunit weight in gridcell + !------------------------------------------------------------------------ + + ! Set decomposition properties + + call subgrid_get_info_natveg(gi, & + npatches=npatches, ncols=ncols, nlunits=nlunits, sesc=.TRUE.) + wtlunit2gcell = wt_lunit(gi, ltype) + + nlunits_added = 0 + ncols_added = 0 + npatches_added = 0 + + if (nlunits > 0) then + call add_landunit(li=li, gi=gi, ltype=ltype, wtgcell=wtlunit2gcell) + nlunits_added = nlunits_added + 1 + + + do m = natpft_lb,natpft_ub + if (natveg_patch_exists(gi, m)) then + ! Assume one column for each vegetation patch + call add_column(ci=ci, li=li, ctype=1, wtlunit=wt_nat_patch(gi,m)) + ncols_added = ncols_added + 1 + + call add_patch(pi=pi, ci=ci, ptype=m, wtcol=1.0_r8) + npatches_added = npatches_added + 1 + end if + end do + end if + + SHR_ASSERT(nlunits_added == nlunits, errMsg(sourcefile, __LINE__)) + SHR_ASSERT(ncols_added == ncols, errMsg(sourcefile, __LINE__)) + SHR_ASSERT(npatches_added == npatches, errMsg(sourcefile, __LINE__)) + + end subroutine set_landunit_veg_compete + !------------------------------------------------------------------------ subroutine set_landunit_wet_lake (ltype, gi, li, ci, pi) diff --git a/src/main/subgridMod.F90 b/src/main/subgridMod.F90 index 6358e90b5e..f152466ea4 100644 --- a/src/main/subgridMod.F90 +++ b/src/main/subgridMod.F90 @@ -74,6 +74,8 @@ subroutine subgrid_get_gcellinfo (gi, glc_behavior, & ! atm_topo is arbitrary for the sake of getting these counts. We don't have a true ! atm_topo value at the point of this call, so use 0. real(r8), parameter :: atm_topo = 0._r8 + logical :: sesc = .TRUE. ! switch for separated soil columns of natural vegetation + !------------------------------------------------------------------------------ npatches = 0 @@ -81,7 +83,7 @@ subroutine subgrid_get_gcellinfo (gi, glc_behavior, & nlunits = 0 ncohorts = 0 - call subgrid_get_info_natveg(gi, npatches_temp, ncols_temp, nlunits_temp) + call subgrid_get_info_natveg(gi, npatches_temp, ncols_temp, nlunits_temp, sesc) call accumulate_counters() call subgrid_get_info_urban_tbd(gi, npatches_temp, ncols_temp, nlunits_temp) @@ -123,7 +125,7 @@ end subroutine accumulate_counters end subroutine subgrid_get_gcellinfo !----------------------------------------------------------------------- - subroutine subgrid_get_info_natveg(gi, npatches, ncols, nlunits) + subroutine subgrid_get_info_natveg(gi, npatches, ncols, nlunits, sesc) ! ! !DESCRIPTION: ! Obtain properties for natural vegetated landunit in this grid cell @@ -133,6 +135,8 @@ subroutine subgrid_get_info_natveg(gi, npatches, ncols, nlunits) ! ! !ARGUMENTS: integer, intent(in) :: gi ! grid cell index + logical, intent(in) :: sesc ! switch for separated soil columns of natural vegetation + integer, intent(out) :: npatches ! number of nat veg patches in this grid cell integer, intent(out) :: ncols ! number of nat veg columns in this grid cell integer, intent(out) :: nlunits ! number of nat veg landunits in this grid cell @@ -152,8 +156,14 @@ subroutine subgrid_get_info_natveg(gi, npatches, ncols, nlunits) end do if (npatches > 0) then - ! Assume that the vegetated landunit has one column - ncols = 1 + if(sesc) then + ! Assume one soil column for each patch + ncols = npatches + else + ! Assume that the vegetated landunit has one column + ncols = 1 + end if + nlunits = 1 else ! As noted in natveg_patch_exists, we expect a naturally vegetated landunit in From ee25cdf7fc14766a4cf34d024c4ebb61bf76fabf Mon Sep 17 00:00:00 2001 From: Sean Swenson Date: Mon, 11 Jun 2018 14:11:15 -0600 Subject: [PATCH 03/76] merge ekluzek's radtemp branch with ronnymeier's sesc branch --- bld/CLMBuildNamelist.pm | 12 ++++- .../namelist_defaults_clm4_5.xml | 5 ++ .../namelist_definition_clm4_5.xml | 10 ++++ src/biogeophys/CanopyFluxesMod.F90 | 53 +++++++++++++------ src/main/clm_varctl.F90 | 12 +++++ src/main/controlMod.F90 | 8 +++ src/main/initGridCellsMod.F90 | 8 +-- src/main/subgridMod.F90 | 5 +- 8 files changed, 89 insertions(+), 24 deletions(-) diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index 00807d049c..b81a8663aa 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -1572,7 +1572,7 @@ sub process_namelist_inline_logic { setup_logic_subgrid($opts, $nl_flags, $definition, $defaults, $nl, $physv); setup_logic_fertilizer($opts, $nl_flags, $definition, $defaults, $nl, $physv); setup_logic_grainproduct($opts, $nl_flags, $definition, $defaults, $nl, $physv); - setup_logic_soilstate($opts, $nl_flags, $definition, $defaults, $nl, $physv); + setup_logic_pftsoilcolumn($opts, $nl_flags, $definition, $defaults, $nl, $physv); setup_logic_demand($opts, $nl_flags, $definition, $defaults, $nl, $physv); setup_logic_surface_dataset($opts, $nl_flags, $definition, $defaults, $nl, $physv); if ( remove_leading_and_trailing_quotes($nl_flags->{'clm_start_type'}) ne "branch" ) { @@ -2192,6 +2192,15 @@ sub error_if_set { } +#------------------------------------------------------------------------------- +sub setup_logic_pftsoilcolumn { + my ($opts, $nl_flags, $definition, $defaults, $nl, $physv) = @_; + + if ( $physv->as_long() >= $physv->as_long("clm4_5") ) { + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'use_individual_pft_soil_column'); + } +} + #------------------------------------------------------------------------------- sub setup_logic_soilstate { @@ -3616,6 +3625,7 @@ sub setup_logic_canopyfluxes { if ( $physv->as_long() >= $physv->as_long("clm4_5") ) { add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'use_undercanopy_stability' ); + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'use_biomass_heat_storage'); } } diff --git a/bld/namelist_files/namelist_defaults_clm4_5.xml b/bld/namelist_files/namelist_defaults_clm4_5.xml index 1a3629725d..0d6f428f88 100644 --- a/bld/namelist_files/namelist_defaults_clm4_5.xml +++ b/bld/namelist_files/namelist_defaults_clm4_5.xml @@ -131,6 +131,8 @@ attributes from the config_cache.xml file (with keys converted to upper-case). .false. +.false. + 1 0 @@ -229,6 +231,9 @@ attributes from the config_cache.xml file (with keys converted to upper-case). .false. .true. +.false. + + .true. diff --git a/bld/namelist_files/namelist_definition_clm4_5.xml b/bld/namelist_files/namelist_definition_clm4_5.xml index 44b98a18b4..e19d1a9a46 100644 --- a/bld/namelist_files/namelist_definition_clm4_5.xml +++ b/bld/namelist_files/namelist_definition_clm4_5.xml @@ -131,6 +131,11 @@ specify spatially variable soil thickness. If not present, use bottom of soil column (nlevsoi). + +If TRUE, each pft exists on a separate soil column. + + Index of rooting profile for water @@ -303,6 +308,11 @@ Intercept of free living Nitrogen fixation with zero annual ET If TRUE use the undercanopy stability term used with CLM4.5 (Sakaguchi&Zeng, 2008) + +If TRUE, include biomass heat storage in canopy energy balance. + + Fraction of intercepted precipitation diff --git a/src/biogeophys/CanopyFluxesMod.F90 b/src/biogeophys/CanopyFluxesMod.F90 index cb43a9cb5d..34bc959f85 100644 --- a/src/biogeophys/CanopyFluxesMod.F90 +++ b/src/biogeophys/CanopyFluxesMod.F90 @@ -68,7 +68,7 @@ module CanopyFluxesMod logical, private :: snowveg_on = .false. ! snowveg_flag = 'ON' logical, private :: snowveg_onrad = .true. ! snowveg_flag = 'ON_RAD' logical, private :: use_undercanopy_stability = .true. ! use undercanopy stability term or not - + logical, private :: use_biomass_heat_storage = .false. ! include biomass heat storage character(len=*), parameter, private :: sourcefile = & __FILE__ !------------------------------------------------------------------------------ @@ -99,7 +99,7 @@ subroutine CanopyFluxesReadNML(NLFilename) character(len=*), parameter :: nmlname = 'canopyfluxes_inparm' !----------------------------------------------------------------------- - namelist /canopyfluxes_inparm/ use_undercanopy_stability + namelist /canopyfluxes_inparm/ use_undercanopy_stability,use_biomass_heat_storage ! Initialize options to default values, in case they are not specified in ! the namelist @@ -121,6 +121,7 @@ subroutine CanopyFluxesReadNML(NLFilename) end if call shr_mpi_bcast (use_undercanopy_stability, mpicom) + call shr_mpi_bcast (use_biomass_heat_storage, mpicom) if (masterproc) then write(iulog,*) ' ' @@ -353,20 +354,24 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, real(r8) :: cp_veg(bounds%begp:bounds%endp) !heat capacity of veg real(r8) :: cp_stem(bounds%begp:bounds%endp) !heat capacity of stems - real(r8) :: dt_stem(bounds%begp:bounds%endp) + real(r8) :: dt_stem(bounds%begp:bounds%endp) !change in stem temperature real(r8) :: fstem(bounds%begp:bounds%endp) !fraction of stem - real(r8) :: bhd(0:mxpft) !stem breast-height-diameter - real(r8) :: wood_density, carea_stem real(r8) :: lw_stem(bounds%begp:bounds%endp) !internal longwave stem real(r8) :: lw_leaf(bounds%begp:bounds%endp) !internal longwave leaf real(r8) :: sa_stem(bounds%begp:bounds%endp) !surface area stem m2/m2_ground real(r8) :: sa_leaf(bounds%begp:bounds%endp) !surface area leaf m2/m2_ground real(r8) :: sa_internal(bounds%begp:bounds%endp) !min(sa_stem,sa_leaf) real(r8) :: uuc(bounds%begp:bounds%endp) ! undercanopy windspeed + real(r8) :: bhd(0:mxpft) !stem breast-height-diameter + real(r8) :: fbw(0:mxpft) !stem diameter at breast-height + real(r8) :: nstem(0:mxpft) !number of stems per m2 + real(r8) :: rstem(0:mxpft) !stem resistance to heat transfer, per stem diameter + real(r8) :: wood_density(0:mxpft) !wood density (kg/m3) + real(r8) :: cp_wood + real(r8) :: carea_stem + real(r8) :: rstema ! biomass parameters real(r8), parameter :: c_to_b = 2.0_r8 !(g biomass /g C) - real(r8), parameter :: ntree = 0.4_r8 !(number of trees / m2) - real(r8), parameter :: rstem = 100._r8 !stem resistance (s/m) real(r8), parameter :: k_vert = 0.1 !vertical distribution of stem real(r8), parameter :: k_cyl_vol = 1.0 !departure from cylindrical volume @@ -626,8 +631,12 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, hs_canopy(p) = 0._r8 end do -! set bhd (should be done on parameter file) +! set pft specific stem properties (should be done on parameter file) bhd(1:16) = (/0.15,0.15,0.15,0.2,0.2,0.2,0.2,0.1,0.02,0.02,0.02,0.004,0.004,0.004,0.004,0.004/) + fbw(1:16) = (/0.45,0.45,0.45,0.6,0.6,0.6,0.6,0.45,0.5,0.5,0.5,0.7,0.7,0.7,0.7,0.7/) + nstem(1:16) = (/0.4,0.4,0.4,0.2,0.2,0.2,0.2,0.4,1.,1.,1.,100.,100.,100.,100.,100./) + rstem(1:16) = (/100.,100.,100.,100.,100.,100.,100.,100.,100.,100.,100.,100.,100.,100.,100.,100./) + wood_density(1:16) = (/500.,500.,500.,500.,500.,500.,500.,500.,500.,500.,500.,500.,500.,500.,500.,500./) ! calculate biomass heat capacities do f = 1, fn @@ -636,34 +645,45 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ! fraction of stem receiving incoming radiation fstem(p) = (esai(p))/(elai(p)+esai(p)) fstem(p) = k_vert * fstem(p) + if(.not.use_biomass_heat_storage) then + fstem(p) = 0._r8 + endif +! do not calculate separate leaf/stem heat capacity for grasses + if(patch%itype(p) > 11) fstem(p) = 0.0 + ! leaf and stem surface area sa_leaf(p) = elai(p) ! double in spirit of full surface area for sensible heat sa_leaf(p) = 2.*sa_leaf(p) - sa_stem(p) = ntree*(htop(p)*shr_const_pi*bhd(patch%itype(p))) + + sa_stem(p) = nstem(patch%itype(p))*(htop(p)*shr_const_pi*bhd(patch%itype(p))) ! adjust for departure of cylindrical stem model sa_stem(p) = k_cyl_area * sa_stem(p) + if(.not.use_biomass_heat_storage) then + sa_stem(p) = 0._r8 + endif +! do not calculate separate leaf/stem heat capacity for grasses + if(patch%itype(p) > 11) sa_stem(p) = 0.0 + ! internal longwave fluxes between leaf and stem ! surface area term must be equal, remainder cancels ! (use same area of interaction i.e. ignore leaf <-> leaf) sa_internal(p) = min(sa_leaf(p),sa_stem(p)) sa_internal(p) = k_internal * sa_internal(p) -!scs: specify heat capacity of vegetation +! calculate specify heat capacity of vegetation !(lma * c2b = lma_dry, lma * c2b * (fw/(1-fw)) = lma_wet, sum these) ! lma_dry has units of kg dry mass /m2 here (table 2 of bonan 2017) ! cdry_biomass = 1400 J/kg/K, cwater = 4188 J/kg/K ! boreal needleleaf lma*c2b ~ 0.25 kg dry mass/m2(leaf) - cp_veg(p) = (0.25_r8 * elai(p)) * (1400._r8 + (0.7/(1.-0.7))*4188._r8) + cp_veg(p) = (0.25_r8 * max(0.01_r8,elai(p))) * (1400._r8 + (fbw(patch%itype(p))/(1.-fbw(patch%itype(p))))*4188._r8) -! wood density could vary by pft... - wood_density = 5.e2_r8 ! kg/m3 lindroth2010 uses ~4.e2 carea_stem = shr_const_pi * (bhd(patch%itype(p))*0.5)**2 ! cp-stem will have units J/k/ground_area (here assuming 1 stem/m2) - cp_stem(p) = (1400._r8 + (0.7/(1.-0.7))*4188._r8) + cp_stem(p) = (1400._r8 + (fbw(patch%itype(p))/(1.-fbw(patch%itype(p))))*4188._r8) ! use weight of dry wood - cp_stem(p) = cp_stem(p) * ntree * wood_density * htop(p) * carea_stem + cp_stem(p) = nstem(patch%itype(p))* cp_stem(p) * wood_density(patch%itype(p)) * htop(p) * carea_stem ! adjust for departure from cylindrical stem model cp_stem(p) = k_cyl_vol * cp_stem(p) enddo @@ -997,7 +1017,8 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, wtg(p) = 1._r8/rah(p,2) ! ground ! wtstem = sa_stem(p)/rb(p) ! stem ! add resistance between internal stem temperature and canopy air - wtstem = sa_stem(p)/(rstem + rb(p)) ! stem + rstema = rstem(patch%itype(p))*bhd(patch%itype(p)) + wtstem = sa_stem(p)/(rstema + rb(p)) ! stem wtshi = 1._r8/(wta+wtl+wtstem+wtg(p)) diff --git a/src/main/clm_varctl.F90 b/src/main/clm_varctl.F90 index 938155c5dd..2c4ad5c371 100644 --- a/src/main/clm_varctl.F90 +++ b/src/main/clm_varctl.F90 @@ -237,6 +237,18 @@ module clm_varctl logical, public :: use_lai_streams = .false. ! true => use lai streams in SatellitePhenologyMod.F90 + !---------------------------------------------------------- + ! biomass heat storage switch + !---------------------------------------------------------- + + logical, public :: use_biomass_heat_storage = .false. ! true => include biomass heat storage in canopy energy budget + + !---------------------------------------------------------- + ! each pft has individual soil column switch + !---------------------------------------------------------- + + logical, public :: use_individual_pft_soil_column = .false. ! true => each pft exists on its own soil column + !---------------------------------------------------------- ! bedrock / soil depth switch !---------------------------------------------------------- diff --git a/src/main/controlMod.F90 b/src/main/controlMod.F90 index 9cc442d026..4f94ead66c 100644 --- a/src/main/controlMod.F90 +++ b/src/main/controlMod.F90 @@ -231,6 +231,10 @@ subroutine control_init( ) namelist /clm_inparm/ use_bedrock + namelist /clm_inparm/ use_biomass_heat_storage + + namelist /clm_inparm/ use_individual_pft_soil_column + namelist /clm_inparm/ use_hydrstress namelist /clm_inparm/ use_dynroot @@ -655,6 +659,10 @@ subroutine control_spmd() call mpi_bcast (use_bedrock, 1, MPI_LOGICAL, 0, mpicom, ier) + call mpi_bcast (use_biomass_heat_storage, 1, MPI_LOGICAL, 0, mpicom, ier) + + call mpi_bcast (use_individual_pft_soil_column, 1, MPI_LOGICAL, 0, mpicom, ier) + call mpi_bcast (use_hydrstress, 1, MPI_LOGICAL, 0, mpicom, ier) call mpi_bcast (use_dynroot, 1, MPI_LOGICAL, 0, mpicom, ier) diff --git a/src/main/initGridCellsMod.F90 b/src/main/initGridCellsMod.F90 index 0bb499ddba..be4c2d154b 100644 --- a/src/main/initGridCellsMod.F90 +++ b/src/main/initGridCellsMod.F90 @@ -63,7 +63,7 @@ subroutine initGridcells(glc_behavior) use subgridWeightsMod , only : compute_higher_order_weights use landunit_varcon , only : istsoil, istwet, istdlak, istice_mec use landunit_varcon , only : isturb_tbd, isturb_hd, isturb_md, istcrop - use clm_varctl , only : use_fates + use clm_varctl , only : use_fates,use_individual_pft_soil_column use shr_const_mod , only : SHR_CONST_PI ! ! !ARGUMENTS: @@ -74,7 +74,7 @@ subroutine initGridcells(glc_behavior) integer :: nclumps ! number of clumps on this processor type(bounds_type) :: bounds_proc type(bounds_type) :: bounds_clump - logical :: sesc = .TRUE. ! switch for separated soil columns of natural vegetation + !------------------------------------------------------------------------ ! Notes about how this routine is arranged, and its implications for the arrangement @@ -138,7 +138,7 @@ subroutine initGridcells(glc_behavior) ! Determine naturally vegetated landunit do gdc = bounds_clump%begg,bounds_clump%endg - if(sesc) then + if(use_individual_pft_soil_column) then call set_landunit_veg_noncompete( & ltype=istsoil, gi=gdc, li=li, ci=ci, pi=pi) else @@ -344,7 +344,7 @@ subroutine set_landunit_veg_noncompete (ltype, gi, li, ci, pi) SHR_ASSERT(ncols_added == ncols, errMsg(sourcefile, __LINE__)) SHR_ASSERT(npatches_added == npatches, errMsg(sourcefile, __LINE__)) - end subroutine set_landunit_veg_compete + end subroutine set_landunit_veg_noncompete !------------------------------------------------------------------------ diff --git a/src/main/subgridMod.F90 b/src/main/subgridMod.F90 index f152466ea4..c118220cb2 100644 --- a/src/main/subgridMod.F90 +++ b/src/main/subgridMod.F90 @@ -14,7 +14,7 @@ module subgridMod use shr_log_mod , only : errMsg => shr_log_errMsg use spmdMod , only : masterproc use abortutils , only : endrun - use clm_varctl , only : iulog + use clm_varctl , only : iulog,use_individual_pft_soil_column use clm_instur , only : wt_lunit, wt_nat_patch, urban_valid, wt_cft use landunit_varcon, only : istcrop, istdlak, istwet, isturb_tbd, isturb_hd, isturb_md use glcBehaviorMod , only : glc_behavior_type @@ -74,7 +74,6 @@ subroutine subgrid_get_gcellinfo (gi, glc_behavior, & ! atm_topo is arbitrary for the sake of getting these counts. We don't have a true ! atm_topo value at the point of this call, so use 0. real(r8), parameter :: atm_topo = 0._r8 - logical :: sesc = .TRUE. ! switch for separated soil columns of natural vegetation !------------------------------------------------------------------------------ @@ -83,7 +82,7 @@ subroutine subgrid_get_gcellinfo (gi, glc_behavior, & nlunits = 0 ncohorts = 0 - call subgrid_get_info_natveg(gi, npatches_temp, ncols_temp, nlunits_temp, sesc) + call subgrid_get_info_natveg(gi, npatches_temp, ncols_temp, nlunits_temp, use_individual_pft_soil_column) call accumulate_counters() call subgrid_get_info_urban_tbd(gi, npatches_temp, ncols_temp, nlunits_temp) From 2b9419ffef900b44d05973b74a65089897b08a48 Mon Sep 17 00:00:00 2001 From: Sean Swenson Date: Mon, 11 Jun 2018 14:21:59 -0600 Subject: [PATCH 04/76] add setup_logic_soilstate to bld/CLMBuildNamelist.pm --- bld/CLMBuildNamelist.pm | 1 + 1 file changed, 1 insertion(+) diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index 5f4d6d4c04..3f3d6bafb8 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -1573,6 +1573,7 @@ sub process_namelist_inline_logic { setup_logic_fertilizer($opts, $nl_flags, $definition, $defaults, $nl, $physv); setup_logic_grainproduct($opts, $nl_flags, $definition, $defaults, $nl, $physv); setup_logic_pftsoilcolumn($opts, $nl_flags, $definition, $defaults, $nl, $physv); + setup_logic_soilstate($opts, $nl_flags, $definition, $defaults, $nl, $physv); setup_logic_demand($opts, $nl_flags, $definition, $defaults, $nl, $physv); setup_logic_surface_dataset($opts, $nl_flags, $definition, $defaults, $nl, $physv); if ( remove_leading_and_trailing_quotes($nl_flags->{'clm_start_type'}) ne "branch" ) { From c0f744b934f34ff01398d573023cf90c352cbdba Mon Sep 17 00:00:00 2001 From: Sean Swenson Date: Tue, 12 Jun 2018 09:11:46 -0600 Subject: [PATCH 05/76] initialize hs_canopy and eflx_hs_stem --- src/biogeophys/BareGroundFluxesMod.F90 | 4 ++++ src/biogeophys/CanopyFluxesMod.F90 | 1 + src/biogeophys/SoilFluxesMod.F90 | 4 +++- 3 files changed, 8 insertions(+), 1 deletion(-) diff --git a/src/biogeophys/BareGroundFluxesMod.F90 b/src/biogeophys/BareGroundFluxesMod.F90 index cfbc99b740..2500453902 100644 --- a/src/biogeophys/BareGroundFluxesMod.F90 +++ b/src/biogeophys/BareGroundFluxesMod.F90 @@ -112,6 +112,8 @@ subroutine BareGroundFluxes(bounds, num_noexposedvegp, filter_noexposedvegp, & !------------------------------------------------------------------------------ associate( & + hs_canopy => energyflux_inst%hs_canopy_patch , & ! Output: [real(r8) (:) ] change in heat storage of stem (W/m**2) [+ to atm] + eflx_sh_stem => energyflux_inst%eflx_sh_stem_patch , & ! Output: [real(r8) (:) ] sensible heat flux from stems (W/m**2) [+ to atm] soilresis => soilstate_inst%soilresis_col , & ! Input: [real(r8) (:,:) ] evaporative soil resistance (s/m) snl => col%snl , & ! Input: [integer (:) ] number of snow layers dz => col%dz , & ! Input: [real(r8) (:,:) ] layer depth (m) @@ -251,6 +253,8 @@ subroutine BareGroundFluxes(bounds, num_noexposedvegp, filter_noexposedvegp, & displa(p) = 0._r8 dlrad(p) = 0._r8 ulrad(p) = 0._r8 + hs_canopy(p) = 0._r8 + eflx_sh_stem(p) = 0._r8 ur(p) = max(1.0_r8,sqrt(forc_u(g)*forc_u(g)+forc_v(g)*forc_v(g))) dth(p) = thm(p)-t_grnd(c) diff --git a/src/biogeophys/CanopyFluxesMod.F90 b/src/biogeophys/CanopyFluxesMod.F90 index 34bc959f85..a9b45270d3 100644 --- a/src/biogeophys/CanopyFluxesMod.F90 +++ b/src/biogeophys/CanopyFluxesMod.F90 @@ -629,6 +629,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, btran(p) = btran0 btran2(p) = btran0 hs_canopy(p) = 0._r8 + eflx_sh_stem(p) = 0._r8 end do ! set pft specific stem properties (should be done on parameter file) diff --git a/src/biogeophys/SoilFluxesMod.F90 b/src/biogeophys/SoilFluxesMod.F90 index c4b5852372..fbafcb8f6e 100644 --- a/src/biogeophys/SoilFluxesMod.F90 +++ b/src/biogeophys/SoilFluxesMod.F90 @@ -311,7 +311,9 @@ subroutine SoilFluxes (bounds, num_urbanl, filter_urbanl, & ! Total fluxes (vegetation + ground) - eflx_sh_tot(p) = eflx_sh_veg(p) + eflx_sh_stem(p) + eflx_sh_grnd(p) +! eflx_sh_tot(p) = eflx_sh_veg(p) + eflx_sh_stem(p) + eflx_sh_grnd(p) + eflx_sh_tot(p) = eflx_sh_veg(p) + eflx_sh_grnd(p) + if (.not. lun%urbpoi(l)) eflx_sh_tot(p) = eflx_sh_tot(p) + eflx_sh_stem(p) qflx_evap_tot(p) = qflx_evap_veg(p) + qflx_evap_soi(p) eflx_lh_tot(p)= hvap*qflx_evap_veg(p) + htvp(c)*qflx_evap_soi(p) if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then From 508a8faa40ee531d345680a8ca179e36fa4a4ec8 Mon Sep 17 00:00:00 2001 From: Sean Swenson Date: Tue, 12 Jun 2018 12:36:49 -0600 Subject: [PATCH 06/76] add t_stem restart, change bhd/nstem, comment out lnd2glc endrun --- src/biogeophys/CanopyFluxesMod.F90 | 10 ++++++++-- src/biogeophys/TemperatureType.F90 | 5 +++++ src/main/lnd2glcMod.F90 | 4 +++- 3 files changed, 16 insertions(+), 3 deletions(-) diff --git a/src/biogeophys/CanopyFluxesMod.F90 b/src/biogeophys/CanopyFluxesMod.F90 index a9b45270d3..c3d009b31b 100644 --- a/src/biogeophys/CanopyFluxesMod.F90 +++ b/src/biogeophys/CanopyFluxesMod.F90 @@ -633,9 +633,9 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, end do ! set pft specific stem properties (should be done on parameter file) - bhd(1:16) = (/0.15,0.15,0.15,0.2,0.2,0.2,0.2,0.1,0.02,0.02,0.02,0.004,0.004,0.004,0.004,0.004/) + bhd(1:16) = (/0.2,0.3,0.3,0.35,0.35,0.25,0.25,0.2,0.05,0.05,0.05,0.008,0.008,0.008,0.008,0.008/) fbw(1:16) = (/0.45,0.45,0.45,0.6,0.6,0.6,0.6,0.45,0.5,0.5,0.5,0.7,0.7,0.7,0.7,0.7/) - nstem(1:16) = (/0.4,0.4,0.4,0.2,0.2,0.2,0.2,0.4,1.,1.,1.,100.,100.,100.,100.,100./) + nstem(1:16) = (/0.4,0.4,0.4,0.2,0.2,0.2,0.2,0.4,0.5,0.5,0.5,100.,100.,100.,100.,100./) rstem(1:16) = (/100.,100.,100.,100.,100.,100.,100.,100.,100.,100.,100.,100.,100.,100.,100.,100./) wood_density(1:16) = (/500.,500.,500.,500.,500.,500.,500.,500.,500.,500.,500.,500.,500.,500.,500.,500./) @@ -1397,6 +1397,12 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ulrad(p) = ((1._r8-emg(c))*(1._r8-emv(p))*(1._r8-emv(p))*forc_lwrad(c) & + emv(p)*(1._r8+(1._r8-emg(c))*(1._r8-emv(p)))*sb*((1.-fstem(p))*tlbef(p)**3*(tlbef(p) + 4._r8*dt_veg(p))+fstem(p)*tsbef(p)**3*(tsbef(p) + 4._r8*dt_stem(p))) + emg(c)*(1._r8-emv(p))*sb*lw_grnd) +!scs +if(ulrad(p) > 0. .and. ulrad(p) < 5.e3) then +else +write(iulog,*) 'badulrad: ', p, patch%itype(p),ulrad(p),tlbef(p),tsbef(p),dt_stem(p) +endif + !ABT ! Calculate the skin temperature as a weighted sum of all the ground and vegetated fraction ! The weight is the so-called vegetation emissivity, but not that emv is actually an attentuation diff --git a/src/biogeophys/TemperatureType.F90 b/src/biogeophys/TemperatureType.F90 index 00e714e20b..43bd8f682e 100644 --- a/src/biogeophys/TemperatureType.F90 +++ b/src/biogeophys/TemperatureType.F90 @@ -886,6 +886,11 @@ subroutine Restart(this, bounds, ncid, flag, is_simple_buildtemp, is_prog_buildt long_name='vegetation temperature', units='K', & interpinic_flag='interp', readvar=readvar, data=this%t_veg_patch) + call restartvar(ncid=ncid, flag=flag, varname='T_STEM', xtype=ncd_double, & + dim1name='pft', & + long_name='stem temperature', units='K', & + interpinic_flag='interp', readvar=readvar, data=this%t_stem_patch) + call restartvar(ncid=ncid, flag=flag, varname='TH2OSFC', xtype=ncd_double, & dim1name='column', & long_name='surface water temperature', units='K', & diff --git a/src/main/lnd2glcMod.F90 b/src/main/lnd2glcMod.F90 index 9de7eba3f3..a704245d0b 100644 --- a/src/main/lnd2glcMod.F90 +++ b/src/main/lnd2glcMod.F90 @@ -204,7 +204,9 @@ subroutine update_lnd2glc(this, bounds, num_do_smb_c, filter_do_smb_c, & ! Make sure we haven't already assigned the coupling fields for this point ! (this could happen, for example, if there were multiple columns in the ! istsoil landunit, which we aren't prepared to handle) - if (fields_assigned(g,n)) then +!FIXTHIS!!! if (fields_assigned(g,n)) then +! This is commented out so that multiple soil columns can be enabled + if (1==2) then write(iulog,*) subname//' ERROR: attempt to assign coupling fields twice for the same index.' write(iulog,*) 'One possible cause is having multiple columns in the istsoil landunit,' write(iulog,*) 'which this routine cannot handle.' From 41e2a7415ef968b2533359e3e5e486b5b9ed6161 Mon Sep 17 00:00:00 2001 From: Sean Swenson Date: Thu, 21 Jun 2018 10:29:57 -0600 Subject: [PATCH 07/76] read biomass parameters from file --- src/biogeophys/CanopyFluxesMod.F90 | 125 +++++++++++++++++++++++------ src/main/clm_initializeMod.F90 | 2 +- src/main/clm_instMod.F90 | 2 + src/main/pftconMod.F90 | 16 ++++ src/main/readParamsMod.F90 | 5 +- 5 files changed, 125 insertions(+), 25 deletions(-) diff --git a/src/biogeophys/CanopyFluxesMod.F90 b/src/biogeophys/CanopyFluxesMod.F90 index c3d009b31b..7a3f646a1d 100644 --- a/src/biogeophys/CanopyFluxesMod.F90 +++ b/src/biogeophys/CanopyFluxesMod.F90 @@ -51,6 +51,25 @@ module CanopyFluxesMod ! !PUBLIC TYPES: implicit none ! + ! !PUBLIC VARIABLES: + + type :: canopyflux_params_type + real(r8), allocatable, public :: dbh (:) + real(r8), allocatable, public :: fbw (:) + real(r8), allocatable, public :: nstem (:) + real(r8), allocatable, public :: rstem (:) + real(r8), allocatable, public :: wood_density (:) + contains + procedure, private :: allocParams + end type canopyflux_params_type + ! + type(canopyflux_params_type), public, protected :: params_inst ! params_inst is populated in readParamsMod + + type, public :: canopyflux_type + contains + procedure, public :: ReadParams + end type canopyflux_type + ! !PUBLIC MEMBER FUNCTIONS: public :: CanopyFluxesReadNML ! Read in namelist settings public :: CanopyFluxes ! Calculate canopy fluxes @@ -75,6 +94,76 @@ module CanopyFluxesMod contains + !----------------------------------------------------------------------- + subroutine allocParams ( this ) + ! + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + implicit none + + ! !ARGUMENTS: + class(canopyflux_params_type) :: this + ! + ! !LOCAL VARIABLES: + character(len=32) :: subname = 'allocParams' + !----------------------------------------------------------------------- + + ! allocate parameters + + allocate( this%dbh (0:mxpft) ) ; this%dbh(:) = nan + allocate( this%fbw (0:mxpft) ) ; this%fbw(:) = nan + allocate( this%nstem (0:mxpft) ) ; this%nstem(:) = nan + allocate( this%rstem (0:mxpft) ) ; this%rstem(:) = nan + allocate( this%wood_density(0:mxpft) ) ; this%wood_density(:) = nan + + end subroutine allocParams + + !----------------------------------------------------------------------- + subroutine readParams ( this, ncid ) + ! + ! !USES: + use ncdio_pio , only : file_desc_t,ncd_io + implicit none + + ! !ARGUMENTS: + class(canopyflux_type) :: this + type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id + ! + ! !LOCAL VARIABLES: + character(len=32) :: subname = 'readParams' + character(len=100) :: errCode = '-Error reading in parameters file:' + logical :: readv ! has variable been read in or not + real(r8) :: temp1d(0:mxpft) ! temporary to read in parameter + character(len=100) :: tString ! temp. var for reading + !----------------------------------------------------------------------- + + ! read in parameters + + + call params_inst%allocParams() + + tString = "dbh" + call ncd_io(varname=trim(tString),data=temp1d, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%dbh=temp1d + tString = "fbw" + call ncd_io(varname=trim(tString),data=temp1d, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%fbw=temp1d + tString = "nstem" + call ncd_io(varname=trim(tString),data=temp1d, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%nstem=temp1d + tString = "rstem" + call ncd_io(varname=trim(tString),data=temp1d, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%rstem=temp1d + tString = "wood_density" + call ncd_io(varname=trim(tString),data=temp1d, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%wood_density=temp1d + + end subroutine readParams + !------------------------------------------------------------------------ subroutine CanopyFluxesReadNML(NLFilename) ! @@ -362,11 +451,6 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, real(r8) :: sa_leaf(bounds%begp:bounds%endp) !surface area leaf m2/m2_ground real(r8) :: sa_internal(bounds%begp:bounds%endp) !min(sa_stem,sa_leaf) real(r8) :: uuc(bounds%begp:bounds%endp) ! undercanopy windspeed - real(r8) :: bhd(0:mxpft) !stem breast-height-diameter - real(r8) :: fbw(0:mxpft) !stem diameter at breast-height - real(r8) :: nstem(0:mxpft) !number of stems per m2 - real(r8) :: rstem(0:mxpft) !stem resistance to heat transfer, per stem diameter - real(r8) :: wood_density(0:mxpft) !wood density (kg/m3) real(r8) :: cp_wood real(r8) :: carea_stem real(r8) :: rstema @@ -632,13 +716,6 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, eflx_sh_stem(p) = 0._r8 end do -! set pft specific stem properties (should be done on parameter file) - bhd(1:16) = (/0.2,0.3,0.3,0.35,0.35,0.25,0.25,0.2,0.05,0.05,0.05,0.008,0.008,0.008,0.008,0.008/) - fbw(1:16) = (/0.45,0.45,0.45,0.6,0.6,0.6,0.6,0.45,0.5,0.5,0.5,0.7,0.7,0.7,0.7,0.7/) - nstem(1:16) = (/0.4,0.4,0.4,0.2,0.2,0.2,0.2,0.4,0.5,0.5,0.5,100.,100.,100.,100.,100./) - rstem(1:16) = (/100.,100.,100.,100.,100.,100.,100.,100.,100.,100.,100.,100.,100.,100.,100.,100./) - wood_density(1:16) = (/500.,500.,500.,500.,500.,500.,500.,500.,500.,500.,500.,500.,500.,500.,500.,500./) - ! calculate biomass heat capacities do f = 1, fn p = filterp(f) @@ -649,22 +726,23 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, if(.not.use_biomass_heat_storage) then fstem(p) = 0._r8 endif -! do not calculate separate leaf/stem heat capacity for grasses - if(patch%itype(p) > 11) fstem(p) = 0.0 ! leaf and stem surface area sa_leaf(p) = elai(p) ! double in spirit of full surface area for sensible heat sa_leaf(p) = 2.*sa_leaf(p) - sa_stem(p) = nstem(patch%itype(p))*(htop(p)*shr_const_pi*bhd(patch%itype(p))) + sa_stem(p) = params_inst%nstem(patch%itype(p))*(htop(p)*shr_const_pi*params_inst%dbh(patch%itype(p))) ! adjust for departure of cylindrical stem model sa_stem(p) = k_cyl_area * sa_stem(p) if(.not.use_biomass_heat_storage) then sa_stem(p) = 0._r8 endif ! do not calculate separate leaf/stem heat capacity for grasses - if(patch%itype(p) > 11) sa_stem(p) = 0.0 + if(patch%itype(p) > 11) then + fstem(p) = 0.0 + sa_stem(p) = 0.0 + endif ! internal longwave fluxes between leaf and stem ! surface area term must be equal, remainder cancels @@ -677,14 +755,14 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ! lma_dry has units of kg dry mass /m2 here (table 2 of bonan 2017) ! cdry_biomass = 1400 J/kg/K, cwater = 4188 J/kg/K ! boreal needleleaf lma*c2b ~ 0.25 kg dry mass/m2(leaf) - cp_veg(p) = (0.25_r8 * max(0.01_r8,elai(p))) * (1400._r8 + (fbw(patch%itype(p))/(1.-fbw(patch%itype(p))))*4188._r8) + cp_veg(p) = (0.25_r8 * max(0.01_r8,elai(p))) * (1400._r8 + (params_inst%fbw(patch%itype(p))/(1.-params_inst%fbw(patch%itype(p))))*4188._r8) - carea_stem = shr_const_pi * (bhd(patch%itype(p))*0.5)**2 + carea_stem = shr_const_pi * (params_inst%dbh(patch%itype(p))*0.5)**2 ! cp-stem will have units J/k/ground_area (here assuming 1 stem/m2) - cp_stem(p) = (1400._r8 + (fbw(patch%itype(p))/(1.-fbw(patch%itype(p))))*4188._r8) + cp_stem(p) = (1400._r8 + (params_inst%fbw(patch%itype(p))/(1.-params_inst%fbw(patch%itype(p))))*4188._r8) ! use weight of dry wood - cp_stem(p) = nstem(patch%itype(p))* cp_stem(p) * wood_density(patch%itype(p)) * htop(p) * carea_stem + cp_stem(p) = params_inst%nstem(patch%itype(p))* cp_stem(p) * params_inst%wood_density(patch%itype(p)) * htop(p) * carea_stem ! adjust for departure from cylindrical stem model cp_stem(p) = k_cyl_vol * cp_stem(p) enddo @@ -1018,7 +1096,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, wtg(p) = 1._r8/rah(p,2) ! ground ! wtstem = sa_stem(p)/rb(p) ! stem ! add resistance between internal stem temperature and canopy air - rstema = rstem(patch%itype(p))*bhd(patch%itype(p)) + rstema = params_inst%rstem(patch%itype(p))*params_inst%dbh(patch%itype(p)) wtstem = sa_stem(p)/(rstema + rb(p)) ! stem wtshi = 1._r8/(wta+wtl+wtstem+wtg(p)) @@ -1204,7 +1282,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ! The energy loss due to above two limits is added to ! the sensible heat flux. - eflx_sh_veg(p) = efsh + dc1*wtga(p)*dt_veg(p) + err(p) + erre + hvap*ecidif + eflx_sh_veg(p) = efsh + dc1*wtga(p)*dt_veg(p) + err(p) + erre + hvap*ecidif ! Update SH and lw_leaf for changes in t_veg eflx_sh_stem(p) = eflx_sh_stem(p) + forc_rho(c)*cpair*wtstem*(-wtl0(p)*dt_veg(p)) @@ -1236,7 +1314,8 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, zeta(p) = zldis(p)*vkc*grav*thvstar/(ustar(p)**2*thv(c)) if (zeta(p) >= 0._r8) then !stable - zeta(p) = min(zetamax,max(zeta(p),0.01_r8)) +!remove cap zeta(p) = min(zetamax,max(zeta(p),0.01_r8)) + zeta(p) = min(100._r8,max(zeta(p),0.01_r8)) um(p) = max(ur(p),0.1_r8) else !unstable zeta(p) = max(-100._r8,min(zeta(p),-0.01_r8)) diff --git a/src/main/clm_initializeMod.F90 b/src/main/clm_initializeMod.F90 index 42f71ec526..12f43ad3db 100644 --- a/src/main/clm_initializeMod.F90 +++ b/src/main/clm_initializeMod.F90 @@ -340,7 +340,7 @@ subroutine initialize2( ) allocate(nutrient_competition_method, & source=create_nutrient_competition_method(bounds_proc)) - call readParameters(nutrient_competition_method, photosyns_inst) + call readParameters(nutrient_competition_method, photosyns_inst, canopyflux_inst) ! ------------------------------------------------------------------------ ! Initialize time manager diff --git a/src/main/clm_instMod.F90 b/src/main/clm_instMod.F90 index 1b1b44adba..b33026326f 100644 --- a/src/main/clm_instMod.F90 +++ b/src/main/clm_instMod.F90 @@ -49,6 +49,7 @@ module clm_instMod use OzoneBaseMod , only : ozone_base_type use OzoneFactoryMod , only : create_and_init_ozone_type use PhotosynthesisMod , only : photosyns_type + use CanopyFluxesMod , only : canopyflux_type use SoilHydrologyType , only : soilhydrology_type use SoilStateType , only : soilstate_type use SolarAbsorbedType , only : solarabs_type @@ -99,6 +100,7 @@ module clm_instMod type(lakestate_type) :: lakestate_inst class(ozone_base_type), allocatable :: ozone_inst type(photosyns_type) :: photosyns_inst + type(canopyflux_type) :: canopyflux_inst type(soilstate_type) :: soilstate_inst type(soilhydrology_type) :: soilhydrology_inst type(solarabs_type) :: solarabs_inst diff --git a/src/main/pftconMod.F90 b/src/main/pftconMod.F90 index 0efa2053eb..53fb8d0d0c 100644 --- a/src/main/pftconMod.F90 +++ b/src/main/pftconMod.F90 @@ -145,6 +145,12 @@ module pftconMod real(r8), allocatable :: root_radius (:) ! root radius (m) real(r8), allocatable :: root_density (:) ! root density (gC/m3) + real(r8), allocatable :: dbh (:) ! diameter at breast height (m) + real(r8), allocatable :: fbw (:) ! fraction of biomass that is water + real(r8), allocatable :: nstem (:) ! stem density (#/m2) + real(r8), allocatable :: rstem (:) ! stem resistance (s/m) + real(r8), allocatable :: wood_density (:) ! wood density (kg/m3) + ! crop ! These arrays give information about the merge of unused crop types to the types CLM @@ -460,6 +466,11 @@ subroutine InitAllocate (this) allocate( this%fun_cn_flex_c (0:mxpft) ) allocate( this%FUN_fracfixers(0:mxpft) ) + allocate( this%dbh (0:mxpft) ) + allocate( this%fbw (0:mxpft) ) + allocate( this%nstem (0:mxpft) ) + allocate( this%rstem (0:mxpft) ) + allocate( this%wood_density (0:mxpft) ) end subroutine InitAllocate @@ -1375,6 +1386,11 @@ subroutine Clean(this) deallocate( this%fun_cn_flex_c) deallocate( this%FUN_fracfixers) + deallocate( this%dbh) + deallocate( this%fbw) + deallocate( this%nstem) + deallocate( this%rstem) + deallocate( this%wood_density) end subroutine Clean end module pftconMod diff --git a/src/main/readParamsMod.F90 b/src/main/readParamsMod.F90 index 7fbea89531..f1c7a4aa43 100644 --- a/src/main/readParamsMod.F90 +++ b/src/main/readParamsMod.F90 @@ -23,7 +23,7 @@ module readParamsMod contains !----------------------------------------------------------------------- - subroutine readParameters (nutrient_competition_method, photosyns_inst) + subroutine readParameters (nutrient_competition_method, photosyns_inst, canopyflux_inst) ! ! ! USES: use CNSharedParamsMod , only : CNParamsReadShared @@ -43,9 +43,11 @@ subroutine readParameters (nutrient_competition_method, photosyns_inst) use NutrientCompetitionMethodMod , only : nutrient_competition_method_type use clm_varctl, only : NLFilename_in use PhotosynthesisMod , only : photosyns_type + use CanopyFluxesMod , only : canopyflux_type ! ! !ARGUMENTS: type(photosyns_type) , intent(in) :: photosyns_inst + type(canopyflux_type) , intent(in) :: canopyflux_inst class(nutrient_competition_method_type), intent(in) :: nutrient_competition_method ! ! !LOCAL VARIABLES: @@ -97,6 +99,7 @@ subroutine readParameters (nutrient_competition_method, photosyns_inst) ! Biogeophysics ! call photosyns_inst%ReadParams( ncid ) + call canopyflux_inst%ReadParams( ncid ) ! From c795d0bac5a756c42245282e6b075ad103c4300b Mon Sep 17 00:00:00 2001 From: Sean Swenson Date: Thu, 21 Jun 2018 11:12:39 -0600 Subject: [PATCH 08/76] remove comment --- src/biogeophys/CanopyFluxesMod.F90 | 5 ----- 1 file changed, 5 deletions(-) diff --git a/src/biogeophys/CanopyFluxesMod.F90 b/src/biogeophys/CanopyFluxesMod.F90 index 7a3f646a1d..293f75e742 100644 --- a/src/biogeophys/CanopyFluxesMod.F90 +++ b/src/biogeophys/CanopyFluxesMod.F90 @@ -1476,11 +1476,6 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ulrad(p) = ((1._r8-emg(c))*(1._r8-emv(p))*(1._r8-emv(p))*forc_lwrad(c) & + emv(p)*(1._r8+(1._r8-emg(c))*(1._r8-emv(p)))*sb*((1.-fstem(p))*tlbef(p)**3*(tlbef(p) + 4._r8*dt_veg(p))+fstem(p)*tsbef(p)**3*(tsbef(p) + 4._r8*dt_stem(p))) + emg(c)*(1._r8-emv(p))*sb*lw_grnd) -!scs -if(ulrad(p) > 0. .and. ulrad(p) < 5.e3) then -else -write(iulog,*) 'badulrad: ', p, patch%itype(p),ulrad(p),tlbef(p),tsbef(p),dt_stem(p) -endif !ABT ! Calculate the skin temperature as a weighted sum of all the ground and vegetated fraction From f9304f5030a3deccaeb602eb47d3a41a8d14ebf8 Mon Sep 17 00:00:00 2001 From: Sean Swenson Date: Wed, 11 Jul 2018 13:55:42 -0600 Subject: [PATCH 09/76] remove sai from potential evaporation calculation --- src/biogeophys/CanopyFluxesMod.F90 | 14 +++++++++----- src/biogeophys/PhotosynthesisMod.F90 | 2 +- 2 files changed, 10 insertions(+), 6 deletions(-) diff --git a/src/biogeophys/CanopyFluxesMod.F90 b/src/biogeophys/CanopyFluxesMod.F90 index 293f75e742..200ead5653 100644 --- a/src/biogeophys/CanopyFluxesMod.F90 +++ b/src/biogeophys/CanopyFluxesMod.F90 @@ -1128,7 +1128,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, end if ! should be the same expression used in Photosynthesis/getqflx - efpot = forc_rho(c)*(elai(p)+esai(p))/rb(p)*(qsatl(p)-qaf(p)) + efpot = forc_rho(c)*elai(p)/rb(p)*(qsatl(p)-qaf(p)) ! When the hydraulic stress parameterization is active calculate rpp ! but not transpiration @@ -1169,7 +1169,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ! Moved the original subroutine in-line... wtaq = frac_veg_nosno(p)/raw(p,1) ! air - wtlq = frac_veg_nosno(p)*(elai(p)+esai(p))/rb(p) * rpp ! leaf + wtlq = frac_veg_nosno(p)*elai(p)/rb(p) * rpp ! leaf !Litter layer resistance. Added by K.Sakaguchi snow_depth_c = z_dl ! critical depth for 100% litter burial by snow (=litter thickness) @@ -1248,7 +1248,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ! result in an imbalance in "hvap*qflx_evap_veg" and ! "efe + dc2*wtgaq*qsatdt_veg" - efpot = forc_rho(c)*(elai(p)+esai(p))/rb(p) & + efpot = forc_rho(c)*elai(p)/rb(p) & *(wtgaq*(qsatl(p)+qsatldT(p)*dt_veg(p)) & -wtgq0*qg(c)-wtaq0(p)*forc_q(c)) qflx_evap_veg(p) = rpp*efpot @@ -1314,8 +1314,12 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, zeta(p) = zldis(p)*vkc*grav*thvstar/(ustar(p)**2*thv(c)) if (zeta(p) >= 0._r8) then !stable -!remove cap zeta(p) = min(zetamax,max(zeta(p),0.01_r8)) - zeta(p) = min(100._r8,max(zeta(p),0.01_r8)) + ! remove stability cap when biomass heat storage is active + if(use_biomass_heat_storage) then + zeta(p) = min(100._r8,max(zeta(p),0.01_r8)) + else + zeta(p) = min(zetamax,max(zeta(p),0.01_r8)) + endif um(p) = max(ur(p),0.1_r8) else !unstable zeta(p) = max(-100._r8,min(zeta(p),-0.01_r8)) diff --git a/src/biogeophys/PhotosynthesisMod.F90 b/src/biogeophys/PhotosynthesisMod.F90 index 99920f4cca..4237cddd57 100644 --- a/src/biogeophys/PhotosynthesisMod.F90 +++ b/src/biogeophys/PhotosynthesisMod.F90 @@ -4879,7 +4879,7 @@ subroutine getqflx(p,c,gb_mol,gs_mol_sun,gs_mol_sha,qflx_sun,qflx_sha,qsatl,qaf, cf = forc_pbot(c)/(rgas*1.e-3_r8*tgcm(p))*1.e6_r8 ! gb->gbmol conversion factor - wtl = (elai(p)+esai(p))*gb_mol + wtl = elai(p)*gb_mol efpot = forc_rho(c)*wtl*(qsatl-qaf) if (havegs) then From 66611596e6be0e1e4b2202a2f8f9e2e08ec01575 Mon Sep 17 00:00:00 2001 From: Sean Swenson Date: Thu, 2 Aug 2018 10:36:23 -0600 Subject: [PATCH 10/76] add namelist variable use_biomass_heat_storage --- bld/CLMBuildNamelist.pm | 1 + .../namelist_defaults_clm4_5.xml | 1 + .../namelist_definition_clm4_5.xml | 5 + src/biogeophys/BareGroundFluxesMod.F90 | 19 ++- src/biogeophys/CanopyFluxesMod.F90 | 145 +++++++++++++++--- src/biogeophys/FrictionVelocityMod.F90 | 7 +- src/biogeophys/SoilFluxesMod.F90 | 3 +- src/main/clm_initializeMod.F90 | 2 +- src/main/clm_instMod.F90 | 2 + src/main/pftconMod.F90 | 16 ++ src/main/readParamsMod.F90 | 5 +- 11 files changed, 175 insertions(+), 31 deletions(-) diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index 00807d049c..0be2ded790 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -3616,6 +3616,7 @@ sub setup_logic_canopyfluxes { if ( $physv->as_long() >= $physv->as_long("clm4_5") ) { add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'use_undercanopy_stability' ); + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'use_biomass_heat_storage'); } } diff --git a/bld/namelist_files/namelist_defaults_clm4_5.xml b/bld/namelist_files/namelist_defaults_clm4_5.xml index 1a3629725d..1d5cf7bb95 100644 --- a/bld/namelist_files/namelist_defaults_clm4_5.xml +++ b/bld/namelist_files/namelist_defaults_clm4_5.xml @@ -229,6 +229,7 @@ attributes from the config_cache.xml file (with keys converted to upper-case). .false. .true. +.false. .true. diff --git a/bld/namelist_files/namelist_definition_clm4_5.xml b/bld/namelist_files/namelist_definition_clm4_5.xml index 44b98a18b4..c82ab2c607 100644 --- a/bld/namelist_files/namelist_definition_clm4_5.xml +++ b/bld/namelist_files/namelist_definition_clm4_5.xml @@ -303,6 +303,11 @@ Intercept of free living Nitrogen fixation with zero annual ET If TRUE use the undercanopy stability term used with CLM4.5 (Sakaguchi&Zeng, 2008) + +If TRUE, include biomass heat storage in canopy energy balance. + + Fraction of intercepted precipitation diff --git a/src/biogeophys/BareGroundFluxesMod.F90 b/src/biogeophys/BareGroundFluxesMod.F90 index cfbc99b740..248c7b6a2e 100644 --- a/src/biogeophys/BareGroundFluxesMod.F90 +++ b/src/biogeophys/BareGroundFluxesMod.F90 @@ -112,6 +112,8 @@ subroutine BareGroundFluxes(bounds, num_noexposedvegp, filter_noexposedvegp, & !------------------------------------------------------------------------------ associate( & + hs_canopy => energyflux_inst%hs_canopy_patch , & ! Output: [real(r8) (:) ] change in heat storage of stem (W/m**2) [+ to atm] + eflx_sh_stem => energyflux_inst%eflx_sh_stem_patch , & ! Output: [real(r8) (:) ] sensible heat flux from stems (W/m**2) [+ to atm] soilresis => soilstate_inst%soilresis_col , & ! Input: [real(r8) (:,:) ] evaporative soil resistance (s/m) snl => col%snl , & ! Input: [integer (:) ] number of snow layers dz => col%dz , & ! Input: [real(r8) (:,:) ] layer depth (m) @@ -202,11 +204,11 @@ subroutine BareGroundFluxes(bounds, num_noexposedvegp, filter_noexposedvegp, & forc_hgt_u_patch => frictionvel_inst%forc_hgt_u_patch , & ! Input: u10_clm => frictionvel_inst%u10_clm_patch , & ! Input: [real(r8) (:) ] 10 m height winds (m/s) zetamax => frictionvel_parms_inst%zetamaxstable , & ! Input: [real(r8) ] max zeta value under stable conditions - z0mg_col => frictionvel_inst%z0mg_col , & ! Output: [real(r8) (:) ] roughness length, momentum [m] - z0hg_col => frictionvel_inst%z0hg_col , & ! Output: [real(r8) (:) ] roughness length, sensible heat [m] - z0qg_col => frictionvel_inst%z0qg_col , & ! Output: [real(r8) (:) ] roughness length, latent heat [m] - ram1 => frictionvel_inst%ram1_patch , & ! Output: [real(r8) (:) ] aerodynamical resistance (s/m) - + z0mg_col => frictionvel_inst%z0mg_col , & ! Output: [real(r8) (:) ] roughness length, momentum [m] + z0hg_col => frictionvel_inst%z0hg_col , & ! Output: [real(r8) (:) ] roughness length, sensible heat [m] + z0qg_col => frictionvel_inst%z0qg_col , & ! Output: [real(r8) (:) ] roughness length, latent heat [m] + ram1 => frictionvel_inst%ram1_patch , & ! Output: [real(r8) (:) ] aerodynamical resistance (s/m) + num_iter => frictionvel_inst%num_iter_patch , & ! Output: [real(r8) (:) ] number of iterations htvp => energyflux_inst%htvp_col , & ! Input: [real(r8) (:) ] latent heat of evaporation (/sublimation) [J/kg] qflx_ev_snow => waterflux_inst%qflx_ev_snow_patch , & ! Output: [real(r8) (:) ] evaporation flux from snow (mm H2O/s) [+ to atm] qflx_ev_soil => waterflux_inst%qflx_ev_soil_patch , & ! Output: [real(r8) (:) ] evaporation flux from soil (mm H2O/s) [+ to atm] @@ -251,7 +253,9 @@ subroutine BareGroundFluxes(bounds, num_noexposedvegp, filter_noexposedvegp, & displa(p) = 0._r8 dlrad(p) = 0._r8 ulrad(p) = 0._r8 - + hs_canopy(p) = 0._r8 + eflx_sh_stem(p) = 0._r8 + ur(p) = max(1.0_r8,sqrt(forc_u(g)*forc_u(g)+forc_v(g)*forc_v(g))) dth(p) = thm(p)-t_grnd(c) dqh(p) = forc_q(c) - qg(c) @@ -268,6 +272,7 @@ subroutine BareGroundFluxes(bounds, num_noexposedvegp, filter_noexposedvegp, & call MoninObukIni(ur(p), thv(c), dthv, zldis(p), z0mg_patch(p), um(p), obu(p)) + num_iter(p) = 0 end do ! Perform stability iteration @@ -305,6 +310,8 @@ subroutine BareGroundFluxes(bounds, num_noexposedvegp, filter_noexposedvegp, & obu(p) = zldis(p)/zeta end do + num_iter(p) = iter + end do ! end stability iteration do f = 1, num_noexposedvegp diff --git a/src/biogeophys/CanopyFluxesMod.F90 b/src/biogeophys/CanopyFluxesMod.F90 index 872e077c3c..7cf2033546 100644 --- a/src/biogeophys/CanopyFluxesMod.F90 +++ b/src/biogeophys/CanopyFluxesMod.F90 @@ -50,6 +50,25 @@ module CanopyFluxesMod ! ! !PUBLIC TYPES: implicit none + ! + ! !PUBLIC VARIABLES: + + type :: canopyflux_params_type + real(r8), allocatable, public :: dbh (:) + real(r8), allocatable, public :: fbw (:) + real(r8), allocatable, public :: nstem (:) + real(r8), allocatable, public :: rstem (:) + real(r8), allocatable, public :: wood_density (:) + contains + procedure, private :: allocParams + end type canopyflux_params_type + ! + type(canopyflux_params_type), public, protected :: params_inst ! params_inst is populated in readParamsMod + + type, public :: canopyflux_type + contains + procedure, public :: ReadParams + end type canopyflux_type ! ! !PUBLIC MEMBER FUNCTIONS: public :: CanopyFluxesReadNML ! Read in namelist settings @@ -68,6 +87,7 @@ module CanopyFluxesMod logical, private :: snowveg_on = .false. ! snowveg_flag = 'ON' logical, private :: snowveg_onrad = .true. ! snowveg_flag = 'ON_RAD' logical, private :: use_undercanopy_stability = .true. ! use undercanopy stability term or not + logical, private :: use_biomass_heat_storage = .false. ! include biomass heat storage character(len=*), parameter, private :: sourcefile = & __FILE__ @@ -75,6 +95,76 @@ module CanopyFluxesMod contains + !----------------------------------------------------------------------- + subroutine allocParams ( this ) + ! + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + implicit none + + ! !ARGUMENTS: + class(canopyflux_params_type) :: this + ! + ! !LOCAL VARIABLES: + character(len=32) :: subname = 'allocParams' + !----------------------------------------------------------------------- + + ! allocate parameters + + allocate( this%dbh (0:mxpft) ) ; this%dbh(:) = nan + allocate( this%fbw (0:mxpft) ) ; this%fbw(:) = nan + allocate( this%nstem (0:mxpft) ) ; this%nstem(:) = nan + allocate( this%rstem (0:mxpft) ) ; this%rstem(:) = nan + allocate( this%wood_density(0:mxpft) ) ; this%wood_density(:) = nan + + end subroutine allocParams + + !----------------------------------------------------------------------- + subroutine readParams ( this, ncid ) + ! + ! !USES: + use ncdio_pio , only : file_desc_t,ncd_io + implicit none + + ! !ARGUMENTS: + class(canopyflux_type) :: this + type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id + ! + ! !LOCAL VARIABLES: + character(len=32) :: subname = 'readParams' + character(len=100) :: errCode = '-Error reading in parameters file:' + logical :: readv ! has variable been read in or not + real(r8) :: temp1d(0:mxpft) ! temporary to read in parameter + character(len=100) :: tString ! temp. var for reading + !----------------------------------------------------------------------- + + ! read in parameters + + + call params_inst%allocParams() + + tString = "dbh" + call ncd_io(varname=trim(tString),data=temp1d, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%dbh=temp1d + tString = "fbw" + call ncd_io(varname=trim(tString),data=temp1d, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%fbw=temp1d + tString = "nstem" + call ncd_io(varname=trim(tString),data=temp1d, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%nstem=temp1d + tString = "rstem" + call ncd_io(varname=trim(tString),data=temp1d, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%rstem=temp1d + tString = "wood_density" + call ncd_io(varname=trim(tString),data=temp1d, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + params_inst%wood_density=temp1d + + end subroutine readParams + !------------------------------------------------------------------------ subroutine CanopyFluxesReadNML(NLFilename) ! @@ -99,7 +189,7 @@ subroutine CanopyFluxesReadNML(NLFilename) character(len=*), parameter :: nmlname = 'canopyfluxes_inparm' !----------------------------------------------------------------------- - namelist /canopyfluxes_inparm/ use_undercanopy_stability + namelist /canopyfluxes_inparm/ use_undercanopy_stability,use_biomass_heat_storage ! Initialize options to default values, in case they are not specified in ! the namelist @@ -121,6 +211,7 @@ subroutine CanopyFluxesReadNML(NLFilename) end if call shr_mpi_bcast (use_undercanopy_stability, mpicom) + call shr_mpi_bcast (use_biomass_heat_storage, mpicom) if (masterproc) then write(iulog,*) ' ' @@ -353,20 +444,19 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, real(r8) :: cp_veg(bounds%begp:bounds%endp) !heat capacity of veg real(r8) :: cp_stem(bounds%begp:bounds%endp) !heat capacity of stems - real(r8) :: dt_stem(bounds%begp:bounds%endp) + real(r8) :: dt_stem(bounds%begp:bounds%endp) !change in stem temperature real(r8) :: fstem(bounds%begp:bounds%endp) !fraction of stem - real(r8) :: bhd(0:mxpft) !stem breast-height-diameter - real(r8) :: wood_density, carea_stem real(r8) :: lw_stem(bounds%begp:bounds%endp) !internal longwave stem real(r8) :: lw_leaf(bounds%begp:bounds%endp) !internal longwave leaf real(r8) :: sa_stem(bounds%begp:bounds%endp) !surface area stem m2/m2_ground real(r8) :: sa_leaf(bounds%begp:bounds%endp) !surface area leaf m2/m2_ground real(r8) :: sa_internal(bounds%begp:bounds%endp) !min(sa_stem,sa_leaf) real(r8) :: uuc(bounds%begp:bounds%endp) ! undercanopy windspeed + real(r8) :: cp_wood + real(r8) :: carea_stem + real(r8) :: rstema ! biomass parameters real(r8), parameter :: c_to_b = 2.0_r8 !(g biomass /g C) - real(r8), parameter :: ntree = 0.4_r8 !(number of trees / m2) - real(r8), parameter :: rstem = 100._r8 !stem resistance (s/m) real(r8), parameter :: k_vert = 0.1 !vertical distribution of stem real(r8), parameter :: k_cyl_vol = 1.0 !departure from cylindrical volume @@ -541,6 +631,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, obu => frictionvel_inst%obu_patch , & ! Output: [real(r8) (:) ] Monin-Obukhov length [m] zeta => frictionvel_inst%zeta_patch , & ! Output: [real(r8) (:) ] dimensionless stability parameter vpd => frictionvel_inst%vpd_patch , & ! Output: [real(r8) (:) ] vapor pressure deficit [Pa] + num_iter => frictionvel_inst%num_iter_patch , & ! Output: [real(r8) (:) ] number of iterations begp => bounds%begp , & endp => bounds%endp , & @@ -621,11 +712,9 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, btran(p) = btran0 btran2(p) = btran0 hs_canopy(p) = 0._r8 + eflx_sh_stem(p) = 0._r8 end do -! set bhd (should be done on parameter file) - bhd(1:16) = (/0.15,0.15,0.15,0.2,0.2,0.2,0.2,0.1,0.02,0.02,0.02,0.004,0.004,0.004,0.004,0.004/) - ! calculate biomass heat capacities do f = 1, fn p = filterp(f) @@ -633,34 +722,46 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ! fraction of stem receiving incoming radiation fstem(p) = (esai(p))/(elai(p)+esai(p)) fstem(p) = k_vert * fstem(p) + if(.not.use_biomass_heat_storage) then + fstem(p) = 0._r8 + endif + ! leaf and stem surface area sa_leaf(p) = elai(p) ! double in spirit of full surface area for sensible heat sa_leaf(p) = 2.*sa_leaf(p) - sa_stem(p) = ntree*(htop(p)*shr_const_pi*bhd(patch%itype(p))) + + sa_stem(p) = params_inst%nstem(patch%itype(p))*(htop(p)*shr_const_pi*params_inst%dbh(patch%itype(p))) ! adjust for departure of cylindrical stem model sa_stem(p) = k_cyl_area * sa_stem(p) + if(.not.use_biomass_heat_storage) then + sa_stem(p) = 0._r8 + endif +! do not calculate separate leaf/stem heat capacity for grasses + if(patch%itype(p) > 11) then + fstem(p) = 0.0 + sa_stem(p) = 0.0 + endif + ! internal longwave fluxes between leaf and stem ! surface area term must be equal, remainder cancels ! (use same area of interaction i.e. ignore leaf <-> leaf) sa_internal(p) = min(sa_leaf(p),sa_stem(p)) sa_internal(p) = k_internal * sa_internal(p) -!scs: specify heat capacity of vegetation +! calculate specify heat capacity of vegetation !(lma * c2b = lma_dry, lma * c2b * (fw/(1-fw)) = lma_wet, sum these) ! lma_dry has units of kg dry mass /m2 here (table 2 of bonan 2017) ! cdry_biomass = 1400 J/kg/K, cwater = 4188 J/kg/K ! boreal needleleaf lma*c2b ~ 0.25 kg dry mass/m2(leaf) - cp_veg(p) = (0.25_r8 * elai(p)) * (1400._r8 + (0.7/(1.-0.7))*4188._r8) + cp_veg(p) = (0.25_r8 * max(0.01_r8,elai(p))) * (1400._r8 + (params_inst%fbw(patch%itype(p))/(1.-params_inst%fbw(patch%itype(p))))*4188._r8) -! wood density could vary by pft... - wood_density = 5.e2_r8 ! kg/m3 lindroth2010 uses ~4.e2 - carea_stem = shr_const_pi * (bhd(patch%itype(p))*0.5)**2 + carea_stem = shr_const_pi * (params_inst%dbh(patch%itype(p))*0.5)**2 ! cp-stem will have units J/k/ground_area (here assuming 1 stem/m2) - cp_stem(p) = (1400._r8 + (0.7/(1.-0.7))*4188._r8) + cp_stem(p) = (1400._r8 + (params_inst%fbw(patch%itype(p))/(1.-params_inst%fbw(patch%itype(p))))*4188._r8) ! use weight of dry wood - cp_stem(p) = cp_stem(p) * ntree * wood_density * htop(p) * carea_stem + cp_stem(p) = params_inst%nstem(patch%itype(p))* cp_stem(p) * params_inst%wood_density(patch%itype(p)) * htop(p) * carea_stem ! adjust for departure from cylindrical stem model cp_stem(p) = k_cyl_vol * cp_stem(p) enddo @@ -819,6 +920,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, call MoninObukIni(ur(p), thv(c), dthv(p), zldis(p), z0mv(p), um(p), obu(p)) + num_iter(p) = 0 end do ! Set counter for leaf temperature iteration (itlef) @@ -994,7 +1096,8 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, wtg(p) = 1._r8/rah(p,2) ! ground ! wtstem = sa_stem(p)/rb(p) ! stem ! add resistance between internal stem temperature and canopy air - wtstem = sa_stem(p)/(rstem + rb(p)) ! stem + rstema = params_inst%rstem(patch%itype(p))*params_inst%dbh(patch%itype(p)) + wtstem = sa_stem(p)/(rstema + rb(p)) ! stem wtshi = 1._r8/(wta+wtl+wtstem+wtg(p)) @@ -1179,7 +1282,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ! The energy loss due to above two limits is added to ! the sensible heat flux. - eflx_sh_veg(p) = efsh + dc1*wtga(p)*dt_veg(p) + err(p) + erre + hvap*ecidif + eflx_sh_veg(p) = efsh + dc1*wtga(p)*dt_veg(p) + err(p) + erre + hvap*ecidif ! Update SH and lw_leaf for changes in t_veg eflx_sh_stem(p) = eflx_sh_stem(p) + forc_rho(c)*cpair*wtstem*(-wtl0(p)*dt_veg(p)) @@ -1211,7 +1314,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, zeta(p) = zldis(p)*vkc*grav*thvstar/(ustar(p)**2*thv(c)) if (zeta(p) >= 0._r8) then !stable - zeta(p) = min(zetamax,max(zeta(p),0.01_r8)) + zeta(p) = min(100._r8,max(zeta(p),0.01_r8)) um(p) = max(ur(p),0.1_r8) else !unstable zeta(p) = max(-100._r8,min(zeta(p),-0.01_r8)) @@ -1229,6 +1332,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ! Test for convergence itlef = itlef+1 + num_iter(p) = itlef if (itlef > itmin) then do f = 1, fn p = filterp(f) @@ -1246,7 +1350,6 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, end if end do end if - end do ITERATION ! End stability iteration call t_stopf('can_iter') diff --git a/src/biogeophys/FrictionVelocityMod.F90 b/src/biogeophys/FrictionVelocityMod.F90 index 0b32c39c0a..0111962a48 100644 --- a/src/biogeophys/FrictionVelocityMod.F90 +++ b/src/biogeophys/FrictionVelocityMod.F90 @@ -65,7 +65,7 @@ module FrictionVelocityMod real(r8), pointer, public :: obu_patch (:) ! patch Monin-Obukhov length [m] real(r8), pointer, public :: zeta_patch (:) ! patch dimensionless stability parameter real(r8), pointer, public :: vpd_patch (:) ! patch vapor pressure deficit [Pa] - + real(r8), pointer, public :: num_iter_patch (:) ! patch number of iterations contains @@ -155,6 +155,7 @@ subroutine InitAllocate(this, bounds) allocate(this%obu_patch (begp:endp)) ; this%obu_patch (:) = nan allocate(this%zeta_patch (begp:endp)) ; this%zeta_patch (:) = nan allocate(this%vpd_patch (begp:endp)) ; this%vpd_patch (:) = nan + allocate(this%num_iter_patch (begp:endp)) ; this%num_iter_patch (:) = nan end subroutine InitAllocate @@ -274,6 +275,10 @@ subroutine InitHistory(this, bounds) call hist_addfld1d (fname='VPD', units='Pa', & avgflag='A', long_name='vpd', & ptr_patch=this%vpd_patch, default='inactive') + this%num_iter_patch(begp:endp) = spval + call hist_addfld1d (fname='num_iter', units='unitless', & + avgflag='A', long_name='number of iterations', & + ptr_patch=this%num_iter_patch, default='inactive') this%rb1_patch(begp:endp) = spval call hist_addfld1d (fname='RB', units='s/m', & avgflag='A', long_name='leaf boundary resistance', & diff --git a/src/biogeophys/SoilFluxesMod.F90 b/src/biogeophys/SoilFluxesMod.F90 index 7ce0d57e9b..c52958d007 100644 --- a/src/biogeophys/SoilFluxesMod.F90 +++ b/src/biogeophys/SoilFluxesMod.F90 @@ -303,7 +303,8 @@ subroutine SoilFluxes (bounds, num_urbanl, filter_urbanl, & ! Total fluxes (vegetation + ground) - eflx_sh_tot(p) = eflx_sh_veg(p) + eflx_sh_stem(p) + eflx_sh_grnd(p) + eflx_sh_tot(p) = eflx_sh_veg(p) + eflx_sh_grnd(p) + if (.not. lun%urbpoi(l)) eflx_sh_tot(p) = eflx_sh_tot(p) + eflx_sh_stem(p) qflx_evap_tot(p) = qflx_evap_veg(p) + qflx_evap_soi(p) eflx_lh_tot(p)= hvap*qflx_evap_veg(p) + htvp(c)*qflx_evap_soi(p) if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then diff --git a/src/main/clm_initializeMod.F90 b/src/main/clm_initializeMod.F90 index 393e2d0cdd..4cab3a56d3 100644 --- a/src/main/clm_initializeMod.F90 +++ b/src/main/clm_initializeMod.F90 @@ -341,7 +341,7 @@ subroutine initialize2( ) allocate(nutrient_competition_method, & source=create_nutrient_competition_method(bounds_proc)) - call readParameters(nutrient_competition_method, photosyns_inst) + call readParameters(nutrient_competition_method, photosyns_inst, canopyflux_inst) ! ------------------------------------------------------------------------ ! Initialize time manager diff --git a/src/main/clm_instMod.F90 b/src/main/clm_instMod.F90 index 1b1b44adba..b33026326f 100644 --- a/src/main/clm_instMod.F90 +++ b/src/main/clm_instMod.F90 @@ -49,6 +49,7 @@ module clm_instMod use OzoneBaseMod , only : ozone_base_type use OzoneFactoryMod , only : create_and_init_ozone_type use PhotosynthesisMod , only : photosyns_type + use CanopyFluxesMod , only : canopyflux_type use SoilHydrologyType , only : soilhydrology_type use SoilStateType , only : soilstate_type use SolarAbsorbedType , only : solarabs_type @@ -99,6 +100,7 @@ module clm_instMod type(lakestate_type) :: lakestate_inst class(ozone_base_type), allocatable :: ozone_inst type(photosyns_type) :: photosyns_inst + type(canopyflux_type) :: canopyflux_inst type(soilstate_type) :: soilstate_inst type(soilhydrology_type) :: soilhydrology_inst type(solarabs_type) :: solarabs_inst diff --git a/src/main/pftconMod.F90 b/src/main/pftconMod.F90 index 0efa2053eb..53fb8d0d0c 100644 --- a/src/main/pftconMod.F90 +++ b/src/main/pftconMod.F90 @@ -145,6 +145,12 @@ module pftconMod real(r8), allocatable :: root_radius (:) ! root radius (m) real(r8), allocatable :: root_density (:) ! root density (gC/m3) + real(r8), allocatable :: dbh (:) ! diameter at breast height (m) + real(r8), allocatable :: fbw (:) ! fraction of biomass that is water + real(r8), allocatable :: nstem (:) ! stem density (#/m2) + real(r8), allocatable :: rstem (:) ! stem resistance (s/m) + real(r8), allocatable :: wood_density (:) ! wood density (kg/m3) + ! crop ! These arrays give information about the merge of unused crop types to the types CLM @@ -460,6 +466,11 @@ subroutine InitAllocate (this) allocate( this%fun_cn_flex_c (0:mxpft) ) allocate( this%FUN_fracfixers(0:mxpft) ) + allocate( this%dbh (0:mxpft) ) + allocate( this%fbw (0:mxpft) ) + allocate( this%nstem (0:mxpft) ) + allocate( this%rstem (0:mxpft) ) + allocate( this%wood_density (0:mxpft) ) end subroutine InitAllocate @@ -1375,6 +1386,11 @@ subroutine Clean(this) deallocate( this%fun_cn_flex_c) deallocate( this%FUN_fracfixers) + deallocate( this%dbh) + deallocate( this%fbw) + deallocate( this%nstem) + deallocate( this%rstem) + deallocate( this%wood_density) end subroutine Clean end module pftconMod diff --git a/src/main/readParamsMod.F90 b/src/main/readParamsMod.F90 index 7fbea89531..f1c7a4aa43 100644 --- a/src/main/readParamsMod.F90 +++ b/src/main/readParamsMod.F90 @@ -23,7 +23,7 @@ module readParamsMod contains !----------------------------------------------------------------------- - subroutine readParameters (nutrient_competition_method, photosyns_inst) + subroutine readParameters (nutrient_competition_method, photosyns_inst, canopyflux_inst) ! ! ! USES: use CNSharedParamsMod , only : CNParamsReadShared @@ -43,9 +43,11 @@ subroutine readParameters (nutrient_competition_method, photosyns_inst) use NutrientCompetitionMethodMod , only : nutrient_competition_method_type use clm_varctl, only : NLFilename_in use PhotosynthesisMod , only : photosyns_type + use CanopyFluxesMod , only : canopyflux_type ! ! !ARGUMENTS: type(photosyns_type) , intent(in) :: photosyns_inst + type(canopyflux_type) , intent(in) :: canopyflux_inst class(nutrient_competition_method_type), intent(in) :: nutrient_competition_method ! ! !LOCAL VARIABLES: @@ -97,6 +99,7 @@ subroutine readParameters (nutrient_competition_method, photosyns_inst) ! Biogeophysics ! call photosyns_inst%ReadParams( ncid ) + call canopyflux_inst%ReadParams( ncid ) ! From a5023fbca4afb43a2b35077c887713d37db22833 Mon Sep 17 00:00:00 2001 From: Sean Swenson Date: Thu, 2 Aug 2018 11:59:02 -0600 Subject: [PATCH 11/76] corrections for elai = 0 conditions --- src/biogeophys/CanopyFluxesMod.F90 | 35 ++++++++++++++++++---------- src/biogeophys/PhotosynthesisMod.F90 | 2 +- 2 files changed, 24 insertions(+), 13 deletions(-) diff --git a/src/biogeophys/CanopyFluxesMod.F90 b/src/biogeophys/CanopyFluxesMod.F90 index 7cf2033546..5044005279 100644 --- a/src/biogeophys/CanopyFluxesMod.F90 +++ b/src/biogeophys/CanopyFluxesMod.F90 @@ -721,10 +721,8 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ! fraction of stem receiving incoming radiation fstem(p) = (esai(p))/(elai(p)+esai(p)) - fstem(p) = k_vert * fstem(p) - if(.not.use_biomass_heat_storage) then - fstem(p) = 0._r8 - endif + ! when elai = 0, do not multiply by k_vert (i.e. fstem = 1) + if(elai(p) > 0._r8) fstem(p) = k_vert * fstem(p) ! leaf and stem surface area sa_leaf(p) = elai(p) @@ -734,16 +732,20 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, sa_stem(p) = params_inst%nstem(patch%itype(p))*(htop(p)*shr_const_pi*params_inst%dbh(patch%itype(p))) ! adjust for departure of cylindrical stem model sa_stem(p) = k_cyl_area * sa_stem(p) - if(.not.use_biomass_heat_storage) then - sa_stem(p) = 0._r8 - endif + ! do not calculate separate leaf/stem heat capacity for grasses if(patch%itype(p) > 11) then fstem(p) = 0.0 sa_stem(p) = 0.0 endif -! internal longwave fluxes between leaf and stem + if(.not.use_biomass_heat_storage) then + fstem(p) = 0._r8 + sa_stem(p) = 0._r8 + sa_leaf(p) = (elai(p)+esai(p)) + endif + + ! internal longwave fluxes between leaf and stem ! surface area term must be equal, remainder cancels ! (use same area of interaction i.e. ignore leaf <-> leaf) sa_internal(p) = min(sa_leaf(p),sa_stem(p)) @@ -756,6 +758,11 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ! boreal needleleaf lma*c2b ~ 0.25 kg dry mass/m2(leaf) cp_veg(p) = (0.25_r8 * max(0.01_r8,elai(p))) * (1400._r8 + (params_inst%fbw(patch%itype(p))/(1.-params_inst%fbw(patch%itype(p))))*4188._r8) +! use non-zero, but small, heat capacity + if(.not.use_biomass_heat_storage) then + cp_veg(p) = 1.e-3_r8 + endif + carea_stem = shr_const_pi * (params_inst%dbh(patch%itype(p))*0.5)**2 ! cp-stem will have units J/k/ground_area (here assuming 1 stem/m2) @@ -1128,7 +1135,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, end if ! should be the same expression used in Photosynthesis/getqflx - efpot = forc_rho(c)*(elai(p)+esai(p))/rb(p)*(qsatl(p)-qaf(p)) + efpot = forc_rho(c)*(elai(p))/rb(p)*(qsatl(p)-qaf(p)) ! When the hydraulic stress parameterization is active calculate rpp ! but not transpiration @@ -1169,7 +1176,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ! Moved the original subroutine in-line... wtaq = frac_veg_nosno(p)/raw(p,1) ! air - wtlq = frac_veg_nosno(p)*(elai(p)+esai(p))/rb(p) * rpp ! leaf + wtlq = frac_veg_nosno(p)*(elai(p))/rb(p) * rpp ! leaf !Litter layer resistance. Added by K.Sakaguchi snow_depth_c = z_dl ! critical depth for 100% litter burial by snow (=litter thickness) @@ -1248,7 +1255,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ! result in an imbalance in "hvap*qflx_evap_veg" and ! "efe + dc2*wtgaq*qsatdt_veg" - efpot = forc_rho(c)*(elai(p)+esai(p))/rb(p) & + efpot = forc_rho(c)*(elai(p))/rb(p) & *(wtgaq*(qsatl(p)+qsatldT(p)*dt_veg(p)) & -wtgq0*qg(c)-wtaq0(p)*forc_q(c)) qflx_evap_veg(p) = rpp*efpot @@ -1314,7 +1321,11 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, zeta(p) = zldis(p)*vkc*grav*thvstar/(ustar(p)**2*thv(c)) if (zeta(p) >= 0._r8) then !stable - zeta(p) = min(100._r8,max(zeta(p),0.01_r8)) + if(use_biomass_heat_storage) then + zeta(p) = min(100._r8,max(zeta(p),0.01_r8)) + else + zeta(p) = min(zetamax,max(zeta(p),0.01_r8)) + endif um(p) = max(ur(p),0.1_r8) else !unstable zeta(p) = max(-100._r8,min(zeta(p),-0.01_r8)) diff --git a/src/biogeophys/PhotosynthesisMod.F90 b/src/biogeophys/PhotosynthesisMod.F90 index 8b6e708606..f3def19dd8 100644 --- a/src/biogeophys/PhotosynthesisMod.F90 +++ b/src/biogeophys/PhotosynthesisMod.F90 @@ -4754,7 +4754,7 @@ subroutine getqflx(p,c,gb_mol,gs_mol_sun,gs_mol_sha,qflx_sun,qflx_sha,qsatl,qaf, cf = forc_pbot(c)/(rgas*1.e-3_r8*tgcm(p))*1.e6_r8 ! gb->gbmol conversion factor - wtl = (elai(p)+esai(p))*gb_mol + wtl = (elai(p))*gb_mol efpot = forc_rho(c)*wtl*(qsatl-qaf) if (havegs) then From 457378e4c043adaf3508892be513c3bed3c24936 Mon Sep 17 00:00:00 2001 From: Sean Swenson Date: Thu, 30 Aug 2018 09:06:19 -0600 Subject: [PATCH 12/76] add num_iter --- src/biogeophys/BareGroundFluxesMod.F90 | 5 ++++- src/biogeophys/CanopyFluxesMod.F90 | 28 +++++++++++++++++--------- src/biogeophys/FrictionVelocityMod.F90 | 7 ++++++- src/biogeophys/SoilFluxesMod.F90 | 1 - 4 files changed, 29 insertions(+), 12 deletions(-) diff --git a/src/biogeophys/BareGroundFluxesMod.F90 b/src/biogeophys/BareGroundFluxesMod.F90 index ee51f495f5..779b4df565 100644 --- a/src/biogeophys/BareGroundFluxesMod.F90 +++ b/src/biogeophys/BareGroundFluxesMod.F90 @@ -210,6 +210,7 @@ subroutine BareGroundFluxes(bounds, num_noexposedvegp, filter_noexposedvegp, & z0hg_col => frictionvel_inst%z0hg_col , & ! Output: [real(r8) (:) ] roughness length, sensible heat [m] z0qg_col => frictionvel_inst%z0qg_col , & ! Output: [real(r8) (:) ] roughness length, latent heat [m] ram1 => frictionvel_inst%ram1_patch , & ! Output: [real(r8) (:) ] aerodynamical resistance (s/m) + num_iter => frictionvel_inst%num_iter_patch , & ! Output: [real(r8) (:) ] number of iterations htvp => energyflux_inst%htvp_col , & ! Input: [real(r8) (:) ] latent heat of evaporation (/sublimation) [J/kg] qflx_ev_snow => waterfluxbulk_inst%qflx_ev_snow_patch , & ! Output: [real(r8) (:) ] evaporation flux from snow (mm H2O/s) [+ to atm] @@ -273,7 +274,7 @@ subroutine BareGroundFluxes(bounds, num_noexposedvegp, filter_noexposedvegp, & ! Initialize Monin-Obukhov length and wind speed call MoninObukIni(ur(p), thv(c), dthv, zldis(p), z0mg_patch(p), um(p), obu(p)) - + num_iter(p) = 0 end do ! Perform stability iteration @@ -311,6 +312,8 @@ subroutine BareGroundFluxes(bounds, num_noexposedvegp, filter_noexposedvegp, & obu(p) = zldis(p)/zeta end do + num_iter(p) = iter + end do ! end stability iteration do f = 1, num_noexposedvegp diff --git a/src/biogeophys/CanopyFluxesMod.F90 b/src/biogeophys/CanopyFluxesMod.F90 index fcc87db2b7..4540b4b2ef 100644 --- a/src/biogeophys/CanopyFluxesMod.F90 +++ b/src/biogeophys/CanopyFluxesMod.F90 @@ -633,6 +633,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, obu => frictionvel_inst%obu_patch , & ! Output: [real(r8) (:) ] Monin-Obukhov length [m] zeta => frictionvel_inst%zeta_patch , & ! Output: [real(r8) (:) ] dimensionless stability parameter vpd => frictionvel_inst%vpd_patch , & ! Output: [real(r8) (:) ] vapor pressure deficit [Pa] + num_iter => frictionvel_inst%num_iter_patch , & ! Output: [real(r8) (:) ] number of iterations begp => bounds%begp , & endp => bounds%endp , & @@ -722,10 +723,8 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ! fraction of stem receiving incoming radiation fstem(p) = (esai(p))/(elai(p)+esai(p)) - fstem(p) = k_vert * fstem(p) - if(.not.use_biomass_heat_storage) then - fstem(p) = 0._r8 - endif + ! when elai = 0, do not multiply by k_vert (i.e. fstem = 1) + if(elai(p) > 0._r8) fstem(p) = k_vert * fstem(p) ! leaf and stem surface area sa_leaf(p) = elai(p) @@ -735,16 +734,20 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, sa_stem(p) = params_inst%nstem(patch%itype(p))*(htop(p)*shr_const_pi*params_inst%dbh(patch%itype(p))) ! adjust for departure of cylindrical stem model sa_stem(p) = k_cyl_area * sa_stem(p) - if(.not.use_biomass_heat_storage) then - sa_stem(p) = 0._r8 - endif -! do not calculate separate leaf/stem heat capacity for grasses + + ! do not calculate separate leaf/stem heat capacity for grasses if(patch%itype(p) > 11) then fstem(p) = 0.0 sa_stem(p) = 0.0 endif -! internal longwave fluxes between leaf and stem + if(.not.use_biomass_heat_storage) then + fstem(p) = 0._r8 + sa_stem(p) = 0._r8 + sa_leaf(p) = (elai(p)+esai(p)) + endif + + ! internal longwave fluxes between leaf and stem ! surface area term must be equal, remainder cancels ! (use same area of interaction i.e. ignore leaf <-> leaf) sa_internal(p) = min(sa_leaf(p),sa_stem(p)) @@ -757,6 +760,11 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ! boreal needleleaf lma*c2b ~ 0.25 kg dry mass/m2(leaf) cp_veg(p) = (0.25_r8 * max(0.01_r8,elai(p))) * (1400._r8 + (params_inst%fbw(patch%itype(p))/(1.-params_inst%fbw(patch%itype(p))))*4188._r8) +! use non-zero, but small, heat capacity + if(.not.use_biomass_heat_storage) then + cp_veg(p) = 1.e-3_r8 + endif + carea_stem = shr_const_pi * (params_inst%dbh(patch%itype(p))*0.5)**2 ! cp-stem will have units J/k/ground_area (here assuming 1 stem/m2) @@ -921,6 +929,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ! Initialize Monin-Obukhov length and wind speed call MoninObukIni(ur(p), thv(c), dthv(p), zldis(p), z0mv(p), um(p), obu(p)) + num_iter(p) = 0 end do @@ -1339,6 +1348,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ! Test for convergence itlef = itlef+1 + num_iter(p) = itlef if (itlef > itmin) then do f = 1, fn p = filterp(f) diff --git a/src/biogeophys/FrictionVelocityMod.F90 b/src/biogeophys/FrictionVelocityMod.F90 index 0b32c39c0a..0111962a48 100644 --- a/src/biogeophys/FrictionVelocityMod.F90 +++ b/src/biogeophys/FrictionVelocityMod.F90 @@ -65,7 +65,7 @@ module FrictionVelocityMod real(r8), pointer, public :: obu_patch (:) ! patch Monin-Obukhov length [m] real(r8), pointer, public :: zeta_patch (:) ! patch dimensionless stability parameter real(r8), pointer, public :: vpd_patch (:) ! patch vapor pressure deficit [Pa] - + real(r8), pointer, public :: num_iter_patch (:) ! patch number of iterations contains @@ -155,6 +155,7 @@ subroutine InitAllocate(this, bounds) allocate(this%obu_patch (begp:endp)) ; this%obu_patch (:) = nan allocate(this%zeta_patch (begp:endp)) ; this%zeta_patch (:) = nan allocate(this%vpd_patch (begp:endp)) ; this%vpd_patch (:) = nan + allocate(this%num_iter_patch (begp:endp)) ; this%num_iter_patch (:) = nan end subroutine InitAllocate @@ -274,6 +275,10 @@ subroutine InitHistory(this, bounds) call hist_addfld1d (fname='VPD', units='Pa', & avgflag='A', long_name='vpd', & ptr_patch=this%vpd_patch, default='inactive') + this%num_iter_patch(begp:endp) = spval + call hist_addfld1d (fname='num_iter', units='unitless', & + avgflag='A', long_name='number of iterations', & + ptr_patch=this%num_iter_patch, default='inactive') this%rb1_patch(begp:endp) = spval call hist_addfld1d (fname='RB', units='s/m', & avgflag='A', long_name='leaf boundary resistance', & diff --git a/src/biogeophys/SoilFluxesMod.F90 b/src/biogeophys/SoilFluxesMod.F90 index 71a792f5f0..2c1a328d3e 100644 --- a/src/biogeophys/SoilFluxesMod.F90 +++ b/src/biogeophys/SoilFluxesMod.F90 @@ -311,7 +311,6 @@ subroutine SoilFluxes (bounds, num_urbanl, filter_urbanl, & ! Total fluxes (vegetation + ground) -! eflx_sh_tot(p) = eflx_sh_veg(p) + eflx_sh_stem(p) + eflx_sh_grnd(p) eflx_sh_tot(p) = eflx_sh_veg(p) + eflx_sh_grnd(p) if (.not. lun%urbpoi(l)) eflx_sh_tot(p) = eflx_sh_tot(p) + eflx_sh_stem(p) qflx_evap_tot(p) = qflx_evap_veg(p) + qflx_evap_soi(p) From e43883be96310b580cf055b47712ac887c0dbfdb Mon Sep 17 00:00:00 2001 From: Sean Swenson Date: Thu, 30 Aug 2018 09:08:54 -0600 Subject: [PATCH 13/76] add namelist broadcast --- src/biogeophys/BareGroundFluxesMod.F90 | 1 - src/biogeophys/CanopyFluxesMod.F90 | 6 +++--- src/biogeophys/PhotosynthesisMod.F90 | 2 +- src/biogeophys/TemperatureType.F90 | 5 +++++ src/main/clm_varctl.F90 | 6 ++++++ src/main/controlMod.F90 | 4 ++++ 6 files changed, 19 insertions(+), 5 deletions(-) diff --git a/src/biogeophys/BareGroundFluxesMod.F90 b/src/biogeophys/BareGroundFluxesMod.F90 index 6db74bea1c..f2c6f25285 100644 --- a/src/biogeophys/BareGroundFluxesMod.F90 +++ b/src/biogeophys/BareGroundFluxesMod.F90 @@ -273,7 +273,6 @@ subroutine BareGroundFluxes(bounds, num_noexposedvegp, filter_noexposedvegp, & ! Initialize Monin-Obukhov length and wind speed call MoninObukIni(ur(p), thv(c), dthv, zldis(p), z0mg_patch(p), um(p), obu(p)) - num_iter(p) = 0 end do diff --git a/src/biogeophys/CanopyFluxesMod.F90 b/src/biogeophys/CanopyFluxesMod.F90 index ed3807e848..c35fea896d 100644 --- a/src/biogeophys/CanopyFluxesMod.F90 +++ b/src/biogeophys/CanopyFluxesMod.F90 @@ -930,7 +930,6 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ! Initialize Monin-Obukhov length and wind speed call MoninObukIni(ur(p), thv(c), dthv(p), zldis(p), z0mv(p), um(p), obu(p)) - num_iter(p) = 0 end do @@ -1140,7 +1139,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, end if ! should be the same expression used in Photosynthesis/getqflx - efpot = forc_rho(c)*(elai(p))/rb(p)*(qsatl(p)-qaf(p)) + efpot = forc_rho(c)*elai(p)/rb(p)*(qsatl(p)-qaf(p)) ! When the hydraulic stress parameterization is active calculate rpp ! but not transpiration @@ -1260,7 +1259,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ! result in an imbalance in "hvap*qflx_evap_veg" and ! "efe + dc2*wtgaq*qsatdt_veg" - efpot = forc_rho(c)*(elai(p))/rb(p) & + efpot = forc_rho(c)*elai(p)/rb(p) & *(wtgaq*(qsatl(p)+qsatldT(p)*dt_veg(p)) & -wtgq0*qg(c)-wtaq0(p)*forc_q(c)) qflx_evap_veg(p) = rpp*efpot @@ -1326,6 +1325,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, zeta(p) = zldis(p)*vkc*grav*thvstar/(ustar(p)**2*thv(c)) if (zeta(p) >= 0._r8) then !stable + ! remove stability cap when biomass heat storage is active if(use_biomass_heat_storage) then zeta(p) = min(100._r8,max(zeta(p),0.01_r8)) else diff --git a/src/biogeophys/PhotosynthesisMod.F90 b/src/biogeophys/PhotosynthesisMod.F90 index 71f6961a60..1b72acfc30 100644 --- a/src/biogeophys/PhotosynthesisMod.F90 +++ b/src/biogeophys/PhotosynthesisMod.F90 @@ -4835,7 +4835,7 @@ subroutine getqflx(p,c,gb_mol,gs_mol_sun,gs_mol_sha,qflx_sun,qflx_sha,qsatl,qaf, cf = forc_pbot(c)/(rgas*1.e-3_r8*tgcm(p))*1.e6_r8 ! gb->gbmol conversion factor - wtl = (elai(p))*gb_mol + wtl = elai(p)*gb_mol efpot = forc_rho(c)*wtl*(qsatl-qaf) if (havegs) then diff --git a/src/biogeophys/TemperatureType.F90 b/src/biogeophys/TemperatureType.F90 index 6e1b90a93d..dba102412f 100644 --- a/src/biogeophys/TemperatureType.F90 +++ b/src/biogeophys/TemperatureType.F90 @@ -887,6 +887,11 @@ subroutine Restart(this, bounds, ncid, flag, is_simple_buildtemp, is_prog_buildt long_name='vegetation temperature', units='K', & interpinic_flag='interp', readvar=readvar, data=this%t_veg_patch) + call restartvar(ncid=ncid, flag=flag, varname='T_STEM', xtype=ncd_double, & + dim1name='pft', & + long_name='stem temperature', units='K', & + interpinic_flag='interp', readvar=readvar, data=this%t_stem_patch) + call restartvar(ncid=ncid, flag=flag, varname='TH2OSFC', xtype=ncd_double, & dim1name='column', & long_name='surface water temperature', units='K', & diff --git a/src/main/clm_varctl.F90 b/src/main/clm_varctl.F90 index 938155c5dd..20de195db7 100644 --- a/src/main/clm_varctl.F90 +++ b/src/main/clm_varctl.F90 @@ -237,6 +237,12 @@ module clm_varctl logical, public :: use_lai_streams = .false. ! true => use lai streams in SatellitePhenologyMod.F90 + !---------------------------------------------------------- + ! biomass heat storage switch + !---------------------------------------------------------- + + logical, public :: use_biomass_heat_storage = .false. ! true => include biomass heat storage in canopy energy budget + !---------------------------------------------------------- ! bedrock / soil depth switch !---------------------------------------------------------- diff --git a/src/main/controlMod.F90 b/src/main/controlMod.F90 index ae9c2fcafe..2f682b5523 100644 --- a/src/main/controlMod.F90 +++ b/src/main/controlMod.F90 @@ -238,6 +238,8 @@ subroutine control_init( ) namelist /clm_inparm/ use_bedrock + namelist /clm_inparm/ use_biomass_heat_storage + namelist /clm_inparm/ use_hydrstress namelist /clm_inparm/ use_dynroot @@ -660,6 +662,8 @@ subroutine control_spmd() call mpi_bcast (use_bedrock, 1, MPI_LOGICAL, 0, mpicom, ier) + call mpi_bcast (use_biomass_heat_storage, 1, MPI_LOGICAL, 0, mpicom, ier) + call mpi_bcast (use_hydrstress, 1, MPI_LOGICAL, 0, mpicom, ier) call mpi_bcast (use_dynroot, 1, MPI_LOGICAL, 0, mpicom, ier) From c41a061949a3461574c8e407925f890580467f27 Mon Sep 17 00:00:00 2001 From: Sean Swenson Date: Tue, 25 Jun 2019 10:25:20 -0600 Subject: [PATCH 14/76] fix num_iter location in BareGroundFluxesMod --- src/biogeophys/BareGroundFluxesMod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/biogeophys/BareGroundFluxesMod.F90 b/src/biogeophys/BareGroundFluxesMod.F90 index f2c6f25285..93ad6767bb 100644 --- a/src/biogeophys/BareGroundFluxesMod.F90 +++ b/src/biogeophys/BareGroundFluxesMod.F90 @@ -309,9 +309,9 @@ subroutine BareGroundFluxes(bounds, num_noexposedvegp, filter_noexposedvegp, & um(p) = sqrt(ur(p)*ur(p) + wc*wc) end if obu(p) = zldis(p)/zeta - end do - num_iter(p) = iter + num_iter(p) = iter + end do end do ! end stability iteration From 93c009dd9cf87ba3b195963013a8b25825da2b51 Mon Sep 17 00:00:00 2001 From: Sean Swenson Date: Tue, 27 Aug 2019 10:46:47 -0600 Subject: [PATCH 15/76] fix initial leaf temperature bug --- src/biogeochem/CNVegStructUpdateMod.F90 | 28 ++- src/biogeophys/CanopyFluxesMod.F90 | 241 +++++++++++------------- src/biogeophys/CanopyStateType.F90 | 40 +++- src/main/clm_initializeMod.F90 | 2 +- src/main/clm_instMod.F90 | 2 - src/main/clm_varcon.F90 | 4 +- src/main/pftconMod.F90 | 25 ++- src/main/readParamsMod.F90 | 6 +- 8 files changed, 191 insertions(+), 157 deletions(-) diff --git a/src/biogeochem/CNVegStructUpdateMod.F90 b/src/biogeochem/CNVegStructUpdateMod.F90 index 6a990ce89a..7db10f675f 100644 --- a/src/biogeochem/CNVegStructUpdateMod.F90 +++ b/src/biogeochem/CNVegStructUpdateMod.F90 @@ -42,7 +42,8 @@ subroutine CNVegStructUpdate(num_soilp, filter_soilp, & use pftconMod , only : ntrp_corn, nirrig_trp_corn use pftconMod , only : nsugarcane, nirrig_sugarcane use pftconMod , only : pftcon - use clm_varctl , only : spinup_state + use clm_varctl , only : spinup_state, use_biomass_heat_storage + use clm_varcon , only : c_to_b use clm_time_manager , only : get_rad_step_size ! ! !ARGUMENTS: @@ -97,7 +98,9 @@ subroutine CNVegStructUpdate(num_soilp, filter_soilp, & dwood => pftcon%dwood , & ! Input: density of wood (gC/m^3) ztopmx => pftcon%ztopmx , & ! Input: laimx => pftcon%laimx , & ! Input: - + nstem => pftcon%nstem , & ! Input: Tree number density (#ind/m2) + fbw => pftcon%fbw , & ! Input: Fraction of fresh biomass that is water + allom2 => dgv_ecophyscon%allom2 , & ! Input: [real(r8) (:) ] ecophys const allom3 => dgv_ecophyscon%allom3 , & ! Input: [real(r8) (:) ] ecophys const @@ -110,6 +113,7 @@ subroutine CNVegStructUpdate(num_soilp, filter_soilp, & leafc => cnveg_carbonstate_inst%leafc_patch , & ! Input: [real(r8) (:) ] (gC/m2) leaf C deadstemc => cnveg_carbonstate_inst%deadstemc_patch , & ! Input: [real(r8) (:) ] (gC/m2) dead stem C + livestemc => cnveg_carbonstate_inst%livestemc_patch , & ! Input: [real(r8) (:) ] (gC/m2) live stem C farea_burned => cnveg_state_inst%farea_burned_col , & ! Input: [real(r8) (:) ] F. Li and S. Levis htmx => cnveg_state_inst%htmx_patch , & ! Output: [real(r8) (:) ] max hgt attained by a crop during yr (m) @@ -120,6 +124,8 @@ subroutine CNVegStructUpdate(num_soilp, filter_soilp, & ! *** Key Output from CN*** tlai => canopystate_inst%tlai_patch , & ! Output: [real(r8) (:) ] one-sided leaf area index, no burying by snow tsai => canopystate_inst%tsai_patch , & ! Output: [real(r8) (:) ] one-sided stem area index, no burying by snow + stem_biomass => canopystate_inst%stem_biomass_patch , & ! Output: [real(r8) (:) ] Aboveground stem biomass (kg/m**2) + leaf_biomass => canopystate_inst%leaf_biomass_patch , & ! Output: [real(r8) (:) ] Aboveground leave biomass (kg/m**2) htop => canopystate_inst%htop_patch , & ! Output: [real(r8) (:) ] canopy top (m) hbot => canopystate_inst%hbot_patch , & ! Output: [real(r8) (:) ] canopy bottom (m) elai => canopystate_inst%elai_patch , & ! Output: [real(r8) (:) ] one-sided leaf area index with burying by snow @@ -205,14 +211,28 @@ subroutine CNVegStructUpdate(num_soilp, filter_soilp, & !correct height calculation if doing accelerated spinup if (spinup_state == 2) then htop(p) = ((3._r8 * deadstemc(p) * 10._r8 * taper * taper)/ & - (SHR_CONST_PI * stocking * dwood(ivt(p))))**(1._r8/3._r8) + (SHR_CONST_PI * nstem(ivt(p)) * dwood(ivt(p))))**(1._r8/3._r8) else htop(p) = ((3._r8 * deadstemc(p) * taper * taper)/ & - (SHR_CONST_PI * stocking * dwood(ivt(p))))**(1._r8/3._r8) + (SHR_CONST_PI * nstem(ivt(p)) * dwood(ivt(p))))**(1._r8/3._r8) end if endif + ! calculate vegetation physiological parameters used in biomass heat storage + if (use_biomass_heat_storage) then + ! Assumes fbw the same for leaves and stems + leaf_biomass(p) = max(0.0025_r8,leafc(p)) & + * c_to_b * 1.e-3_r8 / (1._r8 - fbw(ivt(p))) + + stem_biomass(p) = (deadstemc(p) + livestemc(p)) & + * c_to_b * 1.e-3_r8 / (1._r8 - fbw(ivt(p))) + + if (spinup_state == 2) then + stem_biomass(p) = 10._r8 * stem_biomass(p) + end if + end if + ! Peter Thornton, 5/3/2004 ! Adding test to keep htop from getting too close to forcing height for windspeed ! Also added for grass, below, although it is not likely to ever be an issue. diff --git a/src/biogeophys/CanopyFluxesMod.F90 b/src/biogeophys/CanopyFluxesMod.F90 index 4540b4b2ef..a129c33406 100644 --- a/src/biogeophys/CanopyFluxesMod.F90 +++ b/src/biogeophys/CanopyFluxesMod.F90 @@ -14,7 +14,7 @@ module CanopyFluxesMod use shr_log_mod , only : errMsg => shr_log_errMsg use abortutils , only : endrun use clm_varctl , only : iulog, use_cn, use_lch4, use_c13, use_c14, use_cndv, use_fates, & - use_luna, use_hydrstress + use_luna, use_hydrstress, use_biomass_heat_storage use clm_varpar , only : nlevgrnd, nlevsno, mxpft use clm_varcon , only : namep use pftconMod , only : pftcon @@ -37,7 +37,7 @@ module CanopyFluxesMod use TemperatureType , only : temperature_type use WaterFluxBulkType , only : waterfluxbulk_type use WaterStateBulkType , only : waterstatebulk_type - use WaterDiagnosticBulkType , only : waterdiagnosticbulk_type + use WaterDiagnosticBulkType , only : waterdiagnosticbulk_type use CanopyHydrologyMod , only : IsSnowvegFlagOn, IsSnowvegFlagOnRad use HumanIndexMod , only : humanindex_type use ch4Mod , only : ch4_type @@ -52,24 +52,6 @@ module CanopyFluxesMod ! !PUBLIC TYPES: implicit none ! - ! !PUBLIC VARIABLES: - - type :: canopyflux_params_type - real(r8), allocatable, public :: dbh (:) - real(r8), allocatable, public :: fbw (:) - real(r8), allocatable, public :: nstem (:) - real(r8), allocatable, public :: rstem (:) - real(r8), allocatable, public :: wood_density (:) - contains - procedure, private :: allocParams - end type canopyflux_params_type - ! - type(canopyflux_params_type), public, protected :: params_inst ! params_inst is populated in readParamsMod - - type, public :: canopyflux_type - contains - procedure, public :: ReadParams - end type canopyflux_type ! !PUBLIC MEMBER FUNCTIONS: public :: CanopyFluxesReadNML ! Read in namelist settings @@ -88,83 +70,12 @@ module CanopyFluxesMod logical, private :: snowveg_on = .false. ! snowveg_flag = 'ON' logical, private :: snowveg_onrad = .true. ! snowveg_flag = 'ON_RAD' logical, private :: use_undercanopy_stability = .true. ! use undercanopy stability term or not - logical, private :: use_biomass_heat_storage = .false. ! include biomass heat storage character(len=*), parameter, private :: sourcefile = & __FILE__ !------------------------------------------------------------------------------ contains - !----------------------------------------------------------------------- - subroutine allocParams ( this ) - ! - use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) - implicit none - - ! !ARGUMENTS: - class(canopyflux_params_type) :: this - ! - ! !LOCAL VARIABLES: - character(len=32) :: subname = 'allocParams' - !----------------------------------------------------------------------- - - ! allocate parameters - - allocate( this%dbh (0:mxpft) ) ; this%dbh(:) = nan - allocate( this%fbw (0:mxpft) ) ; this%fbw(:) = nan - allocate( this%nstem (0:mxpft) ) ; this%nstem(:) = nan - allocate( this%rstem (0:mxpft) ) ; this%rstem(:) = nan - allocate( this%wood_density(0:mxpft) ) ; this%wood_density(:) = nan - - end subroutine allocParams - - !----------------------------------------------------------------------- - subroutine readParams ( this, ncid ) - ! - ! !USES: - use ncdio_pio , only : file_desc_t,ncd_io - implicit none - - ! !ARGUMENTS: - class(canopyflux_type) :: this - type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id - ! - ! !LOCAL VARIABLES: - character(len=32) :: subname = 'readParams' - character(len=100) :: errCode = '-Error reading in parameters file:' - logical :: readv ! has variable been read in or not - real(r8) :: temp1d(0:mxpft) ! temporary to read in parameter - character(len=100) :: tString ! temp. var for reading - !----------------------------------------------------------------------- - - ! read in parameters - - - call params_inst%allocParams() - - tString = "dbh" - call ncd_io(varname=trim(tString),data=temp1d, flag='read', ncid=ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - params_inst%dbh=temp1d - tString = "fbw" - call ncd_io(varname=trim(tString),data=temp1d, flag='read', ncid=ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - params_inst%fbw=temp1d - tString = "nstem" - call ncd_io(varname=trim(tString),data=temp1d, flag='read', ncid=ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - params_inst%nstem=temp1d - tString = "rstem" - call ncd_io(varname=trim(tString),data=temp1d, flag='read', ncid=ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - params_inst%rstem=temp1d - tString = "wood_density" - call ncd_io(varname=trim(tString),data=temp1d, flag='read', ncid=ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - params_inst%wood_density=temp1d - - end subroutine readParams - !------------------------------------------------------------------------ subroutine CanopyFluxesReadNML(NLFilename) ! @@ -260,7 +171,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ! !USES: use shr_const_mod , only : SHR_CONST_RGAS, shr_const_pi use clm_time_manager , only : get_step_size, get_prev_date,is_end_curr_day - use clm_varcon , only : sb, cpair, hvap, vkc, grav, denice + use clm_varcon , only : sb, cpair, hvap, vkc, grav, denice, c_to_b use clm_varcon , only : denh2o, tfrz, csoilc, tlsai_crit, alpha_aero use clm_varcon , only : c14ratio use perf_mod , only : t_startf, t_stopf @@ -382,7 +293,8 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, real(r8) :: efsh ! sensible heat from leaf [mm/s] real(r8) :: obuold(bounds%begp:bounds%endp) ! monin-obukhov length from previous iteration real(r8) :: tlbef(bounds%begp:bounds%endp) ! leaf temperature from previous iteration [K] - real(r8) :: tsbef(bounds%begp:bounds%endp) ! stem temperature from previous iteration [K] + real(r8) :: tl_ini(bounds%begp:bounds%endp) ! leaf temperature from beginning of time step [K] + real(r8) :: ts_ini(bounds%begp:bounds%endp) ! stem temperature from beginning of time step [K] real(r8) :: ecidif ! excess energies [W/m2] real(r8) :: err(bounds%begp:bounds%endp) ! balance error real(r8) :: erre ! balance error @@ -443,6 +355,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, integer :: iv logical :: is_end_day ! is end of current day + real(r8) :: dbh(bounds%begp:bounds%endp) !diameter at breast height of vegetation real(r8) :: cp_veg(bounds%begp:bounds%endp) !heat capacity of veg real(r8) :: cp_stem(bounds%begp:bounds%endp) !heat capacity of stems real(r8) :: dt_stem(bounds%begp:bounds%endp) !change in stem temperature @@ -457,12 +370,11 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, real(r8) :: carea_stem real(r8) :: rstema ! biomass parameters - real(r8), parameter :: c_to_b = 2.0_r8 !(g biomass /g C) - real(r8), parameter :: k_vert = 0.1 !vertical distribution of stem real(r8), parameter :: k_cyl_vol = 1.0 !departure from cylindrical volume real(r8), parameter :: k_cyl_area = 1.0 !departure from cylindrical area real(r8), parameter :: k_internal = 0.0 !self-absorbtion of leaf/stem longwave + real(r8), parameter :: min_stem_diameter = 0.01!minimum stem diameter for which to calculate stem interactions @@ -473,14 +385,19 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, SHR_ASSERT_ALL((ubound(leafn_patch) == (/bounds%endp/)), errMsg(sourcefile, __LINE__)) associate( & - t_stem => temperature_inst%t_stem_patch , & ! Output: [real(r8) (:) ] stem temperature (Kelvin) - hs_canopy => energyflux_inst%hs_canopy_patch , & ! Output: [real(r8) (:) ] change in heat storage of stem (W/m**2) [+ to atm] - soilresis => soilstate_inst%soilresis_col , & ! Input: [real(r8) (:) ] soil evaporative resistance - snl => col%snl , & ! Input: [integer (:) ] number of snow layers - dayl => grc%dayl , & ! Input: [real(r8) (:) ] daylength (s) - max_dayl => grc%max_dayl , & ! Input: [real(r8) (:) ] maximum daylength for this grid cell (s) - - dleaf => pftcon%dleaf , & ! Input: characteristic leaf dimension (m) + t_stem => temperature_inst%t_stem_patch , & ! Output: [real(r8) (:) ] stem temperature (Kelvin) + hs_canopy => energyflux_inst%hs_canopy_patch , & ! Output: [real(r8) (:) ] change in heat storage of stem (W/m**2) [+ to atm] + soilresis => soilstate_inst%soilresis_col , & ! Input: [real(r8) (:) ] soil evaporative resistance + snl => col%snl , & ! Input: [integer (:) ] number of snow layers + dayl => grc%dayl , & ! Input: [real(r8) (:) ] daylength (s) + max_dayl => grc%max_dayl , & ! Input: [real(r8) (:) ] maximum daylength for this grid cell (s) + + dleaf => pftcon%dleaf , & ! Input: characteristic leaf dimension (m) + dbh_param => pftcon%dbh , & ! Input: diameter at brest height (m) + fbw => pftcon%fbw , & ! Input: fraction of biomass that is water + nstem => pftcon%nstem , & ! Input: stem number density (#ind/m2) + rstem => pftcon%rstem , & ! Input: stem restistance per stem diameter (s/m**2) + wood_density => pftcon%wood_density , & ! Input: dry wood density (kg/m3) forc_lwrad => atm2lnd_inst%forc_lwrad_downscaled_col , & ! Input: [real(r8) (:) ] downward infrared (longwave) radiation (W/m**2) forc_q => atm2lnd_inst%forc_q_downscaled_col , & ! Input: [real(r8) (:) ] atmospheric specific humidity (kg/kg) @@ -533,6 +450,8 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, laisun => canopystate_inst%laisun_patch , & ! Input: [real(r8) (:) ] sunlit leaf area laisha => canopystate_inst%laisha_patch , & ! Input: [real(r8) (:) ] shaded leaf area displa => canopystate_inst%displa_patch , & ! Input: [real(r8) (:) ] displacement height (m) + stem_biomass => canopystate_inst%stem_biomass_patch , & ! Output: [real(r8) (:) ] Aboveground stem biomass (kg/m**2) + leaf_biomass => canopystate_inst%leaf_biomass_patch , & ! Output: [real(r8) (:) ] Aboveground leaf biomass (kg/m**2) htop => canopystate_inst%htop_patch , & ! Input: [real(r8) (:) ] canopy top(m) altmax_lastyear_indx => canopystate_inst%altmax_lastyear_indx_col , & ! Input: [integer (:) ] prior year maximum annual depth of thaw altmax_indx => canopystate_inst%altmax_indx_col , & ! Input: [integer (:) ] maximum annual depth of thaw @@ -726,17 +645,26 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ! when elai = 0, do not multiply by k_vert (i.e. fstem = 1) if(elai(p) > 0._r8) fstem(p) = k_vert * fstem(p) + ! if using Satellite Phenology mode, use values in parameter file + ! otherwise calculate dbh from stem biomass + if(.not. use_cn .or. .not. use_biomass_heat_storage) then + dbh(p) = dbh_param(patch%itype(p)) + else + dbh(p) = 2._r8 * sqrt(stem_biomass(p) * (1._r8 - fbw(patch%itype(p))) / ( shr_const_pi * htop(p) * k_cyl_vol & + * nstem(patch%itype(p)) * wood_density(patch%itype(p)))) + endif + ! leaf and stem surface area sa_leaf(p) = elai(p) ! double in spirit of full surface area for sensible heat sa_leaf(p) = 2.*sa_leaf(p) - sa_stem(p) = params_inst%nstem(patch%itype(p))*(htop(p)*shr_const_pi*params_inst%dbh(patch%itype(p))) + sa_stem(p) = nstem(patch%itype(p))*(htop(p)*shr_const_pi*dbh(p)) ! adjust for departure of cylindrical stem model sa_stem(p) = k_cyl_area * sa_stem(p) ! do not calculate separate leaf/stem heat capacity for grasses - if(patch%itype(p) > 11) then + if(patch%itype(p) > 11 .or. dbh(p) < min_stem_diameter) then fstem(p) = 0.0 sa_stem(p) = 0.0 endif @@ -746,31 +674,49 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, sa_stem(p) = 0._r8 sa_leaf(p) = (elai(p)+esai(p)) endif - - ! internal longwave fluxes between leaf and stem + + ! cross-sectional area of stems + carea_stem = shr_const_pi * (dbh(p)*0.5)**2 + + ! if using Satellite Phenology mode, calculate leaf and stem + ! biomass + if(.not. use_cn) then + ! boreal needleleaf lma*c2b ~ 0.25 kg dry mass/m2(leaf) + leaf_biomass(p) = 0.25_r8 * max(0.01_r8, sa_leaf(p)) & + / (1.-fbw(patch%itype(p))) + stem_biomass(p) = carea_stem * htop(p) * k_cyl_vol & + * nstem(patch%itype(p)) * wood_density(patch%itype(p)) & + /(1.-fbw(patch%itype(p))) + endif + +! internal longwave fluxes between leaf and stem ! surface area term must be equal, remainder cancels ! (use same area of interaction i.e. ignore leaf <-> leaf) sa_internal(p) = min(sa_leaf(p),sa_stem(p)) sa_internal(p) = k_internal * sa_internal(p) ! calculate specify heat capacity of vegetation -!(lma * c2b = lma_dry, lma * c2b * (fw/(1-fw)) = lma_wet, sum these) +! as weighted averaged of dry biomass and water ! lma_dry has units of kg dry mass /m2 here (table 2 of bonan 2017) ! cdry_biomass = 1400 J/kg/K, cwater = 4188 J/kg/K -! boreal needleleaf lma*c2b ~ 0.25 kg dry mass/m2(leaf) - cp_veg(p) = (0.25_r8 * max(0.01_r8,elai(p))) * (1400._r8 + (params_inst%fbw(patch%itype(p))/(1.-params_inst%fbw(patch%itype(p))))*4188._r8) + cp_veg(p) = leaf_biomass(p) * (1400._r8*(1.-fbw(patch%itype(p))) + (fbw(patch%itype(p)))*4188._r8) ! use non-zero, but small, heat capacity if(.not.use_biomass_heat_storage) then - cp_veg(p) = 1.e-3_r8 + cp_veg(p) = 0._r8 endif - carea_stem = shr_const_pi * (params_inst%dbh(patch%itype(p))*0.5)**2 +! cp-stem will have units J/k/ground_area + cp_stem(p) = stem_biomass(p) * (1400._r8*(1.-fbw(patch%itype(p))) + (fbw(patch%itype(p)))*4188._r8) + +!!$ if(abs(cp_stem(p)) > 0. ) then +!!$ else +!!$ write(iulog,*) 'badcp: ', c, p, cp_stem(p) +!!$ write(iulog,*) 'badcp2: ', stem_biomass(p),fbw(patch%itype(p)) +!!$ endif + -! cp-stem will have units J/k/ground_area (here assuming 1 stem/m2) - cp_stem(p) = (1400._r8 + (params_inst%fbw(patch%itype(p))/(1.-params_inst%fbw(patch%itype(p))))*4188._r8) -! use weight of dry wood - cp_stem(p) = params_inst%nstem(patch%itype(p))* cp_stem(p) * params_inst%wood_density(patch%itype(p)) * htop(p) * carea_stem + ! adjust for departure from cylindrical stem model cp_stem(p) = k_cyl_vol * cp_stem(p) enddo @@ -931,6 +877,9 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, call MoninObukIni(ur(p), thv(c), dthv(p), zldis(p), z0mv(p), um(p), obu(p)) num_iter(p) = 0 + ! Record initial veg/stem temperatures + tl_ini(p) = t_veg(p) + ts_ini(p) = t_stem(p) end do ! Set counter for leaf temperature iteration (itlef) @@ -953,9 +902,6 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, temp1(begp:endp), temp2(begp:endp), temp12m(begp:endp), temp22m(begp:endp), fm(begp:endp), & frictionvel_inst) - - - do f = 1, fn p = filterp(f) @@ -963,7 +909,6 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, g = patch%gridcell(p) tlbef(p) = t_veg(p) - tsbef(p) = t_stem(p) del2(p) = del(p) ! Determine aerodynamic resistances @@ -1107,7 +1052,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, wtg(p) = 1._r8/rah(p,2) ! ground ! wtstem = sa_stem(p)/rb(p) ! stem ! add resistance between internal stem temperature and canopy air - rstema = params_inst%rstem(patch%itype(p))*params_inst%dbh(patch%itype(p)) + rstema = rstem(patch%itype(p))*dbh(p) wtstem = sa_stem(p)/(rstema + rb(p)) ! stem wtshi = 1._r8/(wta+wtl+wtstem+wtg(p)) @@ -1232,12 +1177,26 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, dt_veg(p) = ((1.-fstem(p))*(sabv(p) + air(p) & + bir(p)*t_veg(p)**4 + cir(p)*lw_grnd) & - efsh - efe(p) - lw_leaf(p) + lw_stem(p) & - - (cp_veg(p)/dtime)*(t_veg(p) - tlbef(p))) & + - (cp_veg(p)/dtime)*(t_veg(p) - tl_ini(p))) & / ((1.-fstem(p))*(- 4._r8*bir(p)*t_veg(p)**3) & + 4._r8*sa_internal(p)*emv(p)*sb*t_veg(p)**3 & +dc1*wtga(p) +dc2*wtgaq*qsatldT(p) + cp_veg(p)/dtime) t_veg(p) = tlbef(p) + dt_veg(p) + if(t_veg(p) > 0. .and. t_veg(p) < 1000.) then + else + write(iulog,*) 'badtemp: ', c, p, t_veg(p),fstem(p) + write(iulog,'(a12,i4,6f12.6)') 'badtemp2: ', & + patch%itype(p),- 4._r8*bir(p), & + 4._r8*sa_internal(p)*emv(p)*sb, & + dc1*wtga(p) ,dc2*wtgaq*qsatldT(p) , cp_veg(p)/dtime +! write(iulog,'(a12,i4,6f12.6)') 'badtemp3: ',patch%itype(p),wtga(p),wta0(p),wtg0,wtstem0(p),rstema,rb(p) + + write(iulog,'(a12,i4,6f12.6)') 'badtemp3: ', & + patch%itype(p),dbh(p),dbh_param(patch%itype(p)) + endif + + dels = dt_veg(p) del(p) = abs(dels) err(p) = 0._r8 @@ -1251,7 +1210,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, + lw_stem(p) & - (efsh + dc1*wtga(p)*dt_veg(p)) - (efe(p) + & dc2*wtgaq*qsatldT(p)*dt_veg(p)) & - - (cp_veg(p)/dtime)*(t_veg(p) - tlbef(p)) + - (cp_veg(p)/dtime)*(t_veg(p) - tl_ini(p)) end if ! Fluxes from leaves to canopy space @@ -1391,20 +1350,32 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, err(p) = (1.-fstem(p))*(sabv(p) + air(p) + bir(p)*tlbef(p)**3 & *(tlbef(p) + 4._r8*dt_veg(p)) + cir(p)*lw_grnd) & - lw_leaf(p) + lw_stem(p) - eflx_sh_veg(p) - hvap*qflx_evap_veg(p) & - - ((t_veg(p)-tlbef(p))*cp_veg(p)/dtime) + - ((t_veg(p)-tl_ini(p))*cp_veg(p)/dtime) ! Update stem temperature; adjust outgoing longwave ! does not account for changes in SH or internal LW, ! as that would change result for t_veg above - dt_stem(p) = (fstem(p)*(sabv(p) + air(p) + bir(p)*tsbef(p)**4 & - + cir(p)*lw_grnd) - eflx_sh_stem(p) & - + lw_leaf(p)- lw_stem(p))/(cp_stem(p)/dtime & - - fstem(p)*bir(p)*4.*tsbef(p)**3) - - hs_canopy(p) = dt_stem(p)*cp_stem(p)/dtime & - +(t_veg(p)-tlbef(p))*cp_veg(p)/dtime - - t_stem(p) = t_stem(p) + dt_stem(p) + if (use_biomass_heat_storage) then + if (stem_biomass(p) > 0._r8) then + dt_stem(p) = (fstem(p)*(sabv(p) + air(p) + bir(p)*ts_ini(p)**4 & + + cir(p)*lw_grnd) - eflx_sh_stem(p) & + + lw_leaf(p)- lw_stem(p))/(cp_stem(p)/dtime & + - fstem(p)*bir(p)*4.*ts_ini(p)**3) + else + dt_stem(p) = 0._r8 + endif + + hs_canopy(p) = dt_stem(p)*cp_stem(p)/dtime & + +(t_veg(p)-tl_ini(p))*cp_veg(p)/dtime + + t_stem(p) = t_stem(p) + dt_stem(p) + endif + + if(t_stem(p) > 0. .and. t_stem(p) < 1000.) then + else + write(iulog,'(a12,3i8,6f12.6)') 'badtemp4: ', c, p, patch%itype(p), t_stem(p), cp_stem(p) + write(iulog,'(a12,i8,6f12.6)') 'badtemp5: ', patch%itype(p), fstem(p),stem_biomass(p), cp_veg(p),leaf_biomass(p) + endif delt = wtal(p)*t_grnd(c)-wtl0(p)*t_veg(p)-wta0(p)*thm(p)-wtstem0(p)*t_stem(p) @@ -1485,12 +1456,12 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ! Downward longwave radiation below the canopy dlrad(p) = (1._r8-emv(p))*emg(c)*forc_lwrad(c) + & - emv(p)*emg(c)*sb*(tlbef(p)**3*(tlbef(p) + 4._r8*dt_veg(p))*(1.-fstem(p))+tsbef(p)**3*(tsbef(p) + 4._r8*dt_stem(p))*fstem(p)) + emv(p)*emg(c)*sb*(tlbef(p)**3*(tlbef(p) + 4._r8*dt_veg(p))*(1.-fstem(p))+ts_ini(p)**3*(ts_ini(p) + 4._r8*dt_stem(p))*fstem(p)) ! Upward longwave radiation above the canopy ulrad(p) = ((1._r8-emg(c))*(1._r8-emv(p))*(1._r8-emv(p))*forc_lwrad(c) & - + emv(p)*(1._r8+(1._r8-emg(c))*(1._r8-emv(p)))*sb*((1.-fstem(p))*tlbef(p)**3*(tlbef(p) + 4._r8*dt_veg(p))+fstem(p)*tsbef(p)**3*(tsbef(p) + 4._r8*dt_stem(p))) + emg(c)*(1._r8-emv(p))*sb*lw_grnd) + + emv(p)*(1._r8+(1._r8-emg(c))*(1._r8-emv(p)))*sb*((1.-fstem(p))*tlbef(p)**3*(tlbef(p) + 4._r8*dt_veg(p))+fstem(p)*ts_ini(p)**3*(ts_ini(p) + 4._r8*dt_stem(p))) + emg(c)*(1._r8-emv(p))*sb*lw_grnd) ! Calculate the skin temperature as a weighted sum of all the ground and vegetated fraction diff --git a/src/biogeophys/CanopyStateType.F90 b/src/biogeophys/CanopyStateType.F90 index bfb5196d79..f4008815d4 100644 --- a/src/biogeophys/CanopyStateType.F90 +++ b/src/biogeophys/CanopyStateType.F90 @@ -36,6 +36,8 @@ module CanopyStateType real(r8) , pointer :: laisha_z_patch (:,:) ! patch patch shaded leaf area for canopy layer real(r8) , pointer :: mlaidiff_patch (:) ! patch difference between lai month one and month two (for dry deposition of chemical tracers) real(r8) , pointer :: annlai_patch (:,:) ! patch 12 months of monthly lai from input data set (for dry deposition of chemical tracers) + real(r8) , pointer :: stem_biomass_patch (:) ! Aboveground stem biomass (kg/m**2) + real(r8) , pointer :: leaf_biomass_patch (:) ! Aboveground leaf biomass (kg/m**2) real(r8) , pointer :: htop_patch (:) ! patch canopy top (m) real(r8) , pointer :: hbot_patch (:) ! patch canopy bottom (m) real(r8) , pointer :: displa_patch (:) ! patch displacement height (m) @@ -127,6 +129,8 @@ subroutine InitAllocate(this, bounds) allocate(this%laisha_z_patch (begp:endp,1:nlevcan)) ; this%laisha_z_patch (:,:) = nan allocate(this%mlaidiff_patch (begp:endp)) ; this%mlaidiff_patch (:) = nan allocate(this%annlai_patch (12,begp:endp)) ; this%annlai_patch (:,:) = nan + allocate(this%stem_biomass_patch (begp:endp)) ; this%stem_biomass_patch (:) = nan + allocate(this%leaf_biomass_patch (begp:endp)) ; this%leaf_biomass_patch (:) = nan allocate(this%htop_patch (begp:endp)) ; this%htop_patch (:) = nan allocate(this%hbot_patch (begp:endp)) ; this%hbot_patch (:) = nan allocate(this%displa_patch (begp:endp)) ; this%displa_patch (:) = nan @@ -198,6 +202,16 @@ subroutine InitHistory(this, bounds) avgflag='A', long_name='shaded projected leaf area index', & ptr_patch=this%laisha_patch, set_urb=0._r8) + this%stem_biomass_patch(begp:endp) = spval + call hist_addfld1d (fname='AGSB', units='kg/m^2', & + avgflag='A', long_name='Aboveground stem biomass', & + ptr_patch=this%stem_biomass_patch, default='inactive') + + this%leaf_biomass_patch(begp:endp) = spval + call hist_addfld1d (fname='AGLB', units='kg/m^2', & + avgflag='A', long_name='Aboveground leaf biomass', & + ptr_patch=this%leaf_biomass_patch, default='inactive') + if (use_cn .or. use_fates) then this%fsun_patch(begp:endp) = spval call hist_addfld1d (fname='FSUN', units='proportion', & @@ -509,14 +523,16 @@ subroutine InitCold(this, bounds) l = patch%landunit(p) this%frac_veg_nosno_patch(p) = 0._r8 - this%tlai_patch(p) = 0._r8 - this%tsai_patch(p) = 0._r8 - this%elai_patch(p) = 0._r8 - this%esai_patch(p) = 0._r8 - this%htop_patch(p) = 0._r8 - this%hbot_patch(p) = 0._r8 - this%dewmx_patch(p) = 0.1_r8 - this%vegwp_patch(p,:) = -2.5e4_r8 + this%tlai_patch(p) = 0._r8 + this%tsai_patch(p) = 0._r8 + this%elai_patch(p) = 0._r8 + this%esai_patch(p) = 0._r8 + this%stem_biomass_patch(p)= 0._r8 + this%leaf_biomass_patch(p)= 0._r8 + this%htop_patch(p) = 0._r8 + this%hbot_patch(p) = 0._r8 + this%dewmx_patch(p) = 0.1_r8 + this%vegwp_patch(p,:) = -2.5e4_r8 if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then this%laisun_patch(p) = 0._r8 @@ -585,6 +601,14 @@ subroutine Restart(this, bounds, ncid, flag) dim1name='pft', long_name='one-sided stem area index, with burying by snow', units='', & interpinic_flag='interp', readvar=readvar, data=this%esai_patch) + call restartvar(ncid=ncid, flag=flag, varname='stem_biomass', xtype=ncd_double, & + dim1name='pft', long_name='stem biomass', units='kg/m^2', & + interpinic_flag='interp', readvar=readvar, data=this%stem_biomass_patch) + + call restartvar(ncid=ncid, flag=flag, varname='leaf_biomass', xtype=ncd_double, & + dim1name='pft', long_name='leaf biomass', units='kg/m^2', & + interpinic_flag='interp', readvar=readvar, data=this%leaf_biomass_patch) + call restartvar(ncid=ncid, flag=flag, varname='htop', xtype=ncd_double, & dim1name='pft', long_name='canopy top', units='m', & interpinic_flag='interp', readvar=readvar, data=this%htop_patch) diff --git a/src/main/clm_initializeMod.F90 b/src/main/clm_initializeMod.F90 index 2bc4e96039..1f35c4744c 100644 --- a/src/main/clm_initializeMod.F90 +++ b/src/main/clm_initializeMod.F90 @@ -340,7 +340,7 @@ subroutine initialize2( ) allocate(nutrient_competition_method, & source=create_nutrient_competition_method(bounds_proc)) - call readParameters(nutrient_competition_method, photosyns_inst, canopyflux_inst) + call readParameters(nutrient_competition_method, photosyns_inst) ! ------------------------------------------------------------------------ ! Initialize time manager diff --git a/src/main/clm_instMod.F90 b/src/main/clm_instMod.F90 index 2278f924b6..43c3fae406 100644 --- a/src/main/clm_instMod.F90 +++ b/src/main/clm_instMod.F90 @@ -50,7 +50,6 @@ module clm_instMod use OzoneBaseMod , only : ozone_base_type use OzoneFactoryMod , only : create_and_init_ozone_type use PhotosynthesisMod , only : photosyns_type - use CanopyFluxesMod , only : canopyflux_type use SoilHydrologyType , only : soilhydrology_type use SaturatedExcessRunoffMod , only : saturated_excess_runoff_type use SoilStateType , only : soilstate_type @@ -102,7 +101,6 @@ module clm_instMod type(lakestate_type) :: lakestate_inst class(ozone_base_type), allocatable :: ozone_inst type(photosyns_type) :: photosyns_inst - type(canopyflux_type) :: canopyflux_inst type(soilstate_type) :: soilstate_inst type(soilhydrology_type) :: soilhydrology_inst type(saturated_excess_runoff_type) :: saturated_excess_runoff_inst diff --git a/src/main/clm_varcon.F90 b/src/main/clm_varcon.F90 index d0a2053568..3c60372f8b 100644 --- a/src/main/clm_varcon.F90 +++ b/src/main/clm_varcon.F90 @@ -122,11 +122,13 @@ module clm_varcon real(r8) :: thk_bedrock = 3.0_r8 ! thermal conductivity of 'typical' saturated granitic rock ! (Clauser and Huenges, 1995)(W/m/K) - real(r8) :: csol_bedrock = 2.0e6_r8 ! vol. heat capacity of granite/sandstone J/(m3 K)(Shabbir, 2000) !scs + real(r8) :: csol_bedrock = 2.0e6_r8 ! vol. heat capacity of granite/sandstone J/(m3 K)(Shabbir, 2000) real(r8), parameter :: zmin_bedrock = 0.4_r8 ! minimum soil depth [m] real(r8), parameter :: aquifer_water_baseline = 5000._r8 ! baseline value for water in the unconfined aquifer [mm] + real(r8), parameter :: c_to_b = 2.0_r8 ! conversion between mass carbon and total biomass (g biomass /g C) + !!! C13 real(r8), parameter :: preind_atm_del13c = -6.0 ! preindustrial value for atmospheric del13C real(r8), parameter :: preind_atm_ratio = SHR_CONST_PDB + (preind_atm_del13c * SHR_CONST_PDB)/1000.0 ! 13C/12C diff --git a/src/main/pftconMod.F90 b/src/main/pftconMod.F90 index 53fb8d0d0c..69fddaf981 100644 --- a/src/main/pftconMod.F90 +++ b/src/main/pftconMod.F90 @@ -485,7 +485,7 @@ subroutine InitRead(this) use fileutils , only : getfil use ncdio_pio , only : ncd_io, ncd_pio_closefile, ncd_pio_openfile, file_desc_t use ncdio_pio , only : ncd_inqdid, ncd_inqdlen - use clm_varctl , only : paramfile, use_fates, use_flexibleCN, use_dynroot + use clm_varctl , only : paramfile, use_fates, use_flexibleCN, use_dynroot, use_biomass_heat_storage use spmdMod , only : masterproc use CLMFatesParamInterfaceMod, only : FatesReadPFTs ! @@ -1014,6 +1014,29 @@ subroutine InitRead(this) if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) end if + ! + ! Biomass heat storage variables + ! + if (use_biomass_heat_storage ) then + call ncd_io('dbh',this%dbh, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + call ncd_io('fbw',this%fbw, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + call ncd_io('nstem',this%nstem, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + call ncd_io('rstem',this%rstem, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + call ncd_io('wood_density',this%wood_density, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + else + this%dbh = 0.0 + this%fbw = 0.0 + call ncd_io('nstem',this%nstem, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + this%rstem = 0.0 + this%wood_density = 0.0 + end if + call ncd_pio_closefile(ncid) call FatesReadPFTs() diff --git a/src/main/readParamsMod.F90 b/src/main/readParamsMod.F90 index f1c7a4aa43..32281eb057 100644 --- a/src/main/readParamsMod.F90 +++ b/src/main/readParamsMod.F90 @@ -23,7 +23,7 @@ module readParamsMod contains !----------------------------------------------------------------------- - subroutine readParameters (nutrient_competition_method, photosyns_inst, canopyflux_inst) + subroutine readParameters (nutrient_competition_method, photosyns_inst) ! ! ! USES: use CNSharedParamsMod , only : CNParamsReadShared @@ -43,11 +43,9 @@ subroutine readParameters (nutrient_competition_method, photosyns_inst, canopyfl use NutrientCompetitionMethodMod , only : nutrient_competition_method_type use clm_varctl, only : NLFilename_in use PhotosynthesisMod , only : photosyns_type - use CanopyFluxesMod , only : canopyflux_type ! ! !ARGUMENTS: type(photosyns_type) , intent(in) :: photosyns_inst - type(canopyflux_type) , intent(in) :: canopyflux_inst class(nutrient_competition_method_type), intent(in) :: nutrient_competition_method ! ! !LOCAL VARIABLES: @@ -99,8 +97,6 @@ subroutine readParameters (nutrient_competition_method, photosyns_inst, canopyfl ! Biogeophysics ! call photosyns_inst%ReadParams( ncid ) - call canopyflux_inst%ReadParams( ncid ) - ! call ncd_pio_closefile(ncid) From b1185b9342b90cfc4c5b07444a7d22f555d35faa Mon Sep 17 00:00:00 2001 From: Sean Swenson Date: Thu, 29 Aug 2019 09:21:29 -0600 Subject: [PATCH 16/76] initialize dt_stem --- src/biogeophys/CanopyFluxesMod.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/biogeophys/CanopyFluxesMod.F90 b/src/biogeophys/CanopyFluxesMod.F90 index cc7f2570df..c2b444492a 100644 --- a/src/biogeophys/CanopyFluxesMod.F90 +++ b/src/biogeophys/CanopyFluxesMod.F90 @@ -1437,6 +1437,8 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, +(t_veg(p)-tl_ini(p))*cp_veg(p)/dtime t_stem(p) = t_stem(p) + dt_stem(p) + else + dt_stem(p) = 0._r8 endif delt = wtal(p)*t_grnd(c)-wtl0(p)*t_veg(p)-wta0(p)*thm(p)-wtstem0(p)*t_stem(p) From 3fefc5969d2c29868d12b24abbba55206b2e7cee Mon Sep 17 00:00:00 2001 From: Sean Swenson Date: Fri, 4 Oct 2019 11:06:40 -0600 Subject: [PATCH 17/76] merge to master --- bld/CLMBuildNamelist.pm | 2 - src/biogeophys/CanopyFluxesMod.F90 | 93 +----------------------------- src/main/clm_initializeMod.F90 | 2 +- src/main/clm_instMod.F90 | 1 - src/main/initGridCellsMod.F90 | 2 +- src/main/readParamsMod.F90 | 5 +- 6 files changed, 6 insertions(+), 99 deletions(-) diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index ce01d8ba37..e2909f1b14 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -2083,9 +2083,7 @@ sub error_if_set { sub setup_logic_pftsoilcolumn { my ($opts, $nl_flags, $definition, $defaults, $nl, $physv) = @_; - if ( $physv->as_long() >= $physv->as_long("clm4_5") ) { add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'use_individual_pft_soil_column'); - } } #------------------------------------------------------------------------------- diff --git a/src/biogeophys/CanopyFluxesMod.F90 b/src/biogeophys/CanopyFluxesMod.F90 index 27f334316e..a0d59afc23 100644 --- a/src/biogeophys/CanopyFluxesMod.F90 +++ b/src/biogeophys/CanopyFluxesMod.F90 @@ -52,26 +52,6 @@ module CanopyFluxesMod ! !PUBLIC TYPES: implicit none ! - ! !PUBLIC VARIABLES: - - type :: canopyflux_params_type - real(r8), allocatable, public :: dbh (:) - real(r8), allocatable, public :: fbw (:) - real(r8), allocatable, public :: nstem (:) - real(r8), allocatable, public :: rstem (:) - real(r8), allocatable, public :: wood_density (:) - contains - procedure, private :: allocParams - end type canopyflux_params_type - ! - type(canopyflux_params_type), public, protected :: params_inst ! params_inst is populated in readParamsMod - - type, public :: canopyflux_type - contains - procedure, public :: ReadParams - end type canopyflux_type - ! - ! !PUBLIC MEMBER FUNCTIONS: public :: CanopyFluxesReadNML ! Read in namelist settings public :: CanopyFluxes ! Calculate canopy fluxes @@ -86,6 +66,7 @@ module CanopyFluxesMod real(r8) :: cv ! Turbulent transfer coeff. between canopy surface and canopy air (m/s^(1/2)) end type params_type type(params_type), private :: params_inst + ! ! !PUBLIC DATA MEMBERS: ! true => btran is based only on unfrozen soil levels @@ -96,7 +77,7 @@ module CanopyFluxesMod logical, public :: perchroot_alt = .false. ! ! !PRIVATE DATA MEMBERS: - logical, private :: use_undercanopy_stability = .true. ! use undercanopy stability term or not + logical, private :: use_undercanopy_stability = .false. ! use undercanopy stability term or not integer, private :: itmax_canopy_fluxes = -1 ! max # of iterations used in subroutine CanopyFluxes character(len=*), parameter, private :: sourcefile = & @@ -105,76 +86,6 @@ module CanopyFluxesMod contains - !----------------------------------------------------------------------- - subroutine allocParams ( this ) - ! - use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) - implicit none - - ! !ARGUMENTS: - class(canopyflux_params_type) :: this - ! - ! !LOCAL VARIABLES: - character(len=32) :: subname = 'allocParams' - !----------------------------------------------------------------------- - - ! allocate parameters - - allocate( this%dbh (0:mxpft) ) ; this%dbh(:) = nan - allocate( this%fbw (0:mxpft) ) ; this%fbw(:) = nan - allocate( this%nstem (0:mxpft) ) ; this%nstem(:) = nan - allocate( this%rstem (0:mxpft) ) ; this%rstem(:) = nan - allocate( this%wood_density(0:mxpft) ) ; this%wood_density(:) = nan - - end subroutine allocParams - - !----------------------------------------------------------------------- - subroutine readParams ( this, ncid ) - ! - ! !USES: - use ncdio_pio , only : file_desc_t,ncd_io - implicit none - - ! !ARGUMENTS: - class(canopyflux_type) :: this - type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id - ! - ! !LOCAL VARIABLES: - character(len=32) :: subname = 'readParams' - character(len=100) :: errCode = '-Error reading in parameters file:' - logical :: readv ! has variable been read in or not - real(r8) :: temp1d(0:mxpft) ! temporary to read in parameter - character(len=100) :: tString ! temp. var for reading - !----------------------------------------------------------------------- - - ! read in parameters - - - call params_inst%allocParams() - - tString = "dbh" - call ncd_io(varname=trim(tString),data=temp1d, flag='read', ncid=ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - params_inst%dbh=temp1d - tString = "fbw" - call ncd_io(varname=trim(tString),data=temp1d, flag='read', ncid=ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - params_inst%fbw=temp1d - tString = "nstem" - call ncd_io(varname=trim(tString),data=temp1d, flag='read', ncid=ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - params_inst%nstem=temp1d - tString = "rstem" - call ncd_io(varname=trim(tString),data=temp1d, flag='read', ncid=ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - params_inst%rstem=temp1d - tString = "wood_density" - call ncd_io(varname=trim(tString),data=temp1d, flag='read', ncid=ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - params_inst%wood_density=temp1d - - end subroutine readParams - !------------------------------------------------------------------------ subroutine CanopyFluxesReadNML(NLFilename) ! diff --git a/src/main/clm_initializeMod.F90 b/src/main/clm_initializeMod.F90 index eaa1768d26..aa27b18a6c 100644 --- a/src/main/clm_initializeMod.F90 +++ b/src/main/clm_initializeMod.F90 @@ -346,7 +346,7 @@ subroutine initialize2( ) allocate(nutrient_competition_method, & source=create_nutrient_competition_method(bounds_proc)) - call readParameters(nutrient_competition_method, photosyns_inst, canopyflux_inst) + call readParameters(nutrient_competition_method, photosyns_inst) ! ------------------------------------------------------------------------ ! Initialize time manager diff --git a/src/main/clm_instMod.F90 b/src/main/clm_instMod.F90 index d5ff28044e..276df5e3d3 100644 --- a/src/main/clm_instMod.F90 +++ b/src/main/clm_instMod.F90 @@ -52,7 +52,6 @@ module clm_instMod use OzoneBaseMod , only : ozone_base_type use OzoneFactoryMod , only : create_and_init_ozone_type use PhotosynthesisMod , only : photosyns_type - use CanopyFluxesMod , only : canopyflux_type use SoilHydrologyType , only : soilhydrology_type use SaturatedExcessRunoffMod , only : saturated_excess_runoff_type use SoilStateType , only : soilstate_type diff --git a/src/main/initGridCellsMod.F90 b/src/main/initGridCellsMod.F90 index 01ac91b4e6..7e959af786 100644 --- a/src/main/initGridCellsMod.F90 +++ b/src/main/initGridCellsMod.F90 @@ -293,7 +293,7 @@ subroutine set_landunit_veg_noncompete (ltype, gi, li, ci, pi) ! !USES use clm_instur, only : wt_lunit, wt_nat_patch use subgridMod, only : subgrid_get_info_natveg, natveg_patch_exists - use clm_varpar, only : numpft, maxpatch_pft, natpft_lb, natpft_ub + use clm_varpar, only : maxpatch_pft, natpft_lb, natpft_ub ! ! !ARGUMENTS: integer , intent(in) :: ltype ! landunit type diff --git a/src/main/readParamsMod.F90 b/src/main/readParamsMod.F90 index 4a57f8da43..710f29c31f 100644 --- a/src/main/readParamsMod.F90 +++ b/src/main/readParamsMod.F90 @@ -23,7 +23,7 @@ module readParamsMod contains !----------------------------------------------------------------------- - subroutine readParameters (nutrient_competition_method, photosyns_inst, canopyflux_inst) + subroutine readParameters (nutrient_competition_method, photosyns_inst) ! ! ! USES: use CNSharedParamsMod , only : CNParamsReadShared @@ -53,11 +53,10 @@ subroutine readParameters (nutrient_competition_method, photosyns_inst, canopyfl use NutrientCompetitionMethodMod , only : nutrient_competition_method_type use clm_varctl, only : NLFilename_in use PhotosynthesisMod , only : photosyns_type - use CanopyFluxesMod , only : canopyflux_type + ! ! !ARGUMENTS: type(photosyns_type) , intent(in) :: photosyns_inst - type(canopyflux_type) , intent(in) :: canopyflux_inst class(nutrient_competition_method_type), intent(in) :: nutrient_competition_method ! ! !LOCAL VARIABLES: From f79ff356dbb39451c8874be1754a2bec49cb1840 Mon Sep 17 00:00:00 2001 From: Sean Swenson Date: Wed, 15 Apr 2020 13:24:22 -0600 Subject: [PATCH 18/76] cleanly separate use_biomass_heat_storage cases --- src/biogeophys/BalanceCheckMod.F90 | 5 +- src/biogeophys/BareGroundFluxesMod.F90 | 6 +- src/biogeophys/CanopyFluxesMod.F90 | 30 +++++---- src/biogeophys/EnergyFluxType.F90 | 12 ++-- src/biogeophys/PhotosynthesisMod.F90 | 2 +- src/main/initGridCellsMod.F90 | 84 +++----------------------- src/main/pftconMod.F90 | 5 +- src/main/subgridMod.F90 | 9 ++- 8 files changed, 40 insertions(+), 113 deletions(-) diff --git a/src/biogeophys/BalanceCheckMod.F90 b/src/biogeophys/BalanceCheckMod.F90 index 02d53ced69..65620589fe 100644 --- a/src/biogeophys/BalanceCheckMod.F90 +++ b/src/biogeophys/BalanceCheckMod.F90 @@ -335,7 +335,7 @@ subroutine BalanceCheck( bounds, & qflx_sfc_irrig => waterflux_inst%qflx_sfc_irrig_col , & ! Input: [real(r8) (:) ] irrigation flux (mm H2O /s) qflx_glcice_dyn_water_flux => waterflux_inst%qflx_glcice_dyn_water_flux_col, & ! Input: [real(r8) (:)] water flux needed for balance check due to glc_dyn_runoff_routing (mm H2O/s) (positive means addition of water to the system) - hs_canopy => energyflux_inst%hs_canopy_patch , & ! Input: [real(r8) (:) ] change in heat content of stem (W/m**2) [+ to atm] + dhsdt_canopy => energyflux_inst%dhsdt_canopy_patch , & ! Input: [real(r8) (:) ] change in heat content of canopy (W/m**2) [+ to atm] eflx_lwrad_out => energyflux_inst%eflx_lwrad_out_patch , & ! Input: [real(r8) (:) ] emitted infrared (longwave) radiation (W/m**2) eflx_lwrad_net => energyflux_inst%eflx_lwrad_net_patch , & ! Input: [real(r8) (:) ] net infrared (longwave) rad (W/m**2) [+ = to atm] eflx_sh_tot => energyflux_inst%eflx_sh_tot_patch , & ! Input: [real(r8) (:) ] total sensible heat flux (W/m**2) [+ to atm] @@ -612,7 +612,7 @@ subroutine BalanceCheck( bounds, & if (.not. lun%urbpoi(l)) then errseb(p) = sabv(p) + sabg_chk(p) + forc_lwrad(c) - eflx_lwrad_out(p) & - - eflx_sh_tot(p) - eflx_lh_tot(p) - eflx_soil_grnd(p) - hs_canopy(p) + - eflx_sh_tot(p) - eflx_lh_tot(p) - eflx_soil_grnd(p) - dhsdt_canopy(p) else errseb(p) = sabv(p) + sabg(p) & - eflx_lwrad_net(p) & @@ -698,6 +698,7 @@ subroutine BalanceCheck( bounds, & write(iulog,*)'eflx_sh_tot = ' ,eflx_sh_tot(indexp) write(iulog,*)'eflx_lh_tot = ' ,eflx_lh_tot(indexp) write(iulog,*)'eflx_soil_grnd = ' ,eflx_soil_grnd(indexp) + write(iulog,*)'dhsdt_canopy = ' ,dhsdt_canopy(indexp) write(iulog,*)'fsa fsr = ' ,fsa(indexp), fsr(indexp) write(iulog,*)'fabd fabi = ' ,fabd(indexp,:), fabi(indexp,:) write(iulog,*)'albd albi = ' ,albd(indexp,:), albi(indexp,:) diff --git a/src/biogeophys/BareGroundFluxesMod.F90 b/src/biogeophys/BareGroundFluxesMod.F90 index 197897a917..1d62815948 100644 --- a/src/biogeophys/BareGroundFluxesMod.F90 +++ b/src/biogeophys/BareGroundFluxesMod.F90 @@ -144,8 +144,8 @@ subroutine BareGroundFluxes(bounds, num_noexposedvegp, filter_noexposedvegp, & real(r8) :: www ! surface soil wetness [-] !------------------------------------------------------------------------------ - associate( & - hs_canopy => energyflux_inst%hs_canopy_patch , & ! Output: [real(r8) (:) ] change in heat storage of stem (W/m**2) [+ to atm] + associate( & + dhsdt_canopy => energyflux_inst%dhsdt_canopy_patch , & ! Output: [real(r8) (:) ] change in heat storage of stem (W/m**2) [+ to atm] eflx_sh_stem => energyflux_inst%eflx_sh_stem_patch , & ! Output: [real(r8) (:) ] sensible heat flux from stems (W/m**2) [+ to atm] soilresis => soilstate_inst%soilresis_col , & ! Input: [real(r8) (:,:) ] evaporative soil resistance (s/m) snl => col%snl , & ! Input: [integer (:) ] number of snow layers @@ -288,7 +288,7 @@ subroutine BareGroundFluxes(bounds, num_noexposedvegp, filter_noexposedvegp, & displa(p) = 0._r8 dlrad(p) = 0._r8 ulrad(p) = 0._r8 - hs_canopy(p) = 0._r8 + dhsdt_canopy(p) = 0._r8 eflx_sh_stem(p) = 0._r8 ur(p) = max(1.0_r8,sqrt(forc_u(g)*forc_u(g)+forc_v(g)*forc_v(g))) diff --git a/src/biogeophys/CanopyFluxesMod.F90 b/src/biogeophys/CanopyFluxesMod.F90 index 90f96f94af..06e9b4c3cc 100644 --- a/src/biogeophys/CanopyFluxesMod.F90 +++ b/src/biogeophys/CanopyFluxesMod.F90 @@ -433,19 +433,18 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, SHR_ASSERT_ALL_FL((ubound(downreg_patch) == (/bounds%endp/)), sourcefile, __LINE__) SHR_ASSERT_ALL_FL((ubound(leafn_patch) == (/bounds%endp/)), sourcefile, __LINE__) - associate( & + associate( & t_stem => temperature_inst%t_stem_patch , & ! Output: [real(r8) (:) ] stem temperature (Kelvin) - hs_canopy => energyflux_inst%hs_canopy_patch , & ! Output: [real(r8) (:) ] change in heat storage of stem (W/m**2) [+ to atm] - soilresis => soilstate_inst%soilresis_col , & ! Input: [real(r8) (:) ] soil evaporative resistance - snl => col%snl , & ! Input: [integer (:) ] number of snow layers - dayl => grc%dayl , & ! Input: [real(r8) (:) ] daylength (s) - max_dayl => grc%max_dayl , & ! Input: [real(r8) (:) ] maximum daylength for this grid cell (s) - + dhsdt_canopy => energyflux_inst%dhsdt_canopy_patch , & ! Output: [real(r8) (:) ] change in heat storage of stem (W/m**2) [+ to atm] + soilresis => soilstate_inst%soilresis_col , & ! Input: [real(r8) (:) ] soil evaporative resistance + snl => col%snl , & ! Input: [integer (:) ] number of snow layers + dayl => grc%dayl , & ! Input: [real(r8) (:) ] daylength (s) + max_dayl => grc%max_dayl , & ! Input: [real(r8) (:) ] maximum daylength for this grid cell (s) dleaf => pftcon%dleaf , & ! Input: characteristic leaf dimension (m) dbh_param => pftcon%dbh , & ! Input: diameter at brest height (m) fbw => pftcon%fbw , & ! Input: fraction of biomass that is water nstem => pftcon%nstem , & ! Input: stem number density (#ind/m2) - rstem => pftcon%rstem , & ! Input: stem restistance per stem diameter (s/m**2) + rstem => pftcon%rstem , & ! Input: stem resistance per stem diameter (s/m**2) wood_density => pftcon%wood_density , & ! Input: dry wood density (kg/m3) forc_lwrad => atm2lnd_inst%forc_lwrad_downscaled_col , & ! Input: [real(r8) (:) ] downward infrared (longwave) radiation (W/m**2) @@ -579,7 +578,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ulrad => energyflux_inst%ulrad_patch , & ! Output: [real(r8) (:) ] upward longwave radiation above the canopy [W/m2] cgrnd => energyflux_inst%cgrnd_patch , & ! Output: [real(r8) (:) ] deriv. of soil energy flux wrt to soil temp [w/m2/k] eflx_sh_snow => energyflux_inst%eflx_sh_snow_patch , & ! Output: [real(r8) (:) ] sensible heat flux from snow (W/m**2) [+ to atm] - eflx_sh_h2osfc => energyflux_inst%eflx_sh_h2osfc_patch , & ! Output: [real(r8) (:) ] sensible heat flux from soil (W/m**2) [+ to atm] + eflx_sh_h2osfc => energyflux_inst%eflx_sh_h2osfc_patch , & ! Output: [real(r8) (:) ] sensible heat flux from surface water (W/m**2) [+ to atm] eflx_sh_soil => energyflux_inst%eflx_sh_soil_patch , & ! Output: [real(r8) (:) ] sensible heat flux from soil (W/m**2) [+ to atm] eflx_sh_stem => energyflux_inst%eflx_sh_stem_patch , & ! Output: [real(r8) (:) ] sensible heat flux from stems (W/m**2) [+ to atm] eflx_sh_veg => energyflux_inst%eflx_sh_veg_patch , & ! Output: [real(r8) (:) ] sensible heat flux from leaves (W/m**2) [+ to atm] @@ -676,7 +675,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, obuold(p) = 0._r8 btran(p) = btran0 btran2(p) = btran0 - hs_canopy(p) = 0._r8 + dhsdt_canopy(p) = 0._r8 eflx_sh_stem(p) = 0._r8 end do @@ -998,7 +997,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, !! Sakaguchi changes for stability formulation ends here - if (use_undercanopy_stability) then + if (use_biomass_heat_storage) then ! use uuc for ground fluxes (keep uaf for canopy terms) rah(p,2) = 1._r8/(csoilcn*uuc(p)) else @@ -1116,8 +1115,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, canopy_cond(p) = (laisun(p)/(rb(p)+rssun(p)) + laisha(p)/(rb(p)+rssha(p)))/max(elai(p), 0.01_r8) end if -! should be the same expression used in Photosynthesis/getqflx - efpot = forc_rho(c)*elai(p)/rb(p)*(qsatl(p)-qaf(p)) + efpot = forc_rho(c)*(elai(p)+esai(p))/rb(p)*(qsatl(p)-qaf(p)) h2ocan = liqcan(p) + snocan(p) ! When the hydraulic stress parameterization is active calculate rpp @@ -1159,7 +1157,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ! Moved the original subroutine in-line... wtaq = frac_veg_nosno(p)/raw(p,1) ! air - wtlq = frac_veg_nosno(p)*elai(p)/rb(p) * rpp ! leaf + wtlq = frac_veg_nosno(p)*(elai(p)+esai(p))/rb(p) * rpp ! leaf !Litter layer resistance. Added by K.Sakaguchi snow_depth_c = params_inst%z_dl ! critical depth for 100% litter burial by snow (=litter thickness) @@ -1239,7 +1237,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ! result in an imbalance in "hvap*qflx_evap_veg" and ! "efe + dc2*wtgaq*qsatdt_veg" - efpot = forc_rho(c)*elai(p)/rb(p) & + efpot = forc_rho(c)*(elai(p)+esai(p))/rb(p) & *(wtgaq*(qsatl(p)+qsatldT(p)*dt_veg(p)) & -wtgq0*qg(c)-wtaq0(p)*forc_q(c)) qflx_evap_veg(p) = rpp*efpot @@ -1381,7 +1379,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, dt_stem(p) = 0._r8 endif - hs_canopy(p) = dt_stem(p)*cp_stem(p)/dtime & + dhsdt_canopy(p) = dt_stem(p)*cp_stem(p)/dtime & +(t_veg(p)-tl_ini(p))*cp_veg(p)/dtime t_stem(p) = t_stem(p) + dt_stem(p) diff --git a/src/biogeophys/EnergyFluxType.F90 b/src/biogeophys/EnergyFluxType.F90 index 5d95b2e5a1..d58418ccac 100644 --- a/src/biogeophys/EnergyFluxType.F90 +++ b/src/biogeophys/EnergyFluxType.F90 @@ -103,7 +103,7 @@ module EnergyFluxType real(r8), pointer :: htvp_col (:) ! latent heat of vapor of water (or sublimation) [j/kg] ! Canopy heat - real(r8), pointer :: hs_canopy_patch (:) ! patch change in heat content of canopy (leaf+stem) (W/m**2) [+ to atm] + real(r8), pointer :: dhsdt_canopy_patch (:) ! patch change in heat content of canopy (leaf+stem) (W/m**2) [+ to atm] ! Balance Checks real(r8), pointer :: errsoi_patch (:) ! soil/lake energy conservation error (W/m**2) @@ -251,7 +251,7 @@ subroutine InitAllocate(this, bounds) allocate( this%htvp_col (begc:endc)) ; this%htvp_col (:) = nan - allocate( this%hs_canopy_patch (begp:endp)) ; this%hs_canopy_patch (:) = nan + allocate( this%dhsdt_canopy_patch (begp:endp)) ; this%dhsdt_canopy_patch (:) = nan allocate(this%rresis_patch (begp:endp,1:nlevgrnd)) ; this%rresis_patch (:,:) = nan allocate(this%btran_patch (begp:endp)) ; this%btran_patch (:) = nan @@ -445,10 +445,10 @@ subroutine InitHistory(this, bounds, is_simple_buildtemp) avgflag='A', long_name='sensible heat from stem', & ptr_patch=this%eflx_sh_stem_patch, c2l_scale_type='urbanf',default = 'inactive') - this%hs_canopy_patch(begp:endp) = spval - call hist_addfld1d (fname='HS_CANOPY', units='W/m^2', & - avgflag='A', long_name='heat change of stem', & - ptr_patch=this%hs_canopy_patch, set_lake=0._r8, c2l_scale_type='urbanf',default='inactive') + this%dhsdt_canopy_patch(begp:endp) = spval + call hist_addfld1d (fname='DHSDT_CANOPY', units='W/m^2', & + avgflag='A', long_name='change in canopy heat storage', & + ptr_patch=this%dhsdt_canopy_patch, set_lake=0._r8, c2l_scale_type='urbanf',default='inactive') this%eflx_sh_grnd_patch(begp:endp) = spval call hist_addfld1d (fname='FSH_G', units='W/m^2', & diff --git a/src/biogeophys/PhotosynthesisMod.F90 b/src/biogeophys/PhotosynthesisMod.F90 index 032ed9d5bc..a111cab156 100644 --- a/src/biogeophys/PhotosynthesisMod.F90 +++ b/src/biogeophys/PhotosynthesisMod.F90 @@ -4814,7 +4814,7 @@ subroutine getqflx(p,c,gb_mol,gs_mol_sun,gs_mol_sha,qflx_sun,qflx_sha,qsatl,qaf, cf = forc_pbot(c)/(rgas*1.e-3_r8*tgcm(p))*1.e6_r8 ! gb->gbmol conversion factor - wtl = elai(p)*gb_mol + wtl = (elai(p)+esai(p))*gb_mol efpot = forc_rho(c)*wtl*(qsatl-qaf) if (havegs) then diff --git a/src/main/initGridCellsMod.F90 b/src/main/initGridCellsMod.F90 index c1c13bcf95..d60e620a68 100644 --- a/src/main/initGridCellsMod.F90 +++ b/src/main/initGridCellsMod.F90 @@ -35,8 +35,7 @@ module initGridCellsMod public initGridcells ! initialize sub-grid gridcell mapping ! ! !PRIVATE MEMBER FUNCTIONS: - private set_landunit_veg_compete - private set_landunit_veg_noncompete + private set_landunit_veg private set_landunit_wet_lake private set_landunit_ice_mec private set_landunit_crop_noncompete @@ -136,13 +135,8 @@ subroutine initGridcells(glc_behavior) ! Determine naturally vegetated landunit do gdc = bounds_clump%begg,bounds_clump%endg - if(use_individual_pft_soil_column) then - call set_landunit_veg_noncompete( & - ltype=istsoil, gi=gdc, li=li, ci=ci, pi=pi) - else - call set_landunit_veg_compete( & - ltype=istsoil, gi=gdc, li=li, ci=ci, pi=pi) - end if + call set_landunit_veg( & + ltype=istsoil, gi=gdc, li=li, ci=ci, pi=pi) end do ! Determine crop landunit @@ -221,10 +215,10 @@ subroutine initGridcells(glc_behavior) end subroutine initGridcells !------------------------------------------------------------------------ - subroutine set_landunit_veg_compete (ltype, gi, li, ci, pi) + subroutine set_landunit_veg (ltype, gi, li, ci, pi) ! ! !DESCRIPTION: - ! Initialize vegetated landunit with competition + ! Initialize vegetated landunit ! ! !USES use clm_instur, only : wt_lunit, wt_nat_patch @@ -252,7 +246,7 @@ subroutine set_landunit_veg_compete (ltype, gi, li, ci, pi) ! Set decomposition properties call subgrid_get_info_natveg(gi, & - npatches=npatches, ncols=ncols, nlunits=nlunits, sesc=.FALSE.) + npatches=npatches, ncols=ncols, nlunits=nlunits) wtlunit2gcell = wt_lunit(gi, ltype) nlunits_added = 0 @@ -279,71 +273,7 @@ subroutine set_landunit_veg_compete (ltype, gi, li, ci, pi) SHR_ASSERT_FL(ncols_added == ncols, sourcefile, __LINE__) SHR_ASSERT_FL(npatches_added == npatches, sourcefile, __LINE__) - end subroutine set_landunit_veg_compete - - !------------------------------------------------------------------------ - subroutine set_landunit_veg_noncompete (ltype, gi, li, ci, pi) - ! - ! !DESCRIPTION: - ! Initialize vegetated landunit without competition (called if sesc switch - ! is true) - ! - ! !USES - use clm_instur, only : wt_lunit, wt_nat_patch - use subgridMod, only : subgrid_get_info_natveg, natveg_patch_exists - use clm_varpar, only : maxpatch_pft, natpft_lb, natpft_ub - ! - ! !ARGUMENTS: - integer , intent(in) :: ltype ! landunit type - integer , intent(in) :: gi ! gridcell index - integer , intent(inout) :: li ! landunit index - integer , intent(inout) :: ci ! column index - integer , intent(inout) :: pi ! patch index - ! - ! !LOCAL VARIABLES: - integer :: m ! index - integer :: npatches ! number of patches in landunit - integer :: ncols - integer :: nlunits - integer :: npatches_added ! number of patches actually added - integer :: ncols_added ! number of columns actually added - integer :: nlunits_added ! number of landunits actually added - real(r8) :: wtlunit2gcell ! landunit weight in gridcell - !------------------------------------------------------------------------ - - ! Set decomposition properties - - call subgrid_get_info_natveg(gi, & - npatches=npatches, ncols=ncols, nlunits=nlunits, sesc=.TRUE.) - wtlunit2gcell = wt_lunit(gi, ltype) - - nlunits_added = 0 - ncols_added = 0 - npatches_added = 0 - - if (nlunits > 0) then - call add_landunit(li=li, gi=gi, ltype=ltype, wtgcell=wtlunit2gcell) - nlunits_added = nlunits_added + 1 - - - do m = natpft_lb,natpft_ub - if (natveg_patch_exists(gi, m)) then - ! Assume one column for each vegetation patch - call add_column(ci=ci, li=li, ctype=1, wtlunit=wt_nat_patch(gi,m)) - ncols_added = ncols_added + 1 - - call add_patch(pi=pi, ci=ci, ptype=m, wtcol=1.0_r8) - npatches_added = npatches_added + 1 - end if - end do - end if - - SHR_ASSERT(nlunits_added == nlunits, errMsg(sourcefile, __LINE__)) - SHR_ASSERT(ncols_added == ncols, errMsg(sourcefile, __LINE__)) - SHR_ASSERT(npatches_added == npatches, errMsg(sourcefile, __LINE__)) - - end subroutine set_landunit_veg_noncompete - + end subroutine set_landunit_veg !------------------------------------------------------------------------ subroutine set_landunit_wet_lake (ltype, gi, li, ci, pi) diff --git a/src/main/pftconMod.F90 b/src/main/pftconMod.F90 index a9347e122e..b59d683627 100644 --- a/src/main/pftconMod.F90 +++ b/src/main/pftconMod.F90 @@ -149,7 +149,7 @@ module pftconMod real(r8), allocatable :: dbh (:) ! diameter at breast height (m) real(r8), allocatable :: fbw (:) ! fraction of biomass that is water real(r8), allocatable :: nstem (:) ! stem density (#/m2) - real(r8), allocatable :: rstem (:) ! stem resistance (s/m) + real(r8), allocatable :: rstem (:) ! stem resistance per dbh (s/m/m) real(r8), allocatable :: wood_density (:) ! wood density (kg/m3) ! crop @@ -1032,8 +1032,7 @@ subroutine InitRead(this) else this%dbh = 0.0 this%fbw = 0.0 - call ncd_io('nstem',this%nstem, 'read', ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + this%nstem = 0.1 this%rstem = 0.0 this%wood_density = 0.0 end if diff --git a/src/main/subgridMod.F90 b/src/main/subgridMod.F90 index 94b6068d19..f49ededca0 100644 --- a/src/main/subgridMod.F90 +++ b/src/main/subgridMod.F90 @@ -81,7 +81,7 @@ subroutine subgrid_get_gcellinfo (gi, glc_behavior, & nlunits = 0 ncohorts = 0 - call subgrid_get_info_natveg(gi, npatches_temp, ncols_temp, nlunits_temp, use_individual_pft_soil_column) + call subgrid_get_info_natveg(gi, npatches_temp, ncols_temp, nlunits_temp) call accumulate_counters() call subgrid_get_info_urban_tbd(gi, npatches_temp, ncols_temp, nlunits_temp) @@ -123,18 +123,17 @@ end subroutine accumulate_counters end subroutine subgrid_get_gcellinfo !----------------------------------------------------------------------- - subroutine subgrid_get_info_natveg(gi, npatches, ncols, nlunits, sesc) + subroutine subgrid_get_info_natveg(gi, npatches, ncols, nlunits) ! ! !DESCRIPTION: ! Obtain properties for natural vegetated landunit in this grid cell ! ! !USES use clm_varpar, only : natpft_lb, natpft_ub + use clm_varctl, only : use_individual_pft_soil_column ! ! !ARGUMENTS: integer, intent(in) :: gi ! grid cell index - logical, intent(in) :: sesc ! switch for separated soil columns of natural vegetation - integer, intent(out) :: npatches ! number of nat veg patches in this grid cell integer, intent(out) :: ncols ! number of nat veg columns in this grid cell integer, intent(out) :: nlunits ! number of nat veg landunits in this grid cell @@ -154,7 +153,7 @@ subroutine subgrid_get_info_natveg(gi, npatches, ncols, nlunits, sesc) end do if (npatches > 0) then - if(sesc) then + if(use_individual_pft_soil_column) then ! Assume one soil column for each patch ncols = npatches else From 017759d00377f423d8cd99770e08563c1f3d92db Mon Sep 17 00:00:00 2001 From: Sean Swenson Date: Tue, 21 Apr 2020 09:43:24 -0600 Subject: [PATCH 19/76] separate use_biomass_heat_storage case --- src/biogeophys/CanopyFluxesMod.F90 | 178 +++++++++++++++-------------- 1 file changed, 93 insertions(+), 85 deletions(-) diff --git a/src/biogeophys/CanopyFluxesMod.F90 b/src/biogeophys/CanopyFluxesMod.F90 index 06e9b4c3cc..99fa862d6b 100644 --- a/src/biogeophys/CanopyFluxesMod.F90 +++ b/src/biogeophys/CanopyFluxesMod.F90 @@ -407,6 +407,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, real(r8) :: dbh(bounds%begp:bounds%endp) !diameter at breast height of vegetation real(r8) :: cp_veg(bounds%begp:bounds%endp) !heat capacity of veg real(r8) :: cp_stem(bounds%begp:bounds%endp) !heat capacity of stems + real(r8) :: rstema(bounds%begp:bounds%endp) !stem resistance to heat transfer real(r8) :: dt_stem(bounds%begp:bounds%endp) !change in stem temperature real(r8) :: fstem(bounds%begp:bounds%endp) !fraction of stem real(r8) :: lw_stem(bounds%begp:bounds%endp) !internal longwave stem @@ -417,7 +418,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, real(r8) :: uuc(bounds%begp:bounds%endp) ! undercanopy windspeed real(r8) :: cp_wood real(r8) :: carea_stem - real(r8) :: rstema + ! biomass parameters real(r8), parameter :: k_vert = 0.1 !vertical distribution of stem real(r8), parameter :: k_cyl_vol = 1.0 !departure from cylindrical volume @@ -578,7 +579,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ulrad => energyflux_inst%ulrad_patch , & ! Output: [real(r8) (:) ] upward longwave radiation above the canopy [W/m2] cgrnd => energyflux_inst%cgrnd_patch , & ! Output: [real(r8) (:) ] deriv. of soil energy flux wrt to soil temp [w/m2/k] eflx_sh_snow => energyflux_inst%eflx_sh_snow_patch , & ! Output: [real(r8) (:) ] sensible heat flux from snow (W/m**2) [+ to atm] - eflx_sh_h2osfc => energyflux_inst%eflx_sh_h2osfc_patch , & ! Output: [real(r8) (:) ] sensible heat flux from surface water (W/m**2) [+ to atm] + eflx_sh_h2osfc => energyflux_inst%eflx_sh_h2osfc_patch , & ! Output: [real(r8) (:) ] sensible heat flux from soil (W/m**2) [+ to atm] eflx_sh_soil => energyflux_inst%eflx_sh_soil_patch , & ! Output: [real(r8) (:) ] sensible heat flux from soil (W/m**2) [+ to atm] eflx_sh_stem => energyflux_inst%eflx_sh_stem_patch , & ! Output: [real(r8) (:) ] sensible heat flux from stems (W/m**2) [+ to atm] eflx_sh_veg => energyflux_inst%eflx_sh_veg_patch , & ! Output: [real(r8) (:) ] sensible heat flux from leaves (W/m**2) [+ to atm] @@ -683,77 +684,82 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, do f = 1, fn p = filterp(f) - ! fraction of stem receiving incoming radiation - fstem(p) = (esai(p))/(elai(p)+esai(p)) - ! when elai = 0, do not multiply by k_vert (i.e. fstem = 1) - if(elai(p) > 0._r8) fstem(p) = k_vert * fstem(p) + if(use_biomass_heat_storage) then - ! if using Satellite Phenology mode, use values in parameter file - ! otherwise calculate dbh from stem biomass - if(.not. use_cn .or. .not. use_biomass_heat_storage) then - dbh(p) = dbh_param(patch%itype(p)) - else - dbh(p) = 2._r8 * sqrt(stem_biomass(p) * (1._r8 - fbw(patch%itype(p))) / ( shr_const_pi * htop(p) * k_cyl_vol & - * nstem(patch%itype(p)) * wood_density(patch%itype(p)))) - endif + ! fraction of stem receiving incoming radiation + fstem(p) = (esai(p))/(elai(p)+esai(p)) - ! leaf and stem surface area - sa_leaf(p) = elai(p) -! double in spirit of full surface area for sensible heat - sa_leaf(p) = 2.*sa_leaf(p) + ! when elai = 0, do not multiply by k_vert (i.e. fstem = 1) + if(elai(p) > 0._r8) fstem(p) = k_vert * fstem(p) - sa_stem(p) = nstem(patch%itype(p))*(htop(p)*shr_const_pi*dbh(p)) -! adjust for departure of cylindrical stem model - sa_stem(p) = k_cyl_area * sa_stem(p) + ! if using Satellite Phenology mode, use values in parameter file + ! otherwise calculate dbh from stem biomass + if(use_cn) then + dbh(p) = 2._r8 * sqrt(stem_biomass(p) * (1._r8 - fbw(patch%itype(p))) & + / ( shr_const_pi * htop(p) * k_cyl_vol & + * nstem(patch%itype(p)) * wood_density(patch%itype(p)))) + else + dbh(p) = dbh_param(patch%itype(p)) + endif - ! do not calculate separate leaf/stem heat capacity for grasses - if(patch%itype(p) > 11 .or. dbh(p) < min_stem_diameter) then - fstem(p) = 0.0 - sa_stem(p) = 0.0 - endif + ! leaf and stem surface area + sa_leaf(p) = elai(p) + ! double in spirit of full surface area for sensible heat + sa_leaf(p) = 2.*sa_leaf(p) + + sa_stem(p) = nstem(patch%itype(p))*(htop(p)*shr_const_pi*dbh(p)) + ! adjust for departure of cylindrical stem model + sa_stem(p) = k_cyl_area * sa_stem(p) - if(.not.use_biomass_heat_storage) then - fstem(p) = 0._r8 + ! do not calculate separate leaf/stem heat capacity for grasses + ! or other pfts if dbh is below minimum value + if(patch%itype(p) > 11 .or. dbh(p) < min_stem_diameter) then + fstem(p) = 0.0 + sa_stem(p) = 0.0 + endif + + ! cross-sectional area of stems + carea_stem = shr_const_pi * (dbh(p)*0.5)**2 + + ! if using Satellite Phenology mode, calculate leaf and stem biomass + if(.not. use_cn) then + ! boreal needleleaf lma*c2b ~ 0.25 kg dry mass/m2(leaf) + leaf_biomass(p) = 0.25_r8 * max(0.01_r8, sa_leaf(p)) & + / (1.-fbw(patch%itype(p))) + stem_biomass(p) = carea_stem * htop(p) * k_cyl_vol & + * nstem(patch%itype(p)) * wood_density(patch%itype(p)) & + /(1.-fbw(patch%itype(p))) + endif + + ! internal longwave fluxes between leaf and stem + ! (use same area of interaction i.e. ignore leaf <-> leaf) + sa_internal(p) = min(sa_leaf(p),sa_stem(p)) + sa_internal(p) = k_internal * sa_internal(p) + + ! calculate specify heat capacity of vegetation + ! as weighted averaged of dry biomass and water + ! lma_dry has units of kg dry mass/m2 here (table 2 of bonan 2017) + ! cdry_biomass = 1400 J/kg/K, cwater = 4188 J/kg/K + cp_veg(p) = leaf_biomass(p) * (1400._r8*(1.-fbw(patch%itype(p))) + (fbw(patch%itype(p)))*4188._r8) + + ! cp-stem will have units J/k/ground_area + cp_stem(p) = stem_biomass(p) * (1400._r8*(1.-fbw(patch%itype(p))) + (fbw(patch%itype(p)))*4188._r8) + ! adjust for departure from cylindrical stem model + cp_stem(p) = k_cyl_vol * cp_stem(p) + + ! resistance between internal stem temperature and canopy air + rstema(p) = rstem(patch%itype(p))*dbh(p) + else + ! use_biomass_heat_storage .false. + fstem(p) = 0._r8 sa_stem(p) = 0._r8 sa_leaf(p) = (elai(p)+esai(p)) - endif - - ! cross-sectional area of stems - carea_stem = shr_const_pi * (dbh(p)*0.5)**2 - - ! if using Satellite Phenology mode, calculate leaf and stem - ! biomass - if(.not. use_cn) then - ! boreal needleleaf lma*c2b ~ 0.25 kg dry mass/m2(leaf) - leaf_biomass(p) = 0.25_r8 * max(0.01_r8, sa_leaf(p)) & - / (1.-fbw(patch%itype(p))) - stem_biomass(p) = carea_stem * htop(p) * k_cyl_vol & - * nstem(patch%itype(p)) * wood_density(patch%itype(p)) & - /(1.-fbw(patch%itype(p))) - endif - -! internal longwave fluxes between leaf and stem -! surface area term must be equal, remainder cancels -! (use same area of interaction i.e. ignore leaf <-> leaf) - sa_internal(p) = min(sa_leaf(p),sa_stem(p)) - sa_internal(p) = k_internal * sa_internal(p) - -! calculate specify heat capacity of vegetation -! as weighted averaged of dry biomass and water -! lma_dry has units of kg dry mass /m2 here (table 2 of bonan 2017) -! cdry_biomass = 1400 J/kg/K, cwater = 4188 J/kg/K - cp_veg(p) = leaf_biomass(p) * (1400._r8*(1.-fbw(patch%itype(p))) + (fbw(patch%itype(p)))*4188._r8) - -! use non-zero, but small, heat capacity - if(.not.use_biomass_heat_storage) then + sa_internal(p) = 0._r8 cp_veg(p) = 0._r8 + cp_stem(p) = 0._r8 + rstema(p) = 0._r8 endif - -! cp-stem will have units J/k/ground_area - cp_stem(p) = stem_biomass(p) * (1400._r8*(1.-fbw(patch%itype(p))) + (fbw(patch%itype(p)))*4188._r8) - -! adjust for departure from cylindrical stem model - cp_stem(p) = k_cyl_vol * cp_stem(p) + enddo ! calculate daylength control for Vcmax @@ -984,20 +990,11 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ri = ( grav*htop(p) * (taf(p) - t_grnd(c)) ) / (taf(p) * uaf(p) **2.00_r8) - !! modify csoilc value (0.004) if the under-canopy is in stable condition - - if (use_undercanopy_stability .and. (taf(p) - t_grnd(c) ) > 0._r8) then - ! decrease the value of csoilc by dividing it with (1+gamma*min(S, 10.0)) - ! ria ("gmanna" in Sakaguchi&Zeng, 2008) is a constant (=0.5) - ricsoilc = params_inst%csoilc / (1.00_r8 + ria*min( ri, 10.0_r8) ) - csoilcn = csoilb*w + ricsoilc*(1._r8-w) - else - csoilcn = csoilb*w + params_inst%csoilc*(1._r8-w) - end if + csoilcn = csoilb*w + params_inst%csoilc*(1._r8-w) !! Sakaguchi changes for stability formulation ends here - if (use_biomass_heat_storage) then + if (use_undercanopy_stability) then ! use uuc for ground fluxes (keep uaf for canopy terms) rah(p,2) = 1._r8/(csoilcn*uuc(p)) else @@ -1079,14 +1076,10 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ! Sensible heat conductance for air, leaf and ground ! Moved the original subroutine in-line... - wta = 1._r8/rah(p,1) ! air + wta = 1._r8/rah(p,1) ! air wtl = sa_leaf(p)/rb(p) ! leaf - wtg(p) = 1._r8/rah(p,2) ! ground - ! wtstem = sa_stem(p)/rb(p) ! stem - ! add resistance between internal stem temperature and canopy air - rstema = rstem(patch%itype(p))*dbh(p) - - wtstem = sa_stem(p)/(rstema + rb(p)) ! stem + wtg(p) = 1._r8/rah(p,2) ! ground + wtstem = sa_stem(p)/(rstema(p) + rb(p)) ! stem wtshi = 1._r8/(wta+wtl+wtstem+wtg(p)) @@ -1099,9 +1092,9 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, wtal(p) = wta0(p)+wtl0(p)+wtstem0(p) ! air + leaf + stem ! internal longwave fluxes between leaf and stem - lw_stem(p) = sa_internal(p) * emv(p) * sb*t_stem(p)**4 - lw_leaf(p) = sa_internal(p) * emv(p) * sb*t_veg(p)**4 - + lw_stem(p) = sa_internal(p) * emv(p) * sb * t_stem(p)**4 + lw_leaf(p) = sa_internal(p) * emv(p) * sb * t_veg(p)**4 + ! Fraction of potential evaporation from leaf if (fdry(p) > 0._r8) then @@ -1115,6 +1108,8 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, canopy_cond(p) = (laisun(p)/(rb(p)+rssun(p)) + laisha(p)/(rb(p)+rssha(p)))/max(elai(p), 0.01_r8) end if +! should be the same expression used in Photosynthesis/getqflx +!scs efpot = forc_rho(c)*elai(p)/rb(p)*(qsatl(p)-qaf(p)) efpot = forc_rho(c)*(elai(p)+esai(p))/rb(p)*(qsatl(p)-qaf(p)) h2ocan = liqcan(p) + snocan(p) @@ -1157,6 +1152,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ! Moved the original subroutine in-line... wtaq = frac_veg_nosno(p)/raw(p,1) ! air +!scs wtlq = frac_veg_nosno(p)*elai(p)/rb(p) * rpp ! leaf wtlq = frac_veg_nosno(p)*(elai(p)+esai(p))/rb(p) * rpp ! leaf !Litter layer resistance. Added by K.Sakaguchi @@ -1237,6 +1233,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ! result in an imbalance in "hvap*qflx_evap_veg" and ! "efe + dc2*wtgaq*qsatdt_veg" +!scs efpot = forc_rho(c)*elai(p)/rb(p) & efpot = forc_rho(c)*(elai(p)+esai(p))/rb(p) & *(wtgaq*(qsatl(p)+qsatldT(p)*dt_veg(p)) & -wtgq0*qg(c)-wtaq0(p)*forc_q(c)) @@ -1366,6 +1363,17 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, - lw_leaf(p) + lw_stem(p) - eflx_sh_veg(p) - hvap*qflx_evap_veg(p) & - ((t_veg(p)-tl_ini(p))*cp_veg(p)/dtime) + !scs +! if (abs(err(p)) > 1e6) then +! write(iulog,*) 'canerrchk: ', lw_leaf(p), lw_stem(p), dt_veg(p) +! write(iulog,*) 'canerrchk: ', (1.-fstem(p))*(sabv(p) + air(p) + bir(p)*tlbef(p)**3 & +! *(tlbef(p) + 4._r8*dt_veg(p)) + cir(p)*lw_grnd), & +! lw_leaf(p),lw_stem(p),eflx_sh_veg(p),hvap*qflx_evap_veg(p), & +! t_veg(p),tl_ini(p),dt_veg(p),cp_veg(p),cp_stem(p) +! endif + + + ! Update stem temperature; adjust outgoing longwave ! does not account for changes in SH or internal LW, ! as that would change result for t_veg above From 8ae8063757f367dc67b591c3a6399abd3a2802f1 Mon Sep 17 00:00:00 2001 From: Sean Swenson Date: Wed, 22 Apr 2020 09:03:10 -0600 Subject: [PATCH 20/76] change variable names --- src/biogeophys/CanopyFluxesMod.F90 | 65 ++++++++++++++---------------- src/main/pftconMod.F90 | 10 ++--- 2 files changed, 36 insertions(+), 39 deletions(-) diff --git a/src/biogeophys/CanopyFluxesMod.F90 b/src/biogeophys/CanopyFluxesMod.F90 index 99fa862d6b..43f8a3d3d0 100644 --- a/src/biogeophys/CanopyFluxesMod.F90 +++ b/src/biogeophys/CanopyFluxesMod.F90 @@ -405,19 +405,18 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, logical :: is_end_day ! is end of current day real(r8) :: dbh(bounds%begp:bounds%endp) !diameter at breast height of vegetation - real(r8) :: cp_veg(bounds%begp:bounds%endp) !heat capacity of veg + real(r8) :: cp_leaf(bounds%begp:bounds%endp) !heat capacity of leaves real(r8) :: cp_stem(bounds%begp:bounds%endp) !heat capacity of stems - real(r8) :: rstema(bounds%begp:bounds%endp) !stem resistance to heat transfer + real(r8) :: rstem(bounds%begp:bounds%endp) !stem resistance to heat transfer real(r8) :: dt_stem(bounds%begp:bounds%endp) !change in stem temperature - real(r8) :: fstem(bounds%begp:bounds%endp) !fraction of stem + real(r8) :: frac_rad_abs_by_stem(bounds%begp:bounds%endp) !fraction of incoming radiation absorbed by stems real(r8) :: lw_stem(bounds%begp:bounds%endp) !internal longwave stem real(r8) :: lw_leaf(bounds%begp:bounds%endp) !internal longwave leaf real(r8) :: sa_stem(bounds%begp:bounds%endp) !surface area stem m2/m2_ground real(r8) :: sa_leaf(bounds%begp:bounds%endp) !surface area leaf m2/m2_ground real(r8) :: sa_internal(bounds%begp:bounds%endp) !min(sa_stem,sa_leaf) real(r8) :: uuc(bounds%begp:bounds%endp) ! undercanopy windspeed - real(r8) :: cp_wood - real(r8) :: carea_stem + real(r8) :: carea_stem !cross-sectional area of stem ! biomass parameters real(r8), parameter :: k_vert = 0.1 !vertical distribution of stem @@ -425,8 +424,6 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, real(r8), parameter :: k_cyl_area = 1.0 !departure from cylindrical area real(r8), parameter :: k_internal = 0.0 !self-absorbtion of leaf/stem longwave real(r8), parameter :: min_stem_diameter = 0.01!minimum stem diameter for which to calculate stem interactions - - integer :: dummy_to_make_pgi_happy !------------------------------------------------------------------------------ @@ -445,11 +442,11 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, dbh_param => pftcon%dbh , & ! Input: diameter at brest height (m) fbw => pftcon%fbw , & ! Input: fraction of biomass that is water nstem => pftcon%nstem , & ! Input: stem number density (#ind/m2) - rstem => pftcon%rstem , & ! Input: stem resistance per stem diameter (s/m**2) + rstem_per_dbh => pftcon%rstem_per_dbh , & ! Input: stem resistance per stem diameter (s/m**2) wood_density => pftcon%wood_density , & ! Input: dry wood density (kg/m3) forc_lwrad => atm2lnd_inst%forc_lwrad_downscaled_col , & ! Input: [real(r8) (:) ] downward infrared (longwave) radiation (W/m**2) - forc_q => wateratm2lndbulk_inst%forc_q_downscaled_col , & ! Input: [real(r8) (:) ] atmospheric specific humidity (kg/kg) + forc_q => wateratm2lndbulk_inst%forc_q_downscaled_col , & ! Input: [real(r8) (:) ] atmospheric specific humidity (kg/kg) forc_pbot => atm2lnd_inst%forc_pbot_downscaled_col , & ! Input: [real(r8) (:) ] atmospheric pressure (Pa) forc_th => atm2lnd_inst%forc_th_downscaled_col , & ! Input: [real(r8) (:) ] atmospheric potential temperature (Kelvin) forc_rho => atm2lnd_inst%forc_rho_downscaled_col , & ! Input: [real(r8) (:) ] density (kg/m**3) @@ -687,10 +684,10 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, if(use_biomass_heat_storage) then ! fraction of stem receiving incoming radiation - fstem(p) = (esai(p))/(elai(p)+esai(p)) + frac_rad_abs_by_stem(p) = (esai(p))/(elai(p)+esai(p)) - ! when elai = 0, do not multiply by k_vert (i.e. fstem = 1) - if(elai(p) > 0._r8) fstem(p) = k_vert * fstem(p) + ! when elai = 0, do not multiply by k_vert (i.e. frac_rad_abs_by_stem = 1) + if(elai(p) > 0._r8) frac_rad_abs_by_stem(p) = k_vert * frac_rad_abs_by_stem(p) ! if using Satellite Phenology mode, use values in parameter file ! otherwise calculate dbh from stem biomass @@ -714,7 +711,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ! do not calculate separate leaf/stem heat capacity for grasses ! or other pfts if dbh is below minimum value if(patch%itype(p) > 11 .or. dbh(p) < min_stem_diameter) then - fstem(p) = 0.0 + frac_rad_abs_by_stem(p) = 0.0 sa_stem(p) = 0.0 endif @@ -740,7 +737,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ! as weighted averaged of dry biomass and water ! lma_dry has units of kg dry mass/m2 here (table 2 of bonan 2017) ! cdry_biomass = 1400 J/kg/K, cwater = 4188 J/kg/K - cp_veg(p) = leaf_biomass(p) * (1400._r8*(1.-fbw(patch%itype(p))) + (fbw(patch%itype(p)))*4188._r8) + cp_leaf(p) = leaf_biomass(p) * (1400._r8*(1.-fbw(patch%itype(p))) + (fbw(patch%itype(p)))*4188._r8) ! cp-stem will have units J/k/ground_area cp_stem(p) = stem_biomass(p) * (1400._r8*(1.-fbw(patch%itype(p))) + (fbw(patch%itype(p)))*4188._r8) @@ -748,16 +745,16 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, cp_stem(p) = k_cyl_vol * cp_stem(p) ! resistance between internal stem temperature and canopy air - rstema(p) = rstem(patch%itype(p))*dbh(p) + rstem(p) = rstem_per_dbh(patch%itype(p))*dbh(p) else ! use_biomass_heat_storage .false. - fstem(p) = 0._r8 + frac_rad_abs_by_stem(p) = 0._r8 sa_stem(p) = 0._r8 sa_leaf(p) = (elai(p)+esai(p)) sa_internal(p) = 0._r8 - cp_veg(p) = 0._r8 + cp_leaf(p) = 0._r8 cp_stem(p) = 0._r8 - rstema(p) = 0._r8 + rstem(p) = 0._r8 endif enddo @@ -1079,7 +1076,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, wta = 1._r8/rah(p,1) ! air wtl = sa_leaf(p)/rb(p) ! leaf wtg(p) = 1._r8/rah(p,2) ! ground - wtstem = sa_stem(p)/(rstema(p) + rb(p)) ! stem + wtstem = sa_stem(p)/(rstem(p) + rb(p)) ! stem wtshi = 1._r8/(wta+wtl+wtstem+wtg(p)) @@ -1202,13 +1199,13 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, +(1._r8-frac_sno(c)-frac_h2osfc(c))*t_soisno(c,1)**4 & +frac_h2osfc(c)*t_h2osfc(c)**4) - dt_veg(p) = ((1.-fstem(p))*(sabv(p) + air(p) & + dt_veg(p) = ((1.-frac_rad_abs_by_stem(p))*(sabv(p) + air(p) & + bir(p)*t_veg(p)**4 + cir(p)*lw_grnd) & - efsh - efe(p) - lw_leaf(p) + lw_stem(p) & - - (cp_veg(p)/dtime)*(t_veg(p) - tl_ini(p))) & - / ((1.-fstem(p))*(- 4._r8*bir(p)*t_veg(p)**3) & + - (cp_leaf(p)/dtime)*(t_veg(p) - tl_ini(p))) & + / ((1.-frac_rad_abs_by_stem(p))*(- 4._r8*bir(p)*t_veg(p)**3) & + 4._r8*sa_internal(p)*emv(p)*sb*t_veg(p)**3 & - +dc1*wtga(p) +dc2*wtgaq*qsatldT(p) + cp_veg(p)/dtime) + +dc1*wtga(p) +dc2*wtgaq*qsatldT(p) + cp_leaf(p)/dtime) t_veg(p) = tlbef(p) + dt_veg(p) @@ -1218,14 +1215,14 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, if (del(p) > delmax) then dt_veg(p) = delmax*dels/del(p) t_veg(p) = tlbef(p) + dt_veg(p) - err(p) = (1.-fstem(p))*(sabv(p) + air(p) & + err(p) = (1.-frac_rad_abs_by_stem(p))*(sabv(p) + air(p) & + bir(p)*tlbef(p)**3*(tlbef(p) + & 4._r8*dt_veg(p)) + cir(p)*lw_grnd) & -sa_internal(p)*emv(p)*sb*tlbef(p)**3*(tlbef(p) + 4._r8*dt_veg(p)) & + lw_stem(p) & - (efsh + dc1*wtga(p)*dt_veg(p)) - (efe(p) + & dc2*wtgaq*qsatldT(p)*dt_veg(p)) & - - (cp_veg(p)/dtime)*(t_veg(p) - tl_ini(p)) + - (cp_leaf(p)/dtime)*(t_veg(p) - tl_ini(p)) end if ! Fluxes from leaves to canopy space @@ -1358,18 +1355,18 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, +(1._r8-frac_sno(c)-frac_h2osfc(c))*t_soisno(c,1)**4 & +frac_h2osfc(c)*t_h2osfc(c)**4) - err(p) = (1.-fstem(p))*(sabv(p) + air(p) + bir(p)*tlbef(p)**3 & + err(p) = (1.-frac_rad_abs_by_stem(p))*(sabv(p) + air(p) + bir(p)*tlbef(p)**3 & *(tlbef(p) + 4._r8*dt_veg(p)) + cir(p)*lw_grnd) & - lw_leaf(p) + lw_stem(p) - eflx_sh_veg(p) - hvap*qflx_evap_veg(p) & - - ((t_veg(p)-tl_ini(p))*cp_veg(p)/dtime) + - ((t_veg(p)-tl_ini(p))*cp_leaf(p)/dtime) !scs ! if (abs(err(p)) > 1e6) then ! write(iulog,*) 'canerrchk: ', lw_leaf(p), lw_stem(p), dt_veg(p) -! write(iulog,*) 'canerrchk: ', (1.-fstem(p))*(sabv(p) + air(p) + bir(p)*tlbef(p)**3 & +! write(iulog,*) 'canerrchk: ', (1.-frac_rad_abs_by_stem(p))*(sabv(p) + air(p) + bir(p)*tlbef(p)**3 & ! *(tlbef(p) + 4._r8*dt_veg(p)) + cir(p)*lw_grnd), & ! lw_leaf(p),lw_stem(p),eflx_sh_veg(p),hvap*qflx_evap_veg(p), & -! t_veg(p),tl_ini(p),dt_veg(p),cp_veg(p),cp_stem(p) +! t_veg(p),tl_ini(p),dt_veg(p),cp_leaf(p),cp_stem(p) ! endif @@ -1379,16 +1376,16 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ! as that would change result for t_veg above if (use_biomass_heat_storage) then if (stem_biomass(p) > 0._r8) then - dt_stem(p) = (fstem(p)*(sabv(p) + air(p) + bir(p)*ts_ini(p)**4 & + dt_stem(p) = (frac_rad_abs_by_stem(p)*(sabv(p) + air(p) + bir(p)*ts_ini(p)**4 & + cir(p)*lw_grnd) - eflx_sh_stem(p) & + lw_leaf(p)- lw_stem(p))/(cp_stem(p)/dtime & - - fstem(p)*bir(p)*4.*ts_ini(p)**3) + - frac_rad_abs_by_stem(p)*bir(p)*4.*ts_ini(p)**3) else dt_stem(p) = 0._r8 endif dhsdt_canopy(p) = dt_stem(p)*cp_stem(p)/dtime & - +(t_veg(p)-tl_ini(p))*cp_veg(p)/dtime + +(t_veg(p)-tl_ini(p))*cp_leaf(p)/dtime t_stem(p) = t_stem(p) + dt_stem(p) else @@ -1477,12 +1474,12 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ! Downward longwave radiation below the canopy dlrad(p) = (1._r8-emv(p))*emg(c)*forc_lwrad(c) + & - emv(p)*emg(c)*sb*(tlbef(p)**3*(tlbef(p) + 4._r8*dt_veg(p))*(1.-fstem(p))+ts_ini(p)**3*(ts_ini(p) + 4._r8*dt_stem(p))*fstem(p)) + emv(p)*emg(c)*sb*(tlbef(p)**3*(tlbef(p) + 4._r8*dt_veg(p))*(1.-frac_rad_abs_by_stem(p))+ts_ini(p)**3*(ts_ini(p) + 4._r8*dt_stem(p))*frac_rad_abs_by_stem(p)) ! Upward longwave radiation above the canopy ulrad(p) = ((1._r8-emg(c))*(1._r8-emv(p))*(1._r8-emv(p))*forc_lwrad(c) & - + emv(p)*(1._r8+(1._r8-emg(c))*(1._r8-emv(p)))*sb*((1.-fstem(p))*tlbef(p)**3*(tlbef(p) + 4._r8*dt_veg(p))+fstem(p)*ts_ini(p)**3*(ts_ini(p) + 4._r8*dt_stem(p))) + emg(c)*(1._r8-emv(p))*sb*lw_grnd) + + emv(p)*(1._r8+(1._r8-emg(c))*(1._r8-emv(p)))*sb*((1.-frac_rad_abs_by_stem(p))*tlbef(p)**3*(tlbef(p) + 4._r8*dt_veg(p))+frac_rad_abs_by_stem(p)*ts_ini(p)**3*(ts_ini(p) + 4._r8*dt_stem(p))) + emg(c)*(1._r8-emv(p))*sb*lw_grnd) ! Calculate the skin temperature as a weighted sum of all the ground and vegetated fraction diff --git a/src/main/pftconMod.F90 b/src/main/pftconMod.F90 index b59d683627..e5b3d5c564 100644 --- a/src/main/pftconMod.F90 +++ b/src/main/pftconMod.F90 @@ -149,7 +149,7 @@ module pftconMod real(r8), allocatable :: dbh (:) ! diameter at breast height (m) real(r8), allocatable :: fbw (:) ! fraction of biomass that is water real(r8), allocatable :: nstem (:) ! stem density (#/m2) - real(r8), allocatable :: rstem (:) ! stem resistance per dbh (s/m/m) + real(r8), allocatable :: rstem_per_dbh (:) ! stem resistance per dbh (s/m/m) real(r8), allocatable :: wood_density (:) ! wood density (kg/m3) ! crop @@ -470,7 +470,7 @@ subroutine InitAllocate (this) allocate( this%dbh (0:mxpft) ) allocate( this%fbw (0:mxpft) ) allocate( this%nstem (0:mxpft) ) - allocate( this%rstem (0:mxpft) ) + allocate( this%rstem_per_dbh (0:mxpft) ) allocate( this%wood_density (0:mxpft) ) end subroutine InitAllocate @@ -1025,7 +1025,7 @@ subroutine InitRead(this) if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) call ncd_io('nstem',this%nstem, 'read', ncid, readvar=readv) if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - call ncd_io('rstem',this%rstem, 'read', ncid, readvar=readv) + call ncd_io('rstem',this%rstem_per_dbh, 'read', ncid, readvar=readv) if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) call ncd_io('wood_density',this%wood_density, 'read', ncid, readvar=readv) if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) @@ -1033,7 +1033,7 @@ subroutine InitRead(this) this%dbh = 0.0 this%fbw = 0.0 this%nstem = 0.1 - this%rstem = 0.0 + this%rstem_per_dbh = 0.0 this%wood_density = 0.0 end if @@ -1422,7 +1422,7 @@ subroutine Clean(this) deallocate( this%dbh) deallocate( this%fbw) deallocate( this%nstem) - deallocate( this%rstem) + deallocate( this%rstem_per_dbh) deallocate( this%wood_density) end subroutine Clean From e00a604d1b34b9e1bc0e0236427fa1282b47ae88 Mon Sep 17 00:00:00 2001 From: Sean Swenson Date: Fri, 22 May 2020 09:50:45 -0600 Subject: [PATCH 21/76] back out one column per patch changes --- bld/CLMBuildNamelist.pm | 9 --------- bld/namelist_files/namelist_defaults_ctsm.xml | 3 --- bld/namelist_files/namelist_definition_ctsm.xml | 5 ----- src/main/clm_varctl.F90 | 6 ------ src/main/controlMod.F90 | 4 ---- src/main/initGridCellsMod.F90 | 12 ++++++------ src/main/lnd2glcMod.F90 | 4 +--- src/main/subgridMod.F90 | 12 +++--------- 8 files changed, 10 insertions(+), 45 deletions(-) diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index e2909f1b14..bf0e094f15 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -1504,7 +1504,6 @@ sub process_namelist_inline_logic { setup_logic_subgrid($opts, $nl_flags, $definition, $defaults, $nl); setup_logic_fertilizer($opts, $nl_flags, $definition, $defaults, $nl); setup_logic_grainproduct($opts, $nl_flags, $definition, $defaults, $nl, $physv); - setup_logic_pftsoilcolumn($opts, $nl_flags, $definition, $defaults, $nl); setup_logic_soilstate($opts, $nl_flags, $definition, $defaults, $nl); setup_logic_demand($opts, $nl_flags, $definition, $defaults, $nl); setup_logic_surface_dataset($opts, $nl_flags, $definition, $defaults, $nl); @@ -2078,14 +2077,6 @@ sub error_if_set { } } - -#------------------------------------------------------------------------------- -sub setup_logic_pftsoilcolumn { - my ($opts, $nl_flags, $definition, $defaults, $nl, $physv) = @_; - - add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'use_individual_pft_soil_column'); -} - #------------------------------------------------------------------------------- sub setup_logic_soilstate { diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index 58648de067..4a9cc3f25b 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -134,9 +134,6 @@ attributes from the config_cache.xml file (with keys converted to upper-case). .true. .false. - -.false. - 1 0 diff --git a/bld/namelist_files/namelist_definition_ctsm.xml b/bld/namelist_files/namelist_definition_ctsm.xml index f46c56c464..dd98f7e4f3 100644 --- a/bld/namelist_files/namelist_definition_ctsm.xml +++ b/bld/namelist_files/namelist_definition_ctsm.xml @@ -144,11 +144,6 @@ specify spatially variable soil thickness. If not present, use bottom of soil column (nlevsoi). - -If TRUE, each pft exists on a separate soil column. - - Index of rooting profile for water diff --git a/src/main/clm_varctl.F90 b/src/main/clm_varctl.F90 index 1fd0335fe3..f65a6b96e9 100644 --- a/src/main/clm_varctl.F90 +++ b/src/main/clm_varctl.F90 @@ -268,12 +268,6 @@ module clm_varctl logical, public :: use_biomass_heat_storage = .false. ! true => include biomass heat storage in canopy energy budget - !---------------------------------------------------------- - ! each pft has individual soil column switch - !---------------------------------------------------------- - - logical, public :: use_individual_pft_soil_column = .false. ! true => each pft exists on its own soil column - !---------------------------------------------------------- ! bedrock / soil depth switch !---------------------------------------------------------- diff --git a/src/main/controlMod.F90 b/src/main/controlMod.F90 index e2773ffe93..f787726b38 100644 --- a/src/main/controlMod.F90 +++ b/src/main/controlMod.F90 @@ -242,8 +242,6 @@ subroutine control_init( ) namelist /clm_inparm/ use_biomass_heat_storage - namelist /clm_inparm/ use_individual_pft_soil_column - namelist /clm_inparm/ use_hydrstress namelist /clm_inparm/ use_dynroot @@ -747,8 +745,6 @@ subroutine control_spmd() call mpi_bcast (use_biomass_heat_storage, 1, MPI_LOGICAL, 0, mpicom, ier) - call mpi_bcast (use_individual_pft_soil_column, 1, MPI_LOGICAL, 0, mpicom, ier) - call mpi_bcast (use_hydrstress, 1, MPI_LOGICAL, 0, mpicom, ier) call mpi_bcast (use_dynroot, 1, MPI_LOGICAL, 0, mpicom, ier) diff --git a/src/main/initGridCellsMod.F90 b/src/main/initGridCellsMod.F90 index d60e620a68..6fd96ed188 100644 --- a/src/main/initGridCellsMod.F90 +++ b/src/main/initGridCellsMod.F90 @@ -35,7 +35,7 @@ module initGridCellsMod public initGridcells ! initialize sub-grid gridcell mapping ! ! !PRIVATE MEMBER FUNCTIONS: - private set_landunit_veg + private set_landunit_veg_compete private set_landunit_wet_lake private set_landunit_ice_mec private set_landunit_crop_noncompete @@ -60,7 +60,7 @@ subroutine initGridcells(glc_behavior) use subgridWeightsMod , only : compute_higher_order_weights use landunit_varcon , only : istsoil, istwet, istdlak, istice_mec use landunit_varcon , only : isturb_tbd, isturb_hd, isturb_md, istcrop - use clm_varctl , only : use_fates,use_individual_pft_soil_column + use clm_varctl , only : use_fates use shr_const_mod , only : SHR_CONST_PI ! ! !ARGUMENTS: @@ -135,7 +135,7 @@ subroutine initGridcells(glc_behavior) ! Determine naturally vegetated landunit do gdc = bounds_clump%begg,bounds_clump%endg - call set_landunit_veg( & + call set_landunit_veg_compete( & ltype=istsoil, gi=gdc, li=li, ci=ci, pi=pi) end do @@ -215,10 +215,10 @@ subroutine initGridcells(glc_behavior) end subroutine initGridcells !------------------------------------------------------------------------ - subroutine set_landunit_veg (ltype, gi, li, ci, pi) + subroutine set_landunit_veg_compete (ltype, gi, li, ci, pi) ! ! !DESCRIPTION: - ! Initialize vegetated landunit + ! Initialize vegetated landunit with competition ! ! !USES use clm_instur, only : wt_lunit, wt_nat_patch @@ -273,7 +273,7 @@ subroutine set_landunit_veg (ltype, gi, li, ci, pi) SHR_ASSERT_FL(ncols_added == ncols, sourcefile, __LINE__) SHR_ASSERT_FL(npatches_added == npatches, sourcefile, __LINE__) - end subroutine set_landunit_veg + end subroutine set_landunit_veg_compete !------------------------------------------------------------------------ subroutine set_landunit_wet_lake (ltype, gi, li, ci, pi) diff --git a/src/main/lnd2glcMod.F90 b/src/main/lnd2glcMod.F90 index b2a60dcfb1..f48b3ef8b2 100644 --- a/src/main/lnd2glcMod.F90 +++ b/src/main/lnd2glcMod.F90 @@ -204,9 +204,7 @@ subroutine update_lnd2glc(this, bounds, num_do_smb_c, filter_do_smb_c, & ! Make sure we haven't already assigned the coupling fields for this point ! (this could happen, for example, if there were multiple columns in the ! istsoil landunit, which we aren't prepared to handle) -!FIXTHIS!!! if (fields_assigned(g,n)) then -! This is commented out so that multiple soil columns can be enabled - if (1==2) then + if (fields_assigned(g,n)) then write(iulog,*) subname//' ERROR: attempt to assign coupling fields twice for the same index.' write(iulog,*) 'One possible cause is having multiple columns in the istsoil landunit,' write(iulog,*) 'which this routine cannot handle.' diff --git a/src/main/subgridMod.F90 b/src/main/subgridMod.F90 index f49ededca0..31d9dd585b 100644 --- a/src/main/subgridMod.F90 +++ b/src/main/subgridMod.F90 @@ -13,7 +13,7 @@ module subgridMod use shr_kind_mod , only : r8 => shr_kind_r8 use spmdMod , only : masterproc use abortutils , only : endrun - use clm_varctl , only : iulog,use_individual_pft_soil_column + use clm_varctl , only : iulog use clm_instur , only : wt_lunit, wt_nat_patch, urban_valid, wt_cft use landunit_varcon, only : istcrop, istdlak, istwet, isturb_tbd, isturb_hd, isturb_md use glcBehaviorMod , only : glc_behavior_type @@ -130,7 +130,6 @@ subroutine subgrid_get_info_natveg(gi, npatches, ncols, nlunits) ! ! !USES use clm_varpar, only : natpft_lb, natpft_ub - use clm_varctl, only : use_individual_pft_soil_column ! ! !ARGUMENTS: integer, intent(in) :: gi ! grid cell index @@ -153,13 +152,8 @@ subroutine subgrid_get_info_natveg(gi, npatches, ncols, nlunits) end do if (npatches > 0) then - if(use_individual_pft_soil_column) then - ! Assume one soil column for each patch - ncols = npatches - else - ! Assume that the vegetated landunit has one column - ncols = 1 - end if + ! Assume that the vegetated landunit has one column + ncols = 1 nlunits = 1 else From e4a29871ae277dcdcd57a178504fa20b7061583b Mon Sep 17 00:00:00 2001 From: Sean Swenson Date: Wed, 10 Jun 2020 13:46:48 -0600 Subject: [PATCH 22/76] add back undercanopy_stability --- src/biogeophys/CanopyFluxesMod.F90 | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) diff --git a/src/biogeophys/CanopyFluxesMod.F90 b/src/biogeophys/CanopyFluxesMod.F90 index 43f8a3d3d0..779490fe80 100644 --- a/src/biogeophys/CanopyFluxesMod.F90 +++ b/src/biogeophys/CanopyFluxesMod.F90 @@ -987,11 +987,19 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ri = ( grav*htop(p) * (taf(p) - t_grnd(c)) ) / (taf(p) * uaf(p) **2.00_r8) - csoilcn = csoilb*w + params_inst%csoilc*(1._r8-w) - + ! modify csoilc value (0.004) if the under-canopy is in stable condition + if (use_undercanopy_stability .and. (taf(p) - t_grnd(c) ) > 0._r8) then + ! decrease the value of csoilc by dividing it with (1+gamma*min(S, 10.0)) + ! ria ("gmanna" in Sakaguchi&Zeng, 2008) is a constant (=0.5) + ricsoilc = params_inst%csoilc / (1.00_r8 + ria*min( ri, 10.0_r8) ) + csoilcn = csoilb*w + ricsoilc*(1._r8-w) + else + csoilcn = csoilb*w + params_inst%csoilc*(1._r8-w) + end if + !! Sakaguchi changes for stability formulation ends here - if (use_undercanopy_stability) then + if (use_biomass_heat_storage) then ! use uuc for ground fluxes (keep uaf for canopy terms) rah(p,2) = 1._r8/(csoilcn*uuc(p)) else From 3b8da8077b762ed45d1491b74564ef0bbbde3b74 Mon Sep 17 00:00:00 2001 From: Sean Swenson Date: Wed, 10 Jun 2020 14:06:29 -0600 Subject: [PATCH 23/76] remove comment --- src/biogeophys/CanopyFluxesMod.F90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/biogeophys/CanopyFluxesMod.F90 b/src/biogeophys/CanopyFluxesMod.F90 index 779490fe80..0b43950a11 100644 --- a/src/biogeophys/CanopyFluxesMod.F90 +++ b/src/biogeophys/CanopyFluxesMod.F90 @@ -1113,8 +1113,6 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, canopy_cond(p) = (laisun(p)/(rb(p)+rssun(p)) + laisha(p)/(rb(p)+rssha(p)))/max(elai(p), 0.01_r8) end if -! should be the same expression used in Photosynthesis/getqflx -!scs efpot = forc_rho(c)*elai(p)/rb(p)*(qsatl(p)-qaf(p)) efpot = forc_rho(c)*(elai(p)+esai(p))/rb(p)*(qsatl(p)-qaf(p)) h2ocan = liqcan(p) + snocan(p) From d70d7a80a64684f36174372788b667f2e28b9059 Mon Sep 17 00:00:00 2001 From: Sean Swenson Date: Wed, 10 Jun 2020 14:08:28 -0600 Subject: [PATCH 24/76] remove more comments --- src/biogeophys/CanopyFluxesMod.F90 | 13 ------------- 1 file changed, 13 deletions(-) diff --git a/src/biogeophys/CanopyFluxesMod.F90 b/src/biogeophys/CanopyFluxesMod.F90 index 0b43950a11..5f3cacf169 100644 --- a/src/biogeophys/CanopyFluxesMod.F90 +++ b/src/biogeophys/CanopyFluxesMod.F90 @@ -1155,7 +1155,6 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ! Moved the original subroutine in-line... wtaq = frac_veg_nosno(p)/raw(p,1) ! air -!scs wtlq = frac_veg_nosno(p)*elai(p)/rb(p) * rpp ! leaf wtlq = frac_veg_nosno(p)*(elai(p)+esai(p))/rb(p) * rpp ! leaf !Litter layer resistance. Added by K.Sakaguchi @@ -1236,7 +1235,6 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ! result in an imbalance in "hvap*qflx_evap_veg" and ! "efe + dc2*wtgaq*qsatdt_veg" -!scs efpot = forc_rho(c)*elai(p)/rb(p) & efpot = forc_rho(c)*(elai(p)+esai(p))/rb(p) & *(wtgaq*(qsatl(p)+qsatldT(p)*dt_veg(p)) & -wtgq0*qg(c)-wtaq0(p)*forc_q(c)) @@ -1366,17 +1364,6 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, - lw_leaf(p) + lw_stem(p) - eflx_sh_veg(p) - hvap*qflx_evap_veg(p) & - ((t_veg(p)-tl_ini(p))*cp_leaf(p)/dtime) - !scs -! if (abs(err(p)) > 1e6) then -! write(iulog,*) 'canerrchk: ', lw_leaf(p), lw_stem(p), dt_veg(p) -! write(iulog,*) 'canerrchk: ', (1.-frac_rad_abs_by_stem(p))*(sabv(p) + air(p) + bir(p)*tlbef(p)**3 & -! *(tlbef(p) + 4._r8*dt_veg(p)) + cir(p)*lw_grnd), & -! lw_leaf(p),lw_stem(p),eflx_sh_veg(p),hvap*qflx_evap_veg(p), & -! t_veg(p),tl_ini(p),dt_veg(p),cp_leaf(p),cp_stem(p) -! endif - - - ! Update stem temperature; adjust outgoing longwave ! does not account for changes in SH or internal LW, ! as that would change result for t_veg above From d468d384e0be1f80e733a58f6ae73ceeb1eddcf5 Mon Sep 17 00:00:00 2001 From: Sean Swenson Date: Wed, 10 Jun 2020 14:15:51 -0600 Subject: [PATCH 25/76] shift comment --- src/biogeophys/CanopyFluxesMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/biogeophys/CanopyFluxesMod.F90 b/src/biogeophys/CanopyFluxesMod.F90 index 5f3cacf169..dce160007d 100644 --- a/src/biogeophys/CanopyFluxesMod.F90 +++ b/src/biogeophys/CanopyFluxesMod.F90 @@ -1017,7 +1017,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, svpts(p) = el(p) ! pa eah(p) = forc_pbot(c) * qaf(p) / 0.622_r8 ! pa rhaf(p) = eah(p)/svpts(p) -! add history fields + ! variables for history fields rah1(p) = rah(p,1) raw1(p) = raw(p,1) rah2(p) = rah(p,2) From 6e547057ba320360207bb68de7817e06de1f218e Mon Sep 17 00:00:00 2001 From: Sean Swenson Date: Wed, 10 Jun 2020 14:18:48 -0600 Subject: [PATCH 26/76] remove blank lines --- src/main/initGridCellsMod.F90 | 1 - src/main/subgridMod.F90 | 1 - 2 files changed, 2 deletions(-) diff --git a/src/main/initGridCellsMod.F90 b/src/main/initGridCellsMod.F90 index 6fd96ed188..565a03e245 100644 --- a/src/main/initGridCellsMod.F90 +++ b/src/main/initGridCellsMod.F90 @@ -71,7 +71,6 @@ subroutine initGridcells(glc_behavior) integer :: nclumps ! number of clumps on this processor type(bounds_type) :: bounds_proc type(bounds_type) :: bounds_clump - !------------------------------------------------------------------------ ! Notes about how this routine is arranged, and its implications for the arrangement diff --git a/src/main/subgridMod.F90 b/src/main/subgridMod.F90 index 31d9dd585b..8307c440ff 100644 --- a/src/main/subgridMod.F90 +++ b/src/main/subgridMod.F90 @@ -73,7 +73,6 @@ subroutine subgrid_get_gcellinfo (gi, glc_behavior, & ! atm_topo is arbitrary for the sake of getting these counts. We don't have a true ! atm_topo value at the point of this call, so use 0. real(r8), parameter :: atm_topo = 0._r8 - !------------------------------------------------------------------------------ npatches = 0 From dd7989623f675b2c994a58560591746601bc5772 Mon Sep 17 00:00:00 2001 From: Sean Swenson Date: Wed, 10 Jun 2020 14:21:27 -0600 Subject: [PATCH 27/76] wrap long line --- src/biogeophys/CanopyFluxesMod.F90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/biogeophys/CanopyFluxesMod.F90 b/src/biogeophys/CanopyFluxesMod.F90 index dce160007d..b5c183e355 100644 --- a/src/biogeophys/CanopyFluxesMod.F90 +++ b/src/biogeophys/CanopyFluxesMod.F90 @@ -1472,7 +1472,9 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ! Upward longwave radiation above the canopy ulrad(p) = ((1._r8-emg(c))*(1._r8-emv(p))*(1._r8-emv(p))*forc_lwrad(c) & - + emv(p)*(1._r8+(1._r8-emg(c))*(1._r8-emv(p)))*sb*((1.-frac_rad_abs_by_stem(p))*tlbef(p)**3*(tlbef(p) + 4._r8*dt_veg(p))+frac_rad_abs_by_stem(p)*ts_ini(p)**3*(ts_ini(p) + 4._r8*dt_stem(p))) + emg(c)*(1._r8-emv(p))*sb*lw_grnd) + + emv(p)*(1._r8+(1._r8-emg(c))*(1._r8-emv(p)))*sb*((1.-frac_rad_abs_by_stem(p)) & + *tlbef(p)**3*(tlbef(p) + 4._r8*dt_veg(p))+frac_rad_abs_by_stem(p)*ts_ini(p)**3*(ts_ini(p) & + + 4._r8*dt_stem(p))) + emg(c)*(1._r8-emv(p))*sb*lw_grnd) ! Calculate the skin temperature as a weighted sum of all the ground and vegetated fraction From c99427e012eff3b43d05def514b76d837cb8be5a Mon Sep 17 00:00:00 2001 From: Sean Swenson Date: Wed, 10 Jun 2020 14:30:06 -0600 Subject: [PATCH 28/76] activate history fields --- src/biogeophys/EnergyFluxType.F90 | 11 +++++++---- src/biogeophys/TemperatureType.F90 | 12 +++++++----- 2 files changed, 14 insertions(+), 9 deletions(-) diff --git a/src/biogeophys/EnergyFluxType.F90 b/src/biogeophys/EnergyFluxType.F90 index d58418ccac..07829cc199 100644 --- a/src/biogeophys/EnergyFluxType.F90 +++ b/src/biogeophys/EnergyFluxType.F90 @@ -8,6 +8,7 @@ module EnergyFluxType use shr_kind_mod , only : r8 => shr_kind_r8 use shr_log_mod , only : errMsg => shr_log_errMsg use clm_varcon , only : spval + use clm_varctl , only : use_biomass_heat_storage use decompMod , only : bounds_type use LandunitType , only : lun use ColumnType , only : col @@ -445,10 +446,12 @@ subroutine InitHistory(this, bounds, is_simple_buildtemp) avgflag='A', long_name='sensible heat from stem', & ptr_patch=this%eflx_sh_stem_patch, c2l_scale_type='urbanf',default = 'inactive') - this%dhsdt_canopy_patch(begp:endp) = spval - call hist_addfld1d (fname='DHSDT_CANOPY', units='W/m^2', & - avgflag='A', long_name='change in canopy heat storage', & - ptr_patch=this%dhsdt_canopy_patch, set_lake=0._r8, c2l_scale_type='urbanf',default='inactive') + if (use_biomass_heat_storage) then + this%dhsdt_canopy_patch(begp:endp) = spval + call hist_addfld1d (fname='DHSDT_CANOPY', units='W/m^2', & + avgflag='A', long_name='change in canopy heat storage', & + ptr_patch=this%dhsdt_canopy_patch, set_lake=0._r8, c2l_scale_type='urbanf',default='active') + endif this%eflx_sh_grnd_patch(begp:endp) = spval call hist_addfld1d (fname='FSH_G', units='W/m^2', & diff --git a/src/biogeophys/TemperatureType.F90 b/src/biogeophys/TemperatureType.F90 index de85a68452..bbb028576a 100644 --- a/src/biogeophys/TemperatureType.F90 +++ b/src/biogeophys/TemperatureType.F90 @@ -7,7 +7,7 @@ module TemperatureType use shr_log_mod , only : errMsg => shr_log_errMsg use decompMod , only : bounds_type use abortutils , only : endrun - use clm_varctl , only : use_cndv, iulog, use_luna, use_crop + use clm_varctl , only : use_cndv, iulog, use_luna, use_crop, use_biomass_heat_storage use clm_varpar , only : nlevsno, nlevgrnd, nlevlak, nlevlak, nlevurb use clm_varcon , only : spval, ispval use GridcellType , only : grc @@ -390,10 +390,12 @@ subroutine InitHistory(this, bounds, is_simple_buildtemp, is_prog_buildtemp ) avgflag='A', long_name='Urban daily maximum of average 2-m temperature', & ptr_patch=this%t_ref2m_max_u_patch, set_nourb=spval, default='inactive') - this%t_stem_patch(begp:endp) = spval - call hist_addfld1d (fname='TSTEM', units='K', & - avgflag='A', long_name='stem temperature', & - ptr_patch=this%t_stem_patch, default='inactive') + if (use_biomass_heat_storage) then + this%t_stem_patch(begp:endp) = spval + call hist_addfld1d (fname='TSTEM', units='K', & + avgflag='A', long_name='stem temperature', & + ptr_patch=this%t_stem_patch, default='active') + endif this%t_veg_patch(begp:endp) = spval call hist_addfld1d (fname='TV', units='K', & From 63567cec0db691b8e00c405386c169ca062e025b Mon Sep 17 00:00:00 2001 From: Sean Swenson Date: Sat, 13 Jun 2020 10:19:45 -0600 Subject: [PATCH 29/76] add is_tree,is_shruyb,is_grass --- src/biogeochem/CNDVLightMod.F90 | 13 +++++---- src/biogeochem/CNDVType.F90 | 4 +-- src/biogeophys/CanopyFluxesMod.F90 | 9 ++++-- src/main/pftconMod.F90 | 44 +++++++++++++++++++++++------- 4 files changed, 49 insertions(+), 21 deletions(-) diff --git a/src/biogeochem/CNDVLightMod.F90 b/src/biogeochem/CNDVLightMod.F90 index 3c498742b9..aa429890ba 100644 --- a/src/biogeochem/CNDVLightMod.F90 +++ b/src/biogeochem/CNDVLightMod.F90 @@ -72,8 +72,9 @@ subroutine Light(bounds, num_natvegp, filter_natvegp, & slatop => pftcon%slatop , & ! Input: specific leaf area at top of canopy, projected area basis (m2/gC) dsladlai => pftcon%dsladlai , & ! Input: dSLA/dLAI, projected area basis (m2/gC) woody => pftcon%woody , & ! Input: woody patch or not - tree => pftcon%tree , & ! Input: tree patch or not - + is_tree => pftcon%is_tree , & ! Input: tree patch or not + is_shrub => pftcon%is_shrub , & ! Input: shrub patch or not + deadstemc => cnveg_carbonstate_inst%deadstemc_patch , & ! Input: [real(r8) (:) ] (gC/m2) dead stem C leafcmax => cnveg_carbonstate_inst%leafcmax_patch , & ! Input: [real(r8) (:) ] (gC/m2) leaf C storage @@ -132,11 +133,11 @@ subroutine Light(bounds, num_natvegp, filter_natvegp, & fpc_inc(p) = max(0._r8, fpcgrid(p) - fpcgrid_old) if (woody(ivt(p)) == 1._r8) then - if (tree(ivt(p)) == 1) then + if (is_tree(ivt(p))) then numtrees(g) = numtrees(g) + 1 fpc_tree_total(g) = fpc_tree_total(g) + fpcgrid(p) fpc_inc_tree(g) = fpc_inc_tree(g) + fpc_inc(p) - else ! if shrubs + else if (is_shrub(ivt(p))) then fpc_shrub_total(g) = fpc_shrub_total(g) + fpcgrid(p) end if else ! if grass @@ -162,7 +163,7 @@ subroutine Light(bounds, num_natvegp, filter_natvegp, & ! light competition - if (woody(ivt(p))==1._r8 .and. tree(ivt(p))==1._r8) then + if (woody(ivt(p))==1._r8 .and. is_tree(ivt(p))) then if (fpc_tree_total(g) > fpc_tree_max) then @@ -200,7 +201,7 @@ subroutine Light(bounds, num_natvegp, filter_natvegp, & end if - else if (woody(ivt(p))==1._r8 .and. tree(ivt(p))==0._r8) then ! shrub + else if (woody(ivt(p))==1._r8 .and. is_shrub(ivt(p))) then ! shrub if (fpc_shrub_total(g) > fpc_shrub_max(g)) then diff --git a/src/biogeochem/CNDVType.F90 b/src/biogeochem/CNDVType.F90 index 6bc87d8f4b..065e972a15 100644 --- a/src/biogeochem/CNDVType.F90 +++ b/src/biogeochem/CNDVType.F90 @@ -97,7 +97,7 @@ subroutine InitAllocate(this, bounds) use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) use clm_varpar , only : maxveg use pftconMod , only : allom1s, allom2s, allom1, allom2, allom3, reinickerp - use pftconMod , only : ntree, nbrdlf_dcd_brl_shrub + use pftconMod , only : nbrdlf_dcd_brl_shrub use pftconMod , only : pftcon ! ! !ARGUMENTS: @@ -148,7 +148,7 @@ subroutine InitAllocate(this, bounds) dgv_ecophyscon%allom2(m) = allom2 dgv_ecophyscon%allom3(m) = allom3 ! modification for shrubs by X.D.Z - if (m > ntree .and. m <= nbrdlf_dcd_brl_shrub ) then + if (pftcon%is_shrub(m)) then dgv_ecophyscon%allom1(m) = allom1s dgv_ecophyscon%allom2(m) = allom2s end if diff --git a/src/biogeophys/CanopyFluxesMod.F90 b/src/biogeophys/CanopyFluxesMod.F90 index b5c183e355..4740e4c263 100644 --- a/src/biogeophys/CanopyFluxesMod.F90 +++ b/src/biogeophys/CanopyFluxesMod.F90 @@ -438,6 +438,8 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, snl => col%snl , & ! Input: [integer (:) ] number of snow layers dayl => grc%dayl , & ! Input: [real(r8) (:) ] daylength (s) max_dayl => grc%max_dayl , & ! Input: [real(r8) (:) ] maximum daylength for this grid cell (s) + is_tree => pftcon%is_tree , & ! Input: tree patch or not + is_shrub => pftcon%is_shrub , & ! Input: shrub patch or not dleaf => pftcon%dleaf , & ! Input: characteristic leaf dimension (m) dbh_param => pftcon%dbh , & ! Input: diameter at brest height (m) fbw => pftcon%fbw , & ! Input: fraction of biomass that is water @@ -708,9 +710,10 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ! adjust for departure of cylindrical stem model sa_stem(p) = k_cyl_area * sa_stem(p) - ! do not calculate separate leaf/stem heat capacity for grasses - ! or other pfts if dbh is below minimum value - if(patch%itype(p) > 11 .or. dbh(p) < min_stem_diameter) then + ! only calculate separate leaf/stem heat capacity for trees + ! and shrubs if dbh is greater than some minimum value + if(.not.(is_tree(patch%itype(p)) .or. is_shrub(patch%itype(p))) & + .or. dbh(p) < min_stem_diameter) then frac_rad_abs_by_stem(p) = 0.0 sa_stem(p) = 0.0 endif diff --git a/src/main/pftconMod.F90 b/src/main/pftconMod.F90 index e5b3d5c564..1c1c1bf9c6 100644 --- a/src/main/pftconMod.F90 +++ b/src/main/pftconMod.F90 @@ -110,7 +110,9 @@ module pftconMod type, public :: pftcon_type integer , allocatable :: noveg (:) ! value for not vegetated - integer , allocatable :: tree (:) ! tree or not? + logical , allocatable :: is_tree (:) ! tree or not? + logical , allocatable :: is_shrub (:) ! shrub or not? + logical , allocatable :: is_grass (:) ! grass or not? real(r8), allocatable :: dleaf (:) ! characteristic leaf dimension (m) real(r8), allocatable :: c3psn (:) ! photosynthetic pathway: 0. = c4, 1. = c3 @@ -339,8 +341,10 @@ subroutine InitAllocate (this) class(pftcon_type) :: this !----------------------------------------------------------------------- - allocate( this%noveg (0:mxpft)); this%noveg (:) =huge(1) - allocate( this%tree (0:mxpft)); this%tree (:) =huge(1) + allocate( this%noveg (0:mxpft)); this%noveg (:) = huge(1) + allocate( this%is_tree (0:mxpft)); this%is_tree (:) = .false. + allocate( this%is_shrub (0:mxpft)); this%is_shrub (:) = .false. + allocate( this%is_grass (0:mxpft)); this%is_grass (:) = .false. allocate( this%dleaf (0:mxpft) ) allocate( this%c3psn (0:mxpft) ) @@ -983,13 +987,8 @@ subroutine InitRead(this) this%dwood(m) = dwood this%root_radius(m) = root_radius this%root_density(m) = root_density - - if (m <= ntree) then - this%tree(m) = 1 - else - this%tree(m) = 0 - end if end do + ! ! clm 5 nitrogen variables ! @@ -1138,6 +1137,29 @@ subroutine InitRead(this) call this%set_is_pft_known_to_model() call this%set_num_cfts_known_to_model() + ! Set vegetation family identifier (tree/shrub/grass) + do m = 0,mxpft + if (m == ndllf_evr_tmp_tree .or. m == ndllf_evr_brl_tree & + .or. m == ndllf_dcd_brl_tree .or. m == nbrdlf_evr_trp_tree & + .or. m == nbrdlf_evr_tmp_tree .or. m == nbrdlf_dcd_trp_tree & + .or. m == nbrdlf_dcd_tmp_tree .or. m == nbrdlf_dcd_brl_tree) then + this%is_tree(m) = .true. + else + this%is_tree(m) = .false. + endif + if(m == nbrdlf_evr_shrub .or. m == nbrdlf_dcd_tmp_shrub .or. m == nbrdlf_dcd_brl_shrub) then + this%is_shrub(m) = .true. + else + this%is_shrub(m) = .false. + endif + if(m == nc3_arctic_grass .or. m == nc3_nonarctic_grass .or. m == nc4_grass) then + this%is_grass(m) = .true. + else + this%is_grass(m) = .false. + endif + + end do + if (use_cndv) then this%fcur(:) = this%fcurdv(:) end if @@ -1292,7 +1314,9 @@ subroutine Clean(this) !----------------------------------------------------------------------- deallocate( this%noveg) - deallocate( this%tree) + deallocate( this%is_tree) + deallocate( this%is_shrub) + deallocate( this%is_grass) deallocate( this%dleaf) deallocate( this%c3psn) From 6615ce4e98ce027ff3b9a00709b72108f2eb643f Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Mon, 28 Sep 2020 14:40:03 -0600 Subject: [PATCH 30/76] Remove comment so identical to ctsm1.0.dev113 --- src/main/initGridCellsMod.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/src/main/initGridCellsMod.F90 b/src/main/initGridCellsMod.F90 index 565a03e245..0d9b20ef7b 100644 --- a/src/main/initGridCellsMod.F90 +++ b/src/main/initGridCellsMod.F90 @@ -130,7 +130,6 @@ subroutine initGridcells(glc_behavior) li = bounds_clump%begl-1 ci = bounds_clump%begc-1 pi = bounds_clump%begp-1 - ! Determine naturally vegetated landunit do gdc = bounds_clump%begg,bounds_clump%endg From 210f63a96c45de0dd015bb972f66be8f56fb9e1d Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Mon, 28 Sep 2020 14:42:20 -0600 Subject: [PATCH 31/76] Remove comment so identical to ctsm1.0.dev113 --- src/main/subgridMod.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/src/main/subgridMod.F90 b/src/main/subgridMod.F90 index 8307c440ff..3f34acda69 100644 --- a/src/main/subgridMod.F90 +++ b/src/main/subgridMod.F90 @@ -153,7 +153,6 @@ subroutine subgrid_get_info_natveg(gi, npatches, ncols, nlunits) if (npatches > 0) then ! Assume that the vegetated landunit has one column ncols = 1 - nlunits = 1 else ! As noted in natveg_patch_exists, we expect a naturally vegetated landunit in From 2ad6094dfdff029db8571974fa65d43384c63b60 Mon Sep 17 00:00:00 2001 From: Sean Swenson Date: Tue, 29 Sep 2020 10:17:40 -0600 Subject: [PATCH 32/76] add specific heat capacities to clm_varcon --- src/biogeophys/CanopyFluxesMod.F90 | 24 +++++++++++++++--------- src/biogeophys/EnergyFluxType.F90 | 10 +++++----- src/main/clm_varcon.F90 | 2 ++ 3 files changed, 22 insertions(+), 14 deletions(-) diff --git a/src/biogeophys/CanopyFluxesMod.F90 b/src/biogeophys/CanopyFluxesMod.F90 index ff1ce1688c..2dfe5107dc 100644 --- a/src/biogeophys/CanopyFluxesMod.F90 +++ b/src/biogeophys/CanopyFluxesMod.F90 @@ -228,6 +228,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, use clm_varcon , only : sb, cpair, hvap, vkc, grav, denice, c_to_b use clm_varcon , only : denh2o, tfrz, tlsai_crit, alpha_aero use clm_varcon , only : c14ratio + use clm_varcon , only : c_water, c_dry_biomass use perf_mod , only : t_startf, t_stopf use QSatMod , only : QSat use CLMFatesInterfaceMod, only : hlm_fates_interface_type @@ -740,12 +741,13 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ! calculate specify heat capacity of vegetation ! as weighted averaged of dry biomass and water - ! lma_dry has units of kg dry mass/m2 here (table 2 of bonan 2017) - ! cdry_biomass = 1400 J/kg/K, cwater = 4188 J/kg/K - cp_leaf(p) = leaf_biomass(p) * (1400._r8*(1.-fbw(patch%itype(p))) + (fbw(patch%itype(p)))*4188._r8) + ! lma_dry has units of kg dry mass/m2 here + ! (Appendix B of Bonan et al., GMD, 2018) + + cp_leaf(p) = leaf_biomass(p) * (c_dry_biomass*(1.-fbw(patch%itype(p))) + (fbw(patch%itype(p)))*c_water) ! cp-stem will have units J/k/ground_area - cp_stem(p) = stem_biomass(p) * (1400._r8*(1.-fbw(patch%itype(p))) + (fbw(patch%itype(p)))*4188._r8) + cp_stem(p) = stem_biomass(p) * (c_dry_biomass*(1.-fbw(patch%itype(p))) + (fbw(patch%itype(p)))*c_water) ! adjust for departure from cylindrical stem model cp_stem(p) = k_cyl_vol * cp_stem(p) @@ -1471,15 +1473,19 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ! Downward longwave radiation below the canopy - dlrad(p) = (1._r8-emv(p))*emg(c)*forc_lwrad(c) + & - emv(p)*emg(c)*sb*(tlbef(p)**3*(tlbef(p) + 4._r8*dt_veg(p))*(1.-frac_rad_abs_by_stem(p))+ts_ini(p)**3*(ts_ini(p) + 4._r8*dt_stem(p))*frac_rad_abs_by_stem(p)) + dlrad(p) = (1._r8-emv(p))*emg(c)*forc_lwrad(c) & + + emv(p)*emg(c)*sb*(tlbef(p)**3*(tlbef(p) + 4._r8*dt_veg(p)) & + *(1.-frac_rad_abs_by_stem(p))+ts_ini(p)**3*(ts_ini(p) & + + 4._r8*dt_stem(p))*frac_rad_abs_by_stem(p)) ! Upward longwave radiation above the canopy ulrad(p) = ((1._r8-emg(c))*(1._r8-emv(p))*(1._r8-emv(p))*forc_lwrad(c) & - + emv(p)*(1._r8+(1._r8-emg(c))*(1._r8-emv(p)))*sb*((1.-frac_rad_abs_by_stem(p)) & - *tlbef(p)**3*(tlbef(p) + 4._r8*dt_veg(p))+frac_rad_abs_by_stem(p)*ts_ini(p)**3*(ts_ini(p) & - + 4._r8*dt_stem(p))) + emg(c)*(1._r8-emv(p))*sb*lw_grnd) + + emv(p)*(1._r8+(1._r8-emg(c))*(1._r8-emv(p)))*sb & + *((1.-frac_rad_abs_by_stem(p))*tlbef(p)**3 & + *(tlbef(p) + 4._r8*dt_veg(p)) & + +frac_rad_abs_by_stem(p)*ts_ini(p)**3*(ts_ini(p)+ 4._r8*dt_stem(p))) & + + emg(c)*(1._r8-emv(p))*sb*lw_grnd) ! Calculate the skin temperature as a weighted sum of all the ground and vegetated fraction diff --git a/src/biogeophys/EnergyFluxType.F90 b/src/biogeophys/EnergyFluxType.F90 index 07829cc199..1f1aa64a9e 100644 --- a/src/biogeophys/EnergyFluxType.F90 +++ b/src/biogeophys/EnergyFluxType.F90 @@ -441,12 +441,12 @@ subroutine InitHistory(this, bounds, is_simple_buildtemp) avgflag='A', long_name='sensible heat from veg', & ptr_patch=this%eflx_sh_veg_patch, set_lake=0._r8, c2l_scale_type='urbanf') - this%eflx_sh_stem_patch(begp:endp) = spval - call hist_addfld1d (fname='FSH_STEM', units='W/m^2', & - avgflag='A', long_name='sensible heat from stem', & - ptr_patch=this%eflx_sh_stem_patch, c2l_scale_type='urbanf',default = 'inactive') - if (use_biomass_heat_storage) then + this%eflx_sh_stem_patch(begp:endp) = spval + call hist_addfld1d (fname='FSH_STEM', units='W/m^2', & + avgflag='A', long_name='sensible heat from stem', & + ptr_patch=this%eflx_sh_stem_patch, c2l_scale_type='urbanf',default = 'inactive') + this%dhsdt_canopy_patch(begp:endp) = spval call hist_addfld1d (fname='DHSDT_CANOPY', units='W/m^2', & avgflag='A', long_name='change in canopy heat storage', & diff --git a/src/main/clm_varcon.F90 b/src/main/clm_varcon.F90 index a6044dcb3e..ff9f5e0d2c 100644 --- a/src/main/clm_varcon.F90 +++ b/src/main/clm_varcon.F90 @@ -81,6 +81,8 @@ module clm_varcon real(r8), public :: alpha_aero = 1.0_r8 ! constant for aerodynamic parameter weighting real(r8), public :: tlsai_crit = 2.0_r8 ! critical value of elai+esai for which aerodynamic parameters are maximum real(r8), public :: watmin = 0.01_r8 ! minimum soil moisture (mm) + real(r8), public :: c_water = 4188_r8 ! specific heat of water [J/kg/K] + real(r8), public :: c_dry_biomass = 1400_r8 ! specific heat of dry biomass real(r8), public :: re = SHR_CONST_REARTH*0.001_r8 ! radius of earth (km) From 5da56d380011700afe31667bbe30e0f979501485 Mon Sep 17 00:00:00 2001 From: Sean Swenson Date: Tue, 29 Sep 2020 10:35:01 -0600 Subject: [PATCH 33/76] add comment regarding tuning parameters --- src/biogeophys/CanopyFluxesMod.F90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/biogeophys/CanopyFluxesMod.F90 b/src/biogeophys/CanopyFluxesMod.F90 index 2dfe5107dc..ef1b30d2d6 100644 --- a/src/biogeophys/CanopyFluxesMod.F90 +++ b/src/biogeophys/CanopyFluxesMod.F90 @@ -421,7 +421,9 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, real(r8) :: uuc(bounds%begp:bounds%endp) ! undercanopy windspeed real(r8) :: carea_stem !cross-sectional area of stem - ! biomass parameters + ! Biomass heat storage tuning parameters + ! These parameters can be used to account for differences + ! in vegetation shape. real(r8), parameter :: k_vert = 0.1 !vertical distribution of stem real(r8), parameter :: k_cyl_vol = 1.0 !departure from cylindrical volume real(r8), parameter :: k_cyl_area = 1.0 !departure from cylindrical area From 1e9be52627dbe5b3a9c383a4d13211e0e79f84fa Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Tue, 29 Sep 2020 12:58:07 -0600 Subject: [PATCH 34/76] Remove whitespace difference so same as ctsm5.1.dev003 base code --- src/main/readParamsMod.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/src/main/readParamsMod.F90 b/src/main/readParamsMod.F90 index 482d7b05a5..38d412414e 100644 --- a/src/main/readParamsMod.F90 +++ b/src/main/readParamsMod.F90 @@ -57,7 +57,6 @@ subroutine readParameters (nutrient_competition_method, photosyns_inst) use NutrientCompetitionMethodMod , only : nutrient_competition_method_type use clm_varctl, only : NLFilename_in use PhotosynthesisMod , only : photosyns_type - ! ! !ARGUMENTS: type(photosyns_type) , intent(in) :: photosyns_inst From 67a6dda244b23d626668aa1d451e05a816bffc00 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Tue, 29 Sep 2020 13:00:56 -0600 Subject: [PATCH 35/76] Turn bio-mass heat storage on for clm5_1 --- bld/namelist_files/namelist_defaults_ctsm.xml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index 72592395ea..66a4ca6ac1 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -306,7 +306,8 @@ attributes from the config_cache.xml file (with keys converted to upper-case). .false. .true. -.false. +.true. +.false. 40 3 From f5f56ee0d7294bf7847951977d46153e1bf7d3aa Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Tue, 8 Dec 2020 16:34:55 -0700 Subject: [PATCH 36/76] Correct test number, Sam Levis removed some tests no longer relevent in a previous tag --- bld/unit_testers/build-namelist_test.pl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/bld/unit_testers/build-namelist_test.pl b/bld/unit_testers/build-namelist_test.pl index 0fee84f11c..1a86b5faf6 100755 --- a/bld/unit_testers/build-namelist_test.pl +++ b/bld/unit_testers/build-namelist_test.pl @@ -138,7 +138,7 @@ sub make_config_cache { # # Figure out number of tests that will run # -my $ntests = 1516; +my $ntests = 1513; if ( defined($opts{'compare'}) ) { $ntests += 1017; } From 01c13f038c051247369b239be669431fb86be87e Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Tue, 8 Dec 2020 16:47:10 -0700 Subject: [PATCH 37/76] Move biomass heat storage if outside of long loop, have a small loop for else case --- src/biogeophys/CanopyFluxesMod.F90 | 33 ++++++++++++++++-------------- 1 file changed, 18 insertions(+), 15 deletions(-) diff --git a/src/biogeophys/CanopyFluxesMod.F90 b/src/biogeophys/CanopyFluxesMod.F90 index 715d797e87..ab19bff11a 100644 --- a/src/biogeophys/CanopyFluxesMod.F90 +++ b/src/biogeophys/CanopyFluxesMod.F90 @@ -680,10 +680,9 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, end do ! calculate biomass heat capacities - do f = 1, fn - p = filterp(f) - - if(use_biomass_heat_storage) then + if(use_biomass_heat_storage) then +bioms: do f = 1, fn + p = filterp(f) ! fraction of stem receiving incoming radiation frac_rad_abs_by_stem(p) = (esai(p))/(elai(p)+esai(p)) @@ -750,18 +749,22 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ! resistance between internal stem temperature and canopy air rstem(p) = rstem_per_dbh(patch%itype(p))*dbh(p) - else - ! use_biomass_heat_storage .false. - frac_rad_abs_by_stem(p) = 0._r8 - sa_stem(p) = 0._r8 - sa_leaf(p) = (elai(p)+esai(p)) - sa_internal(p) = 0._r8 - cp_leaf(p) = 0._r8 - cp_stem(p) = 0._r8 - rstem(p) = 0._r8 - endif - enddo + enddo bioms + else + ! Otherwise set biomass heat storage terms to zero + do f = 1, fn + p = filterp(f) + sa_leaf(p) = (elai(p)+esai(p)) + frac_rad_abs_by_stem(p) = 0._r8 + sa_stem(p) = 0._r8 + sa_internal(p) = 0._r8 + cp_leaf(p) = 0._r8 + cp_stem(p) = 0._r8 + rstem(p) = 0._r8 + end do + end if + ! calculate daylength control for Vcmax do f = 1, fn From b24f4fea90ecb22382b0f5db7908b6ee893af63b Mon Sep 17 00:00:00 2001 From: Sean Swenson Date: Mon, 14 Dec 2020 14:56:00 -0700 Subject: [PATCH 38/76] refactor to remove roundoff differences --- src/biogeochem/CNVegStructUpdateMod.F90 | 3 +++ src/biogeophys/CanopyFluxesMod.F90 | 28 +++++++++++++++---------- 2 files changed, 20 insertions(+), 11 deletions(-) diff --git a/src/biogeochem/CNVegStructUpdateMod.F90 b/src/biogeochem/CNVegStructUpdateMod.F90 index c94f8b4de2..1049a7ad3f 100644 --- a/src/biogeochem/CNVegStructUpdateMod.F90 +++ b/src/biogeochem/CNVegStructUpdateMod.F90 @@ -236,6 +236,9 @@ subroutine CNVegStructUpdate(num_soilp, filter_soilp, & if (spinup_state == 2) then stem_biomass(p) = 10._r8 * stem_biomass(p) end if + else + leaf_biomass(p) = 0_r8 + stem_biomass(p) = 0_r8 end if ! Peter Thornton, 5/3/2004 diff --git a/src/biogeophys/CanopyFluxesMod.F90 b/src/biogeophys/CanopyFluxesMod.F90 index ab19bff11a..a927066f97 100644 --- a/src/biogeophys/CanopyFluxesMod.F90 +++ b/src/biogeophys/CanopyFluxesMod.F90 @@ -693,9 +693,13 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ! if using Satellite Phenology mode, use values in parameter file ! otherwise calculate dbh from stem biomass if(use_cn) then - dbh(p) = 2._r8 * sqrt(stem_biomass(p) * (1._r8 - fbw(patch%itype(p))) & - / ( shr_const_pi * htop(p) * k_cyl_vol & - * nstem(patch%itype(p)) * wood_density(patch%itype(p)))) + if(stem_biomass(p) > 0._r8) then + dbh(p) = 2._r8 * sqrt(stem_biomass(p) * (1._r8 - fbw(patch%itype(p))) & + / ( shr_const_pi * htop(p) * k_cyl_vol & + * nstem(patch%itype(p)) * wood_density(patch%itype(p)))) + else + dbh(p) = 0._r8 + endif else dbh(p) = dbh_param(patch%itype(p)) endif @@ -1121,7 +1125,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, canopy_cond(p) = (laisun(p)/(rb(p)+rssun(p)) + laisha(p)/(rb(p)+rssha(p)))/max(elai(p), 0.01_r8) end if - efpot = forc_rho(c)*(elai(p)+esai(p))/rb(p)*(qsatl(p)-qaf(p)) + efpot = forc_rho(c)*((elai(p)+esai(p))/rb(p))*(qsatl(p)-qaf(p)) h2ocan = liqcan(p) + snocan(p) ! When the hydraulic stress parameterization is active calculate rpp @@ -1243,7 +1247,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ! result in an imbalance in "hvap*qflx_evap_veg" and ! "efe + dc2*wtgaq*qsatdt_veg" - efpot = forc_rho(c)*(elai(p)+esai(p))/rb(p) & + efpot = forc_rho(c)*((elai(p)+esai(p))/rb(p)) & *(wtgaq*(qsatl(p)+qsatldT(p)*dt_veg(p)) & -wtgq0*qg(c)-wtaq0(p)*forc_q(c)) qflx_evap_veg(p) = rpp*efpot @@ -1478,18 +1482,20 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ! Downward longwave radiation below the canopy dlrad(p) = (1._r8-emv(p))*emg(c)*forc_lwrad(c) & - + emv(p)*emg(c)*sb*(tlbef(p)**3*(tlbef(p) + 4._r8*dt_veg(p)) & - *(1.-frac_rad_abs_by_stem(p))+ts_ini(p)**3*(ts_ini(p) & - + 4._r8*dt_stem(p))*frac_rad_abs_by_stem(p)) + + emv(p)*emg(c)*sb*tlbef(p)**3*(tlbef(p) + 4._r8*dt_veg(p)) & + *(1.-frac_rad_abs_by_stem(p)) & + + emv(p)*emg(c)*sb*ts_ini(p)**3*(ts_ini(p) + 4._r8*dt_stem(p)) & + *frac_rad_abs_by_stem(p) ! Upward longwave radiation above the canopy ulrad(p) = ((1._r8-emg(c))*(1._r8-emv(p))*(1._r8-emv(p))*forc_lwrad(c) & + emv(p)*(1._r8+(1._r8-emg(c))*(1._r8-emv(p)))*sb & - *((1.-frac_rad_abs_by_stem(p))*tlbef(p)**3 & - *(tlbef(p) + 4._r8*dt_veg(p)) & - +frac_rad_abs_by_stem(p)*ts_ini(p)**3*(ts_ini(p)+ 4._r8*dt_stem(p))) & + *tlbef(p)**3*(tlbef(p) + 4._r8*dt_veg(p))*(1.-frac_rad_abs_by_stem(p)) & + + emv(p)*(1._r8+(1._r8-emg(c))*(1._r8-emv(p)))*sb & + *ts_ini(p)**3*(ts_ini(p)+ 4._r8*dt_stem(p))*frac_rad_abs_by_stem(p) & + emg(c)*(1._r8-emv(p))*sb*lw_grnd) + ! Calculate the skin temperature as a weighted sum of all the ground and vegetated fraction From a4634b4ae9727e244df13b1ac7642c4eec62b474 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Tue, 15 Dec 2020 17:16:55 -0700 Subject: [PATCH 39/76] Add a test to make sure fates does not set use_biomass_heat_storage, add some more fates tests --- bld/unit_testers/build-namelist_test.pl | 31 ++++++++++++++++++------- 1 file changed, 22 insertions(+), 9 deletions(-) diff --git a/bld/unit_testers/build-namelist_test.pl b/bld/unit_testers/build-namelist_test.pl index 1a86b5faf6..61df4288a8 100755 --- a/bld/unit_testers/build-namelist_test.pl +++ b/bld/unit_testers/build-namelist_test.pl @@ -138,9 +138,9 @@ sub make_config_cache { # # Figure out number of tests that will run # -my $ntests = 1513; +my $ntests = 1550; if ( defined($opts{'compare'}) ) { - $ntests += 1017; + $ntests += 1026; } plan( tests=>$ntests ); @@ -837,6 +837,11 @@ sub make_config_cache { GLC_TWO_WAY_COUPLING=>"FALSE", phys=>"clm5_0", }, + "useFATESWbMH" =>{ options=>"-bgc fates -envxml_dir . -no-megan", + namelst=>"use_biomass_heat_storage=.true.", + GLC_TWO_WAY_COUPLING=>"FALSE", + phys=>"clm5_1", + }, "createcropFalse" =>{ options=>"-bgc bgc -envxml_dir . -no-megan", namelst=>"create_crop_landunit=.false.", GLC_TWO_WAY_COUPLING=>"FALSE", @@ -1413,22 +1418,30 @@ sub make_config_cache { &cleanup(); # Run FATES mode for several resolutions and configurations my $clmoptions = "-bgc fates -envxml_dir . -no-megan"; - my @clmres = ( "1x1_brazil", "5x5_amazon", "10x15", "1.9x2.5" ); + my @clmres = ( "1x1_brazil", "5x5_amazon", "4x5", "1.9x2.5" ); foreach my $res ( @clmres ) { - $options = "-res $res"; - my @edoptions = ( "-use_case 2000_control", "", "-namelist \"&a use_lch4=.true.,use_nitrif_denitrif=.true./\"", "-clm_accelerated_spinup on" ); + $options = "-res $res -clm_start_type cold"; + my @edoptions = ( "-use_case 2000_control", + "-use_case 1850_control", + "", + "-namelist \"&a use_lch4=.true.,use_nitrif_denitrif=.true./\"", + "-clm_accelerated_spinup on" + ); foreach my $edop (@edoptions ) { + if ( $res eq "5x5_amazon" && ($edop =~ /1850_control/) ) { + next; + } &make_env_run( ); eval{ system( "$bldnml $options $clmoptions $edop > $tempfile 2>&1 " ); }; is( $@, '', "$options $edop" ); - $cfiles->checkfilesexist( "$options $edop", $mode ); + $cfiles->checkfilesexist( "$options $clmoptions $edop", $mode ); $cfiles->shownmldiff( "default", "standard" ); if ( defined($opts{'compare'}) ) { - $cfiles->doNOTdodiffonfile( "$tempfile", "$options $edop", $mode ); - $cfiles->comparefiles( "$options $edop", $mode, $opts{'compare'} ); + $cfiles->doNOTdodiffonfile( "$tempfile", "$options $clmoptions $edop", $mode ); + $cfiles->comparefiles( "$options $clmoptions $edop", $mode, $opts{'compare'} ); } if ( defined($opts{'generate'}) ) { - $cfiles->copyfiles( "$options $edop", $mode ); + $cfiles->copyfiles( "$options $clmoptions $edop", $mode ); } &cleanup(); } From bcea798a0d0a2ab19230aa6c6add3fa4e2d3670d Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Tue, 15 Dec 2020 17:17:52 -0700 Subject: [PATCH 40/76] Bring in a paramsfile that has the biomass heat storage terms on it for clm5_1, also turn it off when fates is on --- bld/namelist_files/namelist_defaults_ctsm.xml | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index 523ac2c1f9..3fbed6e3a2 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -311,8 +311,9 @@ attributes from the config_cache.xml file (with keys converted to upper-case). .false. .true. -.true. -.false. +.true. +.false. +.false. 40 3 @@ -472,7 +473,7 @@ attributes from the config_cache.xml file (with keys converted to upper-case). -lnd/clm2/paramdata/ctsm51_params.c200905.nc +lnd/clm2/paramdata/ctsm51_params.c201215.nc lnd/clm2/paramdata/clm50_params.c200905.nc lnd/clm2/paramdata/clm45_params.c200905.nc From 08ddb0336c3e0102aafde479858632bc1bf92b71 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Tue, 15 Dec 2020 17:18:20 -0700 Subject: [PATCH 41/76] Send use_fates when setting default for biomass heat storage --- bld/CLMBuildNamelist.pm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index 46a8591b3b..50196698ec 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -3675,7 +3675,8 @@ sub setup_logic_canopyfluxes { add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'use_undercanopy_stability' ); add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'itmax_canopy_fluxes', 'structure'=>$nl_flags->{'structure'}); - add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'use_biomass_heat_storage'); + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'use_biomass_heat_storage', + 'use_fates'=>$nl_flags->{'use_fates'}, 'phys'=>$nl_flags->{'phys'} ); } #------------------------------------------------------------------------------- From 8aeb64db891b4bced2894b1f0e87bb65c610ec61 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Tue, 15 Dec 2020 18:25:16 -0700 Subject: [PATCH 42/76] Correct compare number of tests --- bld/unit_testers/build-namelist_test.pl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/bld/unit_testers/build-namelist_test.pl b/bld/unit_testers/build-namelist_test.pl index 61df4288a8..24c7a0add3 100755 --- a/bld/unit_testers/build-namelist_test.pl +++ b/bld/unit_testers/build-namelist_test.pl @@ -140,7 +140,7 @@ sub make_config_cache { # my $ntests = 1550; if ( defined($opts{'compare'}) ) { - $ntests += 1026; + $ntests += 1044; } plan( tests=>$ntests ); From 1eec345bf85802f523df0bd50dc50b9f89f91572 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Tue, 15 Dec 2020 18:25:53 -0700 Subject: [PATCH 43/76] Make sure use_biomass_heat_storage is NOT on when fates is --- bld/CLMBuildNamelist.pm | 3 +++ 1 file changed, 3 insertions(+) diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index 50196698ec..3326c4b105 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -3677,6 +3677,9 @@ sub setup_logic_canopyfluxes { 'structure'=>$nl_flags->{'structure'}); add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'use_biomass_heat_storage', 'use_fates'=>$nl_flags->{'use_fates'}, 'phys'=>$nl_flags->{'phys'} ); + if ( &value_is_true($nl->get_value('use_biomass_heat_storage') ) && &value_is_true( $nl_flags->{'use_fates'}) ) { + $log->fatal_error('use_biomass_heat_storage can NOT be set to true when fates is on'); + } } #------------------------------------------------------------------------------- From 1cec0104c1ed283241c2a4fea2945ea33d470d56 Mon Sep 17 00:00:00 2001 From: Sean Swenson Date: Wed, 16 Dec 2020 11:47:07 -0700 Subject: [PATCH 44/76] convert taper/stocking to arrays --- src/biogeochem/CNVegStructUpdateMod.F90 | 41 +++++++++++++++---------- src/biogeochem/CNVegetationFacade.F90 | 2 +- 2 files changed, 26 insertions(+), 17 deletions(-) diff --git a/src/biogeochem/CNVegStructUpdateMod.F90 b/src/biogeochem/CNVegStructUpdateMod.F90 index 1049a7ad3f..1066c93e43 100644 --- a/src/biogeochem/CNVegStructUpdateMod.F90 +++ b/src/biogeochem/CNVegStructUpdateMod.F90 @@ -16,6 +16,7 @@ module CNVegStructUpdateMod use CNVegCarbonStateType , only : cnveg_carbonstate_type use CanopyStateType , only : canopystate_type use PatchType , only : patch + use decompMod , only : bounds_type ! implicit none private @@ -27,7 +28,7 @@ module CNVegStructUpdateMod contains !----------------------------------------------------------------------- - subroutine CNVegStructUpdate(num_soilp, filter_soilp, & + subroutine CNVegStructUpdate(bounds,num_soilp, filter_soilp, & waterdiagnosticbulk_inst, frictionvel_inst, dgvs_inst, cnveg_state_inst, crop_inst, & cnveg_carbonstate_inst, canopystate_inst) ! @@ -49,6 +50,7 @@ subroutine CNVegStructUpdate(num_soilp, filter_soilp, & use clm_time_manager , only : get_rad_step_size ! ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds integer , intent(in) :: num_soilp ! number of column soil points in patch filter integer , intent(in) :: filter_soilp(:) ! patch filter for soil points type(waterdiagnosticbulk_type) , intent(in) :: waterdiagnosticbulk_inst @@ -66,8 +68,8 @@ subroutine CNVegStructUpdate(num_soilp, filter_soilp, & ! !LOCAL VARIABLES: integer :: p,c,g ! indices integer :: fp ! lake filter indices - real(r8) :: taper ! ratio of height:radius_breast_height (tree allometry) - real(r8) :: stocking ! #stems / ha (stocking density) + real(r8) :: taper(bounds%begp:bounds%endp) ! ratio of height:radius_breast_height (tree allometry) + real(r8) :: stocking(bounds%begp:bounds%endp) ! #stems / ha (stocking density) real(r8) :: ol ! thickness of canopy layer covered by snow (m) real(r8) :: fb ! fraction of canopy layer covered by snow real(r8) :: tlai_old ! for use in Zeng tsai formula @@ -141,11 +143,18 @@ subroutine CNVegStructUpdate(num_soilp, filter_soilp, & dt = real( get_rad_step_size(), r8 ) ! constant allometric parameters - taper = 200._r8 - stocking = 1000._r8 - - ! convert from stems/ha -> stems/m^2 - stocking = stocking / 10000._r8 + taper(:) = 200._r8 + + if (use_biomass_heat_storage) then + do fp = 1,num_soilp + p = filter_soilp(fp) + stocking(p) = nstem(ivt(p)) + enddo + else + stocking(:) = 1000._r8 + ! convert from stems/ha -> stems/m^2 + stocking(:) = stocking(:) / 10000._r8 + endif ! patch loop do fp = 1,num_soilp @@ -192,10 +201,10 @@ subroutine CNVegStructUpdate(num_soilp, filter_soilp, & ! if shrubs have a squat taper if (ivt(p) >= nbrdlf_evr_shrub .and. ivt(p) <= nbrdlf_dcd_brl_shrub) then - taper = 10._r8 + taper(p) = 10._r8 ! otherwise have a tall taper else - taper = 200._r8 + taper(p) = 200._r8 end if ! trees and shrubs for now have a very simple allometry, with hard-wired @@ -204,9 +213,9 @@ subroutine CNVegStructUpdate(num_soilp, filter_soilp, & if (fpcgrid(p) > 0._r8 .and. nind(p) > 0._r8) then - stocking = nind(p)/fpcgrid(p) !#ind/m2 nat veg area -> #ind/m2 patch area + stocking(p) = nind(p)/fpcgrid(p) !#ind/m2 nat veg area -> #ind/m2 patch area htop(p) = allom2(ivt(p)) * ( (24._r8 * deadstemc(p) / & - (SHR_CONST_PI * stocking * dwood(ivt(p)) * taper))**(1._r8/3._r8) )**allom3(ivt(p)) ! lpj's htop w/ cn's stemdiam + (SHR_CONST_PI * stocking(p) * dwood(ivt(p)) * taper(p)))**(1._r8/3._r8) )**allom3(ivt(p)) ! lpj's htop w/ cn's stemdiam else htop(p) = 0._r8 @@ -215,11 +224,11 @@ subroutine CNVegStructUpdate(num_soilp, filter_soilp, & else !correct height calculation if doing accelerated spinup if (spinup_state == 2) then - htop(p) = ((3._r8 * deadstemc(p) * 10._r8 * taper * taper)/ & - (SHR_CONST_PI * nstem(ivt(p)) * dwood(ivt(p))))**(1._r8/3._r8) + htop(p) = ((3._r8 * deadstemc(p) * 10._r8 * taper(p) * taper(p))/ & + (SHR_CONST_PI * stocking(p) * dwood(ivt(p))))**(1._r8/3._r8) else - htop(p) = ((3._r8 * deadstemc(p) * taper * taper)/ & - (SHR_CONST_PI * nstem(ivt(p)) * dwood(ivt(p))))**(1._r8/3._r8) + htop(p) = ((3._r8 * deadstemc(p) * taper(p) * taper(p))/ & + (SHR_CONST_PI * stocking(p) * dwood(ivt(p))))**(1._r8/3._r8) end if endif diff --git a/src/biogeochem/CNVegetationFacade.F90 b/src/biogeochem/CNVegetationFacade.F90 index 44e904bf2c..d0741e68ff 100644 --- a/src/biogeochem/CNVegetationFacade.F90 +++ b/src/biogeochem/CNVegetationFacade.F90 @@ -1084,7 +1084,7 @@ subroutine EcosystemDynamicsPostDrainage(this, bounds, num_allc, filter_allc, & ! vegetation structure (LAI, SAI, height) if (doalb) then - call CNVegStructUpdate(num_soilp, filter_soilp, & + call CNVegStructUpdate(bounds,num_soilp, filter_soilp, & waterdiagnosticbulk_inst, frictionvel_inst, this%dgvs_inst, this%cnveg_state_inst, & crop_inst, this%cnveg_carbonstate_inst, canopystate_inst) end if From 2a04340a7b78e350cd0bc8200c4a630716b32403 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 16 Dec 2020 17:16:33 -0700 Subject: [PATCH 45/76] Update paramsfile to a ctsm5_1 one that has the new BHS terms on it --- bld/namelist_files/namelist_defaults_ctsm.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index 523ac2c1f9..9b28e857d6 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -472,7 +472,7 @@ attributes from the config_cache.xml file (with keys converted to upper-case). -lnd/clm2/paramdata/ctsm51_params.c200905.nc +lnd/clm2/paramdata/ctsm51_params.c201215.nc lnd/clm2/paramdata/clm50_params.c200905.nc lnd/clm2/paramdata/clm45_params.c200905.nc From b1610f80fd1a4b53d660b34a8dbf70523f1de854 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 16 Dec 2020 17:17:51 -0700 Subject: [PATCH 46/76] Set dhsdt_canopy to zero over lake --- src/biogeophys/LakeFluxesMod.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/biogeophys/LakeFluxesMod.F90 b/src/biogeophys/LakeFluxesMod.F90 index 3477c565d6..212d0ca7d1 100644 --- a/src/biogeophys/LakeFluxesMod.F90 +++ b/src/biogeophys/LakeFluxesMod.F90 @@ -269,6 +269,7 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, eflx_gnet => energyflux_inst%eflx_gnet_patch , & ! Output: [real(r8) (:) ] net heat flux into ground (W/m**2) taux => energyflux_inst%taux_patch , & ! Output: [real(r8) (:) ] wind (shear) stress: e-w (kg/m/s**2) tauy => energyflux_inst%tauy_patch , & ! Output: [real(r8) (:) ] wind (shear) stress: n-s (kg/m/s**2) + dhsdt_canopy => energyflux_inst%dhsdt_canopy_patch , & ! Output: [real(r8) (:) ] change in heat storage of stem (W/m**2) [+ to atm] ks => lakestate_inst%ks_col , & ! Output: [real(r8) (:) ] coefficient passed to LakeTemperature ws => lakestate_inst%ws_col , & ! Output: [real(r8) (:) ] surface friction velocity (m/s) @@ -377,6 +378,7 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, c = patch%column(p) g = patch%gridcell(p) + dhsdt_canopy(p) = 0.0_r8 nmozsgn(p) = 0 obuold(p) = 0._r8 displa(p) = 0._r8 From 876cf8c17b6ed2eb2aab2f02177405df04c300d1 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 16 Dec 2020 17:20:59 -0700 Subject: [PATCH 47/76] Set terms when BHS off to double precision, set nstem to exactly how stocking was set in CNVegStructUpdate (probably just needs to be double precision, but doing it the same to make sure) --- src/main/pftconMod.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/main/pftconMod.F90 b/src/main/pftconMod.F90 index e8924cbe36..219e556f51 100644 --- a/src/main/pftconMod.F90 +++ b/src/main/pftconMod.F90 @@ -1043,11 +1043,11 @@ subroutine InitRead(this) call ncd_io('wood_density',this%wood_density, 'read', ncid, readvar=readv) if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) else - this%dbh = 0.0 - this%fbw = 0.0 - this%nstem = 0.1 - this%rstem_per_dbh = 0.0 - this%wood_density = 0.0 + this%dbh = 0.0_r8 + this%fbw = 0.0_r8 + this%nstem = 1000._r8 / 10000._r8 + this%rstem_per_dbh = 0.0_r8 + this%wood_density = 0.0_r8 end if call ncd_pio_closefile(ncid) From 9d96016eca31ffc167c80c1fbe45ed62f71cfa00 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Fri, 18 Dec 2020 11:28:55 -0700 Subject: [PATCH 48/76] @swesosc found this update to min stem diameter allows the simulations to run --- src/biogeophys/CanopyFluxesMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/biogeophys/CanopyFluxesMod.F90 b/src/biogeophys/CanopyFluxesMod.F90 index a927066f97..36edd7761c 100644 --- a/src/biogeophys/CanopyFluxesMod.F90 +++ b/src/biogeophys/CanopyFluxesMod.F90 @@ -425,7 +425,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, real(r8), parameter :: k_cyl_vol = 1.0 !departure from cylindrical volume real(r8), parameter :: k_cyl_area = 1.0 !departure from cylindrical area real(r8), parameter :: k_internal = 0.0 !self-absorbtion of leaf/stem longwave - real(r8), parameter :: min_stem_diameter = 0.01!minimum stem diameter for which to calculate stem interactions + real(r8), parameter :: min_stem_diameter = 0.05!minimum stem diameter for which to calculate stem interactions integer :: dummy_to_make_pgi_happy !------------------------------------------------------------------------------ From 39e2f8625703a5ac4bb5e5025bb9c269838966b0 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Sun, 20 Dec 2020 00:55:32 -0700 Subject: [PATCH 49/76] Set new bhs variables on the params file for prognostic crop to the same as the values for grassland, they aren't actually used and the tests: ERS_Ly5_P144x1.f10_f10_musgs.IHistClm51BgcCrop.cheyenne_intel.clm-cropMonthOutput and SMS_Lm13.f19_g17.I2000Clm51BgcCrop.cheyenne_intel.clm-cropMonthOutput show that answers don't change. This is because effectively these parameters only matter for tree and shrubs and aren't used for other veg types --- bld/namelist_files/namelist_defaults_ctsm.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index 9b28e857d6..bd04e99e80 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -472,7 +472,7 @@ attributes from the config_cache.xml file (with keys converted to upper-case). -lnd/clm2/paramdata/ctsm51_params.c201215.nc +lnd/clm2/paramdata/ctsm51_params.c201220.nc lnd/clm2/paramdata/clm50_params.c200905.nc lnd/clm2/paramdata/clm45_params.c200905.nc From b23838a70314d89a0d2c9343bb837dd8b55ace20 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Sun, 20 Dec 2020 20:29:48 -0700 Subject: [PATCH 50/76] Add Clm51Sp compsets, as now answers will diverge from Clm50 for those cases --- cime_config/config_compsets.xml | 35 +++++++++++++++++++++++++++++++++ 1 file changed, 35 insertions(+) diff --git a/cime_config/config_compsets.xml b/cime_config/config_compsets.xml index cc947a7439..de0139fc63 100644 --- a/cime_config/config_compsets.xml +++ b/cime_config/config_compsets.xml @@ -36,6 +36,11 @@ + + I1PtClm51SpRs + 2000_DATM%1PT_CLM51%SP_SICE_SOCN_SROF_SGLC_SWAV + + I1PtClm50SpRs 2000_DATM%1PT_CLM50%SP_SICE_SOCN_SROF_SGLC_SWAV @@ -59,6 +64,17 @@ 2000_DATM%GSWP3v1_CLM50%SP_SICE_SOCN_SROF_SGLC_SWAV + + I2000Clm51Sp + 2000_DATM%GSWP3v1_CLM51%SP_SICE_SOCN_MOSART_SGLC_SWAV + + + + + I2000Clm51SpRs + 2000_DATM%GSWP3v1_CLM51%SP_SICE_SOCN_SROF_SGLC_SWAV + + I2000Clm50SpRtm @@ -128,6 +144,11 @@ + + I1850Clm51Sp + 1850_DATM%GSWP3v1_CLM51%SP_SICE_SOCN_MOSART_SGLC_SWAV + + I1850Clm51Bgc 1850_DATM%GSWP3v1_CLM51%BGC_SICE_SOCN_MOSART_SGLC_SWAV @@ -177,6 +198,10 @@ + + I2000Clm51Fates + 2000_DATM%GSWP3v1_CLM51%FATES_SICE_SOCN_MOSART_SGLC_SWAV + I2000Clm50Fates 2000_DATM%GSWP3v1_CLM50%FATES_SICE_SOCN_MOSART_SGLC_SWAV @@ -213,6 +238,16 @@ + + I1850Clm51SpNoAnthro + 1850_DATM%GSWP3v1_CLM51%SP-NOANTHRO_SICE_SOCN_MOSART_SGLC_SWAV + + + + IHistClm51Sp + HIST_DATM%GSWP3v1_CLM51%SP_SICE_SOCN_MOSART_SGLC_SWAV + + IHistClm51Bgc HIST_DATM%GSWP3v1_CLM51%BGC_SICE_SOCN_MOSART_SGLC_SWAV From 78baadc1bcbd52ae128edb9572f312e1213a3b3c Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Sun, 20 Dec 2020 20:52:15 -0700 Subject: [PATCH 51/76] Add two new Clm51 tests with Sp on --- cime_config/testdefs/testlist_clm.xml | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/cime_config/testdefs/testlist_clm.xml b/cime_config/testdefs/testlist_clm.xml index 2e3ff301f6..cebb54f7f5 100644 --- a/cime_config/testdefs/testlist_clm.xml +++ b/cime_config/testdefs/testlist_clm.xml @@ -381,12 +381,13 @@ - + + @@ -423,6 +424,15 @@ + + + + + + + + + From 50d751bf326fb9c7f958e794156806b1c4c3d8a9 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Mon, 21 Dec 2020 00:53:17 -0700 Subject: [PATCH 52/76] Convert a Clm50 Fates test to Clm51 since we now have changes that show up outside of BGC tests --- cime_config/testdefs/testlist_clm.xml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/cime_config/testdefs/testlist_clm.xml b/cime_config/testdefs/testlist_clm.xml index cebb54f7f5..c673d4e544 100644 --- a/cime_config/testdefs/testlist_clm.xml +++ b/cime_config/testdefs/testlist_clm.xml @@ -1973,12 +1973,13 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + + From 5d293bb0aa9e879fe585ccee1af511a413acfdce Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Mon, 21 Dec 2020 13:33:01 -0700 Subject: [PATCH 53/76] Some minor formatting changes and work on comments a bit --- src/biogeochem/CNVegStructUpdateMod.F90 | 6 +- src/biogeophys/BareGroundFluxesMod.F90 | 14 ++--- src/biogeophys/CanopyFluxesMod.F90 | 79 ++++++++++++++----------- src/biogeophys/SoilFluxesMod.F90 | 4 +- src/main/pftconMod.F90 | 4 ++ 5 files changed, 61 insertions(+), 46 deletions(-) diff --git a/src/biogeochem/CNVegStructUpdateMod.F90 b/src/biogeochem/CNVegStructUpdateMod.F90 index 1066c93e43..e3c529d119 100644 --- a/src/biogeochem/CNVegStructUpdateMod.F90 +++ b/src/biogeochem/CNVegStructUpdateMod.F90 @@ -233,15 +233,17 @@ subroutine CNVegStructUpdate(bounds,num_soilp, filter_soilp, & endif + ! ! calculate vegetation physiological parameters used in biomass heat storage + ! if (use_biomass_heat_storage) then - ! Assumes fbw the same for leaves and stems + ! Assumes fbw (fraction of biomass that is water) is the same for leaves and stems leaf_biomass(p) = max(0.0025_r8,leafc(p)) & * c_to_b * 1.e-3_r8 / (1._r8 - fbw(ivt(p))) stem_biomass(p) = (deadstemc(p) + livestemc(p)) & * c_to_b * 1.e-3_r8 / (1._r8 - fbw(ivt(p))) - + if (spinup_state == 2) then stem_biomass(p) = 10._r8 * stem_biomass(p) end if diff --git a/src/biogeophys/BareGroundFluxesMod.F90 b/src/biogeophys/BareGroundFluxesMod.F90 index 7520543de9..89893e3aa4 100644 --- a/src/biogeophys/BareGroundFluxesMod.F90 +++ b/src/biogeophys/BareGroundFluxesMod.F90 @@ -146,8 +146,8 @@ subroutine BareGroundFluxes(bounds, num_noexposedvegp, filter_noexposedvegp, & !------------------------------------------------------------------------------ associate( & - dhsdt_canopy => energyflux_inst%dhsdt_canopy_patch , & ! Output: [real(r8) (:) ] change in heat storage of stem (W/m**2) [+ to atm] - eflx_sh_stem => energyflux_inst%eflx_sh_stem_patch , & ! Output: [real(r8) (:) ] sensible heat flux from stems (W/m**2) [+ to atm] + dhsdt_canopy => energyflux_inst%dhsdt_canopy_patch , & ! Output: [real(r8) (:) ] change in heat storage of stem (W/m**2) [+ to atm] + eflx_sh_stem => energyflux_inst%eflx_sh_stem_patch , & ! Output: [real(r8) (:) ] sensible heat flux from stems (W/m**2) [+ to atm] soilresis => soilstate_inst%soilresis_col , & ! Input: [real(r8) (:,:) ] evaporative soil resistance (s/m) snl => col%snl , & ! Input: [integer (:) ] number of snow layers dz => col%dz , & ! Input: [real(r8) (:,:) ] layer depth (m) @@ -244,11 +244,11 @@ subroutine BareGroundFluxes(bounds, num_noexposedvegp, filter_noexposedvegp, & ram1 => frictionvel_inst%ram1_patch , & ! Output: [real(r8) (:) ] aerodynamical resistance (s/m) num_iter => frictionvel_inst%num_iter_patch , & ! Output: [real(r8) (:) ] number of iterations htvp => energyflux_inst%htvp_col , & ! Input: [real(r8) (:) ] latent heat of evaporation (/sublimation) [J/kg] - qflx_ev_snow => waterfluxbulk_inst%qflx_ev_snow_patch , & ! Output: [real(r8) (:) ] evaporation flux from snow (mm H2O/s) [+ to atm] - qflx_ev_soil => waterfluxbulk_inst%qflx_ev_soil_patch , & ! Output: [real(r8) (:) ] evaporation flux from soil (mm H2O/s) [+ to atm] - qflx_ev_h2osfc => waterfluxbulk_inst%qflx_ev_h2osfc_patch , & ! Output: [real(r8) (:) ] evaporation flux from h2osfc (mm H2O/s) [+ to atm] - qflx_evap_soi => waterfluxbulk_inst%qflx_evap_soi_patch , & ! Output: [real(r8) (:) ] soil evaporation (mm H2O/s) (+ = to atm) - qflx_evap_tot => waterfluxbulk_inst%qflx_evap_tot_patch , & ! Output: [real(r8) (:) ] qflx_evap_soi + qflx_evap_can + qflx_tran_veg + qflx_ev_snow => waterfluxbulk_inst%qflx_ev_snow_patch , & ! Output: [real(r8) (:) ] evaporation flux from snow (mm H2O/s) [+ to atm] + qflx_ev_soil => waterfluxbulk_inst%qflx_ev_soil_patch , & ! Output: [real(r8) (:) ] evaporation flux from soil (mm H2O/s) [+ to atm] + qflx_ev_h2osfc => waterfluxbulk_inst%qflx_ev_h2osfc_patch , & ! Output: [real(r8) (:) ] evaporation flux from h2osfc (mm H2O/s) [+ to atm] + qflx_evap_soi => waterfluxbulk_inst%qflx_evap_soi_patch , & ! Output: [real(r8) (:) ] soil evaporation (mm H2O/s) (+ = to atm) + qflx_evap_tot => waterfluxbulk_inst%qflx_evap_tot_patch , & ! Output: [real(r8) (:) ] qflx_evap_soi + qflx_evap_can + qflx_tran_veg qflx_tran_veg => waterfluxbulk_inst%qflx_tran_veg_patch , & ! Output: [real(r8) (:) ] vegetation transpiration (mm H2O/s) (+ = to atm) qflx_evap_veg => waterfluxbulk_inst%qflx_evap_veg_patch , & ! Output: [real(r8) (:) ] vegetation evaporation (mm H2O/s) (+ = to atm) diff --git a/src/biogeophys/CanopyFluxesMod.F90 b/src/biogeophys/CanopyFluxesMod.F90 index 36edd7761c..eba84b814e 100644 --- a/src/biogeophys/CanopyFluxesMod.F90 +++ b/src/biogeophys/CanopyFluxesMod.F90 @@ -51,7 +51,7 @@ module CanopyFluxesMod ! ! !PUBLIC TYPES: implicit none - ! + ! ! !PUBLIC MEMBER FUNCTIONS: public :: CanopyFluxesReadNML ! Read in namelist settings public :: CanopyFluxes ! Calculate canopy fluxes @@ -299,8 +299,8 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, real(r8) :: rppdry ! fraction of potential evaporation through transp [-] real(r8) :: cf ! heat transfer coefficient from leaves [-] real(r8) :: rb(bounds%begp:bounds%endp) ! leaf boundary layer resistance [s/m] - real(r8) :: rah(bounds%begp:bounds%endp,2) ! thermal resistance [s/m] - real(r8) :: raw(bounds%begp:bounds%endp,2) ! moisture resistance [s/m] + real(r8) :: rah(bounds%begp:bounds%endp,2) ! thermal resistance [s/m] (air, ground) + real(r8) :: raw(bounds%begp:bounds%endp,2) ! moisture resistance [s/m] (air, ground) real(r8) :: wta ! heat conductance for air [m/s] real(r8) :: wtg(bounds%begp:bounds%endp) ! heat conductance for ground [m/s] real(r8) :: wtl ! heat conductance for leaf [m/s] @@ -418,15 +418,18 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, real(r8) :: uuc(bounds%begp:bounds%endp) ! undercanopy windspeed real(r8) :: carea_stem !cross-sectional area of stem + ! Indices for raw and rah + integer, parameter :: above_canopy = 1 ! Above canopy + integer, parameter :: below_canopy = 2 ! Below canopy ! Biomass heat storage tuning parameters ! These parameters can be used to account for differences ! in vegetation shape. - real(r8), parameter :: k_vert = 0.1 !vertical distribution of stem - real(r8), parameter :: k_cyl_vol = 1.0 !departure from cylindrical volume - real(r8), parameter :: k_cyl_area = 1.0 !departure from cylindrical area - real(r8), parameter :: k_internal = 0.0 !self-absorbtion of leaf/stem longwave - real(r8), parameter :: min_stem_diameter = 0.05!minimum stem diameter for which to calculate stem interactions - + real(r8), parameter :: k_vert = 0.1 !vertical distribution of stem + real(r8), parameter :: k_cyl_vol = 1.0 !departure from cylindrical volume + real(r8), parameter :: k_cyl_area = 1.0 !departure from cylindrical area + real(r8), parameter :: k_internal = 0.0 !self-absorbtion of leaf/stem longwave + real(r8), parameter :: min_stem_diameter = 0.05 !minimum stem diameter for which to calculate stem interactions + integer :: dummy_to_make_pgi_happy !------------------------------------------------------------------------------ @@ -434,10 +437,10 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, SHR_ASSERT_ALL_FL((ubound(leafn_patch) == (/bounds%endp/)), sourcefile, __LINE__) associate( & - t_stem => temperature_inst%t_stem_patch , & ! Output: [real(r8) (:) ] stem temperature (Kelvin) - dhsdt_canopy => energyflux_inst%dhsdt_canopy_patch , & ! Output: [real(r8) (:) ] change in heat storage of stem (W/m**2) [+ to atm] + t_stem => temperature_inst%t_stem_patch , & ! Output: [real(r8) (:) ] stem temperature (Kelvin) + dhsdt_canopy => energyflux_inst%dhsdt_canopy_patch , & ! Output: [real(r8) (:) ] change in heat storage of stem (W/m**2) [+ to atm] soilresis => soilstate_inst%soilresis_col , & ! Input: [real(r8) (:) ] soil evaporative resistance - snl => col%snl , & ! Input: [integer (:) ] number of snow layers + snl => col%snl , & ! Input: [integer (:) ] number of snow layers dayl => grc%dayl , & ! Input: [real(r8) (:) ] daylength (s) max_dayl => grc%max_dayl , & ! Input: [real(r8) (:) ] maximum daylength for this grid cell (s) is_tree => pftcon%is_tree , & ! Input: tree patch or not @@ -446,11 +449,11 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, dbh_param => pftcon%dbh , & ! Input: diameter at brest height (m) fbw => pftcon%fbw , & ! Input: fraction of biomass that is water nstem => pftcon%nstem , & ! Input: stem number density (#ind/m2) - rstem_per_dbh => pftcon%rstem_per_dbh , & ! Input: stem resistance per stem diameter (s/m**2) + rstem_per_dbh => pftcon%rstem_per_dbh , & ! Input: stem resistance per stem diameter (s/m**2) wood_density => pftcon%wood_density , & ! Input: dry wood density (kg/m3) forc_lwrad => atm2lnd_inst%forc_lwrad_downscaled_col , & ! Input: [real(r8) (:) ] downward infrared (longwave) radiation (W/m**2) - forc_q => wateratm2lndbulk_inst%forc_q_downscaled_col , & ! Input: [real(r8) (:) ] atmospheric specific humidity (kg/kg) + forc_q => wateratm2lndbulk_inst%forc_q_downscaled_col , & ! Input: [real(r8) (:) ] atmospheric specific humidity (kg/kg) forc_pbot => atm2lnd_inst%forc_pbot_downscaled_col , & ! Input: [real(r8) (:) ] atmospheric pressure (Pa) forc_th => atm2lnd_inst%forc_th_downscaled_col , & ! Input: [real(r8) (:) ] atmospheric potential temperature (Kelvin) forc_rho => atm2lnd_inst%forc_rho_downscaled_col , & ! Input: [real(r8) (:) ] density (kg/m**3) @@ -581,7 +584,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, eflx_sh_snow => energyflux_inst%eflx_sh_snow_patch , & ! Output: [real(r8) (:) ] sensible heat flux from snow (W/m**2) [+ to atm] eflx_sh_h2osfc => energyflux_inst%eflx_sh_h2osfc_patch , & ! Output: [real(r8) (:) ] sensible heat flux from soil (W/m**2) [+ to atm] eflx_sh_soil => energyflux_inst%eflx_sh_soil_patch , & ! Output: [real(r8) (:) ] sensible heat flux from soil (W/m**2) [+ to atm] - eflx_sh_stem => energyflux_inst%eflx_sh_stem_patch , & ! Output: [real(r8) (:) ] sensible heat flux from stems (W/m**2) [+ to atm] + eflx_sh_stem => energyflux_inst%eflx_sh_stem_patch , & ! Output: [real(r8) (:) ] sensible heat flux from stems (W/m**2) [+ to atm] eflx_sh_veg => energyflux_inst%eflx_sh_veg_patch , & ! Output: [real(r8) (:) ] sensible heat flux from leaves (W/m**2) [+ to atm] eflx_sh_grnd => energyflux_inst%eflx_sh_grnd_patch , & ! Output: [real(r8) (:) ] sensible heat flux from ground (W/m**2) [+ to atm] rah1 => frictionvel_inst%rah1_patch , & ! Output: [real(r8) (:) ] aerodynamical resistance [s/m] @@ -679,7 +682,9 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, eflx_sh_stem(p) = 0._r8 end do - ! calculate biomass heat capacities + ! + ! Calculate biomass heat capacities + ! if(use_biomass_heat_storage) then bioms: do f = 1, fn p = filterp(f) @@ -709,18 +714,21 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ! double in spirit of full surface area for sensible heat sa_leaf(p) = 2.*sa_leaf(p) + ! Surface area for stem sa_stem(p) = nstem(patch%itype(p))*(htop(p)*shr_const_pi*dbh(p)) ! adjust for departure of cylindrical stem model sa_stem(p) = k_cyl_area * sa_stem(p) + ! ! only calculate separate leaf/stem heat capacity for trees ! and shrubs if dbh is greater than some minimum value + ! (set surface area for stem, and fraction absorbed by stem to zero) if(.not.(is_tree(patch%itype(p)) .or. is_shrub(patch%itype(p))) & .or. dbh(p) < min_stem_diameter) then frac_rad_abs_by_stem(p) = 0.0 sa_stem(p) = 0.0 endif - + ! cross-sectional area of stems carea_stem = shr_const_pi * (dbh(p)*0.5)**2 @@ -733,7 +741,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, * nstem(patch%itype(p)) * wood_density(patch%itype(p)) & /(1.-fbw(patch%itype(p))) endif - + ! internal longwave fluxes between leaf and stem ! (use same area of interaction i.e. ignore leaf <-> leaf) sa_internal(p) = min(sa_leaf(p),sa_stem(p)) @@ -753,7 +761,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ! resistance between internal stem temperature and canopy air rstem(p) = rstem_per_dbh(patch%itype(p))*dbh(p) - + enddo bioms else ! Otherwise set biomass heat storage terms to zero @@ -847,7 +855,8 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, end if - ! Modify aerodynamic parameters for sparse/dense canopy (X. Zeng) + !! Modify aerodynamic parameters for sparse/dense canopy (X. Zeng) + do f = 1, fn p = filterp(f) c = patch%column(p) @@ -1008,7 +1017,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, else csoilcn = csoilb*w + params_inst%csoilc*(1._r8-w) end if - + !! Sakaguchi changes for stability formulation ends here if (use_biomass_heat_storage) then @@ -1030,10 +1039,10 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, eah(p) = forc_pbot(c) * qaf(p) / 0.622_r8 ! pa rhaf(p) = eah(p)/svpts(p) ! variables for history fields - rah1(p) = rah(p,1) - raw1(p) = raw(p,1) - rah2(p) = rah(p,2) - raw2(p) = raw(p,2) + rah1(p) = rah(p,1) + raw1(p) = raw(p,1) + rah2(p) = rah(p,2) + raw2(p) = raw(p,2) vpd(p) = max((svpts(p) - eah(p)), 50._r8) * 0.001_r8 end do @@ -1093,12 +1102,12 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ! Sensible heat conductance for air, leaf and ground ! Moved the original subroutine in-line... - wta = 1._r8/rah(p,1) ! air - wtl = sa_leaf(p)/rb(p) ! leaf - wtg(p) = 1._r8/rah(p,2) ! ground - wtstem = sa_stem(p)/(rstem(p) + rb(p)) ! stem + wta = 1._r8/rah(p,1) ! air + wtl = sa_leaf(p)/rb(p) ! leaf + wtg(p) = 1._r8/rah(p,2) ! ground + wtstem = sa_stem(p)/(rstem(p) + rb(p)) ! stem - wtshi = 1._r8/(wta+wtl+wtstem+wtg(p)) + wtshi = 1._r8/(wta+wtl+wtstem+wtg(p)) ! air, leaf, stem and ground wtl0(p) = wtl*wtshi ! leaf wtg0 = wtg(p)*wtshi ! ground @@ -1111,7 +1120,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ! internal longwave fluxes between leaf and stem lw_stem(p) = sa_internal(p) * emv(p) * sb * t_stem(p)**4 lw_leaf(p) = sa_internal(p) * emv(p) * sb * t_veg(p)**4 - + ! Fraction of potential evaporation from leaf if (fdry(p) > 0._r8) then @@ -1225,7 +1234,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, +dc1*wtga(p) +dc2*wtgaq*qsatldT(p) + cp_leaf(p)/dtime) t_veg(p) = tlbef(p) + dt_veg(p) - + dels = dt_veg(p) del(p) = abs(dels) err(p) = 0._r8 @@ -1379,7 +1388,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, - ((t_veg(p)-tl_ini(p))*cp_leaf(p)/dtime) ! Update stem temperature; adjust outgoing longwave - ! does not account for changes in SH or internal LW, + ! does not account for changes in SH or internal LW, ! as that would change result for t_veg above if (use_biomass_heat_storage) then if (stem_biomass(p) > 0._r8) then @@ -1390,10 +1399,10 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, else dt_stem(p) = 0._r8 endif - + dhsdt_canopy(p) = dt_stem(p)*cp_stem(p)/dtime & +(t_veg(p)-tl_ini(p))*cp_leaf(p)/dtime - + t_stem(p) = t_stem(p) + dt_stem(p) else dt_stem(p) = 0._r8 diff --git a/src/biogeophys/SoilFluxesMod.F90 b/src/biogeophys/SoilFluxesMod.F90 index e9fa942afa..10082db373 100644 --- a/src/biogeophys/SoilFluxesMod.F90 +++ b/src/biogeophys/SoilFluxesMod.F90 @@ -88,7 +88,7 @@ subroutine SoilFluxes (bounds, num_urbanl, filter_urbanl, & !----------------------------------------------------------------------- associate( & - eflx_sh_stem => energyflux_inst%eflx_sh_stem_patch , & ! Output: [real(r8) (:) ] sensible heat flux from stems (W/m**2) [+ to atm] + eflx_sh_stem => energyflux_inst%eflx_sh_stem_patch , & ! Output: [real(r8) (:) ] sensible heat flux from stems (W/m**2) [+ to atm] eflx_h2osfc_to_snow_col => energyflux_inst%eflx_h2osfc_to_snow_col , & ! Input: [real(r8) (:) ] col snow melt to h2osfc heat flux (W/m**2) forc_lwrad => atm2lnd_inst%forc_lwrad_downscaled_col , & ! Input: [real(r8) (:) ] downward infrared (longwave) radiation (W/m**2) @@ -316,7 +316,7 @@ subroutine SoilFluxes (bounds, num_urbanl, filter_urbanl, & ! Total fluxes (vegetation + ground) eflx_sh_tot(p) = eflx_sh_veg(p) + eflx_sh_grnd(p) - if (.not. lun%urbpoi(l)) eflx_sh_tot(p) = eflx_sh_tot(p) + eflx_sh_stem(p) + if (.not. lun%urbpoi(l)) eflx_sh_tot(p) = eflx_sh_tot(p) + eflx_sh_stem(p) qflx_evap_tot(p) = qflx_evap_veg(p) + qflx_evap_soi(p) eflx_lh_tot(p)= hvap*qflx_evap_veg(p) + htvp(c)*qflx_evap_soi(p) if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then diff --git a/src/main/pftconMod.F90 b/src/main/pftconMod.F90 index 219e556f51..d80ffa1acb 100644 --- a/src/main/pftconMod.F90 +++ b/src/main/pftconMod.F90 @@ -1032,6 +1032,10 @@ subroutine InitRead(this) ! Biomass heat storage variables ! if (use_biomass_heat_storage ) then + ! + ! These variables are used for stem biomass and only for tree and shrub + ! (They are effectively unused for other veg types) + ! call ncd_io('dbh',this%dbh, 'read', ncid, readvar=readv) if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) call ncd_io('fbw',this%fbw, 'read', ncid, readvar=readv) From 51748a003affae62eae1a361a120bd85cd9b984a Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Mon, 21 Dec 2020 13:50:14 -0700 Subject: [PATCH 54/76] Use index parameters rather than hardcoded indices to better document what is going on --- src/biogeophys/CanopyFluxesMod.F90 | 32 +++++++++++++++--------------- 1 file changed, 16 insertions(+), 16 deletions(-) diff --git a/src/biogeophys/CanopyFluxesMod.F90 b/src/biogeophys/CanopyFluxesMod.F90 index eba84b814e..56e3f6390a 100644 --- a/src/biogeophys/CanopyFluxesMod.F90 +++ b/src/biogeophys/CanopyFluxesMod.F90 @@ -972,8 +972,8 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ! Determine aerodynamic resistances ram1(p) = 1._r8/(ustar(p)*ustar(p)/um(p)) - rah(p,1) = 1._r8/(temp1(p)*ustar(p)) - raw(p,1) = 1._r8/(temp2(p)*ustar(p)) + rah(p,above_canopy) = 1._r8/(temp1(p)*ustar(p)) + raw(p,above_canopy) = 1._r8/(temp2(p)*ustar(p)) ! Bulk boundary layer resistance of leaves @@ -1022,14 +1022,14 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, if (use_biomass_heat_storage) then ! use uuc for ground fluxes (keep uaf for canopy terms) - rah(p,2) = 1._r8/(csoilcn*uuc(p)) + rah(p,below_canopy) = 1._r8/(csoilcn*uuc(p)) else - rah(p,2) = 1._r8/(csoilcn*uaf(p)) + rah(p,below_canopy) = 1._r8/(csoilcn*uaf(p)) endif - raw(p,2) = rah(p,2) + raw(p,below_canopy) = rah(p,below_canopy) if (use_lch4) then - grnd_ch4_cond(p) = 1._r8/(raw(p,1)+raw(p,2)) + grnd_ch4_cond(p) = 1._r8/(raw(p,above_canopy)+raw(p,below_canopy)) end if ! Stomatal resistances for sunlit and shaded fractions of canopy. @@ -1039,10 +1039,10 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, eah(p) = forc_pbot(c) * qaf(p) / 0.622_r8 ! pa rhaf(p) = eah(p)/svpts(p) ! variables for history fields - rah1(p) = rah(p,1) - raw1(p) = raw(p,1) - rah2(p) = rah(p,2) - raw2(p) = raw(p,2) + rah1(p) = rah(p,above_canopy) + raw1(p) = raw(p,above_canopy) + rah2(p) = rah(p,below_canopy) + raw2(p) = raw(p,below_canopy) vpd(p) = max((svpts(p) - eah(p)), 50._r8) * 0.001_r8 end do @@ -1102,9 +1102,9 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ! Sensible heat conductance for air, leaf and ground ! Moved the original subroutine in-line... - wta = 1._r8/rah(p,1) ! air + wta = 1._r8/rah(p,above_canopy) ! air wtl = sa_leaf(p)/rb(p) ! leaf - wtg(p) = 1._r8/rah(p,2) ! ground + wtg(p) = 1._r8/rah(p,below_canopy) ! ground wtstem = sa_stem(p)/(rstem(p) + rb(p)) ! stem wtshi = 1._r8/(wta+wtl+wtstem+wtg(p)) ! air, leaf, stem and ground @@ -1175,7 +1175,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ! Air has same conductance for both sensible and latent heat. ! Moved the original subroutine in-line... - wtaq = frac_veg_nosno(p)/raw(p,1) ! air + wtaq = frac_veg_nosno(p)/raw(p,above_canopy) ! air wtlq = frac_veg_nosno(p)*(elai(p)+esai(p))/rb(p) * rpp ! leaf !Litter layer resistance. Added by K.Sakaguchi @@ -1186,13 +1186,13 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ! add litter resistance and Lee and Pielke 1992 beta if (delq(p) < 0._r8) then !dew. Do not apply beta for negative flux (follow old rsoil) - wtgq(p) = frac_veg_nosno(p)/(raw(p,2)+rdl) + wtgq(p) = frac_veg_nosno(p)/(raw(p,below_canopy)+rdl) else if (do_soilevap_beta()) then - wtgq(p) = soilbeta(c)*frac_veg_nosno(p)/(raw(p,2)+rdl) + wtgq(p) = soilbeta(c)*frac_veg_nosno(p)/(raw(p,below_canopy)+rdl) endif if (do_soil_resistance_sl14()) then - wtgq(p) = frac_veg_nosno(p)/(raw(p,2)+soilresis(c)) + wtgq(p) = frac_veg_nosno(p)/(raw(p,below_canopy)+soilresis(c)) endif end if From 7856d9927ac945a7175995536043680ad13c9742 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Mon, 21 Dec 2020 15:08:39 -0700 Subject: [PATCH 55/76] Use nstem whether use_biomass_heat_storage is on or not, answers remain identical --- src/biogeochem/CNVegStructUpdateMod.F90 | 14 ++++---------- 1 file changed, 4 insertions(+), 10 deletions(-) diff --git a/src/biogeochem/CNVegStructUpdateMod.F90 b/src/biogeochem/CNVegStructUpdateMod.F90 index e3c529d119..dde7fb27c5 100644 --- a/src/biogeochem/CNVegStructUpdateMod.F90 +++ b/src/biogeochem/CNVegStructUpdateMod.F90 @@ -145,16 +145,10 @@ subroutine CNVegStructUpdate(bounds,num_soilp, filter_soilp, & ! constant allometric parameters taper(:) = 200._r8 - if (use_biomass_heat_storage) then - do fp = 1,num_soilp - p = filter_soilp(fp) - stocking(p) = nstem(ivt(p)) - enddo - else - stocking(:) = 1000._r8 - ! convert from stems/ha -> stems/m^2 - stocking(:) = stocking(:) / 10000._r8 - endif + do fp = 1,num_soilp + p = filter_soilp(fp) + stocking(p) = nstem(ivt(p)) + enddo ! patch loop do fp = 1,num_soilp From 9085b77dcd4a41e736c943745b69f98365e86479 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Mon, 21 Dec 2020 15:26:24 -0700 Subject: [PATCH 56/76] Set stocking back to a scalar and only use for CNDV, use nstem directly otherwise, which removes some extra memory use and hence should be more efficient --- src/biogeochem/CNVegStructUpdateMod.F90 | 17 ++++++----------- 1 file changed, 6 insertions(+), 11 deletions(-) diff --git a/src/biogeochem/CNVegStructUpdateMod.F90 b/src/biogeochem/CNVegStructUpdateMod.F90 index dde7fb27c5..5dfb64f68b 100644 --- a/src/biogeochem/CNVegStructUpdateMod.F90 +++ b/src/biogeochem/CNVegStructUpdateMod.F90 @@ -69,7 +69,7 @@ subroutine CNVegStructUpdate(bounds,num_soilp, filter_soilp, & integer :: p,c,g ! indices integer :: fp ! lake filter indices real(r8) :: taper(bounds%begp:bounds%endp) ! ratio of height:radius_breast_height (tree allometry) - real(r8) :: stocking(bounds%begp:bounds%endp) ! #stems / ha (stocking density) + real(r8) :: stocking ! #stems / ha (stocking density) real(r8) :: ol ! thickness of canopy layer covered by snow (m) real(r8) :: fb ! fraction of canopy layer covered by snow real(r8) :: tlai_old ! for use in Zeng tsai formula @@ -145,11 +145,6 @@ subroutine CNVegStructUpdate(bounds,num_soilp, filter_soilp, & ! constant allometric parameters taper(:) = 200._r8 - do fp = 1,num_soilp - p = filter_soilp(fp) - stocking(p) = nstem(ivt(p)) - enddo - ! patch loop do fp = 1,num_soilp p = filter_soilp(fp) @@ -202,14 +197,14 @@ subroutine CNVegStructUpdate(bounds,num_soilp, filter_soilp, & end if ! trees and shrubs for now have a very simple allometry, with hard-wired - ! stem taper (height:radius) and hard-wired stocking density (#individuals/area) + ! stem taper (height:radius) and nstem from PFT parameter file if (use_cndv) then if (fpcgrid(p) > 0._r8 .and. nind(p) > 0._r8) then - stocking(p) = nind(p)/fpcgrid(p) !#ind/m2 nat veg area -> #ind/m2 patch area + stocking = nind(p)/fpcgrid(p) !#ind/m2 nat veg area -> #ind/m2 patch area htop(p) = allom2(ivt(p)) * ( (24._r8 * deadstemc(p) / & - (SHR_CONST_PI * stocking(p) * dwood(ivt(p)) * taper(p)))**(1._r8/3._r8) )**allom3(ivt(p)) ! lpj's htop w/ cn's stemdiam + (SHR_CONST_PI * stocking * dwood(ivt(p)) * taper(p)))**(1._r8/3._r8) )**allom3(ivt(p)) ! lpj's htop w/ cn's stemdiam else htop(p) = 0._r8 @@ -219,10 +214,10 @@ subroutine CNVegStructUpdate(bounds,num_soilp, filter_soilp, & !correct height calculation if doing accelerated spinup if (spinup_state == 2) then htop(p) = ((3._r8 * deadstemc(p) * 10._r8 * taper(p) * taper(p))/ & - (SHR_CONST_PI * stocking(p) * dwood(ivt(p))))**(1._r8/3._r8) + (SHR_CONST_PI * nstem(ivt(p)) * dwood(ivt(p))))**(1._r8/3._r8) else htop(p) = ((3._r8 * deadstemc(p) * taper(p) * taper(p))/ & - (SHR_CONST_PI * stocking(p) * dwood(ivt(p))))**(1._r8/3._r8) + (SHR_CONST_PI * nstem(ivt(p)) * dwood(ivt(p))))**(1._r8/3._r8) end if endif From a354746c7187616ce29afefb78cdab4f221ce4b1 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Mon, 21 Dec 2020 16:56:40 -0700 Subject: [PATCH 57/76] Put taper as a hardcoded parameter in pftcon, use it rather than a large array. This improves memory efficiency and simplifies the CN code, also verify with SMS_Lm1.f10_f10_musgs.I1850Clm50BgcCropCmip6waccm.cheyenne_gnu.clm-basic that answers are identical --- src/biogeochem/CNVegStructUpdateMod.F90 | 21 ++++----------------- src/main/pftconMod.F90 | 10 ++++++++++ 2 files changed, 14 insertions(+), 17 deletions(-) diff --git a/src/biogeochem/CNVegStructUpdateMod.F90 b/src/biogeochem/CNVegStructUpdateMod.F90 index 5dfb64f68b..1cb7dad82f 100644 --- a/src/biogeochem/CNVegStructUpdateMod.F90 +++ b/src/biogeochem/CNVegStructUpdateMod.F90 @@ -68,7 +68,6 @@ subroutine CNVegStructUpdate(bounds,num_soilp, filter_soilp, & ! !LOCAL VARIABLES: integer :: p,c,g ! indices integer :: fp ! lake filter indices - real(r8) :: taper(bounds%begp:bounds%endp) ! ratio of height:radius_breast_height (tree allometry) real(r8) :: stocking ! #stems / ha (stocking density) real(r8) :: ol ! thickness of canopy layer covered by snow (m) real(r8) :: fb ! fraction of canopy layer covered by snow @@ -105,6 +104,7 @@ subroutine CNVegStructUpdate(bounds,num_soilp, filter_soilp, & ztopmx => pftcon%ztopmx , & ! Input: laimx => pftcon%laimx , & ! Input: nstem => pftcon%nstem , & ! Input: Tree number density (#ind/m2) + taper => pftcon%taper , & ! Input: ratio of height:radius_breast_height (tree allometry) fbw => pftcon%fbw , & ! Input: Fraction of fresh biomass that is water allom2 => dgv_ecophyscon%allom2 , & ! Input: [real(r8) (:) ] ecophys const @@ -142,9 +142,6 @@ subroutine CNVegStructUpdate(bounds,num_soilp, filter_soilp, & dt = real( get_rad_step_size(), r8 ) - ! constant allometric parameters - taper(:) = 200._r8 - ! patch loop do fp = 1,num_soilp p = filter_soilp(fp) @@ -186,16 +183,6 @@ subroutine CNVegStructUpdate(bounds,num_soilp, filter_soilp, & if (woody(ivt(p)) == 1._r8) then - ! trees and shrubs - - ! if shrubs have a squat taper - if (ivt(p) >= nbrdlf_evr_shrub .and. ivt(p) <= nbrdlf_dcd_brl_shrub) then - taper(p) = 10._r8 - ! otherwise have a tall taper - else - taper(p) = 200._r8 - end if - ! trees and shrubs for now have a very simple allometry, with hard-wired ! stem taper (height:radius) and nstem from PFT parameter file if (use_cndv) then @@ -204,7 +191,7 @@ subroutine CNVegStructUpdate(bounds,num_soilp, filter_soilp, & stocking = nind(p)/fpcgrid(p) !#ind/m2 nat veg area -> #ind/m2 patch area htop(p) = allom2(ivt(p)) * ( (24._r8 * deadstemc(p) / & - (SHR_CONST_PI * stocking * dwood(ivt(p)) * taper(p)))**(1._r8/3._r8) )**allom3(ivt(p)) ! lpj's htop w/ cn's stemdiam + (SHR_CONST_PI * stocking * dwood(ivt(p)) * taper(ivt(p))))**(1._r8/3._r8) )**allom3(ivt(p)) ! lpj's htop w/ cn's stemdiam else htop(p) = 0._r8 @@ -213,10 +200,10 @@ subroutine CNVegStructUpdate(bounds,num_soilp, filter_soilp, & else !correct height calculation if doing accelerated spinup if (spinup_state == 2) then - htop(p) = ((3._r8 * deadstemc(p) * 10._r8 * taper(p) * taper(p))/ & + htop(p) = ((3._r8 * deadstemc(p) * 10._r8 * taper(ivt(p)) * taper(ivt(p)))/ & (SHR_CONST_PI * nstem(ivt(p)) * dwood(ivt(p))))**(1._r8/3._r8) else - htop(p) = ((3._r8 * deadstemc(p) * taper(p) * taper(p))/ & + htop(p) = ((3._r8 * deadstemc(p) * taper(ivt(p)) * taper(ivt(p)))/ & (SHR_CONST_PI * nstem(ivt(p)) * dwood(ivt(p))))**(1._r8/3._r8) end if diff --git a/src/main/pftconMod.F90 b/src/main/pftconMod.F90 index d80ffa1acb..91851e8626 100644 --- a/src/main/pftconMod.F90 +++ b/src/main/pftconMod.F90 @@ -152,6 +152,7 @@ module pftconMod real(r8), allocatable :: dbh (:) ! diameter at breast height (m) real(r8), allocatable :: fbw (:) ! fraction of biomass that is water real(r8), allocatable :: nstem (:) ! stem density (#/m2) + real(r8), allocatable :: taper (:) ! tapering ratio of height:radius_breast_height real(r8), allocatable :: rstem_per_dbh (:) ! stem resistance per dbh (s/m/m) real(r8), allocatable :: wood_density (:) ! wood density (kg/m3) @@ -480,6 +481,7 @@ subroutine InitAllocate (this) allocate( this%dbh (0:mxpft) ) allocate( this%fbw (0:mxpft) ) allocate( this%nstem (0:mxpft) ) + allocate( this%taper (0:mxpft) ) allocate( this%rstem_per_dbh (0:mxpft) ) allocate( this%wood_density (0:mxpft) ) @@ -1053,6 +1055,7 @@ subroutine InitRead(this) this%rstem_per_dbh = 0.0_r8 this%wood_density = 0.0_r8 end if + this%taper = 200._r8 ! Initialize taper to the same value everywhere (below change it for shrub) call ncd_pio_closefile(ncid) @@ -1175,6 +1178,13 @@ subroutine InitRead(this) else this%is_grass(m) = .false. endif + + ! Set taper differently if shrub + if ( this%is_shrub(m) )then + this%taper(m) = 10._r8 + else + this%taper(m) = 200._r8 + end if end do From 026d506401c6fb0b971f8b58547bd6aa6bb383eb Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Mon, 21 Dec 2020 17:35:12 -0700 Subject: [PATCH 58/76] Make sure constants are double precision. This does cause an apparant change in answers from the SMS_Lm13.f19_g17.I2000Clm51BgcCrop.cheyenne_intel.clm-cropMonthOutput test. It should only be a change at single precision roundoff level --- src/biogeophys/CanopyFluxesMod.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/biogeophys/CanopyFluxesMod.F90 b/src/biogeophys/CanopyFluxesMod.F90 index 56e3f6390a..b10df5bdcd 100644 --- a/src/biogeophys/CanopyFluxesMod.F90 +++ b/src/biogeophys/CanopyFluxesMod.F90 @@ -424,11 +424,11 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ! Biomass heat storage tuning parameters ! These parameters can be used to account for differences ! in vegetation shape. - real(r8), parameter :: k_vert = 0.1 !vertical distribution of stem - real(r8), parameter :: k_cyl_vol = 1.0 !departure from cylindrical volume - real(r8), parameter :: k_cyl_area = 1.0 !departure from cylindrical area - real(r8), parameter :: k_internal = 0.0 !self-absorbtion of leaf/stem longwave - real(r8), parameter :: min_stem_diameter = 0.05 !minimum stem diameter for which to calculate stem interactions + real(r8), parameter :: k_vert = 0.1_r8 !vertical distribution of stem + real(r8), parameter :: k_cyl_vol = 1.0_r8 !departure from cylindrical volume + real(r8), parameter :: k_cyl_area = 1.0_r8 !departure from cylindrical area + real(r8), parameter :: k_internal = 0.0_r8 !self-absorbtion of leaf/stem longwave + real(r8), parameter :: min_stem_diameter = 0.05_r8 !minimum stem diameter for which to calculate stem interactions integer :: dummy_to_make_pgi_happy !------------------------------------------------------------------------------ From 1ce3299002e0d4324f511c832d5b6f57d37c761a Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Mon, 21 Dec 2020 22:48:44 -0700 Subject: [PATCH 59/76] Add spinup_factor which is normally one, but 10 when spinup_state is Accel. Decomp. (2) --- src/biogeochem/CNVegCarbonStateType.F90 | 2 ++ src/biogeochem/CNVegStructUpdateMod.F90 | 7 ++----- 2 files changed, 4 insertions(+), 5 deletions(-) diff --git a/src/biogeochem/CNVegCarbonStateType.F90 b/src/biogeochem/CNVegCarbonStateType.F90 index 0a8ea2e03c..9a754640c7 100644 --- a/src/biogeochem/CNVegCarbonStateType.F90 +++ b/src/biogeochem/CNVegCarbonStateType.F90 @@ -102,6 +102,8 @@ module CNVegCarbonStateType end type cnveg_carbonstate_type + real(r8), public :: spinup_factor = 1.0_r8 ! Spinup factor used when in Accelerated Decomposition mode + ! !PRIVATE DATA: type, private :: cnvegcarbonstate_const_type diff --git a/src/biogeochem/CNVegStructUpdateMod.F90 b/src/biogeochem/CNVegStructUpdateMod.F90 index 1cb7dad82f..d9740e7ef9 100644 --- a/src/biogeochem/CNVegStructUpdateMod.F90 +++ b/src/biogeochem/CNVegStructUpdateMod.F90 @@ -13,7 +13,7 @@ module CNVegStructUpdateMod use CNDVType , only : dgvs_type use CNVegStateType , only : cnveg_state_type use CropType , only : crop_type - use CNVegCarbonStateType , only : cnveg_carbonstate_type + use CNVegCarbonStateType , only : cnveg_carbonstate_type, spinup_factor use CanopyStateType , only : canopystate_type use PatchType , only : patch use decompMod , only : bounds_type @@ -217,12 +217,9 @@ subroutine CNVegStructUpdate(bounds,num_soilp, filter_soilp, & leaf_biomass(p) = max(0.0025_r8,leafc(p)) & * c_to_b * 1.e-3_r8 / (1._r8 - fbw(ivt(p))) - stem_biomass(p) = (deadstemc(p) + livestemc(p)) & + stem_biomass(p) = (spinup_factor*deadstemc(p) + livestemc(p)) & * c_to_b * 1.e-3_r8 / (1._r8 - fbw(ivt(p))) - if (spinup_state == 2) then - stem_biomass(p) = 10._r8 * stem_biomass(p) - end if else leaf_biomass(p) = 0_r8 stem_biomass(p) = 0_r8 From 7e19306103ced0526e83167d8201cdb84015969c Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 23 Dec 2020 10:34:00 -0700 Subject: [PATCH 60/76] Get SMS_D_Ld1_Mmpi-serial.f45_f45_mg37.I2000Clm50Sp.izumi_pgi.clm-ptsRLA to replicate ctsm5.1.dev019 answers by modifying three terms, that would've just been roundoff different when use_biomass_heat_storage is off --- src/biogeophys/CanopyFluxesMod.F90 | 30 +++++++++++++++++++++++------- 1 file changed, 23 insertions(+), 7 deletions(-) diff --git a/src/biogeophys/CanopyFluxesMod.F90 b/src/biogeophys/CanopyFluxesMod.F90 index 36edd7761c..8a47888ad6 100644 --- a/src/biogeophys/CanopyFluxesMod.F90 +++ b/src/biogeophys/CanopyFluxesMod.F90 @@ -410,6 +410,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, real(r8) :: rstem(bounds%begp:bounds%endp) !stem resistance to heat transfer real(r8) :: dt_stem(bounds%begp:bounds%endp) !change in stem temperature real(r8) :: frac_rad_abs_by_stem(bounds%begp:bounds%endp) !fraction of incoming radiation absorbed by stems + real(r8) :: frac_rad_abs_by_leaf !fraction of incoming radiation absorbed by leaf real(r8) :: lw_stem(bounds%begp:bounds%endp) !internal longwave stem real(r8) :: lw_leaf(bounds%begp:bounds%endp) !internal longwave leaf real(r8) :: sa_stem(bounds%begp:bounds%endp) !surface area stem m2/m2_ground @@ -1216,13 +1217,13 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, +(1._r8-frac_sno(c)-frac_h2osfc(c))*t_soisno(c,1)**4 & +frac_h2osfc(c)*t_h2osfc(c)**4) - dt_veg(p) = ((1.-frac_rad_abs_by_stem(p))*(sabv(p) + air(p) & + dt_veg(p) = ((1._r8-frac_rad_abs_by_stem(p))*(sabv(p) + air(p) & + bir(p)*t_veg(p)**4 + cir(p)*lw_grnd) & - efsh - efe(p) - lw_leaf(p) + lw_stem(p) & - (cp_leaf(p)/dtime)*(t_veg(p) - tl_ini(p))) & - / ((1.-frac_rad_abs_by_stem(p))*(- 4._r8*bir(p)*t_veg(p)**3) & + / (((1._r8-frac_rad_abs_by_stem(p))*(- 4._r8*bir(p)*t_veg(p)**3) & + 4._r8*sa_internal(p)*emv(p)*sb*t_veg(p)**3 & - +dc1*wtga(p) +dc2*wtgaq*qsatldT(p) + cp_leaf(p)/dtime) + +dc1*wtga(p) +dc2*wtgaq*qsatldT(p)) + cp_leaf(p)/dtime) t_veg(p) = tlbef(p) + dt_veg(p) @@ -1481,20 +1482,35 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ! Downward longwave radiation below the canopy +! dlrad(p) = (1._r8-emv(p))*emg(c)*forc_lwrad(c) + & +! emv(p)*emg(c)*sb*tlbef(p)**3*(tlbef(p) + 4._r8*dt_veg(p)) dlrad(p) = (1._r8-emv(p))*emg(c)*forc_lwrad(c) & - + emv(p)*emg(c)*sb*tlbef(p)**3*(tlbef(p) + 4._r8*dt_veg(p)) & - *(1.-frac_rad_abs_by_stem(p)) & + + emv(p)*emg(c)*sb*tlbef(p)**3*(tlbef(p) + 4._r8*dt_veg(p)) + if ( use_biomass_heat_storage )then + frac_rad_abs_by_leaf = 1._r8-frac_rad_abs_by_stem(p) + else + frac_rad_abs_by_leaf = 1._r8 + end if + dlrad(p) = dlrad(p) & + *(1._r8-frac_rad_abs_by_stem(p)) & + emv(p)*emg(c)*sb*ts_ini(p)**3*(ts_ini(p) + 4._r8*dt_stem(p)) & *frac_rad_abs_by_stem(p) ! Upward longwave radiation above the canopy - ulrad(p) = ((1._r8-emg(c))*(1._r8-emv(p))*(1._r8-emv(p))*forc_lwrad(c) & + ulrad(p) = (1._r8-emg(c))*(1._r8-emv(p))*(1._r8-emv(p))*forc_lwrad(c) + if ( .not. use_biomass_heat_storage )then + ulrad(p) = (ulrad(p) & + + emv(p)*(1._r8+(1._r8-emg(c))*(1._r8-emv(p)))*sb*tlbef(p)**3*(tlbef(p) + & + 4._r8*dt_veg(p)) + emg(c)*(1._r8-emv(p))*sb*lw_grnd) + else + ulrad(p) = (ulrad(p) & + emv(p)*(1._r8+(1._r8-emg(c))*(1._r8-emv(p)))*sb & - *tlbef(p)**3*(tlbef(p) + 4._r8*dt_veg(p))*(1.-frac_rad_abs_by_stem(p)) & + *tlbef(p)**3*(tlbef(p) + 4._r8*dt_veg(p))*(1._r8-frac_rad_abs_by_stem(p)) & + emv(p)*(1._r8+(1._r8-emg(c))*(1._r8-emv(p)))*sb & *ts_ini(p)**3*(ts_ini(p)+ 4._r8*dt_stem(p))*frac_rad_abs_by_stem(p) & + emg(c)*(1._r8-emv(p))*sb*lw_grnd) + end if From 11e69572aae09643934615d9a53cee3250c3f90d Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 23 Dec 2020 14:38:28 -0700 Subject: [PATCH 61/76] Remove frac_rad_abs_by_leaf as it wasn't be used --- src/biogeophys/CanopyFluxesMod.F90 | 6 ------ 1 file changed, 6 deletions(-) diff --git a/src/biogeophys/CanopyFluxesMod.F90 b/src/biogeophys/CanopyFluxesMod.F90 index 8a47888ad6..20adce4bf2 100644 --- a/src/biogeophys/CanopyFluxesMod.F90 +++ b/src/biogeophys/CanopyFluxesMod.F90 @@ -410,7 +410,6 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, real(r8) :: rstem(bounds%begp:bounds%endp) !stem resistance to heat transfer real(r8) :: dt_stem(bounds%begp:bounds%endp) !change in stem temperature real(r8) :: frac_rad_abs_by_stem(bounds%begp:bounds%endp) !fraction of incoming radiation absorbed by stems - real(r8) :: frac_rad_abs_by_leaf !fraction of incoming radiation absorbed by leaf real(r8) :: lw_stem(bounds%begp:bounds%endp) !internal longwave stem real(r8) :: lw_leaf(bounds%begp:bounds%endp) !internal longwave leaf real(r8) :: sa_stem(bounds%begp:bounds%endp) !surface area stem m2/m2_ground @@ -1486,11 +1485,6 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ! emv(p)*emg(c)*sb*tlbef(p)**3*(tlbef(p) + 4._r8*dt_veg(p)) dlrad(p) = (1._r8-emv(p))*emg(c)*forc_lwrad(c) & + emv(p)*emg(c)*sb*tlbef(p)**3*(tlbef(p) + 4._r8*dt_veg(p)) - if ( use_biomass_heat_storage )then - frac_rad_abs_by_leaf = 1._r8-frac_rad_abs_by_stem(p) - else - frac_rad_abs_by_leaf = 1._r8 - end if dlrad(p) = dlrad(p) & *(1._r8-frac_rad_abs_by_stem(p)) & + emv(p)*emg(c)*sb*ts_ini(p)**3*(ts_ini(p) + 4._r8*dt_stem(p)) & From 552bfa366f703683a51ea89ea3c44d4e7bf8af62 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 23 Dec 2020 19:35:12 -0700 Subject: [PATCH 62/76] Fix a mistake with dlrad --- src/biogeophys/CanopyFluxesMod.F90 | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/src/biogeophys/CanopyFluxesMod.F90 b/src/biogeophys/CanopyFluxesMod.F90 index 20adce4bf2..bb361d29d6 100644 --- a/src/biogeophys/CanopyFluxesMod.F90 +++ b/src/biogeophys/CanopyFluxesMod.F90 @@ -417,6 +417,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, real(r8) :: sa_internal(bounds%begp:bounds%endp) !min(sa_stem,sa_leaf) real(r8) :: uuc(bounds%begp:bounds%endp) ! undercanopy windspeed real(r8) :: carea_stem !cross-sectional area of stem + real(r8) :: dlrad_leaf !Downward longwave radition from leaf ! Biomass heat storage tuning parameters ! These parameters can be used to account for differences @@ -1483,12 +1484,15 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ! dlrad(p) = (1._r8-emv(p))*emg(c)*forc_lwrad(c) + & ! emv(p)*emg(c)*sb*tlbef(p)**3*(tlbef(p) + 4._r8*dt_veg(p)) - dlrad(p) = (1._r8-emv(p))*emg(c)*forc_lwrad(c) & - + emv(p)*emg(c)*sb*tlbef(p)**3*(tlbef(p) + 4._r8*dt_veg(p)) - dlrad(p) = dlrad(p) & - *(1._r8-frac_rad_abs_by_stem(p)) & + dlrad_leaf = emv(p)*emg(c)*sb*tlbef(p)**3*(tlbef(p) + 4._r8*dt_veg(p)) + dlrad(p) = (1._r8-emv(p))*emg(c)*forc_lwrad(c) + if ( .not. use_biomass_heat_storage )then + dlrad(p) = dlrad(p) + dlrad_leaf + else + dlrad(p) = dlrad(p) + dlrad_leaf *(1._r8-frac_rad_abs_by_stem(p)) & + emv(p)*emg(c)*sb*ts_ini(p)**3*(ts_ini(p) + 4._r8*dt_stem(p)) & *frac_rad_abs_by_stem(p) + end if ! Upward longwave radiation above the canopy From 6ccb03c628ef72b6d64bc8e496cca55d257fc3f5 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 30 Dec 2020 16:08:30 -0700 Subject: [PATCH 63/76] Set BHS constants when off to double precision --- src/main/pftconMod.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/main/pftconMod.F90 b/src/main/pftconMod.F90 index e8924cbe36..219e556f51 100644 --- a/src/main/pftconMod.F90 +++ b/src/main/pftconMod.F90 @@ -1043,11 +1043,11 @@ subroutine InitRead(this) call ncd_io('wood_density',this%wood_density, 'read', ncid, readvar=readv) if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) else - this%dbh = 0.0 - this%fbw = 0.0 - this%nstem = 0.1 - this%rstem_per_dbh = 0.0 - this%wood_density = 0.0 + this%dbh = 0.0_r8 + this%fbw = 0.0_r8 + this%nstem = 1000._r8 / 10000._r8 + this%rstem_per_dbh = 0.0_r8 + this%wood_density = 0.0_r8 end if call ncd_pio_closefile(ncid) From d642e9616d47bf7851a3a1633355d314cec95ed1 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Sat, 9 Jan 2021 18:21:53 -0700 Subject: [PATCH 64/76] Add 1850 Clm51 Bgc and BgcCrop compsets --- cime_config/config_compsets.xml | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/cime_config/config_compsets.xml b/cime_config/config_compsets.xml index de0139fc63..4567e755e7 100644 --- a/cime_config/config_compsets.xml +++ b/cime_config/config_compsets.xml @@ -144,6 +144,11 @@ + + I1850Clm51BgcCrop + 1850_DATM%GSWP3v1_CLM50%BGC-CROP_SICE_SOCN_MOSART_SGLC_SWAV + + I1850Clm51Sp 1850_DATM%GSWP3v1_CLM51%SP_SICE_SOCN_MOSART_SGLC_SWAV @@ -238,6 +243,12 @@ + + I1850Clm51Bgc + 1850_DATM%GSWP3v1_CLM50%BGC_SICE_SOCN_MOSART_SGLC_SWAV + + + I1850Clm51SpNoAnthro 1850_DATM%GSWP3v1_CLM51%SP-NOANTHRO_SICE_SOCN_MOSART_SGLC_SWAV From 63e7ae79c85a8073509a3babe478f4b9fa4b36c1 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Sat, 9 Jan 2021 18:22:36 -0700 Subject: [PATCH 65/76] Use cime share constant for specfic heat of water --- src/main/clm_varcon.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/main/clm_varcon.F90 b/src/main/clm_varcon.F90 index ff9f5e0d2c..9f66d335ad 100644 --- a/src/main/clm_varcon.F90 +++ b/src/main/clm_varcon.F90 @@ -13,7 +13,7 @@ module clm_varcon SHR_CONST_RHOICE,SHR_CONST_TKFRZ,SHR_CONST_REARTH, & SHR_CONST_PDB, SHR_CONST_PI, SHR_CONST_CDAY, & SHR_CONST_RGAS, SHR_CONST_PSTD, & - SHR_CONST_MWDAIR, SHR_CONST_MWWV + SHR_CONST_MWDAIR, SHR_CONST_MWWV, SHR_CONST_CPFW use clm_varpar , only: numrad, nlevgrnd, nlevlak, nlevdecomp_full use clm_varpar , only: ngases use clm_varpar , only: nlayer @@ -81,7 +81,7 @@ module clm_varcon real(r8), public :: alpha_aero = 1.0_r8 ! constant for aerodynamic parameter weighting real(r8), public :: tlsai_crit = 2.0_r8 ! critical value of elai+esai for which aerodynamic parameters are maximum real(r8), public :: watmin = 0.01_r8 ! minimum soil moisture (mm) - real(r8), public :: c_water = 4188_r8 ! specific heat of water [J/kg/K] + real(r8), public :: c_water = SHR_CONST_CPFW ! specific heat of water [J/kg/K] real(r8), public :: c_dry_biomass = 1400_r8 ! specific heat of dry biomass real(r8), public :: re = SHR_CONST_REARTH*0.001_r8 ! radius of earth (km) From cb5bd95a711d117264476c0493480c4c364f0634 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Sat, 9 Jan 2021 18:23:51 -0700 Subject: [PATCH 66/76] Some formatting changes, and changes that @swensosc found to fix the spinup cases in regard to dt_veg, there were some parenthesis that got out of place --- src/biogeophys/CanopyFluxesMod.F90 | 32 +++++++++++++++--------------- 1 file changed, 16 insertions(+), 16 deletions(-) diff --git a/src/biogeophys/CanopyFluxesMod.F90 b/src/biogeophys/CanopyFluxesMod.F90 index 01141fa7c3..348af3a613 100644 --- a/src/biogeophys/CanopyFluxesMod.F90 +++ b/src/biogeophys/CanopyFluxesMod.F90 @@ -403,20 +403,20 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, real(r8) :: dt_veg_temp(bounds%begp:bounds%endp) integer :: iv logical :: is_end_day ! is end of current day - real(r8) :: dbh(bounds%begp:bounds%endp) !diameter at breast height of vegetation - real(r8) :: cp_leaf(bounds%begp:bounds%endp) !heat capacity of leaves - real(r8) :: cp_stem(bounds%begp:bounds%endp) !heat capacity of stems - real(r8) :: rstem(bounds%begp:bounds%endp) !stem resistance to heat transfer - real(r8) :: dt_stem(bounds%begp:bounds%endp) !change in stem temperature - real(r8) :: frac_rad_abs_by_stem(bounds%begp:bounds%endp) !fraction of incoming radiation absorbed by stems - real(r8) :: lw_stem(bounds%begp:bounds%endp) !internal longwave stem - real(r8) :: lw_leaf(bounds%begp:bounds%endp) !internal longwave leaf - real(r8) :: sa_stem(bounds%begp:bounds%endp) !surface area stem m2/m2_ground - real(r8) :: sa_leaf(bounds%begp:bounds%endp) !surface area leaf m2/m2_ground - real(r8) :: sa_internal(bounds%begp:bounds%endp) !min(sa_stem,sa_leaf) - real(r8) :: uuc(bounds%begp:bounds%endp) ! undercanopy windspeed - real(r8) :: carea_stem !cross-sectional area of stem - real(r8) :: dlrad_leaf !Downward longwave radition from leaf + real(r8) :: dbh(bounds%begp:bounds%endp) ! diameter at breast height of vegetation + real(r8) :: cp_leaf(bounds%begp:bounds%endp) ! heat capacity of leaves + real(r8) :: cp_stem(bounds%begp:bounds%endp) ! heat capacity of stems + real(r8) :: rstem(bounds%begp:bounds%endp) ! stem resistance to heat transfer + real(r8) :: dt_stem(bounds%begp:bounds%endp) ! change in stem temperature + real(r8) :: frac_rad_abs_by_stem(bounds%begp:bounds%endp) ! fraction of incoming radiation absorbed by stems + real(r8) :: lw_stem(bounds%begp:bounds%endp) ! internal longwave stem + real(r8) :: lw_leaf(bounds%begp:bounds%endp) ! internal longwave leaf + real(r8) :: sa_stem(bounds%begp:bounds%endp) ! surface area stem m2/m2_ground + real(r8) :: sa_leaf(bounds%begp:bounds%endp) ! surface area leaf m2/m2_ground + real(r8) :: sa_internal(bounds%begp:bounds%endp) ! min(sa_stem,sa_leaf) + real(r8) :: uuc(bounds%begp:bounds%endp) ! undercanopy windspeed + real(r8) :: carea_stem ! cross-sectional area of stem + real(r8) :: dlrad_leaf ! Downward longwave radition from leaf ! Indices for raw and rah integer, parameter :: above_canopy = 1 ! Above canopy @@ -1228,9 +1228,9 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, + bir(p)*t_veg(p)**4 + cir(p)*lw_grnd) & - efsh - efe(p) - lw_leaf(p) + lw_stem(p) & - (cp_leaf(p)/dtime)*(t_veg(p) - tl_ini(p))) & - / ((1._r8-frac_rad_abs_by_stem(p))*(- 4._r8*bir(p)*t_veg(p)**3 & + / ((1._r8-frac_rad_abs_by_stem(p))*(- 4._r8*bir(p)*t_veg(p)**3) & + 4._r8*sa_internal(p)*emv(p)*sb*t_veg(p)**3 & - +dc1*wtga(p) +dc2*wtgaq*qsatldT(p))+ cp_leaf(p)/dtime) + +dc1*wtga(p) +dc2*wtgaq*qsatldT(p)+ cp_leaf(p)/dtime) t_veg(p) = tlbef(p) + dt_veg(p) From 115477d2024ab1e655ef9d05cf48f51c54c30b80 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Sat, 9 Jan 2021 18:31:06 -0700 Subject: [PATCH 67/76] Add spinup_factor_AD to use for Accel. Decomp. mode --- src/biogeochem/CNVegCarbonStateType.F90 | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/src/biogeochem/CNVegCarbonStateType.F90 b/src/biogeochem/CNVegCarbonStateType.F90 index 9a754640c7..fd8924c2f1 100644 --- a/src/biogeochem/CNVegCarbonStateType.F90 +++ b/src/biogeochem/CNVegCarbonStateType.F90 @@ -102,7 +102,8 @@ module CNVegCarbonStateType end type cnveg_carbonstate_type - real(r8), public :: spinup_factor = 1.0_r8 ! Spinup factor used when in Accelerated Decomposition mode + real(r8), public :: spinup_factor = 1.0_r8 ! Spinup factor used for this simulation + real(r8), public :: spinup_factor_AD = 10.0_r8 ! Spinup factor used when in Accelerated Decomposition mode ! !PRIVATE DATA: @@ -1245,13 +1246,14 @@ subroutine Restart ( this, bounds, ncid, flag, carbon_type, reseed_dead_plants, if (flag == 'read' .and. spinup_state /= restart_file_spinup_state .and. .not. use_cndv) then if ( masterproc ) write(iulog, *) 'exit_spinup ',exit_spinup,' restart_file_spinup_state ',restart_file_spinup_state + if ( spinup_state == 2 ) spinup_factor = spinup_factor_AD if (spinup_state <= 1 .and. restart_file_spinup_state == 2 ) then if ( masterproc ) write(iulog,*) ' CNRest: taking Dead wood C pools out of AD spinup mode' exit_spinup = .true. if ( masterproc ) write(iulog, *) 'Multiplying stemc and crootc by 10 for exit spinup' do i = bounds%begp,bounds%endp - this%deadstemc_patch(i) = this%deadstemc_patch(i) * 10._r8 - this%deadcrootc_patch(i) = this%deadcrootc_patch(i) * 10._r8 + this%deadstemc_patch(i) = this%deadstemc_patch(i) * spinup_factor_AD + this%deadcrootc_patch(i) = this%deadcrootc_patch(i) * spinup_factor_AD end do else if (spinup_state == 2 .and. restart_file_spinup_state <= 1 )then if (spinup_state == 2 .and. restart_file_spinup_state <= 1 )then @@ -1259,8 +1261,8 @@ subroutine Restart ( this, bounds, ncid, flag, carbon_type, reseed_dead_plants, enter_spinup = .true. if ( masterproc ) write(iulog, *) 'Dividing stemc and crootc by 10 for enter spinup ' do i = bounds%begp,bounds%endp - this%deadstemc_patch(i) = this%deadstemc_patch(i) / 10._r8 - this%deadcrootc_patch(i) = this%deadcrootc_patch(i) / 10._r8 + this%deadstemc_patch(i) = this%deadstemc_patch(i) / spinup_factor_AD + this%deadcrootc_patch(i) = this%deadcrootc_patch(i) / spinup_factor_AD end do end if end if From 5b011aa5ce9ec1a1a7abcf581421148b77d14ce1 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Sun, 10 Jan 2021 09:52:11 -0700 Subject: [PATCH 68/76] Change the hardwired 10x multiplier for deadwood to spinup_factor_deadwood, and change the name of it from spinup_factor in CNVegCarbonState to spinup_factor_deadwood since the previous name conflicted with the array in decomp --- src/biogeochem/CNFireBaseMod.F90 | 9 +++------ src/biogeochem/CNFireLi2014Mod.F90 | 9 +++------ src/biogeochem/CNFireLi2016Mod.F90 | 6 +++--- src/biogeochem/CNFireLi2021Mod.F90 | 6 +++--- src/biogeochem/CNGapMortalityMod.F90 | 10 +++++----- src/biogeochem/CNVegCarbonStateType.F90 | 10 +++++----- src/biogeochem/CNVegStructUpdateMod.F90 | 6 +++--- 7 files changed, 25 insertions(+), 31 deletions(-) diff --git a/src/biogeochem/CNFireBaseMod.F90 b/src/biogeochem/CNFireBaseMod.F90 index 1ba0efc4d4..b9c125716e 100644 --- a/src/biogeochem/CNFireBaseMod.F90 +++ b/src/biogeochem/CNFireBaseMod.F90 @@ -24,7 +24,7 @@ module CNFireBaseMod use atm2lndType , only : atm2lnd_type use CNDVType , only : dgvs_type use CNVegStateType , only : cnveg_state_type - use CNVegCarbonStateType , only : cnveg_carbonstate_type + use CNVegCarbonStateType , only : cnveg_carbonstate_type, spinup_factor_deadwood use CNVegCarbonFluxType , only : cnveg_carbonflux_type use CNVegNitrogenStateType , only : cnveg_nitrogenstate_type use CNVegNitrogenFluxType , only : cnveg_nitrogenflux_type @@ -441,7 +441,7 @@ subroutine CNFireFluxes (this, bounds, num_soilc, filter_soilc, num_soilp, filte ! ! !USES: use clm_time_manager , only: get_step_size_real,get_days_per_year,get_curr_date - use clm_varctl , only: use_cndv, spinup_state + use clm_varctl , only: use_cndv use clm_varcon , only: secspday use pftconMod , only: nc3crop use dynSubgridControlMod , only: run_has_transient_landcover @@ -718,10 +718,7 @@ subroutine CNFireFluxes (this, bounds, num_soilc, filter_soilc, num_soilp, filte ! apply this rate to the patch state variables to get flux rates ! biomass burning ! carbon fluxes - m = 1._r8 - if (spinup_state == 2) then - m = 10._r8 - end if + m = spinup_factor_deadwood m_leafc_to_fire(p) = leafc(p) * f * cc_leaf(patch%itype(p)) m_leafc_storage_to_fire(p) = leafc_storage(p) * f * cc_other(patch%itype(p)) diff --git a/src/biogeochem/CNFireLi2014Mod.F90 b/src/biogeochem/CNFireLi2014Mod.F90 index a69efbfeae..e8fd78230e 100644 --- a/src/biogeochem/CNFireLi2014Mod.F90 +++ b/src/biogeochem/CNFireLi2014Mod.F90 @@ -17,7 +17,7 @@ module CNFireLi2014Mod use shr_kind_mod , only : r8 => shr_kind_r8, CL => shr_kind_CL use shr_const_mod , only : SHR_CONST_PI,SHR_CONST_TKFRZ use shr_infnan_mod , only : shr_infnan_isnan - use clm_varctl , only : iulog, spinup_state + use clm_varctl , only : iulog use clm_varpar , only : nlevdecomp, ndecomp_pools, nlevdecomp_full use clm_varcon , only : dzsoi_decomp use pftconMod , only : noveg, pftcon @@ -27,7 +27,7 @@ module CNFireLi2014Mod use atm2lndType , only : atm2lnd_type use CNDVType , only : dgvs_type use CNVegStateType , only : cnveg_state_type - use CNVegCarbonStateType , only : cnveg_carbonstate_type + use CNVegCarbonStateType , only : cnveg_carbonstate_type, spinup_factor_deadwood use CNVegCarbonFluxType , only : cnveg_carbonflux_type use CNVegNitrogenStateType , only : cnveg_nitrogenstate_type use CNVegNitrogenFluxType , only : cnveg_nitrogenflux_type @@ -920,10 +920,7 @@ subroutine CNFireFluxes (this, bounds, num_soilc, filter_soilc, num_soilp, filte ! apply this rate to the patch state variables to get flux rates ! biomass burning ! carbon fluxes - m = 1._r8 - if (spinup_state == 2) then - m = 10._r8 - end if + m = spinup_factor_deadwood m_leafc_to_fire(p) = leafc(p) * f * cc_leaf(patch%itype(p)) m_leafc_storage_to_fire(p) = leafc_storage(p) * f * cc_other(patch%itype(p)) diff --git a/src/biogeochem/CNFireLi2016Mod.F90 b/src/biogeochem/CNFireLi2016Mod.F90 index b1cdafb4ee..aa1d123a55 100644 --- a/src/biogeochem/CNFireLi2016Mod.F90 +++ b/src/biogeochem/CNFireLi2016Mod.F90 @@ -27,7 +27,7 @@ module CNFireLi2016Mod use atm2lndType , only : atm2lnd_type use CNDVType , only : dgvs_type use CNVegStateType , only : cnveg_state_type - use CNVegCarbonStateType , only : cnveg_carbonstate_type + use CNVegCarbonStateType , only : cnveg_carbonstate_type, spinup_factor_deadwood use CNVegCarbonFluxType , only : cnveg_carbonflux_type use CNVegNitrogenStateType , only : cnveg_nitrogenstate_type use CNVegNitrogenFluxType , only : cnveg_nitrogenflux_type @@ -422,7 +422,7 @@ subroutine CNFireArea (this, bounds, num_soilc, filter_soilc, num_soilp, filter_ end if if (spinup_state == 2) then rootc_col(c) = rootc_col(c) + (frootc(p) + frootc_storage(p) + & - frootc_xfer(p) + deadcrootc(p) * 10._r8 + & + frootc_xfer(p) + deadcrootc(p) * spinup_factor_deadwood + & deadcrootc_storage(p) + deadcrootc_xfer(p) + & livecrootc(p)+livecrootc_storage(p) + & livecrootc_xfer(p))*patch%wtcol(p) @@ -588,7 +588,7 @@ subroutine CNFireArea (this, bounds, num_soilc, filter_soilc, num_soilp, filter_ if( cropf_col(c) < 1._r8 )then fuelc(c) = totlitc(c)+totvegc(c)-rootc_col(c)-fuelc_crop(c)*cropf_col(c) if (spinup_state == 2) then - fuelc(c) = fuelc(c) + ((10._r8 - 1._r8)*deadstemc_col(c)) + fuelc(c) = fuelc(c) + ((spinup_factor_deadwood - 1._r8)*deadstemc_col(c)) do j = 1, nlevdecomp fuelc(c) = fuelc(c)+decomp_cpools_vr(c,j,i_cwd) * dzsoi_decomp(j) * spinup_factor(i_cwd) & * get_spinup_latitude_term(grc%latdeg(col%gridcell(c))) diff --git a/src/biogeochem/CNFireLi2021Mod.F90 b/src/biogeochem/CNFireLi2021Mod.F90 index 77b0693fca..b2f64867f7 100644 --- a/src/biogeochem/CNFireLi2021Mod.F90 +++ b/src/biogeochem/CNFireLi2021Mod.F90 @@ -27,7 +27,7 @@ module CNFireLi2021Mod use atm2lndType , only : atm2lnd_type use CNDVType , only : dgvs_type use CNVegStateType , only : cnveg_state_type - use CNVegCarbonStateType , only : cnveg_carbonstate_type + use CNVegCarbonStateType , only : cnveg_carbonstate_type, spinup_factor_deadwood use CNVegCarbonFluxType , only : cnveg_carbonflux_type use CNVegNitrogenStateType , only : cnveg_nitrogenstate_type use CNVegNitrogenFluxType , only : cnveg_nitrogenflux_type @@ -423,7 +423,7 @@ subroutine CNFireArea (this, bounds, num_soilc, filter_soilc, num_soilp, filter_ end if if (spinup_state == 2) then rootc_col(c) = rootc_col(c) + (frootc(p) + frootc_storage(p) + & - frootc_xfer(p) + deadcrootc(p) * 10._r8 + & + frootc_xfer(p) + deadcrootc(p) * spinup_factor_deadwood + & deadcrootc_storage(p) + deadcrootc_xfer(p) + & livecrootc(p)+livecrootc_storage(p) + & livecrootc_xfer(p))*patch%wtcol(p) @@ -589,7 +589,7 @@ subroutine CNFireArea (this, bounds, num_soilc, filter_soilc, num_soilp, filter_ if( cropf_col(c) < 1._r8 )then fuelc(c) = totlitc(c)+totvegc(c)-rootc_col(c)-fuelc_crop(c)*cropf_col(c) if (spinup_state == 2) then - fuelc(c) = fuelc(c) + ((10._r8 - 1._r8)*deadstemc_col(c)) + fuelc(c) = fuelc(c) + ((spinup_factor_deadwood - 1._r8)*deadstemc_col(c)) do j = 1, nlevdecomp fuelc(c) = fuelc(c)+decomp_cpools_vr(c,j,i_cwd) * dzsoi_decomp(j) * spinup_factor(i_cwd) & * get_spinup_latitude_term(grc%latdeg(col%gridcell(c))) diff --git a/src/biogeochem/CNGapMortalityMod.F90 b/src/biogeochem/CNGapMortalityMod.F90 index e313cdf213..e5acca9a39 100644 --- a/src/biogeochem/CNGapMortalityMod.F90 +++ b/src/biogeochem/CNGapMortalityMod.F90 @@ -14,7 +14,7 @@ module CNGapMortalityMod use shr_log_mod , only : errMsg => shr_log_errMsg use pftconMod , only : pftcon use CNDVType , only : dgvs_type - use CNVegCarbonStateType , only : cnveg_carbonstate_type + use CNVegCarbonStateType , only : cnveg_carbonstate_type, spinup_factor_deadwood use CNVegCarbonFluxType , only : cnveg_carbonflux_type use CNVegNitrogenStateType , only : cnveg_nitrogenstate_type use CNVegNitrogenFluxType , only : cnveg_nitrogenflux_type @@ -192,8 +192,8 @@ subroutine CNGapMortality (bounds, num_soilc, filter_soilc, num_soilp, filter_so cnveg_carbonflux_inst%m_livestemc_to_litter_patch(p) = cnveg_carbonstate_inst%livestemc_patch(p) * m cnveg_carbonflux_inst%m_livecrootc_to_litter_patch(p) = cnveg_carbonstate_inst%livecrootc_patch(p) * m if (spinup_state == 2 .and. .not. use_cndv) then !accelerate mortality of dead woody pools - cnveg_carbonflux_inst%m_deadstemc_to_litter_patch(p) = cnveg_carbonstate_inst%deadstemc_patch(p) * m * 10._r8 - cnveg_carbonflux_inst%m_deadcrootc_to_litter_patch(p) = cnveg_carbonstate_inst%deadcrootc_patch(p) * m * 10._r8 + cnveg_carbonflux_inst%m_deadstemc_to_litter_patch(p) = cnveg_carbonstate_inst%deadstemc_patch(p) * m * spinup_factor_deadwood + cnveg_carbonflux_inst%m_deadcrootc_to_litter_patch(p) = cnveg_carbonstate_inst%deadcrootc_patch(p) * m * spinup_factor_deadwood else cnveg_carbonflux_inst%m_deadstemc_to_litter_patch(p) = cnveg_carbonstate_inst%deadstemc_patch(p) * m cnveg_carbonflux_inst%m_deadcrootc_to_litter_patch(p) = cnveg_carbonstate_inst%deadcrootc_patch(p) * m @@ -228,8 +228,8 @@ subroutine CNGapMortality (bounds, num_soilc, filter_soilc, num_soilp, filter_so cnveg_nitrogenflux_inst%m_livecrootn_to_litter_patch(p) = cnveg_nitrogenstate_inst%livecrootn_patch(p) * m if (spinup_state == 2 .and. .not. use_cndv) then !accelerate mortality of dead woody pools - cnveg_nitrogenflux_inst%m_deadstemn_to_litter_patch(p) = cnveg_nitrogenstate_inst%deadstemn_patch(p) * m * 10._r8 - cnveg_nitrogenflux_inst%m_deadcrootn_to_litter_patch(p) = cnveg_nitrogenstate_inst%deadcrootn_patch(p) * m * 10._r8 + cnveg_nitrogenflux_inst%m_deadstemn_to_litter_patch(p) = cnveg_nitrogenstate_inst%deadstemn_patch(p) * m * spinup_factor_deadwood + cnveg_nitrogenflux_inst%m_deadcrootn_to_litter_patch(p) = cnveg_nitrogenstate_inst%deadcrootn_patch(p) * m * spinup_factor_deadwood else cnveg_nitrogenflux_inst%m_deadstemn_to_litter_patch(p) = cnveg_nitrogenstate_inst%deadstemn_patch(p) * m cnveg_nitrogenflux_inst%m_deadcrootn_to_litter_patch(p) = cnveg_nitrogenstate_inst%deadcrootn_patch(p) * m diff --git a/src/biogeochem/CNVegCarbonStateType.F90 b/src/biogeochem/CNVegCarbonStateType.F90 index fd8924c2f1..1d6d36fe4e 100644 --- a/src/biogeochem/CNVegCarbonStateType.F90 +++ b/src/biogeochem/CNVegCarbonStateType.F90 @@ -102,8 +102,8 @@ module CNVegCarbonStateType end type cnveg_carbonstate_type - real(r8), public :: spinup_factor = 1.0_r8 ! Spinup factor used for this simulation - real(r8), public :: spinup_factor_AD = 10.0_r8 ! Spinup factor used when in Accelerated Decomposition mode + real(r8), public :: spinup_factor_deadwood = 1.0_r8 ! Spinup factor used for this simulation + real(r8), public :: spinup_factor_AD = 10.0_r8 ! Spinup factor used when in Accelerated Decomposition mode ! !PRIVATE DATA: @@ -1246,11 +1246,11 @@ subroutine Restart ( this, bounds, ncid, flag, carbon_type, reseed_dead_plants, if (flag == 'read' .and. spinup_state /= restart_file_spinup_state .and. .not. use_cndv) then if ( masterproc ) write(iulog, *) 'exit_spinup ',exit_spinup,' restart_file_spinup_state ',restart_file_spinup_state - if ( spinup_state == 2 ) spinup_factor = spinup_factor_AD + if ( spinup_state == 2 ) spinup_factor_deadwood = spinup_factor_AD if (spinup_state <= 1 .and. restart_file_spinup_state == 2 ) then if ( masterproc ) write(iulog,*) ' CNRest: taking Dead wood C pools out of AD spinup mode' exit_spinup = .true. - if ( masterproc ) write(iulog, *) 'Multiplying stemc and crootc by 10 for exit spinup' + if ( masterproc ) write(iulog, *) 'Multiplying stemc and crootc by ', spinup_factor_AD, ' for exit spinup' do i = bounds%begp,bounds%endp this%deadstemc_patch(i) = this%deadstemc_patch(i) * spinup_factor_AD this%deadcrootc_patch(i) = this%deadcrootc_patch(i) * spinup_factor_AD @@ -1259,7 +1259,7 @@ subroutine Restart ( this, bounds, ncid, flag, carbon_type, reseed_dead_plants, if (spinup_state == 2 .and. restart_file_spinup_state <= 1 )then if ( masterproc ) write(iulog,*) ' CNRest: taking Dead wood C pools into AD spinup mode' enter_spinup = .true. - if ( masterproc ) write(iulog, *) 'Dividing stemc and crootc by 10 for enter spinup ' + if ( masterproc ) write(iulog, *) 'Dividing stemc and crootc by ', spinup_factor_AD, 'for enter spinup ' do i = bounds%begp,bounds%endp this%deadstemc_patch(i) = this%deadstemc_patch(i) / spinup_factor_AD this%deadcrootc_patch(i) = this%deadcrootc_patch(i) / spinup_factor_AD diff --git a/src/biogeochem/CNVegStructUpdateMod.F90 b/src/biogeochem/CNVegStructUpdateMod.F90 index d9740e7ef9..91055508b9 100644 --- a/src/biogeochem/CNVegStructUpdateMod.F90 +++ b/src/biogeochem/CNVegStructUpdateMod.F90 @@ -13,7 +13,7 @@ module CNVegStructUpdateMod use CNDVType , only : dgvs_type use CNVegStateType , only : cnveg_state_type use CropType , only : crop_type - use CNVegCarbonStateType , only : cnveg_carbonstate_type, spinup_factor + use CNVegCarbonStateType , only : cnveg_carbonstate_type, spinup_factor_deadwood use CanopyStateType , only : canopystate_type use PatchType , only : patch use decompMod , only : bounds_type @@ -200,7 +200,7 @@ subroutine CNVegStructUpdate(bounds,num_soilp, filter_soilp, & else !correct height calculation if doing accelerated spinup if (spinup_state == 2) then - htop(p) = ((3._r8 * deadstemc(p) * 10._r8 * taper(ivt(p)) * taper(ivt(p)))/ & + htop(p) = ((3._r8 * deadstemc(p) * spinup_factor_deadwood * taper(ivt(p)) * taper(ivt(p)))/ & (SHR_CONST_PI * nstem(ivt(p)) * dwood(ivt(p))))**(1._r8/3._r8) else htop(p) = ((3._r8 * deadstemc(p) * taper(ivt(p)) * taper(ivt(p)))/ & @@ -217,7 +217,7 @@ subroutine CNVegStructUpdate(bounds,num_soilp, filter_soilp, & leaf_biomass(p) = max(0.0025_r8,leafc(p)) & * c_to_b * 1.e-3_r8 / (1._r8 - fbw(ivt(p))) - stem_biomass(p) = (spinup_factor*deadstemc(p) + livestemc(p)) & + stem_biomass(p) = (spinup_factor_deadwood*deadstemc(p) + livestemc(p)) & * c_to_b * 1.e-3_r8 / (1._r8 - fbw(ivt(p))) else From 7889677a6c07f9ea7c4ae6b9a991a3575d19c7fb Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Sun, 10 Jan 2021 14:27:30 -0700 Subject: [PATCH 69/76] Correct the note about the spinup factor --- src/soilbiogeochem/SoilBiogeochemDecompCascadeCNMod.F90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/soilbiogeochem/SoilBiogeochemDecompCascadeCNMod.F90 b/src/soilbiogeochem/SoilBiogeochemDecompCascadeCNMod.F90 index 98951f9b56..8305fcefe6 100644 --- a/src/soilbiogeochem/SoilBiogeochemDecompCascadeCNMod.F90 +++ b/src/soilbiogeochem/SoilBiogeochemDecompCascadeCNMod.F90 @@ -668,7 +668,9 @@ subroutine decomp_rate_constants_cn(bounds, & end if ! The following code implements the acceleration part of the AD spinup - ! algorithm, by multiplying all of the SOM decomposition base rates by 10.0. + ! algorithm, by multiplying all of the SOM decomposition base rates by + ! spinup_vector, scalar between 1 and 70X, defined as a constant for each + ! pool here if ( spinup_state .eq. 1 ) then k_s1 = k_s1 * params_inst%spinup_vector(1) From 50d87ec91886cba50c3fbe411eaafffe7ff99e60 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Sun, 10 Jan 2021 22:12:12 -0700 Subject: [PATCH 70/76] Pass deadwood spinup_factor into NitrogenState rather than using a hardcoded constant of 10. --- src/biogeochem/CNVegCarbonStateType.F90 | 6 +++++- src/biogeochem/CNVegNitrogenStateType.F90 | 16 +++++++++------- src/biogeochem/CNVegetationFacade.F90 | 9 +++++++-- 3 files changed, 21 insertions(+), 10 deletions(-) diff --git a/src/biogeochem/CNVegCarbonStateType.F90 b/src/biogeochem/CNVegCarbonStateType.F90 index 1d6d36fe4e..f7c9178453 100644 --- a/src/biogeochem/CNVegCarbonStateType.F90 +++ b/src/biogeochem/CNVegCarbonStateType.F90 @@ -1039,7 +1039,7 @@ end subroutine InitCold !----------------------------------------------------------------------- subroutine Restart ( this, bounds, ncid, flag, carbon_type, reseed_dead_plants, & c12_cnveg_carbonstate_inst, filter_reseed_patch, & - num_reseed_patch) + num_reseed_patch, spinup_factor4deadwood ) ! ! !DESCRIPTION: ! Read/write CN restart data for carbon state @@ -1065,6 +1065,7 @@ subroutine Restart ( this, bounds, ncid, flag, carbon_type, reseed_dead_plants, type (cnveg_carbonstate_type) , intent(in), optional :: c12_cnveg_carbonstate_inst integer , intent(out), optional :: filter_reseed_patch(:) integer , intent(out), optional :: num_reseed_patch + real(r8) , intent(out), optional :: spinup_factor4deadwood ! ! !LOCAL VARIABLES: integer :: i,j,k,l,c,p @@ -2285,6 +2286,9 @@ subroutine Restart ( this, bounds, ncid, flag, carbon_type, reseed_dead_plants, end if end if + ! Output spinup factor for deadwood (dead stem and dead course root) + if ( present(spinup_factor4deadwood) ) spinup_factor4deadwood = spinup_factor_AD + end subroutine Restart !----------------------------------------------------------------------- diff --git a/src/biogeochem/CNVegNitrogenStateType.F90 b/src/biogeochem/CNVegNitrogenStateType.F90 index 1b06cd3fc3..10a191ded9 100644 --- a/src/biogeochem/CNVegNitrogenStateType.F90 +++ b/src/biogeochem/CNVegNitrogenStateType.F90 @@ -529,7 +529,8 @@ end subroutine InitCold !----------------------------------------------------------------------- subroutine Restart ( this, bounds, ncid, flag, leafc_patch, & leafc_storage_patch, frootc_patch, frootc_storage_patch, & - deadstemc_patch, filter_reseed_patch, num_reseed_patch ) + deadstemc_patch, filter_reseed_patch, num_reseed_patch, & + spinup_factor_deadwood ) ! ! !DESCRIPTION: ! Read/write restart data @@ -554,6 +555,7 @@ subroutine Restart ( this, bounds, ncid, flag, leafc_patch, & real(r8) , intent(in) :: deadstemc_patch(bounds%begp:) integer , intent(in) :: filter_reseed_patch(:) integer , intent(in) :: num_reseed_patch + real(r8) , intent(in) :: spinup_factor_deadwood ! ! !LOCAL VARIABLES: integer :: i, p, l @@ -719,18 +721,18 @@ subroutine Restart ( this, bounds, ncid, flag, leafc_patch, & if (spinup_state <= 1 .and. restart_file_spinup_state == 2 ) then if ( masterproc ) write(iulog,*) ' CNRest: taking Dead wood N pools out of AD spinup mode' exit_spinup = .true. - if ( masterproc ) write(iulog, *) 'Multiplying stemn and crootn by 10 for exit spinup ' + if ( masterproc ) write(iulog, *) 'Multiplying stemn and crootn by ', spinup_factor_deadwood, 'for exit spinup ' do i = bounds%begp,bounds%endp - this%deadstemn_patch(i) = this%deadstemn_patch(i) * 10._r8 - this%deadcrootn_patch(i) = this%deadcrootn_patch(i) * 10._r8 + this%deadstemn_patch(i) = this%deadstemn_patch(i) * spinup_factor_deadwood + this%deadcrootn_patch(i) = this%deadcrootn_patch(i) * spinup_factor_deadwood end do else if (spinup_state == 2 .and. restart_file_spinup_state <= 1 ) then if ( masterproc ) write(iulog,*) ' CNRest: taking Dead wood N pools into AD spinup mode' enter_spinup = .true. - if ( masterproc ) write(iulog, *) 'Dividing stemn and crootn by 10 for enter spinup ' + if ( masterproc ) write(iulog, *) 'Dividing stemn and crootn by ', spinup_factor_deadwood, 'for enter spinup ' do i = bounds%begp,bounds%endp - this%deadstemn_patch(i) = this%deadstemn_patch(i) / 10._r8 - this%deadcrootn_patch(i) = this%deadcrootn_patch(i) / 10._r8 + this%deadstemn_patch(i) = this%deadstemn_patch(i) / spinup_factor_deadwood + this%deadcrootn_patch(i) = this%deadcrootn_patch(i) / spinup_factor_deadwood end do endif diff --git a/src/biogeochem/CNVegetationFacade.F90 b/src/biogeochem/CNVegetationFacade.F90 index d0741e68ff..9ef32b4563 100644 --- a/src/biogeochem/CNVegetationFacade.F90 +++ b/src/biogeochem/CNVegetationFacade.F90 @@ -451,6 +451,7 @@ subroutine Restart(this, bounds, ncid, flag) ! !LOCAL VARIABLES: integer :: begp, endp + real(r8) :: spinup_factor4deadwood ! Spinup factor used for deadwood (dead-stem and dead course root) character(len=*), parameter :: subname = 'Restart' !----------------------------------------------------------------------- @@ -460,10 +461,13 @@ subroutine Restart(this, bounds, ncid, flag) endp = bounds%endp call this%cnveg_carbonstate_inst%restart(bounds, ncid, flag=flag, carbon_type='c12', & reseed_dead_plants=this%reseed_dead_plants, filter_reseed_patch=reseed_patch, & - num_reseed_patch=num_reseed_patch ) + num_reseed_patch=num_reseed_patch, spinup_factor4deadwood=spinup_factor4deadwood ) if ( flag /= 'read' .and. num_reseed_patch /= 0 )then call endrun(msg="ERROR num_reseed should be zero and is not"//errmsg(sourcefile, __LINE__)) end if + if ( flag /= 'read' .and. spinup_factor4deadwood /= 10_r8 )then + call endrun(msg="ERROR spinup_factor4deadwood should be 10 and is not"//errmsg(sourcefile, __LINE__)) + end if if (use_c13) then call this%c13_cnveg_carbonstate_inst%restart(bounds, ncid, flag=flag, carbon_type='c13', & reseed_dead_plants=this%reseed_dead_plants, c12_cnveg_carbonstate_inst=this%cnveg_carbonstate_inst) @@ -487,7 +491,8 @@ subroutine Restart(this, bounds, ncid, flag) frootc_patch=this%cnveg_carbonstate_inst%frootc_patch(begp:endp), & frootc_storage_patch=this%cnveg_carbonstate_inst%frootc_storage_patch(begp:endp), & deadstemc_patch=this%cnveg_carbonstate_inst%deadstemc_patch(begp:endp), & - filter_reseed_patch=reseed_patch, num_reseed_patch=num_reseed_patch) + filter_reseed_patch=reseed_patch, num_reseed_patch=num_reseed_patch, & + spinup_factor_deadwood=spinup_factor4deadwood ) call this%cnveg_nitrogenflux_inst%restart(bounds, ncid, flag=flag) call this%cnveg_state_inst%restart(bounds, ncid, flag=flag, & cnveg_carbonstate=this%cnveg_carbonstate_inst, & From 79a94d2fcd87273d17fa1644e9d774f8b03bb813 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Sun, 10 Jan 2021 23:30:56 -0700 Subject: [PATCH 71/76] Remove some logic regarding spinup_state and just use spinup_factor_deadwood, so the logic isn't needed anymore (answers for SSP_Ld10.f19_g17.I1850Clm50Bgc.cheyenne_intel.clm-rtmColdSSP remain identical). This simplifies and makes the code more robust by removing some duplicated lines --- src/biogeochem/CNFireLi2016Mod.F90 | 10 +--------- src/biogeochem/CNFireLi2021Mod.F90 | 10 +--------- src/biogeochem/CNGapMortalityMod.F90 | 9 ++------- src/biogeochem/CNVegStructUpdateMod.F90 | 7 +------ 4 files changed, 5 insertions(+), 31 deletions(-) diff --git a/src/biogeochem/CNFireLi2016Mod.F90 b/src/biogeochem/CNFireLi2016Mod.F90 index aa1d123a55..afd661cd28 100644 --- a/src/biogeochem/CNFireLi2016Mod.F90 +++ b/src/biogeochem/CNFireLi2016Mod.F90 @@ -420,19 +420,11 @@ subroutine CNFireArea (this, bounds, num_soilc, filter_soilc, num_soilp, filter_ end if end if end if - if (spinup_state == 2) then - rootc_col(c) = rootc_col(c) + (frootc(p) + frootc_storage(p) + & + rootc_col(c) = rootc_col(c) + (frootc(p) + frootc_storage(p) + & frootc_xfer(p) + deadcrootc(p) * spinup_factor_deadwood + & deadcrootc_storage(p) + deadcrootc_xfer(p) + & livecrootc(p)+livecrootc_storage(p) + & livecrootc_xfer(p))*patch%wtcol(p) - else - rootc_col(c) = rootc_col(c) + (frootc(p) + frootc_storage(p) + & - frootc_xfer(p) + deadcrootc(p) + & - deadcrootc_storage(p) + deadcrootc_xfer(p) + & - livecrootc(p)+livecrootc_storage(p) + & - livecrootc_xfer(p))*patch%wtcol(p) - endif fsr_col(c) = fsr_col(c) + fsr_pft(patch%itype(p))*patch%wtcol(p)/(1.0_r8-cropf_col(c)) diff --git a/src/biogeochem/CNFireLi2021Mod.F90 b/src/biogeochem/CNFireLi2021Mod.F90 index b2f64867f7..973bbf46ed 100644 --- a/src/biogeochem/CNFireLi2021Mod.F90 +++ b/src/biogeochem/CNFireLi2021Mod.F90 @@ -421,19 +421,11 @@ subroutine CNFireArea (this, bounds, num_soilc, filter_soilc, num_soilp, filter_ end if end if end if - if (spinup_state == 2) then - rootc_col(c) = rootc_col(c) + (frootc(p) + frootc_storage(p) + & + rootc_col(c) = rootc_col(c) + (frootc(p) + frootc_storage(p) + & frootc_xfer(p) + deadcrootc(p) * spinup_factor_deadwood + & deadcrootc_storage(p) + deadcrootc_xfer(p) + & livecrootc(p)+livecrootc_storage(p) + & livecrootc_xfer(p))*patch%wtcol(p) - else - rootc_col(c) = rootc_col(c) + (frootc(p) + frootc_storage(p) + & - frootc_xfer(p) + deadcrootc(p) + & - deadcrootc_storage(p) + deadcrootc_xfer(p) + & - livecrootc(p)+livecrootc_storage(p) + & - livecrootc_xfer(p))*patch%wtcol(p) - endif fsr_col(c) = fsr_col(c) + fsr_pft(patch%itype(p))*patch%wtcol(p)/(1.0_r8-cropf_col(c)) diff --git a/src/biogeochem/CNGapMortalityMod.F90 b/src/biogeochem/CNGapMortalityMod.F90 index e5acca9a39..cd02221de4 100644 --- a/src/biogeochem/CNGapMortalityMod.F90 +++ b/src/biogeochem/CNGapMortalityMod.F90 @@ -191,13 +191,8 @@ subroutine CNGapMortality (bounds, num_soilc, filter_soilc, num_soilp, filter_so cnveg_carbonflux_inst%m_frootc_to_litter_patch(p) = cnveg_carbonstate_inst%frootc_patch(p) * m cnveg_carbonflux_inst%m_livestemc_to_litter_patch(p) = cnveg_carbonstate_inst%livestemc_patch(p) * m cnveg_carbonflux_inst%m_livecrootc_to_litter_patch(p) = cnveg_carbonstate_inst%livecrootc_patch(p) * m - if (spinup_state == 2 .and. .not. use_cndv) then !accelerate mortality of dead woody pools - cnveg_carbonflux_inst%m_deadstemc_to_litter_patch(p) = cnveg_carbonstate_inst%deadstemc_patch(p) * m * spinup_factor_deadwood - cnveg_carbonflux_inst%m_deadcrootc_to_litter_patch(p) = cnveg_carbonstate_inst%deadcrootc_patch(p) * m * spinup_factor_deadwood - else - cnveg_carbonflux_inst%m_deadstemc_to_litter_patch(p) = cnveg_carbonstate_inst%deadstemc_patch(p) * m - cnveg_carbonflux_inst%m_deadcrootc_to_litter_patch(p) = cnveg_carbonstate_inst%deadcrootc_patch(p) * m - end if + cnveg_carbonflux_inst%m_deadstemc_to_litter_patch(p) = cnveg_carbonstate_inst%deadstemc_patch(p) * m * spinup_factor_deadwood + cnveg_carbonflux_inst%m_deadcrootc_to_litter_patch(p) = cnveg_carbonstate_inst%deadcrootc_patch(p) * m * spinup_factor_deadwood ! storage pools cnveg_carbonflux_inst%m_leafc_storage_to_litter_patch(p) = cnveg_carbonstate_inst%leafc_storage_patch(p) * m diff --git a/src/biogeochem/CNVegStructUpdateMod.F90 b/src/biogeochem/CNVegStructUpdateMod.F90 index 91055508b9..1c0ec70fa0 100644 --- a/src/biogeochem/CNVegStructUpdateMod.F90 +++ b/src/biogeochem/CNVegStructUpdateMod.F90 @@ -199,13 +199,8 @@ subroutine CNVegStructUpdate(bounds,num_soilp, filter_soilp, & else !correct height calculation if doing accelerated spinup - if (spinup_state == 2) then - htop(p) = ((3._r8 * deadstemc(p) * spinup_factor_deadwood * taper(ivt(p)) * taper(ivt(p)))/ & + htop(p) = ((3._r8 * deadstemc(p) * spinup_factor_deadwood * taper(ivt(p)) * taper(ivt(p)))/ & (SHR_CONST_PI * nstem(ivt(p)) * dwood(ivt(p))))**(1._r8/3._r8) - else - htop(p) = ((3._r8 * deadstemc(p) * taper(ivt(p)) * taper(ivt(p)))/ & - (SHR_CONST_PI * nstem(ivt(p)) * dwood(ivt(p))))**(1._r8/3._r8) - end if endif From 391502a8397721e88c2fb8d7039111be5d8bbe41 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Tue, 12 Jan 2021 01:31:38 -0700 Subject: [PATCH 72/76] Add taper to paramsfiles, and always use it and nstem, new paramsfiles for clm45, clm50, ctsm51 --- bld/namelist_files/namelist_defaults_ctsm.xml | 6 +++--- src/main/pftconMod.F90 | 15 ++++----------- 2 files changed, 7 insertions(+), 14 deletions(-) diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index 519c021c83..b80f529904 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -473,9 +473,9 @@ attributes from the config_cache.xml file (with keys converted to upper-case). -lnd/clm2/paramdata/ctsm51_params.c201220.nc -lnd/clm2/paramdata/clm50_params.c200905.nc -lnd/clm2/paramdata/clm45_params.c200905.nc +lnd/clm2/paramdata/ctsm51_params.c210112.nc +lnd/clm2/paramdata/clm50_params.c210112.nc +lnd/clm2/paramdata/clm45_params.c210112.nc diff --git a/src/main/pftconMod.F90 b/src/main/pftconMod.F90 index 91851e8626..e6989ded10 100644 --- a/src/main/pftconMod.F90 +++ b/src/main/pftconMod.F90 @@ -1030,6 +1030,10 @@ subroutine InitRead(this) if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) end if + call ncd_io('nstem',this%nstem, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + call ncd_io('taper',this%taper, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) ! ! Biomass heat storage variables ! @@ -1042,8 +1046,6 @@ subroutine InitRead(this) if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) call ncd_io('fbw',this%fbw, 'read', ncid, readvar=readv) if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - call ncd_io('nstem',this%nstem, 'read', ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) call ncd_io('rstem',this%rstem_per_dbh, 'read', ncid, readvar=readv) if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) call ncd_io('wood_density',this%wood_density, 'read', ncid, readvar=readv) @@ -1051,11 +1053,9 @@ subroutine InitRead(this) else this%dbh = 0.0_r8 this%fbw = 0.0_r8 - this%nstem = 1000._r8 / 10000._r8 this%rstem_per_dbh = 0.0_r8 this%wood_density = 0.0_r8 end if - this%taper = 200._r8 ! Initialize taper to the same value everywhere (below change it for shrub) call ncd_pio_closefile(ncid) @@ -1179,13 +1179,6 @@ subroutine InitRead(this) this%is_grass(m) = .false. endif - ! Set taper differently if shrub - if ( this%is_shrub(m) )then - this%taper(m) = 10._r8 - else - this%taper(m) = 200._r8 - end if - end do if (use_cndv) then From d4267fe2827e909366d4128566a151877315629a Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Tue, 12 Jan 2021 09:51:43 -0700 Subject: [PATCH 73/76] Deallocate new array, so that Clean method will work, which is required for the FUNITCTSM_P1x1.f10_f10_musgs.I2000Clm50Sp.cheyenne_intel to pass --- src/main/pftconMod.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/src/main/pftconMod.F90 b/src/main/pftconMod.F90 index e6989ded10..10a0d06db6 100644 --- a/src/main/pftconMod.F90 +++ b/src/main/pftconMod.F90 @@ -1476,6 +1476,7 @@ subroutine Clean(this) deallocate( this%nstem) deallocate( this%rstem_per_dbh) deallocate( this%wood_density) + deallocate( this%taper) end subroutine Clean end module pftconMod From af30ca3c4f809c717e23fba304e41886e41f3071 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Tue, 12 Jan 2021 16:53:41 -0700 Subject: [PATCH 74/76] Remove ntree because it's not used anymore --- src/main/pftconMod.F90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/main/pftconMod.F90 b/src/main/pftconMod.F90 index 10a0d06db6..88e5965051 100644 --- a/src/main/pftconMod.F90 +++ b/src/main/pftconMod.F90 @@ -26,7 +26,6 @@ module pftconMod integer, public :: nbrdlf_dcd_trp_tree ! value for Broadleaf deciduous tropical tree integer, public :: nbrdlf_dcd_tmp_tree ! value for Broadleaf deciduous temperate tree integer, public :: nbrdlf_dcd_brl_tree ! value for Broadleaf deciduous boreal tree - integer, public :: ntree ! value for last type of tree integer, public :: nbrdlf_evr_shrub ! value for Broadleaf evergreen shrub integer, public :: nbrdlf_dcd_tmp_shrub ! value for Broadleaf deciduous temperate shrub integer, public :: nbrdlf_dcd_brl_shrub ! value for Broadleaf deciduous boreal shrub @@ -1151,7 +1150,6 @@ subroutine InitRead(this) if ( trim(pftname(i)) == 'irrigated_tropical_soybean' ) nirrig_trp_soybean = i end do - ntree = nbrdlf_dcd_brl_tree ! value for last type of tree npcropmin = ntmp_corn ! first prognostic crop npcropmax = mxpft ! last prognostic crop in list From f6c6d4e4164788579423ed3bc5b3ebeb5be2223d Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Tue, 12 Jan 2021 17:10:42 -0700 Subject: [PATCH 75/76] Update change files --- doc/ChangeLog | 129 ++++++++++++++++++++++++++++++++++++++++++++++++++ doc/ChangeSum | 1 + 2 files changed, 130 insertions(+) diff --git a/doc/ChangeLog b/doc/ChangeLog index 4eac6c847f..b3f5f739a2 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,4 +1,133 @@ =============================================================== +Tag name: ctsm5.1.dev021 +Originator(s): erik (Erik Kluzek,UCAR/TSS,303-497-1326) +Date: Tue Jan 12 17:10:32 MST 2021 +One-line Summary: Add option for biomass heat storage (BHS) to clm5_1 physics + +Purpose of changes +------------------ + +Add heat stored in biomass (for trees and shrubs) to the surface energy balance calculation. Add +a switch for it and turn it on by default for clm5_1 physics. It's turned off for clm4_5, clm5_0 +physics and when FATES is turned on. Those cases are identical to before, answers only change +when it's turned on. + +Papers describing BHS simulations: +R. Meier, Davin, E., Swenson, S., Lawrence, D., and Schwaab, Jo. (2019). Biomass heat +storage dampens diurnal temperature variations +in forests. Environmental Research Letters. 14. 084026. 10.1088/1748-9326/ab2b4e. + +S.C. Swenson, Burns, S. P., and Lawrence, D. M. ( 2019). The impact of biomass heat storage +on the canopy energy balance and atmospheric stability in the community land model, Journal +of Advances in Modeling Earth Systems, 11, 83– 98. +https://doi.org/10.1029/2018MS001476 + + +Bugs fixed or introduced +------------------------ + +Issues fixed (include CTSM Issue #): + #342 --- set medlynslope to C4 appropriate value for millet and sorghum + (had already been done for miscanthus and switchgrass) + #1246 -- Make spinup_factor_deadwood a variable rather than hardcoded constant + +Known bugs introduced in this tag (include github issue ID): + #1247 -- FATES doesn't work with BHS + +Significant changes to scientifically-supported configurations +-------------------------------------------------------------- + +Does this tag change answers significantly for any of the following physics configurations? +(Details of any changes will be given in the "Answer changes" section below.) + + [Put an [X] in the box for any configuration with significant answer changes.] + +[X] clm5_1 + +[ ] clm5_0 + +[ ] ctsm5_0-nwp + +[ ] clm4_5 + +Notes of particular relevance for users +--------------------------------------- + +Caveats for users (e.g., need to interpolate initial conditions): + New variables are added on the restart files (stem/leaf biomass and stem Temp) + Testing didn't show this as a problem, but theoretically could require + updating initial conditions + +Changes to CTSM's user interface (e.g., new/renamed XML or namelist variables): New compsets, new hist fields + I1850Clm51BgcCrop + I1850Clm51Bgc + History fields: AGSB, AGLB, FSH_STEM, DHDT_CANOPY, RAH1, RAH2, RAW1, RAW2, USTAR, UM, UAF, UM, UAF, + TAF, QAF, OBU, ZETA, VPD, num_iter, RB, TSTEM + DHSDT_CANOPY, TSTEM are default active + +Changes made to namelist defaults (e.g., changed parameter values): New use_biomass_heat_storage + New namelist item: use_biomass_heat_storage to turn on or off (by default only on for clm5_1 + physics for both SP and BGC modes) + +Changes to the datasets (e.g., parameter, surface or initial files): New parameter datasets + All of the params files were updated. New terms were BHS parameters and taper + stocking is now set as "nstem" on the parameter file + taper is now on the parameter file + +Substantial timing or memory changes: Doesn't seem to + Only one short test failed the TPUTCOMP test + Longer tests were not significantly different + +Notes of particular relevance for developers: (including Code reviews and testing) +--------------------------------------------- +NOTE: Be sure to review the steps in README.CHECKLIST.master_tags as well as the coding style in the Developers Guide + +Caveats for developers (e.g., code that is duplicated that requires double maintenance): + Setting of leaf/stem biomass should be refactored and removed from CanopyFluxes (as described in #1247) + There's a change in CNGapMortality that could change for DV when AD mode is on + Stability cap (zera) is different for BHS on than off + +Changes to tests or testing: New CLM51 FATES test + +CTSM testing: regular + + [PASS means all tests PASS and OK means tests PASS other than expected fails.] + + build-namelist tests: + + cheyenne - OK (462 comparisons fail because of new namelist and params files) + + python testing (see instructions in python/README.md; document testing done): + + cheyenne -- PASS + + regular tests (aux_clm): + + cheyenne ---- OK + izumi ------- OK + +If the tag used for baseline comparisons was NOT the previous tag, note that here: + + +Answer changes +-------------- + +Changes answers relative to baseline: Yes! + + Summarize any changes to answers, i.e., + - what code configurations: clm5_1 + - what platforms/compilers: all + - nature of change: new climate for tree and shrubs + +Detailed list of changes +------------------------ + +Pull Requests that document the changes (include PR ids): +(https://github.com/ESCOMP/ctsm/pull) + #1016 -- Heat Storage biomass + +=============================================================== +=============================================================== Tag name: ctsm5.1.dev020 Originator(s): erik (Erik Kluzek,UCAR/TSS,303-497-1326) Date: Wed Dec 30 00:42:16 MST 2020 diff --git a/doc/ChangeSum b/doc/ChangeSum index 6dc5b4fc0d..0ca1854990 100644 --- a/doc/ChangeSum +++ b/doc/ChangeSum @@ -1,5 +1,6 @@ Tag Who Date Summary ============================================================================================================================ + ctsm5.1.dev021 erik 01/12/2021 Add option for biomass heat storage (BHS) to clm5_1 physics ctsm5.1.dev020 erik 12/30/2020 Potential roundoff changes in preparation for bio-mass heat storage option ctsm5.1.dev019 sacks 12/19/2020 Fix ndep from coupler ctsm5.1.dev018 slevis 12/08/2020 Add ACTIVE (T/F) column to master hist fields table and alphabetize From a1c0b5f3308350d3fbe9e400ed2c0ce590c5ba4b Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Tue, 12 Jan 2021 20:22:04 -0700 Subject: [PATCH 76/76] Update time --- doc/ChangeLog | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/ChangeLog b/doc/ChangeLog index b3f5f739a2..2ca737aa91 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,7 +1,7 @@ =============================================================== Tag name: ctsm5.1.dev021 Originator(s): erik (Erik Kluzek,UCAR/TSS,303-497-1326) -Date: Tue Jan 12 17:10:32 MST 2021 +Date: Tue Jan 12 20:21:52 MST 2021 One-line Summary: Add option for biomass heat storage (BHS) to clm5_1 physics Purpose of changes