Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Skip using fluxes provided by land component for first time step #234

Open
wants to merge 11 commits into
base: ufs/dev
Choose a base branch
from
142 changes: 117 additions & 25 deletions physics/SFC_Models/Land/sfc_land.F90
Original file line number Diff line number Diff line change
@@ -10,6 +10,7 @@
module sfc_land

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

contains

@@ -28,22 +29,48 @@ module sfc_land
!! \section general General Algorithm
!! \section detailed Detailed Algorithm
!! @{
subroutine sfc_land_run(im, cpllnd, cpllnd2atm, flag_iter, dry, &
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, &
subroutine sfc_land_run(im, flag_init, flag_restart, &
cpllnd, cpllnd2atm, flag_iter, dry, &
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, slc, &
sncovr1, qsurf, evap, hflx, ep, t2mmp, q2mp, &
gflux, runoff, drain, cmm, chh, zvfun, &
errmsg, errflg)

implicit none

! Inputs
integer , intent(in) :: im
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) :: 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(:)
@@ -57,6 +84,7 @@ subroutine sfc_land_run(im, cpllnd, cpllnd2atm, flag_iter, dry, &
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(:)
@@ -75,32 +103,96 @@ subroutine sfc_land_run(im, cpllnd, cpllnd2atm, flag_iter, dry, &
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, &
& 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
errmsg = ''
errflg = 0

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

! Check coupling from component land to atmosphere
if (.not. cpllnd2atm) 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
! Check if it is cold or warm run
if (flag_init .and. .not. flag_restart) then
uturuncoglu marked this conversation as resolved.
Show resolved Hide resolved
! 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))
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)) ! 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 ! convert to expected units
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

Loading