Skip to content

Commit

Permalink
add simple land flux calculation that is used in the initial time step
Browse files Browse the repository at this point in the history
  • Loading branch information
uturuncoglu committed Dec 19, 2024
1 parent da33dbd commit 2be4469
Show file tree
Hide file tree
Showing 2 changed files with 207 additions and 28 deletions.
113 changes: 86 additions & 27 deletions physics/SFC_Models/Land/sfc_land.F90
Original file line number Diff line number Diff line change
Expand Up @@ -10,6 +10,7 @@
module sfc_land

use machine, only : kind_phys
use funcphys, only : fpvs

contains

Expand All @@ -29,23 +30,40 @@ module sfc_land
!! \section detailed Detailed Algorithm
!! @{
subroutine sfc_land_run(im, flag_init, flag_restart, &
cpllnd, cpllnd2atm, flag_iter, dry, sncovr1_lnd, qsurf_lnd, &
cpllnd, cpllnd2atm, flag_iter, dry, &
t1, q1, prsl1, prslki, ps, tskin, wind, cm, ch, rd, eps, epsm1, &
rvrdm1, hvap, cp, 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, &
sncovr1, qsurf, evap, hflx, ep, t2mmp, q2mp, &
gflux, runoff, drain, cmm, chh, zvfun, &
errmsg, errflg)
errmsg, errflg, naux2d, aux2d)

implicit none

! Inputs
integer , intent(in) :: im
logical , intent(in) :: flag_init
logical , intent(in) :: flag_restart
logical , intent(in) :: cpllnd
logical , intent(in) :: cpllnd2atm
logical , intent(in) :: flag_iter(:)
logical , intent(in) :: dry(:)
integer , intent(in) :: im
logical , intent(in) :: flag_init
logical , intent(in) :: flag_restart
logical , intent(in) :: cpllnd
logical , intent(in) :: cpllnd2atm
logical , intent(in) :: flag_iter(:)
logical , intent(in) :: dry(:)
real(kind=kind_phys), intent(in) :: t1(:)
real(kind=kind_phys), intent(in) :: q1(:)
real(kind=kind_phys), intent(in) :: prsl1(:)
real(kind=kind_phys), intent(in) :: prslki(:)
real(kind=kind_phys), intent(in) :: ps(:)
real(kind=kind_phys), intent(in) :: tskin(:)
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) :: 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), optional :: sncovr1_lnd(:)
real(kind=kind_phys), intent(in), optional :: qsurf_lnd(:)
real(kind=kind_phys), intent(in), optional :: evap_lnd(:)
Expand Down Expand Up @@ -77,35 +95,76 @@ subroutine sfc_land_run(im, flag_init, flag_restart, &
character(len=*) , intent(out) :: errmsg
integer , intent(out) :: errflg

! Constant parameters
real(kind=kind_phys), parameter :: &
& one = 1.0_kind_phys, &
& zero = 0.0_kind_phys, &
& qmin = 1.0e-8_kind_phys

! Locals
integer :: i
real(kind=kind_phys) :: qss, rch, tem, cpinv, hvapi, elocp
real(kind=kind_phys), dimension(im) :: rho, q0

! Initialize CCPP error handling variables
errmsg = ''
errflg = 0

cpinv = one/cp
hvapi = one/hvap
elocp = hvap/cp

! Check coupling from component land to atmosphere
if (.not. cpllnd2atm) return

! Check if it is cold or warm run
if (flag_init .and. .not.flag_restart) return

! Fill variables
do i = 1, im
sncovr1(i) = sncovr1_lnd(i)
qsurf(i) = qsurf_lnd(i)
hflx(i) = hflx_lnd(i)
evap(i) = evap_lnd(i)
ep(i) = ep_lnd(i)
t2mmp(i) = t2mmp_lnd(i)
q2mp(i) = q2mp_lnd(i)
gflux(i) = gflux_lnd(i)
drain(i) = drain_lnd(i)
runoff(i) = runoff_lnd(i)
cmm(i) = cmm_lnd(i)
chh(i) = chh_lnd(i)
zvfun(i) = zvfun_lnd(i)
enddo
if (flag_init .and. .not. flag_restart) then
! Calculate fluxes internally
do i = 1, im
if (dry(i)) then
q0(i) = max(q1(i), qmin)
rho(i) = prsl1(i)/(rd*t1(i)*(one+rvrdm1*q0(i)))
qss = fpvs(tskin(i))
qss = eps*qss/(ps(i)+epsm1*qss)
rch = rho(i)*cp*ch(i)*wind(i)
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))
ep(i) = evap(i)
evap(i) = evap(i)*(1.0/rho(i))*hvapi
t2mmp(i) = tskin(i)
q2mp(i) = qsurf(i)
gflux(i) = zero
drain(i) = zero
runoff(i) = zero
cmm(i) = cm(i)*wind(i)
chh(i) = rho(i)*tem
zvfun(i) = one
end if
enddo
else
! Use fluxes from land component model
do i = 1, im
if (dry(i)) then
sncovr1(i) = sncovr1_lnd(i)
qsurf(i) = qsurf_lnd(i)
hflx(i) = hflx_lnd(i)
evap(i) = evap_lnd(i)
ep(i) = ep_lnd(i)
t2mmp(i) = t2mmp_lnd(i)
q2mp(i) = q2mp_lnd(i)
gflux(i) = gflux_lnd(i)
drain(i) = drain_lnd(i)
runoff(i) = runoff_lnd(i)
cmm(i) = cmm_lnd(i)
chh(i) = chh_lnd(i)
zvfun(i) = zvfun_lnd(i)
end if
enddo
endif

