diff --git a/physics/SFC_Models/Land/sfc_land.F90 b/physics/SFC_Models/Land/sfc_land.F90 index 51a63cdae..1661c5c40 100644 --- a/physics/SFC_Models/Land/sfc_land.F90 +++ b/physics/SFC_Models/Land/sfc_land.F90 @@ -31,10 +31,12 @@ module sfc_land !! @{ subroutine sfc_land_run(im, flag_init, flag_restart, & cpllnd, cpllnd2atm, flag_iter, dry, & - t1, q1, prsl1, prslki, ps, tskin, wind, cm, ch, rd, eps, epsm1, & - rvrdm1, hvap, cp, sncovr1_lnd, qsurf_lnd, & + t1, q1, prsl1, prslki, ps, tskin, wind, cm, ch, & + dlwflx, dswsfc, sfalb, sfcemis, & + rd, eps, epsm1, rvrdm1, hvap, cp, con_sbc, & + sncovr1_lnd, qsurf_lnd, & evap_lnd, hflx_lnd, ep_lnd, t2mmp_lnd, q2mp_lnd, gflux_lnd, & - runoff_lnd, drain_lnd, cmm_lnd, chh_lnd, zvfun_lnd, & + runoff_lnd, drain_lnd, cmm_lnd, chh_lnd, zvfun_lnd, slc, & sncovr1, qsurf, evap, hflx, ep, t2mmp, q2mp, & gflux, runoff, drain, cmm, chh, zvfun, & errmsg, errflg) @@ -58,12 +60,17 @@ subroutine sfc_land_run(im, flag_init, flag_restart, & real(kind=kind_phys), intent(in) :: wind(:) real(kind=kind_phys), intent(in) :: cm(:) real(kind=kind_phys), intent(in) :: ch(:) + real(kind=kind_phys), intent(in) :: dlwflx(:) + real(kind=kind_phys), intent(in) :: dswsfc(:) + real(kind=kind_phys), intent(in) :: sfalb(:) + real(kind=kind_phys), intent(in) :: sfcemis(:) real(kind=kind_phys), intent(in) :: rd real(kind=kind_phys), intent(in) :: eps real(kind=kind_phys), intent(in) :: epsm1 real(kind=kind_phys), intent(in) :: rvrdm1 real(kind=kind_phys), intent(in) :: hvap real(kind=kind_phys), intent(in) :: cp + real(kind=kind_phys), intent(in) :: con_sbc real(kind=kind_phys), intent(in), optional :: sncovr1_lnd(:) real(kind=kind_phys), intent(in), optional :: qsurf_lnd(:) real(kind=kind_phys), intent(in), optional :: evap_lnd(:) @@ -77,6 +84,7 @@ subroutine sfc_land_run(im, flag_init, flag_restart, & real(kind=kind_phys), intent(in), optional :: cmm_lnd(:) real(kind=kind_phys), intent(in), optional :: chh_lnd(:) real(kind=kind_phys), intent(in), optional :: zvfun_lnd(:) + real(kind=kind_phys), intent(in), optional :: slc(:,:) ! Inputs/Outputs real(kind=kind_phys), intent(inout) :: sncovr1(:) real(kind=kind_phys), intent(inout) :: qsurf(:) @@ -99,11 +107,14 @@ subroutine sfc_land_run(im, flag_init, flag_restart, & real(kind=kind_phys), parameter :: & & one = 1.0_kind_phys, & & zero = 0.0_kind_phys, & - & qmin = 1.0e-8_kind_phys + & qmin = 1.0e-8_kind_phys, & + & slc_min = 0.05_kind_phys, & ! estimate dry limit for soil moisture + & slc_max = 0.50_kind_phys ! estimate saturated limit for soil moisture ! Locals integer :: i real(kind=kind_phys) :: qss, rch, tem, cpinv, hvapi, elocp + real(kind=kind_phys) :: available_energy, soil_stress_factor real(kind=kind_phys), dimension(im) :: rho, q0 ! Initialize CCPP error handling variables @@ -122,6 +133,11 @@ subroutine sfc_land_run(im, flag_init, flag_restart, & ! Calculate fluxes internally do i = 1, im if (dry(i)) then + soil_stress_factor = (slc(i,1)-slc_min)/(slc_max-slc_min) + soil_stress_factor = min(max(zero,soil_stress_factor),one) + available_energy = dswsfc(i)*(one-sfalb(i))+dlwflx(i)*sfcemis(i) - & + sfcemis(i)*con_sbc*tskin(i)**4 + available_energy = min(max(-200.0,available_energy),1000.0) ! set some arbitrary limits q0(i) = max(q1(i), qmin) rho(i) = prsl1(i)/(rd*t1(i)*(one+rvrdm1*q0(i))) qss = fpvs(tskin(i)) @@ -130,11 +146,23 @@ subroutine sfc_land_run(im, flag_init, flag_restart, & tem = ch(i)*wind(i) sncovr1(i) = zero qsurf(i) = qss - hflx(i) = rch*(tskin(i)-t1(i)*prslki(i)) - hflx(i) = hflx(i)*(1.0/rho(i))*cpinv - evap(i) = elocp*rch*(qss-q0(i)) + hflx(i) = rch*(tskin(i)-t1(i)*prslki(i)) ! first guess hflx [W/m2] + evap(i) = elocp*rch*(qss-q0(i)) ! first guess evap [W/m2] + evap(i) = evap(i)*soil_stress_factor ! reduce evap for soil moisture stress + hflx(i) = min(max(-100.0,hflx(i)),500.0) ! set some arbitrary limits + evap(i) = min(max(-100.0,evap(i)),500.0) ! set some arbitrary limits + if(evap(i) + hflx(i) /= zero) then + hflx(i) = available_energy * hflx(i) / (abs(evap(i)) + abs(hflx(i))) + evap(i) = available_energy * evap(i) / (abs(evap(i)) + abs(hflx(i))) + else + hflx(i) = zero + evap(i) = zero + end if + hflx(i) = min(max(-100.0,hflx(i)),500.0) ! set some arbitrary limits + evap(i) = min(max(-100.0,evap(i)),500.0) ! set some arbitrary limits + hflx(i) = hflx(i)*(1.0/rho(i))*cpinv ! convert to expected units ep(i) = evap(i) - evap(i) = evap(i)*(1.0/rho(i))*hvapi + evap(i) = evap(i)*(1.0/rho(i))*hvapi ! convert to expected units t2mmp(i) = tskin(i) q2mp(i) = qsurf(i) gflux(i) = zero diff --git a/physics/SFC_Models/Land/sfc_land.meta b/physics/SFC_Models/Land/sfc_land.meta index b24a6f8af..b443c7efb 100644 --- a/physics/SFC_Models/Land/sfc_land.meta +++ b/physics/SFC_Models/Land/sfc_land.meta @@ -128,6 +128,38 @@ type = real kind = kind_phys intent = in +[dlwflx] + standard_name = surface_downwelling_longwave_flux_absorbed_by_ground_over_land + long_name = total sky surface downward longwave flux absorbed by the ground over land + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[dswsfc] + standard_name = surface_downwelling_shortwave_flux + long_name = total sky surface downward shortwave flux + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[sfalb] + standard_name = surface_albedo_for_diffused_shortwave_on_radiation_timestep + long_name = mean surface diffused shortwave albedo + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[sfcemis] + standard_name = surface_longwave_emissivity_over_land + long_name = surface lw emissivity in fraction over land + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in [eps] standard_name = ratio_of_dry_air_to_water_vapor_gas_constants long_name = rd/rv @@ -176,6 +208,14 @@ type = real kind = kind_phys intent = in +[con_sbc] + standard_name = stefan_boltzmann_constant + long_name = Stefan-Boltzmann constant + units = W m-2 K-4 + dimensions = () + type = real + kind = kind_phys + intent = in [sncovr1_lnd] standard_name = surface_snow_area_fraction_over_land_from_land long_name = surface snow area fraction over land for coupling @@ -228,7 +268,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = in + intent = in optional = True [q2mp_lnd] standard_name = specific_humidity_at_2m_over_land_from_land @@ -273,7 +313,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = in optional = True [chh_lnd] standard_name = surface_drag_mass_flux_for_heat_and_moisture_in_air_over_land_from_land @@ -293,6 +333,14 @@ kind = kind_phys intent = in optional = True +[slc] + standard_name = volume_fraction_of_unfrozen_water_in_soil + long_name = volume fraction of unfrozen soil moisture + units = frac + dimensions = (horizontal_loop_extent,vertical_dimension_of_soil) + type = real + kind = kind_phys + intent = in [sncovr1] standard_name = surface_snow_area_fraction_over_land long_name = surface snow area fraction