Skip to content

Commit

Permalink
initial implementation sfc_data
Browse files Browse the repository at this point in the history
  • Loading branch information
@uturuncoglu
uturuncoglu committed Jan 25, 2024
1 parent 0cdfc9d commit 028cc60
Show file tree
Hide file tree
Showing 2 changed files with 284 additions and 0 deletions.
252 changes: 252 additions & 0 deletions physics/sfc_data.F
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,252 @@
!>\file sfc_data.F
!! This file contains an data surface scheme.

!> This module contains the CCPP-compliant CDEPS data scheme
!! scheme when the model is using data provided by CDEPS.
module sfc_data
implicit none
private
public :: sfc_data_run

contains


!>\defgroup gfs_ocean_main GFS Simple Ocean Module
!! This subroutine calculates thermodynamical properties over
!! open water.
!>@{
!! \section arg_table_sfc_ocean_run Argument Table
!! \htmlinclude sfc_ocean_run.html
!!
!!>\section gen_sfc_ocean GFS Simple Ocean scheme General Algorithm
subroutine sfc_data_run &
!...................................
! --- inputs:
& ( im, use_inline, hvap, cp, rd, eps, epsm1, rvrdm1, ps, u1, v1, t1, q1, &
& tskin, cm, ch, lseaspray, fm, fm10, &
& prsl1, prslki, wet, use_lake_model, wind, &, ! --- inputs
& flag_iter, use_med_flux, dqsfc_med, dtsfc_med, &
& qsurf, cmm, chh, gflux, evap, hflx, ep, & ! --- outputs
& errmsg, errflg &
& )

! ===================================================================== !
! description: !
! !
! usage: !
! !
! call sfc_ocean !
! inputs: !
! ( im, ps, u1, v1, t1, q1, tskin, cm, ch, lseaspray, fm, fm10, !
! prsl1, prslki, wet, use_lake_model, wind, flag_iter, !
! use_med_flux, !
! outputs: !
! qsurf, cmm, chh, gflux, evap, hflx, ep ) !
! !
! !
! subprograms/functions called: fpvs !
! !
! !
! program history log: !
! 2005 -- created from the original progtm to account for !
! ocean only !
! oct 2006 -- h. wei added cmm and chh to the output !
! apr 2009 -- y.-t. hou modified to match the modified gbphys.f !
! reformatted the code and added program documentation !
! sep 2009 -- s. moorthi removed rcl and made pa as pressure unit !
! and furthur reformatted the code !
! dec 2021 -- u. turuncoglu added support for receiving fluxes !
! from mediator !
! !
! !
! ==================== defination of variables ==================== !
! !
! inputs: size !
! im - integer, horizontal dimension 1 !
! ps - real, surface pressure im !
! u1, v1 - real, u/v component of surface layer wind (m/s) im !
! t1 - real, surface layer mean temperature ( k ) im !
! q1 - real, surface layer mean specific humidity im !
! tskin - real, ground surface skin temperature ( k ) im !
! cm - real, surface exchange coeff for momentum (m/s) im !
! ch - real, surface exchange coeff heat & moisture(m/s) im !
! lseaspray- logical, .t. for parameterization for sea spray 1 !
! fm - real, a stability profile function for momentum im !
! fm10 - real, a stability profile function for momentum im !
! at 10m !
! prsl1 - real, surface layer mean pressure im !
! prslki - real, im !
! wet - logical, =T if any ocean/lak, =F otherwise im !
! wind - real, wind speed (m/s) im !
! flag_iter- logical, im !
! use_med_flux - logical, =T to use fluxes coming from med 1 !
! dqsfc_med- real, latent heat flux im !
! dtsfc_med- real, sensible heat flux im !
! !
! outputs: !
! qsurf - real, specific humidity at sfc im !
! cmm - real, im !
! chh - real, im !
! gflux - real, ground heat flux (zero for ocean) im !
! evap - real, evaporation from latent heat flux im !
! hflx - real, sensible heat flux im !
! ep - real, potential evaporation im !
! !
! ===================================================================== !
!
use machine , only : kind_phys
use funcphys, only : fpvs
!
implicit none

! --- constant parameters:
real (kind=kind_phys), parameter :: one = 1.0_kind_phys, &
& zero = 0.0_kind_phys, qmin = 1.0e-8_kind_phys
! --- inputs:
integer, intent(in) :: im
real (kind=kind_phys), intent(in) :: hvap, cp, rd, &
& eps, epsm1, rvrdm1

real (kind=kind_phys), dimension(:), intent(in) :: ps, u1, v1, &
& t1, q1, tskin, cm, ch, fm, fm10, prsl1, prslki, wind

! For sea spray effect
logical, intent(in) :: lseaspray
!
logical, dimension(:), intent(in) :: flag_iter, wet
integer, dimension(:), intent(in) :: use_lake_model
!
logical, intent(in) :: use_med_flux

! To receive fluxes from mediator
real (kind=kind_phys), dimension(:), intent(in) :: &
& dqsfc_med, dtsfc_med

! --- outputs:
real (kind=kind_phys), dimension(:), intent(inout) :: qsurf, &
& cmm, chh, gflux, evap, hflx, ep

character(len=*), intent(out) :: errmsg
integer, intent(out) :: errflg

! --- locals:

real (kind=kind_phys) :: qss, rch, tem,
& elocp, cpinv, hvapi
real (kind=kind_phys), dimension(im) :: rho, q0

integer :: i

logical :: flag(im)
!
! parameters for sea spray effect
!
real (kind=kind_phys) :: f10m, u10m, v10m, ws10, ru10, qss1,
& bb1, hflxs, evaps, ptem
!
! real (kind=kind_phys), parameter :: alps=0.5, bets=0.5, gams=0.1,
! real (kind=kind_phys), parameter :: alps=0.5, bets=0.5, gams=0.0,
! real (kind=kind_phys), parameter :: alps=1.0, bets=1.0, gams=0.2,
real (kind=kind_phys), parameter :: alps=0.75,bets=0.75,gams=0.15,
& ws10cr=30., conlf=7.2e-9, consf=6.4e-8
!
!======================================================================================================
!===> ... begin here
!
! -- ... initialize CCPP error handling variables
errmsg = ''
errflg = 0

cpinv = one/cp
hvapi = one/hvap
elocp = hvap/cp
!
!> - Flag for open water
do i = 1, im
flag(i) = (wet(i) .and. flag_iter(i) .and. use_lake_model(i)/=1)
!> - Initialize variables. all units are supposedly m.k.s. unless specified
! ps is in pascals, wind is wind speed,
! rho is density, qss is sat. hum. at surface

if ( flag(i) ) then
if (use_med_flux) then
q0(i) = max( q1(i), qmin )
rho(i) = prsl1(i) / (rd*t1(i)*(one + rvrdm1*q0(i)))

tem = ch(i) * wind(i)
cmm(i) = cm(i) * wind(i)
chh(i) = rho(i) * tem

hflx(i) = dtsfc_med(i)
evap(i) = dqsfc_med(i)

qsurf(i) = q1(i) + dqsfc_med(i) / (hvap*chh(i))
gflux(i) = zero
else
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)