end subroutine sfc_land_run

Expand Down
122 changes: 121 additions & 1 deletion physics/SFC_Models/Land/sfc_land.meta
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
[ccpp-table-properties]
name = sfc_land
type = scheme
dependencies = ../../hooks/machine.F
dependencies = ../../tools/funcphys.f90,../../hooks/machine.F

########################################################################
[ccpp-arg-table]
Expand Down Expand Up @@ -56,6 +56,126 @@
dimensions = (horizontal_loop_extent)
type = logical
intent = in
[t1]
standard_name = air_temperature_at_surface_adjacent_layer
long_name = surface layer mean temperature
units = K
dimensions = (horizontal_loop_extent)
type = real
kind = kind_phys
intent = in
[q1]
standard_name = specific_humidity_at_surface_adjacent_layer
long_name = surface layer mean specific humidity
units = kg kg-1
dimensions = (horizontal_loop_extent)
type = real
kind = kind_phys
intent = in
[ps]
standard_name = surface_air_pressure
long_name = surface pressure
units = Pa
dimensions = (horizontal_loop_extent)
type = real
kind = kind_phys
intent = in
[prsl1]
standard_name = air_pressure_at_surface_adjacent_layer
long_name = surface layer mean pressure
units = Pa
dimensions = (horizontal_loop_extent)
type = real
kind = kind_phys
intent = in
[prslki]
standard_name = ratio_of_exner_function_between_midlayer_and_interface_at_lowest_model_layer
long_name = Exner function ratio bt midlayer and interface at 1st layer
units = ratio
dimensions = (horizontal_loop_extent)
type = real
kind = kind_phys
intent = in
[tskin]
standard_name = surface_skin_temperature_over_land
long_name = surface skin temperature over land
units = K
dimensions = (horizontal_loop_extent)
type = real
kind = kind_phys
intent = in
[wind]
standard_name = wind_speed_at_lowest_model_layer
long_name = wind speed at lowest model level
units = m s-1
dimensions = (horizontal_loop_extent)
type = real
kind = kind_phys
intent = in
[cm]
standard_name = surface_drag_coefficient_for_momentum_in_air_over_land
long_name = surface exchange coeff for momentum over land
units = none
dimensions = (horizontal_loop_extent)
type = real
kind = kind_phys
intent = in
[ch]
standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_land
long_name = surface exchange coeff heat & moisture over land
units = none
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
units = none
dimensions = ()
type = real
kind = kind_phys
intent = in
[epsm1]
standard_name = ratio_of_dry_air_to_water_vapor_gas_constants_minus_one
long_name = (rd/rv) - 1
units = none
dimensions = ()
type = real
kind = kind_phys
intent = in
[rvrdm1]
standard_name = ratio_of_vapor_to_dry_air_gas_constants_minus_one
long_name = (rv/rd) - 1 (rv = ideal gas constant for water vapor)
units = none
dimensions = ()
type = real
kind = kind_phys
intent = in
[rd]
standard_name = gas_constant_of_dry_air
long_name = ideal gas constant for dry air
units = J kg-1 K-1
dimensions = ()
type = real
kind = kind_phys
intent = in
[hvap]
standard_name = latent_heat_of_vaporization_of_water_at_0C
long_name = latent heat of evaporation/sublimation
units = J kg-1
dimensions = ()
type = real
kind = kind_phys
intent = in
[cp]
standard_name = specific_heat_of_dry_air_at_constant_pressure
long_name = specific heat of dry air at constant pressure
units = J kg-1 K-1
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

0 comments on commit 2be4469

Please sign in to comment.