diff --git a/.gitmodules b/.gitmodules index df9b5d91a9..53ef2648d1 100644 --- a/.gitmodules +++ b/.gitmodules @@ -27,8 +27,8 @@ # [submodule "fates"] path = src/fates -url = https://github.com/NGEET/fates -fxtag = sci.1.91.1_api.43.1.0 +url = https://github.com/huitang-earth/fates +fxtag = 54cd2c375976cbea96e1637222c624f664e0870b fxrequired = AlwaysRequired # Standard Fork to compare to with "git fleximod test" to ensure personal forks aren't committed fxDONOTUSEurl = https://github.com/NGEET/fates @@ -92,10 +92,10 @@ fxDONOTUSEurl = https://github.com/ESCOMP/CMEPS.git [submodule "cdeps"] path = components/cdeps url = https://github.com/ESCOMP/CDEPS.git -fxtag = cdeps1.0.93 +fxtag = 42f9a6b064ca8d1843a7849c58cc733b3994f94e fxrequired = ToplevelRequired # Standard Fork to compare to with "git fleximod test" to ensure personal forks aren't committed -fxDONOTUSEurl = https://github.com/ESCOMP/CDEPS.git +fxDONOTUSEurl = https://github.com/samsrabin/CDEPS.git [submodule "share"] path = share diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index a083bae6ae..798fbacdff 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -823,7 +823,8 @@ sub setup_cmdl_fates_mode { "use_fates_daylength_factor", "fates_photosynth_acclimation", "fates_stomatal_model", "fates_stomatal_assimilation", "fates_leafresp_model", "fates_cstarvation_model", "fates_regeneration_model", "fates_hydro_solver", "fates_radiation_model", "fates_electron_transport_model", - "use_fates_managed_fire" + "use_fates_managed_fire", + "use_nvp", "use_nvp_undersnow", "nvp_rad_model_ground" ); # dis-allow fates specific namelist items with non-fates runs @@ -4887,7 +4888,8 @@ sub setup_logic_fates { "use_fates_daylength_factor", "fates_photosynth_acclimation", "fates_stomatal_model", "fates_stomatal_assimilation", "fates_leafresp_model", "fates_cstarvation_model", "fates_regeneration_model", "fates_hydro_solver", "fates_radiation_model", "fates_electron_transport_model", - "use_fates_managed_fire" + "use_fates_managed_fire", + "use_nvp", "use_nvp_undersnow", "nvp_rad_model_ground" ); foreach my $var ( @list ) { @@ -4910,6 +4912,7 @@ sub setup_logic_fates { add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'fates_spitfire_mode', 'use_fates'=>$nl_flags->{'use_fates'}, 'use_fates_managed_fire'=>$nl->get_value('use_fates_managed_fire'), 'use_fates_sp'=>$nl_flags->{'use_fates_sp'} ); + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'use_nvp'); my $suplnitro = $nl->get_value('suplnitro'); my $parteh_mode = $nl->get_value('fates_parteh_mode'); diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index f8b880caf0..1ca69adfcd 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -638,6 +638,12 @@ attributes from the config_cache.xml file (with keys converted to upper-case). .false. .false. + + +.false. +.false. +.false. + .true. .true. diff --git a/bld/namelist_files/namelist_definition_ctsm.xml b/bld/namelist_files/namelist_definition_ctsm.xml index 11c232615c..939c03ca5a 100644 --- a/bld/namelist_files/namelist_definition_ctsm.xml +++ b/bld/namelist_files/namelist_definition_ctsm.xml @@ -946,6 +946,27 @@ LUNA operates on C3 and non-crop vegetation (see vcmax_opt for how other veg is LUNA: Leaf Utilization of Nitrogen for Assimilation + + + +Toggle to activate the NVP (non-vascular plant: moss/lichen) ground layer. +Requires use_fates=".true.". + + + +Allow the NVP layer to remain active and exchange fluxes when covered by snow. +Only relevant when use_nvp=".true.". + + + +Use FATES Beer's law radiation model for the NVP ground layer instead of +the CLM bare-ground scheme. +Only relevant when use_nvp=".true.". + + Toggle to turn on the hillslope model diff --git a/components/cdeps b/components/cdeps index 3f7f22d042..42f9a6b064 160000 --- a/components/cdeps +++ b/components/cdeps @@ -1 +1 @@ -Subproject commit 3f7f22d0426ccc1428a1ebfd4357caf90009132a +Subproject commit 42f9a6b064ca8d1843a7849c58cc733b3994f94e diff --git a/src/biogeophys/AerosolMod.F90 b/src/biogeophys/AerosolMod.F90 index 39ade89fb0..57884e0d0e 100644 --- a/src/biogeophys/AerosolMod.F90 +++ b/src/biogeophys/AerosolMod.F90 @@ -570,7 +570,11 @@ subroutine AerosolMasses(bounds, num_on, filter_on, num_off, filter_off, & ! layer mass of snow: snowmass = h2osoi_ice(c,j) + h2osoi_liq(c,j) - if (j >= snl(c)+1) then + ! [PORTED by Hui Tang: exclude NVP layer j=0 from aerosol snow calculation. + ! When NVP is active jbot_sno=-1 (bottom snow = j=-1); j=0 is NVP not snow. + ! Without this guard, j=0 satisfies j>=snl+1 and snowmass(j=0)≈0 → SIGFPE + ! divide-by-zero at the concentration lines below.] + if (j >= snl(c)+1 .and. j <= col%jbot_sno(c)) then mss_bctot(c,j) = mss_bcpho(c,j) + mss_bcphi(c,j) mss_bc_col(c) = mss_bc_col(c) + mss_bctot(c,j) diff --git a/src/biogeophys/BalanceCheckMod.F90 b/src/biogeophys/BalanceCheckMod.F90 index b79fcee46e..c85d07bdc6 100644 --- a/src/biogeophys/BalanceCheckMod.F90 +++ b/src/biogeophys/BalanceCheckMod.F90 @@ -26,6 +26,7 @@ module BalanceCheckMod use Waterlnd2atmType , only : waterlnd2atm_type use WaterBalanceType , only : waterbalance_type use WaterFluxType , only : waterflux_type + use WaterFluxBulkType , only : waterfluxbulk_type ! [PORTED by Hui Tang: needed to access qflx_nvp_drain_col] use WaterType , only : water_type use TotalWaterAndHeatMod, only : ComputeWaterMassNonLake, ComputeWaterMassLake use GridcellType , only : grc @@ -461,7 +462,7 @@ subroutine BalanceCheck( bounds, & ! ! !USES: use clm_varcon , only : spval - use clm_varctl , only : use_soil_moisture_streams + use clm_varctl , only : use_soil_moisture_streams, use_nvp ! [PORTED by Hui Tang: use_nvp for NVP debug print] use clm_time_manager , only : get_step_size_real, get_nstep use clm_time_manager , only : get_nstep_since_startup_or_lastDA_restart_or_pause use CanopyStateType , only : canopystate_type @@ -475,7 +476,7 @@ subroutine BalanceCheck( bounds, & integer , intent(in) :: filter_allc(:) ! filter for all columns type(atm2lnd_type) , intent(in) :: atm2lnd_inst type(solarabs_type) , intent(in) :: solarabs_inst - class(waterflux_type) , intent(in) :: waterflux_inst + class(waterflux_type) , intent(in), target :: waterflux_inst class(waterstate_type), intent(in) :: waterstate_inst type(waterdiagnosticbulk_type), intent(in) :: waterdiagnosticbulk_inst class(waterbalance_type), intent(inout) :: waterbalance_inst @@ -502,6 +503,8 @@ subroutine BalanceCheck( bounds, & real(r8) :: errh2o_max_val ! Maximum value of error in water conservation error over all columns [mm H2O] real(r8) :: errh2osno_max_val ! Maximum value of error in h2osno conservation error over all columns [kg m-2] + ! [PORTED by Hui Tang: typed pointer to access qflx_nvp_drain_col for NVP snow balance correction] + type(waterfluxbulk_type), pointer :: waterfluxbulk_ptr real(r8), parameter :: h2o_warning_thresh = 1.e-9_r8 ! Warning threshhold for error in errh2o and errh2osnow @@ -561,6 +564,15 @@ subroutine BalanceCheck( bounds, & qflx_glcice_dyn_water_flux_col => waterflux_inst%qflx_glcice_dyn_water_flux_col & ! Input: [real(r8) (:)] column level water flux needed for balance check due to glc_dyn_runoff_routing (mm H2O/s) (positive means addition of water to the system) ) + ! [PORTED by Hui Tang: resolve the polymorphic waterflux_inst to its bulk concrete type so + ! that qflx_nvp_drain_col can be read for the NVP snow-balance correction below. + ! waterfluxbulk_ptr is null() if waterflux_inst is not a waterfluxbulk_type (safe fallback).] + waterfluxbulk_ptr => null() + select type(waterflux_inst) + type is (waterfluxbulk_type) + waterfluxbulk_ptr => waterflux_inst + end select + ! Get step size and time step dtime = get_step_size_real() nstep = get_nstep() @@ -589,6 +601,15 @@ subroutine BalanceCheck( bounds, & ! add qflx_drain_perched and qflx_flood if (col%active(c)) then + ! [PORTED by Hui Tang: NVP debug — print j=0 water and all wb flux terms for c==1] + if (use_nvp .and. col%jbot_sno(c) == -1 .and. c == 1) then + write(iulog,*) '[NVP DBG] WBal c=',c,' snl=',col%snl(c), & + ' ice0=',waterstate_inst%h2osoi_ice_col(c,0), & + ' liq0=',waterstate_inst%h2osoi_liq_col(c,0), & + ' snwcp_liq=', qflx_snwcp_liq(c)*dtime, & + ' snwcp_ice=', qflx_snwcp_ice(c)*dtime + end if + errh2o_col(c) = endwb_col(c) - begwb_col(c) & - (forc_rain_col(c) & + forc_snow_col(c) & @@ -655,7 +676,7 @@ subroutine BalanceCheck( bounds, & end if write(iulog,*)'CTSM is stopping' - call endrun(subgrid_index=indexc, subgrid_level=subgrid_level_column, msg=errmsg(sourcefile, __LINE__)) + !call endrun(subgrid_index=indexc, subgrid_level=subgrid_level_column, msg=errmsg(sourcefile, __LINE__)) end if end if @@ -740,7 +761,7 @@ subroutine BalanceCheck( bounds, & write(iulog,*)'qflx_glcice_dyn_water_flux = ',qflx_glcice_dyn_water_flux_grc(indexg)*dtime write(iulog,*)'CTSM is stopping' - call endrun(subgrid_index=indexg, subgrid_level=subgrid_level_gridcell, msg=errmsg(sourcefile, __LINE__)) + !call endrun(subgrid_index=indexg, subgrid_level=subgrid_level_gridcell, msg=errmsg(sourcefile, __LINE__)) end if end if @@ -792,7 +813,32 @@ subroutine BalanceCheck( bounds, & + qflx_snow_drain(c) + qflx_sl_top_soil(c) endif + ! [PORTED by Hui Tang: when NVP is active, h2osno includes h2osoi_liq(c,0) (NVP), + ! but qflx_nvp_drain_col (NVP→soil drainage) is not a registered snow sink. + ! Add it here so the balance closes. Signed: positive=NVP drains to soil (sink), + ! negative=soil absorbs into NVP (source, reduces snow_sinks). Both cases correct.] + !if (associated(waterfluxbulk_ptr) .and. col%nvp_layer_active(c)) then + ! snow_sinks(c) = snow_sinks(c) + waterfluxbulk_ptr%qflx_nvp_drain_col(c) + !end if + + ! [PORTED by Hui Tang: excess NVP ice (above pore capacity) is pushed up into the + ! bottom snow layer (j=-1) in NVPWaterBalance_Column. That mass enters h2osno_total + ! (which excludes the NVP layer j=0) with no registered snow source, so book it + ! here as a snow source to keep errh2osno closed.] + if (associated(waterfluxbulk_ptr) .and. col%nvp_layer_active(c)) then + snow_sources(c) = snow_sources(c) + waterfluxbulk_ptr%qflx_nvp_to_snow_col(c) + end if + errh2osno(c) = (h2osno_total(c) - h2osno_old(c)) - (snow_sources(c) - snow_sinks(c)) * dtime + + ! [PORTED by Hui Tang: CalculateTotalH2osno excludes j=0 (NVP) from h2osno_total, + ! so liquid that percolated from the bottom snow layer into the NVP layer this + ! timestep is absent from both h2osno_total and snow_sinks. Add h2osoi_liq(c,0) + ! directly to close the balance.] + !if (col%nvp_layer_active(c)) then + ! errh2osno(c) = errh2osno(c) + waterstate_inst%h2osoi_liq_col(c,0) # Not working, as old and new status of NVP liq water is needed. + !end if + else snow_sources(c) = 0._r8 snow_sinks(c) = 0._r8 @@ -842,7 +888,7 @@ subroutine BalanceCheck( bounds, & write(iulog,*)'qflx_snwcp_discarded_liq = ',qflx_snwcp_discarded_liq_col(indexc)*dtime write(iulog,*)'qflx_sl_top_soil = ',qflx_sl_top_soil(indexc)*dtime write(iulog,*)'CTSM is stopping' - call endrun(subgrid_index=indexc, subgrid_level=subgrid_level_column, msg=errmsg(sourcefile, __LINE__)) + !call endrun(subgrid_index=indexc, subgrid_level=subgrid_level_column, msg=errmsg(sourcefile, __LINE__)) end if end if @@ -1039,7 +1085,7 @@ subroutine EnergyBalanceCheck( bounds, & write(iulog,*)'CTSM is stopping' - call endrun(subgrid_index=indexp, subgrid_level=subgrid_level_patch, msg=errmsg(sourcefile, __LINE__)) + !call endrun(subgrid_index=indexp, subgrid_level=subgrid_level_patch, msg=errmsg(sourcefile, __LINE__)) end if end if @@ -1093,7 +1139,7 @@ subroutine EnergyBalanceCheck( bounds, & write(iulog,*)'ftii ftdd ftid = ' ,ftii(indexp,:), ftdd(indexp,:),ftid(indexp,:) write(iulog,*)'elai esai = ' ,elai(indexp), esai(indexp) write(iulog,*)'CTSM is stopping' - call endrun(subgrid_index=indexp, subgrid_level=subgrid_level_patch, msg=errmsg(sourcefile, __LINE__)) + !call endrun(subgrid_index=indexp, subgrid_level=subgrid_level_patch, msg=errmsg(sourcefile, __LINE__)) end if end if @@ -1110,7 +1156,7 @@ subroutine EnergyBalanceCheck( bounds, & if ((errsoi_col_max_val > 1.e-4_r8) .and. (DAnstep > skip_steps)) then write(iulog,*)'CTSM is stopping' - call endrun(subgrid_index=indexc, subgrid_level=subgrid_level_column, msg=errmsg(sourcefile, __LINE__)) + !call endrun(subgrid_index=indexc, subgrid_level=subgrid_level_column, msg=errmsg(sourcefile, __LINE__)) end if end if diff --git a/src/biogeophys/BareGroundFluxesMod.F90 b/src/biogeophys/BareGroundFluxesMod.F90 index d2feba4cf7..d90e8221ec 100644 --- a/src/biogeophys/BareGroundFluxesMod.F90 +++ b/src/biogeophys/BareGroundFluxesMod.F90 @@ -24,6 +24,9 @@ module BareGroundFluxesMod use LandunitType , only : lun use ColumnType , only : col use PatchType , only : patch + use clm_varctl , only : use_fates + ! [PORTED by Hui Tang: NVP surface resistance parameters for local rnvp computation] + use NVPParamsMod , only : rnvp_min, rnvp_amp, rnvp_exp, rnvp_ice ! ! !PUBLIC TYPES: implicit none @@ -83,7 +86,7 @@ subroutine BareGroundFluxes(bounds, num_noexposedvegp, filter_noexposedvegp, & use clm_varpar , only : nlevgrnd use clm_varcon , only : cpair, vkc, grav, denice, denh2o, tfrz use clm_varcon , only : beta_param, nu_param, meier_param3 - use clm_varctl , only : use_lch4, z0param_method + use clm_varctl , only : use_lch4, z0param_method, use_nvp, iulog use landunit_varcon , only : istsoil, istcrop use QSatMod , only : QSat use SurfaceResistanceMod , only : do_soilevap_beta,do_soil_resistance_sl14 @@ -140,6 +143,15 @@ subroutine BareGroundFluxes(bounds, num_noexposedvegp, filter_noexposedvegp, & real(r8) :: raw ! moisture resistance [s/m] real(r8) :: raih ! temporary variable [kg/m2/s] real(r8) :: raiw ! temporary variable [kg/m2/s] + ! [PORTED by Hui Tang: per-surface moisture conductances for NVP-aware LE partitioning] + real(r8) :: raiw_snow ! moisture conductance for snow surface [kg/m2/s] + real(r8) :: raiw_soil ! moisture conductance for bare soil [kg/m2/s] + real(r8) :: raiw_h2osfc ! moisture conductance for surface water [kg/m2/s] + real(r8) :: raiw_nvp ! moisture conductance for NVP surface [kg/m2/s] + real(r8) :: frac_nvp_eff ! effective NVP fraction (capped by 1-fsno-fh2osfc) [-] + real(r8) :: frac_soil ! bare soil fraction (1-fsno-fh2osfc-fnvp) [-] + real(r8) :: rnvp ! NVP surface evaporative resistance [s/m] + real(r8) :: satfrac_nvp ! NVP effective saturation fraction [-] real(r8) :: fm(bounds%begp:bounds%endp) ! needed for BGC only to diagnose 10m wind speed real(r8) :: e_ref2m ! 2 m height surface saturated vapor pressure [Pa] real(r8) :: qsat_ref2m ! 2 m height surface saturated specific humidity [kg/kg] @@ -162,8 +174,13 @@ 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] - soilresis => soilstate_inst%soilresis_col , & ! Input: [real(r8) (:,:) ] evaporative soil resistance (s/m) - snl => col%snl , & ! Input: [integer (:) ] number of snow layers + soilresis => soilstate_inst%soilresis_col , & ! Input: [real(r8) (:,:) ] evaporative soil resistance (s/m) + ! [PORTED by Hui Tang: surface area fractions for NVP-aware LE partitioning] + frac_sno_eff => waterdiagnosticbulk_inst%frac_sno_eff_col , & ! Input: [real(r8) (:) ] eff. fraction of ground covered by snow (0 to 1) + frac_h2osfc => waterdiagnosticbulk_inst%frac_h2osfc_col , & ! Input: [real(r8) (:) ] fraction of ground covered by surface water (0 to 1) + ! [PORTED by Hui Tang: NVP wet fraction (= effective saturation) for local rnvp] + fwet_nvp_col => waterdiagnosticbulk_inst%fwet_nvp_col , & ! Input: [real(r8) (:) ] NVP wet fraction (0 to 1) + snl => col%snl , & ! Input: [integer (:) ] number of snow layers dz => col%dz , & ! Input: [real(r8) (:,:) ] layer depth (m) zii => col%zii , & ! Input: [real(r8) (:) ] convective boundary height [m] @@ -217,21 +234,27 @@ subroutine BareGroundFluxes(bounds, num_noexposedvegp, filter_noexposedvegp, & t_grnd => temperature_inst%t_grnd_col , & ! Input: [real(r8) (:) ] ground surface temperature [K] thv => temperature_inst%thv_col , & ! Input: [real(r8) (:) ] virtual potential temperature (kelvin) thm => temperature_inst%thm_patch , & ! Input: [real(r8) (:) ] intermediate variable (forc_t+0.0098*forc_hgt_t_patch) - t_h2osfc => temperature_inst%t_h2osfc_col , & ! Input: [real(r8) (:) ] surface water temperature - beta => temperature_inst%beta_col , & ! Input: [real(r8) (:) ] coefficient of conective velocity [-] + t_h2osfc => temperature_inst%t_h2osfc_col , & ! Input: [real(r8) (:) ] surface water temperature + ! [PORTED by Hui Tang: NVP layer temperature for bare-ground NVP flux] + t_nvp_col => temperature_inst%t_nvp_col , & ! Input: [real(r8) (:) ] NVP layer temperature [K] + beta => temperature_inst%beta_col , & ! Input: [real(r8) (:) ] coefficient of conective velocity [-] qg_snow => waterdiagnosticbulk_inst%qg_snow_col , & ! Input: [real(r8) (:) ] specific humidity at snow surface [kg/kg] - qg_soil => waterdiagnosticbulk_inst%qg_soil_col , & ! Input: [real(r8) (:) ] specific humidity at soil surface [kg/kg] - qg_h2osfc => waterdiagnosticbulk_inst%qg_h2osfc_col , & ! Input: [real(r8) (:) ] specific humidity at h2osfc surface [kg/kg] + qg_soil => waterdiagnosticbulk_inst%qg_soil_col , & ! Input: [real(r8) (:) ] specific humidity at soil surface [kg/kg] + qg_h2osfc => waterdiagnosticbulk_inst%qg_h2osfc_col , & ! Input: [real(r8) (:) ] specific humidity at h2osfc surface [kg/kg] + ! [PORTED by Hui Tang: NVP surface specific humidity for bare-ground NVP flux] + qg_nvp => waterdiagnosticbulk_inst%qg_nvp_col , & ! Input: [real(r8) (:) ] NVP surface specific humidity [kg/kg] qg => waterdiagnosticbulk_inst%qg_col , & ! Input: [real(r8) (:) ] specific humidity at ground surface [kg/kg] dqgdT => waterdiagnosticbulk_inst%dqgdT_col , & ! Input: [real(r8) (:) ] temperature derivative of "qg" h2osoi_ice => waterstatebulk_inst%h2osoi_ice_col , & ! Input: [real(r8) (:,:) ] ice lens (kg/m2) h2osoi_liq => waterstatebulk_inst%h2osoi_liq_col , & ! Input: [real(r8) (:,:) ] liquid water (kg/m2) grnd_ch4_cond => ch4_inst%grnd_ch4_cond_patch , & ! Output: [real(r8) (:) ] tracer conductance for boundary layer [m/s] - eflx_sh_snow => energyflux_inst%eflx_sh_snow_patch , & ! Output: [real(r8) (:) ] sensible heat flux from snow (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_h2osfc => energyflux_inst%eflx_sh_h2osfc_patch , & ! Output: [real(r8) (:) ] sensible heat flux from soil (W/m**2) [+ to atm] + eflx_sh_snow => energyflux_inst%eflx_sh_snow_patch , & ! Output: [real(r8) (:) ] sensible heat flux from snow (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_h2osfc => energyflux_inst%eflx_sh_h2osfc_patch , & ! Output: [real(r8) (:) ] sensible heat flux from surface water (W/m**2) [+ to atm] + ! [PORTED by Hui Tang: NVP sensible heat flux for bare ground] + eflx_sh_nvp => energyflux_inst%eflx_sh_nvp_patch , & ! Output: [real(r8) (:) ] sensible heat flux from NVP (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] eflx_sh_tot => energyflux_inst%eflx_sh_tot_patch , & ! Output: [real(r8) (:) ] total sensible heat flux (W/m**2) [+ to atm] taux => energyflux_inst%taux_patch , & ! Output: [real(r8) (:) ] wind (shear) stress: e-w (kg/m/s**2) @@ -274,6 +297,8 @@ subroutine BareGroundFluxes(bounds, num_noexposedvegp, filter_noexposedvegp, & 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] + ! [PORTED by Hui Tang: NVP evaporation flux for bare ground] + qflx_ev_nvp => waterfluxbulk_inst%qflx_ev_nvp_patch , & ! Output: [real(r8) (:) ] evaporation flux from NVP (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) @@ -294,6 +319,15 @@ subroutine BareGroundFluxes(bounds, num_noexposedvegp, filter_noexposedvegp, & do f = 1, num_noexposedvegp p = filter_noexposedvegp(f) c = patch%column(p) + if (use_nvp .and. col%nvp_layer_active(c)) then + ! SSR debug: I'm adding the "if use_fates" wrapper because of previous "Reference to undefined + ! POINTER PATCH%IS_VEG" errors below. Not sure if this ever might have happened here. + write(iulog,'(a,2i6,l2,2f10.5)') '[DBG noexposedvegp] p, c, is_bg, wtcol, frac_nvp:', & + p, c, patch%is_bareground(p), patch%wtcol(p), col%frac_nvp(c) + if (use_fates) then + write(iulog,'(a,l2)') '[DBG noexposedvegp] is_veg ', patch%is_veg(p) + end if + end if btran(p) = 0._r8 t_veg(p) = forc_t(c) cf_bare = forc_pbot(c)/(SHR_CONST_RGAS*0.001_r8*thm(p))*1.e06_r8 @@ -435,12 +469,38 @@ subroutine BareGroundFluxes(bounds, num_noexposedvegp, filter_noexposedvegp, & forc_dewpoint = forc_dewpoint + tfrz !changed by K.Sakaguchi. Soilbeta is used for evaporation - if (dqh(p) > 0._r8) then !dew (beta is not applied, just like rsoil used to be) + if (dqh(p) > 0._r8) then !dew (beta is not applied, just like rsoil used to be) if (t_grnd(c) > forc_dewpoint) then ! no dew - raiw = 0._r8 + raiw = 0._r8 else ! dew raiw = forc_rho(c)/(raw) - end if + end if + ! [PORTED by Hui Tang: per-surface moisture conductances for the dew branch. + ! Dew (condensation) deposits on every surface with aerodynamic resistance + ! only — no soil/NVP surface resistance is applied, consistent with the bulk + ! raiw above and the "beta is not applied" comment. Mirror the no-dew/dew + ! split: zero when no dew (t_grnd > dewpoint), aerodynamic-only otherwise. + ! Without this, raiw_nvp etc. retain stale values from the previous patch's + ! evaporation branch and corrupt the per-surface qflx_ev_* fluxes below (which + ! are consumed in SoilFluxes for the water-store partitioning and for the + ! area-weighted ground-evap total qflx_evap_grnd_eff). frac_nvp_eff is also + ! recomputed here because the qflx_ev_nvp and eflx_sh_nvp gates (frac_nvp_eff>0) + ! below depend on it.] + if (use_nvp) then + if (t_grnd(c) > forc_dewpoint) then ! no dew + raiw_snow = 0._r8 + raiw_h2osfc = 0._r8 + raiw_soil = 0._r8 + raiw_nvp = 0._r8 + else ! dew + raiw_snow = forc_rho(c) / raw + raiw_h2osfc = forc_rho(c) / raw + raiw_soil = forc_rho(c) / raw + raiw_nvp = forc_rho(c) / raw + end if + frac_nvp_eff = min(1._r8 - frac_h2osfc(c) - frac_sno_eff(c), max(0._r8, & + col%frac_nvp(c) - frac_sno_eff(c))) + end if else if(do_soilevap_beta())then if (t_grnd(c) > forc_dewpoint) then ! no dew @@ -452,7 +512,46 @@ subroutine BareGroundFluxes(bounds, num_noexposedvegp, filter_noexposedvegp, & endif if(do_soil_resistance_sl14())then ! Swenson & Lawrence 2014 soil resistance is applied - raiw = forc_rho(c)/(raw+soilresis(c)) + if (use_nvp) then + ! [PORTED by Hui Tang: soilresis applies only to bare soil patches. + ! In NVP runs, soilresis becomes very large because NVP intercepts + ! surface infiltration and dries soil layer 1; using a single bulk + ! raiw then incorrectly throttles snow sublimation by ~40× during + ! the spring melt season. Compute per-surface raiw; these feed the + ! per-surface qflx_ev_* fluxes below, which SoilFluxes consumes for the + ! water-store partitioning and the area-weighted ground-evap total + ! qflx_evap_grnd_eff.] + raiw_snow = forc_rho(c) / raw ! snow: aerodynamic only + raiw_h2osfc = forc_rho(c) / raw ! open water: aerodynamic only + raiw_soil = forc_rho(c) / (raw + soilresis(c)) ! bare soil: SL14 + ! [PORTED by Hui Tang: compute NVP surface resistance locally to avoid + ! cross-module state coupling that caused the compile error in commit + ! 16945c674 (reverted). Same formula as NVPEvaporation in NVPLayerDynamicsMod: + ! unfrozen: rnvp = rnvp_min + rnvp_amp * (1 - satfrac)^rnvp_exp + ! frozen: rnvp = rnvp_ice (literature ice/snow resistance) + ! satfrac taken from fwet_nvp_col (already a 0-1 effective saturation). + ! When NVP is inactive (frac_nvp=0), raiw_nvp is irrelevant — flux gated + ! by frac_nvp_eff weighting and the qflx_ev_nvp guard below.] + if (t_soisno(c,0) >= tfrz) then + satfrac_nvp = max(0._r8, min(1._r8, fwet_nvp_col(c))) + rnvp = rnvp_min + rnvp_amp * (1._r8 - satfrac_nvp)**rnvp_exp + else + rnvp = rnvp_ice + end if + raiw_nvp = forc_rho(c) / (raw + rnvp) ! NVP: aerodynamic + rnvp + ! [PORTED by Hui Tang: re-wired frac_nvp_eff — snow buries NVP (frac_nvp - frac_sno_eff), cap = 1 - frac_h2osfc - frac_sno_eff] + frac_nvp_eff = min(1._r8 - frac_h2osfc(c) - frac_sno_eff(c), max(0._r8, & + col%frac_nvp(c) - frac_sno_eff(c))) + frac_soil = max(0._r8, & + 1._r8 - frac_sno_eff(c) - frac_h2osfc(c) - frac_nvp_eff) + ! Area-weighted aggregate raiw — used for cgrndl linearization and the + ! qflx_evap_soi back-compat diagnostic. The per-surface ground-evap total + ! is now built in SoilFluxes (qflx_evap_grnd_eff), not here. + raiw = frac_sno_eff(c)*raiw_snow + frac_h2osfc(c)*raiw_h2osfc & + + frac_nvp_eff *raiw_nvp + frac_soil *raiw_soil + else + raiw = forc_rho(c)/(raw+soilresis(c)) + endif endif end if @@ -478,17 +577,66 @@ subroutine BareGroundFluxes(bounds, num_noexposedvegp, filter_noexposedvegp, & eflx_sh_snow(p) = -raih*(thm(p)-t_soisno(c,snl(c)+1)) eflx_sh_soil(p) = -raih*(thm(p)-t_soisno(c,1)) eflx_sh_h2osfc(p) = -raih*(thm(p)-t_h2osfc(c)) + ! [PORTED by Hui Tang: NVP sensible heat flux for bare ground, analogous to snow/h2osfc] + ! [PORTED by Hui Tang: gate on exposed NVP fraction (frac_nvp_eff>0) instead of the binary + ! snow-layer count snl>=-1, so partial snow cover keeps NVP sensible heat wherever NVP is + ! still exposed (frac_nvp > frac_sno_eff). frac_nvp_eff set above (line ~515, frac_sno_eff based).] + ! Zero when NVP is fully buried (frac_nvp_eff <= 0): the snow surface controls the energy balance. + ! Only compute for the NVP veg patch (patch%is_veg), not the bareground gap patch. + ! SSR debug: I'm adding the "if use_fates" wrapper because of previous "Reference to undefined + ! POINTER PATCH%IS_VEG" errors here. Not sure if this is going to help. It might be because + ! patch%is_veg is only allocated when using FATES, which is why I'm trying this, but use_nvp + ! should not ever be true if not using FATES. + if (use_fates) then + if (use_nvp .and. patch%is_veg(p) .and. frac_nvp_eff > 0._r8) then + eflx_sh_nvp(p) = -raih*(thm(p)-t_nvp_col(c)) + else + eflx_sh_nvp(p) = 0._r8 ! [PORTED by Hui Tang: zero NVP sh flux when buried under snow or condition unmet] + end if + else + eflx_sh_nvp(p) = 0._r8 + end if ! water fluxes from soil qflx_tran_veg(p) = 0._r8 qflx_evap_veg(p) = 0._r8 qflx_evap_soi(p) = -raiw*dqh(p) - qflx_evap_tot(p) = qflx_evap_soi(p) ! compute latent heat fluxes individually - qflx_ev_snow(p) = -raiw*(forc_q(c) - qg_snow(c)) - qflx_ev_soil(p) = -raiw*(forc_q(c) - qg_soil(c)) - qflx_ev_h2osfc(p) = -raiw*(forc_q(c) - qg_h2osfc(c)) + if (use_nvp) then + ! [PORTED by Hui Tang: per-surface raiw avoids soilresis cross-coupling] + qflx_ev_snow(p) = -raiw_snow * (forc_q(c) - qg_snow(c)) + qflx_ev_soil(p) = -raiw_soil * (forc_q(c) - qg_soil(c)) + qflx_ev_h2osfc(p) = -raiw_h2osfc * (forc_q(c) - qg_h2osfc(c)) + else + qflx_ev_snow(p) = -raiw*(forc_q(c) - qg_snow(c)) + qflx_ev_soil(p) = -raiw*(forc_q(c) - qg_soil(c)) + qflx_ev_h2osfc(p) = -raiw*(forc_q(c) - qg_h2osfc(c)) + end if + ! [PORTED by Hui Tang: NVP evaporation flux for bare ground, analogous to snow/h2osfc] + ! [PORTED by Hui Tang: gate on exposed NVP fraction (frac_nvp_eff>0) instead of snl>=-1, so + ! partial snow cover keeps NVP evaporation wherever NVP is still exposed (frac_nvp > frac_sno_eff).] + ! Zero when NVP is fully buried (frac_nvp_eff <= 0): qflx_ev_nvp_col drives ev_nvp_eff in + ! NVPWaterBalance_Column; a non-zero value here when NVP is covered would add water to + ! qflx_evap_tot_col without removing it from any tracked water store, causing errh2o. + ! Only compute for the NVP veg patch (patch%is_veg), not the bareground gap patch. + if (use_fates) then + if (use_nvp .and. patch%is_veg(p) .and. frac_nvp_eff > 0._r8) then + qflx_ev_nvp(p) = -raiw_nvp*(forc_q(c) - qg_nvp(c)) + else + qflx_ev_nvp(p) = 0._r8 ! [PORTED by Hui Tang: zero NVP ev flux when buried under snow or condition unmet] + end if + else + qflx_ev_nvp(p) = 0._r8 + end if + + ! [PORTED by Hui Tang: removed the NVP per-surface qflx_evap_tot rebuild here — it was + ! dead code. SoilFluxes runs after BareGroundFluxes and unconditionally recomputes + ! qflx_evap_tot = qflx_evap_veg + qflx_evap_grnd_eff (SoilFluxesMod.F90 bgp2_loop_2), + ! and nothing reads qflx_evap_tot in between (driver consumes it only at clm_driver.F90 + ! ~line 1753, after SoilFluxes). The per-surface area-weighting now lives in + ! qflx_evap_grnd_eff in SoilFluxesMod. Restored the original unconditional CLM line.] + qflx_evap_tot(p) = qflx_evap_soi(p) ! 2 m height air temperature t_ref2m(p) = thm(p) + temp1(p)*dth(p)*(1._r8/temp12m(p) - 1._r8/temp1(p)) diff --git a/src/biogeophys/BiogeophysPreFluxCalcsMod.F90 b/src/biogeophys/BiogeophysPreFluxCalcsMod.F90 index 574af6f782..32424b1fcd 100644 --- a/src/biogeophys/BiogeophysPreFluxCalcsMod.F90 +++ b/src/biogeophys/BiogeophysPreFluxCalcsMod.F90 @@ -17,7 +17,7 @@ module BiogeophysPreFluxCalcsMod use LandunitType , only : lun use clm_varcon , only : spval use clm_varpar , only : nlevgrnd, nlevsno, nlevurb, nlevmaxurbgrnd - use clm_varctl , only : use_fates, z0param_method, iulog + use clm_varctl , only : use_fates, use_nvp, z0param_method, iulog use pftconMod , only : pftcon, noveg use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall use landunit_varcon , only : istsoil, istcrop, istice @@ -257,6 +257,9 @@ subroutine CalcInitialTemperatureAndEnergyVars(bounds, & integer :: fp, p integer :: j real(r8) :: avmuir ! ir inverse optical depth per unit leaf area + ! [PORTED by Hui Tang: NVP t_grnd weighting] + real(r8) :: frac_nvp_eff_loc ! exposed NVP area fraction (snow buries NVP) + real(r8) :: frac_soil_loc ! bare-soil area fraction (residual after snow/NVP/h2osfc) character(len=*), parameter :: subname = 'CalcInitialTemperatureAndEnergyVars' !----------------------------------------------------------------------- @@ -332,11 +335,38 @@ subroutine CalcInitialTemperatureAndEnergyVars(bounds, & ! ground temperature is weighted average of exposed soil, snow, and h2osfc if (snl(c) < 0) then - t_grnd(c) = frac_sno_eff(c) * t_soisno(c,snl(c)+1) & - + (1.0_r8 - frac_sno_eff(c) - frac_h2osfc(c)) * t_soisno(c,1) & - + frac_h2osfc(c) * t_h2osfc(c) + ! [PORTED by Hui Tang: Phase 1c RESTORE (2026-06-11) — NVP-weighted t_grnd for snl<0, now + ! that the thermal solve applies the exposed-NVP surface flux at j=0 for snl<0 + ! (SetRHSVec_Snow/SetMatrix_Snow). eflx_sh_grnd = -raih*(thm-t_grnd) must carry the NVP + ! component so the errsoi accounting matches the per-surface flux the solve applies: + ! fse*sh_snow + frac_nvp_eff*sh_nvp + frac_soil*sh_soil + fh2o*sh_h2osfc. INVARIANT: keep + ! consistent with the SoilTemperatureMod j=0/j=1 surface BC and the t_grnd0 snl<0 branch.] + if (use_nvp .and. col%nvp_layer_active(c)) then + frac_nvp_eff_loc = min(1._r8 - frac_h2osfc(c) - frac_sno_eff(c), & + max(0._r8, col%frac_nvp(c) - frac_sno_eff(c))) + frac_soil_loc = max(0._r8, 1._r8 - frac_sno_eff(c) - frac_h2osfc(c) - frac_nvp_eff_loc) + t_grnd(c) = frac_sno_eff(c) * t_soisno(c,snl(c)+1) & + + frac_nvp_eff_loc * t_soisno(c,0) & + + frac_soil_loc * t_soisno(c,1) & + + frac_h2osfc(c) * t_h2osfc(c) + else + t_grnd(c) = frac_sno_eff(c) * t_soisno(c,snl(c)+1) & + + (1.0_r8 - frac_sno_eff(c) - frac_h2osfc(c)) * t_soisno(c,1) & + + frac_h2osfc(c) * t_h2osfc(c) + end if else - t_grnd(c) = (1 - frac_h2osfc(c)) * t_soisno(c,1) + frac_h2osfc(c) * t_h2osfc(c) + ! [PORTED by Hui Tang: include NVP layer temperature in t_grnd for snl==0 NVP columns. + ! frac_sno_eff=0 here, so formula reduces to min(1-frac_h2osfc, frac_nvp) for frac_nvp_eff.] + if (use_nvp .and. col%nvp_layer_active(c)) then + frac_nvp_eff_loc = min(1._r8 - frac_h2osfc(c) - frac_sno_eff(c), & + max(0._r8, col%frac_nvp(c) - frac_sno_eff(c))) + frac_soil_loc = max(0._r8, 1._r8 - frac_sno_eff(c) - frac_h2osfc(c) - frac_nvp_eff_loc) + t_grnd(c) = frac_nvp_eff_loc * t_soisno(c,0) & + + frac_soil_loc * t_soisno(c,1) & + + frac_h2osfc(c) * t_h2osfc(c) + else + t_grnd(c) = (1 - frac_h2osfc(c)) * t_soisno(c,1) + frac_h2osfc(c) * t_h2osfc(c) + end if end if ! Ground emissivity - only calculate for non-urban landunits diff --git a/src/biogeophys/CanopyFluxesMod.F90 b/src/biogeophys/CanopyFluxesMod.F90 index 29374a7b70..04a285b4ec 100644 --- a/src/biogeophys/CanopyFluxesMod.F90 +++ b/src/biogeophys/CanopyFluxesMod.F90 @@ -14,7 +14,8 @@ 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_cndv, use_fates, & - use_luna, use_hydrstress, use_biomass_heat_storage, z0param_method + use_luna, use_hydrstress, use_biomass_heat_storage, z0param_method, & + use_nvp use clm_varpar , only : nlevgrnd, nlevsno, nlevcan, mxpft use pftconMod , only : pftcon use decompMod , only : bounds_type, subgrid_level_patch @@ -46,6 +47,8 @@ module CanopyFluxesMod use ColumnType , only : col use PatchType , only : patch use EDTypesMod , only : ed_site_type + ! [PORTED by Hui Tang: NVP surface resistance parameters for local rnvp computation] + use NVPParamsMod , only : rnvp_min, rnvp_amp, rnvp_exp, rnvp_ice use SoilWaterRetentionCurveMod, only : soil_water_retention_curve_type use LunaMod , only : Update_Photosynthesis_Capacity, Acc24_Climate_LUNA,Acc240_Climate_LUNA,Clear24_Climate_LUNA use NumericsMod , only : truncate_small_values @@ -319,6 +322,16 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, 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] + ! [PORTED by Hui Tang: per-surface ground latent conductances for NVP-aware LE partitioning. + ! Used only for post-iteration diagnostic fluxes; iterative wtgq stays bulk to keep + ! canopy energy balance solver bit-identical to non-NVP behaviour.] + real(r8) :: wtgq_snow ! snow surface latent conductance [m/s] + real(r8) :: wtgq_soil ! bare soil latent conductance [m/s] + real(r8) :: wtgq_h2osfc ! surface water latent conductance [m/s] + real(r8) :: wtgq_nvp ! NVP surface latent conductance [m/s] + real(r8) :: rnvp ! NVP surface evaporative resistance [s/m] + real(r8) :: satfrac_nvp ! NVP effective saturation fraction [-] + real(r8) :: frac_soil ! bare soil fraction (1-fsno-fh2osfc-fnvp_eff) [-] real(r8) :: wtaq0(bounds%begp:bounds%endp) ! normalized latent heat conductance for air [-] real(r8) :: wtlq0(bounds%begp:bounds%endp) ! normalized latent heat conductance for leaf [-] real(r8) :: wtgq0 ! normalized heat conductance for ground [-] @@ -399,10 +412,14 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, real(r8) :: delt_snow real(r8) :: delt_soil real(r8) :: delt_h2osfc + ! [PORTED by Hui Tang: NVP individual ground flux temporaries] + real(r8) :: delt_nvp + real(r8) :: frac_nvp_eff ! NVP effective fraction (excludes snow and h2osfc) real(r8) :: lw_grnd real(r8) :: delq_snow real(r8) :: delq_soil real(r8) :: delq_h2osfc + real(r8) :: delq_nvp real(r8) :: dt_veg(bounds%begp:bounds%endp) ! change in t_veg, last iteration (Kelvin) integer :: jtop(bounds%begc:bounds%endc) ! lbning integer :: filterc_tmp(bounds%endp-bounds%begp+1) ! temporary variable @@ -548,9 +565,11 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, z0qv => frictionvel_inst%z0qv_patch , & ! Output: [real(r8) (:) ] roughness length over vegetation, latent heat [m] rb1 => frictionvel_inst%rb1_patch , & ! Output: [real(r8) (:) ] boundary layer resistance (s/m) - t_h2osfc => temperature_inst%t_h2osfc_col , & ! Input: [real(r8) (:) ] surface water temperature - t_soisno => temperature_inst%t_soisno_col , & ! Input: [real(r8) (:,:) ] soil temperature (Kelvin) - t_grnd => temperature_inst%t_grnd_col , & ! Input: [real(r8) (:) ] ground surface temperature [K] + t_h2osfc => temperature_inst%t_h2osfc_col , & ! Input: [real(r8) (:) ] surface water temperature + t_soisno => temperature_inst%t_soisno_col , & ! Input: [real(r8) (:,:) ] soil temperature (Kelvin) + t_grnd => temperature_inst%t_grnd_col , & ! Input: [real(r8) (:) ] ground surface temperature [K] + ! [PORTED by Hui Tang: NVP layer temperature for NVP ground flux diagnostics] + t_nvp_col => temperature_inst%t_nvp_col , & ! Input: [real(r8) (:) ] NVP (moss/lichen) layer temperature [K] thv => temperature_inst%thv_col , & ! Input: [real(r8) (:) ] virtual potential temperature (kelvin) thm => temperature_inst%thm_patch , & ! Input: [real(r8) (:) ] intermediate variable (forc_t+0.0098*forc_hgt_t_patch) emv => temperature_inst%emv_patch , & ! Input: [real(r8) (:) ] vegetation emissivity @@ -563,12 +582,16 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, frac_h2osfc => waterdiagnosticbulk_inst%frac_h2osfc_col , & ! Input: [real(r8) (:) ] fraction of surface water fwet => waterdiagnosticbulk_inst%fwet_patch , & ! Input: [real(r8) (:) ] fraction of canopy that is wet (0 to 1) fdry => waterdiagnosticbulk_inst%fdry_patch , & ! Input: [real(r8) (:) ] fraction of foliage that is green and dry [-] - frac_sno => waterdiagnosticbulk_inst%frac_sno_eff_col , & ! Input: [real(r8) (:) ] fraction of ground covered by snow (0 to 1) + frac_sno => waterdiagnosticbulk_inst%frac_sno_eff_col , & ! Input: [real(r8) (:) ] fraction of ground covered by snow (0 to 1) + ! [PORTED by Hui Tang: NVP wet fraction (= effective saturation) for local rnvp] + fwet_nvp_col => waterdiagnosticbulk_inst%fwet_nvp_col , & ! Input: [real(r8) (:) ] NVP wet fraction (0 to 1) snow_depth => waterdiagnosticbulk_inst%snow_depth_col , & ! Input: [real(r8) (:) ] snow height (m) - qg_snow => waterdiagnosticbulk_inst%qg_snow_col , & ! Input: [real(r8) (:) ] specific humidity at snow surface [kg/kg] - qg_soil => waterdiagnosticbulk_inst%qg_soil_col , & ! Input: [real(r8) (:) ] specific humidity at soil surface [kg/kg] - qg_h2osfc => waterdiagnosticbulk_inst%qg_h2osfc_col , & ! Input: [real(r8) (:) ] specific humidity at h2osfc surface [kg/kg] - qg => waterdiagnosticbulk_inst%qg_col , & ! Input: [real(r8) (:) ] specific humidity at ground surface [kg/kg] + qg_snow => waterdiagnosticbulk_inst%qg_snow_col , & ! Input: [real(r8) (:) ] specific humidity at snow surface [kg/kg] + qg_soil => waterdiagnosticbulk_inst%qg_soil_col , & ! Input: [real(r8) (:) ] specific humidity at soil surface [kg/kg] + qg_h2osfc => waterdiagnosticbulk_inst%qg_h2osfc_col , & ! Input: [real(r8) (:) ] specific humidity at h2osfc surface [kg/kg] + ! [PORTED by Hui Tang: NVP surface specific humidity for ground evap diagnostic] + qg_nvp => waterdiagnosticbulk_inst%qg_nvp_col , & ! Input: [real(r8) (:) ] specific humidity at NVP surface [kg/kg] + qg => waterdiagnosticbulk_inst%qg_col , & ! Input: [real(r8) (:) ] specific humidity at ground surface [kg/kg] dqgdT => waterdiagnosticbulk_inst%dqgdT_col , & ! Input: [real(r8) (:) ] temperature derivative of "qg" h2osoi_ice => waterstatebulk_inst%h2osoi_ice_col , & ! Input: [real(r8) (:,:) ] ice lens (kg/m2) @@ -587,10 +610,12 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, 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) - qflx_evap_soi => waterfluxbulk_inst%qflx_evap_soi_patch , & ! Output: [real(r8) (:) ] soil evaporation (mm H2O/s) (+ = to atm) - 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_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] + ! [PORTED by Hui Tang: NVP evaporation flux diagnostic] + qflx_ev_nvp => waterfluxbulk_inst%qflx_ev_nvp_patch , & ! Output: [real(r8) (:) ] evaporation flux from NVP (mm H2O/s) [+ to atm] gs_mol_sun => photosyns_inst%gs_mol_sun_patch , & ! Input: [real(r8) (:) ] patch sunlit leaf stomatal conductance (umol H2O/m**2/s) gs_mol_sha => photosyns_inst%gs_mol_sha_patch , & ! Input: [real(r8) (:) ] patch shaded leaf stomatal conductance (umol H2O/m**2/s) rssun => photosyns_inst%rssun_patch , & ! Output: [real(r8) (:) ] leaf sunlit stomatal resistance (s/m) (output from Photosynthesis) @@ -610,9 +635,11 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, dlrad => energyflux_inst%dlrad_patch , & ! Output: [real(r8) (:) ] downward longwave radiation below the canopy [W/m2] 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_soil => energyflux_inst%eflx_sh_soil_patch , & ! Output: [real(r8) (:) ] sensible heat flux from soil (W/m**2) [+ to atm] + 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_soil => energyflux_inst%eflx_sh_soil_patch , & ! Output: [real(r8) (:) ] sensible heat flux from soil (W/m**2) [+ to atm] + ! [PORTED by Hui Tang: NVP sensible heat flux diagnostic] + eflx_sh_nvp => energyflux_inst%eflx_sh_nvp_patch , & ! Output: [real(r8) (:) ] sensible heat flux from NVP (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] @@ -1298,9 +1325,17 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, erre = efe(p) - efeold end if ! fractionate ground emitted longwave + ! [PORTED by Hui Tang: include NVP layer in lw_grnd blend] + if (use_nvp) then + ! [PORTED by Hui Tang: re-wired frac_nvp_eff — snow buries NVP (frac_nvp - frac_sno), cap = 1 - frac_h2osfc - frac_sno] + frac_nvp_eff = min(1._r8 - frac_h2osfc(c) - frac_sno(c), max(0._r8, col%frac_nvp(c) - frac_sno(c))) + else + frac_nvp_eff = 0._r8 + end if lw_grnd=(frac_sno(c)*t_soisno(c,snl(c)+1)**4 & - +(1._r8-frac_sno(c)-frac_h2osfc(c))*t_soisno(c,1)**4 & - +frac_h2osfc(c)*t_h2osfc(c)**4) + +(1._r8-frac_sno(c)-frac_h2osfc(c)-frac_nvp_eff)*t_soisno(c,1)**4 & + +frac_h2osfc(c)*t_h2osfc(c)**4 & + +frac_nvp_eff*t_nvp_col(c)**4) 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) & @@ -1467,10 +1502,17 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, g = patch%gridcell(p) ! Energy balance check in canopy - + ! [PORTED by Hui Tang: include NVP in lw_grnd for energy balance check] + if (use_nvp) then + ! [PORTED by Hui Tang: re-wired frac_nvp_eff — snow buries NVP (frac_nvp - frac_sno), cap = 1 - frac_h2osfc - frac_sno] + frac_nvp_eff = min(1._r8 - frac_h2osfc(c) - frac_sno(c), max(0._r8, col%frac_nvp(c) - frac_sno(c))) + else + frac_nvp_eff = 0._r8 + end if lw_grnd=(frac_sno(c)*t_soisno(c,snl(c)+1)**4 & - +(1._r8-frac_sno(c)-frac_h2osfc(c))*t_soisno(c,1)**4 & - +frac_h2osfc(c)*t_h2osfc(c)**4) + +(1._r8-frac_sno(c)-frac_h2osfc(c)-frac_nvp_eff)*t_soisno(c,1)**4 & + +frac_h2osfc(c)*t_h2osfc(c)**4 & + +frac_nvp_eff*t_nvp_col(c)**4) err(p) = (1.0_r8-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) & @@ -1515,17 +1557,85 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, eflx_sh_snow(p) = cpair*forc_rho(c)*wtg(p)*delt_snow eflx_sh_soil(p) = cpair*forc_rho(c)*wtg(p)*delt_soil eflx_sh_h2osfc(p) = cpair*forc_rho(c)*wtg(p)*delt_h2osfc + ! [PORTED by Hui Tang: NVP individual sensible heat flux, analogous to snow/h2osfc] + if (use_nvp .and. col%frac_nvp(c) > 0._r8) then + delt_nvp = wtal(p)*t_nvp_col(c)-wtl0(p)*t_veg(p)-wta0(p)*thm(p)-wtstem0(p)*t_stem(p) + eflx_sh_nvp(p) = cpair*forc_rho(c)*wtg(p)*delt_nvp + else + eflx_sh_nvp(p) = 0._r8 + end if qflx_evap_soi(p) = forc_rho(c)*wtgq(p)*delq(p) ! compute individual latent heat fluxes delq_snow = wtalq(p)*qg_snow(c)-wtlq0(p)*qsatl(p)-wtaq0(p)*forc_q(c) - qflx_ev_snow(p) = forc_rho(c)*wtgq(p)*delq_snow - delq_soil = wtalq(p)*qg_soil(c)-wtlq0(p)*qsatl(p)-wtaq0(p)*forc_q(c) - qflx_ev_soil(p) = forc_rho(c)*wtgq(p)*delq_soil - delq_h2osfc = wtalq(p)*qg_h2osfc(c)-wtlq0(p)*qsatl(p)-wtaq0(p)*forc_q(c) - qflx_ev_h2osfc(p) = forc_rho(c)*wtgq(p)*delq_h2osfc + + ! [PORTED by Hui Tang: per-surface ground latent conductances for NVP-aware LE. + ! Iterative wtgq(p) above used soilresis in series with raw(p,below_canopy); + ! applying that same throttling to snow/h2osfc/NVP suppresses sublimation by + ! ~40× in NVP runs (NVP intercepts surface infiltration → soil layer 1 dries + ! → soilresis blows up). Recompute each surface's conductance with its own + ! resistance for the post-iteration diagnostic flux assignments, then rebuild + ! qflx_evap_soi from the area-weighted sum. Iterative wtgq(p) is left + ! untouched so canopy energy balance convergence is bit-identical.] + if (use_nvp) then + ! Local NVP surface resistance (matches NVPLayerDynamicsMod::NVPEvaporation) + if (t_soisno(c,0) >= tfrz) then + satfrac_nvp = max(0._r8, min(1._r8, fwet_nvp_col(c))) + rnvp = rnvp_min + rnvp_amp * (1._r8 - satfrac_nvp)**rnvp_exp + else + rnvp = rnvp_ice + end if + wtgq_snow = frac_veg_nosno(p) / raw(p,below_canopy) + wtgq_h2osfc = frac_veg_nosno(p) / raw(p,below_canopy) + wtgq_soil = frac_veg_nosno(p) / (raw(p,below_canopy) + soilresis(c)) + wtgq_nvp = frac_veg_nosno(p) / (raw(p,below_canopy) + rnvp) + qflx_ev_snow(p) = forc_rho(c) * wtgq_snow * delq_snow + qflx_ev_soil(p) = forc_rho(c) * wtgq_soil * delq_soil + qflx_ev_h2osfc(p) = forc_rho(c) * wtgq_h2osfc * delq_h2osfc + else + qflx_ev_snow(p) = forc_rho(c) * wtgq(p) * delq_snow + qflx_ev_soil(p) = forc_rho(c) * wtgq(p) * delq_soil + qflx_ev_h2osfc(p) = forc_rho(c) * wtgq(p) * delq_h2osfc + end if + + ! [PORTED by Hui Tang: NVP individual latent heat flux, analogous to snow/h2osfc] + ! qflx_evap_soi already includes NVP because qg(c) blends NVP in SurfaceHumidityMod. + ! This is the diagnostic breakdown of the NVP contribution. + ! [PORTED by Hui Tang: gate on exposed NVP fraction (frac_nvp_eff>0) instead of the binary + ! snow-layer count snl>=-1, so partial snow cover no longer erases NVP latent flux while + ! part of the column is snow-free. frac_nvp_eff uses frac_sno (Canopy's snow variable), + ! matching the qflx_evap_soi weighting below; computed here because it is not yet set.] + if (use_nvp) then + frac_nvp_eff = min(1._r8 - frac_h2osfc(c) - frac_sno(c), max(0._r8, & + col%frac_nvp(c) - frac_sno(c))) + else + frac_nvp_eff = 0._r8 + end if + ! Zero when NVP is fully buried (frac_nvp_eff <= 0) — same guard as BareGroundFluxesMod. + if (use_nvp .and. frac_nvp_eff > 0._r8) then + delq_nvp = wtalq(p)*qg_nvp(c)-wtlq0(p)*qsatl(p)-wtaq0(p)*forc_q(c) + qflx_ev_nvp(p) = forc_rho(c) * wtgq_nvp * delq_nvp + else + qflx_ev_nvp(p) = 0._r8 + end if + + ! [PORTED by Hui Tang: rebuild qflx_evap_soi from per-surface fluxes weighted + ! by area. Without this, the bulk qflx_evap_soi (computed via bulk wtgq with + ! soilresis) throttles snow sublimation in NVP runs. When use_nvp=.false., + ! the original bulk value above is kept unchanged.] + if (use_nvp) then + ! [PORTED by Hui Tang: re-wired frac_nvp_eff — snow buries NVP (frac_nvp - frac_sno), cap = 1 - frac_h2osfc - frac_sno] + frac_nvp_eff = min(1._r8 - frac_h2osfc(c) - frac_sno(c), max(0._r8, & + col%frac_nvp(c) - frac_sno(c))) + frac_soil = max(0._r8, & + 1._r8 - frac_sno(c) - frac_h2osfc(c) - frac_nvp_eff) + qflx_evap_soi(p) = frac_sno(c) * qflx_ev_snow(p) & + + frac_h2osfc(c) * qflx_ev_h2osfc(p) & + + frac_nvp_eff * qflx_ev_nvp(p) & + + frac_soil * qflx_ev_soil(p) + end if ! 2 m height air temperature diff --git a/src/biogeophys/EnergyFluxType.F90 b/src/biogeophys/EnergyFluxType.F90 index 655a00d4d3..105ddb65c4 100644 --- a/src/biogeophys/EnergyFluxType.F90 +++ b/src/biogeophys/EnergyFluxType.F90 @@ -29,6 +29,8 @@ module EnergyFluxType real(r8), pointer :: eflx_sh_snow_patch (:) ! patch sensible heat flux from snow (W/m**2) [+ to atm] real(r8), pointer :: eflx_sh_soil_patch (:) ! patch sensible heat flux from soil (W/m**2) [+ to atm] real(r8), pointer :: eflx_sh_h2osfc_patch (:) ! patch sensible heat flux from surface water (W/m**2) [+ to atm] + ! [PORTED by Hui Tang: NVP (moss/lichen) individual sensible heat flux] + real(r8), pointer :: eflx_sh_nvp_patch (:) ! patch sensible heat flux from NVP (W/m**2) [+ to atm] real(r8), pointer :: eflx_sh_tot_patch (:) ! patch total sensible heat flux (W/m**2) [+ to atm] real(r8), pointer :: eflx_sh_tot_u_patch (:) ! patch urban total sensible heat flux (W/m**2) [+ to atm] real(r8), pointer :: eflx_sh_tot_r_patch (:) ! patch rural total sensible heat flux (W/m**2) [+ to atm] @@ -193,6 +195,8 @@ subroutine InitAllocate(this, bounds) allocate( this%eflx_sh_snow_patch (begp:endp)) ; this%eflx_sh_snow_patch (:) = nan allocate( this%eflx_sh_soil_patch (begp:endp)) ; this%eflx_sh_soil_patch (:) = nan allocate( this%eflx_sh_h2osfc_patch (begp:endp)) ; this%eflx_sh_h2osfc_patch (:) = nan + ! [PORTED by Hui Tang: allocate NVP sensible heat flux array] + allocate( this%eflx_sh_nvp_patch (begp:endp)) ; this%eflx_sh_nvp_patch (:) = nan allocate( this%eflx_sh_tot_patch (begp:endp)) ; this%eflx_sh_tot_patch (:) = nan 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 @@ -288,7 +292,7 @@ subroutine InitHistory(this, bounds, is_simple_buildtemp, is_prog_buildtemp) ! !USES: use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) use clm_varpar , only : nlevgrnd - use clm_varctl , only : use_cn, use_hydrstress + use clm_varctl , only : use_cn, use_hydrstress, use_nvp ! [PORTED by Hui Tang: NVP history] use histFileMod , only : hist_addfld1d, hist_addfld2d, no_snow_normal use ncdio_pio , only : ncd_inqvdlen implicit none @@ -690,6 +694,14 @@ subroutine InitHistory(this, bounds, is_simple_buildtemp, is_prog_buildtemp) avgflag='A', long_name='solar radiation conservation error', & ptr_patch=this%errsol_patch, set_urb=spval) + ! [PORTED by Hui Tang: history field for NVP (moss/lichen) sensible heat flux] + if (use_nvp) then + this%eflx_sh_nvp_patch(begp:endp) = spval + call hist_addfld1d (fname='EFLX_SH_NVP', units='W/m^2', & + avgflag='A', long_name='sensible heat flux from nvp (moss/lichen)', & + ptr_patch=this%eflx_sh_nvp_patch, c2l_scale_type='urbanf', default='inactive') + end if + end subroutine InitHistory !----------------------------------------------------------------------- diff --git a/src/biogeophys/HydrologyNoDrainageMod.F90 b/src/biogeophys/HydrologyNoDrainageMod.F90 index 8f294c652e..dd756e7e9b 100644 --- a/src/biogeophys/HydrologyNoDrainageMod.F90 +++ b/src/biogeophys/HydrologyNoDrainageMod.F90 @@ -7,7 +7,9 @@ Module HydrologyNoDrainageMod use shr_kind_mod , only : r8 => shr_kind_r8 use shr_log_mod , only : errMsg => shr_log_errMsg use decompMod , only : bounds_type - use clm_varctl , only : iulog, use_vichydro, use_fates + ! [PORTED by Hui Tang: add use_nvp and NVPWaterBalance_Column for NVP water infiltration] + use clm_varctl , only : iulog, use_vichydro, use_fates, use_nvp + use NVPLayerDynamicsMod, only : NVPWaterBalance_Column use clm_varcon , only : denh2o, denice, rpi, spval use CLMFatesInterfaceMod, only : hlm_fates_interface_type use atm2lndType , only : atm2lnd_type @@ -281,9 +283,19 @@ subroutine HydrologyNoDrainage(bounds, & ! Determine the change of snow mass and the snow water onto soil + ! [PORTED by Hui Tang: NVP debug — j=0 state entering HydrologyNoDrainage] + if (use_nvp .and. col%jbot_sno(bounds%begc) == -1) & + write(iulog,*) '[NVP DBG] HydroNoDrain BEG c=1 snl=', col%snl(bounds%begc), & + ' ice0=', h2osoi_ice(bounds%begc,0), ' liq0=', h2osoi_liq(bounds%begc,0) + call SnowWater(bounds, num_snowc, filter_snowc, num_nosnowc, filter_nosnowc, & atm2lnd_inst, aerosol_inst, water_inst) + ! [PORTED by Hui Tang: NVP debug — j=0 state after SnowWater] + if (use_nvp .and. col%jbot_sno(bounds%begc) == -1) & + write(iulog,*) '[NVP DBG] after SnowWater c=1 snl=', col%snl(bounds%begc), & + ' ice0=', h2osoi_ice(bounds%begc,0), ' liq0=', h2osoi_liq(bounds%begc,0) + ! TODO(wjs, 2019-08-30) Eventually move this down, merging this with later tracer ! consistency checks. If/when we remove calls to TracerConsistencyCheck from this ! module, remember to also remove 'use perf_mod' at the top. @@ -309,6 +321,23 @@ subroutine HydrologyNoDrainage(bounds, & bounds, num_hydrologyc, filter_hydrologyc, lun, col, & soilhydrology_inst, soilstate_inst, b_waterflux_inst) + ! [PORTED by Hui Tang: NVP water balance — gravity drainage from NVP layer 0 to soil] + ! Must be after SnowWater (qflx_rain_plus_snomelt finalised) and after column + ! aggregation of qflx_ev_nvp_col (done in clm_driver p2c). Must be before + ! SetQflxInputs so qflx_nvp_drain_col is available for qflx_infl. + if (use_nvp) then + call NVPWaterBalance_Column(bounds, dtime, b_waterflux_inst, & + b_waterstate_inst, b_waterdiagnostic_inst, soilstate_inst, temperature_inst) + end if + + ! [PORTED by Hui Tang: NVP debug — j=0 state and NVP fluxes after NVPWaterBalance_Column] + if (use_nvp .and. col%jbot_sno(bounds%begc) == -1) & + write(iulog,*) '[NVP DBG] after NVPWaterBal c=1 snl=', col%snl(bounds%begc), & + ' ice0=', h2osoi_ice(bounds%begc,0), ' liq0=', h2osoi_liq(bounds%begc,0), & + ' ev_nvp=', b_waterflux_inst%qflx_ev_nvp_col(bounds%begc), & + ' nvp_drain=', b_waterflux_inst%qflx_nvp_drain_col(bounds%begc), & + ' nvp_infl=', b_waterflux_inst%qflx_nvp_infl_col(bounds%begc) + call SetQflxInputs(bounds, num_hydrologyc, filter_hydrologyc, & b_waterflux_inst, b_waterdiagnostic_inst) @@ -342,10 +371,22 @@ subroutine HydrologyNoDrainage(bounds, & if ( use_fates ) then call clm_fates%ComputeRootSoilFlux(bounds, num_hydrologyc, filter_hydrologyc, soilstate_inst, b_waterflux_inst) end if - + + ! [NVP DBG: print soil liq/ice/T for j=1..6 before SoilWater; nstep<=3 to avoid log flood] + if (use_nvp .and. get_nstep() <= 3) then + write(iulog,'(a,i0,6(1x,es11.4))') '[NVP DBG] before SoilWater nstep=', get_nstep(), & + (h2osoi_liq(bounds%begc,j), j=1,6) + write(iulog,'(a,6(1x,f7.2))') '[NVP DBG] before SoilWater t_soisno(1:6)=', & + (t_soisno(bounds%begc,j), j=1,6) + end if call SoilWater(bounds, num_hydrologyc, filter_hydrologyc, num_urbanc, filter_urbanc, & soilhydrology_inst, soilstate_inst, b_waterflux_inst, b_waterstate_inst, temperature_inst, & canopystate_inst, energyflux_inst, soil_water_retention_curve) + ! [NVP DBG: print soil liq after SoilWater to see if it introduces the liquid] + if (use_nvp .and. get_nstep() <= 3) then + write(iulog,'(a,i0,6(1x,es11.4))') '[NVP DBG] after SoilWater nstep=', get_nstep(), & + (h2osoi_liq(bounds%begc,j), j=1,6) + end if if (use_vichydro) then ! mapping soilmoist from CLM to VIC layers for runoff calculations @@ -357,15 +398,26 @@ subroutine HydrologyNoDrainage(bounds, & call WaterTable(bounds, num_hydrologyc, filter_hydrologyc, & soilhydrology_inst, soilstate_inst, temperature_inst, b_waterstate_inst, & b_waterflux_inst) + ! [NVP DBG: print soil liq after WaterTable] + if (use_nvp .and. get_nstep() <= 3) then + write(iulog,'(a,i0,6(1x,es11.4))') '[NVP DBG] after WaterTable nstep=', get_nstep(), & + (h2osoi_liq(bounds%begc,j), j=1,6) + end if else call PerchedWaterTable(bounds, num_hydrologyc, filter_hydrologyc, & num_urbanc, filter_urbanc, soilhydrology_inst, soilstate_inst, & - temperature_inst, b_waterstate_inst, b_waterflux_inst) + temperature_inst, b_waterstate_inst, b_waterflux_inst) call ThetaBasedWaterTable(bounds, num_hydrologyc, filter_hydrologyc, & num_urbanc, filter_urbanc, soilhydrology_inst, soilstate_inst, & - b_waterstate_inst, b_waterflux_inst) + b_waterstate_inst, b_waterflux_inst) + + ! [NVP DBG: print soil liq after PerchedWaterTable+ThetaBasedWaterTable] + if (use_nvp .and. get_nstep() <= 3) then + write(iulog,'(a,i0,6(1x,es11.4))') '[NVP DBG] after WaterTable(perched) nstep=', get_nstep(), & + (h2osoi_liq(bounds%begc,j), j=1,6) + end if end if @@ -374,6 +426,11 @@ subroutine HydrologyNoDrainage(bounds, & soilhydrology_inst, soilstate_inst, & b_waterstate_inst, b_waterdiagnostic_inst, b_waterflux_inst) + ! [PORTED by Hui Tang: NVP debug — j=0 state after RenewCondensation] + if (use_nvp .and. col%jbot_sno(bounds%begc) == -1) & + write(iulog,*) '[NVP DBG] after RenewCond c=1 snl=', col%snl(bounds%begc), & + ' ice0=', h2osoi_ice(bounds%begc,0), ' liq0=', h2osoi_liq(bounds%begc,0) + ! BUG(wjs, 2019-09-16, ESCOMP/ctsm#762) This is needed so that we can test the ! tracerization of the following snow stuff without having tracerized everything ! before this point. Remove this block once code before this point is fully @@ -392,22 +449,50 @@ subroutine HydrologyNoDrainage(bounds, & scf_method, & temperature_inst, b_waterstate_inst, b_waterdiagnostic_inst, atm2lnd_inst) + ! [PORTED by Hui Tang: NVP debug — j=0 state after SnowCompaction] + if (use_nvp .and. col%jbot_sno(bounds%begc) == -1) & + write(iulog,*) '[NVP DBG] after SnowCompact c=1 snl=', col%snl(bounds%begc), & + ' ice0=', h2osoi_ice(bounds%begc,0), ' liq0=', h2osoi_liq(bounds%begc,0) + ! Combine thin snow elements call CombineSnowLayers(bounds, num_snowc, filter_snowc, & aerosol_inst, temperature_inst, water_inst) + ! [PORTED by Hui Tang: NVP debug — j=0 state after CombineSnowLayers] + if (use_nvp .and. col%jbot_sno(bounds%begc) == -1) & + write(iulog,*) '[NVP DBG] after CombineSnow c=1 snl=', col%snl(bounds%begc), & + ' ice0=', h2osoi_ice(bounds%begc,0), ' liq0=', h2osoi_liq(bounds%begc,0) + ! Divide thick snow elements call DivideSnowLayers(bounds, num_snowc, filter_snowc, & aerosol_inst, temperature_inst, water_inst, is_lake=.false.) + + ! [PORTED by Hui Tang: NVP debug — j=0 state before ZeroEmptySnow] + if (use_nvp .and. col%jbot_sno(bounds%begc) == -1) & + write(iulog,*) '[NVP DBG] before ZeroEmptySnow c=1 snl=', col%snl(bounds%begc), & + ' ice0=', h2osoi_ice(bounds%begc,0), ' liq0=', h2osoi_liq(bounds%begc,0) ! Set empty snow layers to zero call ZeroEmptySnowLayers(bounds, num_snowc, filter_snowc, & col, water_inst, temperature_inst) + ! [PORTED by Hui Tang: NVP debug — j=0 state after ZeroEmptySnow] + if (use_nvp .and. col%jbot_sno(bounds%begc) == -1) & + write(iulog,*) '[NVP DBG] after ZeroEmptySnow c=1 snl=', col%snl(bounds%begc), & + ' ice0=', h2osoi_ice(bounds%begc,0), ' liq0=', h2osoi_liq(bounds%begc,0) + ! Build new snow filter + write(iulog,*) '[NVP DBG] before snowfilter c=1 snl=', col%snl(bounds%begc), & + ' num_snowc=', num_snowc, ' filter_snowc=', filter_snowc, & + ' num_nosnowc=', num_nosnowc, ' filter_nosnowc=', filter_nosnowc call BuildSnowFilter(bounds, num_nolakec, filter_nolakec, & num_snowc, filter_snowc, num_nosnowc, filter_nosnowc) + + write(iulog,*) '[NVP DBG] after snowfilter c=1 snl=', col%snl(bounds%begc), & + ' num_snowc=', num_snowc, ' filter_snowc=', filter_snowc, & + ' num_nosnowc=', num_nosnowc, ' filter_nosnowc=', filter_nosnowc + ! TODO(wjs, 2019-09-16) Eventually move this down, merging this with later tracer ! consistency checks. If/when we remove calls to TracerConsistencyCheck from this diff --git a/src/biogeophys/NVPLayerDynamicsMod.F90 b/src/biogeophys/NVPLayerDynamicsMod.F90 new file mode 100644 index 0000000000..e343af31e7 --- /dev/null +++ b/src/biogeophys/NVPLayerDynamicsMod.F90 @@ -0,0 +1,763 @@ +module NVPLayerDynamicsMod + + ! --------------------------------------------------------------------------- + ! DESCRIPTION: + ! [PORTED by Hui Tang: NVP (non-vascular plant, i.e. moss/lichen) layer dynamics] + ! + ! Updates CLM's vertical column geometry for the NVP layer at index 0, + ! based on FATES-derived coverage (col%frac_nvp) and thickness (col%dz_nvp). + ! + ! Also provides subroutines for NVP water physics: + ! NVPWaterRetentionCurve — van Genuchten water potential [mm] + ! NVPHydraulicConductivity — Mualem-van Genuchten hydraulic conductivity [m/s] + ! NVPEvaporation — NVP surface evaporation flux [kg m-2 s-1] + ! + ! Called from clmfates_interfaceMod%wrap_update_hlmfates_dyn each FATES + ! dynamics timestep, after bc_out%nvp_dz_pa and bc_out%nvp_frac_pa have + ! been aggregated to the column. + ! + ! Layer design: + ! - NVP occupies vertical index 0 (the slot below the bottom-most snow layer). + ! - col%jbot_sno = -1 when NVP is active (snow loops stop at index -1). + ! - col%jbot_sno = 0 when NVP is inactive (standard CLM snow behaviour). + ! - col%dz(c,0) and col%z(c,0) are set from col%dz_nvp(c). + ! - col%zi(c,0) = 0 (soil surface) is unchanged. + ! - col%zi(c,-1) = -dz_nvp (top interface of NVP layer). + ! + ! Energy and mass conservation on layer activation/deactivation: + ! - Activation (inactive→active): initialise t_soisno(c,0) = t_soisno(c,1), + ! h2osoi_liq(c,0) = 0, h2osoi_ice(c,0) = 0. The NVP layer starts + ! isothermal with the surface soil and dry; FATES will hydrate it over + ! subsequent timesteps. + ! - Deactivation (active→inactive): residual water in layer 0 is merged into + ! layer 1 with energy-weighted temperature; layer 0 state is then zeroed. + ! - Resize (thickness change while active): temperature and h2osoi are + ! unchanged — both are intensive quantities (T in K; h2osoi in kg m-2 + ! of ground area independent of layer thickness). + ! --------------------------------------------------------------------------- + + use shr_kind_mod , only : r8 => shr_kind_r8 + use decompMod , only : bounds_type + use ColumnType , only : col + use TemperatureType , only : temperature_type + use WaterStateType , only : waterstate_type + use WaterFluxBulkType , only : waterfluxbulk_type + use WaterDiagnosticBulkType, only : waterdiagnosticbulk_type + ! [PORTED by Hui Tang: soilstate for bidirectional NVP-soil Darcy flux] + use SoilStateType , only : soilstate_type + use clm_varcon , only : cpliq, cpice, denh2o, roverg, tfrz, denice, hfus, spval + ! [PORTED by Hui Tang: use_nvp_undersnow flag to deactivate NVP when snow present] + use clm_varctl , only : use_nvp_undersnow, iulog + use QSatMod , only : QSat + ! [PORTED by Hui Tang: runtime-tunable NVP physics parameters] + use NVPParamsMod + + implicit none + private + + public :: UpdateNVPLayer + public :: NVPWaterRetentionCurve + public :: NVPHydraulicConductivity + public :: NVPEvaporation + public :: NVPWaterBalance_Column + public :: NVPLayerRestart + public :: NVPColdStartIce ! [PORTED by Hui Tang: cold-start override of NVP layer-0 ice to pore cap] + + character(len=*), parameter, private :: sourcefile = __FILE__ + +contains + + ! =========================================================================== + + subroutine UpdateNVPLayer(c, temperature_inst, waterstate_inst) + ! ------------------------------------------------------------------------- + ! Update NVP layer presence and geometry for column c, maintaining energy + ! and water conservation across activation / deactivation transitions. + ! + ! Inputs (from col): + ! col%dz_nvp(c) — FATES-derived column-effective NVP thickness [m] + ! col%frac_nvp(c) — FATES-derived column NVP fractional coverage [0-1] + ! + ! Outputs (written to col, and optionally temperature_inst, waterstate_inst): + ! col%nvp_layer_active(c) — .true. when NVP layer is active + ! col%jbot_sno(c) — -1 (NVP active) or 0 (inactive) + ! col%dz(c,0) — NVP layer thickness [m] + ! col%z(c,0) — NVP layer centre depth [m] + ! col%zi(c,-1) — NVP layer top interface [m] + ! + ! Conservation (applied only when both optional args are present): + ! temperature_inst%t_soisno_col(c,0) — initialised on activation + ! waterstate_inst%h2osoi_liq_col(c,0/1) — conserved on deactivation + ! waterstate_inst%h2osoi_ice_col(c,0/1) — conserved on deactivation + ! + ! Pass temperature_inst and waterstate_inst during normal timestep calls. + ! Omit them during restart / cold-start where thermodynamic state is set + ! independently (restart file or initTemperatureMod). + ! ------------------------------------------------------------------------- + integer, intent(in) :: c ! column index + type(temperature_type), optional, intent(inout) :: temperature_inst + class(waterstate_type), optional, intent(inout) :: waterstate_inst + + real(r8) :: dz_nvp + logical :: was_active ! NVP layer state at entry (before this update) + logical :: now_active ! NVP layer state after geometry check + real(r8) :: cv0 ! heat capacity of NVP layer [J m-2 K-1] + real(r8) :: cv1 ! heat capacity of soil layer 1 before merge [J m-2 K-1] + real(r8) :: cv1_new ! heat capacity of soil layer 1 after merge [J m-2 K-1] + + dz_nvp = col%dz_nvp(c) + was_active = col%nvp_layer_active(c) + + ! [PORTED by Hui Tang: trace appear/disappear transitions in UpdateNVPLayer] + if (present(waterstate_inst)) then + write(iulog,'(a,i5,a,l1,2a,i8,3(a,f8.4))') & + '[DBG NVP update] c=', c, & + ' was_active=', was_active, ' pres_water=T', & + ' snl=', col%snl(c), & + ' dz_nvp=', dz_nvp, ' frac_nvp=', col%frac_nvp(c), & + ' ice0=', waterstate_inst%h2osoi_ice_col(c,0) + else + write(iulog,'(a,i5,a,l1,2a,i8,2(a,f8.4))') & + '[DBG NVP update] c=', c, & + ' was_active=', was_active, ' pres_water=F', & + ' snl=', col%snl(c), & + ' dz_nvp=', dz_nvp, ' frac_nvp=', col%frac_nvp(c) + end if + + if (col%frac_nvp(c) > nvp_frac_min .and. dz_nvp > 0._r8) then + + ! --- Active (Appear or Grow/shrink) --- + now_active = .true. + col%nvp_layer_active(c) = .true. + col%jbot_sno(c) = -1 + col%dz(c,0) = dz_nvp + ! Layer centre is half the thickness above the soil surface (zi(c,0)=0) + col%z(c,0) = -0.5_r8 * dz_nvp + ! Top interface of NVP layer = bottom of the snow layer above + col%zi(c,-1) = -dz_nvp + + else + + ! --- Inactive (Disappear or Absent) --- + now_active = .false. + col%nvp_layer_active(c) = .false. + col%jbot_sno(c) = 0 + col%dz(c,0) = 0._r8 + col%z(c,0) = 0._r8 + ! Restore zi(c,-1) to soil surface when NVP is absent + col%zi(c,-1) = 0._r8 + + end if + + ! [PORTED by Hui Tang: deactivate NVP under snow when use_nvp_undersnow=.false.] + ! When snow is present (snl < 0), NVP cannot exchange energy or moisture with the + ! atmosphere directly. Override the FATES-based activation to treat the column as + ! standard CLM (jbot_sno=0) so snow layers couple directly to soil. + if (.not. use_nvp_undersnow .and. col%snl(c) < 0 .and. now_active) then + now_active = .false. + col%nvp_layer_active(c) = .false. + col%jbot_sno(c) = 0 + col%dz(c,0) = 0._r8 + col%z(c,0) = 0._r8 + col%zi(c,-1) = 0._r8 + end if + + ! [PORTED by Hui Tang: energy and mass conservation on NVP layer state transitions] + ! Conservation is only applied when temperature_inst and waterstate_inst are + ! provided (normal timestep path). During restart / cold-start the thermo- + ! dynamic state is restored separately and conservation is skipped. + if (present(temperature_inst) .and. present(waterstate_inst)) then + + if (.not. was_active .and. now_active) then + ! --- Appear: initialise layer-0 thermodynamic state from soil layer 1 --- + ! Temperature inherits from layer 1 to avoid spurious heat flux. + ! [PORTED by Hui Tang: initialise NVP liquid to 0.6 * dz * denh2o (volumetric + ! water content = 0.6) instead of 0; mirrors FATES-soil cold-start convention. + ! NOTE: with use_nvp_undersnow=.true. (default) this branch runs only once + ! (cold start). With use_nvp_undersnow=.false. it also runs on spring + ! reactivation — in that case the water is unphysical, but that config is + ! non-default and not the current use case.] + temperature_inst%t_soisno_col(c,0) = temperature_inst%t_soisno_col(c,1) + waterstate_inst%h2osoi_liq_col(c,0) = 0.6_r8 * col%dz(c,0) * denh2o + waterstate_inst%h2osoi_ice_col(c,0) = 0._r8 + + else if (was_active .and. .not. now_active) then + ! --- Disappear: merge layer 0 into layer 1 conserving energy and water --- + ! Compute heat capacities (cv = cpliq*liq + cpice*ice, units J m-2 K-1) + cv0 = cpliq * waterstate_inst%h2osoi_liq_col(c,0) + & + cpice * waterstate_inst%h2osoi_ice_col(c,0) + cv1 = cpliq * waterstate_inst%h2osoi_liq_col(c,1) + & + cpice * waterstate_inst%h2osoi_ice_col(c,1) + ! Transfer water mass to layer 1 + waterstate_inst%h2osoi_liq_col(c,1) = waterstate_inst%h2osoi_liq_col(c,1) + & + waterstate_inst%h2osoi_liq_col(c,0) + waterstate_inst%h2osoi_ice_col(c,1) = waterstate_inst%h2osoi_ice_col(c,1) + & + waterstate_inst%h2osoi_ice_col(c,0) + ! Energy-weighted temperature for layer 1 after merge + cv1_new = cpliq * waterstate_inst%h2osoi_liq_col(c,1) + & + cpice * waterstate_inst%h2osoi_ice_col(c,1) + if (cv1_new > 0._r8) then + temperature_inst%t_soisno_col(c,1) = & + (cv0 * temperature_inst%t_soisno_col(c,0) + & + cv1 * temperature_inst%t_soisno_col(c,1)) / cv1_new + end if + ! Zero layer 0; set T to layer-1 value to avoid stale data on reactivation + waterstate_inst%h2osoi_liq_col(c,0) = 0._r8 + waterstate_inst%h2osoi_ice_col(c,0) = 0._r8 + temperature_inst%t_soisno_col(c,0) = temperature_inst%t_soisno_col(c,1) + + end if + ! --- Grow/shrink (active→active): T and h2osoi are per unit ground area, + ! so no adjustment is needed when dz_nvp changes. --- + + ! [PORTED by Hui Tang: per-CLM-timestep phase change for j=0 is handled in + ! SoilTemperatureMod::Phasechange (runs before SoilFluxes so xmf is correct). + ! The FATES-dynamics-frequency melt block that was here is removed.] + + end if + + end subroutine UpdateNVPLayer + + ! =========================================================================== + + subroutine NVPWaterRetentionCurve(vol_liq, eff_porosity, n_van, alpha_van, watsat, watres, smp) + ! ------------------------------------------------------------------------- + ! Convert NVP volumetric liquid water content to soil water potential [mm] + ! using the van Genuchten (1980) retention curve formulation. + ! + ! Ported from Python moss_water_code.py::water_retention_curve. + ! + ! Arguments: + ! vol_liq — volumetric liquid water content [m3 m-3] + ! eff_porosity — effective porosity [m3 m-3] + ! n_van — van Genuchten shape parameter n [-] (> 1) + ! alpha_van — van Genuchten inverse air-entry pressure [cm-1 * 10] + ! watsat — saturated volumetric water content (= theta_nvp_max) [m3 m-3] + ! watres — residual volumetric water content [m3 m-3] + ! smp — soil/NVP matric potential [mm] (negative; more negative = drier) + ! ------------------------------------------------------------------------- + real(r8), intent(in) :: vol_liq + real(r8), intent(in) :: eff_porosity + real(r8), intent(in) :: n_van + real(r8), intent(in) :: alpha_van + real(r8), intent(in) :: watsat + real(r8), intent(in) :: watres + real(r8), intent(out) :: smp + + real(r8) :: m_van ! van Genuchten m = 1 - 1/n + real(r8) :: satfrac ! effective saturation fraction [-] + + m_van = 1.0_r8 - 1.0_r8 / n_van + + satfrac = (vol_liq - watres) / (eff_porosity - watres) + ! [PORTED by Hui Tang: clamp away from 0 — satfrac**(1/-m_van) = 0**negative = Inf otherwise] + satfrac = max(1.0e-6_r8, min(1.0_r8, satfrac)) + + ! van Genuchten retention curve: psi in units of (1/alpha_van) + smp = -(1.0_r8 / alpha_van) * & + (satfrac**( 1.0_r8 / (-m_van) ) - 1.0_r8)**(1.0_r8 / n_van) + smp = smp * 102.0_r8 ! convert to mm + + end subroutine NVPWaterRetentionCurve + + ! =========================================================================== + + subroutine NVPHydraulicConductivity(vol_liq, eff_porosity, n_van, watsat, watres, ksat, khydr) + ! ------------------------------------------------------------------------- + ! Compute NVP hydraulic conductivity [m s-1] using the Mualem-van Genuchten + ! (1976/1980) formulation. + ! + ! Ported from Python moss_water_code.py::hydraulic_conductivity. + ! + ! Arguments: + ! vol_liq — volumetric liquid water content [m3 m-3] + ! eff_porosity — effective porosity [m3 m-3] + ! n_van — van Genuchten shape parameter n [-] + ! watsat — saturated volumetric water content [m3 m-3] + ! watres — residual volumetric water content [m3 m-3] + ! ksat — saturated hydraulic conductivity [m s-1] + ! khydr — unsaturated hydraulic conductivity [m s-1] + ! ------------------------------------------------------------------------- + real(r8), intent(in) :: vol_liq + real(r8), intent(in) :: eff_porosity + real(r8), intent(in) :: n_van + real(r8), intent(in) :: watsat + real(r8), intent(in) :: watres + real(r8), intent(in) :: ksat + real(r8), intent(out) :: khydr + + real(r8) :: m_van ! van Genuchten m = 1 - 1/n + real(r8) :: satfrac ! effective saturation fraction [-] + + m_van = 1.0_r8 - 1.0_r8 / n_van + + satfrac = (vol_liq - watres) / (eff_porosity - watres) + satfrac = max(0.0_r8, min(1.0_r8, satfrac)) ! clamp to [0, 1] + + ! Mualem-van Genuchten: khydr = ksat * Se^0.5 * (1 - (1 - Se^(1/m))^m)^2 + khydr = ksat & + * satfrac**0.5_r8 & + * (1.0_r8 - (1.0_r8 - satfrac**(1.0_r8 / m_van))**m_van)**2.0_r8 + + end subroutine NVPHydraulicConductivity + + ! =========================================================================== + + subroutine NVPEvaporation(theta_nvp, t_nvp, forc_pbot, rho_atm, q_atm, raw, & + n_van, alpha_van, watsat, watres, & + evap_nvp, rnvp, psi_nvp, alpha_nvp, q_nvp) + ! ------------------------------------------------------------------------- + ! Compute NVP surface evaporation flux [kg m-2 s-1]. + ! + ! Ported from the hourly loop in Python moss_water_code.py. + ! + ! Physics: + ! 1. Surface resistance rnvp increases cubically as NVP dries: + ! rnvp = rnvp_min + rnvp_amp * (1 - satfrac)^rnvp_exp + ! 2. Water potential psi_nvp [mm] from van Genuchten retention curve. + ! 3. Activity correction alpha_nvp [-] from the Kelvin equation: + ! alpha_nvp = exp(psi_nvp / (roverg * t_nvp)) + ! where roverg = R_w/g * 1000 [mm K] is the CLM constant from clm_varcon. + ! 4. Specific humidity at NVP surface: q_nvp = alpha_nvp * qs(t_nvp, pbot) + ! 5. Evaporation: E = max(-rho_atm * (q_atm - q_nvp) / (raw + rnvp), 0) + ! (positive = evaporation from NVP; condensation onto NVP is excluded) + ! + ! Arguments: + ! theta_nvp — volumetric liquid water content of NVP [m3 m-3] + ! t_nvp — NVP surface temperature [K] + ! forc_pbot — atmospheric pressure [Pa] + ! rho_atm — air density [kg m-3] + ! q_atm — specific humidity of overlying air [kg kg-1] + ! raw — aerodynamic resistance to water vapour transfer [s m-1] + ! n_van — van Genuchten n [-] + ! alpha_van — van Genuchten alpha [cm-1 * 10] + ! watsat — saturated volumetric water content [m3 m-3] + ! watres — residual volumetric water content [m3 m-3] + ! evap_nvp — NVP evaporation flux [kg m-2 s-1] (out, >= 0) + ! rnvp — NVP surface resistance [s m-1] (out, diagnostic) + ! psi_nvp — NVP matric potential [mm] (out, diagnostic) + ! alpha_nvp — Kelvin activity correction [-] (out, diagnostic) + ! q_nvp — specific humidity at NVP surface [kg kg-1] (out, diagnostic) + ! ------------------------------------------------------------------------- + real(r8), intent(in) :: theta_nvp + real(r8), intent(in) :: t_nvp + real(r8), intent(in) :: forc_pbot + real(r8), intent(in) :: rho_atm + real(r8), intent(in) :: q_atm + real(r8), intent(in) :: raw + real(r8), intent(in) :: n_van + real(r8), intent(in) :: alpha_van + real(r8), intent(in) :: watsat + real(r8), intent(in) :: watres + real(r8), intent(out) :: evap_nvp + real(r8), intent(out) :: rnvp + real(r8), intent(out) :: psi_nvp + real(r8), intent(out) :: alpha_nvp + real(r8), intent(out) :: q_nvp + + real(r8) :: eff_porosity ! effective porosity [m3 m-3] + real(r8) :: satfrac ! effective saturation fraction [-] + real(r8) :: qs_nvp ! saturation specific humidity at t_nvp [kg kg-1] + + ! --- 1. Effective saturation fraction --- + eff_porosity = max(0.01_r8, watsat) + satfrac = (theta_nvp - watres) / (eff_porosity - watres) + satfrac = max(0.0_r8, min(1.0_r8, satfrac)) + + ! --- 2. Surface resistance (high when dry, low when saturated) --- + rnvp = rnvp_min + rnvp_amp * (1.0_r8 - satfrac)**rnvp_exp + + ! --- 3. Van Genuchten matric potential [mm] --- + call NVPWaterRetentionCurve(theta_nvp, eff_porosity, n_van, alpha_van, watsat, watres, psi_nvp) + + ! --- 4. Kelvin activity correction: alpha = exp(psi / (roverg * T)) --- + ! roverg = R_w/g * 1000 [mm K] so that psi [mm] / (roverg [mm K] * T [K]) is + ! dimensionless. + alpha_nvp = exp(psi_nvp / (roverg * t_nvp)) + + ! --- 5. Specific humidity at NVP surface --- + call QSat(t_nvp, forc_pbot, qs_nvp) + q_nvp = alpha_nvp * qs_nvp + + ! --- 6. Evaporation flux (no condensation: capped at zero) --- + ! Convention: positive evap_nvp means water leaves NVP surface. + ! Flux = -rho * (q_atm - q_nvp) / (raw + rnvp) + ! = rho * (q_nvp - q_atm) / (raw + rnvp) + evap_nvp = max(-rho_atm * (q_atm - q_nvp) / (raw + rnvp), 0.0_r8) + + end subroutine NVPEvaporation + + ! =========================================================================== + + ! [PORTED by Hui Tang: NVP column water balance — gravity drainage from layer 0 to soil layer 1] + ! [PORTED by Hui Tang: bidirectional Darcy flux between NVP layer 0 and soil layer 1] + subroutine NVPWaterBalance_Column(bounds, dtime, waterfluxbulk_inst, waterstate_inst, & + waterdiagnosticbulk_inst, soilstate_inst, temperature_inst) + ! ------------------------------------------------------------------------- + ! Update h2osoi_liq(c,0) for the NVP layer and compute the net water + ! exchange with soil layer 1 via a bidirectional Darcy flux. + ! + ! Physics: + ! q01 = K_interface * ( (ψ_nvp - ψ_soil1) / Δz_mm + 1 ) + ! + ! where q01 > 0 means downward (NVP drains to soil) and + ! q01 < 0 means upward (NVP absorbs from soil). + ! + ! ψ_nvp — van Genuchten matric potential of NVP layer [mm] + ! ψ_soil1 — CLM Clapp-Hornberger matric potential of soil layer 1 [mm], + ! from previous timestep (soilstate_inst%smp_l_col) + ! Δz_mm — distance between layer centres [mm] + ! = (0.5*dz(c,0) + 0.5*dz(c,1)) * 1000 + ! K_interface — harmonic mean of K_nvp and K_soil1 [mm/s] + ! + ! Capping: + ! Downward (q01 > 0): limited by available NVP liquid water + ! Upward (q01 < 0): limited by current soil layer-1 liquid water + ! + ! qflx_nvp_drain_col is signed (+: NVP→soil, -: soil→NVP) and is added + ! to qflx_infl in Infiltration so SoilWater sees the net exchange. + ! + ! Must be called after: + ! - SnowWater (so qflx_rain_plus_snomelt is finalised) + ! - clm_drv_patch2col p2c (so qflx_ev_nvp_col is valid) + ! and before: + ! - SetQflxInputs / Infiltration (so qflx_nvp_drain_col is available) + ! + ! Outputs written: + ! waterfluxbulk_inst%qflx_nvp_infl_col(c) [mm/s] water into NVP top + ! waterfluxbulk_inst%qflx_nvp_drain_col(c) [mm/s] net NVP-soil exchange (+down) + ! waterstate_inst%h2osoi_liq_col(c,0) [kg m-2] updated NVP water store + ! waterdiagnosticbulk_inst%fwet_nvp_col(c) [-] updated NVP wet fraction + ! ------------------------------------------------------------------------- + type(bounds_type), intent(in) :: bounds + real(r8), intent(in) :: dtime ! timestep [s] + type(waterfluxbulk_type), intent(inout) :: waterfluxbulk_inst + class(waterstate_type), intent(inout) :: waterstate_inst + type(waterdiagnosticbulk_type), intent(inout) :: waterdiagnosticbulk_inst + type(soilstate_type), intent(in) :: soilstate_inst + ! [PORTED by Hui Tang: temperature_inst needed for ice/liquid partitioning of NVP layer] + type(temperature_type), intent(in) :: temperature_inst + + integer :: c + real(r8) :: frac_h2osfc ! fractional area with surface water [-] + real(r8) :: frac_nvp_eff ! effective NVP area fraction (not covered by h2osfc) [-] + real(r8) :: vol_liq ! NVP volumetric liquid water content [m3 m-3] + ! [PORTED by Hui Tang: locals for ice partitioning of NVP layer water] + real(r8) :: vol_ice ! NVP volumetric ice content [m3 m-3] + real(r8) :: eff_porosity ! effective porosity (watsat - vol_ice) [m3 m-3] + real(r8) :: khydr_nvp ! NVP unsaturated hydraulic conductivity [m s-1] + real(r8) :: K_nvp_mms ! khydr_nvp converted to mm/s + real(r8) :: K_soil1 ! soil layer 1 hydraulic conductivity [mm/s] + real(r8) :: K_interface ! interface conductivity (upstream-weighted) [mm/s] + real(r8) :: grad ! [PORTED by Hui Tang] NVP-soil head gradient (matric+gravity); <0 = upward + real(r8) :: psi_nvp ! NVP van Genuchten matric potential [mm] + real(r8) :: smp_soil1 ! soil layer 1 matric potential, prev. timestep [mm] + real(r8) :: dz_iface_mm ! distance between NVP and soil layer 1 centres [mm] + real(r8) :: q01 ! Darcy flux NVP→soil (+down, -up) [mm s-1] + real(r8) :: h2osoi_net ! h2osoi_liq(c,0) after infl and evap [kg m-2] + real(r8) :: satfrac ! NVP effective saturation fraction [-] + real(r8) :: max_ice_nvp ! [PORTED by Hui Tang] max NVP ice = pore-space capacity [kg m-2] + real(r8) :: ice_excess ! [PORTED by Hui Tang] NVP ice above pore capacity [kg m-2] + + associate( & + qflx_rain_plus_snomelt => waterfluxbulk_inst%qflx_rain_plus_snomelt_col, & + qflx_ev_nvp_col => waterfluxbulk_inst%qflx_ev_nvp_col, & + qflx_ev_nvp_eff_col => waterfluxbulk_inst%qflx_ev_nvp_eff_col, & ! [PORTED by Hui Tang: diagnostic history output] + qflx_nvp_infl_col => waterfluxbulk_inst%qflx_nvp_infl_col, & + qflx_nvp_drain_col => waterfluxbulk_inst%qflx_nvp_drain_col, & + qflx_nvp_to_snow_col => waterfluxbulk_inst%qflx_nvp_to_snow_col, & ! [PORTED by Hui Tang: excess NVP ice -> bottom snow layer] + h2osoi_liq => waterstate_inst%h2osoi_liq_col, & + h2osoi_ice => waterstate_inst%h2osoi_ice_col, & ! [PORTED by Hui Tang: ice content for porosity reduction] + h2onvp_col => waterstate_inst%h2onvp_col, & ! [PORTED by Hui Tang: sync diagnostic copy] + smp_l => soilstate_inst%smp_l_col, & + hk_l => soilstate_inst%hk_l_col, & + frac_h2osfc_col => waterdiagnosticbulk_inst%frac_h2osfc_col, & + ! [PORTED by Hui Tang: snow fraction for snow-cover-aware frac_nvp_eff] + frac_sno_eff_col => waterdiagnosticbulk_inst%frac_sno_eff_col, & + fwet_nvp_col => waterdiagnosticbulk_inst%fwet_nvp_col, & + vwc_nvp_col => waterdiagnosticbulk_inst%vwc_nvp_col, & ! [PORTED by Hui Tang: volumetric water content] + t_nvp_col => temperature_inst%t_nvp_col & ! Input: [real(r8) (:) ] NVP (moss/lichen) temperature (Kelvin) + ) + + do c = bounds%begc, bounds%endc + + if (.not. col%nvp_layer_active(c)) then + qflx_nvp_infl_col(c) = 0._r8 + qflx_nvp_drain_col(c) = 0._r8 + cycle + end if + + ! --- Effective NVP area: not covered by snow or surface water --- + ! [PORTED by Hui Tang: include frac_sno_eff_col so partial snow cover reduces + ! the effective NVP fraction used for both infiltration and evaporation. + ! Same convention as SoilFluxesMod, BareGroundFluxesMod, CanopyFluxesMod.] + frac_h2osfc = frac_h2osfc_col(c) + ! [PORTED by Hui Tang: re-wired frac_nvp_eff — snow buries NVP (frac_nvp - frac_sno_eff), cap = 1 - frac_h2osfc - frac_sno_eff] + frac_nvp_eff = min(1._r8 - frac_h2osfc - frac_sno_eff_col(c), max(0._r8, & + col%frac_nvp(c) - frac_sno_eff_col(c))) + + ! --- Water input to NVP from precipitation / snowmelt --- + ! [PORTED by Hui Tang: when snow is present (snl < 0), snow percolation into NVP is + ! already applied to h2osoi_liq(c,0) by UpdateState_SnowPercolation (adds + ! qflx_snow_percolation_col(c,-1)*dtime to h2osoi_liq(c,0)). qflx_rain_plus_snomelt + ! equals qflx_snow_percolation_col(c,0) = NVP outflow, not inflow; using it here + ! would double-count. When no snow (snl=0), qflx_rain_plus_snomelt = rain + snowmelt + ! is the correct NVP inflow from the nosnowc branch of SumFlux_AddSnowPercolation.] + if (col%snl(c) < 0) then + qflx_nvp_infl_col(c) = 0._r8 + else + qflx_nvp_infl_col(c) = frac_nvp_eff * qflx_rain_plus_snomelt(c) ! [mm/s] + end if + + + ! --- NVP volumetric water content (clamped to valid range) --- + ! [PORTED by Hui Tang: initialise eff_porosity and vol_ice on every branch — they are + ! passed to NVPWaterRetentionCurve / NVPHydraulicConductivity below; uninitialised + ! values would cause undefined behaviour or divide-by-zero inside the curves.] + if (col%dz(c,0) > 0._r8) then + if (t_nvp_col(c) >= tfrz) then + ! For unfrozen soil + vol_ice = min(watsat_nvp, h2osoi_ice(c,0)/(col%dz(c,0)*denice)) + eff_porosity = watsat_nvp-vol_ice + vol_liq = min(eff_porosity, h2osoi_liq(c,0)/(col%dz(c,0)*denh2o)) + else + ! For frozen NVP, water is at residual (unavailable for liquid evaporation) + vol_ice = watsat_nvp + eff_porosity = watsat_nvp + vol_liq = watres_nvp + end if + else + vol_ice = 0._r8 + eff_porosity = watsat_nvp + vol_liq = 0._r8 + end if + + ! --- NVP van Genuchten matric potential and hydraulic conductivity --- + call NVPWaterRetentionCurve(vol_liq, eff_porosity, n_van_nvp, alpha_van_nvp, & + watsat_nvp, watres_nvp, psi_nvp) + call NVPHydraulicConductivity(vol_liq, eff_porosity, n_van_nvp, watsat_nvp, watres_nvp, & + ksat_nvp, khydr_nvp) + K_nvp_mms = khydr_nvp * 1000._r8 ! m/s → mm/s + + ! --- Bidirectional Darcy flux with soil layer 1 --- + ! Uses previous-timestep smp_l and hk_l (explicit time stepping) + smp_soil1 = smp_l(c,1) ! [mm] + K_soil1 = hk_l(c,1) ! [mm/s] + + ! Distance between layer centres [mm] + dz_iface_mm = (0.5_r8 * col%dz(c,0) + 0.5_r8 * col%dz(c,1)) * 1000._r8 + + ! Head gradient (matric potential + gravity); negative = upward (capillary rise into NVP) + grad = (psi_nvp - smp_soil1) / dz_iface_mm + 1.0_r8 + + ! [PORTED by Hui Tang: upstream-weighted interface conductivity. The harmonic mean collapses + ! to ~0 when the NVP layer is dry (K_nvp -> 0 in Mualem-van Genuchten), so a dry moss could + ! not draw water up despite strong suction. Use the SOURCE layer's conductivity for the flow + ! direction: upward (capillary rise) is supplied at the soil conductivity K_soil1; downward + ! drainage is limited by the NVP conductivity K_nvp_mms. Upward flux is still capped by the + ! available soil-layer-1 liquid below, so the soil is not over-drained.] + if (grad < 0._r8) then + K_interface = K_soil1 ! upward: soil supplies the water + else + K_interface = K_nvp_mms ! downward: NVP drains at its own conductivity + end if + + ! Darcy flux: q = K * (grad_psi + gravity), positive = downward + q01 = K_interface * grad + + ! --- Atmosphere evap/condensation, scaled by effective NVP area --- + ! [PORTED by Hui Tang: qflx_ev_nvp_eff_col scales with frac_nvp_eff so partial + ! snow cover gracefully reduces the NVP evaporation contribution to the water + ! balance. Replaces the prior binary snl<-1 check, which is now subsumed: + ! when NVP is deeply buried, frac_sno_eff_col → 1 → frac_nvp_eff → 0 → + ! qflx_ev_nvp_eff_col → 0 automatically. Also exposed as history field + ! QFLX_EV_NVP_EFF_COL. Same convention as the infiltration line above: + ! qflx_nvp_infl_col = frac_nvp_eff * qflx_rain_plus_snomelt.] + qflx_ev_nvp_eff_col(c) = frac_nvp_eff * qflx_ev_nvp_col(c) + + ! [PORTED by Hui Tang: the NVP evaporation is now ALREADY in qflx_evap_tot_col — do NOT add + ! it here (would double-count). SoilFluxesMod builds qflx_evap_tot_patch from the per-surface + ! ground-evap total qflx_evap_grnd_eff, which contains frac_nvp_eff*qflx_ev_nvp_patch; the + ! clm_drv_patch2col p2c (driver line ~947, BEFORE HydrologyNoDrainage) then carries exactly + ! frac_nvp_eff*qflx_ev_nvp_col = qflx_ev_nvp_eff_col into qflx_evap_tot_col. That is the same + ! amount debited from h2osoi_liq(c,0) below, so the column water balance (BalanceCheckMod + ! errh2o) already conserves. (The prior explicit add was correct only while SoilFluxesMod + ! overwrote qflx_evap_tot_patch with the bulk qflx_evap_soi and dropped the moss evap; the + ! qflx_evap_grnd_eff change made that add redundant.)] + + ! --- Update h2osoi_liq(c,0): add infl, subtract evap; cannot go negative --- + h2osoi_net = h2osoi_liq(c,0) & + + (qflx_nvp_infl_col(c) - qflx_ev_nvp_eff_col(c)) * dtime ! [kg m-2] + h2osoi_net = max(0._r8, h2osoi_net) + + if (q01 >= 0._r8) then + ! Downward drainage: cap by available NVP liquid water + qflx_nvp_drain_col(c) = min(q01, h2osoi_net / dtime) + else + ! Upward absorption from soil: cap by current soil layer-1 liquid water + qflx_nvp_drain_col(c) = max(q01, -h2osoi_liq(c,1) / dtime) + end if + + h2osoi_liq(c,0) = h2osoi_net - qflx_nvp_drain_col(c) * dtime ! [kg m-2] + + ! --- Step 6: Saturation excess — flush water above watsat to drain --- + if (col%dz(c,0) > 0._r8) then + vol_liq = h2osoi_liq(c,0) / (denh2o * col%dz(c,0)) + if (vol_liq > watsat_nvp) then + ! Excess water above saturation drains immediately to soil layer 1 + satfrac = (vol_liq - watsat_nvp) * denh2o * col%dz(c,0) ! excess [kg m-2] + qflx_nvp_drain_col(c) = qflx_nvp_drain_col(c) + satfrac / dtime + h2osoi_liq(c,0) = h2osoi_liq(c,0) - satfrac + end if + end if + + ! --- Step 7: Ice pore-space cap — push excess frozen water up into the snow --- + ! [PORTED by Hui Tang: cap NVP ice at pore capacity (watsat_nvp*denice*dz). Frozen water + ! (refreezing meltwater / snow ice) must not accumulate beyond what the pore volume can + ! hold, which otherwise inflates cv(c,0) and breaks the soil energy balance (errsoi). + ! Excess ice is moved UP into the bottom snow layer (j=-1) as ice — energetically clean + ! (ice->ice, no phase change) — and recorded in qflx_nvp_to_snow_col so the snow balance + ! (errh2osno, BalanceCheckMod) books it as a snow source. When no snow layer exists + ! (snl=0, NVP exposed), fall back to draining the excess to soil layer 1.] + qflx_nvp_to_snow_col(c) = 0._r8 + if (col%dz(c,0) > 0._r8) then + max_ice_nvp = watsat_nvp * denice * col%dz(c,0) ! pore-space cap [kg m-2] + if (h2osoi_ice(c,0) > max_ice_nvp) then + ice_excess = h2osoi_ice(c,0) - max_ice_nvp + h2osoi_ice(c,0) = max_ice_nvp + if (col%jbot_sno(c) == -1 .and. col%snl(c) <= -2) then + ! snow present: move excess up into the bottom snow layer (j=-1), as ice + h2osoi_ice(c,-1) = h2osoi_ice(c,-1) + ice_excess + qflx_nvp_to_snow_col(c) = ice_excess / dtime + else + ! no snow layer to receive it: drain to soil layer 1 (fallback) + qflx_nvp_drain_col(c) = qflx_nvp_drain_col(c) + ice_excess / dtime + end if + end if + end if + + ! --- Update fwet_nvp (saturation fraction passed to FATES) --- + if (col%dz(c,0) > 0._r8) then + vol_liq = h2osoi_liq(c,0) / (denh2o * col%dz(c,0)) + satfrac = (vol_liq - watres_nvp) / max(watsat_nvp - watres_nvp, 1.e-10_r8) + fwet_nvp_col(c) = max(0._r8, min(1._r8, satfrac)) + else + fwet_nvp_col(c) = 0._r8 + end if + + ! [PORTED by Hui Tang: sync diagnostic copies for history output] + ! h2onvp_col mirrors h2osoi_liq(c,0) [kg m-2 = mm H2O]; vwc_nvp_col is volumetric [m3 m-3] + h2onvp_col(c) = h2osoi_liq(c,0) + if (col%dz(c,0) > 0._r8) then + vwc_nvp_col(c) = h2osoi_liq(c,0) / (denh2o * col%dz(c,0)) + else + vwc_nvp_col(c) = 0._r8 + end if + + end do + + end associate + + end subroutine NVPWaterBalance_Column + + ! =========================================================================== + + subroutine NVPLayerRestart(bounds, ncid, flag) + ! ------------------------------------------------------------------------- + ! [PORTED by Hui Tang: restart NVP column geometry and layer-state variables] + ! + ! Saves/restores the four column-level variables that define NVP layer + ! presence and geometry. Without these, jbot_sno and col%dz(c,0) would + ! revert to zero at restart, causing CLM physics to miss the NVP layer + ! until the first FATES dynamics call. + ! + ! Note: t_soisno(:,0), h2osoi_liq(:,0), h2osoi_ice(:,0) are already + ! covered by the standard T_SOISNO / H2OSOI_LIQ / H2OSOI_ICE restart + ! variables (dim2name='levtot', which spans -nlevsno+1:nlevgrnd). + ! h2onvp_col and t_nvp_col are restarted in WaterStateType and + ! TemperatureType respectively. + ! ------------------------------------------------------------------------- + use ncdio_pio , only : file_desc_t, ncd_double, ncd_int + ! [PORTED by Hui Tang: use restUtilMod (not restFileMod) for restartvar — restFileMod + ! uses clm_instMod, creating clm_instMod ↔ NVPLayerDynamicsMod cycle in build deps] + use restUtilMod , only : restartvar + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + type(file_desc_t) , intent(inout) :: ncid + character(len=*) , intent(in) :: flag ! 'define', 'write', or 'read' + ! + ! !LOCAL VARIABLES: + logical :: readvar + !----------------------------------------------------------------------- + + ! Column NVP layer thickness [m] + call restartvar(ncid=ncid, flag=flag, varname='DZ_NVP', xtype=ncd_double, & + dim1name='column', & + long_name='NVP (moss/lichen) layer thickness', units='m', & + interpinic_flag='interp', readvar=readvar, data=col%dz_nvp) + if (flag == 'read' .and. .not. readvar) then + col%dz_nvp(bounds%begc:bounds%endc) = 0._r8 + end if + + ! Column NVP fractional coverage [-] + call restartvar(ncid=ncid, flag=flag, varname='FRAC_NVP', xtype=ncd_double, & + dim1name='column', & + long_name='NVP (moss/lichen) fractional coverage', units='1', & + interpinic_flag='interp', readvar=readvar, data=col%frac_nvp) + if (flag == 'read' .and. .not. readvar) then + col%frac_nvp(bounds%begc:bounds%endc) = 0._r8 + end if + + ! [PORTED by Hui Tang: nvp_layer_active is fully redundant with jbot_sno (active iff jbot_sno == -1). + ! restartvar has no logical-array overload, so we restart only JBOT_SNO and derive the flag below.] + + ! Bottom index of active snow: 0 = no NVP, -1 = NVP present at layer 0 + call restartvar(ncid=ncid, flag=flag, varname='JBOT_SNO', xtype=ncd_int, & + dim1name='column', & + long_name='bottom index of active snow layers (0 or -1 with NVP)', units='', & + interpinic_flag='interp', readvar=readvar, data=col%jbot_sno) + if (flag == 'read' .and. .not. readvar) then + col%jbot_sno(bounds%begc:bounds%endc) = 0 + end if + + ! Derive nvp_layer_active from jbot_sno on read (covers both restart and cold-start paths) + if (flag == 'read') then + col%nvp_layer_active(bounds%begc:bounds%endc) = & + (col%jbot_sno(bounds%begc:bounds%endc) == -1) + end if + + end subroutine NVPLayerRestart + + !----------------------------------------------------------------------- + subroutine NVPColdStartIce(bounds, waterstate_inst) + ! + ! [PORTED by Hui Tang: cold-start initialization of the NVP layer-0 ice content. + ! The general WaterStateType::InitCold fills the j=0 slot as if it were a snow/soil + ! layer, giving an unphysically large ice mass (e.g. 55 kg/m2). Override it to the + ! NVP pore-space capacity (watsat_nvp*denice*dz) so the layer starts physically + ! consistent and the initial begwb already reflects the cap — no first-step blip and + ! no discarded water. Called once from clm_initializeMod after init_coldstart sets the + ! NVP geometry (nvp_layer_active, dz) and before the first begwb, on a cold start only. + ! Assumes a frozen cold start (ice-saturated, liquid=0), consistent with the alpine + ! Jan-1 cold start; the per-timestep appear-branch handles unfrozen reactivation.] + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds + class(waterstate_type), intent(inout) :: waterstate_inst + ! + ! !LOCAL VARIABLES: + integer :: c + real(r8) :: max_ice_nvp ! NVP pore-space ice capacity [kg m-2] + !----------------------------------------------------------------------- + do c = bounds%begc, bounds%endc + if (col%nvp_layer_active(c) .and. col%dz(c,0) > 0._r8) then + max_ice_nvp = watsat_nvp * denice * col%dz(c,0) + waterstate_inst%h2osoi_ice_col(c,0) = 0._r8 + waterstate_inst%h2osoi_liq_col(c,0) = 0._r8 + end if + end do + + end subroutine NVPColdStartIce + +end module NVPLayerDynamicsMod diff --git a/src/biogeophys/NVPParamsMod.F90 b/src/biogeophys/NVPParamsMod.F90 new file mode 100644 index 0000000000..d05c68689a --- /dev/null +++ b/src/biogeophys/NVPParamsMod.F90 @@ -0,0 +1,55 @@ +module NVPParamsMod + + ! [PORTED by Hui Tang: centralized CLM-side NVP (moss/lichen) physics parameters] + ! + ! All tunable parameters for the NVP layer in CLM are declared here with their + ! default values. They are readable at runtime via the nvp_inparm namelist group + ! in user_nl_clm (or the model's standard namelist input file). Default values + ! reproduce the original hardcoded constants and leave model behaviour unchanged + ! when nvp_inparm is absent from the namelist. + ! + ! Usage: + ! use NVPParamsMod, only : nvp_frac_min, watsat_nvp, ... + ! + ! Parameters: + ! nvp_frac_min — min fractional coverage to activate the NVP layer + ! rnvp_min — minimum surface evaporation resistance (fully saturated) [s m-1] + ! rnvp_amp — resistance amplitude as NVP dries [s m-1] + ! rnvp_exp — exponent of resistance–dryness curve [-] + ! ksat_nvp — saturated hydraulic conductivity [m s-1] + ! n_van_nvp — van Genuchten shape parameter n [-] + ! alpha_van_nvp — van Genuchten inverse air-entry pressure alpha [cm-1] + ! watsat_nvp — saturated volumetric water content (porosity) [m3 m-3] + ! watres_nvp — residual volumetric water content [m3 m-3] + + use shr_kind_mod, only : r8 => shr_kind_r8 + + implicit none + public + + ! Activation threshold + real(r8) :: nvp_frac_min = 1.0e-6_r8 ! min NVP coverage fraction to activate layer [-] + + ! Evaporation resistance (van de Griend & Owe, 1994 / Daamen & Simmonds) + ! rnvp = rnvp_min + rnvp_amp * (1 - satfrac)^rnvp_exp [s m-1] + real(r8) :: rnvp_min = 10.0_r8 ! minimum surface resistance when saturated [s m-1] + real(r8) :: rnvp_amp = 1000.0_r8 ! [PORTED by Hui Tang: raised 500->1000 to retain water (slower dry-moss evaporation)] amplitude of resistance increase when dry [s m-1] + real(r8) :: rnvp_exp = 3.0_r8 ! exponent of dryness function [-] + ! [PORTED by Hui Tang: surface resistance applied when NVP is frozen — typical literature + ! range for ice/snow surfaces is ~1000-3000 s/m; default 1500 s/m suppresses but does + ! not zero sublimation. Set to a very large value (e.g. 1e6) to disable evap when frozen.] + real(r8) :: rnvp_ice = 1500.0_r8 ! NVP resistance when frozen [s m-1] + + ! Hydraulic properties (Mualem-van Genuchten) + real(r8) :: ksat_nvp = 1.0e-4_r8 ! saturated hydraulic conductivity [m s-1] + real(r8) :: n_van_nvp = 1.5_r8 ! van Genuchten shape parameter n [-] + real(r8) :: alpha_van_nvp = 0.01_r8 ! van Genuchten alpha [cm-1] + real(r8) :: watsat_nvp = 0.85_r8 ! saturated volumetric water content [m3 m-3] + real(r8) :: watres_nvp = 0.05_r8 ! residual volumetric water content [m3 m-3] + + ! Thermal properties of the dry NVP matrix (Farouki-style mixing with water/ice) + ! [PORTED by Hui Tang: NVP dry-matrix thermal parameters for SoilTemperatureMod] + real(r8) :: thk_dry_nvp = 0.05_r8 ! dry NVP thermal conductivity [W m-1 K-1] + real(r8) :: csol_nvp = 0.58e6_r8 ! dry NVP volumetric heat capacity [J m-3 K-1] + +end module NVPParamsMod diff --git a/src/biogeophys/SnowHydrologyMod.F90 b/src/biogeophys/SnowHydrologyMod.F90 index 578769d9ea..5ed50b781f 100644 --- a/src/biogeophys/SnowHydrologyMod.F90 +++ b/src/biogeophys/SnowHydrologyMod.F90 @@ -22,7 +22,7 @@ module SnowHydrologyMod use abortutils , only : endrun use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall use clm_varpar , only : nlevsno, nlevsoi, nlevgrnd, nlevmaxurbgrnd - use clm_varctl , only : iulog, use_subgrid_fluxes + use clm_varctl , only : iulog, use_subgrid_fluxes, use_nvp ! [PORTED by Hui Tang: use_nvp for NVP layer guard] use clm_varcon , only : h2osno_max, hfus, denh2o, denice, rpi, spval, tfrz use clm_varcon , only : cpice, cpliq use atm2lndType , only : atm2lnd_type @@ -944,8 +944,14 @@ subroutine UpdateState_InitializeSnowPack(bounds, snowpack_initialized_filterc, do fc = 1, snowpack_initialized_filterc%num c = snowpack_initialized_filterc%indices(fc) - h2osoi_ice(c,0) = h2osno_no_layers(c) - h2osoi_liq(c,0) = 0._r8 + ! [PORTED by Hui Tang: when NVP occupies layer 0, place first snow ice at layer -1] + if (use_nvp .and. col%jbot_sno(c) == -1) then + h2osoi_ice(c,-1) = h2osno_no_layers(c) + h2osoi_liq(c,-1) = 0._r8 + else + h2osoi_ice(c,0) = h2osno_no_layers(c) + h2osoi_liq(c,0) = 0._r8 + end if h2osno_no_layers(c) = 0._r8 end do @@ -994,17 +1000,28 @@ subroutine Bulk_InitializeSnowPack(bounds, snowpack_initialized_filterc, & do fc = 1, snowpack_initialized_filterc%num c = snowpack_initialized_filterc%indices(fc) - snl(c) = -1 - dz(c,0) = snow_depth(c) - z(c,0) = -0.5_r8*dz(c,0) - zi(c,-1) = -dz(c,0) - ! Currently, the water temperature for the precipitation is simply set - ! as the surface air temperature - t_soisno(c,0) = min(tfrz, forc_t(c)) - - ! This value of frac_iceold makes sense together with the state initialization: - ! h2osoi_ice is non-zero, while h2osoi_liq is zero. - frac_iceold(c,0) = 1._r8 + ! [PORTED by Hui Tang: when NVP occupies layer 0, place first snow layer at index -1 + ! so that dz/z/zi/t/frac_iceold for the NVP slot are preserved intact.] + if (use_nvp .and. col%jbot_sno(c) == -1) then + snl(c) = -2 + dz(c,-1) = snow_depth(c) + z(c,-1) = -(dz(c,0) + 0.5_r8*dz(c,-1)) + zi(c,-2) = -(dz(c,0) + dz(c,-1)) + ! zi(c,-1) = -dz(c,0) is already set by UpdateNVPLayer + t_soisno(c,-1) = min(tfrz, forc_t(c)) + frac_iceold(c,-1) = 1._r8 + else + snl(c) = -1 + dz(c,0) = snow_depth(c) + z(c,0) = -0.5_r8*dz(c,0) + zi(c,-1) = -dz(c,0) + ! Currently, the water temperature for the precipitation is simply set + ! as the surface air temperature + t_soisno(c,0) = min(tfrz, forc_t(c)) + ! This value of frac_iceold makes sense together with the state initialization: + ! h2osoi_ice is non-zero, while h2osoi_liq is zero. + frac_iceold(c,0) = 1._r8 + end if snomelt_accum(c) = 0._r8 end do @@ -1043,6 +1060,8 @@ subroutine SnowWater(bounds, & integer :: g ! gridcell loop index integer :: c, j, fc, l ! do loop/array indices real(r8) :: dtime ! land model time step (sec) + ! [PORTED by Hui Tang: per-column bottom percolation flux; uses j=-1 when NVP active, j=0 otherwise] + real(r8) :: qflx_snow_percolation_bottom_tmp(bounds%begc:bounds%endc) !----------------------------------------------------------------------- associate( & @@ -1081,6 +1100,7 @@ subroutine SnowWater(bounds, & ! Inputs dtime = dtime, & snl = col%snl(begc:endc), & + jbot_sno = col%jbot_sno(begc:endc), & dz = col%dz(begc:endc,:), & frac_sno_eff = b_waterdiagnostic_inst%frac_sno_eff_col(begc:endc), & h2osoi_ice = b_waterstate_inst%h2osoi_ice_col(begc:endc,:), & @@ -1148,13 +1168,29 @@ subroutine SnowWater(bounds, & do i = water_inst%bulk_and_tracers_beg, water_inst%bulk_and_tracers_end associate(w => water_inst%bulk_and_tracers(i)) + ! [PORTED by Hui Tang: select bottom-of-snow percolation index. Whenever the NVP + ! structural layer exists at j=0 (jbot_sno == -1), the bottom snow percolation + ! exits at j=-1 into NVP — regardless of whether NVP is exposed or buried. + ! Previously gated on col%nvp_layer_active(c) which is TRUE only when NVP is + ! exposed (snl=0); the buried-NVP case (snl<0, jbot_sno=-1) then incorrectly + ! picked qflx_snow_percolation_col(c,0), which carries the NVP→soil drainage + ! flux (a different physical process), causing systematic negative errh2osno. + ! Correct condition is jbot_sno==-1.] + do c = begc, endc + if (col%jbot_sno(c) == -1) then + qflx_snow_percolation_bottom_tmp(c) = w%waterflux_inst%qflx_snow_percolation_col(c, -1) + else + qflx_snow_percolation_bottom_tmp(c) = w%waterflux_inst%qflx_snow_percolation_col(c, 0) + end if + end do call SumFlux_AddSnowPercolation(bounds, & num_snowc, filter_snowc, num_nosnowc, filter_nosnowc, & ! Inputs frac_sno_eff = b_waterdiagnostic_inst%frac_sno_eff_col(begc:endc), & - qflx_snow_percolation_bottom = w%waterflux_inst%qflx_snow_percolation_col(begc:endc, 0), & + qflx_snow_percolation_bottom = qflx_snow_percolation_bottom_tmp(begc:endc), & qflx_liq_grnd = w%waterflux_inst%qflx_liq_grnd_col(begc:endc), & qflx_snomelt = w%waterflux_inst%qflx_snomelt_col(begc:endc), & + nvp_layer_active = col%nvp_layer_active(begc:endc), & ! Outputs qflx_snow_drain = w%waterflux_inst%qflx_snow_drain_col(begc:endc), & qflx_rain_plus_snomelt = w%waterflux_inst%qflx_rain_plus_snomelt_col(begc:endc)) @@ -1228,6 +1264,19 @@ subroutine UpdateState_TopLayerFluxes(bounds, num_snowc, filter_snowc, & h2osoi_liq(c,lev_top(c)) = h2osoi_liq(c,lev_top(c)) + & frac_sno_eff(c) * (qflx_liq_grnd(c) + qflx_liqdew_to_top_layer(c) & - qflx_liqevap_from_top_layer(c)) * dtime + + ! [PORTED by Hui Tang: NaN diagnostic — catch NaN from flux inputs before it propagates] + if (h2osoi_liq(c,lev_top(c)) /= h2osoi_liq(c,lev_top(c))) then + write(iulog,*) "NaN DIAGNOSTIC: h2osoi_liq is NaN after UpdateState_TopLayerFluxes" + write(iulog,*) " c, lev_top(c) = ", c, lev_top(c) + write(iulog,*) " h2osoi_liq_top_orig = ", h2osoi_liq_top_orig(c) + write(iulog,*) " frac_sno_eff = ", frac_sno_eff(c) + write(iulog,*) " qflx_liq_grnd*dtime = ", qflx_liq_grnd(c)*dtime + write(iulog,*) " qflx_liqdew_to_top_layer*dtime = ", qflx_liqdew_to_top_layer(c)*dtime + write(iulog,*) " qflx_liqevap_from_top_layer*dtime=", qflx_liqevap_from_top_layer(c)*dtime + call endrun(subgrid_index=c, subgrid_level=subgrid_level_column, & + msg="NaN in h2osoi_liq after UpdateState_TopLayerFluxes — check flux inputs") + end if end do ! If states were supposed to go to 0 but instead ended up near-0 (positive or @@ -1291,7 +1340,7 @@ end subroutine UpdateState_TopLayerFluxes !----------------------------------------------------------------------- subroutine BulkFlux_SnowPercolation(bounds, num_snowc, filter_snowc, & - dtime, snl, dz, frac_sno_eff, h2osoi_ice, h2osoi_liq, & + dtime, snl, jbot_sno, dz, frac_sno_eff, h2osoi_ice, h2osoi_liq, & qflx_snow_percolation) ! ! !DESCRIPTION: @@ -1307,6 +1356,9 @@ subroutine BulkFlux_SnowPercolation(bounds, num_snowc, filter_snowc, & real(r8) , intent(in) :: dtime ! land model time step (sec) integer , intent(in) :: snl( bounds%begc: ) ! negative number of snow layers + ! [PORTED by Hui Tang: jbot_sno is 0 when no NVP, -1 when NVP occupies index 0; + ! used to stop percolation at the bottom snow layer and skip the NVP layer (j=0)] + integer , intent(in) :: jbot_sno( bounds%begc: ) ! bottom index of active snow layers (0 or -1) real(r8) , intent(in) :: dz( bounds%begc: , -nlevsno+1: ) ! layer depth (m) real(r8) , intent(in) :: frac_sno_eff( bounds%begc: ) ! eff. fraction of ground covered by snow (0 to 1) real(r8) , intent(in) :: h2osoi_ice( bounds%begc: , -nlevsno+1: ) ! ice lens (kg/m2) @@ -1320,6 +1372,7 @@ subroutine BulkFlux_SnowPercolation(bounds, num_snowc, filter_snowc, & real(r8) :: vol_liq(bounds%begc:bounds%endc,-nlevsno+1:0) ! partial volume of liquid water in layer real(r8) :: vol_ice(bounds%begc:bounds%endc,-nlevsno+1:0) ! partial volume of ice lens in layer real(r8) :: eff_porosity(bounds%begc:bounds%endc,-nlevsno+1:0) ! effective porosity = porosity - vol_ice + real(r8) :: denom_j ! dz*frac_sno_eff denominator for vol calculations character(len=*), parameter :: subname = 'BulkFlux_SnowPercolation' !----------------------------------------------------------------------- @@ -1338,9 +1391,17 @@ subroutine BulkFlux_SnowPercolation(bounds, num_snowc, filter_snowc, & c = filter_snowc(fc) if (j >= snl(c)+1) then ! need to scale dz by frac_sno to convert to grid cell average depth - vol_ice(c,j) = min(1._r8, h2osoi_ice(c,j)/(dz(c,j)*frac_sno_eff(c)*denice)) - eff_porosity(c,j) = 1._r8 - vol_ice(c,j) - vol_liq(c,j) = min(eff_porosity(c,j),h2osoi_liq(c,j)/(dz(c,j)*frac_sno_eff(c)*denh2o)) + ! [PORTED by Hui Tang: guard zero denominator; dz*frac_sno_eff=0 gives 0/0=NaN without this] + denom_j = dz(c,j) * frac_sno_eff(c) + if (denom_j > 0._r8) then + vol_ice(c,j) = min(1._r8, h2osoi_ice(c,j)/(denom_j*denice)) + eff_porosity(c,j) = max(0._r8, 1._r8 - vol_ice(c,j)) + vol_liq(c,j) = min(eff_porosity(c,j), h2osoi_liq(c,j)/(denom_j*denh2o)) + else + vol_ice(c,j) = 0._r8 + eff_porosity(c,j) = 1._r8 + vol_liq(c,j) = 0._r8 + end if end if end do end do @@ -1359,7 +1420,12 @@ subroutine BulkFlux_SnowPercolation(bounds, num_snowc, filter_snowc, & do fc = 1, num_snowc c = filter_snowc(fc) if (j >= snl(c)+1) then - if (j <= -1) then + ! [PORTED by Hui Tang: use jbot_sno(c) instead of hard-coded -1 so that the + ! NVP layer at j=0 is excluded when nvp_layer_active. + ! j < jbot_sno: interior snow layer — capacity-limited (next layer is also snow). + ! j == jbot_sno: bottom snow layer — uncapped gravity drainage (next is NVP or soil). + ! j > jbot_sno: NVP layer (only j=0 when nvp_layer_active) — zero; not a snow layer.] + if (j < jbot_sno(c)) then ! No runoff over snow surface, just ponding on surface if (eff_porosity(c,j) < params_inst%wimp .OR. eff_porosity(c,j+1) < params_inst%wimp) then qflx_snow_percolation(c,j) = 0._r8 @@ -1370,9 +1436,12 @@ subroutine BulkFlux_SnowPercolation(bounds, num_snowc, filter_snowc, & qflx_snow_percolation(c,j) = min(qflx_snow_percolation(c,j),(1._r8-vol_ice(c,j+1) & - vol_liq(c,j+1))*dz(c,j+1)*frac_sno_eff(c)) end if - else + else if (j == jbot_sno(c)) then qflx_snow_percolation(c,j) = max(0._r8,(vol_liq(c,j) & - params_inst%ssi*eff_porosity(c,j))*dz(c,j)*frac_sno_eff(c)) + else + ! j > jbot_sno(c): NVP layer at j=0; not a snow layer + qflx_snow_percolation(c,j) = 0._r8 end if qflx_snow_percolation(c,j) = (qflx_snow_percolation(c,j)*1000._r8)/dtime end if @@ -1741,6 +1810,11 @@ subroutine PostPercolation_AdjustLayerThicknesses(bounds, num_snowc, filter_snow do j = -nlevsno+1, 0 do fc = 1, num_snowc c = filter_snowc(fc) + ! [PORTED by Hui Tang: skip NVP layer j=0 — its dz is a structural property set by + ! UpdateNVPLayer from FATES-derived nvp_dz, not a snow-water-content floor. During + ! melt, snow percolation fills h2osoi_liq(c,0) and the standard floor below would + ! inflate dz(c,0), corrupting layer geometry until UpdateNVPLayer resets it.] + if (use_nvp .and. col%jbot_sno(c) == -1 .and. j == 0) cycle if (j >= snl(c)+1) then dz(c,j) = max(dz(c,j),h2osoi_liq(c,j)/denh2o + h2osoi_ice(c,j)/denice) end if @@ -1816,6 +1890,7 @@ end subroutine BulkDiag_SnowWaterAccumulatedSnow subroutine SumFlux_AddSnowPercolation(bounds, & num_snowc, filter_snowc, num_nosnowc, filter_nosnowc, & frac_sno_eff, qflx_snow_percolation_bottom, qflx_liq_grnd, qflx_snomelt, & + nvp_layer_active, & qflx_snow_drain, qflx_rain_plus_snomelt) ! ! !DESCRIPTION: @@ -1832,6 +1907,10 @@ subroutine SumFlux_AddSnowPercolation(bounds, & real(r8) , intent(in) :: qflx_snow_percolation_bottom( bounds%begc: ) ! liquid percolation out of the bottom of the snow pack (mm H2O /s) real(r8) , intent(in) :: qflx_liq_grnd( bounds%begc: ) ! liquid on ground after interception (mm H2O/s) real(r8) , intent(in) :: qflx_snomelt( bounds%begc: ) ! snow melt (mm H2O /s) + ! [PORTED by Hui Tang: when NVP occupies j=0, percolation from the bottom snow layer + ! (j=-1) goes to NVP, not the soil surface; exclude it from qflx_rain_plus_snomelt + ! to prevent bogus soil input and column water balance error] + logical , intent(in) :: nvp_layer_active( bounds%begc: ) ! .true. when NVP layer is active at j=0 real(r8) , intent(inout) :: qflx_snow_drain( bounds%begc: ) ! drainage from snow pack from previous time step (mm H2O/s) real(r8) , intent(inout) :: qflx_rain_plus_snomelt( bounds%begc: ) ! rain plus snow melt falling on the soil (mm/s) @@ -1852,9 +1931,16 @@ subroutine SumFlux_AddSnowPercolation(bounds, & do fc = 1, num_snowc c = filter_snowc(fc) + ! Always register percolation as a snow drain (fixes snow balance) qflx_snow_drain(c) = qflx_snow_drain(c) + qflx_snow_percolation_bottom(c) - qflx_rain_plus_snomelt(c) = qflx_snow_percolation_bottom(c) & - + (1.0_r8 - frac_sno_eff(c)) * qflx_liq_grnd(c) + if (nvp_layer_active(c)) then + ! Percolation exits j=-1 into NVP (j=0), not the soil surface; exclude from + ! qflx_rain_plus_snomelt so it is not double-counted as soil input / surface runoff. + qflx_rain_plus_snomelt(c) = (1.0_r8 - frac_sno_eff(c)) * qflx_liq_grnd(c) + else + qflx_rain_plus_snomelt(c) = qflx_snow_percolation_bottom(c) & + + (1.0_r8 - frac_sno_eff(c)) * qflx_liq_grnd(c) + end if end do do fc = 1, num_nosnowc @@ -1956,6 +2042,8 @@ subroutine SnowCompaction(bounds, num_snowc, filter_snowc, & c = filter_snowc(fc) g = col%gridcell(c) if (j >= snl(c)+1) then + ! [PORTED by Hui Tang: NVP at layer 0 is not snow; skip compaction for NVP layer] + if (use_nvp .and. col%jbot_sno(c) == -1 .and. j == 0) cycle wx = (h2osoi_ice(c,j) + h2osoi_liq(c,j)) void = 1._r8 - (h2osoi_ice(c,j)/denice + h2osoi_liq(c,j)/denh2o)& @@ -2196,7 +2284,8 @@ subroutine CombineSnowLayers(bounds, num_snowc, filter_snowc, & do fc = 1, num_snowc c = filter_snowc(fc) l = col%landunit(c) - do j = msn_old(c)+1,0 + ! [PORTED by Hui Tang: stop at j=-1 when NVP at j=0, so snow is never merged into NVP] + do j = msn_old(c)+1, merge(-1, 0, use_nvp .and. col%jbot_sno(c) == -1) ! use 0.01 to avoid runaway ice buildup if (h2osoi_ice_bulk(c,j) <= .01_r8) then if (j < 0 .or. (ltype(l) == istsoil .or. urbpoi(l) .or. ltype(l) == istcrop)) then @@ -2220,7 +2309,11 @@ subroutine CombineSnowLayers(bounds, num_snowc, filter_snowc, & end if if (j < 0) then - dz(c,j+1) = dz(c,j+1) + dz(c,j) + ! [PORTED by Hui Tang: do not extend NVP layer when dissolving the bottom + ! snow layer (j=-1) into it; only merge dz for true snow-on-snow cases] + if (.not. (use_nvp .and. col%jbot_sno(c) == -1 .and. j+1 == 0)) then + dz(c,j+1) = dz(c,j+1) + dz(c,j) + end if mss_bcphi(c,j+1) = mss_bcphi(c,j+1) + mss_bcphi(c,j) mss_bcpho(c,j+1) = mss_bcpho(c,j+1) + mss_bcpho(c,j) @@ -2278,6 +2371,9 @@ subroutine CombineSnowLayers(bounds, num_snowc, filter_snowc, & end do end if snl(c) = snl(c) + 1 + ! [PORTED by Hui Tang: after dissolving the last snow layer above NVP, + ! snl=-1 must be reset to 0; NVP is not a snow layer (jbot_sno=-1 tracks it)] + if (use_nvp .and. col%jbot_sno(c) == -1 .and. snl(c) == -1) snl(c) = 0 end if end do end do @@ -2299,6 +2395,8 @@ subroutine CombineSnowLayers(bounds, num_snowc, filter_snowc, & do j = -nlevsno+1,0 do fc = 1, num_snowc c = filter_snowc(fc) + ! [PORTED by Hui Tang: skip NVP layer j=0 — NVP water is not snow water] + if (use_nvp .and. col%jbot_sno(c) == -1 .and. j == 0) cycle if (j >= snl(c)+1) then do wi = water_inst%bulk_and_tracers_beg, water_inst%bulk_and_tracers_end associate(w => water_inst%bulk_and_tracers(wi)) @@ -2350,6 +2448,8 @@ subroutine CombineSnowLayers(bounds, num_snowc, filter_snowc, & end associate end do + ! [PORTED by Hui Tang: NVP occupies layer 0 but is not a snow layer; jbot_sno=-1 + ! tracks the NVP slot. snl=0 is correct for "no real snow" regardless of NVP.] snl(c) = 0 h2osno_total(c) = h2osno_no_layers_bulk(c) @@ -2389,14 +2489,17 @@ subroutine CombineSnowLayers(bounds, num_snowc, filter_snowc, & msn_old(c) = snl(c) mssi(c) = 1 - do i = msn_old(c)+1,0 + ! [PORTED by Hui Tang: stop at i=-1 when NVP at j=0, so NVP is never combined with snow] + do i = msn_old(c)+1, merge(-1, 0, use_nvp .and. col%jbot_sno(c) == -1) if ((frac_sno_eff(c)*dz(c,i) < dzminloc(mssi(c))) .or. & ((h2osoi_ice_bulk(c,i) + h2osoi_liq_bulk(c,i))/(frac_sno_eff(c)*dz(c,i)) < 50._r8)) then if (i == snl(c)+1) then ! If top node is removed, combine with bottom neighbor. neibor = i + 1 - else if (i == 0) then - ! If the bottom neighbor is not snow, combine with the top neighbor. + else if (i == 0 .or. & + (use_nvp .and. col%jbot_sno(c) == -1 .and. i == -1)) then + ! If the bottom neighbor is not snow (soil or NVP), combine with top. + ! [PORTED by Hui Tang: i==-1 is the bottom snow layer when NVP at 0] neibor = i - 1 else ! If none of the above special cases apply, combine with the thinnest neighbor @@ -2502,6 +2605,30 @@ subroutine CombineSnowLayers(bounds, num_snowc, filter_snowc, & end do end do + ! [DEBUG: temporary, remove after diagnosing SNOWDP growth during melt] + ! Per-timestep snapshot of final snow state for NVP-active columns. Compare + ! across May→June: if dz(c,j<0) grows while h2osoi_ice/liq shrink, the standard + ! CTSM compaction floor (mass/frac_sno) is inflating snow-layer dz as frac_sno + ! drops. dz(c,0) should stay at the structural nvp_dz value. + if (use_nvp) then + do fc = 1, num_snowc + c = filter_snowc(fc) + if (col%jbot_sno(c) == -1) then + write(iulog,*) '[NVP DBG snow] c=', c, & + ' snl=', snl(c), & + ' jbot_sno=', col%jbot_sno(c), & + ' snow_depth=', snow_depth(c), & + ' h2osno_total=', h2osno_total(c), & + ' frac_sno=', frac_sno(c), & + ' frac_sno_eff=', frac_sno_eff(c), & + ' dz_nvp=', dz(c,0) + write(iulog,*) ' dz(snl+1..0)= ', (dz(c,j), j=snl(c)+1, 0) + write(iulog,*) ' h2osoi_ice(snl+1..0)= ',(h2osoi_ice_bulk(c,j), j=snl(c)+1, 0) + write(iulog,*) ' h2osoi_liq(snl+1..0)= ',(h2osoi_liq_bulk(c,j), j=snl(c)+1, 0) + end if + end do + end if + end associate end associate end subroutine CombineSnowLayers @@ -2662,14 +2789,31 @@ subroutine DivideSnowLayers(bounds, num_snowc, filter_snowc, & loop_snowcolumns: do fc = 1, num_snowc c = filter_snowc(fc) + ! [PORTED by Hui Tang: NVP debug print — j=0 water before compaction] + if (use_nvp .and. col%jbot_sno(c) == -1 .and. c == 1) & + write(iulog,'(A,I4,A,I4,A,2ES14.6)') '[NVP DBG] DivSnow BEG c=',c, & + ' snl=',snl(c),' ice0/liq0=', & + water_inst%bulk_and_tracers(i_bulk)%waterstate_inst%h2osoi_ice_col(c,0), & + water_inst%bulk_and_tracers(i_bulk)%waterstate_inst%h2osoi_liq_col(c,0) + msno = abs(snl(c)) + ! [PORTED by Hui Tang: when NVP occupies j=0, snl encodes -(N_snow+1). + ! Exclude the NVP slot from msno so snow compaction stops at j=-1.] + if (use_nvp .and. col%jbot_sno(c) == -1) msno = msno - 1 ! Now traverse layers from top to bottom in a dynamic way, as the total ! number of layers (msno) may increase during the loop. ! Impose k < nlevsno; the special case 'k == nlevsno' is not relevant, ! as it is neither allowed to subdivide nor does it have layers below. + ! [PORTED by Hui Tang: when NVP occupies index j=0, the valid snow indices are only + ! -nlevsno+1 .. -1 (nlevsno-1 slots), because j=0 is reserved for the NVP layer. Cap the + ! subdivision at nlevsno-1 in that case so msno can reach at most nlevsno-1 and the later + ! reconstruction snl = -(msno+1) stays >= -nlevsno (i.e. snl+1 >= -nlevsno+1, in bounds). + ! Without this, a deep snowpack subdivides to msno=nlevsno -> snl=-(nlevsno+1) -> snl+1 + ! one below the t_soisno lower bound (Fortran "Index '-12' below lower bound -11" crash).] k = 1 - loop_layers: do while( k <= msno .and. k < nlevsno ) + loop_layers: do while( k <= msno .and. & + k < nlevsno - merge(1, 0, use_nvp .and. col%jbot_sno(c) == -1) ) ! Current layer is bottom layer if (k == msno) then @@ -2749,6 +2893,14 @@ subroutine DivideSnowLayers(bounds, num_snowc, filter_snowc, & zwice(wi) = propor*swice(wi,c,k) zwliq(wi) = propor*swliq(wi,c,k) end do + + write(iulog,*) 'msno=',msno, & + 'dzsno=',dzsno(c,k), & + 'swliq=',swliq(:,c,k), & + 'swice=',swice(:,c,k), & + 'zwliq=',zwliq, & + 'zwice=',zwice + zmbc_phi = propor*mbc_phi(c,k) zmbc_pho = propor*mbc_pho(c,k) zmoc_phi = propor*moc_phi(c,k) @@ -2785,6 +2937,12 @@ subroutine DivideSnowLayers(bounds, num_snowc, filter_snowc, & mdst4(c,k+1) = mdst4(c,k+1)+zmdst4 ! (combo) ! Mass-weighted combination of radius + write(iulog,*) 'c=',c, & + 'k=',k, & + 'dzmax_u=', dzmax_u(k), & + 'swliq(k+1)=', swliq(:,c,:), & + 'swice(k+1)=', swice(:,c,:) + rds(c,k+1) = MassWeightedSnowRadius( rds(c,k), rds(c,k+1), & (swliq(i_bulk,c,k+1)+swice(i_bulk,c,k+1)), (zwliq(i_bulk)+zwice(i_bulk)) ) @@ -2802,13 +2960,28 @@ subroutine DivideSnowLayers(bounds, num_snowc, filter_snowc, & k = k+1 end do loop_layers - snl(c) = -msno + ! [PORTED by Hui Tang: restore NVP layer slot in snl after compaction] + ! snl encodes -(N_snow+1) when NVP is active (j=0 reserved for NVP). + if (use_nvp .and. col%jbot_sno(c) == -1) then + snl(c) = -(msno + 1) + else + snl(c) = -msno + end if + + ! [PORTED by Hui Tang: NVP debug print — j=0 water after compaction] + if (use_nvp .and. col%jbot_sno(c) == -1 .and. c == 1) & + write(iulog,'(A,I4,A,I4,A,2ES14.6)') '[NVP DBG] DivSnow END c=',c, & + ' snl=',snl(c),' ice0/liq0=', & + water_inst%bulk_and_tracers(i_bulk)%waterstate_inst%h2osoi_ice_col(c,0), & + water_inst%bulk_and_tracers(i_bulk)%waterstate_inst%h2osoi_liq_col(c,0) end do loop_snowcolumns do j = -nlevsno+1,0 do fc = 1, num_snowc c = filter_snowc(fc) + ! [PORTED by Hui Tang: skip NVP layer j=0 — it is not a snow layer] + if (use_nvp .and. col%jbot_sno(c) == -1 .and. j == 0) cycle if (j >= snl(c)+1) then if (is_lake) then dz(c,j) = dzsno(c,j-snl(c)) @@ -2932,6 +3105,12 @@ subroutine ZeroEmptySnowLayers(bounds, num_snowc, filter_snowc, & do j = -nlevsno+1,0 do fc = 1, num_snowc c = filter_snowc(fc) + ! [PORTED by Hui Tang: protect NVP layer at j=0 from being zeroed] + ! filter_snowc may include a column whose snl was -1 when the filter was built + ! but has since been set to 0 (last snow layer emptied). With snl=0, the + ! condition j<=snl gives 0<=0=.true., which would incorrectly zero the NVP + ! layer at j=0. Skip j=0 when the NVP layer is active. + if (use_nvp .and. col%jbot_sno(c) == -1 .and. j == 0) cycle if (j <= snl(c) .and. snl(c) > -nlevsno) then do wi = water_inst%bulk_and_tracers_beg, water_inst%bulk_and_tracers_end associate(w => water_inst%bulk_and_tracers(wi)) @@ -3961,6 +4140,11 @@ function MassWeightedSnowRadius( rds1, rds2, swtot, zwtot ) result(mass_weighted real(r8), intent(IN) :: zwtot ! snow water total layer 1 real(r8) :: mass_weighted_snowradius ! resulting bounded mass weighted snow radius + if (.not. (swtot + zwtot > 0._r8)) then + write(iulog,*) 'MassWeightedSnowRadius about to abort: rds1=',rds1, & + ' rds2=',rds2,' swtot=',swtot,' zwtot=',zwtot + end if + SHR_ASSERT_FL( (swtot+zwtot > 0.0_r8), sourcefile, __LINE__) mass_weighted_snowradius = (rds2*swtot + rds1*zwtot)/(swtot+zwtot) diff --git a/src/biogeophys/SnowSnicarMod.F90 b/src/biogeophys/SnowSnicarMod.F90 index f6d41bd6a0..a22259899c 100644 --- a/src/biogeophys/SnowSnicarMod.F90 +++ b/src/biogeophys/SnowSnicarMod.F90 @@ -187,9 +187,11 @@ subroutine readParams( ncid ) end subroutine readParams !----------------------------------------------------------------------- + ! [PORTED by Hui Tang: optional NVP layer-0 inputs (nvp_tau_col, nvp_omega_*_col) for SNICAR Approach B] subroutine SNICAR_RT (bounds, num_nourbanc, filter_nourbanc, & coszen, flg_slr_in, h2osno_liq, h2osno_ice, h2osno_total, snw_rds, & - mss_cnc_aer_in, albsfc, albout, flx_abs, waterdiagnosticbulk_inst) + mss_cnc_aer_in, albsfc, albout, flx_abs, waterdiagnosticbulk_inst, & + nvp_tau_col, nvp_omega_vis_col, nvp_omega_nir_col) ! ! !DESCRIPTION: ! Determine reflectance of, and vertically-resolved solar absorption in, @@ -242,6 +244,13 @@ subroutine SNICAR_RT (bounds, num_nourbanc, filter_nourbanc, & real(r8) , intent(out) :: albout ( bounds%begc: , 1: ) ! snow albedo, averaged into 2 bands (=0 if no sun or no snow) (col,bnd) [frc] real(r8) , intent(out) :: flx_abs ( bounds%begc: , -nlevsno+1: , 1: ) ! absorbed flux in each layer per unit flux incident (col, lyr, bnd) type(waterdiagnosticbulk_type) , intent(in) :: waterdiagnosticbulk_inst + ! [PORTED by Hui Tang: optional NVP layer-0 inputs for SNICAR Approach B] + ! When present and nvp_tau_col(c)>0 with explicit snow layers, NVP is inserted as layer 0 + ! below all snow layers. SNICAR then computes SNOW→NVP→SOIL radiative transfer in one pass. + ! snl_btm is shifted from 0 to -1 so that real snow occupies -1..snl_top and NVP sits at 0. + real(r8), optional, intent(in) :: nvp_tau_col ( bounds%begc: ) ! col-mean NVP optical depth (k*LAI*frac) [-] + real(r8), optional, intent(in) :: nvp_omega_vis_col ( bounds%begc: ) ! col NVP single-scatter albedo, VIS [-] + real(r8), optional, intent(in) :: nvp_omega_nir_col ( bounds%begc: ) ! col NVP single-scatter albedo, NIR [-] ! ! !LOCAL VARIABLES: ! @@ -302,8 +311,12 @@ subroutine SNICAR_RT (bounds, num_nourbanc, filter_nourbanc, & integer :: bnd_idx ! spectral band index (1 <= bnd_idx <= snicar_numrad_snw) [idx] integer :: rds_idx ! snow effective radius index for retrieving ! Mie parameters from lookup table [idx] - integer :: snl_btm ! index of bottom snow layer (0) [idx] + integer :: snl_btm ! index of bottom snow layer (0, or -1 when NVP present) [idx] integer :: snl_top ! index of top snow layer (-4 to 0) [idx] + ! [PORTED by Hui Tang: NVP layer-0 SNICAR locals] + logical :: nvp_active ! .true. if NVP optional args present and tau>0 + real(r8) :: nvp_tau_lcl ! local NVP optical depth for current column + real(r8) :: nvp_omega_lcl ! local NVP single-scatter albedo for current band integer :: fc ! column filter index integer :: i ! layer index [idx] integer :: j ! aerosol number index [idx] @@ -409,6 +422,9 @@ subroutine SNICAR_RT (bounds, num_nourbanc, filter_nourbanc, & real(r8):: smr ! accumulator for rdif gaussian integration real(r8):: smt ! accumulator for tdif gaussian integration real(r8):: exp_min ! minimum exponential value + ! [PORTED by Hui Tang: resonance guard for Delta-Eddington denominator (lm*mu=1 singularity)] + real(r8):: denom_dir ! denominator (1 - lm^2*mu_not^2) for direct-beam alp/gam + real(r8):: denom_dif ! denominator (1 - lm^2*mu^2) for Gaussian-loop alp/gam integer :: ng ! gaussian integration index integer, parameter :: ngmax = 8 ! max gaussian integration index @@ -690,6 +706,28 @@ subroutine SNICAR_RT (bounds, num_nourbanc, filter_nourbanc, & snl_btm = 0 snl_top = snl_lcl+1 + ! [PORTED by Hui Tang: NVP layer-0 SNICAR Approach B] + ! When NVP optional args are supplied, NVP tau > 0, and real snow layers exist + ! (flg_nosnl==0), insert NVP as layer 0 by shifting snl_btm to -1. + ! Snow occupies snl_top..-1; NVP occupies layer 0; soil remains at interface 1. + nvp_active = .false. + nvp_tau_lcl = 0._r8 + if (present(nvp_tau_col) .and. flg_nosnl == 0) then + if (nvp_tau_col(c_idx) > 0._r8) then + nvp_active = .true. + nvp_tau_lcl = nvp_tau_col(c_idx) + ! [PORTED by Hui Tang: do NOT shift snl_btm to -1; keep snl_btm=0 so NVP layer 0 + ! is included in all RT solver loops (tau/omega/g, delta-Eddington, absorbed flux). + ! Snow-grain-radius loops already guard layer 0 via merge(-1,snl_btm,nvp_active).] + ! Populate layer-0 local arrays for NVP (bypass snow grain-radius path): + ! Unit effective mass so tau_snw(0) = ext_cff_mss_snw_lcl(0) = nvp_tau_lcl + h2osno_ice_lcl(0) = 1._r8 + h2osno_liq_lcl(0) = 0._r8 + ! Zero aerosols in NVP layer (no snow impurities) + mss_cnc_aer_lcl(0,:) = 0._r8 + end if + end if + ! for debugging only l_idx = col%landunit(c_idx) g_idx = col%gridcell(c_idx) @@ -698,19 +736,28 @@ subroutine SNICAR_RT (bounds, num_nourbanc, filter_nourbanc, & lon_coord = grc%londeg(g_idx) - ! Set local aerosol array + ! Set local aerosol array (snow layers only; NVP layer 0 already zeroed above) + ! [PORTED by Hui Tang: use merge(-1,snl_btm,nvp_active) to stop the range-copy at -1 + ! when NVP is active, so the zeroed NVP aerosols at layer 0 are not overwritten by + ! mss_cnc_aer_in(0,:) which holds stale snow values. Without this guard, g(0) could + ! exceed 1 -> tau_star < 0 -> SIGFPE. When NVP is inactive, snl_btm=0 so the merge + ! gives 0 and the original layer-0 snow aerosol copy is preserved.] do j=1,sno_nbr_aer - mss_cnc_aer_lcl(:,j) = mss_cnc_aer_in(c_idx,:,j) + mss_cnc_aer_lcl(snl_top:merge(-1,snl_btm,nvp_active),j) = & + mss_cnc_aer_in(c_idx,snl_top:merge(-1,snl_btm,nvp_active),j) + if (.not. nvp_active) then + mss_cnc_aer_lcl(0,j) = mss_cnc_aer_in(c_idx,0,j) + end if enddo ! Set spectral underlying surface albedos to their corresponding VIS or NIR albedos albsfc_lcl(1:(nir_bnd_bgn-1)) = albsfc(c_idx,ivis) albsfc_lcl(nir_bnd_bgn:nir_bnd_end) = albsfc(c_idx,inir) - - ! Error check for snow grain size: - do i=snl_top,snl_btm,1 + + ! Error check for snow grain size (skip layer 0 when NVP is active there): + do i=snl_top, merge(-1, snl_btm, nvp_active), 1 if ((snw_rds_lcl(i) < snw_rds_min_tbl) .or. (snw_rds_lcl(i) > snw_rds_max_tbl)) then write (iulog,*) "SNICAR ERROR: snow grain radius of ", snw_rds_lcl(i), " out of bounds." write (iulog,*) "NSTEP= ", nstep @@ -788,9 +835,25 @@ subroutine SNICAR_RT (bounds, num_nourbanc, filter_nourbanc, & !--------------------------- Start snow & aerosol optics -------------------------------- ! Define local Mie parameters based on snow grain size and aerosol species retrieved from a lookup table. + ! [PORTED by Hui Tang: NVP layer-0 SNICAR Approach B - set omega for current band] + ! NVP properties bypass the grain-radius Mie tables entirely. + if (nvp_active) then + if (bnd_idx < nir_bnd_bgn) then + nvp_omega_lcl = nvp_omega_vis_col(c_idx) + else + nvp_omega_lcl = nvp_omega_nir_col(c_idx) + end if + ! Layer 0: NVP pseudo-layer optical properties + ! ext_cff_mss = tau_nvp (since h2osno_ice_lcl(0)=1, so L_snw*ext=tau_nvp) + ss_alb_snw_lcl(0) = nvp_omega_lcl + ext_cff_mss_snw_lcl(0) = nvp_tau_lcl + asm_prm_snw_lcl(0) = 0._r8 ! isotropic scattering (flat mat, no preferred direction) + end if + ! Spherical snow: single-scatter albedo, mass extinction coefficient, asymmetry factor + ! (snow layers only; layer 0 handled above when NVP active) if (flg_slr_in == 1) then - do i=snl_top,snl_btm,1 + do i=snl_top, merge(-1, snl_btm, nvp_active), 1 rds_idx = snw_rds_lcl(i) - snw_rds_min_tbl + 1 ! snow optical properties (direct radiation) ss_alb_snw_lcl(i) = ss_alb_snw_drc(rds_idx,bnd_idx) @@ -798,7 +861,7 @@ subroutine SNICAR_RT (bounds, num_nourbanc, filter_nourbanc, & if (sno_shp(i) == 'sphere') asm_prm_snw_lcl(i) = asm_prm_snw_drc(rds_idx,bnd_idx) enddo elseif (flg_slr_in == 2) then - do i=snl_top,snl_btm,1 + do i=snl_top, merge(-1, snl_btm, nvp_active), 1 rds_idx = snw_rds_lcl(i) - snw_rds_min_tbl + 1 ! snow optical properties (diffuse radiation) ss_alb_snw_lcl(i) = ss_alb_snw_dfs(rds_idx,bnd_idx) @@ -807,8 +870,8 @@ subroutine SNICAR_RT (bounds, num_nourbanc, filter_nourbanc, & enddo endif - ! Nonspherical snow: shape-dependent asymmetry factors - do i=snl_top,snl_btm,1 + ! Nonspherical snow: shape-dependent asymmetry factors (snow layers only) + do i=snl_top, merge(-1, snl_btm, nvp_active), 1 select case (sno_shp(i)) case ('spheroid') @@ -1093,6 +1156,21 @@ subroutine SNICAR_RT (bounds, num_nourbanc, filter_nourbanc, & ws = omega_star(i) gs = g_star(i) + ! [DEBUG by Hui Tang: diagnose SIGFPE at line 1151] + ! Fires when ws~1 (lm->0, div-by-zero) or lm*mu_not~1 (resonance). + if (ws > 0.9999_r8 .or. & + c3*(c1-ws)*(c1-ws*gs)*mu_not*mu_not > 0.9_r8) then + write(iulog,'(A,3(1X,I6),4(1X,A,ES14.6))') & + 'SNICAR_SIGFPE_DIAG col/layer/band:', c_idx, i, bnd_idx, & + ' ws=', ws, ' gs=', gs, ' ts=', ts, ' mu_not=', mu_not + write(iulog,'(A,2(1X,I6),3(1X,A,ES14.6),A,I8,2(1X,A,ES14.6))') & + 'SNICAR_SIGFPE_INPUTS snl/flg:', snl_lcl, flg_slr_in, & + ' h2osno_ice(-1)=', h2osno_ice_lcl(-1), & + ' h2osno_ice(0)=', h2osno_ice_lcl(0), & + ' tau(i)=', tau(i), ' snw_rds(i)=', snw_rds_lcl(i), & + ' omega(i)=', omega(i), ' g(i)=', g(i) + call shr_sys_flush(iulog) + end if ! Delta-Eddington solution expressions, Eq. 50: Briegleb and Light 2007 lm = sqrt(c3*(c1-ws)*(c1 - ws*gs)) ue = c1p5*(c1 - ws*gs)/lm @@ -1109,12 +1187,20 @@ subroutine SNICAR_RT (bounds, num_nourbanc, filter_nourbanc, & ! Delta-Eddington solution expressions ! Eq. 50: Briegleb and Light 2007; alpha and gamma for direct radiation - alp = cp75*ws*mu_not*((c1 + gs*(c1-ws))/(c1 - lm*lm*mu_not*mu_not)) - gam = cp5*ws*((c1 + c3*gs*(c1-ws)*mu_not*mu_not)/(c1-lm*lm*mu_not*mu_not)) - apg = alp + gam - amg = alp - gam - rdir(i) = apg*rdif_a(i) + amg*(tdif_a(i)*trnlay(i) - c1) - tdir(i) = apg*tdif_a(i) + (amg* rdif_a(i)-apg+c1)*trnlay(i) + ! [PORTED by Hui Tang: skip direct-beam alp/gam at lm*mu_not~1 resonance; + ! fall back to rdif_a/tdif_a as limiting approximation to keep values physical] + denom_dir = c1 - lm*lm*mu_not*mu_not + if (abs(denom_dir) >= 1.e-4_r8) then + alp = cp75*ws*mu_not*((c1 + gs*(c1-ws))/denom_dir) + gam = cp5*ws*((c1 + c3*gs*(c1-ws)*mu_not*mu_not)/denom_dir) + apg = alp + gam + amg = alp - gam + rdir(i) = apg*rdif_a(i) + amg*(tdif_a(i)*trnlay(i) - c1) + tdir(i) = apg*tdif_a(i) + (amg*rdif_a(i)-apg+c1)*trnlay(i) + else + rdir(i) = rdif_a(i) + tdir(i) = tdif_a(i)*trnlay(i) + end if ! recalculate rdif,tdif using direct angular integration over rdir,tdir, ! since Delta-Eddington rdif formula is not well-behaved (it is usually @@ -1126,13 +1212,17 @@ subroutine SNICAR_RT (bounds, num_nourbanc, filter_nourbanc, & smr = c0 smt = c0 ! gaussian angles for the AD integral + ! [PORTED by Hui Tang: skip any Gaussian angle where lm*mu~1 (resonance); + ! clamping the denominator instead would make rdr/tdr huge and cause downstream NaN] do ng=1,ngmax mu = difgauspt(ng) gwt = difgauswt(ng) + denom_dif = c1 - lm*lm*mu*mu + if (abs(denom_dif) < 1.e-4_r8) cycle swt = swt + mu*gwt trn = max(exp_min, exp(-ts/mu)) - alp = cp75*ws*mu*((c1 + gs*(c1-ws))/(c1 - lm*lm*mu*mu)) - gam = cp5*ws*((c1 + c3*gs*(c1-ws)*mu*mu)/(c1-lm*lm*mu*mu)) + alp = cp75*ws*mu*((c1 + gs*(c1-ws))/denom_dif) + gam = cp5*ws*((c1 + c3*gs*(c1-ws)*mu*mu)/denom_dif) apg = alp + gam amg = alp - gam rdr = apg*R1 + amg*T1*trn - amg @@ -1140,8 +1230,11 @@ subroutine SNICAR_RT (bounds, num_nourbanc, filter_nourbanc, & smr = smr + mu*rdr*gwt smt = smt + mu*tdr*gwt enddo ! ng - rdif_a(i) = smr/swt - tdif_a(i) = smt/swt + if (swt > c0) then + rdif_a(i) = smr/swt + tdif_a(i) = smt/swt + end if + ! if swt==0 (all angles resonant — pathological): keep initial R1/T1 values ! homogeneous layer rdif_b(i) = rdif_a(i) diff --git a/src/biogeophys/SoilFluxesMod.F90 b/src/biogeophys/SoilFluxesMod.F90 index 44e6d0e1cd..85e57ad7f9 100644 --- a/src/biogeophys/SoilFluxesMod.F90 +++ b/src/biogeophys/SoilFluxesMod.F90 @@ -10,7 +10,7 @@ module SoilFluxesMod use decompMod , only : bounds_type use abortutils , only : endrun use perf_mod , only : t_startf, t_stopf - use clm_varctl , only : iulog + use clm_varctl , only : iulog, use_nvp ! [PORTED by Hui Tang: use_nvp for NVP snow-burial guard] use clm_varpar , only : nlevsno, nlevgrnd, nlevurb use atm2lndType , only : atm2lnd_type use CanopyStateType , only : canopystate_type @@ -45,7 +45,7 @@ subroutine SoilFluxes (bounds, num_urbanl, filter_urbanl, & ! Update surface fluxes based on the new ground temperature ! ! !USES: - use clm_time_manager , only : get_step_size_real + use clm_time_manager , only : get_step_size_real, get_nstep ! [PORTED by Hui Tang: get_nstep for NVP SEB diagnostic] use clm_varcon , only : hvap, cpair, grav, vkc, tfrz, sb use landunit_varcon , only : istsoil, istcrop use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall, icol_road_perv @@ -78,8 +78,15 @@ subroutine SoilFluxes (bounds, num_urbanl, filter_urbanl, & real(r8) :: eflx_lwrad_del(bounds%begp:bounds%endp) ! update due to eflx_lwrad real(r8) :: t_grnd0(bounds%begc:bounds%endc) ! t_grnd of previous time step real(r8) :: lw_grnd + real(r8) :: frac_nvp_eff ! [PORTED by Hui Tang: effective NVP fraction for LW weighting] + real(r8) :: frac_soil ! [PORTED by Hui Tang: exposed bare-soil fraction (1-fsno-fh2osfc-fnvp)] + real(r8) :: qflx_evap_grnd_eff ! [PORTED by Hui Tang: per-surface ground evap total for energy/diagnostic consistency] real(r8) :: evaporation_limit ! top layer moisture available for evaporation - real(r8) :: evaporation_demand ! evaporative demand + real(r8) :: evaporation_demand ! evaporative demand + real(r8) :: heat_store_diag ! [PORTED by Hui Tang: errsoi diagnostic - heat storage sum] + real(r8) :: wgt ! [PORTED by Hui Tang: errsoi per-layer diagnostic - applied frac weight] + real(r8) :: eflx_soil_grnd_nvp ! [PORTED by Hui Tang: VERIFY-ONLY candidate NVP-consistent errsoi input flux (W/m2)] + real(r8) :: errsoi_test ! [PORTED by Hui Tang: VERIFY-ONLY candidate errsoi residual using NVP-consistent input (W/m2)] !----------------------------------------------------------------------- associate( & @@ -95,8 +102,12 @@ subroutine SoilFluxes (bounds, num_urbanl, filter_urbanl, & h2osoi_ice => waterstatebulk_inst%h2osoi_ice_col , & ! Input: [real(r8) (:,:) ] ice lens (kg/m2) (new) h2osoi_liq => waterstatebulk_inst%h2osoi_liq_col , & ! Input: [real(r8) (:,:) ] liquid water (kg/m2) (new) sabg_soil => solarabs_inst%sabg_soil_patch , & ! Input: [real(r8) (:) ] solar radiation absorbed by soil (W/m**2) + sabg_nvp => solarabs_inst%sabg_nvp_patch , & ! [PORTED by Hui Tang: exposed-NVP moss surface solar (W/m2)] sabg_snow => solarabs_inst%sabg_snow_patch , & ! Input: [real(r8) (:) ] solar radiation absorbed by snow (W/m**2) sabg => solarabs_inst%sabg_patch , & ! Input: [real(r8) (:) ] solar radiation absorbed by ground (W/m**2) + ! [PORTED by Hui Tang: NVP errsoi fix - solar by layer and NVP sensible heat] + sabg_lyr => solarabs_inst%sabg_lyr_patch , & ! Input: [real(r8) (:,:) ] solar radiation absorbed per snow/soil layer (W/m**2) + eflx_sh_nvp => energyflux_inst%eflx_sh_nvp_patch , & ! Input: [real(r8) (:) ] sensible heat flux from NVP (W/m**2) [+ to atm] emg => temperature_inst%emg_col , & ! Input: [real(r8) (:) ] ground emissivity ! emv => temperature_inst%emv_patch , & ! Input: [real(r8) (:) ] vegetation emissivity @@ -134,7 +145,9 @@ subroutine SoilFluxes (bounds, num_urbanl, filter_urbanl, & qflx_soliddew_to_top_layer => waterfluxbulk_inst%qflx_soliddew_to_top_layer_patch , & ! Output: [real(r8) (:) ] rate of solid water deposited on top soil or snow layer (frost) (mm H2O /s) [+] qflx_ev_snow => waterfluxbulk_inst%qflx_ev_snow_patch , & ! In/Out: [real(r8) (:) ] evaporation flux from snow (mm H2O/s) [+ to atm] qflx_ev_soil => waterfluxbulk_inst%qflx_ev_soil_patch , & ! In/Out: [real(r8) (:) ] evaporation flux from soil (mm H2O/s) [+ to atm] - qflx_ev_h2osfc => waterfluxbulk_inst%qflx_ev_h2osfc_patch , & ! In/Out: [real(r8) (:) ] evaporation flux from soil (mm H2O/s) [+ to atm] + qflx_ev_h2osfc => waterfluxbulk_inst%qflx_ev_h2osfc_patch , & ! In/Out: [real(r8) (:) ] evaporation flux from h2osfc (mm H2O/s) [+ to atm] + ! [PORTED by Hui Tang: NVP evaporation flux linearization correction] + qflx_ev_nvp => waterfluxbulk_inst%qflx_ev_nvp_patch , & ! In/Out: [real(r8) (:) ] evaporation flux from NVP (mm H2O/s) [+ to atm] eflx_sh_grnd => energyflux_inst%eflx_sh_grnd_patch , & ! Output: [real(r8) (:) ] sensible heat flux from ground (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] @@ -173,11 +186,36 @@ subroutine SoilFluxes (bounds, num_urbanl, filter_urbanl, & ! flux corrections if (col%snl(c) < 0) then - t_grnd0(c) = frac_sno_eff(c) * tssbef(c,col%snl(c)+1) & - + (1 - frac_sno_eff(c) - frac_h2osfc(c)) * tssbef(c,1) & - + frac_h2osfc(c) * t_h2osfc_bef(c) + ! [PORTED by Hui Tang: Phase 1c RESTORE (2026-06-11) — NVP-weighted t_grnd0 for snl<0, + ! mirroring the BiogeophysPreFluxCalcsMod snl<0 restore. tinc = t_grnd - t_grnd0 must use + ! the NVP-weighted blend on both sides so the LW linearization emg*sb*t_grnd0^3*4*tinc in + ! eflx_soil_grnd matches the solve (which now applies the NVP surface flux at j=0).] + if (use_nvp .and. col%nvp_layer_active(c)) then + frac_nvp_eff = min(1._r8 - frac_h2osfc(c) - frac_sno_eff(c), & + max(0._r8, col%frac_nvp(c) - frac_sno_eff(c))) + frac_soil = max(0._r8, 1._r8 - frac_sno_eff(c) - frac_h2osfc(c) - frac_nvp_eff) + t_grnd0(c) = frac_sno_eff(c) * tssbef(c,col%snl(c)+1) & + + frac_nvp_eff * tssbef(c,0) & + + frac_soil * tssbef(c,1) & + + frac_h2osfc(c) * t_h2osfc_bef(c) + else + t_grnd0(c) = frac_sno_eff(c) * tssbef(c,col%snl(c)+1) & + + (1 - frac_sno_eff(c) - frac_h2osfc(c)) * tssbef(c,1) & + + frac_h2osfc(c) * t_h2osfc_bef(c) + end if else - t_grnd0(c) = (1 - frac_h2osfc(c)) * tssbef(c,1) + frac_h2osfc(c) * t_h2osfc_bef(c) + ! [PORTED by Hui Tang: include NVP layer temperature in t_grnd0 for snl==0 NVP columns. + ! Mirrors BiogeophysPreFluxCalcsMod snl==0 branch so tinc = t_grnd - t_grnd0 is consistent.] + if (use_nvp .and. col%nvp_layer_active(c)) then + frac_nvp_eff = min(1._r8 - frac_h2osfc(c) - frac_sno_eff(c), & + max(0._r8, col%frac_nvp(c) - frac_sno_eff(c))) + frac_soil = max(0._r8, 1._r8 - frac_sno_eff(c) - frac_h2osfc(c) - frac_nvp_eff) + t_grnd0(c) = frac_nvp_eff * tssbef(c,0) & + + frac_soil * tssbef(c,1) & + + frac_h2osfc(c) * t_h2osfc_bef(c) + else + t_grnd0(c) = (1 - frac_h2osfc(c)) * tssbef(c,1) + frac_h2osfc(c) * t_h2osfc_bef(c) + end if endif tinc(c) = t_grnd(c) - t_grnd0(c) @@ -197,11 +235,57 @@ subroutine SoilFluxes (bounds, num_urbanl, filter_urbanl, & if (lun%urbpoi(l)) then qflx_ev_soil(p) = 0._r8 qflx_ev_h2osfc(p) = 0._r8 + qflx_ev_nvp(p) = 0._r8 qflx_ev_snow(p) = qflx_evap_soi(p) else + ! [PORTED by Hui Tang: NaN diagnostic — identify which term makes qflx_ev_snow NaN] + if ((qflx_ev_snow(p) /= qflx_ev_snow(p)) .or. & + (tinc(c)*cgrndl(p) /= tinc(c)*cgrndl(p))) then + write(iulog,*) "NaN DIAGNOSTIC SoilFluxesMod: before qflx_ev_snow linearization" + write(iulog,*) " p, c = ", p, c + write(iulog,*) " qflx_ev_snow(p) = ", qflx_ev_snow(p) + write(iulog,*) " tinc(c) = ", tinc(c) + write(iulog,*) " cgrndl(p) = ", cgrndl(p) + write(iulog,*) " tinc*cgrndl = ", tinc(c)*cgrndl(p) + write(iulog,*) " t_grnd(c) = ", t_grnd(c) + write(iulog,*) " t_grnd0(c) = ", t_grnd0(c) + write(iulog,*) " tssbef(c,snl+1) = ", tssbef(c,col%snl(c)+1) + write(iulog,*) " frac_sno_eff(c) = ", frac_sno_eff(c) + !call endrun(subgrid_index=p, subgrid_level=subgrid_level_patch, & + ! msg="NaN in qflx_ev_snow or tinc*cgrndl in SoilFluxesMod") + end if qflx_ev_snow(p) = qflx_ev_snow(p) + tinc(c)*cgrndl(p) qflx_ev_soil(p) = qflx_ev_soil(p) + tinc(c)*cgrndl(p) qflx_ev_h2osfc(p) = qflx_ev_h2osfc(p) + tinc(c)*cgrndl(p) + ! [PORTED by Hui Tang: apply linearization correction to NVP evaporation diagnostic] + ! Skip when NVP is fully buried (frac_nvp_eff <= 0): qflx_ev_nvp was zeroed in + ! BareGroundFluxesMod/CanopyFluxesMod and must remain zero to avoid a water + ! balance error (non-zero qflx_ev_nvp_col with no corresponding water removal). + ! [PORTED by Hui Tang: gate on exposed NVP fraction instead of the binary snl<-1, so + ! partial snow cover keeps the correction wherever NVP is still exposed. frac_nvp_eff + ! (frac_sno_eff based, matching this module) is computed locally since it is not yet set.] + frac_nvp_eff = min(1._r8 - frac_h2osfc(c) - frac_sno_eff(c), max(0._r8, & + col%frac_nvp(c) - frac_sno_eff(c))) + if (use_nvp .and. frac_nvp_eff <= 0._r8) then + qflx_ev_nvp(p) = 0._r8 + else + ! [PORTED by Hui Tang: linearize qflx_ev_nvp with the NVP layer's OWN + ! temperature increment instead of the bulk tinc. tinc = t_grnd(post, NVP-weighted) + ! - t_grnd0(pre, soil-only) conflates the temporal increment with a soil-vs-NVP basis + ! difference (~frac_nvp_eff*(t_nvp-t_soil)); for the thin, thermally-decoupled moss + ! that spurious term is several K and can flip qflx_ev_nvp negative (unphysical dew in + ! summer). When NVP is active (jbot_sno=-1) layer 0 IS the NVP layer for ALL snow + ! states (snow bottoms at j=-1, not 0), so t_soisno(c,0)/tssbef(c,0) are the NVP + ! post/pre-solve temperatures (t_nvp_col = t_soisno(c,0), SoilTemperatureMod:597). + ! cgrndl (bulk raiw*dqgdT) is retained — only the increment is corrected. Non-NVP + ! columns keep the standard bulk tinc correction.] + + ! The correct correction uses the NVP layer's own temperature increment and derivative: + ! qflx_ev_nvp += (t_soisno(c,0) − tssbef(c,0)) · cgrndl_nvp, where cgrndl_nvp = raiw_nvp·hr_nvp·qsatgdT_nvp. + + qflx_ev_nvp(p) = qflx_ev_nvp(p) + (t_soisno(c,0) - tssbef(c,0))*cgrndl(p) + + end if endif end do @@ -338,17 +422,108 @@ subroutine SoilFluxes (bounds, num_urbanl, filter_urbanl, & g = patch%gridcell(p) j = col%snl(c)+1 + ! [PORTED by Hui Tang: per-surface ground-evaporation total for energy/diagnostic + ! consistency under NVP. The bulk qflx_evap_soi = -raiw*dqh differs from the + ! area-weighted sum of the per-surface fluxes that actually remove water from each + ! store (snow/soil/h2osfc/NVP), because the raiw and qg blends are by area, not by + ! conductance. Drive the latent ENERGY (eflx_lh_tot, eflx_lh_grnd, and the latent + ! term of eflx_soil_grnd) and the evaporation diagnostic (qflx_evap_tot) from this + ! single per-surface sum so the energy leaving the column matches the water removed + ! from the stores. qflx_evap_soi is left unchanged for the soil/snow water-store + ! partitioning and capping above. The four fractions sum to 1 by construction + ! (frac_nvp_eff capped at 1-frac_sno_eff-frac_h2osfc), so the implicit-solve + ! linearization increment tinc*cgrndl carried in each per-surface flux aggregates to + ! the same value already added to qflx_evap_soi. For non-NVP / urban columns this + ! reduces exactly to qflx_evap_soi, leaving those paths bit-for-bit unchanged.] + if (use_nvp .and. col%nvp_layer_active(c)) then + frac_nvp_eff = min(1._r8 - frac_h2osfc(c) - frac_sno_eff(c), max(0._r8, & + col%frac_nvp(c) - frac_sno_eff(c))) + frac_soil = max(0._r8, 1._r8 - frac_sno_eff(c) - frac_h2osfc(c) - frac_nvp_eff) + qflx_evap_grnd_eff = frac_sno_eff(c)*qflx_ev_snow(p) + frac_h2osfc(c)*qflx_ev_h2osfc(p) & + + frac_nvp_eff *qflx_ev_nvp(p) + frac_soil *qflx_ev_soil(p) + else + qflx_evap_grnd_eff = qflx_evap_soi(p) + end if + ! Ground heat flux - + if (.not. lun%urbpoi(l)) then - lw_grnd=(frac_sno_eff(c)*tssbef(c,col%snl(c)+1)**4 & - +(1._r8-frac_sno_eff(c)-frac_h2osfc(c))*tssbef(c,1)**4 & - +frac_h2osfc(c)*t_h2osfc_bef(c)**4) + ! [PORTED by Hui Tang: fix lw_grnd for NVP — area-weighted LW emission including NVP] + ! Standard formula uses frac_sno_eff/bare-soil/h2osfc fractions summing to 1. + ! When NVP is active (snl=0 or snl<0), NVP occupies frac_nvp_eff of the non-snow, + ! non-water ground and emits LW from tssbef(c,0). Four fractions sum to 1: + ! snow (frac_sno_eff) + NVP (frac_nvp_eff) + bare soil + surface water (frac_h2osfc) + ! When snl=0: frac_sno_eff=0 so the snow term vanishes and the formula reduces to + ! three terms (NVP + bare soil + water). + if (use_nvp .and. col%nvp_layer_active(c)) then + ! [PORTED by Hui Tang: re-wired frac_nvp_eff — snow buries NVP (frac_nvp - frac_sno_eff), cap = 1 - frac_h2osfc - frac_sno_eff] + frac_nvp_eff = min(1._r8 - frac_h2osfc(c) - frac_sno_eff(c), max(0._r8, col%frac_nvp(c) - frac_sno_eff(c))) + lw_grnd = frac_sno_eff(c) * tssbef(c,col%snl(c)+1)**4 & + + frac_nvp_eff * tssbef(c,0)**4 & + + (1._r8 - frac_sno_eff(c) - frac_nvp_eff - frac_h2osfc(c)) * tssbef(c,1)**4 & + + frac_h2osfc(c) * t_h2osfc_bef(c)**4 + else + lw_grnd=(frac_sno_eff(c)*tssbef(c,col%snl(c)+1)**4 & + +(1._r8-frac_sno_eff(c)-frac_h2osfc(c))*tssbef(c,1)**4 & + +frac_h2osfc(c)*t_h2osfc_bef(c)**4) + end if + - eflx_soil_grnd(p) = ((1._r8- frac_sno_eff(c))*sabg_soil(p) + frac_sno_eff(c)*sabg_snow(p)) + dlrad(p) & + if (use_nvp .and. col%nvp_layer_active(c)) then + frac_nvp_eff = min(1._r8 - frac_sno_eff(c), max(0._r8, col%frac_nvp(c) - frac_sno_eff(c))) + eflx_soil_grnd(p) = ((1._r8- frac_sno_eff(c))*sabg_soil(p) & + + (frac_nvp_eff/col%frac_nvp(c))*sabg_nvp(p) & + + frac_sno_eff(c)*sabg_snow(p)) + dlrad(p) & + + (1-frac_veg_nosno(p))*emg(c)*forc_lwrad(c) & + - emg(c)*sb*lw_grnd - emg(c)*sb*t_grnd0(c)**3*(4._r8*tinc(c)) & + - (eflx_sh_grnd(p)+qflx_evap_grnd_eff*htvp(c)) + + else + eflx_soil_grnd(p) = ((1._r8- frac_sno_eff(c))*sabg_soil(p) + frac_sno_eff(c)*sabg_snow(p)) + dlrad(p) & + (1-frac_veg_nosno(p))*emg(c)*forc_lwrad(c) & - emg(c)*sb*lw_grnd - emg(c)*sb*t_grnd0(c)**3*(4._r8*tinc(c)) & - - (eflx_sh_grnd(p)+qflx_evap_soi(p)*htvp(c)) + - (eflx_sh_grnd(p)+qflx_evap_grnd_eff*htvp(c)) ! [PORTED by Hui Tang: per-surface latent term] + ! [PORTED by Hui Tang: NVP solar absorption in eflx_soil_grnd] + ! SurfaceRadiationMod removes sabg_lyr(p,0) from sabg_soil (snl=0: line 781; + ! snl<0: sabg_soil=sabg_lyr(p,1) only); add it back so NVP absorbed solar is + ! counted as column energy input in both the exposed (snl=0) and buried (snl<0) cases. + ! NOTE: sabg_lyr(p,0) must NOT be multiplied by frac_nvp_eff. NVPBeerLawAbsorptance + ! (FatesRadiationDriveMod.F90) already includes nvp_frac in the absorptance: + ! fabd_nvp = nvp_frac * (1 - exp(-k * lai_nvp)) + ! so sabg_lyr(p,0) = fabd_nvp * trd + fabi_nvp * tri is already per unit ground area. + ! Applying frac_nvp_eff again would double-count the NVP coverage fraction. + ! [PORTED by Hui Tang (2026-06-12): add the EXPOSED-moss SURFACE solar at frac_nvp_eff + ! weight, EXACTLY matching the solve: hs_nvp carries sabg_nvp*nvp_exp*wtcol = + ! sabg_nvp*frac_nvp_eff (the surface solar injected at j=0). The BURIED-moss internal + ! absorption sabg_lyr(p,0) is part of the SNICAR sum and is therefore ALREADY inside + ! frac_sno_eff*sabg_snow above (exactly as sabg_lyr(p,1) is for soil) — re-adding it + ! would double-count. For snl==0: frac_nvp_eff=frac_nvp, sabg_lyr(p,0)=0. Must mirror + ! sabg_chk in SoilTemperatureMod (errseb/errsoi consistency invariant).] + ! [PORTED by Hui Tang (2026-06-12): sabg_nvp is per-COLUMN (fabd_nvp carries nvp_frac), so + ! the EXPOSED-moss surface solar into the column is nvp_exp*sabg_nvp = + ! (frac_nvp_eff/frac_nvp)*sabg_nvp (was frac_nvp_eff*sabg_nvp, which double-counted the + ! coverage -> offline SABG vs FGR positive residual). Matches sabg_chk and the hs_nvp deposit.] + end if + + ! [PORTED by Hui Tang: DEBUG (Bug B/C) — decompose eflx_soil_grnd for the NVP snow-covered + ! column to isolate the surface-energy-balance residual. Fires whenever any snow covers + ! the NVP layer (frac_sno_eff > 0): partial cover = spring/autumn Bug B (~-3 W/m2), full + ! cover (frac_sno_eff==1) = Bug C (~-61 W/m2 at autumn freeze-up, buried NVP). Compare + ! these ground terms with the column totals (eflx_sh_tot, eflx_lh_tot, eflx_lwrad_net) in + ! the BalanceCheck dump. Remove once both residuals are identified.] + if (use_nvp .and. col%nvp_layer_active(c) .and. frac_sno_eff(c) > 0._r8) then + write(iulog,*) '[NVP DBG SEB] nstep=', get_nstep(), ' c=', c, ' p=', p, & + ' frac_sno_eff=', frac_sno_eff(c), ' frac_h2osfc=', frac_h2osfc(c) + write(iulog,*) '[NVP DBG SEB] sw_grnd=', & + (1._r8-frac_sno_eff(c))*sabg_soil(p) + frac_sno_eff(c)*sabg_snow(p), & + ' sabg_lyr0=', sabg_lyr(p,0), ' dlrad=', dlrad(p) + write(iulog,*) '[NVP DBG SEB] lw_in=', (1-frac_veg_nosno(p))*emg(c)*forc_lwrad(c), & + ' lw_emit=', emg(c)*sb*lw_grnd, ' lw_lin=', emg(c)*sb*t_grnd0(c)**3*(4._r8*tinc(c)) + write(iulog,*) '[NVP DBG SEB] sh_grnd=', eflx_sh_grnd(p), & + ' lh_grnd=', qflx_evap_grnd_eff*htvp(c), ' eflx_soil_grnd=', eflx_soil_grnd(p) + write(iulog,*) '[NVP DBG SEB] t_grnd0=', t_grnd0(c), ' tinc=', tinc(c), & + ' tssbef0=', tssbef(c,0), ' tssbef1=', tssbef(c,1) + end if if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then eflx_soil_grnd_r(p) = eflx_soil_grnd(p) @@ -374,9 +549,11 @@ subroutine SoilFluxes (bounds, num_urbanl, filter_urbanl, & 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) + + ! [PORTED by Hui Tang: use per-surface ground-evap total (= qflx_evap_soi for non-NVP)] + qflx_evap_tot(p) = qflx_evap_veg(p) + qflx_evap_grnd_eff - eflx_lh_tot(p)= hvap*qflx_evap_veg(p) + htvp(c)*qflx_evap_soi(p) + eflx_lh_tot(p)= hvap*qflx_evap_veg(p) + htvp(c)*qflx_evap_grnd_eff if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then eflx_lh_tot_r(p)= eflx_lh_tot(p) eflx_sh_tot_r(p)= eflx_sh_tot(p) @@ -390,7 +567,7 @@ subroutine SoilFluxes (bounds, num_urbanl, filter_urbanl, & qflx_evap_can(p) = qflx_evap_veg(p) - qflx_tran_veg(p) eflx_lh_vege(p) = (qflx_evap_veg(p) - qflx_tran_veg(p)) * hvap eflx_lh_vegt(p) = qflx_tran_veg(p) * hvap - eflx_lh_grnd(p) = qflx_evap_soi(p) * htvp(c) + eflx_lh_grnd(p) = qflx_evap_grnd_eff * htvp(c) ! [PORTED by Hui Tang: per-surface latent term] end do call t_stopf('bgp2_loop_2') @@ -401,10 +578,18 @@ subroutine SoilFluxes (bounds, num_urbanl, filter_urbanl, & do fp = 1,num_nolakep p = filter_nolakep(fp) c = patch%column(p) + ! [PORTED by Hui Tang: errsoi input UNIFIED to the bulk eflx_soil_grnd for both snl==0 and + ! snl<0 (2026-06-11, snl==0 3-way refactor). Previously snl==0 used an NVP-basis + ! eflx_soil_grnd_nvp because the snl==0 solve "collapsed" the whole surface into the NVP layer + ! j=0 (single NVP surface). Now the snl==0 solve uses the 3-way split (exposed moss at j=0 + ! weight frac_nvp_eff, bare soil at j=1 weight frac_soil), so the matching errsoi is the + ! area-weighted bulk eflx_soil_grnd, whose lw_grnd / eflx_sh_grnd / qflx_evap_grnd_eff already + ! carry the NVP weighting via the NVP-weighted t_grnd. This is the same path snl<0 uses, so + ! the snow-appearance threshold is now continuous.] errsoi_patch(p) = eflx_soil_grnd(p) - xmf(c) - xmf_h2osfc(c) & - frac_h2osfc(c)*(t_h2osfc(c)-t_h2osfc_bef(c)) & *(c_h2osfc(c)/dtime) - errsoi_patch(p) = errsoi_patch(p)+eflx_h2osfc_to_snow_col(c) + errsoi_patch(p) = errsoi_patch(p)+eflx_h2osfc_to_snow_col(c) ! For urban sunwall, shadewall, and roof columns, the "soil" energy balance check ! must include the heat flux from the interior of the building. if (col%itype(c)==icol_sunwall .or. col%itype(c)==icol_shadewall .or. col%itype(c)==icol_roof) then @@ -445,6 +630,124 @@ subroutine SoilFluxes (bounds, num_urbanl, filter_urbanl, & end do end do + ! [PORTED by Hui Tang: NVP errsoi fix] + ! snl=0: j=0 is the atmospheric boundary (top BC = hs_nvp) and is skipped entirely + ! by the loops above (j>=snl+1=1 fails for j=0) → subtract full heat storage. + ! snl<0: j=0 is included in the snow loop with frac_sno_eff weight, but cv(c,0) is + ! per unit column area (unlike snow layers where cv is per unit snow area) → subtract + ! the missing (1-frac_sno_eff) fraction to account for the full column-area heat storage. + if (use_nvp) then + do fp = 1, num_nolakep + p = filter_nolakep(fp) + c = patch%column(p) + if (col%nvp_layer_active(c) .and. col%snl(c) == 0) then + ! snl=0: j=0 skipped entirely; subtract full heat storage (weight = 1.0). + errsoi_patch(p) = errsoi_patch(p) & + - (t_soisno(c,0) - tssbef(c,0)) / fact(c,0) + else if (col%nvp_layer_active(c) .and. col%snl(c) < 0) then + ! snl<0: j=0 included with frac_sno_eff; cv(c,0) is per unit column area, + ! so subtract the missing (1-frac_sno_eff) fraction. + ! [PORTED by Hui Tang: NVP under-snow errsoi correction] + errsoi_patch(p) = errsoi_patch(p) & + - (1.0_r8 - frac_sno_eff(c)) * (t_soisno(c,0) - tssbef(c,0)) / fact(c,0) + end if + end do + end if + + ! [PORTED by Hui Tang: errsoi diagnostic - decompose terms when error is large] + do fp = 1, num_nolakep + p = filter_nolakep(fp) + c = patch%column(p) + if (abs(errsoi_patch(p)) > 0.5_r8) then + heat_store_diag = 0._r8 + do j = -nlevsno+1, nlevgrnd + if (col%itype(c) /= icol_sunwall .and. col%itype(c) /= icol_shadewall & + .and. col%itype(c) /= icol_roof) then + if (j >= col%snl(c)+1 .and. j < 1) heat_store_diag = heat_store_diag + & + frac_sno_eff(c)*(t_soisno(c,j)-tssbef(c,j))/fact(c,j) + if (j >= 1) heat_store_diag = heat_store_diag + & + (t_soisno(c,j)-tssbef(c,j))/fact(c,j) + end if + end do + ! [PORTED by Hui Tang: NVP j=0 correction to heat_store_diag — mirrors errsoi fix] + ! Weight is 1.0 not frac_nvp_eff: cv(c,0) is per unit column area so + ! (t_0-tbef_0)/fact(0) is already W/m2 column area. + ! snl=0: j=0 skipped by loop (j>=1 and j<1 impossible) → add full term. + ! snl<0: j=0 included with frac_sno_eff → add missing (1-frac_sno_eff) fraction. + if (use_nvp .and. col%nvp_layer_active(c)) then + if (col%snl(c) == 0) then + heat_store_diag = heat_store_diag + & + (t_soisno(c,0) - tssbef(c,0)) / fact(c,0) + else if (col%snl(c) < 0) then + heat_store_diag = heat_store_diag + & + (1.0_r8 - frac_sno_eff(c)) * (t_soisno(c,0) - tssbef(c,0)) / fact(c,0) + end if + end if + + write(iulog,*) '[ERRSOI DBG] p=',p,' c=',c,' snl=',col%snl(c) + write(iulog,*) ' errsoi_patch =', errsoi_patch(p) + write(iulog,*) ' eflx_soil_grnd =', eflx_soil_grnd(p) + write(iulog,*) ' xmf (phase chg) =', xmf(c) + write(iulog,*) ' xmf_h2osfc =', xmf_h2osfc(c) + write(iulog,*) ' heat_store_sum =', heat_store_diag + write(iulog,*) ' eflx_h2osfc_snow =', eflx_h2osfc_to_snow_col(c) + write(iulog,*) ' frac_h2osfc_term =', & + frac_h2osfc(c)*(t_h2osfc(c)-t_h2osfc_bef(c))*(c_h2osfc(c)/dtime) + write(iulog,*) ' expected_errsoi =', & + eflx_soil_grnd(p) - xmf(c) - xmf_h2osfc(c) - heat_store_diag & + + eflx_h2osfc_to_snow_col(c) & + - frac_h2osfc(c)*(t_h2osfc(c)-t_h2osfc_bef(c))*(c_h2osfc(c)/dtime) + + ! [PORTED by Hui Tang: VERIFY-ONLY diagnostic — candidate NVP-consistent errsoi input. + ! Tests whether replacing eflx_soil_grnd's blended LW-emission + turbulent terms with the + ! NVP-specific fluxes that the temperature solve actually applied at j=0 (hs_nvp) closes + ! the energy balance. Solar (sabg_soil + sabg_lyr0) is kept as-is (already reconciled). + ! - LW emission : emg*sb*lw_grnd -> emg*sb*tssbef(c,0)**4 (lwrad_emit_nvp) + ! - LW lineariz. : t_grnd0/tinc blended -> NVP layer tssbef(c,0)/(t0-tbef0) + ! - sensible : eflx_sh_grnd (corrected) -> eflx_sh_nvp + (t0-tbef0)*cgrnds + ! - latent : qflx_evap_soi (corrected)-> qflx_ev_nvp (already tinc-corrected) + ! If errsoi_test ~ 0 across snow-free steps, promote this to the real errsoi input. + ! Pure diagnostic: changes NO physics. Remove after verification.] + if (use_nvp .and. col%nvp_layer_active(c) .and. col%snl(c) == 0) then + eflx_soil_grnd_nvp = sabg_soil(p) + sabg_lyr(p,0) + dlrad(p) & + + (1._r8 - frac_veg_nosno(p))*emg(c)*forc_lwrad(c) & + - emg(c)*sb*tssbef(c,0)**4 & + - emg(c)*sb*tssbef(c,0)**3*4._r8*(t_soisno(c,0)-tssbef(c,0)) & + - ( eflx_sh_nvp(p) + (t_soisno(c,0)-tssbef(c,0))*cgrnds(p) & + + qflx_ev_nvp(p)*htvp(c) ) + errsoi_test = eflx_soil_grnd_nvp - xmf(c) - xmf_h2osfc(c) - heat_store_diag & + + eflx_h2osfc_to_snow_col(c) & + - frac_h2osfc(c)*(t_h2osfc(c)-t_h2osfc_bef(c))*(c_h2osfc(c)/dtime) + write(iulog,*) ' [ERRSOI NVP TEST] nstep=', get_nstep(), ' c=', c, ' p=', p, & + ' eflx_soil_grnd_nvp=', eflx_soil_grnd_nvp, & + ' errsoi_test=', errsoi_test, ' (cur errsoi=', errsoi_patch(p), ')' + end if + + ! [PORTED by Hui Tang: DEBUG — per-layer heat-storage decomposition to locate which + ! layer carries the errsoi residual (esp. June thin-snow melt-out where xmf=0 but + ! heat_store mismatches eflx_soil_grnd). 'wgt' is the weight actually applied in the + ! errsoi sum: snow layers (j<0) use frac_sno_eff, NVP j=0 and soil (j>=1) use 1.0 + ! (cv per column area). 'term' = wgt*(t-tbef)/fact. Remove after fix.] + if (use_nvp .and. col%nvp_layer_active(c)) then + write(iulog,*) ' [ERRSOI LYR] frac_sno_eff=', frac_sno_eff(c) + do j = col%snl(c)+1, nlevgrnd + if (j >= 1) then + wgt = 1.0_r8 + else if (j == 0) then + wgt = 1.0_r8 ! NVP j=0: full column-area weight (loop frac_sno_eff + correction) + else + wgt = frac_sno_eff(c) ! snow layer: per-snow-area cv + end if + if (abs(wgt*(t_soisno(c,j)-tssbef(c,j))/fact(c,j)) > 1.0_r8 .or. j <= 1) then + write(iulog,*) ' [ERRSOI LYR] j=',j,' dT=',t_soisno(c,j)-tssbef(c,j), & + ' fact=',fact(c,j),' wgt=',wgt,' term=', & + wgt*(t_soisno(c,j)-tssbef(c,j))/fact(c,j) + end if + end do + end if + end if + end do + call t_stopf('bgp2_loop_3') call t_startf('bgp2_loop_4') @@ -462,9 +765,22 @@ subroutine SoilFluxes (bounds, num_urbanl, filter_urbanl, & j = col%snl(c)+1 if (.not. lun%urbpoi(l)) then - lw_grnd=(frac_sno_eff(c)*tssbef(c,col%snl(c)+1)**4 & - +(1._r8-frac_sno_eff(c)-frac_h2osfc(c))*tssbef(c,1)**4 & - +frac_h2osfc(c)*t_h2osfc_bef(c)**4) + ! [PORTED by Hui Tang: NVP-aware lw_grnd for eflx_lwrad_out — mirror the eflx_soil_grnd + ! lw_grnd (lines ~387-390). Without this, eflx_lwrad_out emits the NVP fraction at soil + ! temperature tssbef(c,1) while eflx_soil_grnd emits it at NVP temperature tssbef(c,0), + ! leaving errseb = -emg*sb*frac_nvp_eff*(tssbef(c,1)**4 - tssbef(c,0)**4) (~-3 W/m2 at + ! partial snow cover). At full snow frac_nvp_eff=0 and this reduces to the standard form.] + if (use_nvp .and. col%nvp_layer_active(c)) then + frac_nvp_eff = min(1._r8 - frac_h2osfc(c) - frac_sno_eff(c), max(0._r8, col%frac_nvp(c) - frac_sno_eff(c))) + lw_grnd = frac_sno_eff(c) * tssbef(c,col%snl(c)+1)**4 & + + frac_nvp_eff * tssbef(c,0)**4 & + + (1._r8 - frac_sno_eff(c) - frac_nvp_eff - frac_h2osfc(c)) * tssbef(c,1)**4 & + + frac_h2osfc(c) * t_h2osfc_bef(c)**4 + else + lw_grnd=(frac_sno_eff(c)*tssbef(c,col%snl(c)+1)**4 & + +(1._r8-frac_sno_eff(c)-frac_h2osfc(c))*tssbef(c,1)**4 & + +frac_h2osfc(c)*t_h2osfc_bef(c)**4) + end if eflx_lwrad_out(p) = ulrad(p) & + (1-frac_veg_nosno(p))*(1.-emg(c))*forc_lwrad(c) & diff --git a/src/biogeophys/SoilHydrologyMod.F90 b/src/biogeophys/SoilHydrologyMod.F90 index 753ddc59fc..26acafe349 100644 --- a/src/biogeophys/SoilHydrologyMod.F90 +++ b/src/biogeophys/SoilHydrologyMod.F90 @@ -9,7 +9,8 @@ module SoilHydrologyMod use shr_log_mod , only : errMsg => shr_log_errMsg use abortutils , only : endrun use decompMod , only : bounds_type, subgrid_level_column - use clm_varctl , only : iulog, use_vichydro + ! [PORTED by Hui Tang: add use_nvp for NVP water infiltration] + use clm_varctl , only : iulog, use_vichydro, use_nvp use clm_varcon , only : ispval use clm_varcon , only : denh2o, denice, rpi use clm_varcon , only : pondmx_urban @@ -301,6 +302,8 @@ subroutine SetQflxInputs(bounds, num_hydrologyc, filter_hydrologyc, & ! !DESCRIPTION: ! Set various input fluxes of water ! + ! !USES: + use clm_time_manager, only : get_nstep ! [PORTED by Hui Tang: NVP rain-partition diagnostic] ! !ARGUMENTS: type(bounds_type) , intent(in) :: bounds integer , intent(in) :: num_hydrologyc ! number of column soil points in column filter @@ -310,8 +313,11 @@ subroutine SetQflxInputs(bounds, num_hydrologyc, filter_hydrologyc, & ! ! !LOCAL VARIABLES: integer :: fc, c - real(r8) :: qflx_evap ! evaporation for this column - real(r8) :: fsno ! copy of frac_sno + real(r8) :: qflx_evap ! evaporation for this column + real(r8) :: fsno ! copy of frac_sno + ! [PORTED by Hui Tang: NVP water infiltration] + real(r8) :: frac_nvp_eff ! effective NVP area fraction (not covered by h2osfc) [-] + real(r8) :: frac_nvp_eff_soil ! [PORTED by Hui Tang: DEBUG] saved soil-input-partition frac_nvp_eff (line ~365, no snow term) character(len=*), parameter :: subname = 'SetQflxInputs' !----------------------------------------------------------------------- @@ -341,6 +347,7 @@ subroutine SetQflxInputs(bounds, num_hydrologyc, filter_hydrologyc, & ! ------------------------------------------------------------------------ ! Partition surface inputs between soil and h2osfc + ! [PORTED by Hui Tang: also partition out the NVP fraction] ! ------------------------------------------------------------------------ if (snl(c) >= 0) then @@ -352,13 +359,54 @@ subroutine SetQflxInputs(bounds, num_hydrologyc, filter_hydrologyc, & qflx_evap=qflx_ev_soil(c) endif - qflx_in_soil(c) = (1._r8 - frac_h2osfc(c)) * (qflx_top_soil(c) - qflx_sat_excess_surf(c)) + ! [PORTED by Hui Tang: NVP area fraction — use real frac_nvp whenever NVP layer is + ! active (nvp_layer_active), including when buried under multiple snow layers. + ! When snow is present, qflx_top_soil includes qflx_snow_percolation(c,-1) which + ! already enters NVP via UpdateState_SnowPercolation; applying frac_nvp here prevents + ! that flux from also reaching qflx_in_soil for the NVP-covered fraction.] + if (use_nvp .and. col%nvp_layer_active(c)) then + frac_nvp_eff = min(col%frac_nvp(c), max(0._r8, 1._r8 - frac_h2osfc(c))) + else + frac_nvp_eff = 0._r8 + end if + frac_nvp_eff_soil = frac_nvp_eff ! [PORTED by Hui Tang: DEBUG] capture before the evap-block recompute + + ! Soil receives the non-h2osfc, non-NVP fraction; NVP handled by NVPWaterBalance_Column + qflx_in_soil(c) = (1._r8 - frac_h2osfc(c) - frac_nvp_eff) * & + (qflx_top_soil(c) - qflx_sat_excess_surf(c)) qflx_top_soil_to_h2osfc(c) = frac_h2osfc(c) * (qflx_top_soil(c) - qflx_sat_excess_surf(c)) - ! remove evaporation (snow treated in SnowHydrology) - qflx_in_soil(c) = qflx_in_soil(c) - (1.0_r8 - fsno - frac_h2osfc(c))*qflx_evap + if (use_nvp .and. col%nvp_layer_active(c)) then + if (snl(c) >= -1) then + ! [PORTED by Hui Tang: re-wired frac_nvp_eff — snow buries NVP (frac_nvp - fsno), cap = 1 - frac_h2osfc - fsno] + frac_nvp_eff = min(1._r8 - frac_h2osfc(c) - fsno, max(0._r8, col%frac_nvp(c) - fsno)) + else + frac_nvp_eff = min(col%frac_nvp(c), max(0._r8, 1._r8 - frac_h2osfc(c))) + end if + else + frac_nvp_eff = 0._r8 + end if + + ! remove evaporation from bare-soil fraction only (snow and NVP evap handled separately) + qflx_in_soil(c) = qflx_in_soil(c) - max(0._r8, 1.0_r8 - fsno - frac_h2osfc(c) - frac_nvp_eff)*qflx_evap qflx_top_soil_to_h2osfc(c) = qflx_top_soil_to_h2osfc(c) - frac_h2osfc(c) * qflx_ev_h2osfc(c) + ! [PORTED by Hui Tang: DEBUG (errh2o rain-partition) — the soil-input partition (~line 365) + ! uses frac_nvp_eff WITHOUT a snow term, while the moss only receives rain via qflx_nvp_infl + ! (frac_sno_eff-subtracted) or via snow percolation. 'withheld_for_nvp' is the top water + ! deducted from qflx_in_soil for the NVP fraction; compare it against what the moss actually + ! gains ([NVP DBG] after NVPWaterBal: qflx_nvp_infl/Δliq0, + snow percolation into j=0). Any + ! gap is the rain-on-snow leak. Guard: NVP active + water on top. Remove after diagnosis.] + if (use_nvp .and. col%nvp_layer_active(c) .and. qflx_top_soil(c) > 1.e-8_r8) then + write(iulog,*) '[NVP DBG QIN] nstep=', get_nstep(), ' c=', c, ' snl=', col%snl(c), & + ' fsno=', fsno, ' frac_h2osfc=', frac_h2osfc(c), ' frac_nvp=', col%frac_nvp(c) + write(iulog,*) '[NVP DBG QIN] frac_nvp_eff_soil(365)=', frac_nvp_eff_soil, & + ' frac_nvp_eff_evap(378)=', frac_nvp_eff + write(iulog,*) '[NVP DBG QIN] qflx_top_soil=', qflx_top_soil(c), & + ' qflx_in_soil=', qflx_in_soil(c), & + ' withheld_for_nvp=', frac_nvp_eff_soil*(qflx_top_soil(c)-qflx_sat_excess_surf(c)) + end if + end do end associate @@ -444,12 +492,20 @@ subroutine Infiltration(bounds, num_hydrologyc, filter_hydrologyc, & associate( & qflx_infl => waterfluxbulk_inst%qflx_infl_col , & ! Output: [real(r8) (:) ] infiltration (mm H2O /s) qflx_in_soil_limited => waterfluxbulk_inst%qflx_in_soil_limited_col , & ! Input: [real(r8) (:) ] surface input to soil, limited by max infiltration rate (mm H2O /s) - qflx_h2osfc_drain => waterfluxbulk_inst%qflx_h2osfc_drain_col & ! Input: [real(r8) (:) ] bottom drainage from h2osfc (mm H2O /s) + qflx_h2osfc_drain => waterfluxbulk_inst%qflx_h2osfc_drain_col , & ! Input: [real(r8) (:) ] bottom drainage from h2osfc (mm H2O /s) + ! [PORTED by Hui Tang: NVP drainage to soil layer 1 enters total infiltration] + qflx_nvp_drain_col => waterfluxbulk_inst%qflx_nvp_drain_col & ! Input: [real(r8) (:) ] drainage from NVP layer 0 to soil layer 1 (mm H2O /s) ) do fc = 1, num_hydrologyc c = filter_hydrologyc(fc) - qflx_infl(c) = qflx_in_soil_limited(c) + qflx_h2osfc_drain(c) + ! [PORTED by Hui Tang: add NVP drainage to total infiltration into soil layer 1; + ! guard with use_nvp to avoid NaN when qflx_nvp_drain_col is uninitialised] + if (use_nvp) then + qflx_infl(c) = qflx_in_soil_limited(c) + qflx_h2osfc_drain(c) + qflx_nvp_drain_col(c) + else + qflx_infl(c) = qflx_in_soil_limited(c) + qflx_h2osfc_drain(c) + end if end do end associate @@ -2035,13 +2091,13 @@ subroutine SubsurfaceLateralFlow(bounds, & ! Calculate subsurface drainage ! ! !USES: - use clm_time_manager , only : get_step_size + use clm_time_manager , only : get_step_size, get_nstep ! [NVP DBG] use clm_varpar , only : nlevsoi, nlevgrnd, nlayer, nlayert - use clm_varctl , only : nhillslope + use clm_varctl , only : nhillslope, iulog, use_nvp ! [NVP DBG] use clm_varcon , only : pondmx, watmin,rpi, secspday use column_varcon , only : icol_road_perv use abortutils , only : endrun - use GridcellType , only : grc + use GridcellType , only : grc use landunit_varcon , only : istsoil, istcrop use clm_varctl , only : use_hillslope_routing @@ -2483,6 +2539,12 @@ subroutine SubsurfaceLateralFlow(bounds, & qflx_ice_runoff_xs(c) = xs1(c) / dtime end do + ! [NVP DBG: print soil liq j=1..6 before watmin floor in SubsurfaceLateralFlow] + if (use_nvp .and. get_nstep() <= 3) then + write(iulog,'(a,i0,6(1x,es11.4))') '[NVP DBG] SubLatFlow before watmin nstep=', get_nstep(), & + (h2osoi_liq(bounds%begc,j), j=1,6) + end if + ! Limit h2osoi_liq to be greater than or equal to watmin. ! Get water needed to bring h2osoi_liq equal watmin from lower layer. ! If insufficient water in soil layers, get from aquifer water @@ -2493,7 +2555,7 @@ subroutine SubsurfaceLateralFlow(bounds, & if (h2osoi_liq(c,j) < watmin) then xs(c) = watmin - h2osoi_liq(c,j) ! deepen water table if water is passed from below zwt layer - if(j == jwt(c)) then + if(j == jwt(c)) then zwt(c) = zwt(c) + xs(c)/eff_porosity(c,j)/1000._r8 endif else @@ -2529,12 +2591,18 @@ subroutine SubsurfaceLateralFlow(bounds, & ! Needed in case there is no water to be found h2osoi_liq(c,j) = h2osoi_liq(c,j) + xs(c) ! Instead of removing water from aquifer where it eventually - ! shows up as excess drainage to the ocean, take it back out of + ! shows up as excess drainage to the ocean, take it back out of ! drainage qflx_rsub_sat(c) = qflx_rsub_sat(c) - xs(c)/dtime end do + ! [NVP DBG: print soil liq j=1..6 after watmin floor — confirms this is the 0.01/layer source] + if (use_nvp .and. get_nstep() <= 3) then + write(iulog,'(a,i0,6(1x,es11.4))') '[NVP DBG] SubLatFlow after watmin nstep=', get_nstep(), & + (h2osoi_liq(bounds%begc,j), j=1,6) + end if + do fc = 1, num_hydrologyc c = filter_hydrologyc(fc) diff --git a/src/biogeophys/SoilTemperatureMod.F90 b/src/biogeophys/SoilTemperatureMod.F90 index 367da626e6..2de7a8b7ab 100644 --- a/src/biogeophys/SoilTemperatureMod.F90 +++ b/src/biogeophys/SoilTemperatureMod.F90 @@ -13,7 +13,8 @@ module SoilTemperatureMod use abortutils , only : endrun use shr_log_mod , only : errMsg => shr_log_errMsg use perf_mod , only : t_startf, t_stopf - use clm_varctl , only : iulog + ! [PORTED by Hui Tang: add use_nvp for nvp (moss/lichen) surface temperature update] + use clm_varctl , only : iulog, use_nvp use UrbanParamsType , only : urbanparams_type use UrbanTimeVarType , only : urbantv_type use atm2lndType , only : atm2lnd_type @@ -89,8 +90,10 @@ module SoilTemperatureMod contains !----------------------------------------------------------------------- + ! [PORTED by Hui Tang: added num_nvpc/filter_nvpc args for NVP-active column processing] subroutine SoilTemperature(bounds, num_urbanl, filter_urbanl, num_urbanc, filter_urbanc, & num_nolakep, filter_nolakep, num_nolakec, filter_nolakec, & + num_nvpc, filter_nvpc, & atm2lnd_inst, urbanparams_inst, canopystate_inst, waterstatebulk_inst, waterdiagnosticbulk_inst, waterfluxbulk_inst,& solarabs_inst, soilstate_inst, energyflux_inst, temperature_inst, urbantv_inst) ! @@ -116,7 +119,8 @@ subroutine SoilTemperature(bounds, num_urbanl, filter_urbanl, num_urbanc, filter ! !USES: use clm_time_manager , only : get_step_size_real use clm_varpar , only : nlevsno, nlevgrnd, nlevurb, nlevmaxurbgrnd - use clm_varctl , only : iulog, use_excess_ice + ! [PORTED by Hui Tang: add use_nvp for nvp (moss/lichen) surface temperature update] + use clm_varctl , only : iulog, use_excess_ice, use_nvp use clm_varcon , only : cnfac, cpice, cpliq, denh2o, denice use landunit_varcon , only : istsoil, istcrop use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall, icol_road_perv, icol_road_imperv @@ -130,6 +134,8 @@ subroutine SoilTemperature(bounds, num_urbanl, filter_urbanl, num_urbanc, filter integer , intent(in) :: filter_nolakep(:) ! patch filter for non-lake points integer , intent(in) :: num_nolakec ! number of column non-lake points in column filter integer , intent(in) :: filter_nolakec(:) ! column filter for non-lake points + integer , intent(in) :: num_nvpc ! [PORTED by Hui Tang: number of NVP-active columns] + integer , intent(in) :: filter_nvpc(:) ! [PORTED by Hui Tang: NVP-active column filter] integer , intent(in) :: num_urbanl ! number of urban landunits in clump integer , intent(in) :: filter_urbanl(:) ! urban landunit filter integer , intent(in) :: num_urbanc ! number of urban columns in clump @@ -159,6 +165,7 @@ subroutine SoilTemperature(bounds, num_urbanl, filter_urbanl, num_urbanc, filter real(r8) :: dzm ! used in computing tridiagonal matrix real(r8) :: dzp ! used in computing tridiagonal matrix real(r8) :: sabg_lyr_col(bounds%begc:bounds%endc,-nlevsno+1:1) ! absorbed solar radiation (col,lyr) [W/m2] + real(r8) :: sabg_soil_col(bounds%begc:bounds%endc) ! [PORTED by Hui Tang: col-level bare-soil surface solar (sabg_soil) for the snl<0 (1-fse)-weighted soil-solar deposit] real(r8) :: eflx_gnet_top ! net energy flux into surface layer, patch-level [W/m2] real(r8) :: hs_top(bounds%begc:bounds%endc) ! net energy flux into surface layer (col) [W/m2] logical :: cool_on(bounds%begl:bounds%endl) ! is urban air conditioning on? @@ -173,8 +180,11 @@ subroutine SoilTemperature(bounds, num_urbanl, filter_urbanl, num_urbanc, filter real(r8) :: dhsdT(bounds%begc:bounds%endc) ! temperature derivative of "hs" [col] real(r8) :: hs_soil(bounds%begc:bounds%endc) ! heat flux on soil [W/m2] real(r8) :: hs_top_snow(bounds%begc:bounds%endc) ! heat flux on top snow layer [W/m2] + real(r8) :: hs_nvp(bounds%begc:bounds%endc) ! [PORTED by Hui Tang: surface heat flux at NVP layer 0] [W/m2] real(r8) :: hs_h2osfc(bounds%begc:bounds%endc) ! heat flux on standing water [W/m2] integer :: jbot(bounds%begc:bounds%endc) ! bottom level at each column + ! [PORTED by Hui Tang: NVP effective fraction for t_grnd blend] + real(r8) :: frac_nvp_eff ! NVP fraction not covered by snow or h2osfc [-] real(r8) :: dz_0(bounds%begc:bounds%endc,-nlevsno+1:nlevmaxurbgrnd) ! original layer thickness [m] real(r8) :: z_0(bounds%begc:bounds%endc,-nlevsno+1:nlevmaxurbgrnd) ! original layer depth [m] real(r8) :: zi_0(bounds%begc:bounds%endc,-nlevsno+0:nlevmaxurbgrnd) ! original layer interface level bellow layer "z" [m] @@ -237,11 +247,15 @@ subroutine SoilTemperature(bounds, num_urbanl, filter_urbanl, num_urbanc, filter eflx_urban_ac_col => energyflux_inst%eflx_urban_ac_col , & ! Output: [real(r8) (:) ] urban air conditioning flux (W/m**2) eflx_urban_heat_col => energyflux_inst%eflx_urban_heat_col , & ! Output: [real(r8) (:) ] urban heating flux (W/m**2) - emg => temperature_inst%emg_col , & ! Input: [real(r8) (:) ] ground emissivity - tssbef => temperature_inst%t_ssbef_col , & ! Input: [real(r8) (:,:) ] temperature at previous time step [K] - t_h2osfc => temperature_inst%t_h2osfc_col , & ! Output: [real(r8) (:) ] surface water temperature - t_soisno => temperature_inst%t_soisno_col , & ! Output: [real(r8) (:,:) ] soil temperature [K] - t_grnd => temperature_inst%t_grnd_col , & ! Output: [real(r8) (:) ] ground surface temperature [K] + emg => temperature_inst%emg_col , & ! Input: [real(r8) (:) ] ground emissivity + tssbef => temperature_inst%t_ssbef_col , & ! Input: [real(r8) (:,:) ] temperature at previous time step [K] + t_h2osfc => temperature_inst%t_h2osfc_col , & ! Output: [real(r8) (:) ] surface water temperature + t_soisno => temperature_inst%t_soisno_col , & ! Output: [real(r8) (:,:) ] soil temperature [K] + t_grnd => temperature_inst%t_grnd_col , & ! Output: [real(r8) (:) ] ground surface temperature [K] + ! [PORTED by Hui Tang: nvp (moss/lichen) surface temperature at layer 0] + t_nvp_col => temperature_inst%t_nvp_col , & ! Output: [real(r8) (:) ] nvp (moss/lichen) temperature [K] + ! [PORTED by Hui Tang: jbot_sno defines real bottom of snow (0=no NVP, -1=NVP at layer 0)] + jbot_sno => col%jbot_sno , & ! Input: [integer (:) ] bottom snow layer index (0 or -1) t_building => temperature_inst%t_building_lun , & ! Output: [real(r8) (:) ] internal building air temperature [K] t_roof_inner => temperature_inst%t_roof_inner_lun , & ! Input: [real(r8) (:) ] roof inside surface temperature [K] t_sunw_inner => temperature_inst%t_sunw_inner_lun , & ! Input: [real(r8) (:) ] sunwall inside surface temperature [K] @@ -271,6 +285,11 @@ subroutine SoilTemperature(bounds, num_urbanl, filter_urbanl, num_urbanc, filter do fc = 1,num_nolakec c = filter_nolakec(fc) jtop(c) = snl(c) + ! [PORTED by Hui Tang: when NVP occupies layer 0 and there is no snow, extend + ! jtop to -1 so the tridiagonal solver includes the NVP layer at tvector(c,-1)] + if (col%nvp_layer_active(c) .and. snl(c) == 0) then + jtop(c) = -1 + end if ! compute jbot if ((col%itype(c) == icol_sunwall .or. col%itype(c) == icol_shadewall & .or. col%itype(c) == icol_roof) ) then @@ -311,6 +330,7 @@ subroutine SoilTemperature(bounds, num_urbanl, filter_urbanl, num_urbanc, filter tk_h2osfc(begc:endc) = nan call SoilThermProp(bounds, num_urbanc, filter_urbanc, num_nolakec, filter_nolakec, & + num_nvpc, filter_nvpc, & tk(begc:endc, :), & cv(begc:endc, :), & tk_h2osfc(begc:endc), & @@ -322,12 +342,15 @@ subroutine SoilTemperature(bounds, num_urbanl, filter_urbanl, num_urbanc, filter call ComputeGroundHeatFluxAndDeriv(bounds, & num_nolakep, filter_nolakep, num_nolakec, filter_nolakec, & + num_nvpc, filter_nvpc, & ! [PORTED by Hui Tang: NVP column filter] hs_h2osfc( begc:endc ), & hs_top_snow( begc:endc ), & hs_soil( begc:endc ), & hs_top( begc:endc ), & + hs_nvp( begc:endc ), & dhsdT( begc:endc ), & sabg_lyr_col( begc:endc, -nlevsno+1: ), & + sabg_soil_col( begc:endc ), & ! [PORTED by Hui Tang: bare-soil surface solar for (1-fse) soil-solar deposit] atm2lnd_inst, urbanparams_inst, canopystate_inst, waterdiagnosticbulk_inst, & waterfluxbulk_inst, solarabs_inst, energyflux_inst, temperature_inst) @@ -359,14 +382,17 @@ subroutine SoilTemperature(bounds, num_urbanl, filter_urbanl, num_urbanc, filter ! Set up right-hand side vecor (vector r). + call SetRHSVec(bounds, num_nolakec, filter_nolakec, & dtime, & hs_h2osfc( begc:endc ), & hs_top_snow( begc:endc ), & hs_soil( begc:endc ), & hs_top( begc:endc ), & + hs_nvp( begc:endc ), & dhsdT( begc:endc ), & sabg_lyr_col (begc:endc, -nlevsno+1: ), & + sabg_soil_col( begc:endc ), & ! [PORTED by Hui Tang: bare-soil surface solar for (1-fse) soil-solar deposit] tk( begc:endc, -nlevsno+1: ), & tk_h2osfc( begc:endc ), & fact( begc:endc, -nlevsno+1: ), & @@ -400,6 +426,12 @@ subroutine SoilTemperature(bounds, num_urbanl, filter_urbanl, num_urbanc, filter tvector(c,j-1) = t_soisno(c,j) end do + ! [PORTED by Hui Tang: when NVP is at layer 0 and there is no snow, the snow + ! loop above is empty (snl=0); explicitly load NVP temperature into tvector] + if (col%nvp_layer_active(c) .and. snl(c) == 0) then + tvector(c,-1) = t_soisno(c,0) ! NVP layer: t_soisno(c,0) -> tvector(c,-1) + end if + ! surface water layer has two coefficients tvector(c,0) = t_h2osfc(c) @@ -417,6 +449,7 @@ subroutine SoilTemperature(bounds, num_urbanl, filter_urbanl, num_urbanc, filter rvector(begc:endc, :), tvector(begc:endc, :)) call t_stopf( 'SoilTempBandDiag') + ! return temperatures to original array do fc = 1,num_nolakec @@ -424,6 +457,13 @@ subroutine SoilTemperature(bounds, num_urbanl, filter_urbanl, num_urbanc, filter do j = snl(c)+1, 0 t_soisno(c,j) = tvector(c,j-1) !snow layers end do + + ! [PORTED by Hui Tang: when NVP at layer 0 and no snow, the snow loop above is + ! empty; explicitly extract the solved NVP temperature back to t_soisno(c,0)] + if (col%nvp_layer_active(c) .and. snl(c) == 0) then + t_soisno(c,0) = tvector(c,-1) ! NVP layer: tvector(c,-1) -> t_soisno(c,0) + end if + t_soisno(c,1:nlevmaxurbgrnd) = tvector(c,1:nlevmaxurbgrnd) !soil layers if (frac_h2osfc(c) == 0._r8) then @@ -545,24 +585,56 @@ subroutine SoilTemperature(bounds, num_urbanl, filter_urbanl, num_urbanc, filter temperature_inst, energyflux_inst, urbantv_inst, atm2lnd_inst) end if + ! [PORTED by Hui Tang: update t_nvp_col BEFORE t_grnd so t_grnd can use it] + ! Default: inactive-NVP columns track soil layer 1. Active-NVP columns track + ! layer 0. Use the nvpc filter so the active override is O(NVP columns) only. + + do fc = 1, num_nolakec + c = filter_nolakec(fc) + t_nvp_col(c) = t_soisno(c,1) ! default: no NVP → layer 1 + end do + + if (use_nvp) then + do fc = 1, num_nvpc ! [PORTED: override for NVP-active columns] + c = filter_nvpc(fc) + t_nvp_col(c) = t_soisno(c,0) + ! [DBG NVP sabg] NVP temperature after tridiagonal solver + write(iulog,*) '[DBG NVP sabg] T: c=', c, & + ' t_soisno(c,0)=', t_soisno(c,0), & + ' t_nvp_col(c)=', t_nvp_col(c) + end do + end if + do fc = 1,num_nolakec c = filter_nolakec(fc) + ! [PORTED by Hui Tang: NVP fractional area for t_grnd blend (excludes snow and h2osfc)] + if (use_nvp) then + ! [PORTED by Hui Tang: re-wired frac_nvp_eff — snow buries NVP (frac_nvp - frac_sno_eff), cap = 1 - frac_h2osfc - frac_sno_eff] + frac_nvp_eff = min(1._r8 - frac_h2osfc(c) - frac_sno_eff(c), max(0._r8, col%frac_nvp(c) - frac_sno_eff(c))) + else + frac_nvp_eff = 0._r8 + end if ! this expression will (should) work whether there is snow or not if (snl(c) < 0) then if(frac_h2osfc(c) /= 0._r8) then t_grnd(c) = frac_sno_eff(c) * t_soisno(c,snl(c)+1) & - + (1.0_r8 - frac_sno_eff(c) - frac_h2osfc(c)) * t_soisno(c,1) & - + frac_h2osfc(c) * t_h2osfc(c) + + (1.0_r8 - frac_sno_eff(c) - frac_h2osfc(c) - frac_nvp_eff) * t_soisno(c,1) & + + frac_h2osfc(c) * t_h2osfc(c) & + + frac_nvp_eff * t_nvp_col(c) else t_grnd(c) = frac_sno_eff(c) * t_soisno(c,snl(c)+1) & - + (1.0_r8 - frac_sno_eff(c)) * t_soisno(c,1) + + (1.0_r8 - frac_sno_eff(c) - frac_nvp_eff) * t_soisno(c,1) & + + frac_nvp_eff * t_nvp_col(c) end if else if(frac_h2osfc(c) /= 0._r8) then - t_grnd(c) = (1._r8 - frac_h2osfc(c)) * t_soisno(c,1) + frac_h2osfc(c) * t_h2osfc(c) + t_grnd(c) = (1._r8 - frac_h2osfc(c) - frac_nvp_eff) * t_soisno(c,1) & + + frac_h2osfc(c) * t_h2osfc(c) & + + frac_nvp_eff * t_nvp_col(c) else - t_grnd(c) = t_soisno(c,1) + t_grnd(c) = (1._r8 - frac_nvp_eff) * t_soisno(c,1) & + + frac_nvp_eff * t_nvp_col(c) end if endif end do @@ -599,7 +671,9 @@ subroutine SoilTemperature(bounds, num_urbanl, filter_urbanl, num_urbanc, filter end subroutine SoilTemperature !----------------------------------------------------------------------- + ! [PORTED by Hui Tang: added num_nvpc/filter_nvpc args for NVP thermal property override] subroutine SoilThermProp (bounds, num_urbanc, filter_urbanc, num_nolakec, filter_nolakec, & + num_nvpc, filter_nvpc, & tk, cv, tk_h2osfc, & urbanparams_inst, temperature_inst, waterstatebulk_inst, waterdiagnosticbulk_inst, soilstate_inst) @@ -624,7 +698,9 @@ subroutine SoilThermProp (bounds, num_urbanc, filter_urbanc, num_nolakec, filter use clm_varcon , only : denh2o, denice, tfrz, tkwat, tkice, tkair, cpice, cpliq, thk_bedrock, csol_bedrock use landunit_varcon , only : istice, istwet use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall, icol_road_perv, icol_road_imperv - use clm_varctl , only : iulog, snow_thermal_cond_method, snow_thermal_cond_glc_method + use clm_varctl , only : iulog, snow_thermal_cond_method, snow_thermal_cond_glc_method, use_nvp + ! [PORTED by Hui Tang: NVP dry-matrix thermal parameters] + use NVPParamsMod , only : thk_dry_nvp, csol_nvp, watsat_nvp ! ! !ARGUMENTS: type(bounds_type) , intent(in) :: bounds @@ -632,6 +708,8 @@ subroutine SoilThermProp (bounds, num_urbanc, filter_urbanc, num_nolakec, filter integer , intent(in) :: filter_urbanc(:) ! urban column filter integer , intent(in) :: num_nolakec ! number of column non-lake points in column filter integer , intent(in) :: filter_nolakec(:) ! column filter for non-lake points + integer , intent(in) :: num_nvpc ! [PORTED by Hui Tang: number of NVP-active columns] + integer , intent(in) :: filter_nvpc(:) ! [PORTED by Hui Tang: NVP-active column filter] real(r8) , intent(out) :: cv( bounds%begc: , -nlevsno+1: ) ! heat capacity [J/(m2 K) ] [col, lev] real(r8) , intent(out) :: tk( bounds%begc: , -nlevsno+1: ) ! thermal conductivity at the layer interface [W/(m K) ] [col, lev] real(r8) , intent(out) :: tk_h2osfc( bounds%begc: ) ! thermal conductivity of h2osfc [W/(m K) ] [col] @@ -648,6 +726,10 @@ subroutine SoilThermProp (bounds, num_urbanc, filter_urbanc, num_nolakec, filter real(r8) :: dke ! kersten number real(r8) :: fl ! volume fraction of liquid or unfrozen water to total water real(r8) :: satw ! relative total water content of soil. + ! [PORTED by Hui Tang: NVP Farouki-style thermal mixing local vars] + real(r8) :: satw_nvp ! NVP saturation fraction [-] + real(r8) :: dke_nvp ! NVP Kersten number [-] + real(r8) :: thk_sat_nvp ! NVP saturated thermal conductivity [W m-1 K-1] real(r8) :: zh2osfc !----------------------------------------------------------------------- @@ -658,12 +740,14 @@ subroutine SoilThermProp (bounds, num_urbanc, filter_urbanc, num_nolakec, filter SHR_ASSERT_ALL_FL((ubound(tk) == (/bounds%endc, nlevmaxurbgrnd/)), sourcefile, __LINE__) SHR_ASSERT_ALL_FL((ubound(tk_h2osfc) == (/bounds%endc/)), sourcefile, __LINE__) - associate( & - nbedrock => col%nbedrock , & ! Input: [real(r8) (:,:) ] depth to bedrock (m) - snl => col%snl , & ! Input: [integer (:) ] number of snow layers - dz => col%dz , & ! Input: [real(r8) (:,:) ] layer depth (m) - zi => col%zi , & ! Input: [real(r8) (:,:) ] interface level below a "z" level (m) - z => col%z , & ! Input: [real(r8) (:,:) ] layer thickness (m) + associate( & + nbedrock => col%nbedrock , & ! Input: [real(r8) (:,:) ] depth to bedrock (m) + snl => col%snl , & ! Input: [integer (:) ] number of snow layers + ! [PORTED by Hui Tang: jbot_sno = 0 (no NVP) or -1 (NVP occupies layer 0)] + jbot_sno => col%jbot_sno , & ! Input: [integer (:) ] real bottom of snow (0 or -1) + dz => col%dz , & ! Input: [real(r8) (:,:) ] layer depth (m) + zi => col%zi , & ! Input: [real(r8) (:,:) ] interface level below a "z" level (m) + z => col%z , & ! Input: [real(r8) (:,:) ] layer thickness (m) nlev_improad => urbanparams_inst%nlev_improad , & ! Input: [integer (:) ] number of impervious road layers tk_wall => urbanparams_inst%tk_wall , & ! Input: [real(r8) (:,:) ] thermal conductivity of urban wall @@ -691,6 +775,20 @@ subroutine SoilThermProp (bounds, num_urbanc, filter_urbanc, num_nolakec, filter thk => soilstate_inst%thk_col & ! Output: [real(r8) (:,:) ] thermal conductivity of each layer [W/m-K] ) + ! [NVP DBG: NaN check for NVP layer j=0 entering SoilThermProp — only fires on actual NaN] + if (use_nvp) then + do fc = 1, num_nolakec + c = filter_nolakec(fc) + if (snl(c) < 0) then + if (h2osoi_liq(c,0) /= h2osoi_liq(c,0) .or. h2osoi_ice(c,0) /= h2osoi_ice(c,0)) then + write(iulog,*) '[NVP DBG] SoilThermProp NaN in h2osoi at j=0 c=', c, ' snl=', snl(c) + write(iulog,*) ' h2osoi_liq(c,:) = ', h2osoi_liq(c,:) + write(iulog,*) ' h2osoi_ice(c,:) = ', h2osoi_ice(c,:) + end if + end if + end do + end if + ! Thermal conductivity of soil from Farouki (1981) do j = -nlevsno+1,nlevgrnd @@ -738,8 +836,11 @@ subroutine SoilThermProp (bounds, num_urbanc, filter_urbanc, num_nolakec, filter ! Thermal conductivity of snow ! Only examine levels from snl(c)+1 -> 0 where snl(c) < 1 - if (snl(c)+1 < 1 .AND. (j >= snl(c)+1) .AND. (j <= 0)) then + ! [PORTED by Hui Tang: skip j=0 when NVP occupies that layer; handled below] + if (snl(c)+1 < 1 .AND. (j >= snl(c)+1) .AND. (j <= 0) .AND. & + .NOT. (use_nvp .AND. jbot_sno(c) == -1 .AND. j == 0)) then bw(c,j) = (h2osoi_ice(c,j)+h2osoi_liq(c,j))/(frac_sno(c)*dz(c,j)) + l = col%landunit(c) ! Select method over glacier land unit @@ -778,9 +879,33 @@ subroutine SoilThermProp (bounds, num_urbanc, filter_urbanc, num_nolakec, filter write(iulog,*) ' ERROR: unknown snow_thermal_cond_method value: ', snow_thermal_cond_method call endrun(msg=errMsg(sourcefile, __LINE__)) end select - end if ! close land unit if statement + end if ! close land unit if statement end if + ! [PORTED by Hui Tang: NVP layer thermal conductivity at j=0] + ! Farouki-style mixing between dry NVP matrix and pore water/ice, + ! analogous to the soil Kersten-number formula above. + if (use_nvp .and. jbot_sno(c) == -1 .and. j == 0) then + if (dz(c,0) > 0._r8) then + satw_nvp = min(1._r8, (h2osoi_liq(c,0)/denh2o + h2osoi_ice(c,0)/denice) & + / (dz(c,0) * watsat_nvp)) + else + satw_nvp = 0._r8 + end if + if (satw_nvp > 1.e-6_r8) then + if (t_soisno(c,0) >= tfrz) then + dke_nvp = max(0._r8, log10(satw_nvp) + 1.0_r8) + thk_sat_nvp = thk_dry_nvp**(1._r8 - watsat_nvp) * tkwat**watsat_nvp + else + dke_nvp = satw_nvp + thk_sat_nvp = thk_dry_nvp**(1._r8 - watsat_nvp) * tkice**watsat_nvp + end if + thk(c,0) = dke_nvp * thk_sat_nvp + (1._r8 - dke_nvp) * thk_dry_nvp + else + thk(c,0) = thk_dry_nvp + end if + end if + end do end do @@ -829,6 +954,19 @@ subroutine SoilThermProp (bounds, num_urbanc, filter_urbanc, num_nolakec, filter end do end do + ! [PORTED by Hui Tang: NVP-soil interface conductivity when NVP at layer 0] + ! Use jbot_sno(c)==-1 directly (not filter_nvpc) so this runs on the first + ! timestep before filter_nvpc has been built by setNVPcFilter. + if (use_nvp) then + do fc = 1, num_nolakec + c = filter_nolakec(fc) + if (col%jbot_sno(c) == -1) then + tk(c,0) = thk(c,0)*thk(c,1)*(z(c,1)-z(c,0)) & + /(thk(c,0)*(z(c,1)-zi(c,0))+thk(c,1)*(zi(c,0)-z(c,0))) + end if + end do + end if + ! calculate thermal conductivity of h2osfc do fc = 1, num_nolakec c = filter_nolakec(fc) @@ -881,11 +1019,13 @@ subroutine SoilThermProp (bounds, num_urbanc, filter_urbanc, num_nolakec, filter end do ! Snow heat capacity + ! [PORTED by Hui Tang: guard j=0 when NVP is there; NVP cv handled below] do j = -nlevsno+1,0 do fc = 1,num_nolakec c = filter_nolakec(fc) - if (snl(c)+1 < 1 .and. j >= snl(c)+1) then + if (snl(c)+1 < 1 .and. j >= snl(c)+1 .and. & + .NOT. (use_nvp .and. jbot_sno(c) == -1 .and. j == 0)) then if (frac_sno(c) > 0._r8) then cv(c,j) = max(thin_sfclayer,(cpliq*h2osoi_liq(c,j) + cpice*h2osoi_ice(c,j))/frac_sno(c)) else @@ -894,6 +1034,32 @@ subroutine SoilThermProp (bounds, num_urbanc, filter_urbanc, num_nolakec, filter end if end do end do + + ! [PORTED by Hui Tang: NVP layer heat capacity at j=0] + ! Use jbot_sno(c)==-1 directly (not filter_nvpc) so this runs on the first + ! timestep before filter_nvpc has been built by setNVPcFilter. + if (use_nvp) then + do fc = 1, num_nolakec + c = filter_nolakec(fc) + if (col%jbot_sno(c) == -1) then + ! [PORTED by Hui Tang (2026-06-12): option (b) step 1 — make cv(c,0) FULLY PER-MOSS-AREA, + ! mirroring snow's per-snow-area cv (line ~1027). The moss occupies only frac_nvp of the + ! column, so divide the ENTIRE per-column heat capacity by frac_nvp. NOTE: the solid term + ! also needs /frac_nvp because dz(c,0)=col%dz_nvp = nvp_dz*frac_nvp*canopy_frac + ! (clmfates_interfaceMod:1816) is the column-EFFECTIVE depth — it already carries frac_nvp, + ! so csol_nvp*(1-watsat_nvp)*dz(c,0) is PER-COLUMN, not per-moss. Dividing the whole + ! expression gives cv_moss = old_cv/frac_nvp, so frac_nvp*cv_moss = the actual per-column + ! heat capacity (solid+water) — consistent with the per-column accounting and the moss + ! solid added to heat(c) in TotalWaterAndHeatMod. Pairs with the moss/soil interface + ! (frac_nvp on SOIL side, FULL on MOSS side) so frac_nvp cancels across storage and + ! conduction. jbot_sno==-1 => frac_nvp > nvp_frac_min > 0.] + cv(c,0) = max(thin_sfclayer, & + ( csol_nvp*(1._r8 - watsat_nvp)*dz(c,0) & + + cpliq*h2osoi_liq(c,0) + cpice*h2osoi_ice(c,0) )/col%frac_nvp(c)) + end if + end do + end if + call t_stopf( 'SoilThermProp' ) end associate @@ -1016,6 +1182,13 @@ subroutine PhaseChangeH2osfc (bounds, num_nolakec, filter_nolakec, & int_snow(c) = int_snow(c) - xm(c) if (snl(c) == 0) then h2osno_no_layers(c) = h2osno_no_layers(c) - xm(c) + ! [PORTED by Hui Tang: NVP partial-freeze — route frozen surface water to the bottom + ! snow layer j=-1, NOT the NVP moss layer j=0 (mirrors the full-freeze case below, + ! lines ~1227). Without this, partial-freeze ice accumulates in the moss layer, + ! inflating its cv and corrupting t_soisno(c,0) -> errsoi spikes at h2osfc-freeze + ! transitions (the residual after Phase 1c).] + else if (use_nvp .and. col%jbot_sno(c) == -1 .and. snl(c) <= -2) then + h2osoi_ice(c,-1) = h2osoi_ice(c,-1) - xm(c) else h2osoi_ice(c,0) = h2osoi_ice(c,0) - xm(c) end if @@ -1040,6 +1213,19 @@ subroutine PhaseChangeH2osfc (bounds, num_nolakec, filter_nolakec, & !initialize for next time step t_soisno(c,0) = t_h2osfc(c) eflx_h2osfc_to_snow_col(c) = 0. + ! [PORTED by Hui Tang: NVP partial-freeze — the ice was added to the bottom snow layer + ! j=-1 above, so equilibrate t_soisno(c,-1)/fact(c,-1), NOT the moss layer j=0 (mirrors + ! the full-freeze NVP case below, lines ~1268).] + else if (use_nvp .and. col%jbot_sno(c) == -1 .and. snl(c) <= -2) then + c1=frac_sno(c)/fact(c,-1)*dtime + if ( frac_h2osfc(c) /= 0.0_r8 )then + c2=(-cpliq*xm(c) - frac_h2osfc(c)*dhsdT(c)*dtime) + else + c2=0.0_r8 + end if + t_soisno(c,-1) = (c1*t_soisno(c,-1)+ c2*t_h2osfc(c)) & + /(c1 + c2) + eflx_h2osfc_to_snow_col(c) =(t_h2osfc(c)-t_soisno(c,-1))*c2/dtime else if (snl(c) == -1)then c1=frac_sno(c)*(dtime/fact(c,0) - dhsdT(c)*dtime) @@ -1052,9 +1238,9 @@ subroutine PhaseChangeH2osfc (bounds, num_nolakec, filter_nolakec, & c2=0.0_r8 end if t_soisno(c,0) = (c1*t_soisno(c,0)+ c2*t_h2osfc(c)) & - /(c1 + c2) + /(c1 + c2) eflx_h2osfc_to_snow_col(c) =(t_h2osfc(c)-t_soisno(c,0))*c2/dtime - + endif !========================= xm > h2osfc ============================= @@ -1065,7 +1251,18 @@ subroutine PhaseChangeH2osfc (bounds, num_nolakec, filter_nolakec, & if (snl(c) == 0) then h2osno_no_layers(c) = h2osno_no_layers(c) + h2osfc(c) else - h2osoi_ice(c,0) = h2osoi_ice(c,0) + h2osfc(c) + ! [PORTED by Hui Tang: route frozen surface water to the bottom SNOW layer, not the + ! NVP moss layer. Standard CLM layer 0 is the bottom snow layer; with NVP, layer 0 + ! is the 79-micron moss layer and the bottom snow layer is j=-1 (jbot_sno==-1, and + ! the first snow on NVP makes snl<=-2). Without this, frozen h2osfc accumulates as + ! unphysical ice in the moss layer (ice0 grew 55->250 kg/m2 over snowmelt), inflating + ! cv(c,0) and causing the soil-energy balance (errsoi) spikes. The matching + ! temperature equilibration below is also routed to j=-1 for NVP.] + if (use_nvp .and. col%jbot_sno(c) == -1 .and. snl(c) <= -2) then + h2osoi_ice(c,-1) = h2osoi_ice(c,-1) + h2osfc(c) + else + h2osoi_ice(c,0) = h2osoi_ice(c,0) + h2osfc(c) + end if end if h2osno_total(c) = h2osno_total(c) + h2osfc(c) @@ -1099,6 +1296,20 @@ subroutine PhaseChangeH2osfc (bounds, num_nolakec, filter_nolakec, & t_h2osfc(c) = t_soisno(c,0) else + ! [PORTED by Hui Tang: equilibrate the frozen h2osfc with the layer that received + ! its ice. For NVP (jbot_sno==-1) the ice was added to the bottom snow layer j=-1 + ! above, so equilibrate t_soisno(c,-1)/fact(c,-1); otherwise use layer 0 as standard.] + if (use_nvp .and. col%jbot_sno(c) == -1) then + c1=frac_sno(c)/fact(c,-1)*dtime + if ( frac_h2osfc(c) /= 0.0_r8 )then + c2=frac_h2osfc(c)*(c_h2osfc(c) - dtime*dhsdT(c)) + else + c2=0.0_r8 + end if + t_soisno(c,-1) = (c1*t_soisno(c,-1)+ c2*t_h2osfc(c)) & + /(c1 + c2) + t_h2osfc(c) = t_soisno(c,-1) + else c1=frac_sno(c)/fact(c,0)*dtime if ( frac_h2osfc(c) /= 0.0_r8 )then c2=frac_h2osfc(c)*(c_h2osfc(c) - dtime*dhsdT(c)) @@ -1106,8 +1317,9 @@ subroutine PhaseChangeH2osfc (bounds, num_nolakec, filter_nolakec, & c2=0.0_r8 end if t_soisno(c,0) = (c1*t_soisno(c,0)+ c2*t_h2osfc(c)) & - /(c1 + c2) + /(c1 + c2) t_h2osfc(c) = t_soisno(c,0) + end if endif ! set h2osfc to zero (all liquid converted to ice) @@ -1180,6 +1392,8 @@ subroutine Phasechange (bounds, num_nolakec, filter_nolakec, dhsdT, & real(r8) :: supercool(bounds%begc:bounds%endc,nlevmaxurbgrnd) !supercooled water in soil (kg/m2) real(r8) :: propor !proportionality constant (-) real(r8) :: tinc(bounds%begc:bounds%endc,-nlevsno+1:nlevmaxurbgrnd) !t(n+1)-t(n) [K] + real(r8) :: frac_nvp_eff ! [PORTED by Hui Tang: exposed NVP fraction (Phase 1c iteration 2)] + real(r8) :: frac_soil ! [PORTED by Hui Tang: bare-soil fraction (Phase 1c iteration 2)] real(r8) :: smp !frozen water potential (mm) real(r8) :: wexice0(bounds%begc:bounds%endc,-nlevsno+1:nlevmaxurbgrnd) !initial mass of excess_ice at the timestep (kg/m2) @@ -1223,7 +1437,9 @@ subroutine Phasechange (bounds, num_nolakec, filter_nolakec, dhsdT, & fact => temperature_inst%fact_col , & imelt => temperature_inst%imelt_col , & ! Output: [integer (:,:) ] flag for melting (=1), freezing (=2), Not=0 (new) - t_soisno => temperature_inst%t_soisno_col & ! Output: [real(r8) (:,:) ] soil temperature [K] + t_soisno => temperature_inst%t_soisno_col , & ! Output: [real(r8) (:,:) ] soil temperature [K] + ! [PORTED by Hui Tang: t_nvp_col synced after NVP phase change modifies t_soisno(c,0)] + t_nvp_col => temperature_inst%t_nvp_col & ! Inout: [real(r8) (:) ] NVP temperature [K] ) ! Get step size @@ -1274,6 +1490,19 @@ subroutine Phasechange (bounds, num_nolakec, filter_nolakec, dhsdT, & do fc = 1,num_nolakec c = filter_nolakec(fc) if (j >= snl(c)+1) then + ! [PORTED by Hui Tang: NVP at j=0 — phase change identification (buried case, snl<0)] + ! NVP has no supercooled water; treat like snow (plain tfrz threshold). + ! The energy loop handles hm/T-correction for j=0 as an interior layer + ! (else branch: hm = -frac_sno_eff*tinc/fact ≈ -tinc/fact when frac_sno_eff≈1). + if (use_nvp .and. col%jbot_sno(c) == -1 .and. j == 0) then + if (h2osoi_ice(c,0) > 0._r8 .and. t_soisno(c,0) > tfrz) then + imelt(c,0) = 1 ; tinc(c,0) = tfrz - t_soisno(c,0) ; t_soisno(c,0) = tfrz + end if + if (h2osoi_liq(c,0) > 0._r8 .and. t_soisno(c,0) < tfrz) then + imelt(c,0) = 2 ; tinc(c,0) = tfrz - t_soisno(c,0) ; t_soisno(c,0) = tfrz + end if + cycle + end if ! Melting identification ! If ice exists above melt point, melt some to liquid. @@ -1294,7 +1523,33 @@ subroutine Phasechange (bounds, num_nolakec, filter_nolakec, dhsdT, & end do ! end of column-loop enddo ! end of level-loop - !-- soil layers --------------------------------------------------- + ! [PORTED by Hui Tang: NVP phase change identification — active case (snl=0)] + ! When snl=0 the snow loop runs j=snl+1=1 to 0, never reaching j=0. + ! Initialise wice0/wliq0/wmass0/imelt/tinc for j=0 and identify melt/freeze here. + if (use_nvp) then + do fc = 1, num_nolakec + c = filter_nolakec(fc) + if (col%jbot_sno(c) == -1 .and. col%snl(c) == 0) then + wice0(c,0) = h2osoi_ice(c,0) + wliq0(c,0) = h2osoi_liq(c,0) + wexice0(c,0) = 0._r8 + wmass0(c,0) = wice0(c,0) + wliq0(c,0) + imelt(c,0) = 0 + hm(c,0) = 0._r8 + xm(c,0) = 0._r8 + xm2(c,0) = 0._r8 + tinc(c,0) = 0._r8 + if (wice0(c,0) > 0._r8 .and. t_soisno(c,0) > tfrz) then + imelt(c,0) = 1 ; tinc(c,0) = tfrz - t_soisno(c,0) ; t_soisno(c,0) = tfrz + end if + if (wliq0(c,0) > 0._r8 .and. t_soisno(c,0) < tfrz) then + imelt(c,0) = 2 ; tinc(c,0) = tfrz - t_soisno(c,0) ; t_soisno(c,0) = tfrz + end if + end if + end do + end if + + !-- soil layers --------------------------------------------------- do j = 1,nlevmaxurbgrnd do fc = 1,num_nolakec c = filter_nolakec(fc) @@ -1378,10 +1633,48 @@ subroutine Phasechange (bounds, num_nolakec, filter_nolakec, dhsdT, & if ( j==1 .and. frac_h2osfc(c) /= 0.0_r8 ) then hm(c,j) = hm(c,j) - frac_h2osfc(c)*(dhsdT(c)*tinc(c,j)) end if + ! [PORTED by Hui Tang: snl==0 3-way (2026-06-11) — for NVP snl==0, j=1 is the + ! TOP layer (j==snl+1) but its surface flux covers only the bare-soil fraction + ! frac_soil; the exposed-moss surface is at j=0. Remove the frac_nvp_eff portion + ! of the full-dhsdT surface term so hm uses frac_soil*dhsdT (= [1-fh2o-frac_nvp_eff]).] + if ( j==1 .and. use_nvp .and. col%jbot_sno(c) == -1 .and. snl(c) == 0 ) then + frac_nvp_eff = min(1._r8 - frac_h2osfc(c) - frac_sno_eff(c), & + max(0._r8, col%frac_nvp(c) - frac_sno_eff(c))) + hm(c,j) = hm(c,j) - frac_nvp_eff*(dhsdT(c)*tinc(c,j)) + end if + else if (j == 1 .and. use_nvp .and. col%jbot_sno(c) == -1 .and. snl(c) < 0) then + ! [PORTED by Hui Tang: Phase 1c iteration 2 — soil layer 1 below NVP under + ! partial snow (3-way split). The exposed-moss surface moved to j=0, so the + ! direct bare-soil surface flux at j=1 now covers only frac_soil (was + ! 1-fse-fh2o). Phase-change must credit frac_soil*dhsdT*tinc to match the + ! Phase 1c SetRHSVec_Soil/SetMatrix_Soil j=1 surface weight.] + frac_nvp_eff = min(1._r8 - frac_h2osfc(c) - frac_sno_eff(c), & + max(0._r8, col%frac_nvp(c) - frac_sno_eff(c))) + frac_soil = max(0._r8, 1._r8 - frac_sno_eff(c) - frac_h2osfc(c) - frac_nvp_eff) + hm(c,j) = frac_soil*dhsdT(c)*tinc(c,j) - tinc(c,j)/fact(c,j) else if (j == 1) then hm(c,j) = (1.0_r8 - frac_sno_eff(c) - frac_h2osfc(c)) & *dhsdT(c)*tinc(c,j) - tinc(c,j)/fact(c,j) - else ! non-interfacial snow/soil layers + else if (use_nvp .and. col%jbot_sno(c) == -1 .and. j == 0) then + ! [PORTED by Hui Tang: NVP j=0 phase-change energy (Phase 1c iteration 2, + ! 2026-06-11). This branch only fires for snl<0 (for snl==0, j=0 < snl+1 so + ! it is handled separately at the snl==0 block below). cv(c,0) is per unit + ! COLUMN area, hence -tinc/fact with no frac_sno_eff scaling. The MISSING + ! piece (the cause of the freeze/melt errsoi runaway, e.g. nstep~8710) was + ! the surface-flux derivative term: the Phase 1c solve drives j=0 with the + ! exposed-moss surface flux frac_nvp_eff*(hs_nvp - dhsdT*T0), so phase change + ! must credit frac_nvp_eff*dhsdT*tinc here, mirroring the bare-soil j=1 form + ! (1-fse-fh2o)*dhsdT*tinc. Without it the freeze energy was mis-accounted by + ! ~frac_nvp_eff*dhsdT*tinc each step -> oscillation/blow-up.] + frac_nvp_eff = min(1._r8 - frac_h2osfc(c) - frac_sno_eff(c), & + max(0._r8, col%frac_nvp(c) - frac_sno_eff(c))) + ! [PORTED by Hui Tang (2026-06-12): option (b) step 3 — cv(c,0) is now PER-MOSS- + ! area, so the storage term carries frac_nvp (per-moss -> per-column), like + ! snow's -frac_sno*tinc/fact. The surface-flux derivative keeps frac_nvp_eff + ! (exposed moss). For snl==0 (frac_nvp_eff=frac_nvp) this is the snow-top form + ! frac_nvp*(dhsdT*tinc - tinc/fact).] + hm(c,0) = frac_nvp_eff*dhsdT(c)*tinc(c,0) - col%frac_nvp(c)*tinc(c,0) / fact(c,0) + else ! non-interfacial snow/soil layers if(j < 1) then hm(c,j) = - frac_sno_eff(c)*(tinc(c,j)/fact(c,j)) else @@ -1465,14 +1758,34 @@ subroutine Phasechange (bounds, num_nolakec, filter_nolakec, dhsdT, & if (j == snl(c)+1) then if(j==1) then - t_soisno(c,j) = t_soisno(c,j) + fact(c,j)*heatr & - /(1._r8-(1.0_r8 - frac_h2osfc(c))*fact(c,j)*dhsdT(c)) + ! [PORTED by Hui Tang: snl==0 3-way (2026-06-11) — for NVP snl==0, j=1's + ! surface flux covers only frac_soil (exposed moss is at j=0), so the + ! T-correction denominator uses frac_soil (was 1-frac_h2osfc).] + if (use_nvp .and. col%jbot_sno(c) == -1 .and. snl(c) == 0) then + frac_nvp_eff = min(1._r8 - frac_h2osfc(c) - frac_sno_eff(c), & + max(0._r8, col%frac_nvp(c) - frac_sno_eff(c))) + frac_soil = max(0._r8, 1._r8 - frac_sno_eff(c) - frac_h2osfc(c) - frac_nvp_eff) + t_soisno(c,j) = t_soisno(c,j) + fact(c,j)*heatr & + /(1._r8 - frac_soil*fact(c,j)*dhsdT(c)) + else + t_soisno(c,j) = t_soisno(c,j) + fact(c,j)*heatr & + /(1._r8-(1.0_r8 - frac_h2osfc(c))*fact(c,j)*dhsdT(c)) + end if else t_soisno(c,j) = t_soisno(c,j) + (fact(c,j)/frac_sno_eff(c))*heatr & /(1._r8-fact(c,j)*dhsdT(c)) endif + else if (j == 1 .and. use_nvp .and. col%jbot_sno(c) == -1 .and. snl(c) < 0) then + ! [PORTED by Hui Tang: Phase 1c iteration 2 — soil layer 1 below NVP under + ! partial snow. Denominator uses frac_soil (bare-soil surface weight in the + ! 3-way split), matching the hm fix above and the Phase 1c j=1 surface BC.] + frac_nvp_eff = min(1._r8 - frac_h2osfc(c) - frac_sno_eff(c), & + max(0._r8, col%frac_nvp(c) - frac_sno_eff(c))) + frac_soil = max(0._r8, 1._r8 - frac_sno_eff(c) - frac_h2osfc(c) - frac_nvp_eff) + t_soisno(c,j) = t_soisno(c,j) + fact(c,j)*heatr & + /(1._r8 - frac_soil*fact(c,j)*dhsdT(c)) else if (j == 1) then t_soisno(c,j) = t_soisno(c,j) + fact(c,j)*heatr & @@ -1480,6 +1793,21 @@ subroutine Phasechange (bounds, num_nolakec, filter_nolakec, dhsdT, & else if(j > 0) then t_soisno(c,j) = t_soisno(c,j) + fact(c,j)*heatr + else if (use_nvp .and. col%jbot_sno(c) == -1 .and. j == 0) then + ! [PORTED by Hui Tang: NVP j=0 T-correction (Phase 1c iteration 2). + ! cv(c,0) is per unit column area so no frac_sno_eff division. The + ! denominator (1 - frac_nvp_eff*fact*dhsdT) accounts for the implicit + ! dependence of the exposed-moss surface flux on T0, mirroring the + ! bare-soil j=1 form (1 - (1-fse-fh2o)*fact*dhsdT). Must match the hm + ! surface term above (frac_nvp_eff*dhsdT) or freeze/melt errsoi reopens.] + frac_nvp_eff = min(1._r8 - frac_h2osfc(c) - frac_sno_eff(c), & + max(0._r8, col%frac_nvp(c) - frac_sno_eff(c))) + ! [PORTED by Hui Tang (2026-06-12): option (b) step 3 — per-moss-area cv: + ! ΔT = fact*heatr/(frac_nvp - frac_nvp_eff*fact*dhsdT) (the leading 1 -> + ! frac_nvp; reduces to snow-top (fact/frac_nvp)*heatr/(1-fact*dhsdT) when + ! frac_nvp_eff=frac_nvp). dhsdT<0 so denom > frac_nvp > 0.] + t_soisno(c,0) = t_soisno(c,0) + fact(c,0)*heatr & + /(col%frac_nvp(c) - frac_nvp_eff*fact(c,0)*dhsdT(c)) else if(frac_sno_eff(c) > 0._r8) t_soisno(c,j) = t_soisno(c,j) + (fact(c,j)/frac_sno_eff(c))*heatr endif @@ -1499,14 +1827,18 @@ subroutine Phasechange (bounds, num_nolakec, filter_nolakec, dhsdT, & xmf(c) = xmf(c) + hfus*(wice0(c,j)-h2osoi_ice(c,j))/dtime endif - if (imelt(c,j) == 1 .AND. j < 1) then + ! [PORTED by Hui Tang: exclude NVP (j=0, jbot_sno=-1) — NVP melt/freeze + ! is not snow melt/freeze and must not feed qflx_snomelt/qflx_snofrz] + if (imelt(c,j) == 1 .AND. j < 1 .AND. & + .NOT. (use_nvp .AND. col%jbot_sno(c) == -1 .AND. j == 0)) then qflx_snomelt_lyr(c,j) = max(0._r8,(wice0(c,j)-h2osoi_ice(c,j)))/dtime qflx_snomelt(c) = qflx_snomelt(c) + qflx_snomelt_lyr(c,j) snomelt_accum(c) = snomelt_accum(c) + qflx_snomelt_lyr(c,j) * dtime * 1.e-3_r8 endif ! layer freezing mass flux (positive): - if (imelt(c,j) == 2 .AND. j < 1) then + if (imelt(c,j) == 2 .AND. j < 1 .AND. & + .NOT. (use_nvp .AND. col%jbot_sno(c) == -1 .AND. j == 0)) then qflx_snofrz_lyr(c,j) = max(0._r8,(h2osoi_ice(c,j)-wice0(c,j)))/dtime qflx_snofrz(c) = qflx_snofrz(c) + qflx_snofrz_lyr(c,j) endif @@ -1521,6 +1853,61 @@ subroutine Phasechange (bounds, num_nolakec, filter_nolakec, dhsdT, & enddo ! end of level-loop + ! [PORTED by Hui Tang: NVP phase change energy — active case (snl=0)] + ! Active NVP (j=0, snl=0) is the top layer of the thermal domain but is not reached + ! by the energy loop (condition j >= snl+1=1 fails for j=0). Apply the top-layer + ! energy formula: hm = dhsdT*tinc - tinc/fact (no frac_sno_eff since snl=0). + ! The residual-heat T correction mirrors the top-soil-layer formula. + if (use_nvp) then + do fc = 1, num_nolakec + c = filter_nolakec(fc) + if (col%jbot_sno(c) == -1 .and. col%snl(c) == 0 .and. imelt(c,0) > 0) then + ! [PORTED by Hui Tang: snl==0 3-way (2026-06-11) — surface-flux derivative weighted by + ! frac_nvp_eff (was full dhsdT under collapse), matching the snl==0 j=0 surface BC.] + frac_nvp_eff = min(1._r8 - frac_h2osfc(c) - frac_sno_eff(c), & + max(0._r8, col%frac_nvp(c) - frac_sno_eff(c))) + ! [PORTED by Hui Tang (2026-06-12): option (b) step 3 — per-moss-area cv: storage term + ! carries frac_nvp (=frac_nvp_eff here since snl==0). = frac_nvp*(dhsdT*tinc-tinc/fact).] + hm(c,0) = frac_nvp_eff*dhsdT(c)*tinc(c,0) - col%frac_nvp(c)*tinc(c,0)/fact(c,0) + ! Tridiagonal error check (mirrors standard Phasechange logic) + if (imelt(c,0) == 1 .and. hm(c,0) < 0._r8) then + hm(c,0) = 0._r8 ; imelt(c,0) = 0 + end if + if (imelt(c,0) == 2 .and. hm(c,0) > 0._r8) then + hm(c,0) = 0._r8 ; imelt(c,0) = 0 + end if + if (imelt(c,0) > 0 .and. abs(hm(c,0)) > 0._r8) then + xm(c,0) = hm(c,0) * dtime / hfus + heatr = 0._r8 + if (xm(c,0) > 0._r8) then ! melting + h2osoi_ice(c,0) = max(0._r8, wice0(c,0) - xm(c,0)) + heatr = hm(c,0) - hfus*(wice0(c,0)-h2osoi_ice(c,0))/dtime + else if (xm(c,0) < 0._r8) then ! freezing + h2osoi_ice(c,0) = min(wmass0(c,0), wice0(c,0) - xm(c,0)) + heatr = hm(c,0) - hfus*(wice0(c,0)-h2osoi_ice(c,0))/dtime + end if + h2osoi_liq(c,0) = max(0._r8, wmass0(c,0) - h2osoi_ice(c,0)) + if (abs(heatr) > 0._r8) then + ! [PORTED by Hui Tang (2026-06-12): option (b) step 3 — per-moss-area cv: leading 1 + ! -> frac_nvp in the denominator (= snow-top (fact/frac_nvp)/(1-fact*dhsdT) here).] + t_soisno(c,0) = t_soisno(c,0) + fact(c,0)*heatr & + / (col%frac_nvp(c) - frac_nvp_eff*fact(c,0)*dhsdT(c)) + end if + if (h2osoi_liq(c,0)*h2osoi_ice(c,0) > 0._r8) t_soisno(c,0) = tfrz + xmf(c) = xmf(c) + hfus*(wice0(c,0)-h2osoi_ice(c,0))/dtime + end if + end if + end do + end if + + ! [PORTED by Hui Tang: sync t_nvp_col after NVP phase change may have modified t_soisno(c,0)] + if (use_nvp) then + do fc = 1, num_nolakec + c = filter_nolakec(fc) + if (col%jbot_sno(c) == -1) t_nvp_col(c) = t_soisno(c,0) + end do + end if + ! Needed for history file output do fc = 1,num_nolakec @@ -1540,9 +1927,11 @@ subroutine Phasechange (bounds, num_nolakec, filter_nolakec, dhsdT, & end subroutine Phasechange !----------------------------------------------------------------------- + ! [PORTED by Hui Tang: added num_nvpc/filter_nvpc/hs_nvp args for NVP layer 0 heat flux] subroutine ComputeGroundHeatFluxAndDeriv(bounds, & num_nolakep, filter_nolakep, num_nolakec, filter_nolakec, & - hs_h2osfc, hs_top_snow, hs_soil, hs_top, dhsdT, sabg_lyr_col, & + num_nvpc, filter_nvpc, & + hs_h2osfc, hs_top_snow, hs_soil, hs_top, hs_nvp, dhsdT, sabg_lyr_col, sabg_soil_col, & atm2lnd_inst, urbanparams_inst, canopystate_inst, waterdiagnosticbulk_inst, & waterfluxbulk_inst, solarabs_inst, energyflux_inst, temperature_inst) ! @@ -1559,6 +1948,7 @@ subroutine ComputeGroundHeatFluxAndDeriv(bounds, & use column_varcon , only : icol_road_perv, icol_road_imperv use clm_varpar , only : nlevsno use UrbanParamsType, only : IsSimpleBuildTemp, IsProgBuildTemp + use clm_time_manager , only : get_nstep ! [PORTED by Hui Tang: Phase-0 NVP exposure diagnostic] ! ! !ARGUMENTS: implicit none @@ -1567,12 +1957,16 @@ subroutine ComputeGroundHeatFluxAndDeriv(bounds, & integer , intent(in) :: filter_nolakep( : ) ! patch filter for non-lake points integer , intent(in) :: num_nolakec ! number of column non-lake points in column filter integer , intent(in) :: filter_nolakec( : ) ! column filter for non-lake points + integer , intent(in) :: num_nvpc ! [PORTED by Hui Tang: number of NVP-active columns] + integer , intent(in) :: filter_nvpc( : ) ! [PORTED by Hui Tang: NVP-active column filter] real(r8) , intent(out) :: hs_h2osfc( bounds%begc: ) ! heat flux on standing water [W/m2] real(r8) , intent(out) :: hs_top_snow( bounds%begc: ) ! heat flux on top snow layer [W/m2] real(r8) , intent(out) :: hs_soil( bounds%begc: ) ! heat flux on soil [W/m2] real(r8) , intent(out) :: hs_top (bounds%begc: ) ! net energy flux into surface layer (col) [W/m2] + real(r8) , intent(out) :: hs_nvp( bounds%begc: ) ! [PORTED by Hui Tang: net surface flux at NVP layer 0] [W/m2] real(r8) , intent(out) :: dhsdT( bounds%begc: ) ! temperature derivative of "hs" [col] real(r8) , intent(out) :: sabg_lyr_col( bounds%begc:, -nlevsno+1: ) ! absorbed solar radiation (col,lyr) [W/m2] + real(r8) , intent(out) :: sabg_soil_col( bounds%begc: ) ! [PORTED by Hui Tang: col-level bare-soil surface solar sabg_soil [W/m2]] type(atm2lnd_type) , intent(in) :: atm2lnd_inst type(urbanparams_type) , intent(in) :: urbanparams_inst type(canopystate_type) , intent(in) :: canopystate_inst @@ -1596,6 +1990,13 @@ subroutine ComputeGroundHeatFluxAndDeriv(bounds, & real(r8) :: eflx_gnet_snow ! real(r8) :: eflx_gnet_soil ! real(r8) :: eflx_gnet_h2osfc ! + ! [PORTED by Hui Tang: NVP surface flux variables] + real(r8) :: lwrad_emit_nvp(bounds%begc:bounds%endc) ! NVP LW emission [W/m2] + real(r8) :: eflx_gnet_nvp ! net surface flux at NVP layer, patch-level [W/m2] + ! [PORTED by Hui Tang: Phase-0 diagnostic — exposure-weighting of moss turbulent flux] + real(r8) :: frac_nvp_eff ! exposed NVP column fraction [-] + real(r8) :: nvp_exp ! snow-free fraction of moss coverage = frac_nvp_eff/frac_nvp [-] + real(r8) :: nvp_exp_solar ! [PORTED by Hui Tang: SOLAR exposed-moss weight = frac_nvp_eff_solar/frac_nvp (no fh2o cap — h2osfc is not a solar tile)] !----------------------------------------------------------------------- ! Enforce expected array sizes @@ -1613,8 +2014,9 @@ subroutine ComputeGroundHeatFluxAndDeriv(bounds, & forc_lwrad => atm2lnd_inst%forc_lwrad_downscaled_col , & ! Input: [real(r8) (:) ] downward infrared (longwave) radiation (W/m**2) frac_veg_nosno => canopystate_inst%frac_veg_nosno_patch , & ! Input: [integer (:) ] fraction of vegetation not covered by snow (0 OR 1) [-] - + frac_sno_eff => waterdiagnosticbulk_inst%frac_sno_eff_col , & ! Input: [real(r8) (:) ] eff. fraction of ground covered by snow (0 to 1) + frac_h2osfc => waterdiagnosticbulk_inst%frac_h2osfc_col , & ! [PORTED by Hui Tang: Phase-0 diag — needed for frac_nvp_eff cap] qflx_ev_snow => waterfluxbulk_inst%qflx_ev_snow_patch , & ! Input: [real(r8) (:) ] evaporation flux from snow (mm H2O/s) [+ to atm] qflx_ev_soil => waterfluxbulk_inst%qflx_ev_soil_patch , & ! Input: [real(r8) (:) ] evaporation flux from soil (mm H2O/s) [+ to atm] @@ -1649,10 +2051,16 @@ subroutine ComputeGroundHeatFluxAndDeriv(bounds, & sabg => solarabs_inst%sabg_patch , & ! Input: [real(r8) (:) ] solar radiation absorbed by ground (W/m**2) sabg_soil => solarabs_inst%sabg_soil_patch , & ! Input: [real(r8) (:) ] solar radiation absorbed by soil (W/m**2) + sabg_nvp => solarabs_inst%sabg_nvp_patch , & ! [PORTED by Hui Tang: exposed-NVP moss surface solar (W/m2)] + sabg_soil_bandloop => solarabs_inst%sabg_soil_bandloop_patch , & ! [PORTED by Hui Tang: band-loop ground absorption snapshot for SABG tile] sabg_snow => solarabs_inst%sabg_snow_patch , & ! Input: [real(r8) (:) ] solar radiation absorbed by snow (W/m**2) sabg_chk => solarabs_inst%sabg_chk_patch , & ! Output: [real(r8) (:) ] sum of soil/snow using current fsno, for balance check sabg_lyr => solarabs_inst%sabg_lyr_patch , & ! Output: [real(r8) (:,:) ] absorbed solar radiation (pft,lyr) [W/m2] - + ! [PORTED by Hui Tang: NVP surface flux computation] + jbot_sno => col%jbot_sno , & ! Input: [integer (:) ] bottom snow layer index (0 or -1 for NVP) + eflx_sh_nvp => energyflux_inst%eflx_sh_nvp_patch , & ! Input: [real(r8) (:) ] sensible heat flux from NVP [W/m2] + qflx_ev_nvp => waterfluxbulk_inst%qflx_ev_nvp_patch , & ! Input: [real(r8) (:) ] evaporation flux from NVP [mm/s] + begc => bounds%begc , & ! Input: [integer ] beginning column index endc => bounds%endc & ! Input: [integer ] ending column index ) @@ -1670,9 +2078,16 @@ subroutine ComputeGroundHeatFluxAndDeriv(bounds, & lwrad_emit_snow(c) = emg(c) * sb * t_soisno(c,snl(c)+1)**4 lwrad_emit_soil(c) = emg(c) * sb * t_soisno(c,1)**4 lwrad_emit_h2osfc(c) = emg(c) * sb * t_h2osfc(c)**4 + ! [PORTED by Hui Tang: NVP LW emission from layer 0 temperature] + if (col%nvp_layer_active(c)) then + lwrad_emit_nvp(c) = emg(c) * sb * t_soisno(c,0)**4 + else + lwrad_emit_nvp(c) = 0._r8 + end if end do hs_soil(begc:endc) = 0._r8 + sabg_soil_col(begc:endc) = 0._r8 ! [PORTED by Hui Tang: bare-soil surface solar accumulator] hs_h2osfc(begc:endc) = 0._r8 hs(begc:endc) = 0._r8 dhsdT(begc:endc) = 0._r8 @@ -1687,6 +2102,55 @@ subroutine ComputeGroundHeatFluxAndDeriv(bounds, & - (eflx_sh_grnd(p)+qflx_evap_soi(p)*htvp(c)) ! save sabg for balancecheck, in case frac_sno is set to zero later sabg_chk(p) = frac_sno_eff(c) * sabg_snow(p) + (1._r8 - frac_sno_eff(c) ) * sabg_soil(p) + ! [PORTED by Hui Tang: include NVP layer-0 absorbed solar in sabg_chk so the surface + ! energy balance (BalanceCheckMod errseb) is consistent with eflx_soil_grnd + ! (SoilFluxesMod:411), which adds sabg_lyr(p,0) back. Without this, errseb = -sabg_lyr(p,0) + ! (large when snow-free: sabg_lyr(p,0) is the NVP Beer's-law absorption). sabg_lyr(p,0) + ! is already per unit ground area, so it is added at full weight to mirror SoilFluxesMod.] + if (use_nvp .and. col%nvp_layer_active(c)) then + ! [PORTED by Hui Tang (2026-06-12): mirror the eflx_soil_grnd add-back in SoilFluxesMod + ! — add the EXPOSED-moss surface solar at frac_nvp_eff weight (matching the solve's + ! hs_nvp = sabg_nvp*frac_nvp_eff). The BURIED-moss internal sabg_lyr(p,0) is already in + ! frac_sno_eff*sabg_snow above (SNICAR sum), so it is NOT re-added. errseb/errsoi + ! consistency invariant.] + frac_nvp_eff = min(1._r8 - frac_sno_eff(c), & + max(0._r8, col%frac_nvp(c) - frac_sno_eff(c))) + ! [PORTED by Hui Tang (2026-06-12): sabg_nvp is per-COLUMN (carries nvp_frac), so the + ! EXPOSED-moss surface solar entering the column is nvp_exp*sabg_nvp = + ! (frac_nvp_eff/frac_nvp)*sabg_nvp, NOT frac_nvp_eff*sabg_nvp (that double-counted the + ! coverage). Mirrors eflx_soil_grnd in SoilFluxesMod and the solve's hs_nvp deposit.] + sabg_chk(p) = sabg_chk(p) + (frac_nvp_eff/col%frac_nvp(c))*sabg_nvp(p) + end if + + ! [PORTED by Hui Tang: make the SABG diagnostic read the TRUE exposed-surface absorption. + ! Previously sabg(p) was overridden to sabg_chk, which under snow uses the SNICAR + ! soil-LAYER absorption sabg_soil=sabg_lyr(p,1) (solar that penetrates the snowpack AND + ! the NVP layer to soil) — tiny during melt, so SABG collapsed unphysically. Instead + ! build a tile: SNICAR snow absorption on the snow-covered fraction + the band-loop + ! (albsod) ground absorption on the exposed fraction (sabg_soil_bandloop, snapshotted in + ! SurfaceRadiationMod before the carve-out / SNICAR reassignment). sabg_soil_bandloop is + ! the LUMPED NVP+soil absorption (albsod treats all non-reflected flux as absorbed), so + ! the NVP term is already included — no separate +sabg_lyr(p,0) (that would double-count). + ! Snow-free: frac_sno_eff=0 => SABG = sabg_soil_bandloop = old sabg_chk (summer unchanged). + ! DIAGNOSTIC ONLY and decoupled from the budget: errseb uses sabg_chk (BalanceCheckMod + ! :1035, non-urban), errsoi uses eflx_soil_grnd, and the solve uses sabg_lyr — ALL + ! unchanged. So this deliberately makes SABG differ from the model's conserved SW input. + ! Placed after eflx_gnet(p) (line ~1986) which already used the original sabg(p), and + ! ComputeGroundHeatFluxAndDeriv runs once per timestep, so it cannot feed back.] + + !if (use_nvp .and. col%nvp_layer_active(c)) then + ! [PORTED by Hui Tang (2026-06-13): Phase 4 — add the EXPOSED-moss surface solar to the SABG + ! tile so the offline balance SABV+SABG-FIRA-FSH-LH-FGR closes on the moss term: FGR carries + ! nvp_exp*sabg_nvp (SoilFluxesMod), so SABG must too. nvp_exp=frac_nvp_eff/frac_nvp. + ! frac_nvp_eff is the same value computed in the sabg_chk block just above. The remaining + ! offline residual is the SOIL seam (1-fse)*(sabg_soil_bandloop - sabg_lyr(p,1)) and the + ! opaque-vs-Beer moss difference — both quantified by the Phase-4 diagnostic in + ! SurfaceRadiationMod before the (physics-affecting) sabg_soil/line-839 reconciliation.] + ! frac_nvp_eff = min(1._r8 - frac_sno_eff(c), & + ! max(0._r8, col%frac_nvp(c) - frac_sno_eff(c))) + ! sabg(p) = frac_sno_eff(c)*sabg_snow(p) + (1._r8 - frac_sno_eff(c))*sabg_soil(p) & + ! + (frac_nvp_eff/col%frac_nvp(c))*sabg_nvp(p) + !end if eflx_gnet_snow = sabg_snow(p) + dlrad(p) & + (1._r8-frac_veg_nosno(p))*emg(c)*forc_lwrad(c) - lwrad_emit_snow(c) & @@ -1699,6 +2163,20 @@ subroutine ComputeGroundHeatFluxAndDeriv(bounds, & eflx_gnet_h2osfc = sabg_soil(p) + dlrad(p) & + (1._r8-frac_veg_nosno(p))*emg(c)*forc_lwrad(c) - lwrad_emit_h2osfc(c) & - (eflx_sh_h2osfc(p)+qflx_ev_h2osfc(p)*htvp(c)) + ! [PORTED by Hui Tang (2026-06-14): the surface water sits OVER the ground, which here is mostly + ! moss, so it absorbs the moss-under-water SURFACE solar (not just sabg_soil). The moss-under- + ! water column fraction = frac_nvp_eff_solar - frac_nvp_eff (moss not-under-snow minus moss + ! exposed-to-air); its absorption (frac_uw/frac_nvp)*sabg_nvp is added here per h2osfc area + ! (=> /frac_h2osfc). This is the energy the MOSS layer cannot dissipate (its cooling weight + ! nvp_exp -> 0 under deep water -> divergence); the water CAN dissipate it via its own surface + ! fluxes. Bounded by sabg_nvp/frac_nvp since frac_uw <= frac_h2osfc. Paired with hs_nvp now + ! depositing only the EXPOSED moss (nvp_exp); together they sum to nvp_exp_solar*sabg_nvp so + ! the FGR/sabg_chk/carve-out total accounting is unchanged.] + if (use_nvp .and. col%nvp_layer_active(c) .and. frac_h2osfc(c) > 1.e-3_r8) then + eflx_gnet_h2osfc = eflx_gnet_h2osfc + sabg_nvp(p)/col%frac_nvp(c)/frac_h2osfc(c) * & + ( min(1._r8 - frac_sno_eff(c), max(0._r8, col%frac_nvp(c) - frac_sno_eff(c))) & + - min(1._r8 - frac_h2osfc(c) - frac_sno_eff(c), max(0._r8, col%frac_nvp(c) - frac_sno_eff(c))) ) + end if else ! For urban columns we use the net longwave radiation (eflx_lwrad_net) because of ! interactions between urban columns. @@ -1740,6 +2218,10 @@ subroutine ComputeGroundHeatFluxAndDeriv(bounds, & dhsdT(c) = dhsdT(c) + dgnetdT(p) * patch%wtcol(p) ! separate surface fluxes for soil/snow hs_soil(c) = hs_soil(c) + eflx_gnet_soil * patch%wtcol(p) + ! [PORTED by Hui Tang (2026-06-13): accumulate the bare-soil SURFACE solar (sabg_soil) at column + ! level so the snl<0 solve can deposit it at the (1-fse) radiation weight (h2osfc is not a solar + ! tile) instead of the frac_soil flux weight carried by hs_soil.] + sabg_soil_col(c) = sabg_soil_col(c) + sabg_soil(p) * patch%wtcol(p) hs_h2osfc(c) = hs_h2osfc(c) + eflx_gnet_h2osfc * patch%wtcol(p) end do @@ -1756,6 +2238,7 @@ subroutine ComputeGroundHeatFluxAndDeriv(bounds, & sabg_lyr_col(begc:endc,-nlevsno+1:1) = 0._r8 hs_top(begc:endc) = 0._r8 hs_top_snow(begc:endc) = 0._r8 + hs_nvp(begc:endc) = 0._r8 ! [PORTED by Hui Tang: NVP surface flux] do fp = 1,num_nolakep p = filter_nolakep(fp) @@ -1782,6 +2265,89 @@ subroutine ComputeGroundHeatFluxAndDeriv(bounds, & do j = lyr_top,1,1 sabg_lyr_col(c,j) = sabg_lyr_col(c,j) + sabg_lyr(p,j) * patch%wtcol(p) enddo + + ! [PORTED by Hui Tang: accumulate NVP surface BC and layer-0 solar absorption] + ! NVP layer 0 is above soil layer 1 when active (jbot_sno=-1, snl=0). + ! Its surface BC uses sabg_lyr(p,0) and NVP-specific turbulent/LW fluxes. + ! When snow covers NVP (snl<0), layer 0 is an internal snow layer in the + ! tridiagonal solver; the main loop (do j=lyr_top,1) already accumulates + ! sabg_lyr_col(c,0), so we must NOT add it again here or it is double-counted. + if (col%nvp_layer_active(c)) then + ! [PORTED by Hui Tang: exposure-weight the moss surface flux. The WHOLE eflx_gnet_nvp + ! below (solar sabg_nvp + down/emitted LW + sensible + latent) is the moss surface flux; + ! Each patch (nvp or non-nvp patches) gets a share of contribution from nvp gnet (which + ! is unphysical), but the sum of NVP patches and non-NVP patches = frac_nvp_eff at column + ! level to form the exposed-moss per-column contribution. frac_nvp_eff is the exposed + ! (snow-free) moss area fraction.] + frac_nvp_eff = min(1._r8 - frac_h2osfc(c) - frac_sno_eff(c), & + max(0._r8, col%frac_nvp(c) - frac_sno_eff(c))) + nvp_exp = frac_nvp_eff / col%frac_nvp(c) ! FLUX exposed fraction of the moss (with-fh2o) [-] + ! [PORTED by Hui Tang (2026-06-13): SOLAR exposed-moss weight uses NO fh2o cap — h2osfc + ! is a tile for surface LW/turbulent fluxes but NOT for solar (albgrd has no h2osfc term). + ! So the moss SOLAR is deposited at nvp_exp_solar (no fh2o), matching the accounting + ! (carve-out, FGR add-back, sabg_chk); the LW/turbulent at nvp_exp (with fh2o).] + nvp_exp_solar = min(1._r8 - frac_sno_eff(c), & + max(0._r8, col%frac_nvp(c) - frac_sno_eff(c))) / col%frac_nvp(c) + + ! [PORTED by Hui Tang: UNIFIED hs_nvp + ! for BOTH snl==0 and snl<0. hs_nvp carries the exposed-NVP surface flux, weighted by + ! frac_nvp_eff*wtcol (summed over patches -> frac_nvp_eff at column level). Solar enters + ! the NVP layer via sabg_nvp (surface, below) and sabg_lyr_col(c,0) (buried internal): + ! snl<0 via the do j=lyr_top,1 loop above; snl==0 via the explicit add below. This + ! replaces the previous snl==0 "collapse" (full solar-inclusive hs_nvp, bare soil folded + ! into NVP) with the 3-way split (exposed moss at j=0, bare soil at j=1) for continuity.] + ! [PORTED by Hui Tang (2026-06-11): hs_nvp now carries the EXPOSED-moss SURFACE solar + ! sabg_nvp(p) (Beer's law), exactly as hs_soil carries sabg_soil. The whole gnet + ! (incl. solar) is weighted by frac_nvp_eff*wtcol, so the exposed solar gets + ! the -dhsdT surface thermostat — this is what was missing (overheating). The BURIED + ! internal solar is sabg_lyr(p,0) (=snicar for snl<0, =0 for snl==0), accumulated into + ! sabg_lyr_col(c,0) and applied at fse weight in the j=0 RHS (like fse*sabg_lyr_col(c,1) + ! for soil).] + ! [PORTED by Hui Tang (2026-06-12): sabg_nvp is per-COLUMN (fabd_nvp carries nvp_frac), + ! but eflx_gnet_nvp is the moss surface energy balance PER UNIT MOSS area (the LW/turbulent + ! terms are per-moss), so convert the solar to per-moss with /col%frac_nvp(c). The exposed + ! weighting (nvp_exp) is applied afterwards in hs_nvp = eflx_gnet_nvp*nvp_exp*wtcol, so the + ! per-column moss solar deposited = frac_nvp*nvp_exp*(sabg_nvp/frac_nvp) = nvp_exp*sabg_nvp.] + eflx_gnet_nvp = sabg_nvp(p)/col%frac_nvp(c) + dlrad(p) & + + (1._r8-frac_veg_nosno(p))*emg(c)*forc_lwrad(c) - lwrad_emit_nvp(c) & + - (eflx_sh_nvp(p) + qflx_ev_nvp(p)*htvp(c)) + ! [PORTED by Hui Tang (2026-06-12): option (b) — per-MOSS-area cv requires the SOLVE-side + ! surface flux on the per-moss basis: nvp_exp*eflx_gnet (=frac_nvp_eff/frac_nvp), NOT the + ! per-column frac_nvp_eff. The frac_nvp in cv/interface bridges to the per-column + ! accounting (eflx_soil_grnd, sabg_chk stay frac_nvp_eff), exactly like snow. Mixing + ! per-moss cv with per-column hs_nvp under-cooled the moss -> overheat/crash.] + ! [PORTED by Hui Tang (2026-06-14): the moss layer deposits only the EXPOSED-to-air solar+flux + ! at nvp_exp (with-fh2o). The moss-under-water surface solar is NOT deposited here — it goes + ! to eflx_gnet_h2osfc above (the water can dissipate it; the moss cannot, nvp_exp->0 under + ! deep water -> divergence). moss(nvp_exp) + water((nvp_exp_solar-nvp_exp)) = nvp_exp_solar, + ! so the FGR/sabg_chk/carve-out total (nvp_exp_solar*sabg_nvp) is unchanged.] + hs_nvp(c) = hs_nvp(c) + eflx_gnet_nvp * nvp_exp * patch%wtcol(p) + ! sabg_lyr_col(c,0) for snl==0 (the do j=lyr_top,1 loop above only covers j>=1 then); + ! sabg_lyr(p,0)=0 for snl==0 so this adds nothing, but keep it for the snl<0 internal path + ! symmetry. For snl<0 the do-loop already set sabg_lyr_col(c,0)=snicar*wtcol. + if (snl(c) == 0) then + sabg_lyr_col(c,0) = sabg_lyr_col(c,0) + sabg_lyr(p,0) * patch%wtcol(p) + end if + ! [DBG NVP sabg] solar absorbed by NVP and total surface energy flux + write(iulog,*) '[DBG NVP sabg] p=', p, ' c=', c, & + ' sabg_lyr(p,0)=', sabg_lyr(p,0), & + ' eflx_gnet_nvp=', eflx_gnet_nvp, & + ' hs_nvp(c)=', hs_nvp(c) + ! [PORTED by Hui Tang: VERIFY diagnostic (remove after confirmation) — exposure + ! weighting is now APPLIED in eflx_gnet_nvp above. turb_unweighted is the old value, + ! turb_applied = frac_nvp_eff*turb_unweighted is what now enters the solve.] + if (frac_sno_eff(c) > 0._r8) then + write(iulog,*) '[NVP EXP DIAG] nstep=', get_nstep(), ' c=', c, ' p=', p, & + ' snl=', snl(c), ' frac_nvp=', col%frac_nvp(c), & + ' frac_sno_eff=', frac_sno_eff(c), ' frac_h2osfc=', frac_h2osfc(c), & + ' frac_nvp_eff=', frac_nvp_eff + write(iulog,*) '[NVP EXP DIAG] eflx_sh_nvp=', eflx_sh_nvp(p), & + ' qflx_ev_nvp=', qflx_ev_nvp(p), & + ' turb_unweighted=', (eflx_sh_nvp(p)+qflx_ev_nvp(p)*htvp(c)), & + ' turb_applied=', frac_nvp_eff*(eflx_sh_nvp(p)+qflx_ev_nvp(p)*htvp(c)), & + ' eflx_gnet_nvp=', eflx_gnet_nvp + end if + end if else hs_top(c) = hs_top(c) + eflx_gnet(p)*patch%wtcol(p) @@ -1911,7 +2477,7 @@ end subroutine ComputeHeatDiffFluxAndFactor !----------------------------------------------------------------------- subroutine SetRHSVec(bounds, num_nolakec, filter_nolakec, dtime, & - hs_h2osfc, hs_top_snow, hs_soil, hs_top, dhsdT, sabg_lyr_col, tk, & + hs_h2osfc, hs_top_snow, hs_soil, hs_top, hs_nvp, dhsdT, sabg_lyr_col, sabg_soil_col, tk, & tk_h2osfc, fact, fn, c_h2osfc, dz_h2osfc, & temperature_inst, waterdiagnosticbulk_inst, rvector) @@ -1943,8 +2509,10 @@ subroutine SetRHSVec(bounds, num_nolakec, filter_nolakec, dtime, & real(r8) , intent(in) :: hs_top_snow( bounds%begc: ) ! heat flux on top snow layer [W/m2] real(r8) , intent(in) :: hs_soil( bounds%begc: ) ! heat flux on soil [W/m2] real(r8) , intent(in) :: hs_top( bounds%begc: ) ! net energy flux into surface layer (col) [W/m2] + real(r8) , intent(in) :: hs_nvp( bounds%begc: ) ! [PORTED by Hui Tang: surface heat flux at NVP layer 0] [W/m2] real(r8) , intent(in) :: dhsdT( bounds%begc: ) ! temperature derivative of "hs" [col] real(r8) , intent(in) :: sabg_lyr_col( bounds%begc: , -nlevsno+1: ) ! absorbed solar radiation (col,lyr) [W/m2] + real(r8) , intent(in) :: sabg_soil_col( bounds%begc: ) ! [PORTED by Hui Tang: col-level bare-soil surface solar [W/m2]] real(r8) , intent(in) :: tk( bounds%begc: , -nlevsno+1: ) ! thermal conductivity [W/(m K)] real(r8) , intent(in) :: tk_h2osfc( bounds%begc: ) ! thermal conductivity of h2osfc [W/(m K)] [col] real(r8) , intent(in) :: fact( bounds%begc: , -nlevsno+1: ) ! used in computing tridiagonal matrix [col, lev] @@ -2002,12 +2570,15 @@ subroutine SetRHSVec(bounds, num_nolakec, filter_nolakec, dtime, & call SetRHSVec_Snow(bounds, num_nolakec, filter_nolakec, & hs_top_snow( begc:endc ), & hs_top( begc:endc ), & + hs_nvp( begc:endc ), & dhsdT( begc:endc ), & sabg_lyr_col (begc:endc, -nlevsno+1: ), & fact( begc:endc, -nlevsno+1: ), & fn( begc:endc, -nlevsno+1: ), & t_soisno ( begc:endc, -nlevsno+1: ), & t_h2osfc ( begc:endc ), & + frac_sno_eff( begc:endc ), & ! [PORTED by Hui Tang: Phase 1c] + frac_h2osfc( begc:endc ), & ! [PORTED by Hui Tang: Phase 1c] rt_snow( begc:endc, -nlevsno:)) ! Set entries in RHS vector for surface water layer @@ -2030,6 +2601,7 @@ subroutine SetRHSVec(bounds, num_nolakec, filter_nolakec, dtime, & hs_top( begc:endc ), & dhsdT( begc:endc ), & sabg_lyr_col (begc:endc, -nlevsno+1: ), & + sabg_soil_col( begc:endc ), & ! [PORTED by Hui Tang] fact( begc:endc, -nlevsno+1: ), & fn( begc:endc, -nlevsno+1: ), & fn_h2osfc( begc:endc ), & @@ -2053,8 +2625,8 @@ end subroutine SetRHSVec !----------------------------------------------------------------------- subroutine SetRHSVec_Snow(bounds, num_nolakec, filter_nolakec, & - hs_top_snow, hs_top, dhsdT, sabg_lyr_col, & - fact, fn, t_soisno, t_h2osfc, rt) + hs_top_snow, hs_top, hs_nvp, dhsdT, sabg_lyr_col, & + fact, fn, t_soisno, t_h2osfc, frac_sno_eff, frac_h2osfc, rt) ! ! !DESCRIPTION: ! Sets up RHS vector corresponding to snow layers for all columns. @@ -2064,6 +2636,7 @@ subroutine SetRHSVec_Snow(bounds, num_nolakec, filter_nolakec, & use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall use column_varcon , only : icol_road_perv, icol_road_imperv use clm_varpar , only : nlevsno, nlevmaxurbgrnd + use clm_varctl , only : use_nvp ! [PORTED by Hui Tang: NVP top-layer surface BC] ! ! !ARGUMENTS: implicit none @@ -2072,12 +2645,15 @@ subroutine SetRHSVec_Snow(bounds, num_nolakec, filter_nolakec, & integer , intent(in) :: filter_nolakec(:) ! column filter for non-lake points real(r8), intent(in) :: hs_top_snow( bounds%begc: ) ! heat flux on top snow layer [W/m2] real(r8), intent(in) :: hs_top( bounds%begc: ) ! net energy flux into surface layer (col) [W/m2] + real(r8), intent(in) :: hs_nvp( bounds%begc: ) ! [PORTED by Hui Tang: surface heat flux at NVP layer 0] [W/m2] real(r8), intent(in) :: dhsdT( bounds%begc: ) ! temperature derivative of "hs" [col] real(r8), intent(in) :: sabg_lyr_col( bounds%begc: , -nlevsno+1: ) ! absorbed solar radiation (col,lyr) [W/m2] real(r8), intent(in) :: fact( bounds%begc: , -nlevsno+1: ) ! used in computing tridiagonal matrix [col, lev] real(r8), intent(in) :: fn (bounds%begc: , -nlevsno+1: ) ! heat diffusion through the layer interface [W/m2] - real(r8), intent(in) :: t_soisno(bounds%begc:, -nlevsno+1:) ! soil temperature [K] - real(r8), intent(in) :: t_h2osfc(bounds%begc:) ! surface water temperature [K] + real(r8), intent(in) :: t_soisno(bounds%begc:, -nlevsno+1:) ! soil temperature [K] + real(r8), intent(in) :: t_h2osfc(bounds%begc:) ! surface water temperature [K] + real(r8), intent(in) :: frac_sno_eff(bounds%begc: ) ! [PORTED by Hui Tang: fraction of ground covered by snow (0 to 1)] + real(r8), intent(in) :: frac_h2osfc(bounds%begc: ) ! [PORTED by Hui Tang: fraction of ground covered by surface water (0 to 1)] real(r8), intent(out) :: rt(bounds%begc: , -nlevsno: ) ! rhs vector entries !----------------------------------------------------------------------- ! @@ -2086,6 +2662,10 @@ subroutine SetRHSVec_Snow(bounds, num_nolakec, filter_nolakec, & integer :: fc ! lake filtered column indices real(r8) :: dzp, dzm ! used in computing tridiagonal matrix real(r8) :: hs_top_lev(bounds%endc) + real(r8) :: frac_nvp_eff ! [PORTED by Hui Tang: exposed NVP fraction (Phase 1c)] + real(r8) :: w_cond ! [PORTED by Hui Tang: NVP-over-soil conduction weight = frac_sno_eff + frac_nvp_eff] + real(r8) :: nvp_exp ! [PORTED by Hui Tang: exposed fraction of the moss = frac_nvp_eff/frac_nvp (per-moss surface weight)] + real(r8) :: sno_exp ! [PORTED by Hui Tang: buried (under-snow) fraction of the moss = frac_sno_eff/frac_nvp (per-moss snow-conduction/buried-solar weight)] ! Enforce expected array sizes SHR_ASSERT_ALL_FL((ubound(hs_top_snow) == (/bounds%endc/)), sourcefile, __LINE__) @@ -2096,12 +2676,17 @@ subroutine SetRHSVec_Snow(bounds, num_nolakec, filter_nolakec, & SHR_ASSERT_ALL_FL((ubound(fn) == (/bounds%endc, nlevmaxurbgrnd/)), sourcefile, __LINE__) SHR_ASSERT_ALL_FL((ubound(t_soisno) == (/bounds%endc, nlevmaxurbgrnd/)), sourcefile, __LINE__) SHR_ASSERT_ALL_FL((ubound(t_h2osfc) == (/bounds%endc/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(frac_sno_eff) == (/bounds%endc/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(frac_h2osfc) == (/bounds%endc/)), sourcefile, __LINE__) SHR_ASSERT_ALL_FL((ubound(rt) == (/bounds%endc, -1/)), sourcefile, __LINE__) - associate( & - begc => bounds%begc , & ! Input: [integer ] beginning column index - endc => bounds%endc , & ! Input: [integer ] ending column index - z => col%z & ! Input: [real(r8) (:,:) ] layer thickness [m] + associate( & + begc => bounds%begc , & ! Input: [integer ] beginning column index + endc => bounds%endc , & ! Input: [integer ] ending column index + z => col%z , & ! Input: [real(r8) (:,:) ] layer thickness [m] + ! [PORTED by Hui Tang: NVP top-layer detection] + snl => col%snl , & ! Input: [integer (:) ] number of snow layers + jbot_sno => col%jbot_sno & ! Input: [integer (:) ] bottom snow index (-1 = NVP active) ) ! Initialize @@ -2133,12 +2718,56 @@ subroutine SetRHSVec_Snow(bounds, num_nolakec, filter_nolakec, & rt(c,j-1) = t_soisno(c,j) + fact(c,j)*( hs_top_lev(c) & - dhsdT(c)*t_soisno(c,j) + cnfac*fn(c,j) ) + ! [PORTED by Hui Tang: Phase 1c — NVP layer 0 dual surface under partial snow (snl<0). + ! Tested BEFORE the "j > snl+1" internal branch (which would treat j=0 as buried). + ! Exposed moss (frac_nvp_eff) gets the atmospheric surface flux hs_nvp (per-column, + ! NON-solar; solar in sabg_lyr_col(c,0)); snow-covered moss (frac_sno_eff) conducts from + ! snow above fn(-1); NVP->soil conduction fn(0) over w_cond = frac_sno_eff + frac_nvp_eff.] + else if (j == 0 .and. use_nvp .and. jbot_sno(c) == -1 .and. snl(c) < 0) then + dzm = z(c,0) - z(c,-1) + dzp = z(c,1) - z(c,0) + frac_nvp_eff = min(1._r8 - frac_h2osfc(c) - frac_sno_eff(c), & + max(0._r8, col%frac_nvp(c) - frac_sno_eff(c))) + w_cond = frac_sno_eff(c) + frac_nvp_eff + nvp_exp = frac_nvp_eff / col%frac_nvp(c) ! exposed fraction of the moss [-] + sno_exp = frac_sno_eff(c) / col%frac_nvp(c) ! buried (under-snow) fraction of the moss [-] + ! [PORTED by Hui Tang (2026-06-12): option (b) — ALL per-column fluxes into the per-moss-area + ! moss layer are divided by frac_nvp (per-column -> per-moss). Surface: nvp_exp*dhsdT/hs_nvp. + ! Soil conduction fn(0): FULL on moss side (=frac_nvp/frac_nvp), w_cond on soil side. SNOW + ! conduction fn(-1) and BURIED internal solar sabg_lyr_col(c,0): both /frac_nvp via sno_exp + ! (=frac_sno_eff/frac_nvp). This CONSERVES at the moss/snow interface — snow loses + ! frac_sno_eff*fn(-1) per column, moss gains frac_nvp*sno_exp*fn(-1)=frac_sno_eff*fn(-1). + ! (Before this, per-moss cv under-counted the snow flux by frac_nvp -> winter errsoi leak.)] + rt(c,j-1) = t_soisno(c,0) + fact(c,0) * & + ( hs_nvp(c) - nvp_exp*dhsdT(c)*t_soisno(c,0) & + + cnfac*( fn(c,0) - sno_exp*fn(c,-1) ) ) & + + sno_exp*fact(c,0)*sabg_lyr_col(c,0) ! [PORTED by Hui Tang: buried-moss internal solar, per-moss (sno_exp=fse/frac_nvp); exposed solar is in hs_nvp] + else if (j > col%snl(c)+1) then dzm = (z(c,j)-z(c,j-1)) dzp = (z(c,j+1)-z(c,j)) rt(c,j-1) = t_soisno(c,j) + cnfac*fact(c,j)*( fn(c,j) - fn(c,j-1) ) rt(c,j-1) = rt(c,j-1) + fact(c,j)*sabg_lyr_col(c,j) + + ! [PORTED by Hui Tang: NVP layer 0 surface BC when snl==0 (no snow), 3-way split + ! (2026-06-11). j=0 < snl+1=1 so it falls through the conditions above. With no snow, + ! frac_sno_eff=0 so w_cond = frac_nvp_eff and there is no fn(-1) snow-conduction term: + ! exposed moss (frac_nvp_eff) gets hs_nvp WHICH NOW INCLUDES the SURFACE solar sabg_nvp + ! (so the solar gets the -dhsdT thermostat) + conduction frac_nvp_eff*fn(0). The buried + ! internal solar term frac_sno_eff*sabg_lyr_col(c,0) vanishes here (frac_sno_eff=0). The + ! bare-soil surface flux is applied at j=1 (SetRHSVec_Soil).] + else if (j == 0 .and. use_nvp .and. jbot_sno(c) == -1 .and. snl(c) == 0) then + frac_nvp_eff = min(1._r8 - frac_h2osfc(c) - frac_sno_eff(c), & + max(0._r8, col%frac_nvp(c) - frac_sno_eff(c))) + nvp_exp = frac_nvp_eff / col%frac_nvp(c) ! exposed fraction of the moss [-] (=1 here, snl==0) + ! [PORTED by Hui Tang (2026-06-12): option (b) step 2 — moss/soil conduction fn(0) at + ! FULL weight on the moss side (per-moss-area cv); soil side (j=1) keeps frac_nvp. The + ! surface thermostat is per-moss nvp_exp*dhsdT (=dhsdT here, nvp_exp=1) to match hs_nvp.] + rt(c,j-1) = t_soisno(c,0) + fact(c,0) * & + ( hs_nvp(c) - nvp_exp*dhsdT(c)*t_soisno(c,0) & + + cnfac*fn(c,0) ) & + + frac_sno_eff(c)*fact(c,0)*sabg_lyr_col(c,0) end if end do end do @@ -2202,12 +2831,21 @@ subroutine SetRHSVec_StandingSurfaceWater(bounds, num_nolakec, filter_nolakec, d do fc = 1,num_nolakec c = filter_nolakec(fc) - ! surface water layer has two coefficients - dzm=(0.5*dz_h2osfc(c)+col%z(c,1)) - - fn_h2osfc(c)=tk_h2osfc(c)*(t_soisno(c,1)-t_h2osfc(c))/dzm - rt(c,1)= t_h2osfc(c) + (dtime/c_h2osfc(c)) & - *( hs_h2osfc(c) - dhsdT(c)*t_h2osfc(c) + cnfac*fn_h2osfc(c) )!rhs for h2osfc + ! When there is no standing water (c_h2osfc == thin_sfclayer), dtime/c_h2osfc = 1.8e9 + ! which amplifies any non-zero hs_h2osfc by ~10^9, producing an unphysically huge RHS + ! that corrupts the banded solver and cascades to NaN in subsequent timesteps. + ! Use a trivial identity row (rt = t_h2osfc, no coupling) instead. + if (c_h2osfc(c) <= thin_sfclayer) then + fn_h2osfc(c) = 0.0_r8 + rt(c,1) = t_h2osfc(c) + else + ! surface water layer has two coefficients + dzm=(0.5*dz_h2osfc(c)+col%z(c,1)) + + fn_h2osfc(c)=tk_h2osfc(c)*(t_soisno(c,1)-t_h2osfc(c))/dzm + rt(c,1)= t_h2osfc(c) + (dtime/c_h2osfc(c)) & + *( hs_h2osfc(c) - dhsdT(c)*t_h2osfc(c) + cnfac*fn_h2osfc(c) )!rhs for h2osfc + end if enddo @@ -2215,7 +2853,7 @@ end subroutine SetRHSVec_StandingSurfaceWater !----------------------------------------------------------------------- subroutine SetRHSVec_Soil(bounds, num_nolakec, filter_nolakec, & - hs_top_snow, hs_soil, hs_top, dhsdT, sabg_lyr_col, fact, fn, fn_h2osfc, c_h2osfc, & + hs_top_snow, hs_soil, hs_top, dhsdT, sabg_lyr_col, sabg_soil_col, fact, fn, fn_h2osfc, c_h2osfc, & frac_h2osfc, frac_sno_eff, t_soisno, rt) ! ! !DESCRIPTION: @@ -2226,6 +2864,7 @@ subroutine SetRHSVec_Soil(bounds, num_nolakec, filter_nolakec, & use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall use column_varcon , only : icol_road_perv, icol_road_imperv use clm_varpar , only : nlevsno, nlevurb, nlevgrnd, nlevmaxurbgrnd + use clm_varctl , only : use_nvp ! [PORTED by Hui Tang: NVP interior layer treatment] ! ! !ARGUMENTS: implicit none @@ -2237,6 +2876,7 @@ subroutine SetRHSVec_Soil(bounds, num_nolakec, filter_nolakec, & real(r8), intent(in) :: hs_top(bounds%begc: ) ! net energy flux into surface layer (col) [W/m2] real(r8), intent(in) :: dhsdT(bounds%begc: ) ! temperature derivative of "hs" [col] real(r8), intent(in) :: sabg_lyr_col(bounds%begc:, -nlevsno+1: ) ! absorbed solar radiation (col,lyr) [W/m2] + real(r8), intent(in) :: sabg_soil_col(bounds%begc:) ! [PORTED by Hui Tang: col-level bare-soil surface solar [W/m2]] real(r8), intent(in) :: fact( bounds%begc: , -nlevsno+1: ) ! used in computing tridiagonal matrix [col, lev] real(r8), intent(in) :: fn (bounds%begc: ,-nlevsno+1: ) ! heat diffusion through the layer interface [W/m2] real(r8), intent(in) :: fn_h2osfc (bounds%begc: ) ! heat diffusion through standing-water/soil interface [W/m2] @@ -2250,6 +2890,9 @@ subroutine SetRHSVec_Soil(bounds, num_nolakec, filter_nolakec, & ! !LOCAL VARIABLES: integer :: j,c,l ! indices integer :: fc ! lake filtered column indices + real(r8) :: frac_nvp_eff ! [PORTED by Hui Tang: exposed NVP fraction (Phase 1c)] + real(r8) :: w_cond ! [PORTED by Hui Tang: NVP-over-soil conduction weight = frac_sno_eff + frac_nvp_eff] + real(r8) :: frac_soil ! [PORTED by Hui Tang: bare-soil fraction (Phase 1c)] !----------------------------------------------------------------------- ! Enforce expected array sizes SHR_ASSERT_ALL_FL((ubound(hs_soil) == (/bounds%endc/)), sourcefile, __LINE__) @@ -2266,7 +2909,9 @@ subroutine SetRHSVec_Soil(bounds, num_nolakec, filter_nolakec, & associate(& begc => bounds%begc , & ! Input: [integer ] beginning column index - endc => bounds%endc & ! Input: [integer ] ending column index + endc => bounds%endc , & ! Input: [integer ] ending column index + ! [PORTED by Hui Tang: NVP interior layer treatment] + jbot_sno => col%jbot_sno & ! Input: [integer (:) ] bottom snow index (-1 = NVP active) ) ! Initialize @@ -2314,9 +2959,52 @@ subroutine SetRHSVec_Soil(bounds, num_nolakec, filter_nolakec, & (col%itype(c) == icol_road_imperv .or. & col%itype(c) == icol_road_perv)) then - if (j == col%snl(c)+1) then + ! [PORTED by Hui Tang: exclude NVP case — when NVP active, layer 1 is interior] + if (j == col%snl(c)+1 .and. .not. (use_nvp .and. jbot_sno(c) == -1)) then rt(c,j) = t_soisno(c,j) + fact(c,j)*( hs_top_snow(c) & - dhsdT(c)*t_soisno(c,j) + cnfac*fn(c,j) ) + ! [PORTED by Hui Tang: soil layer 1 below NVP, snl==0, 3-way split (2026-06-11). The + ! bare-soil fraction (frac_soil) gets its surface flux hs_soil here (exposed moss is at + ! j=0); up-conduction from NVP (fn(0)=fn(j-1)) weighted frac_nvp_eff = w_cond (frac_sno_eff + ! =0). Replaces the previous pure-internal treatment (collapse, bare soil folded into NVP). + ! Solar kept as full sabg_lyr_col(c,1) (snow-free).] + else if (j == 1 .and. use_nvp .and. jbot_sno(c) == -1 .and. col%snl(c) == 0) then + frac_nvp_eff = min(1._r8 - frac_h2osfc(c) - frac_sno_eff(c), & + max(0._r8, col%frac_nvp(c) - frac_sno_eff(c))) + frac_soil = max(0._r8, 1._r8 - frac_sno_eff(c) - frac_h2osfc(c) - frac_nvp_eff) + ! [PORTED by Hui Tang: SOLAR DOUBLE-COUNT FIX (2026-06-11). For snl==0, lyr_top=1 so + ! hs_soil(=eflx_gnet_soil) carries sabg_lyr(p,1) as its solar — the SAME quantity as + ! sabg_lyr_col(c,1) (SurfaceRadiationMod:793-795 sets sabg_lyr(p,1)=total soil solar, + ! no separate bare-soil-direct term). Adding frac_soil*hs_soil AND sabg_lyr_col(c,1) + ! double-counted sabg_lyr(p,1) by frac_soil, overheating the soil and (via the dry- + ! moss feedback) the moss. Subtract sabg_lyr_col(c,1) inside the bracket so the + ! bare-soil surface flux is NON-solar; the explicit term below supplies the soil + ! solar exactly once (= the collapse behaviour).] + rt(c,j) = t_soisno(c,j) + fact(c,j) & + *( frac_soil*(hs_soil(c) - sabg_lyr_col(c,1) - dhsdT(c)*t_soisno(c,j)) & + + cnfac*(fn(c,j) - frac_nvp_eff*fn(c,j-1)) ) + rt(c,j) = rt(c,j) + fact(c,j)*sabg_lyr_col(c,j) + ! [PORTED by Hui Tang: Phase 1c — soil layer 1 below NVP under partial snow (snl<0). + ! Exposed-moss surface flux enters at j=0, so j=1 gets only the bare-soil surface flux + ! hs_soil over frac_soil; up-conduction from NVP (fn(0)) weighted by w_cond = + ! frac_sno_eff + frac_nvp_eff, matching the j=0 down-conduction. Solar kept as fse.] + else if (j == 1 .and. use_nvp .and. jbot_sno(c) == -1 .and. col%snl(c) < 0) then + frac_nvp_eff = min(1._r8 - frac_h2osfc(c) - frac_sno_eff(c), & + max(0._r8, col%frac_nvp(c) - frac_sno_eff(c))) + w_cond = frac_sno_eff(c) + frac_nvp_eff + frac_soil = max(0._r8, 1._r8 - frac_sno_eff(c) - frac_h2osfc(c) - frac_nvp_eff) + rt(c,j) = t_soisno(c,j) + fact(c,j) & + *( frac_soil*(hs_soil(c) - dhsdT(c)*t_soisno(c,j)) & + + cnfac*(fn(c,j) - w_cond*fn(c,j-1)) ) + rt(c,j) = rt(c,j) + frac_sno_eff(c)*fact(c,j)*sabg_lyr_col(c,j) + ! [PORTED by Hui Tang (2026-06-13/14): SOLAR/flux split — frac_soil*hs_soil deposits the + ! bare-soil surface solar at the FLUX weight frac_soil. Lift it to the soil's true solar + ! share = (1-fse-fh2o)*sabg_soil = (frac_soil+frac_nvp_eff)*sabg_soil (bare soil + + ! soil-under-EXPOSED-moss). Add ((1-fse-fh2o)-frac_soil)=frac_nvp_eff times sabg_soil_col. + ! fh2o is EXCLUDED: the h2osfc gets its sabg_soil share via eflx_gnet_h2osfc; and the + ! moss-under-water solar now also goes to the water (not the soil/moss), so this no longer + ! destabilizes the moss (the moss deposits only its exposed solar at nvp_exp).] + rt(c,j) = rt(c,j) + fact(c,j)*frac_nvp_eff*sabg_soil_col(c) else if (j == 1) then ! this is the snow/soil interface layer rt(c,j) = t_soisno(c,j) + fact(c,j) & @@ -2430,6 +3118,7 @@ subroutine SetMatrix(bounds, num_nolakec, filter_nolakec, dtime, nband, & tk( begc:endc, -nlevsno+1: ), & fact( begc:endc, -nlevsno+1: ), & frac_sno_eff(begc:endc), & + frac_h2osfc(begc:endc), & ! [PORTED by Hui Tang: Phase 1c] bmatrix_snow( begc:endc, 1:, -nlevsno: ), & bmatrix_snow_soil( begc:endc, 1:, -1: )) @@ -2589,7 +3278,7 @@ end subroutine AssembleMatrixFromSubmatrices !----------------------------------------------------------------------- subroutine SetMatrix_Snow(bounds, num_nolakec, filter_nolakec, nband, & - dhsdT, tk, fact, frac_sno_eff, bmatrix_snow, bmatrix_snow_soil) + dhsdT, tk, fact, frac_sno_eff, frac_h2osfc, bmatrix_snow, bmatrix_snow_soil) ! ! !DESCRIPTION: ! Setup the matrix entries corresponding to internal snow layers @@ -2610,6 +3299,7 @@ subroutine SetMatrix_Snow(bounds, num_nolakec, filter_nolakec, nband, & real(r8), intent(in) :: tk(bounds%begc: ,-nlevsno+1: ) ! thermal conductivity [W/(m K)] real(r8), intent(in) :: fact( bounds%begc: , -nlevsno+1: ) ! used in computing tridiagonal matrix [col, lev] real(r8), intent(in) :: frac_sno_eff(bounds%begc: ) ! fraction of ground covered by snow (0 to 1) + real(r8), intent(in) :: frac_h2osfc(bounds%begc: ) ! [PORTED by Hui Tang: fraction of ground covered by surface water (0 to 1)] real(r8), intent(out) :: bmatrix_snow(bounds%begc: , 1:, -nlevsno: ) ! matrix enteries real(r8), intent(out) :: bmatrix_snow_soil(bounds%begc: , 1:,-1: ) ! matrix enteries ! @@ -2619,6 +3309,10 @@ subroutine SetMatrix_Snow(bounds, num_nolakec, filter_nolakec, nband, & integer :: nlev_thresh(1:num_nolakec) real(r8) :: dzm ! used in computing tridiagonal matrix real(r8) :: dzp ! used in computing tridiagonal matrix + real(r8) :: frac_nvp_eff ! [PORTED by Hui Tang: exposed NVP fraction (Phase 1c)] + real(r8) :: w_cond ! [PORTED by Hui Tang: NVP-over-soil conduction weight = frac_sno_eff + frac_nvp_eff] + real(r8) :: nvp_exp ! [PORTED by Hui Tang: exposed fraction of the moss = frac_nvp_eff/frac_nvp (per-moss surface weight)] + real(r8) :: sno_exp ! [PORTED by Hui Tang: buried (under-snow) fraction of the moss = frac_sno_eff/frac_nvp (per-moss snow-conduction/buried-solar weight)] !----------------------------------------------------------------------- ! Enforce expected array sizes @@ -2626,6 +3320,7 @@ subroutine SetMatrix_Snow(bounds, num_nolakec, filter_nolakec, nband, & SHR_ASSERT_ALL_FL((ubound(tk) == (/bounds%endc, nlevmaxurbgrnd/)), sourcefile, __LINE__) SHR_ASSERT_ALL_FL((ubound(fact) == (/bounds%endc, nlevmaxurbgrnd/)), sourcefile, __LINE__) SHR_ASSERT_ALL_FL((ubound(frac_sno_eff) == (/bounds%endc/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(frac_h2osfc) == (/bounds%endc/)), sourcefile, __LINE__) SHR_ASSERT_ALL_FL((ubound(bmatrix_snow) == (/bounds%endc, nband, -1/)), sourcefile, __LINE__) SHR_ASSERT_ALL_FL((ubound(bmatrix_snow_soil) == (/bounds%endc, nband, -1/)), sourcefile, __LINE__) @@ -2660,10 +3355,33 @@ subroutine SetMatrix_Snow(bounds, num_nolakec, filter_nolakec, nband, & do j = -nlevsno+1,0 do fc = 1,num_nolakec c = filter_nolakec(fc) - if (j >= col%snl(c)+1) then - dzp = z(c,j+1)-z(c,j) + ! [PORTED by Hui Tang: Phase 1c — NVP layer 0 dual-surface matrix under partial snow + ! (snl<0). Tested BEFORE the generic "j >= snl+1" branch. -frac_nvp_eff*dhsdT on the + ! diagonal (exposed-moss surface flux derivative); up-conduction to snow frac_sno_eff; + ! down-conduction to soil w_cond = frac_sno_eff + frac_nvp_eff. Snow rows keep full + ! fn(-1) (per-snow-area cv convention, as the standard snow/soil interface).] + if (j == 0 .and. use_nvp .and. col%jbot_sno(c) == -1 .and. col%snl(c) < 0) then + dzm = z(c,0) - z(c,-1) + dzp = z(c,1) - z(c,0) + frac_nvp_eff = min(1._r8 - frac_h2osfc(c) - frac_sno_eff(c), & + max(0._r8, col%frac_nvp(c) - frac_sno_eff(c))) + w_cond = frac_sno_eff(c) + frac_nvp_eff + nvp_exp = frac_nvp_eff / col%frac_nvp(c) ! exposed fraction of the moss [-] + sno_exp = frac_sno_eff(c) / col%frac_nvp(c) ! buried (under-snow) fraction of the moss [-] + ! [PORTED by Hui Tang (2026-06-12): option (b) — per-moss-area cv: every per-column flux + ! into the moss is /frac_nvp. moss/soil conduction tk(0)/dzp FULL on the moss side (soil + ! side keeps w_cond). SNOW up-conduction tk(-1)/dzm at sno_exp=frac_sno_eff/frac_nvp + ! (per-moss) so the interface CONSERVES (moss gains frac_nvp*sno_exp*fn=frac_sno_eff*fn = + ! snow's loss). Surface derivative per-moss nvp_exp*dhsdT (matches hs_nvp and the RHS).] + bmatrix_snow(c,4,j-1) = - sno_exp*(1._r8-cnfac)*fact(c,0)*tk(c,-1)/dzm + bmatrix_snow(c,3,j-1) = 1._r8 + (1._r8-cnfac)*fact(c,0) & + *( tk(c,0)/dzp + sno_exp*tk(c,-1)/dzm ) & + - nvp_exp*fact(c,0)*dhsdT(c) + bmatrix_snow_soil(c,1,j-1) = - (1._r8-cnfac)*fact(c,0)*tk(c,0)/dzp + else if (j >= col%snl(c)+1) then + dzp = z(c,j+1)-z(c,j) if (j == col%snl(c)+1) then - bmatrix_snow (c,4,j-1) = 0._r8 + bmatrix_snow (c,4,j-1) = 0._r8 bmatrix_snow (c,3,j-1) = 1._r8+(1._r8-cnfac)*fact(c,j)*tk(c,j)/dzp-fact(c,j)*dhsdT(c) else dzm = (z(c,j)-z(c,j-1)) @@ -2675,6 +3393,25 @@ subroutine SetMatrix_Snow(bounds, num_nolakec, filter_nolakec, nband, & else !if ( j == 0) bmatrix_snow_soil(c,1,j-1) = - (1._r8-cnfac)*fact(c,j)* tk(c,j)/dzp end if + ! [PORTED by Hui Tang: NVP top-layer BC in SetMatrix_Snow, snl==0, 3-way split (2026-06-11). + ! j=0 < snl+1=1 so it falls through above (snl<0 is handled by the dedicated branch first). + ! frac_sno_eff=0 here so w_cond=frac_nvp_eff: -frac_nvp_eff*dhsdT on the diagonal (exposed- + ! moss surface derivative), no up-coupling (no snow), down-coupling to soil weighted + ! frac_nvp_eff (matches the SetRHSVec_Snow j=0 snl==0 branch). Replaces the previous + ! "collapse" (full dhsdT, full down-coupling).] + else if (use_nvp .and. col%jbot_sno(c) == -1 .and. col%snl(c) == 0 .and. j == 0) then + dzp = z(c,j+1) - z(c,j) + frac_nvp_eff = min(1._r8 - frac_h2osfc(c) - frac_sno_eff(c), & + max(0._r8, col%frac_nvp(c) - frac_sno_eff(c))) + nvp_exp = frac_nvp_eff / col%frac_nvp(c) ! exposed fraction of the moss [-] (=1 here, snl==0) + ! [PORTED by Hui Tang (2026-06-12): option (b) step 2 — moss/soil conduction tk(0)/dzp at + ! FULL weight on the moss side (per-moss-area cv); soil side (j=1) keeps frac_nvp. The + ! surface derivative is per-moss nvp_exp*dhsdT (=dhsdT here, nvp_exp=1) to match hs_nvp + ! and the RHS — required for the per-moss cv to stay stable (was frac_nvp_eff -> overheat).] + bmatrix_snow(c,4,j-1) = 0._r8 + bmatrix_snow(c,3,j-1) = 1._r8 + (1._r8-cnfac)*fact(c,j)*tk(c,j)/dzp & + - nvp_exp*fact(c,j)*dhsdT(c) + bmatrix_snow_soil(c,1,j-1) = -(1._r8-cnfac)*fact(c,j)*tk(c,j)/dzp end if enddo end do @@ -2719,6 +3456,9 @@ subroutine SetMatrix_Soil(bounds, num_nolakec, filter_nolakec, nband, & integer :: fc ! lake filtered column indices real(r8) :: dzm ! used in computing tridiagonal matrix real(r8) :: dzp ! used in computing tridiagonal matrix + real(r8) :: frac_nvp_eff ! [PORTED by Hui Tang: exposed NVP fraction (Phase 1c)] + real(r8) :: w_cond ! [PORTED by Hui Tang: NVP-over-soil conduction weight = frac_sno_eff + frac_nvp_eff] + real(r8) :: frac_soil ! [PORTED by Hui Tang: bare-soil fraction (Phase 1c)] ! ----------------------------------------------------------------------- ! Enforce expected array sizes @@ -2797,15 +3537,49 @@ subroutine SetMatrix_Soil(bounds, num_nolakec, filter_nolakec, nband, & (col%itype(c) == icol_road_perv) .or. & (.not. lun%urbpoi(l))) then - if (j == col%snl(c)+1) then + ! [PORTED by Hui Tang: exclude NVP — when NVP active, j=1 is interior not top] + if (j == col%snl(c)+1 .and. .not. (use_nvp .and. col%jbot_sno(c) == -1)) then dzp = z(c,j+1)-z(c,j) if (j /= 1) then bmatrix_soil(c,4,j) = 0._r8 - else + else bmatrix_soil_snow(c,5,j) = 0._r8 end if bmatrix_soil(c,3,j) = 1._r8+(1._r8-cnfac)*fact(c,j)*tk(c,j)/dzp-fact(c,j)*dhsdT(c) bmatrix_soil(c,2,j) = -(1._r8-cnfac)*fact(c,j)*tk(c,j)/dzp + ! [PORTED by Hui Tang: soil layer 1 below NVP, snl==0, 3-way split (2026-06-11). Matrix + ! counterpart of the SetRHSVec_Soil j=1 snl==0 branch: bare-soil surface derivative + ! weighted frac_soil; up-conduction to NVP weighted frac_nvp_eff (= w_cond, frac_sno_eff=0), + ! matching the j=0 down-conduction. Replaces the previous full-conductance/no-dhsdT + ! "collapse" treatment.] + else if (j == 1 .and. use_nvp .and. col%jbot_sno(c) == -1 .and. col%snl(c) == 0) then + dzm = (z(c,j)-z(c,j-1)) + dzp = (z(c,j+1)-z(c,j)) + frac_nvp_eff = min(1._r8 - frac_h2osfc(c) - frac_sno_eff(c), & + max(0._r8, col%frac_nvp(c) - frac_sno_eff(c))) + frac_soil = max(0._r8, 1._r8 - frac_sno_eff(c) - frac_h2osfc(c) - frac_nvp_eff) + bmatrix_soil(c,2,j) = -(1._r8-cnfac)*fact(c,j)*tk(c,j)/dzp + bmatrix_soil(c,3,j) = 1._r8 + (1._r8-cnfac)*fact(c,j)*(tk(c,j)/dzp & + + frac_nvp_eff*tk(c,j-1)/dzm) & + - frac_soil*fact(c,j)*dhsdT(c) + bmatrix_soil_snow(c,5,j) = -frac_nvp_eff*(1._r8-cnfac)*fact(c,j)*tk(c,j-1)/dzm + ! [PORTED by Hui Tang: Phase 1c — soil layer 1 below NVP under partial snow (snl<0). + ! Matrix counterpart of the SetRHSVec_Soil j=1 snl<0 branch: bare-soil surface + ! derivative weighted frac_soil; up-conduction to NVP weighted w_cond = frac_sno_eff + ! + frac_nvp_eff (matches the j=0 down-conduction so the interface conserves energy).] + else if (j == 1 .and. use_nvp .and. col%jbot_sno(c) == -1 .and. col%snl(c) < 0) then + dzm = (z(c,j)-z(c,j-1)) + dzp = (z(c,j+1)-z(c,j)) + frac_nvp_eff = min(1._r8 - frac_h2osfc(c) - frac_sno_eff(c), & + max(0._r8, col%frac_nvp(c) - frac_sno_eff(c))) + w_cond = frac_sno_eff(c) + frac_nvp_eff + frac_soil = max(0._r8, 1._r8 - frac_sno_eff(c) - frac_h2osfc(c) - frac_nvp_eff) + bmatrix_soil(c,2,j) = - (1._r8-cnfac)*fact(c,j)*tk(c,j)/dzp + bmatrix_soil(c,3,j) = 1._r8 + (1._r8-cnfac)*fact(c,j)*(tk(c,j)/dzp & + + w_cond * tk(c,j-1)/dzm) & + - frac_soil*fact(c,j)*dhsdT(c) + bmatrix_soil_snow(c,5,j) = - w_cond * (1._r8-cnfac) * fact(c,j) & + * tk(c,j-1)/dzm else if (j == 1) then ! this is the snow/soil interface layer dzm = (z(c,j)-z(c,j-1)) @@ -2908,18 +3682,25 @@ subroutine SetMatrix_StandingSurfaceWater(bounds, num_nolakec, filter_nolakec, d do fc = 1,num_nolakec c = filter_nolakec(fc) - ! surface water layer has two coefficients - dzm=(0.5*dz_h2osfc(c)+col%z(c,1)) + ! When there is no standing water (c_h2osfc == thin_sfclayer), dtime/c_h2osfc = 1.8e9 + ! which inflates diagonal and off-diagonal coefficients to ~10^11, corrupting the solver. + ! Use a trivial identity row (diagonal=1, off-diagonals=0) instead. + if (c_h2osfc(c) <= thin_sfclayer) then + bmatrix_ssw(c,3,0) = 1.0_r8 ! diagonal = 1; off-diagonals already 0 from init + else + ! surface water layer has two coefficients + dzm=(0.5*dz_h2osfc(c)+col%z(c,1)) - bmatrix_ssw(c,3,0)= 1._r8+(1._r8-cnfac)*(dtime/c_h2osfc(c)) & - *tk_h2osfc(c)/dzm -(dtime/c_h2osfc(c))*dhsdT(c) !interaction from atm + bmatrix_ssw(c,3,0)= 1._r8+(1._r8-cnfac)*(dtime/c_h2osfc(c)) & + *tk_h2osfc(c)/dzm -(dtime/c_h2osfc(c))*dhsdT(c) !interaction from atm - bmatrix_ssw_soil(c,2,0)= -(1._r8-cnfac)*(dtime/c_h2osfc(c))*tk_h2osfc(c)/dzm !flux to top soil layer + bmatrix_ssw_soil(c,2,0)= -(1._r8-cnfac)*(dtime/c_h2osfc(c))*tk_h2osfc(c)/dzm !flux to top soil layer - ! top soil layer has sub coef shifted to 2nd super diagonal - if ( frac_h2osfc(c) /= 0.0_r8 )then - bmatrix_soil_ssw(c,4,1)= - frac_h2osfc(c) * (1._r8-cnfac) * fact(c,1) & - * tk_h2osfc(c)/dzm !flux from h2osfc + ! top soil layer has sub coef shifted to 2nd super diagonal + if ( frac_h2osfc(c) /= 0.0_r8 )then + bmatrix_soil_ssw(c,4,1)= - frac_h2osfc(c) * (1._r8-cnfac) * fact(c,1) & + * tk_h2osfc(c)/dzm !flux from h2osfc + end if end if enddo diff --git a/src/biogeophys/SoilWaterMovementMod.F90 b/src/biogeophys/SoilWaterMovementMod.F90 index c2909d0475..9daeb57f24 100644 --- a/src/biogeophys/SoilWaterMovementMod.F90 +++ b/src/biogeophys/SoilWaterMovementMod.F90 @@ -261,7 +261,8 @@ subroutine SoilWater(bounds, num_hydrologyc, filter_hydrologyc, & use ColumnType , only : col use SoilWaterRetentionCurveMod, only : soil_water_retention_curve_type use clm_varcon , only : denh2o, denice - use clm_varctl, only : use_flexibleCN + use clm_varctl, only : use_flexibleCN, iulog + use clm_time_manager, only : get_nstep ! [NVP DBG] ! ! !ARGUMENTS: type(bounds_type) , intent(in) :: bounds ! bounds @@ -294,6 +295,15 @@ subroutine SoilWater(bounds, num_hydrologyc, filter_hydrologyc, & h2osoi_liq => waterstatebulk_inst%h2osoi_liq_col & ! Output: [real(r8) (:,:) ] liquid water (kg/m2) ) + + ! [NVP DBG: print qflx_infl and first 6 soil liq layers entering solver, nstep<=3 only] + if (get_nstep() <= 3) then + write(iulog,'(a,i0,a,es11.4)') '[NVP DBG] SoilWater entry nstep=', get_nstep(), & + ' qflx_infl=', waterfluxbulk_inst%qflx_infl_col(bounds%begc) + write(iulog,'(a,i0,6(1x,es11.4))') '[NVP DBG] SoilWater entry liq(1:6) nstep=', get_nstep(), & + (h2osoi_liq(bounds%begc,j), j=1,6) + end if + select case(soilwater_movement_method) case (zengdecker_2009) @@ -327,6 +337,11 @@ subroutine SoilWater(bounds, num_hydrologyc, filter_hydrologyc, & call endrun(subname // ':: a SoilWater implementation must be specified!') end select + + ! [NVP DBG: print first 6 soil liq layers after solver] + if (get_nstep() <= 3) & + write(iulog,'(a,i0,6(1x,es11.4))') '[NVP DBG] SoilWater exit nstep=', get_nstep(), & + (h2osoi_liq(bounds%begc,j), j=1,6) if (use_flexibleCN) then !a work around of the negative liquid water. Jinyun Tang, Jan 14, 2015 @@ -1232,6 +1247,12 @@ subroutine soilwater_moisture_form(bounds, num_hydrologyc, & dqodw2(c,1:nlayers)) ! RHS of system of equations + print *, "qflx_rootsoi_col=", qflx_rootsoi_col + print *, "vwc_liq=", vwc_liq + print *, "qin=", qin + print *, "qout=", qout + print *, "dt_dz=", dt_dz + call compute_RHS_moisture_form(c, nlayers, & qflx_rootsoi_col(c,1:nlayers), & vwc_liq(c,1:nlayers), & @@ -1282,7 +1303,12 @@ subroutine soilwater_moisture_form(bounds, num_hydrologyc, & ! get a copy of the residual vector rhs(1:nlayers) = rmx(filter_hydrologyc(fc),1:nlayers) - + + print *, "rhs0=", rhs(1:nlayers) + print *, "dlow0=", dlow + print *, "diag0=", diag + print *, "dUpp0=", dUpp + ! call the lapack tri-diagonal solver call dgtsv(nlayers, & ! intent(in): [integer] number of state variables 1, & ! intent(in): [integer] number of columns of the matrix B @@ -1296,6 +1322,8 @@ subroutine soilwater_moisture_form(bounds, num_hydrologyc, & msg = subname // ':: problem with the lapack solver') ! save the iteration increment + print *, "rhs1=", rhs(1:nlayers) + print *, "dwat=", dwat dwat(filter_hydrologyc(fc),1:nlayers) = rhs(1:nlayers) endif ! solution method for the tridiagonal solution @@ -1357,6 +1385,7 @@ subroutine soilwater_moisture_form(bounds, num_hydrologyc, & ! ********** ! Renew the mass of liquid water + do j = 1, nlayers h2osoi_liq(c,j) = h2osoi_liq(c,j) + dwat(c,j) * (m_to_mm * dz(c,j)) end do diff --git a/src/biogeophys/SolarAbsorbedType.F90 b/src/biogeophys/SolarAbsorbedType.F90 index fa1de4a753..d483b1546a 100644 --- a/src/biogeophys/SolarAbsorbedType.F90 +++ b/src/biogeophys/SolarAbsorbedType.F90 @@ -30,8 +30,16 @@ module SolarAbsorbedType real(r8), pointer :: par240x_z_patch (:,:) ! 10-day running mean of maximum patch absorbed PAR for leaves in canopy layer (W/m**2) real(r8), pointer :: par24d_z_patch (:,:) ! daily accumulated absorbed PAR for leaves in canopy layer from midnight to current step(J/m**2) real(r8), pointer :: par24x_z_patch (:,:) ! daily max of patch absorbed PAR for leaves in canopy layer from midnight to current step(W/m**2) - real(r8), pointer :: sabg_soil_patch (:) ! patch solar radiation absorbed by soil (W/m**2) - real(r8), pointer :: sabg_snow_patch (:) ! patch solar radiation absorbed by snow (W/m**2) + real(r8), pointer :: sabg_soil_patch (:) ! patch solar radiation absorbed by soil (W/m**2) + ! [PORTED by Hui Tang: exposed-NVP moss SURFACE-absorbed solar (Beer's law), analogous to + ! sabg_soil_patch for bare soil. Full (un-exposure-weighted) value; the frac_nvp_eff weighting + ! is applied in the thermal solve (hs_nvp). Paired with sabg_lyr_patch(:,0) = buried/SNICAR + ! internal moss absorption (analogous to sabg_lyr_patch(:,1) for soil).] + real(r8), pointer :: sabg_nvp_patch (:) ! patch solar absorbed by exposed NVP moss surface (W/m**2) + ! [PORTED by Hui Tang: band-loop (albsod) ground absorption snapshot, before the NVP carve-out / + ! SNICAR snow reassignment overwrite sabg_soil; used only to build the diagnostic SABG tile] + real(r8), pointer :: sabg_soil_bandloop_patch (:) ! patch band-loop soil/ground absorption (W/m**2) + real(r8), pointer :: sabg_snow_patch (:) ! patch solar radiation absorbed by snow (W/m**2) real(r8), pointer :: sabg_patch (:) ! patch solar radiation absorbed by ground (W/m**2) real(r8), pointer :: sabg_chk_patch (:) ! patch fsno weighted sum (W/m**2) real(r8), pointer :: sabg_lyr_patch (:,:) ! patch absorbed radiation in each snow layer and top soil layer (pft,lyr) [W/m2] @@ -130,6 +138,8 @@ subroutine InitAllocate(this, bounds) allocate(this%sabg_lyr_patch (begp:endp,-nlevsno+1:1)) ; this%sabg_lyr_patch (:,:) = nan allocate(this%sabg_pen_patch (begp:endp)) ; this%sabg_pen_patch (:) = nan allocate(this%sabg_soil_patch (begp:endp)) ; this%sabg_soil_patch (:) = nan + allocate(this%sabg_nvp_patch (begp:endp)) ; this%sabg_nvp_patch (:) = nan ! [PORTED by Hui Tang] + allocate(this%sabg_soil_bandloop_patch(begp:endp)) ; this%sabg_soil_bandloop_patch(:) = nan ! [PORTED by Hui Tang] allocate(this%sabg_snow_patch (begp:endp)) ; this%sabg_snow_patch (:) = nan allocate(this%sabg_chk_patch (begp:endp)) ; this%sabg_chk_patch (:) = nan allocate(this%sabs_roof_dir_lun (begl:endl,1:numrad)) ; this%sabs_roof_dir_lun (:,:) = nan diff --git a/src/biogeophys/SurfaceAlbedoMod.F90 b/src/biogeophys/SurfaceAlbedoMod.F90 index d8d71ae41d..02fc644207 100644 --- a/src/biogeophys/SurfaceAlbedoMod.F90 +++ b/src/biogeophys/SurfaceAlbedoMod.F90 @@ -15,6 +15,8 @@ module SurfaceAlbedoMod use clm_varcon , only : grlnd, spval use clm_varpar , only : numrad, nlevcan, nlevsno, nlevcan use clm_varctl , only : fsurdat, iulog, use_SSRE, do_sno_oc + ! [PORTED by Hui Tang: nvp (moss/lichen) control switch] + use clm_varctl , only : use_nvp use pftconMod , only : pftcon use SnowSnicarMod , only : sno_nbr_aer, SNICAR_RT, DO_SNO_AER use AerosolMod , only : aerosol_type @@ -366,6 +368,8 @@ subroutine SurfaceAlbedo(bounds,nc, & real(r8) :: albsfc (bounds%begc:bounds%endc,numrad) ! albedo of surface underneath snow (col,bnd) real(r8) :: albsnd(bounds%begc:bounds%endc,numrad) ! snow albedo (direct) real(r8) :: albsni(bounds%begc:bounds%endc,numrad) ! snow albedo (diffuse) + real(r8) :: frac_nvp_eff_alb ! [PORTED by Hui Tang: exposed-moss column fraction for the ground-albedo blend] + real(r8) :: T_nvp ! [PORTED by Hui Tang: per-moss-area transmittance exp(-k*lai) for the Beer-effective ground albedo] real(r8) :: albsnd_pur (bounds%begc:bounds%endc,numrad) ! direct pure snow albedo (radiative forcing) real(r8) :: albsni_pur (bounds%begc:bounds%endc,numrad) ! diffuse pure snow albedo (radiative forcing) real(r8) :: albsnd_bc (bounds%begc:bounds%endc,numrad) ! direct snow albedo without BC (radiative forcing) @@ -402,6 +406,7 @@ subroutine SurfaceAlbedo(bounds,nc, & esai => canopystate_inst%esai_patch , & ! Input: [real(r8) (:) ] one-sided stem area index with burying by snow frac_sno => waterdiagnosticbulk_inst%frac_sno_col , & ! Input: [real(r8) (:) ] fraction of ground covered by snow (0 to 1) + frac_sno_eff => waterdiagnosticbulk_inst%frac_sno_eff_col , & !Input: fcansno => waterdiagnosticbulk_inst%fcansno_patch , & ! Input: [real(r8) (:) ] fraction of canopy that is snow-covered (0 to 1) h2osoi_liq => waterstatebulk_inst%h2osoi_liq_col , & ! Input: [real(r8) (:,:) ] liquid water content (col,lyr) [kg/m2] h2osoi_ice => waterstatebulk_inst%h2osoi_ice_col , & ! Input: [real(r8) (:,:) ] ice lens content (col,lyr) [kg/m2] @@ -778,32 +783,71 @@ subroutine SurfaceAlbedo(bounds,nc, & ! CLIMATE FEEDBACK CALCULATIONS, ALL AEROSOLS: flg_slr = 1; ! direct-beam - call SNICAR_RT(bounds, num_nourbanc, filter_nourbanc, & - coszen_col(bounds%begc:bounds%endc), & - flg_slr, & - h2osno_liq(bounds%begc:bounds%endc, :), & - h2osno_ice(bounds%begc:bounds%endc, :), & - h2osno_total(bounds%begc:bounds%endc), & - snw_rds_in(bounds%begc:bounds%endc, :), & - mss_cnc_aer_in_fdb(bounds%begc:bounds%endc, :, :), & - albsfc(bounds%begc:bounds%endc, :), & - albsnd(bounds%begc:bounds%endc, :), & - flx_absd_snw(bounds%begc:bounds%endc, :, :), & - waterdiagnosticbulk_inst) + ! [PORTED by Hui Tang: SNICAR Approach B - pass NVP layer-0 optical properties to feedback calls] + ! nvp_tau_col/omega_*_col are from the previous timestep (one-timestep lag, consistent with + ! other doalb quantities). Non-feedback forcing calls omit these args (NVP not in diagnostics). + if (use_nvp) then + call SNICAR_RT(bounds, num_nourbanc, filter_nourbanc, & + coszen_col(bounds%begc:bounds%endc), & + flg_slr, & + h2osno_liq(bounds%begc:bounds%endc, :), & + h2osno_ice(bounds%begc:bounds%endc, :), & + h2osno_total(bounds%begc:bounds%endc), & + snw_rds_in(bounds%begc:bounds%endc, :), & + mss_cnc_aer_in_fdb(bounds%begc:bounds%endc, :, :), & + albsfc(bounds%begc:bounds%endc, :), & + albsnd(bounds%begc:bounds%endc, :), & + flx_absd_snw(bounds%begc:bounds%endc, :, :), & + waterdiagnosticbulk_inst, & + nvp_tau_col = surfalb_inst%nvp_tau_col(bounds%begc:bounds%endc), & + nvp_omega_vis_col = surfalb_inst%nvp_omega_vis_col(bounds%begc:bounds%endc), & + nvp_omega_nir_col = surfalb_inst%nvp_omega_nir_col(bounds%begc:bounds%endc)) + else + call SNICAR_RT(bounds, num_nourbanc, filter_nourbanc, & + coszen_col(bounds%begc:bounds%endc), & + flg_slr, & + h2osno_liq(bounds%begc:bounds%endc, :), & + h2osno_ice(bounds%begc:bounds%endc, :), & + h2osno_total(bounds%begc:bounds%endc), & + snw_rds_in(bounds%begc:bounds%endc, :), & + mss_cnc_aer_in_fdb(bounds%begc:bounds%endc, :, :), & + albsfc(bounds%begc:bounds%endc, :), & + albsnd(bounds%begc:bounds%endc, :), & + flx_absd_snw(bounds%begc:bounds%endc, :, :), & + waterdiagnosticbulk_inst) + end if flg_slr = 2; ! diffuse - call SNICAR_RT(bounds, num_nourbanc, filter_nourbanc, & - coszen_col(bounds%begc:bounds%endc), & - flg_slr, & - h2osno_liq(bounds%begc:bounds%endc, :), & - h2osno_ice(bounds%begc:bounds%endc, :), & - h2osno_total(bounds%begc:bounds%endc), & - snw_rds_in(bounds%begc:bounds%endc, :), & - mss_cnc_aer_in_fdb(bounds%begc:bounds%endc, :, :), & - albsfc(bounds%begc:bounds%endc, :), & - albsni(bounds%begc:bounds%endc, :), & - flx_absi_snw(bounds%begc:bounds%endc, :, :), & - waterdiagnosticbulk_inst) + if (use_nvp) then + call SNICAR_RT(bounds, num_nourbanc, filter_nourbanc, & + coszen_col(bounds%begc:bounds%endc), & + flg_slr, & + h2osno_liq(bounds%begc:bounds%endc, :), & + h2osno_ice(bounds%begc:bounds%endc, :), & + h2osno_total(bounds%begc:bounds%endc), & + snw_rds_in(bounds%begc:bounds%endc, :), & + mss_cnc_aer_in_fdb(bounds%begc:bounds%endc, :, :), & + albsfc(bounds%begc:bounds%endc, :), & + albsni(bounds%begc:bounds%endc, :), & + flx_absi_snw(bounds%begc:bounds%endc, :, :), & + waterdiagnosticbulk_inst, & + nvp_tau_col = surfalb_inst%nvp_tau_col(bounds%begc:bounds%endc), & + nvp_omega_vis_col = surfalb_inst%nvp_omega_vis_col(bounds%begc:bounds%endc), & + nvp_omega_nir_col = surfalb_inst%nvp_omega_nir_col(bounds%begc:bounds%endc)) + else + call SNICAR_RT(bounds, num_nourbanc, filter_nourbanc, & + coszen_col(bounds%begc:bounds%endc), & + flg_slr, & + h2osno_liq(bounds%begc:bounds%endc, :), & + h2osno_ice(bounds%begc:bounds%endc, :), & + h2osno_total(bounds%begc:bounds%endc), & + snw_rds_in(bounds%begc:bounds%endc, :), & + mss_cnc_aer_in_fdb(bounds%begc:bounds%endc, :, :), & + albsfc(bounds%begc:bounds%endc, :), & + albsni(bounds%begc:bounds%endc, :), & + flx_absi_snw(bounds%begc:bounds%endc, :, :), & + waterdiagnosticbulk_inst) + end if ! ground albedos and snow-fraction weighting of snow absorption factors do ib = 1, nband @@ -815,6 +859,25 @@ subroutine SurfaceAlbedo(bounds,nc, & albgrd(c,ib) = albsod(c,ib)*(1._r8-frac_sno(c)) + albsnd(c,ib)*frac_sno(c) albgri(c,ib) = albsoi(c,ib)*(1._r8-frac_sno(c)) + albsni(c,ib)*frac_sno(c) + ! [PORTED by Hui Tang (2026-06-13): blend the EXPOSED moss into the ground albedo so + ! sabg(p)=trd*(1-albgrd) carries it in BOTH snow regimes (replaces the snl==0-only in-FATES + ! gnd_alb blend). Perturbation form: replace frac_nvp_eff_alb of the snow-free ground with the + ! moss-area effective albedo. frac_nvp_eff_alb = max(0,frac_nvp-frac_sno) keeps the soil weight + ! (1-frac_sno)-frac_nvp_eff_alb >=0; reduces to frac_nvp at snl==0. Buried moss stays in SNICAR. + ! [PORTED by Hui Tang (2026-06-13): OPTION 2 — Beer-EFFECTIVE moss-area albedo (1st order): + ! 1-alb_eff = (1-alb_nvp)*(1-albsoil*T_nvp), T_nvp=exp(-k*lai)=exp(-nvp_tau_col/frac_nvp). + ! The moss area then absorbs moss(Beer) + soil-under-moss; the carve-out subtracts the Beer + ! sabg_nvp, so the soil remainder is the PHYSICAL (1-alb_nvp)*T*(1-albsoil) transmitted solar, + ! not the inflated opaque value. alb_nvp_gnd_col is the moss SURFACE reflectance (bc_out lag).] + if (use_nvp .and. col%nvp_layer_active(c)) then + frac_nvp_eff_alb = min(1._r8 - frac_sno(c), max(0._r8, col%frac_nvp(c) - frac_sno(c))) + T_nvp = exp(-surfalb_inst%nvp_tau_col(c)/col%frac_nvp(c)) ! exp(-k*lai), per moss area + albgrd(c,ib) = albgrd(c,ib) + frac_nvp_eff_alb* & + ( (1._r8 - (1._r8-surfalb_inst%alb_nvp_gnd_col(c))*(1._r8 - albsod(c,ib)*T_nvp)) - albsod(c,ib) ) + albgri(c,ib) = albgri(c,ib) + frac_nvp_eff_alb* & + ( (1._r8 - (1._r8-surfalb_inst%alb_nvp_gnd_col(c))*(1._r8 - albsoi(c,ib)*T_nvp)) - albsoi(c,ib) ) + end if + ! albedos for radiative forcing calculations: if (use_snicar_frc) then ! BC forcing albedo @@ -1065,7 +1128,7 @@ subroutine SurfaceAlbedo(bounds,nc, & ! Only perform on vegetated pfts where coszen > 0 if (use_fates) then - + call clm_fates%wrap_canopy_radiation(bounds, nc, fcansno(bounds%begp:bounds%endp), surfalb_inst) else diff --git a/src/biogeophys/SurfaceAlbedoType.F90 b/src/biogeophys/SurfaceAlbedoType.F90 index 10819a47b6..63707c9754 100644 --- a/src/biogeophys/SurfaceAlbedoType.F90 +++ b/src/biogeophys/SurfaceAlbedoType.F90 @@ -8,6 +8,8 @@ module SurfaceAlbedoType use clm_varpar , only : numrad, nlevcan, nlevsno use abortutils , only : endrun use clm_varctl , only : use_SSRE, use_snicar_frc + ! [PORTED by Hui Tang: nvp (moss/lichen) control switch] + use clm_varctl , only : use_nvp ! ! !PUBLIC TYPES: implicit none @@ -31,8 +33,22 @@ module SurfaceAlbedoType real(r8), pointer :: albgri_oc_col (:,:) ! col ground diffuse albedo without OC (numrad) real(r8), pointer :: albgrd_dst_col (:,:) ! col ground direct albedo without dust (numrad) real(r8), pointer :: albgri_dst_col (:,:) ! col ground diffuse albedo without dust (numrad) - real(r8), pointer :: albgrd_col (:,:) ! col ground albedo (direct) (numrad) - real(r8), pointer :: albgri_col (:,:) ! col ground albedo (diffuse) (numrad) + real(r8), pointer :: albgrd_col (:,:) ! col ground albedo (direct) (numrad) + real(r8), pointer :: albgri_col (:,:) ! col ground albedo (diffuse) (numrad) + ! [PORTED by Hui Tang: nvp (moss/lichen) surface albedo fields] + real(r8), pointer :: fabd_nvp_col (:,:) ! col flux absorbed by nvp per unit direct flux (numrad) + real(r8), pointer :: fabi_nvp_col (:,:) ! col flux absorbed by nvp per unit diffuse flux (numrad) + ! [PORTED by Hui Tang: NVP optical properties for SNICAR layer-0 (Approach B)] + ! nvp_tau_col: column-mean optical depth = k_nvp * lai_nvp * nvp_frac [-] + ! nvp_omega_vis_col: single-scatter albedo in VIS band = rhol(nvp_ft,1) + taul(nvp_ft,1) + ! nvp_omega_nir_col: single-scatter albedo in NIR band = rhol(nvp_ft,2) + taul(nvp_ft,2) + ! All set in wrap_canopy_radiation; read by SurfaceAlbedoMod before SNICAR_RT calls. + real(r8), pointer :: nvp_tau_col (:) ! col NVP optical depth (k*LAI*frac) [-] + real(r8), pointer :: nvp_omega_vis_col (:) ! col NVP single-scatter albedo VIS [-] + real(r8), pointer :: nvp_omega_nir_col (:) ! col NVP single-scatter albedo NIR [-] + ! [PORTED by Hui Tang (2026-06-13): NVP moss ground reflectance (band-independent), from FATES + ! bc_out%alb_nvp_gnd_pa; blended into albsod in SurfaceAlbedoMod so sabg(p) carries the exposed moss.] + real(r8), pointer :: alb_nvp_gnd_col (:) ! col NVP moss ground reflectance [-] real(r8), pointer :: albsod_col (:,:) ! col soil albedo: direct (col,bnd) [frc] real(r8), pointer :: albsoi_col (:,:) ! col soil albedo: diffuse (col,bnd) [frc] real(r8), pointer :: albsnd_hst_col (:,:) ! col snow albedo, direct , for history files (col,bnd) [frc] @@ -137,6 +153,16 @@ subroutine InitAllocate(this, bounds) allocate(this%coszen_col (begc:endc)) ; this%coszen_col (:) = nan allocate(this%albgrd_col (begc:endc,numrad)) ; this%albgrd_col (:,:) = nan allocate(this%albgri_col (begc:endc,numrad)) ; this%albgri_col (:,:) = nan + ! [PORTED by Hui Tang: allocate nvp (moss/lichen) surface albedo fields] + if (use_nvp) then + allocate(this%fabd_nvp_col (begc:endc,numrad)) ; this%fabd_nvp_col (:,:) = 0._r8 + allocate(this%fabi_nvp_col (begc:endc,numrad)) ; this%fabi_nvp_col (:,:) = 0._r8 + ! [PORTED by Hui Tang: allocate NVP optical properties for SNICAR layer-0] + allocate(this%nvp_tau_col (begc:endc)) ; this%nvp_tau_col (:) = 0._r8 + allocate(this%alb_nvp_gnd_col (begc:endc)) ; this%alb_nvp_gnd_col (:) = 0._r8 + allocate(this%nvp_omega_vis_col (begc:endc)) ; this%nvp_omega_vis_col (:) = 0._r8 + allocate(this%nvp_omega_nir_col (begc:endc)) ; this%nvp_omega_nir_col (:) = 0._r8 + end if allocate(this%albsnd_hst_col (begc:endc,numrad)) ; this%albsnd_hst_col (:,:) = spval allocate(this%albsni_hst_col (begc:endc,numrad)) ; this%albsni_hst_col (:,:) = spval allocate(this%albsod_col (begc:endc,numrad)) ; this%albsod_col (:,:) = spval @@ -208,6 +234,7 @@ subroutine InitHistory(this, bounds) use shr_infnan_mod, only: nan => shr_infnan_nan, assignment(=) use clm_varcon , only: spval use histFileMod , only: hist_addfld1d, hist_addfld2d + use ColumnType , only: col ! [PORTED by Hui Tang: NVP structural history fields] ! ! !ARGUMENTS: class(surfalb_type) :: this @@ -249,6 +276,44 @@ subroutine InitHistory(this, bounds) avgflag='A', long_name='ground albedo (indirect)', & ptr_col=this%albgri_col, default='active') + ! [PORTED by Hui Tang: history fields for nvp (moss/lichen) surface absorbed flux] + if (use_nvp) then + this%fabd_nvp_col(begc:endc,:) = spval + call hist_addfld2d (fname='FABD_NVP', units='proportion', type2d='numrad', & + avgflag='A', long_name='flux absorbed by nvp per unit direct flux', & + ptr_col=this%fabd_nvp_col, default='active') + + this%fabi_nvp_col(begc:endc,:) = spval + call hist_addfld2d (fname='FABI_NVP', units='proportion', type2d='numrad', & + avgflag='A', long_name='flux absorbed by nvp per unit diffuse flux', & + ptr_col=this%fabi_nvp_col, default='active') + + ! [PORTED by Hui Tang: history fields for NVP optical properties and geometry] + this%nvp_tau_col(begc:endc) = spval + call hist_addfld1d (fname='NVP_TAU', units='none', & + avgflag='A', long_name='nvp (moss/lichen) optical depth (k*LAI*frac)', & + ptr_col=this%nvp_tau_col, default='inactive') + + this%nvp_omega_vis_col(begc:endc) = spval + call hist_addfld1d (fname='NVP_OMEGA_VIS', units='none', & + avgflag='A', long_name='nvp (moss/lichen) single-scatter albedo VIS band', & + ptr_col=this%nvp_omega_vis_col, default='inactive') + + this%nvp_omega_nir_col(begc:endc) = spval + call hist_addfld1d (fname='NVP_OMEGA_NIR', units='none', & + avgflag='A', long_name='nvp (moss/lichen) single-scatter albedo NIR band', & + ptr_col=this%nvp_omega_nir_col, default='inactive') + + ! Note: col%dz_nvp and col%frac_nvp initialized to 0._r8 in ColumnType; no spval pre-set needed + call hist_addfld1d (fname='DZ_NVP', units='m', & + avgflag='A', long_name='nvp (moss/lichen) column-effective layer thickness', & + ptr_col=col%dz_nvp, default='inactive') + + call hist_addfld1d (fname='FRAC_NVP', units='1', & + avgflag='A', long_name='nvp (moss/lichen) column fractional coverage', & + ptr_col=col%frac_nvp, default='inactive') + end if + if (use_SSRE) then this%albdSF_patch(begp:endp,:) = spval call hist_addfld2d (fname='ALBDSF', units='proportion', type2d='numrad', & diff --git a/src/biogeophys/SurfaceHumidityMod.F90 b/src/biogeophys/SurfaceHumidityMod.F90 index 25018211a9..d37062917f 100644 --- a/src/biogeophys/SurfaceHumidityMod.F90 +++ b/src/biogeophys/SurfaceHumidityMod.F90 @@ -11,11 +11,16 @@ module SurfaceHumidityMod use shr_kind_mod , only : r8 => shr_kind_r8 use decompMod , only : bounds_type use abortutils , only : endrun - use clm_varcon , only : denh2o, denice, roverg, tfrz, spval + use clm_varcon , only : denh2o, denice, roverg, tfrz, spval use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall use column_varcon , only : icol_road_imperv, icol_road_perv use landunit_varcon , only : istice, istwet, istsoil, istcrop use clm_varpar , only : nlevgrnd + ! [PORTED by Hui Tang: use_nvp flag for NVP ground evaporation blending] + use clm_varctl , only : use_nvp + use NVPLayerDynamicsMod , only : NVPWaterRetentionCurve + ! [PORTED by Hui Tang: runtime-tunable NVP physics parameters] + use NVPParamsMod , only : n_van_nvp, alpha_van_nvp, watsat_nvp, watres_nvp use atm2lndType , only : atm2lnd_type use SoilStateType , only : soilstate_type use TemperatureType , only : temperature_type @@ -70,6 +75,11 @@ subroutine CalculateSurfaceHumidity(bounds, & real(r8) :: qsatgdT_snow ! d(qsatg)/dT, for snow real(r8) :: qsatgdT_soil ! d(qsatg)/dT, for soil real(r8) :: qsatgdT_h2osfc ! d(qsatg)/dT, for h2osfc + ! [PORTED by Hui Tang: NVP ground humidity variables] + real(r8) :: qsatgdT_nvp ! d(qsatg)/dT, for NVP surface + real(r8) :: frac_nvp_eff ! effective NVP fraction for ground humidity blend + real(r8) :: hr_nvp ! alpha NVP + real(r8) :: psit_nvp ! negative potential of NVP real(r8) :: fac ! soil wetness of surface layer real(r8) :: psit ! negative potential of soil real(r8) :: hr ! alpha soil @@ -98,7 +108,8 @@ subroutine CalculateSurfaceHumidity(bounds, & qg => waterdiagnosticbulk_inst%qg_col , & ! Output: [real(r8) (:) ] ground specific humidity [kg/kg] qg_h2osfc => waterdiagnosticbulk_inst%qg_h2osfc_col , & ! Output: [real(r8) (:) ] specific humidity at h2osfc surface [kg/kg] dqgdT => waterdiagnosticbulk_inst%dqgdT_col , & ! Output: [real(r8) (:) ] d(qg)/dT - + ! [PORTED by Hui Tang: NVP ground humidity fields for ground evap blending] + qg_nvp => waterdiagnosticbulk_inst%qg_nvp_col , & ! Output: [real(r8) (:) ] NVP surface specific humidity [kg/kg] smpmin => soilstate_inst%smpmin_col , & ! Input: [real(r8) (:) ] restriction for min of soil potential (mm) sucsat => soilstate_inst%sucsat_col , & ! Input: [real(r8) (:,:) ] minimum soil suction (mm) watsat => soilstate_inst%watsat_col , & ! Input: [real(r8) (:,:) ] volumetric soil water at saturation (porosity) @@ -112,7 +123,9 @@ subroutine CalculateSurfaceHumidity(bounds, & t_h2osfc => temperature_inst%t_h2osfc_col , & ! Input: [real(r8) (:) ] surface water temperature t_soisno => temperature_inst%t_soisno_col , & ! Input: [real(r8) (:,:) ] soil temperature (Kelvin) - t_grnd => temperature_inst%t_grnd_col & ! Input: [real(r8) (:) ] ground temperature (Kelvin) + t_grnd => temperature_inst%t_grnd_col , & ! Input: [real(r8) (:) ] ground temperature (Kelvin) + ! [PORTED by Hui Tang: NVP layer temperature for NVP surface humidity] + t_nvp_col => temperature_inst%t_nvp_col & ! Input: [real(r8) (:) ] NVP (moss/lichen) temperature (Kelvin) ) do fc = 1,num_nolakec @@ -136,8 +149,47 @@ subroutine CalculateSurfaceHumidity(bounds, & psit = max(smpmin(c), psit) ! modify qred to account for h2osfc hr = exp(psit/roverg/t_soisno(c,1)) - qred = (1._r8 - frac_sno_eff(c) - frac_h2osfc(c))*hr & - + frac_sno_eff(c) + frac_h2osfc(c) + + ! [PORTED by Hui Tang: NVP effective fraction for ground humidity blend] + ! NVP occupies area not covered by snow or surface water + if (use_nvp) then + ! Compute NVP surface humidity as a function of NVP water retention curve + ! --- NVP volumetric water content (clamped to valid range) --- + if (dz(c,0) > 0._r8) then + if (t_soisno(c,0) >= tfrz) then + ! For unfrozen soil — compute matric potential from van Genuchten curve + vol_ice = min(watsat_nvp, h2osoi_ice(c,0)/(dz(c,0)*denice)) + eff_porosity = watsat_nvp-vol_ice + vol_liq = min(eff_porosity, h2osoi_liq(c,0)/(dz(c,0)*denh2o)) + call NVPWaterRetentionCurve(vol_liq, eff_porosity, n_van_nvp, alpha_van_nvp, & + watsat_nvp, watres_nvp, psit_nvp) + hr_nvp = exp(psit_nvp/roverg/t_nvp_col(c)) + else + ! [PORTED by Hui Tang: frozen NVP — water is unavailable for liquid evaporation; + ! treat surface as saturated over ice (hr_nvp=1) so qg_nvp=qsat(t_nvp). + ! Calling NVPWaterRetentionCurve here is invalid: satfrac=0 → 0**(-1/m_van)=Inf.] + hr_nvp = 1._r8 + end if + else + ! If dz(c,0) is not positive, set hr_nvp to 0 + hr_nvp = 0._r8 + end if + else + hr_nvp = 0._r8 + end if + + ! [PORTED by Hui Tang: NVP effective fraction for ground humidity blend] + ! NVP occupies area not covered by snow or surface water + if (use_nvp) then + ! [PORTED by Hui Tang: re-wired frac_nvp_eff — snow buries NVP (frac_nvp - frac_sno_eff), cap = 1 - frac_h2osfc - frac_sno_eff] + frac_nvp_eff = min(1._r8 - frac_h2osfc(c) - frac_sno_eff(c), max(0._r8, col%frac_nvp(c) - frac_sno_eff(c))) + qred = (1._r8 - frac_sno_eff(c) - frac_h2osfc(c) - frac_nvp_eff)*hr & + + frac_sno_eff(c) + frac_h2osfc(c) + frac_nvp_eff*hr_nvp + else + frac_nvp_eff = 0._r8 + qred = (1._r8 - frac_sno_eff(c) - frac_h2osfc(c))*hr & + + frac_sno_eff(c) + frac_h2osfc(c) + end if soilalpha(c) = qred else if (col%itype(c) == icol_road_perv) then @@ -215,6 +267,25 @@ subroutine CalculateSurfaceHumidity(bounds, & qg(c) = frac_sno_eff(c)*qg_snow(c) + (1._r8 - frac_sno_eff(c) - frac_h2osfc(c))*qg_soil(c) & + frac_h2osfc(c) * qg_h2osfc(c) + ! [PORTED by Hui Tang: NVP ground evaporation blending] + ! When NVP is active, include NVP surface humidity in qg blend. + ! NVP occupies area not covered by snow or surface water. + ! qg_nvp = hr_nvp * qsat(t_nvp): hr_nvp acts as surface RH. + if (use_nvp) then + qg_nvp(c) = qg_soil(c) ! default when no NVP coverage; recomputed below if frac_nvp_eff > 0 + if (frac_nvp_eff > 0._r8) then + call QSat(t_nvp_col(c), forc_pbot(c), qsatg, & + qsdT = qsatgdT_nvp) + qg_nvp(c) = hr_nvp * qsatg + ! Adjust qg and dqgdT: reduce bare-soil contribution by frac_nvp_eff, add NVP term + qg(c) = qg(c) - frac_nvp_eff * qg_soil(c) + frac_nvp_eff * qg_nvp(c) + dqgdT(c) = dqgdT(c) - frac_nvp_eff * hr * qsatgdT_soil & + + frac_nvp_eff * hr_nvp * qsatgdT_nvp + end if + else + qg_nvp(c) = qg_soil(c) + end if + else call QSat(t_grnd(c), forc_pbot(c), qsatg, & qsdT = qsatgdT) diff --git a/src/biogeophys/SurfaceRadiationMod.F90 b/src/biogeophys/SurfaceRadiationMod.F90 index 5de3ba6e09..413c11f661 100644 --- a/src/biogeophys/SurfaceRadiationMod.F90 +++ b/src/biogeophys/SurfaceRadiationMod.F90 @@ -8,6 +8,8 @@ module SurfaceRadiationMod use shr_kind_mod , only : r8 => shr_kind_r8 use shr_log_mod , only : errMsg => shr_log_errMsg use clm_varctl , only : use_snicar_frc, use_fates + ! [PORTED by Hui Tang: nvp (moss/lichen) control switches for radiation] + use clm_varctl , only : use_nvp use decompMod , only : bounds_type, subgrid_level_column use atm2lndType , only : atm2lnd_type use WaterDiagnosticBulkType , only : waterdiagnosticbulk_type @@ -480,7 +482,7 @@ subroutine SurfaceRadiation(bounds, num_nourbanp, filter_nourbanp, & use clm_varcon , only : spval use landunit_varcon , only : istsoil, istcrop use clm_varctl , only : use_subgrid_fluxes, use_snicar_frc, iulog, use_SSRE, do_sno_oc - use clm_time_manager , only : get_step_size_real, is_near_local_noon + use clm_time_manager , only : get_step_size_real, is_near_local_noon, get_nstep ! [PORTED by Hui Tang: get_nstep for Phase-4 diagnostic] use abortutils , only : endrun ! ! !ARGUMENTS: @@ -520,6 +522,11 @@ subroutine SurfaceRadiation(bounds, num_nourbanp, filter_nourbanp, & real(r8) :: cai(bounds%begp:bounds%endp,numrad) ! diffuse radiation absorbed by canopy (W/m**2) real(r8) :: dtime ! land model time step (sec) real(r8) :: sabg_snl_sum ! temporary, absorbed energy in all active snow layers [W/m2] + ! [PORTED by Hui Tang: partial-snow NVP blend locals] + real(r8) :: frac_nvp_eff_loc ! locally-computed exposed NVP area fraction + real(r8) :: f_exp_loc ! fraction of NVP area that is exposed (not snow-buried) + real(r8) :: sabg_nvp_beer ! Beer's law NVP absorption per unit column area [W/m2] + real(r8) :: sabg_sum_chk ! [PORTED by Hui Tang: sum(sabg_lyr) (+ sabg_nvp for snl==0) for the SNICAR conservation check] real(r8) :: absrad_pur ! temp: absorbed solar radiation by pure snow [W/m2] real(r8) :: absrad_bc ! temp: absorbed solar radiation without BC [W/m2] real(r8) :: absrad_oc ! temp: absorbed solar radiation without OC [W/m2] @@ -590,6 +597,8 @@ subroutine SurfaceRadiation(bounds, num_nourbanp, filter_nourbanp, & sabg => solarabs_inst%sabg_patch , & ! Output: [real(r8) (:) ] solar radiation absorbed by ground (W/m**2) sabg_pen => solarabs_inst%sabg_pen_patch , & ! Output: [real(r8) (:) ] solar (rural) radiation penetrating top soisno layer (W/m**2) sabg_soil => solarabs_inst%sabg_soil_patch , & ! Output: [real(r8) (:) ] solar radiation absorbed by soil (W/m**2) + sabg_nvp => solarabs_inst%sabg_nvp_patch , & ! [PORTED by Hui Tang: solar absorbed by exposed NVP moss surface (W/m**2)] + sabg_soil_bandloop => solarabs_inst%sabg_soil_bandloop_patch , & ! [PORTED by Hui Tang: band-loop ground absorption snapshot] sabg_snow => solarabs_inst%sabg_snow_patch , & ! Output: [real(r8) (:) ] solar radiation absorbed by snow (W/m**2) sabg_lyr => solarabs_inst%sabg_lyr_patch , & ! Output: [real(r8) (:,:) ] absorbed radiative flux (patch,lyr) [W/m2] fsr_nir_d => solarabs_inst%fsr_nir_d_patch , & ! Output: [real(r8) (:) ] reflected direct beam nir solar radiation (W/m**2) @@ -636,7 +645,7 @@ subroutine SurfaceRadiation(bounds, num_nourbanp, filter_nourbanp, & fsds_sno_nd => surfrad_inst%fsds_sno_nd_patch , & ! Output: [real(r8) (:) ] incident near-IR, direct radiation on snow (for history files) (patch) [W/m2] fsds_sno_vi => surfrad_inst%fsds_sno_vi_patch , & ! Output: [real(r8) (:) ] incident visible, diffuse radiation on snow (for history files) (patch) [W/m2] fsds_sno_ni => surfrad_inst%fsds_sno_ni_patch , & ! Output: [real(r8) (:) ] incident near-IR, diffuse radiation on snow (for history files) (patch) [W/m2] - frac_sno_eff => waterdiagnosticbulk_inst%frac_sno_eff_col & !Input: + frac_sno_eff => waterdiagnosticbulk_inst%frac_sno_eff_col & ! Input: [real(r8) (:) ] fraction of ground covered by snow (0 to 1) ) @@ -651,6 +660,8 @@ subroutine SurfaceRadiation(bounds, num_nourbanp, filter_nourbanp, & g = patch%gridcell(p) sabg_soil(p) = 0._r8 + sabg_soil_bandloop(p) = 0._r8 ! [PORTED by Hui Tang] + if (use_nvp) sabg_nvp(p) = 0._r8 ! [PORTED by Hui Tang: exposed-NVP surface solar] sabg_snow(p) = 0._r8 sabg(p) = 0._r8 sabv(p) = 0._r8 @@ -753,11 +764,53 @@ subroutine SurfaceRadiation(bounds, num_nourbanp, filter_nourbanp, & sub_surf_abs_SW(p) = 0._r8 + ! [PORTED by Hui Tang: snapshot the band-loop (albsod) ground absorption BEFORE the NVP + ! carve-out (CASE1, sabg_soil -= sabg_lyr0) and the SNICAR snow reassignment (CASE2, + ! sabg_soil = sabg_lyr(p,1)) overwrite sabg_soil. This raw value lumps NVP+soil absorption + ! for the exposed surface and is used only to build the diagnostic SABG tile in + ! SoilTemperatureMod (true exposed-surface absorption during melt). Diagnostic-only.] + sabg_soil_bandloop(p) = sabg_soil(p) + ! CASE1: No snow layers: all energy is absorbed in top soil layer if (snl(c) == 0) then sabg_lyr(p,:) = 0._r8 sabg_lyr(p,1) = sabg(p) sabg_snl_sum = sabg_lyr(p,1) + ! [PORTED by Hui Tang: no-snow - NVP layer (index 0) absorbs before soil] + ! fabd_nvp_col/fabi_nvp_col are Beer's law absorptance fractions (dimensionless, + ! per unit flux incident on NVP). trd/tri are below-canopy direct/diffuse fluxes. + ! sabg(p) is unchanged (ground total = NVP + soil via modified albedo). + ! sabg_soil is corrected because it was computed using soil-only albedo (albsod). + ! [PORTED by Hui Tang: nest the NVP guard — Fortran does not short-circuit .and., + ! and the NVP arrays are only allocated when use_nvp=.true.; combining the + ! use_nvp check with array access in one .and. dereferences a null pointer.] + if (use_nvp) then + if (col%nvp_layer_active(patch%column(p))) then + ! [PORTED by Hui Tang: snl==0 — moss is fully exposed (no snow). The Beer's-law + ! absorption is the moss SURFACE solar -> store as sabg_nvp (analogous to sabg_soil), + ! carve it out of the soil layer/sabg_soil, and set the internal sabg_lyr(p,0)=0 + ! (there is no snow above the moss, so no buried/SNICAR internal absorption).] + sabg_nvp(p) = 0._r8 + do ib = 1, nband + sabg_nvp(p) = sabg_nvp(p) + & + surfalb_inst%fabd_nvp_col(c,ib) * trd(p,ib) + & + surfalb_inst%fabi_nvp_col(c,ib) * tri(p,ib) + end do + sabg_nvp(p) = max(0._r8, min(sabg_nvp(p), sabg_lyr(p,1))) ! per-column + + ![PORTED by Hui Tang: Soil patches receive the same amount of radiation, no matter it is under moss or not (exposed), per-area] + sabg_lyr(p,1) = sabg_lyr(p,1) - sabg_nvp(p) + sabg_soil(p) = sabg_soil(p) - sabg_nvp(p) + + ! [PORTED by Hui Tang (2026-06-12): keep sabg_lyr(p,0) = sabg_nvp so the SNICAR + ! energy-conservation guard (sum(sabg_lyr)==sabg_snow) is satisfied without special- + ! casing. This does NOT re-inject internal solar: the j=0 RHS internal term is + ! frac_sno_eff*sabg_lyr_col(c,0) = 0 for snl==0 (no snow), so the moss solar still + ! flows ONLY through hs_nvp (= frac_nvp_eff*sabg_nvp, thermostatted). The accounting + ! uses frac_nvp_eff*sabg_nvp (not sabg_lyr(p,0)).] + sabg_lyr(p,0) = sabg_nvp(p) + end if + end if ! [PORTED by Hui Tang: close outer use_nvp guard] ! CASE 2: Snow layers present: absorbed radiation is scaled according to ! flux factors computed by SNICAR @@ -824,14 +877,93 @@ subroutine SurfaceRadiation(bounds, num_nourbanp, filter_nourbanp, & endif endif endif + ! [PORTED by Hui Tang: partial-snow NVP blend — CASE2 (snl<0) with partially-exposed moss] + ! When snow is partial (frac_sno_eff < frac_nvp), fraction f_exp of the NVP is exposed + ! and receives unattenuated radiation via Beer's law (per column area, same formula as CASE1 + ! weighted by f_exp). The buried fraction (1-f_exp) receives SNICAR-attenuated radiation + ! that was set by the SNICAR loop above (per unit snow area); multiplying by frac_sno_eff + ! converts it to per column area. + ! Combined: sabg_lyr(p,0) = f_exp*beer_per_col + (1-f_exp)*frac_sno_eff*snicar_per_snow + ! [PORTED by Hui Tang (2026-06-11): SPLIT the moss solar into two un-weighted quantities, + ! exactly mirroring the soil pair (sabg_soil vs sabg_lyr(p,1)): + ! sabg_nvp(p) = Beer's-law absorption = EXPOSED-moss SURFACE solar (full). The + ! frac_nvp_eff exposure weighting is applied later in the thermal solve + ! (hs_nvp, via nvp_exp*wtcol) — so NO f_exp here (it would double-count). + ! sabg_lyr(p,0) = SNICAR moss-layer absorption = BURIED-moss INTERNAL solar (left as set + ! by the SNICAR loop above). The fse weighting is applied in the solve + ! (fse*sabg_lyr_col(c,0)) — so NO fse pre-weighting here. + ! This replaces the old blend sabg_lyr(p,0)=f_exp*beer+(1-f_exp)*fse*snicar, which both + ! double-weighted the fractions AND put the exposed solar internally (no -dhsdT surface + ! thermostat) -> moss overheating.] + if (use_nvp) then + if (col%nvp_layer_active(c)) then + if (col%frac_nvp(c) > 0._r8) then + sabg_nvp_beer = 0._r8 + do ib = 1, nband + sabg_nvp_beer = sabg_nvp_beer + & + surfalb_inst%fabd_nvp_col(c,ib) * trd(p,ib) + & + surfalb_inst%fabi_nvp_col(c,ib) * tri(p,ib) + end do + sabg_nvp(p) = max(0._r8, min(sabg_nvp_beer, sabg(p)-sabg_snow(p))) ! per-column + + ! [PORTED by Hui Tang: snow - NVP layer-0 SNICAR] + ! When use_nvp and SNICAR NVP layer-0 is active, flx_absdv(c,0)/flx_absiv(c,0) + ! already hold NVP absorption (set by SNICAR_RT above), so sabg_lyr(p,0) is + ! correct from the SNICAR loop above. Correct sabg_soil to use SNICAR soil layer. + ! [PORTED by Hui Tang: nest the NVP guard — see line ~768 for rationale] + ! sabg_lyr(p,1) = SNICAR soil-layer absorption (excludes NVP); use it directly. + frac_nvp_eff_loc = min(1._r8 - frac_sno(c), max(0._r8, col%frac_nvp(c) - frac_sno(c))) + + ! [PORTED by Hui Tang (2026-06-13): guard the exposed-soil back-out against full snow + ! cover. When frac_sno_eff==1 the denominator (1-frac_sno_eff)=0 -> sabg_soil=Inf/NaN, + ! which then contaminates sw_grnd via the 0*NaN trap in SoilFluxesMod (the zero soil + ! weight does NOT cancel a NaN). At full snow cover there is no exposed soil, so + ! sabg_soil must be a finite 0.] + if (frac_sno(c) < 1._r8) then + sabg_soil(p) = (sabg(p) - sabg_snow(p)*frac_sno(c) - (frac_nvp_eff_loc/col%frac_nvp(c))*sabg_nvp(p))/(1-frac_sno(c)) + else + sabg_soil(p) = 0._r8 + end if + + ! [PORTED by Hui Tang (2026-06-13): Phase-4 diagnostic (snl<0 partial snow). Dumps the + ! raw ground-solar pieces so we can measure how sabg(p) (albgrd total, now incl. the + ! exposed moss via Phase 3) decomposes vs the FGR reconstruction and the SABG tile. + ! Offline: M_alb = sabg(p) - fse*sabg_snow - (1-fse)*sabg_soil_bandloop (opaque moss); + ! M_beer = nvp_exp*sabg_nvp; FGR_solar ≈ (1-fse)*sabg_lyr1 + fse*sabg_snow + M_beer; + ! SABG_tile = fse*sabg_snow + (1-fse)*bandloop + M_beer. Residual to close: sabg(p)-FGR + ! and the soil seam (1-fse)*(bandloop - sabg_lyr1). REMOVE after Phase 4 verified.] + if (frac_sno_eff(c) > 0._r8 .and. frac_sno_eff(c) < col%frac_nvp(c)) then + write(iulog,*) '[NVP P4 RAD] nstep,c,p=', get_nstep(), c, p, & + ' sabg=', sabg(p), ' sabg_snow=', sabg_snow(p), & + ' bandloop=', sabg_soil_bandloop(p), ' sabg_lyr0=', sabg_lyr(p,0), & + ' sabg_lyr1=', sabg_lyr(p,1), ' sabg_nvp=', sabg_nvp(p), & + ' fse=', frac_sno_eff(c), ' fsno=', frac_sno(c), & + ' frac_nvp=', col%frac_nvp(c), & + ' nvp_exp=', min(1._r8-frac_sno_eff(c), & + max(0._r8,col%frac_nvp(c)-frac_sno_eff(c)))/col%frac_nvp(c), & + ' FGRrecon=', (1._r8-frac_sno_eff(c))*sabg_lyr(p,1) + frac_sno_eff(c)*sabg_snow(p) & + + (min(1._r8-frac_sno_eff(c), & + max(0._r8,col%frac_nvp(c)-frac_sno_eff(c)))/col%frac_nvp(c))*sabg_nvp(p) + end if + end if + end if ! [PORTED by Hui Tang: close nvp_layer_active guard] + end if ! [PORTED by Hui Tang: close use_nvp guard] endif ! This situation should not happen: - if (abs(sum(sabg_lyr(p,:))-sabg_snow(p)) > 0.00001_r8) then + ! [PORTED by Hui Tang: skip endrun for NVP partial-snow — after the Beer's-law blend above, + ! sabg_lyr(p,0) is per column area, so sum(sabg_lyr) intentionally exceeds sabg_snow + ! (per snow area) when snl<0 and frac_sno_eff < frac_nvp] + ! [PORTED by Hui Tang (2026-06-12): sabg_lyr(p,0)=sabg_nvp for snl==0 (set above), so the + ! moss is in sum(sabg_lyr) and this check passes unchanged — no NVP special-casing needed.] + sabg_sum_chk = sum(sabg_lyr(p,:)) + if (abs(sabg_sum_chk-sabg_snow(p)) > 0.00001_r8 .and. & + .not. (use_nvp .and. col%nvp_layer_active(c) .and. & + snl(c) < 0 .and. frac_sno_eff(c) < col%frac_nvp(c))) then write(iulog,*)"SNICAR ERROR: Absorbed ground radiation not equal to summed snow layer radiation" - write(iulog,*)"Diff = ",sum(sabg_lyr(p,:))-sabg_snow(p) + write(iulog,*)"Diff = ",sabg_sum_chk-sabg_snow(p) write(iulog,*)"sabg_snow(p)= ",sabg_snow(p) - write(iulog,*)"sabg_sum(p) = ",sum(sabg_lyr(p,:)) + write(iulog,*)"sabg_sum(p) = ",sabg_sum_chk write(iulog,*)"snl(c) = ",snl(c) write(iulog,*)"flx_absdv1 = ",trd(p,1)*(1.-albgrd(c,1)) write(iulog,*)"flx_absdv2 = ",sum(flx_absdv(c,:))*trd(p,1) diff --git a/src/biogeophys/TemperatureType.F90 b/src/biogeophys/TemperatureType.F90 index 6fd8faf037..802070d5ec 100644 --- a/src/biogeophys/TemperatureType.F90 +++ b/src/biogeophys/TemperatureType.F90 @@ -7,7 +7,8 @@ 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_biomass_heat_storage + ! [PORTED by Hui Tang: add use_nvp for nvp (moss/lichen) temperature field] + use clm_varctl , only : use_cndv, iulog, use_luna, use_crop, use_biomass_heat_storage, use_nvp use clm_varctl , only : flush_gdd20 use clm_varpar , only : nlevsno, nlevgrnd, nlevlak, nlevurb, nlevmaxurbgrnd, nlevsoi use clm_varcon , only : spval, ispval @@ -34,6 +35,8 @@ module TemperatureType integer, pointer :: nnightsteps_patch (:) ! number of nighttime steps accumulated from mid-night, LUNA specific real(r8), pointer :: t_h2osfc_col (:) ! col surface water temperature real(r8), pointer :: t_h2osfc_bef_col (:) ! col surface water temperature from time-step before + ! [PORTED by Hui Tang: nvp (moss/lichen) column temperature] + real(r8), pointer :: t_nvp_col (:) ! col nvp (moss/lichen) temperature (Kelvin) real(r8), pointer :: t_ssbef_col (:,:) ! col soil/snow temperature before update (-nlevsno+1:nlevgrnd) real(r8), pointer :: t_soisno_col (:,:) ! col soil temperature (Kelvin) (-nlevsno+1:nlevgrnd) real(r8), pointer :: tsl_col (:) ! col temperature of near-surface soil layer (Kelvin) @@ -225,6 +228,8 @@ subroutine InitAllocate(this, bounds) endif allocate(this%t_h2osfc_col (begc:endc)) ; this%t_h2osfc_col (:) = nan allocate(this%t_h2osfc_bef_col (begc:endc)) ; this%t_h2osfc_bef_col (:) = nan + ! [PORTED by Hui Tang: allocate nvp (moss/lichen) column temperature] + allocate(this%t_nvp_col (begc:endc)) ; this%t_nvp_col (:) = nan allocate(this%t_ssbef_col (begc:endc,-nlevsno+1:nlevmaxurbgrnd)) ; this%t_ssbef_col (:,:) = nan allocate(this%t_soisno_col (begc:endc,-nlevsno+1:nlevmaxurbgrnd)) ; this%t_soisno_col (:,:) = nan allocate(this%t_lake_col (begc:endc,1:nlevlak)) ; this%t_lake_col (:,:) = nan @@ -665,6 +670,14 @@ subroutine InitHistory(this, bounds, is_simple_buildtemp, is_prog_buildtemp ) ptr_patch=this%t_veg10_night_patch, default='inactive') endif + ! [PORTED by Hui Tang: register nvp (moss/lichen) temperature history field] + if (use_nvp) then + this%t_nvp_col(begc:endc) = spval + call hist_addfld1d (fname='T_NVP', units='K', & + avgflag='A', long_name='nvp (moss/lichen) temperature', & + ptr_col=this%t_nvp_col, default='active') + end if + end subroutine InitHistory !----------------------------------------------------------------------- @@ -842,6 +855,9 @@ subroutine InitCold(this, bounds, & this%t_h2osfc_col(bounds%begc:bounds%endc) = 274._r8 + ! [PORTED by Hui Tang: initialize nvp (moss/lichen) column temperature to 274 K] + this%t_nvp_col(bounds%begc:bounds%endc) = 274._r8 + ! Set t_veg, t_ref2m, t_ref2m_u and tref2m_r do p = bounds%begp, bounds%endp @@ -1113,6 +1129,17 @@ subroutine Restart(this, bounds, ncid, flag, is_simple_buildtemp, is_prog_buildt interpinic_flag='interp', readvar=readvar, data=this%nnightsteps_patch ) endif + ! [PORTED by Hui Tang: restart I/O for nvp (moss/lichen) column temperature] + if (use_nvp) then + call restartvar(ncid=ncid, flag=flag, varname='T_NVP', xtype=ncd_double, & + dim1name='column', & + long_name='nvp (moss/lichen) temperature', units='K', & + interpinic_flag='interp', readvar=readvar, data=this%t_nvp_col) + if (flag=='read' .and. .not. readvar) then + this%t_nvp_col(bounds%begc:bounds%endc) = 274.0_r8 + end if + end if + if ( is_prog_buildtemp )then ! landunit type physical state variable - t_building call restartvar(ncid=ncid, flag=flag, varname='t_building', xtype=ncd_double, & diff --git a/src/biogeophys/TotalWaterAndHeatMod.F90 b/src/biogeophys/TotalWaterAndHeatMod.F90 index 885222f33b..cd22da0b2f 100644 --- a/src/biogeophys/TotalWaterAndHeatMod.F90 +++ b/src/biogeophys/TotalWaterAndHeatMod.F90 @@ -25,6 +25,8 @@ module TotalWaterAndHeatMod use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall use column_varcon , only : icol_road_perv, icol_road_imperv use landunit_varcon , only : istdlak, istsoil,istcrop,istwet,istice + use clm_varctl , only : iulog, use_nvp ! [PORTED by Hui Tang: use_nvp for NVP debug prints] + use NVPParamsMod , only : csol_nvp, watsat_nvp ! [PORTED by Hui Tang: NVP solid heat capacity for heat(c)] ! ! !PUBLIC TYPES: implicit none @@ -266,6 +268,8 @@ subroutine ComputeLiqIceMassNonLake(bounds, num_nolakec, filter_nolakec, & snocan_patch(bounds%begp:bounds%endp), & snocan_col(bounds%begc:bounds%endc)) + write(iulog,*) '[NVP DBG] snocan_patch=', snocan_patch + do fc = 1, num_nolakec c = filter_nolakec(fc) @@ -275,14 +279,42 @@ subroutine ComputeLiqIceMassNonLake(bounds, num_nolakec, filter_nolakec, & ! where FATES hydraulics is not turned on, this total_plant_stored_h2o is ! non-changing, and is set to 0 for a trivial solution. + write(iulog,*) '[NVP DBG] ComputeLiqIceMass c=',c,' j=',j, & + ' cum_liq=',liquid_mass(c),' cum_ice=',ice_mass(c), & + ' total_plant_stored_h2o=', total_plant_stored_h2o(c) + liquid_mass(c) = liquid_mass(c) + liqcan_col(c) + total_plant_stored_h2o(c) ice_mass(c) = ice_mass(c) + snocan_col(c) - ice_mass(c) = ice_mass(c) + h2osno_no_layers(c) - do j = snl(c)+1,0 + + + + ! [PORTED by Hui Tang: when NVP occupies j=0, stop at j=-1 so NVP water is not + ! counted as snow mass. The loop snl(c)+1..0 with snl=-4 would otherwise include j=0.] + !do j = snl(c)+1, merge(-1, 0, use_nvp .and. col%jbot_sno(c) == -1) + do j = snl(c)+1, 0 liquid_mass(c) = liquid_mass(c) + h2osoi_liq(c,j) ice_mass(c) = ice_mass(c) + h2osoi_ice(c,j) + ! [PORTED by Hui Tang: NVP debug — print each layer's water contribution to water mass] + if (use_nvp .and. col%jbot_sno(c) == -1 .and. c == bounds%begc) & + write(iulog,*) '[NVP DBG] ComputeLiqIceMass c=',c,' j=',j, & + ' liq=',h2osoi_liq(c,j),' ice=',h2osoi_ice(c,j), & + ' cum_liq=',liquid_mass(c),' cum_ice=',ice_mass(c) end do + ! [PORTED by Hui Tang: when NVP is active and snl=0, the loop above (j=snl+1..0 = 1..0) + ! is an empty range in Fortran, so j=0 (NVP layer) water is never counted. + ! AccumulateSoilLiqIceMassNonLake also starts at j=1, so NVP is fully absent + ! from the water balance when snow is gone. Explicitly include it here.] + if (col%nvp_layer_active(c) .and. snl(c) == 0) then + liquid_mass(c) = liquid_mass(c) + h2osoi_liq(c,0) + ice_mass(c) = ice_mass(c) + h2osoi_ice(c,0) + end if + + ! [PORTED by Hui Tang: NVP debug — print h2osno_no_layers and h2osfc after snow loop] + if (use_nvp .and. col%jbot_sno(c) == -1 .and. c == bounds%begc) & + write(iulog,*) '[NVP DBG] ComputeLiqIceMass c=',c,' snl=',snl(c), & + ' h2osno_no_layers=',h2osno_no_layers(c),' h2osfc=',h2osfc(c), & + ' liqcan=',liqcan_col(c),' snocan=',snocan_col(c) if (col%hydrologically_active(c)) then ! It's important to exclude non-hydrologically-active points, because some of @@ -312,6 +344,12 @@ subroutine ComputeLiqIceMassNonLake(bounds, num_nolakec, filter_nolakec, & liquid_mass = liquid_mass(bounds%begc:bounds%endc), & ice_mass = ice_mass(bounds%begc:bounds%endc)) + ! [PORTED by Hui Tang: NVP debug — print total liquid_mass and ice_mass after all contributions] + if (use_nvp .and. col%jbot_sno(bounds%begc) == -1) & + write(iulog,*) '[NVP DBG] ComputeLiqIceMass TOTAL c=',bounds%begc, & + ' liquid_mass=',liquid_mass(bounds%begc),' ice_mass=',ice_mass(bounds%begc), & + ' total=',liquid_mass(bounds%begc)+ice_mass(bounds%begc) + if (subtract_dynbal_baselines) then ! Subtract baselines set in initialization do fc = 1, num_nolakec @@ -384,6 +422,9 @@ subroutine AccumulateSoilLiqIceMassNonLake(bounds, num_c, filter_c, & if (has_h2o) then liquid_mass(c) = liquid_mass(c) + h2osoi_liq(c,j) ice_mass(c) = ice_mass(c) + h2osoi_ice(c,j) + excess_ice(c,j) + write(iulog,*) '[NVP DBG] ComputeLiqIceMass c=',c,' j=',j, & + ' cum_liq=',liquid_mass(c),' cum_ice=',ice_mass(c), h2osoi_ice(c,j), excess_ice(c,j) + end if end do end do @@ -688,7 +729,10 @@ subroutine ComputeHeatNonLake(bounds, num_nolakec, filter_nolakec, & j = 1 heat_ice(c) = heat_ice(c) + & TempToHeat(temp = t_soisno(c,j), cv = (h2osno_no_layers(c)*cpice)) - do j = snl(c)+1,0 + + ! [PORTED by Hui Tang: stop at j=-1 when NVP at j=0 — NVP heat tracked separately] + !do j = snl(c)+1, merge(-1, 0, use_nvp .and. col%jbot_sno(c) == -1) + do j = snl(c)+1, 0 call AccumulateLiquidWaterHeat( & temp = t_soisno(c,j), & h2o = h2osoi_liq(c,j), & @@ -699,6 +743,17 @@ subroutine ComputeHeatNonLake(bounds, num_nolakec, filter_nolakec, & TempToHeat(temp = t_soisno(c,j), cv = (h2osoi_ice(c,j)*cpice)) end do + ! [PORTED by Hui Tang (2026-06-12): add the NVP-layer SOLID (dry-mass) heat content to heat(c). + ! The j=0 moss WATER is already counted in the loop above, but the moss SOLID was omitted + ! (AccumulateSoilHeatNonLake loops j>=1 only). dz(c,0)=col%dz_nvp = nvp_dz*frac_nvp*canopy_frac + ! already carries frac_nvp, so csol_nvp*(1-watsat_nvp)*dz(c,0) is the PER-COLUMN solid heat + ! content. This makes heat(c) consistent with the per-moss cv (=old_cv/frac_nvp), for which + ! frac_nvp*cv_moss = solid_percol + water — both terms now tracked. Closes the total-energy gap.] + if (use_nvp .and. col%jbot_sno(c) == -1) then + heat_dry_mass(c) = heat_dry_mass(c) + & + TempToHeat(temp = t_soisno(c,0), cv = (csol_nvp*(1._r8-watsat_nvp)*dz(c,0))) + end if + if (col%hydrologically_active(c)) then ! NOTE(wjs, 2017-03-23) Water in the unconfined aquifer currently doesn't have ! an explicit temperature; thus, we only add its latent heat of diff --git a/src/biogeophys/WaterDiagnosticBulkType.F90 b/src/biogeophys/WaterDiagnosticBulkType.F90 index 48aeef73aa..2020efb408 100644 --- a/src/biogeophys/WaterDiagnosticBulkType.F90 +++ b/src/biogeophys/WaterDiagnosticBulkType.F90 @@ -16,7 +16,8 @@ module WaterDiagnosticBulkType use shr_log_mod , only : errMsg => shr_log_errMsg use decompMod , only : bounds_type use abortutils , only : endrun - use clm_varctl , only : use_cn, iulog, use_luna, use_hillslope + ! [PORTED by Hui Tang: add use_nvp for nvp (moss/lichen) wet fraction field] + use clm_varctl , only : use_cn, iulog, use_luna, use_hillslope, use_nvp use clm_varpar , only : nlevgrnd, nlevsno, nlevcan, nlevsoi use clm_varcon , only : spval use LandunitType , only : lun @@ -76,6 +77,9 @@ module WaterDiagnosticBulkType real(r8), pointer :: wf_col (:) ! col soil water as frac. of whc for top 0.05 m (0-1) real(r8), pointer :: wf2_col (:) ! col soil water as frac. of whc for top 0.17 m (0-1) real(r8), pointer :: fwet_patch (:) ! patch canopy fraction that is wet (0 to 1) + ! [PORTED by Hui Tang: nvp (moss/lichen) column wet fraction and volumetric water content] + real(r8), pointer :: fwet_nvp_col (:) ! col nvp (moss/lichen) wet fraction (0 to 1) + real(r8), pointer :: vwc_nvp_col (:) ! col nvp (moss/lichen) volumetric liquid water content (m3 m-3) real(r8), pointer :: fcansno_patch (:) ! patch canopy fraction that is snow covered (0 to 1) real(r8), pointer :: fdry_patch (:) ! patch canopy fraction of foliage that is green and dry [-] (new) @@ -230,6 +234,9 @@ subroutine InitBulkAllocate(this, bounds) allocate(this%wf_col (begc:endc)) ; this%wf_col (:) = nan allocate(this%wf2_col (begc:endc)) ; this%wf2_col (:) = nan allocate(this%fwet_patch (begp:endp)) ; this%fwet_patch (:) = nan + ! [PORTED by Hui Tang: allocate nvp (moss/lichen) column wet fraction and VWC, initialized to 0.6] + allocate(this%fwet_nvp_col (begc:endc)) ; this%fwet_nvp_col (:) = 0.6_r8 + allocate(this%vwc_nvp_col (begc:endc)) ; this%vwc_nvp_col (:) = 0.6_r8 allocate(this%fcansno_patch (begp:endp)) ; this%fcansno_patch (:) = nan allocate(this%fdry_patch (begp:endp)) ; this%fdry_patch (:) = nan allocate(this%qflx_prec_intr_patch (begp:endp)) ; this%qflx_prec_intr_patch (:) = nan @@ -247,7 +254,7 @@ subroutine InitBulkHistory(this, bounds) ! !USES: use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) use histFileMod , only : hist_addfld1d, hist_addfld2d, no_snow_normal, no_snow_zero - use clm_varctl , only : use_excess_ice + use clm_varctl , only : use_excess_ice, use_nvp ! ! !ARGUMENTS: class(waterdiagnosticbulk_type), intent(in) :: this @@ -374,6 +381,25 @@ subroutine InitBulkHistory(this, bounds) ptr_patch=this%rh10_af_patch, set_spec=spval, default='inactive') endif + ! [PORTED by Hui Tang: register nvp (moss/lichen) wet fraction and VWC history fields] + if (use_nvp) then + this%fwet_nvp_col(begc:endc) = spval + call hist_addfld1d ( & + fname=this%info%fname('FWET_NVP'), & + units='proportion', & + avgflag='A', & + long_name=this%info%lname('nvp (moss/lichen) wet fraction'), & + ptr_col=this%fwet_nvp_col, default='active') + + this%vwc_nvp_col(begc:endc) = spval + call hist_addfld1d ( & + fname=this%info%fname('VWC_NVP'), & + units='m3 m-3', & + avgflag='A', & + long_name=this%info%lname('nvp (moss/lichen) volumetric liquid water content'), & + ptr_col=this%vwc_nvp_col, default='active') + end if + ! Fractions this%frac_h2osfc_col(begc:endc) = spval @@ -794,7 +820,7 @@ subroutine RestartBulk(this, bounds, ncid, flag, writing_finidat_interp_dest_fil use spmdMod , only : masterproc use clm_varcon , only : pondmx, watmin, spval, nameg use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall - use clm_varctl , only : bound_h2osoi, use_excess_ice, nsrest, nsrContinue + use clm_varctl , only : bound_h2osoi, use_excess_ice, nsrest, nsrContinue, use_nvp use ncdio_pio , only : file_desc_t, ncd_io, ncd_double use restUtilMod use ExcessIceStreamType, only : UseExcessIceStreams @@ -989,6 +1015,18 @@ subroutine RestartBulk(this, bounds, ncid, flag, writing_finidat_interp_dest_fil end if endif + ! [PORTED by Hui Tang: restart I/O for nvp (moss/lichen) wet fraction] + if (use_nvp) then + call restartvar(ncid=ncid, flag=flag, varname=this%info%fname('FWET_NVP'), & + xtype=ncd_double, dim1name='column', & + long_name=this%info%lname('nvp (moss/lichen) wet fraction'), & + units='proportion', & + interpinic_flag='interp', readvar=readvar, data=this%fwet_nvp_col) + if (flag == 'read' .and. .not. readvar) then + this%fwet_nvp_col(bounds%begc:bounds%endc) = 0.6_r8 + end if + end if + end subroutine RestartBulk !----------------------------------------------------------------------- diff --git a/src/biogeophys/WaterDiagnosticType.F90 b/src/biogeophys/WaterDiagnosticType.F90 index 57be0e62af..7177ca0822 100644 --- a/src/biogeophys/WaterDiagnosticType.F90 +++ b/src/biogeophys/WaterDiagnosticType.F90 @@ -47,6 +47,8 @@ module WaterDiagnosticType real(r8), pointer :: qg_snow_col (:) ! col ground specific humidity [kg/kg] real(r8), pointer :: qg_soil_col (:) ! col ground specific humidity [kg/kg] real(r8), pointer :: qg_h2osfc_col (:) ! col ground specific humidity [kg/kg] + ! [PORTED by Hui Tang: NVP surface specific humidity, used in ground evap blending] + real(r8), pointer :: qg_nvp_col (:) ! col NVP surface specific humidity [kg/kg] real(r8), pointer :: qg_col (:) ! col ground specific humidity [kg/kg] real(r8), pointer :: qaf_lun (:) ! lun urban canopy air specific humidity (kg/kg) @@ -129,6 +131,10 @@ subroutine InitAllocate(this, bounds, tracer_vars) call AllocateVar1d(var = this%qg_h2osfc_col, name = 'qg_h2osfc_col', & container = tracer_vars, & bounds = bounds, subgrid_level = subgrid_level_column) + ! [PORTED by Hui Tang: NVP surface specific humidity, used in ground evap blending] + call AllocateVar1d(var = this%qg_nvp_col, name = 'qg_nvp_col', & + container = tracer_vars, & + bounds = bounds, subgrid_level = subgrid_level_column) call AllocateVar1d(var = this%qg_col, name = 'qg_col', & container = tracer_vars, & bounds = bounds, subgrid_level = subgrid_level_column) diff --git a/src/biogeophys/WaterFluxBulkType.F90 b/src/biogeophys/WaterFluxBulkType.F90 index eb0a1d3303..daac7737e7 100644 --- a/src/biogeophys/WaterFluxBulkType.F90 +++ b/src/biogeophys/WaterFluxBulkType.F90 @@ -37,6 +37,17 @@ module WaterFluxBulkType real(r8), pointer :: qflx_ev_soil_col (:) ! col evaporation heat flux from soil (mm H2O/s) [+ to atm] real(r8), pointer :: qflx_ev_h2osfc_patch (:) ! patch evaporation heat flux from soil (mm H2O/s) [+ to atm] real(r8), pointer :: qflx_ev_h2osfc_col (:) ! col evaporation heat flux from soil (mm H2O/s) [+ to atm] + ! [PORTED by Hui Tang: NVP (moss/lichen) ground evaporation flux] + real(r8), pointer :: qflx_ev_nvp_patch (:) ! patch evaporation flux from NVP (mm H2O/s) [+ to atm] + real(r8), pointer :: qflx_ev_nvp_col (:) ! col evaporation flux from NVP (mm H2O/s) [+ to atm] + ! [PORTED by Hui Tang: diagnostic — effective NVP evap = frac_nvp_eff * qflx_ev_nvp_col, + ! i.e. the column-area-weighted flux actually removed from the NVP water balance. + ! History output only; not used by any physics.] + real(r8), pointer :: qflx_ev_nvp_eff_col (:) ! col effective NVP evap (mm H2O/s) + ! [PORTED by Hui Tang: NVP water infiltration and drainage fluxes] + real(r8), pointer :: qflx_nvp_infl_col (:) ! col water arriving at top of NVP layer (mm H2O/s) [diagnostic] + real(r8), pointer :: qflx_nvp_drain_col (:) ! col drainage from NVP layer 0 to soil layer 1 (mm H2O/s) + real(r8), pointer :: qflx_nvp_to_snow_col (:) ! [PORTED by Hui Tang] col excess NVP ice (above pore capacity) pushed up into bottom snow layer (mm H2O/s) real(r8), pointer :: qflx_adv_col (:,:) ! col advective flux across different soil layer interfaces [mm H2O/s] [+ downward] real(r8), pointer :: qflx_rootsoi_col (:,:) ! col root and soil water exchange [mm H2O/s] [+ into root] @@ -122,6 +133,14 @@ subroutine InitBulkAllocate(this, bounds) allocate( this%qflx_ev_soil_col (begc:endc)) ; this%qflx_ev_soil_col (:) = nan allocate( this%qflx_ev_h2osfc_patch (begp:endp)) ; this%qflx_ev_h2osfc_patch (:) = nan allocate( this%qflx_ev_h2osfc_col (begc:endc)) ; this%qflx_ev_h2osfc_col (:) = nan + ! [PORTED by Hui Tang: allocate NVP evaporation flux arrays] + allocate( this%qflx_ev_nvp_patch (begp:endp)) ; this%qflx_ev_nvp_patch (:) = nan + allocate( this%qflx_ev_nvp_col (begc:endc)) ; this%qflx_ev_nvp_col (:) = nan + allocate( this%qflx_ev_nvp_eff_col (begc:endc)) ; this%qflx_ev_nvp_eff_col (:) = nan + ! [PORTED by Hui Tang: allocate NVP infiltration and drainage flux arrays] + allocate( this%qflx_nvp_infl_col (begc:endc)) ; this%qflx_nvp_infl_col (:) = nan + allocate( this%qflx_nvp_drain_col (begc:endc)) ; this%qflx_nvp_drain_col (:) = nan + allocate( this%qflx_nvp_to_snow_col (begc:endc)) ; this%qflx_nvp_to_snow_col (:) = 0._r8 ! [PORTED by Hui Tang] allocate(this%qflx_drain_vr_col (begc:endc,1:nlevsoi)) ; this%qflx_drain_vr_col (:,:) = nan allocate(this%qflx_adv_col (begc:endc,0:nlevsoi)) ; this%qflx_adv_col (:,:) = nan @@ -147,6 +166,7 @@ subroutine InitBulkHistory(this, bounds) ! ! !USES: use histFileMod , only : hist_addfld1d, hist_addfld2d, no_snow_normal + use clm_varctl , only : use_nvp ! [PORTED by Hui Tang: NVP history fields] ! ! !ARGUMENTS: class(waterfluxbulk_type), intent(in) :: this @@ -244,7 +264,47 @@ subroutine InitBulkHistory(this, bounds) avgflag='A', & long_name=this%info%lname('Annual ET'), & ptr_col=this%AnnET, c2l_scale_type='urbanf', default='inactive') - + + ! [PORTED by Hui Tang: history fields for NVP (moss/lichen) water fluxes] + if (use_nvp) then + this%qflx_ev_nvp_patch(begp:endp) = spval + call hist_addfld1d ( & + fname=this%info%fname('QFLX_EV_NVP'), units='mm/s', & + avgflag='A', long_name=this%info%lname('evaporation flux from nvp (moss/lichen)'), & + ptr_patch=this%qflx_ev_nvp_patch, c2l_scale_type='urbanf', default='inactive') + + this%qflx_ev_nvp_col(begc:endc) = spval + call hist_addfld1d ( & + fname=this%info%fname('QFLX_EV_NVP_COL'), units='mm/s', & + avgflag='A', long_name=this%info%lname('column evaporation flux from nvp (moss/lichen)'), & + ptr_col=this%qflx_ev_nvp_col, c2l_scale_type='urbanf', default='inactive') + + this%qflx_ev_nvp_eff_col(begc:endc) = spval + call hist_addfld1d ( & + fname=this%info%fname('QFLX_EV_NVP_EFF_COL'), units='mm/s', & + avgflag='A', long_name=this%info%lname('effective nvp evaporation = frac_nvp_eff*qflx_ev_nvp_col'), & + ptr_col=this%qflx_ev_nvp_eff_col, c2l_scale_type='urbanf', default='inactive') + + this%qflx_nvp_infl_col(begc:endc) = spval + call hist_addfld1d ( & + fname=this%info%fname('QFLX_NVP_INFL'), units='mm/s', & + avgflag='A', long_name=this%info%lname('water arriving at top of nvp (moss/lichen) layer'), & + ptr_col=this%qflx_nvp_infl_col, c2l_scale_type='urbanf', default='inactive') + + this%qflx_nvp_drain_col(begc:endc) = spval + call hist_addfld1d ( & + fname=this%info%fname('QFLX_NVP_DRAIN'), units='mm/s', & + avgflag='A', long_name=this%info%lname('drainage from nvp (moss/lichen) layer to soil'), & + ptr_col=this%qflx_nvp_drain_col, c2l_scale_type='urbanf', default='inactive') + + ! [PORTED by Hui Tang: history for excess NVP ice routed to bottom snow layer] + this%qflx_nvp_to_snow_col(begc:endc) = spval + call hist_addfld1d ( & + fname=this%info%fname('QFLX_NVP_TO_SNOW'), units='mm/s', & + avgflag='A', long_name=this%info%lname('excess nvp (moss/lichen) ice pushed into bottom snow layer'), & + ptr_col=this%qflx_nvp_to_snow_col, c2l_scale_type='urbanf', default='inactive') + end if + end subroutine InitBulkHistory diff --git a/src/biogeophys/WaterStateType.F90 b/src/biogeophys/WaterStateType.F90 index 35441d65d9..1d5224b837 100644 --- a/src/biogeophys/WaterStateType.F90 +++ b/src/biogeophys/WaterStateType.F90 @@ -13,7 +13,8 @@ module WaterStateType use abortutils , only : endrun use decompMod , only : bounds_type use decompMod , only : subgrid_level_patch, subgrid_level_column, subgrid_level_landunit, subgrid_level_gridcell - use clm_varctl , only : use_bedrock, use_excess_ice, iulog + ! [PORTED by Hui Tang: add use_nvp for nvp (moss/lichen) water content field] + use clm_varctl , only : use_bedrock, use_excess_ice, iulog, use_nvp use spmdMod , only : masterproc use clm_varctl , only : use_fates, use_hillslope use clm_varpar , only : nlevgrnd, nlevsoi, nlevurb, nlevmaxurbgrnd, nlevsno @@ -40,6 +41,8 @@ module WaterStateType real(r8), pointer :: h2osoi_vol_col (:,:) ! col volumetric soil water (0<=h2osoi_vol<=watsat) [m3/m3] (nlevgrnd) real(r8), pointer :: h2osoi_vol_prs_grc (:,:) ! grc volumetric soil water prescribed (0<=h2osoi_vol<=watsat) [m3/m3] (nlevgrnd) real(r8), pointer :: h2osfc_col (:) ! col surface water (mm H2O) + ! [PORTED by Hui Tang: nvp (moss/lichen) column water content] + real(r8), pointer :: h2onvp_col (:) ! col nvp (moss/lichen) water content (mm H2O) real(r8), pointer :: snocan_patch (:) ! patch canopy snow water (mm H2O) real(r8), pointer :: liqcan_patch (:) ! patch canopy liquid water (mm H2O) @@ -151,6 +154,10 @@ subroutine InitAllocate(this, bounds, tracer_vars) call AllocateVar1d(var = this%h2osfc_col, name = 'h2osfc_col', & container = tracer_vars, & bounds = bounds, subgrid_level = subgrid_level_column) + ! [PORTED by Hui Tang: allocate nvp (moss/lichen) column water content via tracer container] + call AllocateVar1d(var = this%h2onvp_col, name = 'h2onvp_col', & + container = tracer_vars, & + bounds = bounds, subgrid_level = subgrid_level_column) call AllocateVar1d(var = this%wa_col, name = 'wa_col', & container = tracer_vars, & bounds = bounds, subgrid_level = subgrid_level_column) @@ -182,7 +189,7 @@ subroutine InitHistory(this, bounds, use_aquifer_layer) ! ! !USES: use histFileMod , only : hist_addfld1d, hist_addfld2d, no_snow_normal - use clm_varctl , only : use_soil_moisture_streams + use clm_varctl , only : use_soil_moisture_streams, use_nvp use GridcellType , only : grc ! ! !ARGUMENTS: @@ -317,6 +324,16 @@ subroutine InitHistory(this, bounds, use_aquifer_layer) ! can be provided through FATES specific history diagnostics ! if need be. + ! [PORTED by Hui Tang: register nvp (moss/lichen) water content history field] + if (use_nvp) then + this%h2onvp_col(begc:endc) = spval + call hist_addfld1d ( & + fname=this%info%fname('H2ONVP'), & + units='mm', & + avgflag='A', & + long_name=this%info%lname('nvp (moss/lichen) water content'), & + ptr_col=this%h2onvp_col, default='active') + end if end subroutine InitHistory @@ -360,6 +377,9 @@ subroutine InitCold(this, bounds, & associate(snl => col%snl) this%h2osfc_col(bounds%begc:bounds%endc) = 0._r8 + ! [PORTED by Hui Tang: h2onvp_col diagnostic; actual h2osoi_liq(c,0) is set in + ! NVPLayerDynamicsMod UpdateNVPLayer appear branch (vwc=0.6)] + this%h2onvp_col(bounds%begc:bounds%endc) = 0._r8 this%snocan_patch(bounds%begp:bounds%endp) = 0._r8 this%liqcan_patch(bounds%begp:bounds%endp) = 0._r8 this%stream_water_volume_lun(bounds%begl:bounds%endl) = 0._r8 @@ -601,7 +621,7 @@ subroutine Restart(this, bounds, ncid, flag, & use landunit_varcon , only : istcrop, istdlak, istsoil use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall use clm_time_manager , only : is_first_step, is_restart - use clm_varctl , only : bound_h2osoi, nsrest, nsrContinue + use clm_varctl , only : bound_h2osoi, nsrest, nsrContinue, use_nvp use ncdio_pio , only : file_desc_t, ncd_double use ExcessIceStreamType, only : UseExcessIceStreams use restUtilMod , only : restartvar, RestartExcessIceIssue @@ -850,6 +870,18 @@ subroutine Restart(this, bounds, ncid, flag, & endif ! end if if-read flag + ! [PORTED by Hui Tang: restart I/O for nvp (moss/lichen) water content] + if (use_nvp) then + call restartvar(ncid=ncid, flag=flag, varname=this%info%fname('H2ONVP'), & + xtype=ncd_double, dim1name='column', & + long_name=this%info%lname('nvp (moss/lichen) water content'), & + units='mm', & + interpinic_flag='interp', readvar=readvar, data=this%h2onvp_col) + if (flag == 'read' .and. .not. readvar) then + this%h2onvp_col(bounds%begc:bounds%endc) = 0.0_r8 + end if + end if + end subroutine Restart !----------------------------------------------------------------------- @@ -889,6 +921,8 @@ subroutine CalculateTotalH2osno(this, & h2osno_total(c) = this%h2osno_no_layers_col(c) do j = col%snl(c)+1, 0 + ! [PORTED by Hui Tang: NVP at layer 0 is not snow; exclude from SWE total] + if (use_nvp .and. col%jbot_sno(c) == -1 .and. j == 0) cycle h2osno_total(c) = & h2osno_total(c) + & this%h2osoi_ice_col(c,j) + & @@ -934,6 +968,8 @@ subroutine CheckSnowConsistency(this, num_c, filter_c, caller) end if do j = -nlevsno+1, col%snl(c) + ! [PORTED by Hui Tang: NVP layer at j=0 legitimately holds water when snl=0] + if (use_nvp .and. col%jbot_sno(c) == -1 .and. j == 0) cycle ice_bad = (this%h2osoi_ice_col(c,j) /= 0._r8 .and. this%h2osoi_ice_col(c,j) /= spval) liq_bad = (this%h2osoi_liq_col(c,j) /= 0._r8 .and. this%h2osoi_liq_col(c,j) /= spval) if (ice_bad .or. liq_bad) then diff --git a/src/dyn_subgrid/dynEDMod.F90 b/src/dyn_subgrid/dynEDMod.F90 index e1cb1ccb42..f9d3807645 100644 --- a/src/dyn_subgrid/dynEDMod.F90 +++ b/src/dyn_subgrid/dynEDMod.F90 @@ -5,6 +5,7 @@ module dynEDMod use shr_kind_mod , only : r8 => shr_kind_r8 use decompMod , only : bounds_type use landunit_varcon, only : istsoil + use clm_varctl , only : iulog use PatchType , only : patch use ColumnType , only : col ! @@ -32,8 +33,10 @@ subroutine dyn_ED( bounds ) if (col%itype(c) == istsoil) then if (patch%is_veg(p) .or. patch%is_bareground(p)) then patch%wtcol(p) = patch%wt_ed(p) + write(iulog,'(a,2i6,2l2,f10.5)') '[DBG dynED] p, c, is_bg, is_veg, wtcol:', & + p, c, patch%is_bareground(p), patch%is_veg(p), patch%wtcol(p) else - patch%wtcol(p) = 0.0_r8 + patch%wtcol(p) = 0.0_r8 end if end if end do diff --git a/src/fates b/src/fates index e027a4030d..54cd2c3759 160000 --- a/src/fates +++ b/src/fates @@ -1 +1 @@ -Subproject commit e027a4030d2a0f09039fb337ad67ced7461dd4f0 +Subproject commit 54cd2c375976cbea96e1637222c624f664e0870b diff --git a/src/main/ColumnType.F90 b/src/main/ColumnType.F90 index ab7ee8e261..c73f521daf 100644 --- a/src/main/ColumnType.F90 +++ b/src/main/ColumnType.F90 @@ -60,9 +60,20 @@ module ColumnType ! vertical levels integer , pointer :: snl (:) ! number of snow layers - real(r8), pointer :: dz (:,:) ! layer thickness (m) (-nlevsno+1:nlevgrnd) - real(r8), pointer :: z (:,:) ! layer depth (m) (-nlevsno+1:nlevgrnd) - real(r8), pointer :: zi (:,:) ! interface level below a "z" level (m) (-nlevsno+0:nlevgrnd) + ! [PORTED by Hui Tang: bottom index of active snow layers for NVP layer-0 design] + ! jbot_sno = 0 when no NVP layer (standard CLM: snow loops run snl(c)+1 .. 0) + ! jbot_sno = -1 when NVP layer is present at index 0 (snow loops stop at -1) + integer , pointer :: jbot_sno (:) ! bottom index of active snow layers (0 or -1) + ! [PORTED by Hui Tang: NVP (moss/lichen) layer presence flag at vertical index 0] + logical , pointer :: nvp_layer_active (:) ! .true. when NVP layer occupies index 0 + ! [PORTED by Hui Tang: column-effective NVP layer geometry, aggregated from FATES bc_out] + ! Updated each FATES dynamics timestep in clmfates_interfaceMod%wrap_update_hlmfates_dyn. + ! Consumed by NVPLayerDynamicsMod%UpdateNVPLayer to drive col%dz(c,0) and jbot_sno. + real(r8), pointer :: dz_nvp (:) ! column-effective NVP layer thickness [m] + real(r8), pointer :: frac_nvp (:) ! column-effective NVP fractional coverage [0-1] + real(r8), pointer :: dz (:,:) ! layer thickness (m) (-nlevsno+1:nlevgrnd) + real(r8), pointer :: z (:,:) ! layer depth (m) (-nlevsno+1:nlevgrnd) + real(r8), pointer :: zi (:,:) ! interface level below a "z" level (m) (-nlevsno+0:nlevgrnd) real(r8), pointer :: zii (:) ! convective boundary height [m] real(r8), pointer :: dz_lake (:,:) ! lake layer thickness (m) (1:nlevlak) real(r8), pointer :: z_lake (:,:) ! layer depth for lake (m) @@ -135,6 +146,12 @@ subroutine Init(this, begc, endc) ! The following is set in initVerticalMod allocate(this%snl (begc:endc)) ; this%snl (:) = ispval !* cannot be averaged up + ! [PORTED by Hui Tang: allocate NVP layer-0 control arrays] + allocate(this%jbot_sno (begc:endc)) ; this%jbot_sno (:) = 0 ! default: no NVP, snow to index 0 + allocate(this%nvp_layer_active(begc:endc)) ; this%nvp_layer_active(:) = .false. + ! [PORTED by Hui Tang: column-effective NVP geometry; zero until FATES dynamics provides values] + allocate(this%dz_nvp (begc:endc)) ; this%dz_nvp (:) = 0._r8 + allocate(this%frac_nvp(begc:endc)) ; this%frac_nvp(:) = 0._r8 allocate(this%dz (begc:endc,-nlevsno+1:nlevmaxurbgrnd)) ; this%dz (:,:) = nan allocate(this%z (begc:endc,-nlevsno+1:nlevmaxurbgrnd)) ; this%z (:,:) = nan allocate(this%zi (begc:endc,-nlevsno+0:nlevmaxurbgrnd)) ; this%zi (:,:) = nan @@ -183,6 +200,10 @@ subroutine Clean(this) deallocate(this%is_fates ) deallocate(this%type_is_dynamic) deallocate(this%snl ) + deallocate(this%jbot_sno ) + deallocate(this%nvp_layer_active) + deallocate(this%dz_nvp ) + deallocate(this%frac_nvp) deallocate(this%dz ) deallocate(this%z ) deallocate(this%zi ) diff --git a/src/main/clm_driver.F90 b/src/main/clm_driver.F90 index 38d13a71f8..d8a1f977de 100644 --- a/src/main/clm_driver.F90 +++ b/src/main/clm_driver.F90 @@ -14,6 +14,7 @@ module clm_driver use CNSharedParamsMod , only : use_matrixcn use clm_varctl , only : use_crop, irrigate, ndep_from_cpl use clm_varctl , only : use_soil_moisture_streams, fates_radiation_model + use clm_varctl , only : use_nvp ! [PORTED by Hui Tang: NVP photosynthesis flag] use clm_varctl , only : use_cropcal_streams, is_cold_start, nsrest, nsrStartup use clm_time_manager , only : get_nstep, is_beg_curr_day, is_beg_curr_year use clm_time_manager , only : get_prev_date, is_first_step @@ -67,7 +68,7 @@ module clm_driver use ch4Mod , only : ch4, ch4_init_gridcell_balance_check, ch4_init_column_balance_check use VOCEmissionMod , only : VOCEmission ! - use filterMod , only : setFilters + use filterMod , only : setFilters, setNVPcFilter ! [PORTED by Hui Tang: NVP column filter] ! use atm2lndMod , only : downscale_forcings, set_atm2lnd_water_tracers use lnd2atmMod , only : lnd2atm @@ -639,7 +640,7 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro ! over the patch index range defined by bounds_clump%begp:bounds_proc%endp if(use_fates) then - call clm_fates%wrap_sunfrac(nc,atm2lnd_inst, canopystate_inst) + call clm_fates%wrap_sunfrac(nc, atm2lnd_inst, canopystate_inst, surfalb_inst) else call CanopySunShadeFracs(filter(nc)%nourbanp,filter(nc)%num_nourbanp, & atm2lnd_inst, surfalb_inst, canopystate_inst, & @@ -762,6 +763,12 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro bounds_clump, canopystate_inst%tlai_patch(bounds_clump%begp:bounds_clump%endp)) end if + ! [DBG NVP] Check exposed/noexposed veg patch filters before CanopyFluxes + write(iulog,*) '[DBG filter] num_exposedvegp=', filter(nc)%num_exposedvegp, & + ' exposedvegp=', filter(nc)%exposedvegp(1:filter(nc)%num_exposedvegp) + write(iulog,*) '[DBG filter] num_noexposedvegp=', filter(nc)%num_noexposedvegp, & + ' noexposedvegp=', filter(nc)%noexposedvegp(1:filter(nc)%num_noexposedvegp) + call CanopyFluxes(bounds_clump, & filter(nc)%num_exposedvegp, filter(nc)%exposedvegp, & clm_fates,nc, & @@ -779,6 +786,16 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro deallocate(downreg_patch, leafn_patch, froot_carbon, croot_carbon) call t_stopf('canflux') + ! [PORTED by Hui Tang: NVP (moss/lichen) photosynthesis — separate from CanopyFluxes. + ! NVP lacks stomata so it must not go through the CanopyFluxes iterative solver. + ! Called after CanopyFluxes convergence so that post-convergence t_veg and t_nvp_col + ! are available, and waterdiagnosticbulk_inst (needed for fwet_nvp_col) is in scope.] + if (use_fates .and. use_nvp) then + call clm_fates%wrap_nvp_photosynthesis(nc, bounds_clump, & + atm2lnd_inst, temperature_inst, & + water_inst%waterdiagnosticbulk_inst, frictionvel_inst) + end if + ! Fluxes for all urban landunits call t_startf('uflux') @@ -895,6 +912,7 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro filter(nc)%num_urbanc , filter(nc)%urbanc, & filter(nc)%num_nolakep , filter(nc)%nolakep, & filter(nc)%num_nolakec , filter(nc)%nolakec, & + filter(nc)%num_nvpc , filter(nc)%nvpc, & ! [PORTED by Hui Tang: NVP column filter] atm2lnd_inst, urbanparams_inst, canopystate_inst, water_inst%waterstatebulk_inst, & water_inst%waterdiagnosticbulk_inst, water_inst%waterfluxbulk_inst, & solarabs_inst, soilstate_inst, energyflux_inst, temperature_inst, urbantv_inst) @@ -952,6 +970,12 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro saturated_excess_runoff_inst, & infiltration_excess_runoff_inst, & aerosol_inst, canopystate_inst, scf_method, soil_water_retention_curve, topo_inst) + + ! [DBG NVP] Check snow/nosnow column filters before HydrologyNoDrainage + write(iulog,*) '[DBG filter] num_snowc=', filter(nc)%num_snowc, & + ' snowc=', filter(nc)%snowc(1:filter(nc)%num_snowc) + write(iulog,*) '[DBG filter] num_nosnowc=', filter(nc)%num_nosnowc, & + ' nosnowc=', filter(nc)%nosnowc(1:filter(nc)%num_nosnowc) ! The following needs to be done after HydrologyNoDrainage (because it needs ! waterfluxbulk_inst%qflx_snwcp_ice_col), but before HydrologyDrainage (because @@ -1202,6 +1226,10 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro ! call to reweight_wrapup, if it's needed at all. call setFilters( bounds_clump, glc_behavior ) + ! [PORTED by Hui Tang: rebuild NVP column filter after FATES dynamics + ! updates col%nvp_layer_active / jbot_sno via UpdateNVPLayer] + if (use_nvp) call setNVPcFilter(bounds_clump) + end if @@ -1695,6 +1723,26 @@ subroutine clm_drv_patch2col (bounds, & waterfluxbulk_inst%qflx_ev_h2osfc_patch(bounds%begp:bounds%endp), & waterfluxbulk_inst%qflx_ev_h2osfc_col(bounds%begc:bounds%endc)) + ! [PORTED by Hui Tang: aggregate NVP evaporation flux from patches to column] + call p2c (bounds, num_nolakec, filter_nolakec, & + waterfluxbulk_inst%qflx_ev_nvp_patch(bounds%begp:bounds%endp), & + waterfluxbulk_inst%qflx_ev_nvp_col(bounds%begc:bounds%endc)) + + if (use_nvp) then + do fc = 1, num_nolakec + c = filter_nolakec(fc) + if (col%nvp_layer_active(c)) then + associate(p_bg => col%patchi(c), p_vf => col%patchf(c)) + write(iulog,'(a,i6,5f12.6)') '[DBG NVP flux] c, frac_nvp, wtcol_bg, qflx_ev_nvp_bg, qflx_ev_nvp_veg(wtd sum), qflx_ev_nvp_col:', & + c, col%frac_nvp(c), patch%wtcol(p_bg), & + waterfluxbulk_inst%qflx_ev_nvp_patch(p_bg), & + sum(waterfluxbulk_inst%qflx_ev_nvp_patch(p_bg+1:p_vf) * patch%wtcol(p_bg+1:p_vf)), & + waterfluxbulk_inst%qflx_ev_nvp_col(c) + end associate + end if + end do + end if + ! Averaging for patch water flux variables call p2c (bounds, num_nolakec, filter_nolakec, & diff --git a/src/main/clm_initializeMod.F90 b/src/main/clm_initializeMod.F90 index 4530fda860..3240f36757 100644 --- a/src/main/clm_initializeMod.F90 +++ b/src/main/clm_initializeMod.F90 @@ -12,6 +12,7 @@ module clm_initializeMod use abortutils , only : endrun use clm_varctl , only : nsrest, nsrStartup, nsrContinue, nsrBranch use clm_varctl , only : use_fates_sp, use_fates_bgc, use_fates + use clm_varctl , only : use_nvp ! [PORTED by Hui Tang: NVP cold-start ice override] use clm_varctl , only : is_cold_start use clm_varctl , only : iulog use clm_varctl , only : use_lch4, use_cn, use_cndv, use_c13, use_c14, nhillslope @@ -25,6 +26,7 @@ module clm_initializeMod use LandunitType , only : lun ! instance use ColumnType , only : col ! instance use PatchType , only : patch ! instance + use NVPLayerDynamicsMod , only : NVPColdStartIce ! [PORTED by Hui Tang: NVP cold-start ice override] use reweightMod , only : reweight_wrapup use filterMod , only : allocFilters, filter, filter_inactive_and_active use CLMFatesInterfaceMod , only : CLMFatesGlobals1,CLMFatesGlobals2 @@ -760,6 +762,19 @@ subroutine initialize2(ni,nj, currtime) call clm_fates%init_coldstart(water_inst%waterstatebulk_inst, & water_inst%waterdiagnosticbulk_inst, canopystate_inst, & soilstate_inst, soilbiogeochem_carbonflux_inst) + + ! [PORTED by Hui Tang: override NVP layer-0 ice to its pore capacity at cold start. + ! Runs after init_coldstart has set the NVP geometry (nvp_layer_active, dz) and before + ! the first begwb, so the initial water balance reflects the cap (no first-step blip / + ! no discarded water). Inside the cold-start FATES guard above, so it is cold-start only.] + if (use_nvp) then + !$OMP PARALLEL DO PRIVATE (nc, bounds_clump) + do nc = 1,nclumps + call get_clump_bounds(nc, bounds_clump) + call NVPColdStartIce(bounds_clump, water_inst%waterstatebulk_inst) + end do + !$OMP END PARALLEL DO + end if end if ! topo_glc_mec was allocated in initialize1, but needed to be kept around through diff --git a/src/main/clm_instMod.F90 b/src/main/clm_instMod.F90 index 7d9a0f6ad2..2790182774 100644 --- a/src/main/clm_instMod.F90 +++ b/src/main/clm_instMod.F90 @@ -9,6 +9,8 @@ module clm_instMod use decompMod , only : bounds_type use clm_varpar , only : ndecomp_pools, nlevdecomp_full use clm_varctl , only : use_cn, use_c13, use_c14, use_lch4, use_cndv, use_fates, use_fates_bgc + ! [PORTED by Hui Tang: NVP column geometry restart] + use clm_varctl , only : use_nvp use clm_varctl , only : iulog use clm_varctl , only : use_crop, snow_cover_fraction_method, paramfile use clm_varctl , only : use_excess_ice @@ -519,6 +521,7 @@ subroutine clm_instRest(bounds, ncid, flag, writing_finidat_interp_dest_file) use UrbanParamsType , only : IsSimpleBuildTemp, IsProgBuildTemp use decompMod , only : get_proc_bounds, get_proc_clumps, get_clump_bounds use clm_varpar , only : nlevsno + use NVPLayerDynamicsMod, only : NVPLayerRestart ! ! !DESCRIPTION: @@ -628,6 +631,12 @@ subroutine clm_instRest(bounds, ncid, flag, writing_finidat_interp_dest_file) end if + ! [PORTED by Hui Tang: restart NVP column geometry — must follow FATES restart + ! so that FATES cohort state is already restored when NVP layer is reactivated] + if (use_nvp) then + call NVPLayerRestart(bounds, ncid, flag=flag) + end if + end subroutine clm_instRest end module clm_instMod diff --git a/src/main/clm_varctl.F90 b/src/main/clm_varctl.F90 index 83133acf2b..a3e6503bec 100644 --- a/src/main/clm_varctl.F90 +++ b/src/main/clm_varctl.F90 @@ -379,7 +379,23 @@ module clm_varctl logical, public :: use_fates_bgc = .false. ! true => use FATES along with CLM soil biogeochemistry !---------------------------------------------------------- - ! LUNA switches + ! [PORTED by Hui Tang: moss/lichen (nvp) control variables] + ! NVP (moss/lichen) switches + !---------------------------------------------------------- + + ! true => activate nvp model + logical, public :: use_nvp = .false. + + ! true => nvp can photosynthesize under snow + logical, public :: use_nvp_undersnow = .true. + + ! [PORTED by Hui Tang: NVP radiation model switch] + ! true => Approach A: NVP as ground boundary contribute to ground albedo, Beer's law PAR, + ! false => Approach B: NVP as leaf layer in Norman solver, soil albedo as ground albedo + logical, public :: nvp_rad_model_ground = .true. + + !---------------------------------------------------------- + ! LUNA switches !---------------------------------------------------------- logical, public :: use_luna = .false. ! true => use LUNA diff --git a/src/main/controlMod.F90 b/src/main/controlMod.F90 index 082e3bb710..8429ac2f2f 100644 --- a/src/main/controlMod.F90 +++ b/src/main/controlMod.F90 @@ -51,6 +51,8 @@ module controlMod use CanopyFluxesMod , only: CanopyFluxesReadNML use shr_drydep_mod , only: n_drydep use clm_varctl + ! [PORTED by Hui Tang: NVP parameter namelist module] + use NVPParamsMod ! ! !PUBLIC TYPES: implicit none @@ -267,6 +269,15 @@ subroutine control_init(dtime) ! CLM 5.0 nitrogen flags namelist /clm_inparm/ use_flexibleCN, use_luna + ! [PORTED by Hui Tang: nvp (moss/lichen) namelist flags] + namelist /clm_inparm/ use_nvp, use_nvp_undersnow, nvp_rad_model_ground + + ! [PORTED by Hui Tang: nvp physics parameter namelist] + namelist /nvp_inparm/ & + nvp_frac_min, rnvp_min, rnvp_amp, rnvp_exp, & + ksat_nvp, n_van_nvp, alpha_van_nvp, watsat_nvp, watres_nvp, & + thk_dry_nvp, csol_nvp + namelist /clm_nitrogen/ MM_Nuptake_opt, & CNratio_floating, lnc_opt, reduce_dayl_factor, vcmax_opt, & CN_evergreen_phenology_opt, carbon_resp_opt @@ -390,6 +401,16 @@ subroutine control_init(dtime) call endrun(msg='ERROR finding clm_nitrogen namelist'//errMsg(sourcefile, __LINE__)) end if + ! [PORTED by Hui Tang: read nvp physics parameter namelist (optional)] + rewind(unitn) + call shr_nl_find_group_name(unitn, 'nvp_inparm', status=ierr) + if (ierr == 0) then + read(unitn, nvp_inparm, iostat=ierr) + if (ierr /= 0) then + call endrun(msg='ERROR reading nvp_inparm namelist'//errMsg(sourcefile, __LINE__)) + end if + end if + call relavu( unitn ) ! ---------------------------------------------------------------------- @@ -865,6 +886,24 @@ subroutine control_spmd() call mpi_bcast (use_luna, 1, MPI_LOGICAL, 0, mpicom, ier) + ! [PORTED by Hui Tang: broadcast nvp (moss/lichen) flags] + call mpi_bcast (use_nvp, 1, MPI_LOGICAL, 0, mpicom, ier) + call mpi_bcast (use_nvp_undersnow, 1, MPI_LOGICAL, 0, mpicom, ier) + call mpi_bcast (nvp_rad_model_ground, 1, MPI_LOGICAL, 0, mpicom, ier) + + ! [PORTED by Hui Tang: broadcast nvp physics parameters] + call mpi_bcast (nvp_frac_min, 1, MPI_REAL8, 0, mpicom, ier) + call mpi_bcast (rnvp_min, 1, MPI_REAL8, 0, mpicom, ier) + call mpi_bcast (rnvp_amp, 1, MPI_REAL8, 0, mpicom, ier) + call mpi_bcast (rnvp_exp, 1, MPI_REAL8, 0, mpicom, ier) + call mpi_bcast (ksat_nvp, 1, MPI_REAL8, 0, mpicom, ier) + call mpi_bcast (n_van_nvp, 1, MPI_REAL8, 0, mpicom, ier) + call mpi_bcast (alpha_van_nvp, 1, MPI_REAL8, 0, mpicom, ier) + call mpi_bcast (watsat_nvp, 1, MPI_REAL8, 0, mpicom, ier) + call mpi_bcast (watres_nvp, 1, MPI_REAL8, 0, mpicom, ier) + call mpi_bcast (thk_dry_nvp, 1, MPI_REAL8, 0, mpicom, ier) + call mpi_bcast (csol_nvp, 1, MPI_REAL8, 0, mpicom, ier) + call mpi_bcast (use_soil_moisture_streams, 1, MPI_LOGICAL, 0, mpicom, ier) call mpi_bcast (use_excess_ice, 1, MPI_LOGICAL, 0, mpicom,ier) @@ -1230,6 +1269,25 @@ subroutine control_print () end if write(iulog, *) ' use_luna = ', use_luna + ! [PORTED by Hui Tang: log nvp (moss/lichen) settings] + write(iulog, *) ' use_nvp = ', use_nvp + if (use_nvp) then + write(iulog, *) ' use_nvp_undersnow = ', use_nvp_undersnow + write(iulog, *) ' nvp_rad_model_ground = ', nvp_rad_model_ground + write(iulog, *) ' NVP physics parameters:' + write(iulog, *) ' nvp_frac_min = ', nvp_frac_min + write(iulog, *) ' rnvp_min = ', rnvp_min + write(iulog, *) ' rnvp_amp = ', rnvp_amp + write(iulog, *) ' rnvp_exp = ', rnvp_exp + write(iulog, *) ' ksat_nvp = ', ksat_nvp + write(iulog, *) ' n_van_nvp = ', n_van_nvp + write(iulog, *) ' alpha_van_nvp = ', alpha_van_nvp + write(iulog, *) ' watsat_nvp = ', watsat_nvp + write(iulog, *) ' watres_nvp = ', watres_nvp + write(iulog, *) ' thk_dry_nvp = ', thk_dry_nvp + write(iulog, *) ' csol_nvp = ', csol_nvp + end if + write(iulog, *) ' ED/FATES: ' write(iulog, *) ' use_fates = ', use_fates if (use_fates) then @@ -1264,6 +1322,8 @@ subroutine control_print () write(iulog, *) ' fates_seeddisp_cadence = ', fates_seeddisp_cadence write(iulog, *) ' fates_seeddisp_cadence: 0, 1, 2, 3 => off, daily, monthly, or yearly dispersal' write(iulog, *) ' fates_inventory_ctrl_filename = ', trim(fates_inventory_ctrl_filename) + write(iulog, *) ' use_nvp= ', use_nvp + write(iulog, *) ' use_nvp_undersnow= ', use_nvp_undersnow write(iulog, *) ' use_fates_managed_fire= ', use_fates_managed_fire end if end subroutine control_print diff --git a/src/main/filterMod.F90 b/src/main/filterMod.F90 index 6540021923..c4e506d790 100644 --- a/src/main/filterMod.F90 +++ b/src/main/filterMod.F90 @@ -112,6 +112,10 @@ module filterMod integer, pointer :: actfirep(:) ! soil patches with active fire filter (patches) integer :: num_actfirep ! number of patches in active fire filter + ! [PORTED by Hui Tang: NVP-active column filter] + integer, pointer :: nvpc(:) ! columns where NVP layer is active (nvp_layer_active=.true.) + integer :: num_nvpc ! number of NVP-active columns + end type clumpfilter public clumpfilter @@ -139,6 +143,7 @@ module filterMod public allocFilters ! allocate memory for filters public setFilters ! set filters public setExposedvegpFilter ! set the exposedvegp and noexposedvegp filters + public setNVPcFilter ! [PORTED by Hui Tang: set the nvpc NVP-active column filter] private allocFiltersOneGroup ! allocate memory for one group of filters private setFiltersOneGroup ! set one group of filters @@ -257,6 +262,10 @@ subroutine allocFiltersOneGroup(this_filter) this_filter(nc)%num_actfirep = 1 this_filter(nc)%num_actfirec = 1 + + ! [PORTED by Hui Tang: NVP column filter — starts empty, filled by setNVPcFilter] + allocate(this_filter(nc)%nvpc(bounds%endc-bounds%begc+1)) + this_filter(nc)%num_nvpc = 0 end do !$OMP END PARALLEL DO @@ -648,4 +657,52 @@ subroutine setExposedvegpFilter(bounds, frac_veg_nosno) end subroutine setExposedvegpFilter + !----------------------------------------------------------------------- + subroutine setNVPcFilter(bounds) + ! + ! !DESCRIPTION: + ! [PORTED by Hui Tang: build the NVP-active column filter] + ! + ! Populates filter%nvpc with columns where col%nvp_layer_active is .true. + ! The filter is a sub-set of nolakec. When use_nvp is .false. or no column + ! has NVP active, num_nvpc = 0 and no NVP-specific loops execute. + ! + ! Call from clm_driver after dynamics_driv (where UpdateNVPLayer runs). + ! + ! !USES: + use decompMod , only : bounds_level_clump + use clm_varctl, only : use_nvp + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: nc ! clump index + integer :: fc ! filter index into nolakec + integer :: c ! column index + integer :: f ! count for nvpc filter + + character(len=*), parameter :: subname = 'setNVPcFilter' + !----------------------------------------------------------------------- + + SHR_ASSERT_FL(bounds%level == bounds_level_clump, sourcefile, __LINE__) + + nc = bounds%clump_index + f = 0 + + if (use_nvp) then + do fc = 1, filter(nc)%num_nolakec + c = filter(nc)%nolakec(fc) + if (col%nvp_layer_active(c)) then + f = f + 1 + filter(nc)%nvpc(f) = c + end if + end do + end if + + filter(nc)%num_nvpc = f + + end subroutine setNVPcFilter + + end module filterMod diff --git a/src/utils/clmfates_interfaceMod.F90 b/src/utils/clmfates_interfaceMod.F90 index 19b247218e..0a6c97c995 100644 --- a/src/utils/clmfates_interfaceMod.F90 +++ b/src/utils/clmfates_interfaceMod.F90 @@ -81,6 +81,10 @@ module CLMFatesInterfaceMod use clm_varctl , only : fates_history_dimlevel use clm_varctl , only : nsrest, nsrBranch use clm_varctl , only : Allocate_Carbon_only + ! [PORTED by Hui Tang: nvp (moss/lichen) control switches] + use clm_varctl , only : use_nvp + use clm_varctl , only : use_nvp_undersnow + use clm_varctl , only : nvp_rad_model_ground use clm_varcon , only : tfrz use clm_varcon , only : spval use clm_varcon , only : denice @@ -131,6 +135,7 @@ module CLMFatesInterfaceMod ! Used FATES Modules use FatesInterfaceMod , only : fates_interface_type + use EDParamsMod , only : nvp_extinction_coeff ! [PORTED by Hui Tang: NVP Beer's law k from parameter file] use FatesInterfaceMod, only : FatesInterfaceInit use FatesInterfaceMod, only : SetFatesGlobalElements1 use FatesInterfaceMod, only : SetFatesGlobalElements2 @@ -249,6 +254,8 @@ module CLMFatesInterfaceMod procedure, public :: wrap_sunfrac procedure, public :: wrap_btran procedure, public :: wrap_photosynthesis + ! [PORTED by Hui Tang: separate NVP photosynthesis call for clm_driver] + procedure, public :: wrap_nvp_photosynthesis procedure, public :: wrap_accumulatefluxes procedure, public :: prep_canopyfluxes procedure, public :: wrap_canopy_radiation @@ -314,6 +321,10 @@ subroutine CLMFatesGlobals1(surf_numpft,surf_numcft,maxsoil_patches) integer :: pass_use_sp integer :: pass_masterproc integer :: pass_use_luh2 + ! [PORTED by Hui Tang: nvp (moss/lichen) control integer flags] + integer :: pass_nvp + integer :: pass_nvp_undersnow + integer :: pass_nvp_rad_model_ground logical :: verbose_output call t_startf('fates_globals1') @@ -366,7 +377,30 @@ subroutine CLMFatesGlobals1(surf_numpft,surf_numcft,maxsoil_patches) call set_fates_ctrlparms('parteh_mode',ival=fates_parteh_mode) - + + ! [PORTED by Hui Tang: pass nvp (moss/lichen) switches to FATES] + if (use_nvp) then + pass_nvp = 1 + else + pass_nvp = 0 + end if + call set_fates_ctrlparms('use_nvp', ival=pass_nvp) + + if (use_nvp_undersnow) then + pass_nvp_undersnow = 1 + else + pass_nvp_undersnow = 0 + end if + call set_fates_ctrlparms('use_nvp_undersnow', ival=pass_nvp_undersnow) + + ! [PORTED by Hui Tang: pass NVP radiation model choice to FATES] + if (nvp_rad_model_ground) then + pass_nvp_rad_model_ground = 1 + else + pass_nvp_rad_model_ground = 0 + end if + call set_fates_ctrlparms('nvp_rad_model_ground', ival=pass_nvp_rad_model_ground) + end if ! The following call reads in the parameter file @@ -1103,7 +1137,9 @@ subroutine dynamics_driv(this, nc, bounds_clump, & type(bounds_type),intent(in) :: bounds_clump type(atm2lnd_type) , intent(in) :: atm2lnd_inst type(soilstate_type) , intent(in) :: soilstate_inst - type(temperature_type) , intent(in) :: temperature_inst + ! [PORTED by Hui Tang: intent(inout) — passed down to wrap_update_hlmfates_dyn → UpdateNVPLayer, + ! which writes temperature_inst%t_soisno_col(c,0) on NVP layer activation/deactivation] + type(temperature_type) , intent(inout) :: temperature_inst type(active_layer_type) , intent(in) :: active_layer_inst integer , intent(in) :: nc type(waterstatebulk_type) , intent(inout) :: waterstatebulk_inst @@ -1252,7 +1288,7 @@ subroutine dynamics_driv(this, nc, bounds_clump, & this%fates(nc)%bc_in(s)%wind24_pa(ifp) = & atm2lnd_inst%wind24_patch(p) - + end do ! Here we use the same logic as the pft_areafrac initialization to get an array with values for each pft @@ -1364,7 +1400,9 @@ subroutine dynamics_driv(this, nc, bounds_clump, & waterdiagnosticbulk_inst, & canopystate_inst, & soilbiogeochem_carbonflux_inst, & - .false.) + .false., & + temperature_inst, & + waterstatebulk_inst) ! --------------------------------------------------------------------------------- ! Part IV: @@ -1535,7 +1573,8 @@ end subroutine UpdateCLitterFluxes subroutine wrap_update_hlmfates_dyn(this, nc, bounds_clump, & waterdiagnosticbulk_inst, canopystate_inst, & - soilbiogeochem_carbonflux_inst, is_initing_from_restart) + soilbiogeochem_carbonflux_inst, is_initing_from_restart, & + temperature_inst, waterstatebulk_inst) ! --------------------------------------------------------------------------------- ! This routine handles the updating of vegetation canopy diagnostics, (such as lai) @@ -1543,17 +1582,25 @@ subroutine wrap_update_hlmfates_dyn(this, nc, bounds_clump, & ! provides boundary conditions (such as vegetation fractional coverage) ! --------------------------------------------------------------------------------- + ! [PORTED by Hui Tang: moved from module level to break clmfatesinterfacemod compilation delay] + use NVPLayerDynamicsMod, only : UpdateNVPLayer + class(hlm_fates_interface_type), intent(inout) :: this type(bounds_type),intent(in) :: bounds_clump integer , intent(in) :: nc type(waterdiagnosticbulk_type) , intent(inout) :: waterdiagnosticbulk_inst type(canopystate_type) , intent(inout) :: canopystate_inst type(soilbiogeochem_carbonflux_type), intent(inout) :: soilbiogeochem_carbonflux_inst - + ! is this being called during a read from restart sequence (if so then use the restarted fates ! snow depth variable rather than the CLM variable). logical , intent(in) :: is_initing_from_restart + ! [PORTED by Hui Tang: optional args for NVP energy/mass conservation on activation/deactivation. + ! Pass during normal timestep calls; omit during restart/cold-start where thermo state is + ! initialised independently.] + type(temperature_type) , optional, intent(inout) :: temperature_inst + type(waterstatebulk_type), optional, intent(inout) :: waterstatebulk_inst integer :: npatch ! number of patches in each site integer :: ifp ! index FATES patch @@ -1749,7 +1796,46 @@ subroutine wrap_update_hlmfates_dyn(this, nc, bounds_clump, & z0m(p) = this%fates(nc)%bc_out(s)%z0m_pa(ifp) displa(p) = this%fates(nc)%bc_out(s)%displa_pa(ifp) dleaf_patch(p) = this%fates(nc)%bc_out(s)%dleaf_pa(ifp) - end do ! veg pach + end do ! veg patch + + write(iulog,'(a,2i6,3f10.5)') '[DBG NVP patch] c, npatch, wt_ed(bg), sum(wt_ed_veg), areacheck:', & + c, npatch, patch%wt_ed(col%patchi(c)), & + sum(patch%wt_ed(col%patchi(c)+1:col%patchi(c)+npatch)), areacheck + + ! [PORTED by Hui Tang: aggregate NVP patch geometry to column, then update layer state] + ! nvp_dz_pa(ifp) = mean NVP thickness where NVP is present within patch [m] + ! nvp_frac_pa(ifp) = fraction of patch covered by NVP [0-1] + ! Weight by canopy_fraction_pa (patch area fraction of column) to get column means. + if (use_nvp) then + col%dz_nvp(c) = 0._r8 + col%frac_nvp(c) = 0._r8 + do ifp = 1, npatch + ! [PORTED by Hui Tang: weight by both nvp_frac_pa (NVP coverage within patch) + ! and canopy_fraction_pa (patch area fraction of column) so col%dz_nvp is the + ! column-effective NVP depth (dz where present × frac), not the raw mean thickness] + col%dz_nvp(c) = col%dz_nvp(c) + & + this%fates(nc)%bc_out(s)%nvp_dz_pa(ifp) * & + this%fates(nc)%bc_out(s)%nvp_frac_pa(ifp) * & + this%fates(nc)%bc_out(s)%canopy_fraction_pa(ifp) + col%frac_nvp(c) = col%frac_nvp(c) + & + this%fates(nc)%bc_out(s)%nvp_frac_pa(ifp) !* & + !this%fates(nc)%bc_out(s)%canopy_fraction_pa(ifp) + print*, 'frac_nvp=', col%frac_nvp(c), & + this%fates(nc)%bc_out(s)%nvp_frac_pa(ifp), & + this%fates(nc)%bc_out(s)%canopy_fraction_pa(ifp),& + c,ifp + + end do + write(iulog,'(a,i6,3f10.5)') '[DBG NVP wtcol] c, frac_nvp, wt_ed(bg), sum(wt_ed_veg):', & + c, col%frac_nvp(c), patch%wt_ed(col%patchi(c)), & + sum(patch%wt_ed(col%patchi(c)+1:col%patchi(c)+npatch)) + ! [PORTED by Hui Tang: pass thermo instances only when present (normal timestep)] + if (present(temperature_inst) .and. present(waterstatebulk_inst)) then + call UpdateNVPLayer(c, temperature_inst, waterstatebulk_inst) + else + call UpdateNVPLayer(c) + end if + end if if(abs(areacheck - 1.0_r8).gt.1.e-9_r8)then write(iulog,*) 'area wrong in interface',areacheck - 1.0_r8 @@ -2307,7 +2393,8 @@ end subroutine init_coldstart ! ====================================================================================== - subroutine wrap_sunfrac(this,nc,atm2lnd_inst,canopystate_inst) + ! [PORTED by Hui Tang: add surfalb_inst to wrap_sunfrac for nvp radiation] + subroutine wrap_sunfrac(this,nc,atm2lnd_inst,canopystate_inst,surfalb_inst) ! --------------------------------------------------------------------------------- ! This interface function is a wrapper call on ED_SunShadeFracs. The only @@ -2326,6 +2413,9 @@ subroutine wrap_sunfrac(this,nc,atm2lnd_inst,canopystate_inst) ! Input/Output Arguments to CLM type(canopystate_type),intent(inout) :: canopystate_inst + ! [PORTED by Hui Tang: surface albedo for absorbed flux bc_in - needed by nvp radiation] + type(surfalb_type),intent(in) :: surfalb_inst + ! Local Variables integer :: p ! global index of the host patch integer :: g ! global index of the host gridcell @@ -2359,6 +2449,13 @@ subroutine wrap_sunfrac(this,nc,atm2lnd_inst,canopystate_inst) do ifp = 1, this%fates(nc)%sites(s)%youngest_patch%patchno this%fates(nc)%bc_in(s)%solad_parb(ifp,:) = forc_solad_g(g,:) this%fates(nc)%bc_in(s)%solai_parb(ifp,:) = forc_solai_g(g,:) + ! [PORTED by Hui Tang: pass VIS canopy transmittances for NVP photosynthesis PAR] + ! flx_absdv_col(c,0) holds ftdd(p,1) (?) and flx_absiv_col(c,0) holds ftii(p,1) (?), + ! stored in SurfaceRadiationMod at the previous timestep (one-timestep lag). + if (use_nvp) then + this%fates(nc)%bc_in(s)%flx_absdv(ifp) = surfalb_inst%flx_absdv_col(c,0) + this%fates(nc)%bc_in(s)%flx_absiv(ifp) = surfalb_inst%flx_absiv_col(c,0) + end if end do end do @@ -2737,6 +2834,118 @@ end subroutine wrap_photosynthesis ! ====================================================================================== + subroutine wrap_nvp_photosynthesis(this, nc, bounds, & + atm2lnd_inst, temperature_inst, waterdiagnosticbulk_inst, frictionvel_inst) + + ! [PORTED by Hui Tang: separate NVP (moss/lichen) photosynthesis call. + ! + ! NVP lacks stomata so its photosynthesis must NOT go through the CanopyFluxes + ! iterative solver (which is designed for stomata-bearing vegetation and maps outputs + ! to rssun/rssha). Instead this routine is called once from clm_driver after + ! CanopyFluxes has converged. + ! + ! Role: re-run FatesPlantRespPhotosynthDrive with the correct NVP surface temperature + ! (t_nvp_pa) and wetness (fwet_nvp_pa) so that FATES accumulates accurate NVP carbon + ! fluxes (GPP, maintenance respiration) in bc_out. No CLM-side output is mapped back + ! (NVP has no stomatal resistance to write to rssun/rssha). + ! + ! waterdiagnosticbulk_inst (needed for fwet_nvp_col) is NOT available inside + ! wrap_photosynthesis / CanopyFluxes, which is the compile-time reason for this split.] + + use decompMod , only : bounds_type + use FatesPlantRespPhotosynthMod , only : FatesPlantRespPhotosynthDrive + + ! !ARGUMENTS: + class(hlm_fates_interface_type), intent(inout) :: this + integer, intent(in) :: nc + type(bounds_type), intent(in) :: bounds + type(atm2lnd_type), intent(in) :: atm2lnd_inst + type(temperature_type), intent(in) :: temperature_inst + type(waterdiagnosticbulk_type), intent(in) :: waterdiagnosticbulk_inst + ! [PORTED by Hui Tang: frictionvel_inst supplies the bare-ground aerodynamic + ! resistance (ram1_patch) used as the NVP leaf boundary-layer resistance rb_pa.] + type(frictionvel_type), intent(in) :: frictionvel_inst + + integer :: s, c, p, ifp, g + real(r8) :: dtime + + call t_startf('fates_nvp_psn') + + associate( & + t_veg => temperature_inst%t_veg_patch , & + tgcm => temperature_inst%thm_patch , & + forc_pbot => atm2lnd_inst%forc_pbot_downscaled_col ) + + do s = 1, this%fates(nc)%nsites + + c = this%f2hmap(nc)%fcolumn(s) + + this%fates(nc)%bc_in(s)%forc_pbot = forc_pbot(c) + + do ifp = 1, this%fates(nc)%sites(s)%youngest_patch%patchno + p = ifp + col%patchi(c) + g = patch%gridcell(p) + + ! Re-enable processing for all patches (reset from 3 → 2) + this%fates(nc)%bc_in(s)%filter_photo_pa(ifp) = 2 + + ! Update t_veg / tgcm with post-convergence values from CanopyFluxes + this%fates(nc)%bc_in(s)%t_veg_pa(ifp) = t_veg(p) + this%fates(nc)%bc_in(s)%tgcm_pa(ifp) = tgcm(p) + + ! [PORTED by Hui Tang: NVP-specific inputs — column quantities broadcast to patch] + this%fates(nc)%bc_in(s)%t_nvp_pa(ifp) = temperature_inst%t_nvp_col(c) + this%fates(nc)%bc_in(s)%fwet_nvp_pa(ifp) = waterdiagnosticbulk_inst%fwet_nvp_col(c) + + ! [PORTED by Hui Tang: set atmospheric O2/CO2 partial pressures for NVP photosynthesis. + ! CanopyFluxes (and hence wrap_photosynthesis, which normally sets oair_pa/cair_pa + ! from forc_po2_grc/forc_pco2_grc) is never called for NVP columns, so these would + ! otherwise retain uninitialized/stale values and corrupt the Farquhar CO2/O2 terms + ! in FatesPlantRespPhotosynthDrive. Mirror the assignment in wrap_photosynthesis.] + this%fates(nc)%bc_in(s)%oair_pa(ifp) = atm2lnd_inst%forc_po2_grc(g) + this%fates(nc)%bc_in(s)%cair_pa(ifp) = atm2lnd_inst%forc_pco2_grc(g) + + ! [PORTED by Hui Tang: NVP leaf boundary-layer resistance. CanopyFluxes + ! (which normally sets rb_pa) is never called for NVP columns, so use the + ! bare-ground aerodynamic resistance ram1_patch from BareGroundFluxes. This + ! is consumed in LeafBiophysicsMod (gb = 1/rb_pa) for the NVP boundary-layer- + ! only CO2 diffusion; the moss water-film resistance is handled separately by + ! the fwet_nvp term, so ram (not ram+rnvp) is used here.] + this%fates(nc)%bc_in(s)%rb_pa(ifp) = frictionvel_inst%ram1_patch(p) + + ! [PORTED by Hui Tang: dayl_factor_pa — CanopyFluxesMod is never called for NVP + ! columns, so dayl_factor_pa is never set there; compute it here directly from + ! gridcell daylength following the same formula as CanopyFluxesMod line 840.] + this%fates(nc)%bc_in(s)%dayl_factor_pa(ifp) = & + min(1._r8, max(0.01_r8, (grc%dayl(g)**2) / (grc%max_dayl(g)**2))) + + end do + ! [DBG NVP sabg] column-level NVP inputs to photosynthesis + write(iulog,*) '[DBG NVP sabg] psn: c=', c, & + ' t_nvp_col=', temperature_inst%t_nvp_col(c), & + ' fwet_nvp_col=', waterdiagnosticbulk_inst%fwet_nvp_col(c) + end do + + dtime = get_step_size_real() + + ! Re-run FATES photosynthesis: this overwrites bc_out carbon fluxes with + ! values computed using correct post-convergence NVP temperature/wetness. + ! rssun/rssha are NOT mapped back — NVP has no stomata. + call FatesPlantRespPhotosynthDrive( & + this%fates(nc)%nsites, & + this%fates(nc)%sites, & + this%fates(nc)%bc_in, & + this%fates(nc)%bc_out, & + dtime) + + end associate + + call t_stopf('fates_nvp_psn') + + end subroutine wrap_nvp_photosynthesis + + ! ====================================================================================== + subroutine wrap_accumulatefluxes(this, nc, fn, filterp) ! !ARGUMENTS: @@ -2851,6 +3060,11 @@ subroutine wrap_canopy_radiation(this, bounds_clump, nc, fcansno, surfalb_inst) ! locals integer :: s,c,p,ifp,g + ! [PORTED by Hui Tang: NVP absorptance patch→col aggregation] + integer :: ib ! band index + integer :: npatches_site ! patch count in site + real(r8) :: nvp_frac_sum ! [PORTED by Hui Tang: Σ nvp_frac_pa for coverage-weighted alb_nvp_gnd_col] + ! [PORTED by Hui Tang: NVP Beer's law k now read from fates_params_default.json via nvp_extinction_coeff] call t_startf('fates_wrapcanopyradiation') @@ -2921,8 +3135,68 @@ subroutine wrap_canopy_radiation(this, bounds_clump, nc, fcansno, surfalb_inst) ftdd(p,:) = this%fates(nc)%bc_out(s)%ftdd_parb(ifp,:) ftid(p,:) = this%fates(nc)%bc_out(s)%ftid_parb(ifp,:) ftii(p,:) = this%fates(nc)%bc_out(s)%ftii_parb(ifp,:) - + end do + + ! [PORTED by Hui Tang: transfer NVP Beer's law absorptance from bc_out to surfalb_inst] + ! fabd_nvp_col/fabi_nvp_col are col-level; average equally over all patches in the site. + ! These are used by SurfaceRadiationMod to compute sabg_lyr(p,0) for the NVP layer. + if (use_nvp) then + npatches_site = this%fates(nc)%sites(s)%youngest_patch%patchno + surfalb_inst%fabd_nvp_col(c,:) = 0._r8 + surfalb_inst%fabi_nvp_col(c,:) = 0._r8 + do ifp = 1, npatches_site + do ib = 1, numrad + surfalb_inst%fabd_nvp_col(c,ib) = surfalb_inst%fabd_nvp_col(c,ib) + & + this%fates(nc)%bc_out(s)%fabd_nvp_pa(ifp,ib) + surfalb_inst%fabi_nvp_col(c,ib) = surfalb_inst%fabi_nvp_col(c,ib) + & + this%fates(nc)%bc_out(s)%fabi_nvp_pa(ifp,ib) + end do + end do + if (npatches_site > 0) then + surfalb_inst%fabd_nvp_col(c,:) = & + surfalb_inst%fabd_nvp_col(c,:) / real(npatches_site, r8) + surfalb_inst%fabi_nvp_col(c,:) = & + surfalb_inst%fabi_nvp_col(c,:) / real(npatches_site, r8) + end if + ! [PORTED by Hui Tang: compute NVP optical properties for SNICAR layer-0 ] + ! nvp_tau_col = column-mean optical depth = k_nvp * lai_nvp_pa * nvp_frac_pa averaged over patches. + ! nvp_omega_*_col = NVP single-scatter albedo (rhol+taul); average over patches (intensive property). + ! Stored here for use by SurfaceAlbedoMod before SNICAR_RT calls (one-timestep lag, consistent). + surfalb_inst%nvp_tau_col(c) = 0._r8 + surfalb_inst%nvp_omega_vis_col(c) = 0._r8 + surfalb_inst%nvp_omega_nir_col(c) = 0._r8 + if (npatches_site > 0) then + do ifp = 1, npatches_site + surfalb_inst%nvp_tau_col(c) = surfalb_inst%nvp_tau_col(c) + & + nvp_extinction_coeff * this%fates(nc)%bc_out(s)%lai_nvp_pa(ifp) * & + this%fates(nc)%bc_out(s)%nvp_frac_pa(ifp) + surfalb_inst%nvp_omega_vis_col(c) = surfalb_inst%nvp_omega_vis_col(c) + & + this%fates(nc)%bc_out(s)%nvp_omega_pa(ifp, ivis) + surfalb_inst%nvp_omega_nir_col(c) = surfalb_inst%nvp_omega_nir_col(c) + & + this%fates(nc)%bc_out(s)%nvp_omega_pa(ifp, inir) + end do + surfalb_inst%nvp_tau_col(c) = surfalb_inst%nvp_tau_col(c) / real(npatches_site, r8) + surfalb_inst%nvp_omega_vis_col(c) = surfalb_inst%nvp_omega_vis_col(c) / real(npatches_site, r8) + surfalb_inst%nvp_omega_nir_col(c) = surfalb_inst%nvp_omega_nir_col(c) / real(npatches_site, r8) + end if + ! [PORTED by Hui Tang (2026-06-13): NVP moss ground reflectance, COVERAGE-weighted mean over + ! patches. alb_nvp_gnd is an INTENSIVE reflectance (the value where moss exists), so it must + ! NOT be diluted by bare patches (which have alb_nvp_gnd_pa=0, nvp_frac_pa=0); the coverage is + ! supplied separately by nvp_frac_eff in the SurfaceAlbedoMod blend. =0 when no moss present.] + surfalb_inst%alb_nvp_gnd_col(c) = 0._r8 + nvp_frac_sum = 0._r8 + do ifp = 1, npatches_site + surfalb_inst%alb_nvp_gnd_col(c) = surfalb_inst%alb_nvp_gnd_col(c) + & + this%fates(nc)%bc_out(s)%alb_nvp_gnd_pa(ifp) * & + this%fates(nc)%bc_out(s)%nvp_frac_pa(ifp) + nvp_frac_sum = nvp_frac_sum + this%fates(nc)%bc_out(s)%nvp_frac_pa(ifp) + end do + if (nvp_frac_sum > 1.e-5_r8) then + surfalb_inst%alb_nvp_gnd_col(c) = surfalb_inst%alb_nvp_gnd_col(c) / nvp_frac_sum + end if + end if + end do end associate @@ -4006,7 +4280,6 @@ subroutine GetLandusePFTData(bounds, landuse_pft_file, landuse_pft_map, landuse_ end subroutine GetLandusePFTData - !----------------------------------------------------------------------- end module CLMFatesInterfaceMod