diff --git a/physics/PBL/SATMEDMF/satmedmfvdifq.F b/physics/PBL/SATMEDMF/satmedmfvdifq.F index 7b54b6d12..40527ce35 100644 --- a/physics/PBL/SATMEDMF/satmedmfvdifq.F +++ b/physics/PBL/SATMEDMF/satmedmfvdifq.F @@ -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, & @@ -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(:), & @@ -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(:), & @@ -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 @@ -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 diff --git a/physics/PBL/SATMEDMF/satmedmfvdifq.meta b/physics/PBL/SATMEDMF/satmedmfvdifq.meta index ff718f138..e203187aa 100644 --- a/physics/PBL/SATMEDMF/satmedmfvdifq.meta +++ b/physics/PBL/SATMEDMF/satmedmfvdifq.meta @@ -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 diff --git a/physics/SFC_Layer/UFS/sfc_diag.f b/physics/SFC_Layer/UFS/sfc_diag.f index 768814e8c..b0432df6f 100644 --- a/physics/SFC_Layer/UFS/sfc_diag.f +++ b/physics/SFC_Layer/UFS/sfc_diag.f @@ -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, & @@ -31,6 +32,7 @@ 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 @@ -38,6 +40,7 @@ subroutine sfc_diag_run (im,xlat_d,xlon_d, & 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) :: & @@ -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 diff --git a/physics/SFC_Layer/UFS/sfc_diag.meta b/physics/SFC_Layer/UFS/sfc_diag.meta index f4f83ab04..4fdf37916 100644 --- a/physics/SFC_Layer/UFS/sfc_diag.meta +++ b/physics/SFC_Layer/UFS/sfc_diag.meta @@ -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 diff --git a/physics/SFC_Layer/UFS/sfc_diff.f b/physics/SFC_Layer/UFS/sfc_diff.f index 5dd6525f9..e5cb4292e 100644 --- a/physics/SFC_Layer/UFS/sfc_diff.f +++ b/physics/SFC_Layer/UFS/sfc_diff.f @@ -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) @@ -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 @@ -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, & @@ -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 @@ -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) @@ -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), diff --git a/physics/SFC_Layer/UFS/sfc_diff.meta b/physics/SFC_Layer/UFS/sfc_diff.meta index 8ca5b24e1..0964473cb 100644 --- a/physics/SFC_Layer/UFS/sfc_diff.meta +++ b/physics/SFC_Layer/UFS/sfc_diff.meta @@ -218,6 +218,38 @@ 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 @@ -225,6 +257,13 @@ 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 diff --git a/physics/SFC_Layer/UFS/sfc_nst.f90 b/physics/SFC_Layer/UFS/sfc_nst.f90 index 08b1b48e4..9c3804211 100644 --- a/physics/SFC_Layer/UFS/sfc_nst.f90 +++ b/physics/SFC_Layer/UFS/sfc_nst.f90 @@ -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, & @@ -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 ! @@ -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 @@ -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 @@ -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 diff --git a/physics/SFC_Layer/UFS/sfc_nst.meta b/physics/SFC_Layer/UFS/sfc_nst.meta index 131daaab0..80f468803 100644 --- a/physics/SFC_Layer/UFS/sfc_nst.meta +++ b/physics/SFC_Layer/UFS/sfc_nst.meta @@ -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 diff --git a/physics/SFC_Models/Ocean/UFS/sfc_ocean.F b/physics/SFC_Models/Ocean/UFS/sfc_ocean.F index 78d58d8f0..88d23a7aa 100644 --- a/physics/SFC_Models/Ocean/UFS/sfc_ocean.F +++ b/physics/SFC_Models/Ocean/UFS/sfc_ocean.F @@ -25,6 +25,7 @@ subroutine sfc_ocean_run & ! --- inputs: & ( im, hvap, cp, rd, eps, epsm1, rvrdm1, ps, u1, v1, t1, q1, & & tskin, cm, ch, lseaspray, fm, fm10, & + & usfco, vsfco, icplocn2atm, & & 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 @@ -39,6 +40,7 @@ subroutine sfc_ocean_run & ! call sfc_ocean ! ! inputs: ! ! ( im, ps, u1, v1, t1, q1, tskin, cm, ch, lseaspray, fm, fm10, ! +! usfco, vsfco, icplocn2atm, ! ! prsl1, prslki, wet, use_lake_model, wind, flag_iter, ! ! use_med_flux, ! ! outputs: ! @@ -66,6 +68,10 @@ subroutine sfc_ocean_run & ! im - integer, horizontal dimension 1 ! ! ps - real, surface pressure im ! ! u1, v1 - real, u/v component of surface layer wind (m/s) im ! +! usfco - real, u component of surface ocean current (m/s) im ! +! vsfco - real, v component of surface ocean current (m/s) im ! +! icplocn2atm - integer, =1 if usfco and vsfco are used in the 1 ! +! computation of air-sea fluxes ! ! t1 - real, surface layer mean temperature ( k ) im ! ! q1 - real, surface layer mean specific humidity im ! ! tskin - real, ground surface skin temperature ( k ) im ! @@ -109,13 +115,15 @@ subroutine sfc_ocean_run & & eps, epsm1, rvrdm1 real (kind=kind_phys), dimension(:), intent(in) :: ps, u1, v1, & - & t1, q1, tskin, cm, ch, fm, fm10, prsl1, prslki, wind + & t1, q1, tskin, cm, ch, fm, fm10, prsl1, prslki, wind, & + & usfco, vsfco ! For sea spray effect logical, intent(in) :: lseaspray ! logical, dimension(:), intent(in) :: flag_iter, wet integer, dimension(:), intent(in) :: use_lake_model + integer, intent(in) :: icplocn2atm ! logical, intent(in) :: use_med_flux @@ -135,6 +143,7 @@ subroutine sfc_ocean_run & real (kind=kind_phys) :: qss, rch, tem, & elocp, cpinv, hvapi real (kind=kind_phys), dimension(im) :: rho, q0 + real (kind=kind_phys), dimension(im) :: windrel integer :: i @@ -173,9 +182,15 @@ subroutine sfc_ocean_run & 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) + + if (icplocn2atm == 0) then + tem = ch(i) * wind(i) + cmm(i) = cm(i) * wind(i) + else if (icplocn2atm ==1) then + windrel(i)=sqrt( (u1(i)-usfco(i))**2+(v1(i)-vsfco(i))**2 ) + tem = ch(i) * windrel(i) + cmm(i) = cm(i) * windrel(i) + endif chh(i) = rho(i) * tem hflx(i) = dtsfc_med(i) @@ -192,9 +207,16 @@ subroutine sfc_ocean_run & ! --- ... rcp = rho cp ch v - rch = rho(i) * cp * ch(i) * wind(i) - tem = ch(i) * wind(i) - cmm(i) = cm(i) * wind(i) + if (icplocn2atm == 0) then + rch = rho(i) * cp * ch(i) * wind(i) + tem = ch(i) * wind(i) + cmm(i) = cm(i) * wind(i) + else if (icplocn2atm ==1) then + windrel(i)=sqrt( (u1(i)-usfco(i))**2+(v1(i)-vsfco(i))**2 ) + rch = rho(i) * cp * ch(i) * windrel(i) + tem = ch(i) * windrel(i) + cmm(i) = cm(i) * windrel(i) + endif chh(i) = rho(i) * tem !> - Calcualte sensible and latent heat flux over open water diff --git a/physics/SFC_Models/Ocean/UFS/sfc_ocean.meta b/physics/SFC_Models/Ocean/UFS/sfc_ocean.meta index 848c2e3ed..15d9fb5c4 100644 --- a/physics/SFC_Models/Ocean/UFS/sfc_ocean.meta +++ b/physics/SFC_Models/Ocean/UFS/sfc_ocean.meta @@ -86,6 +86,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