! --- ... rcp = rho cp ch v

rch = rho(i) * cp * ch(i) * wind(i)
tem = ch(i) * wind(i)
cmm(i) = cm(i) * wind(i)
chh(i) = rho(i) * tem

!> - Calcualte sensible and latent heat flux over open water

hflx(i) = rch * (tskin(i) - t1(i) * prslki(i))

evap(i) = elocp * rch * (qss - q0(i))

qsurf(i) = qss
gflux(i) = zero
endif
endif
enddo
!
!> - Include sea spray effects
!
do i=1,im
if(lseaspray .and. flag(i)) then
f10m = fm10(i) / fm(i)
u10m = f10m * u1(i)
v10m = f10m * v1(i)
ws10 = sqrt(u10m*u10m + v10m*v10m)
ws10 = max(ws10,1.)
ws10 = min(ws10,ws10cr)
tem = .015 * ws10 * ws10
ru10 = 1. - .087 * log(10./tem)
qss1 = fpvs(t1(i))
qss1 = eps * qss1 / (prsl1(i) + epsm1 * qss1)
tem = rd * cp * t1(i) * t1(i)
tem = 1. + eps * hvap * hvap * qss1 / tem
bb1 = 1. / tem
evaps = conlf * (ws10**5.4) * ru10 * bb1
evaps = evaps * rho(i) * hvap * (qss1 - q0(i))
evap(i) = evap(i) + alps * evaps
hflxs = consf * (ws10**3.4) * ru10
hflxs = hflxs * rho(i) * cp * (tskin(i) - t1(i))
ptem = alps - gams
hflx(i) = hflx(i) + bets * hflxs - ptem * evaps
endif
enddo
!
do i = 1, im
if ( flag(i) ) then
tem = 1.0 / rho(i)
hflx(i) = hflx(i) * tem * cpinv
evap(i) = evap(i) * tem * hvapi
ep(i) = evap(i)
endif
enddo
!
return
!...................................
end subroutine sfc_ocean_run
!-----------------------------------
!>@}
end module sfc_ocean
32 changes: 32 additions & 0 deletions physics/sfc_data.meta
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,32 @@
########################################################################
[ccpp-table-properties]
name = sfc_data
type = scheme
dependencies = machine.F

########################################################################
[ccpp-arg-table]
name = sfc_data_run
type = scheme
[im]
standard_name = horizontal_loop_extent
long_name = horizontal loop extent
units = count
dimensions = ()
type = integer
intent = in
[use_inline]
standard_name = do_cdeps_inline
long_name = flag for using data provided by CDEPS inline (default false)
units = flag
dimensions = ()
type = logical
intent = in
[tsfco_dat]
standard_name = sea_surface_temperature_from_data
long_name = sfc temperature
units = K
dimensions = (horizontal_loop_extent)
type = real
kind = kind_phys
intent = in

0 comments on commit 028cc60

Please sign in to comment.