Skip to content

Commit

Permalink
Merge pull request #155 from binli2337/feature/hafsv2_baseline_with_ssc
Browse files Browse the repository at this point in the history 
Update to consider sea surface current in air-sea flux calculation
  • Loading branch information
@grantfirl
grantfirl authored Feb 1, 2024
2 parents d52832b + 1545c6b commit 51452b8
Show file tree
Hide file tree
Showing 10 changed files with 217 additions and 23 deletions.
17 changes: 13 additions & 4 deletions physics/PBL/SATMEDMF/satmedmfvdifq.F
View file
Original file line number Diff line number Diff line change
Expand Up @@ -75,8 +75,8 @@ end subroutine satmedmfvdifq_init
!! \section detail_satmedmfvidfq GFS satmedmfvdifq Detailed Algorithm
subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, &
& ntiw,ntke,grav,rd,cp,rv,hvap,hfus,fv,eps,epsm1, &
& dv,du,tdt,rtg,u1,v1,t1,q1,swh,hlw,xmu, &
& garea,zvfun,sigmaf, &
& dv,du,tdt,rtg,u1,v1,t1,q1,usfco,vsfco,icplocn2atm, &
& swh,hlw,xmu,garea,zvfun,sigmaf, &
& psk,rbsoil,zorl,u10m,v10m,fm,fh, &
& tsea,heat,evap,stress,spd1,kpbl, &
& prsi,del,prsl,prslk,phii,phil,delt, &
Expand Down Expand Up @@ -110,6 +110,7 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, &
& tdt(:,:), rtg(:,:,:)
real(kind=kind_phys), intent(in) :: &
& u1(:,:), v1(:,:), &
& usfco(:), vsfco(:), &
& t1(:,:), q1(:,:,:), &
& swh(:,:), hlw(:,:), &
& xmu(:), garea(:), &
Expand All @@ -126,6 +127,7 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, &
real(kind=kind_phys), intent(inout), dimension(:,:,:) :: dtend
integer, intent(in) :: dtidx(:,:), index_of_temperature, &
& index_of_x_wind, index_of_y_wind, index_of_process_pbl
integer, intent(in) :: icplocn2atm
real(kind=kind_phys), intent(out) :: &
& dusfc(:), dvsfc(:), &
& dtsfc(:), dqsfc(:), &
Expand All @@ -142,6 +144,7 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, &
!----------------------------------------------------------------------
!***
!*** local variables
real(kind=kind_phys) spd1_m
!***
integer i,is,k,n,ndt,km1,kmpbl,kmscu,ntrac1,idtend
integer kps,kbx,kmx
Expand Down Expand Up @@ -2376,8 +2379,14 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, &
enddo
enddo
do i = 1,im
dusfc(i) = -1.*rho_a(i)*stress(i)*u1(i,1)/spd1(i)
dvsfc(i) = -1.*rho_a(i)*stress(i)*v1(i,1)/spd1(i)
if(icplocn2atm == 0) then
dusfc(i) = -1.*rho_a(i)*stress(i)*u1(i,1)/spd1(i)
dvsfc(i) = -1.*rho_a(i)*stress(i)*v1(i,1)/spd1(i)
else if (icplocn2atm ==1) then
spd1_m=sqrt( (u1(i,1)-usfco(i))**2+(v1(i,1)-vsfco(i))**2 )
dusfc(i) = -1.*rho_a(i)*stress(i)*(u1(i,1)-usfco(i))/spd1_m
dvsfc(i) = -1.*rho_a(i)*stress(i)*(v1(i,1)-vsfco(i))/spd1_m
endif
enddo
!
if(ldiag3d .and. .not. gen_tend) then
Expand Down
23 changes: 23 additions & 0 deletions physics/PBL/SATMEDMF/satmedmfvdifq.meta
View file
Original file line number Diff line number Diff line change
Expand Up @@ -217,6 +217,29 @@
type = real
kind = kind_phys
intent = in
[usfco]
standard_name = x_ocean_current
long_name = zonal current at ocean surface
units = m s-1
dimensions = (horizontal_loop_extent)
type = real
kind = kind_phys
intent = in
[vsfco]
standard_name = y_ocean_current
long_name = meridional current at ocean surface
units = m s-1
dimensions = (horizontal_loop_extent)
type = real
kind = kind_phys
intent = in
[icplocn2atm]
standard_name = control_for_air_sea_flux_computation_over_water
long_name = air-sea flux option
units = 1
dimensions = ()
type = integer
intent = in
[t1]
standard_name = air_temperature
long_name = layer mean air temperature
Expand Down
12 changes: 10 additions & 2 deletions physics/SFC_Layer/UFS/sfc_diag.f
View file
Original file line number Diff line number Diff line change
Expand Up @@ -17,6 +17,7 @@ subroutine sfc_diag_run (im,xlat_d,xlon_d, &
& lsm,lsm_ruc,grav,cp,eps,epsm1,con_rocp, &
& con_karman, &
& shflx,cdq,wind, &
& usfco,vsfco,icplocn2atm, &
& zf,ps,u1,v1,t1,q1,prslki,evap,fm,fh,fm10,fh2, &
& ust,tskin,qsurf,thsfc_loc,diag_flux,diag_log, &
& use_lake_model,iopt_lake,iopt_lake_clm, &
Expand All @@ -31,13 +32,15 @@ subroutine sfc_diag_run (im,xlat_d,xlon_d, &
!
integer, intent(in) :: im, lsm, lsm_ruc, iopt_lake, iopt_lake_clm
logical, intent(in) :: use_lake2m
integer, intent(in) :: icplocn2atm
logical, intent(in) :: thsfc_loc ! Flag for reference pot. temp.
logical, intent(in) :: diag_flux ! Flag for flux method in 2-m diagnostics
logical, intent(in) :: diag_log ! Flag for 2-m log diagnostics under stable conditions
real(kind=kind_phys), intent(in) :: grav,cp,eps,epsm1,con_rocp
real(kind=kind_phys), intent(in) :: con_karman
real(kind=kind_phys), dimension(:), intent( in) :: &
& zf, ps, u1, v1, t1, q1, ust, tskin, &
& usfco, vsfco, &
& qsurf, prslki, evap, fm, fh, fm10, fh2, &
& shflx, cdq, wind, xlat_d, xlon_d
real(kind=kind_phys), dimension(:), intent(out) :: &
Expand Down Expand Up @@ -89,8 +92,13 @@ subroutine sfc_diag_run (im,xlat_d,xlon_d, &

do i = 1, im
f10m(i) = fm10(i) / fm(i)
u10m(i) = f10m(i) * u1(i)
v10m(i) = f10m(i) * v1(i)
if (icplocn2atm ==0) then
u10m(i) = f10m(i) * u1(i)
v10m(i) = f10m(i) * v1(i)
else if (icplocn2atm ==1) then
u10m(i) = usfco(i)+f10m(i) * (u1(i)-usfco(i))
v10m(i) = vsfco(i)+f10m(i) * (v1(i)-vsfco(i))
endif
have_2m = use_lake_model(i)>0 .and. use_lake2m .and. &
& iopt_lake==iopt_lake_clm
if(have_2m) then
Expand Down
23 changes: 23 additions & 0 deletions physics/SFC_Layer/UFS/sfc_diag.meta
View file
Original file line number Diff line number Diff line change
Expand Up @@ -124,6 +124,29 @@
type = real
kind = kind_phys
intent = in
[usfco]
standard_name = x_ocean_current
long_name = zonal current at ocean surface
units = m s-1
dimensions = (horizontal_loop_extent)
type = real
kind = kind_phys
intent = in
[vsfco]
standard_name = y_ocean_current
long_name = meridional current at ocean surface
units = m s-1
dimensions = (horizontal_loop_extent)
type = real
kind = kind_phys
intent = in
[icplocn2atm]
standard_name = control_for_air_sea_flux_computation_over_water
long_name = air-sea flux option
units = 1
dimensions = ()
type = integer
intent = in
[t1]
standard_name = air_temperature_at_surface_adjacent_layer
long_name = 1st model layer air temperature
Expand Down
19 changes: 15 additions & 4 deletions physics/SFC_Layer/UFS/sfc_diff.f
View file
Original file line number Diff line number Diff line change
Expand Up @@ -62,6 +62,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in)
& flag_iter,redrag, & !intent(in)
& flag_lakefreeze, & !intent(in)
& u10m,v10m,sfc_z0_type, & !hafs,z0 type !intent(in)
& u1,v1,usfco,vsfco,icplocn2atm, &
& wet,dry,icy, & !intent(in)
& thsfc_loc, & !intent(in)
& tskin_wat, tskin_lnd, tskin_ice, & !intent(in)
Expand All @@ -86,6 +87,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in)
integer, parameter :: kp = kind_phys
integer, intent(in) :: im, ivegsrc
integer, intent(in) :: sfc_z0_type ! option for calculating surface roughness length over ocean
integer, intent(in) :: icplocn2atm ! option for including ocean current in the computation of flux
integer, dimension(:), intent(in) :: vegtype
Expand All @@ -97,6 +99,8 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in)
logical, intent(in) :: thsfc_loc ! Flag for reference pressure in theta calculation
real(kind=kind_phys), dimension(:), intent(in) :: u10m,v10m
real(kind=kind_phys), dimension(:), intent(in) :: u1,v1
real(kind=kind_phys), dimension(:), intent(in) :: usfco,vsfco
real(kind=kind_phys), intent(in) :: rvrdm1, eps, epsm1, grav
real(kind=kind_phys), dimension(:), intent(in) :: &
& ps,t1,q1,z1,garea,prsl1,prslki,prsik1,prslk1, &
Expand Down Expand Up @@ -127,6 +131,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in)
! locals
!
integer i
real(kind=kind_phys) :: windrel
!
real(kind=kind_phys) :: rat, tv1, thv1, restar, wind10m,
& czilc, tem1, tem2, virtfac
Expand Down Expand Up @@ -350,9 +355,15 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in)
tvs = half * (tsurf_wat(i)+tskin_wat(i))/prsik1(i)
& * virtfac
endif
!
wind10m = sqrt(u10m(i)*u10m(i)+v10m(i)*v10m(i))
!
if (icplocn2atm == 0) then
wind10m=sqrt(u10m(i)*u10m(i)+v10m(i)*v10m(i))
windrel=wind(i)
else if (icplocn2atm ==1) then
wind10m=sqrt((u10m(i)-usfco(i))**2+(v10m(i)-vsfco(i))**2)
windrel=sqrt((u1(i)-usfco(i))**2+(v1(i)-vsfco(i))**2)
endif
if (sfc_z0_type == -1) then ! using wave model derived momentum roughness
tem1 = 0.11 * vis / ustar_wat(i)
z0 = tem1 + 0.01_kp * z0rl_wav(i)
Expand Down Expand Up @@ -397,7 +408,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in)
!
call stability
! --- inputs:
& (z1(i), zvfun(i), gdx, tv1, thv1, wind(i),
& (z1(i), zvfun(i), gdx, tv1, thv1, windrel,
& z0max, ztmax_wat(i), tvs, grav, thsfc_loc,
! --- outputs:
& rb_wat(i), fm_wat(i), fh_wat(i), fm10_wat(i), fh2_wat(i),
Expand Down
39 changes: 39 additions & 0 deletions physics/SFC_Layer/UFS/sfc_diff.meta
View file
Original file line number Diff line number Diff line change
Expand Up @@ -218,13 +218,52 @@
type = real
kind = kind_phys
intent = in
[u1]
standard_name = x_wind_at_surface_adjacent_layer
long_name = x component of surface layer wind
units = m s-1
dimensions = (horizontal_loop_extent)
type = real
kind = kind_phys
intent = in
[v1]
standard_name = y_wind_at_surface_adjacent_layer
long_name = y component of surface layer wind
units = m s-1
dimensions = (horizontal_loop_extent)
type = real
kind = kind_phys
intent = in
[usfco]
standard_name = x_ocean_current
long_name = zonal current at ocean surface
units = m s-1
dimensions = (horizontal_loop_extent)
type = real
kind = kind_phys
intent = in
[vsfco]
standard_name = y_ocean_current
long_name = meridional current at ocean surface
units = m s-1
dimensions = (horizontal_loop_extent)
type = real
kind = kind_phys
intent = in
[sfc_z0_type]
standard_name = flag_for_surface_roughness_option_over_water
long_name = surface roughness options over water
units = flag
dimensions = ()
type = integer
intent = in
[icplocn2atm]
standard_name = control_for_air_sea_flux_computation_over_water
long_name = air-sea flux option
units = 1
dimensions = ()
type = integer
intent = in
[wet]
standard_name = flag_nonzero_wet_surface_fraction
long_name = flag indicating presence of some ocean or lake surface area fraction
Expand Down
25 changes: 19 additions & 6 deletions physics/SFC_Layer/UFS/sfc_nst.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -26,8 +26,8 @@ module sfc_nst
!> \section NSST_general_algorithm GFS Near-Surface Sea Temperature Scheme General Algorithm
subroutine sfc_nst_run &
( im, hvap, cp, hfus, jcal, eps, epsm1, rvrdm1, rd, rhw0, & ! --- inputs:
pi, tgice, sbc, ps, u1, v1, t1, q1, tref, cm, ch, &
lseaspray, fm, fm10, &
pi, tgice, sbc, ps, u1, v1, usfco, vsfco, icplocn2atm, t1, &
q1, tref, cm, ch, lseaspray, fm, fm10, &
prsl1, prslki, prsik1, prslk1, wet, use_lake_model, xlon, &
sinlat, stress, &
sfcemis, dlwflx, sfcnsw, rain, timestep, kdt, solhr,xcosz, &
Expand Down Expand Up @@ -84,6 +84,9 @@ subroutine sfc_nst_run &
! im - integer, horiz dimension 1 !
! ps - real, surface pressure (pa) im !
! u1, v1 - real, u/v component of surface layer wind (m/s) im !
! usfco, vsfco - real, u/v component of surface current (m/s) im !
! icplocn2atm - integer, option to include ocean surface 1 !
! current in the computation of flux !
! t1 - real, surface layer mean temperature ( k ) im !
! q1 - real, surface layer mean specific humidity im !
! tref - real, reference/foundation temperature ( k ) im !
Expand Down Expand Up @@ -167,10 +170,12 @@ subroutine sfc_nst_run &

! --- inputs:
integer, intent(in) :: im, kdt, ipr, nstf_name1, nstf_name4, nstf_name5
integer, intent(in) :: icplocn2atm

real (kind=kind_phys), intent(in) :: hvap, cp, hfus, jcal, eps, &
epsm1, rvrdm1, rd, rhw0, sbc, pi, tgice
real (kind=kind_phys), dimension(:), intent(in) :: ps, u1, v1, &
t1, q1, tref, cm, ch, fm, fm10, &
usfco, vsfco, t1, q1, tref, cm, ch, fm, fm10, &
prsl1, prslki, prsik1, prslk1, xlon, xcosz, &
sinlat, stress, sfcemis, dlwflx, sfcnsw, rain, wind
real (kind=kind_phys), intent(in) :: timestep
Expand Down Expand Up @@ -235,6 +240,7 @@ subroutine sfc_nst_run &
! 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
real (kind=kind_phys) :: windrel
!
!======================================================================================================
! Initialize CCPP error handling variables
Expand Down Expand Up @@ -311,9 +317,16 @@ subroutine sfc_nst_run &

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

rch(i) = rho_a(i) * cp * ch(i) * wind(i)
cmm(i) = cm (i) * wind(i)
chh(i) = rho_a(i) * ch(i) * wind(i)
if (icplocn2atm ==0) then
rch(i) = rho_a(i) * cp * ch(i) * wind(i)
cmm(i) = cm (i) * wind(i)
chh(i) = rho_a(i) * ch(i) * wind(i)
else if (icplocn2atm ==1) then
windrel= sqrt( (u1(i)-usfco(i))**2 + (v1(i)-vsfco(i))**2 )
rch(i) = rho_a(i) * cp * ch(i) * windrel
cmm(i) = cm (i) * windrel
chh(i) = rho_a(i) * ch(i) * windrel
endif

!> - Calculate latent and sensible heat flux over open water with tskin.
! at previous time step
Expand Down
23 changes: 23 additions & 0 deletions physics/SFC_Layer/UFS/sfc_nst.meta
View file
Original file line number Diff line number Diff line change
Expand Up @@ -134,6 +134,29 @@
type = real
kind = kind_phys
intent = in
[usfco]
standard_name = x_ocean_current
long_name = zonal current at ocean surface
units = m s-1
dimensions = (horizontal_loop_extent)
type = real
kind = kind_phys
intent = in
[vsfco]
standard_name = y_ocean_current
long_name = meridional current at ocean surface
units = m s-1
dimensions = (horizontal_loop_extent)
type = real
kind = kind_phys
intent = in
[icplocn2atm]
standard_name = control_for_air_sea_flux_computation_over_water
long_name = air-sea flux option
units = 1
dimensions = ()
type = integer
intent = in
[t1]
standard_name = air_temperature_at_surface_adjacent_layer
long_name = surface layer mean temperature
Expand Down
Loading

0 comments on commit 51452b8

Please sign in to comment.