Skip to content

Commit

Permalink
correction for flux calculation
Browse files Browse the repository at this point in the history
  • Loading branch information
@uturuncoglu
uturuncoglu committed Dec 27, 2024
1 parent 13f0f8d commit 05e017a
Show file tree
Hide file tree
Showing 2 changed files with 86 additions and 10 deletions.
44 changes: 36 additions & 8 deletions physics/SFC_Models/Land/sfc_land.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand All @@ -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(:)
Expand All @@ -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(:)
Expand All @@ -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
Expand All @@ -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))
Expand All @@ -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
Expand Down
52 changes: 50 additions & 2 deletions physics/SFC_Models/Land/sfc_land.meta
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand Down

0 comments on commit 05e017a

Please sign in to comment.