diff --git a/physics/sfc_data.F b/physics/sfc_data.F new file mode 100644 index 000000000..3afee6bbe --- /dev/null +++ b/physics/sfc_data.F @@ -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 diff --git a/physics/sfc_data.meta b/physics/sfc_data.meta new file mode 100644 index 000000000..ab8f65c42 --- /dev/null +++ b/physics/sfc_data.meta @@ -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