From 9dc3d4063619b999316e2e269a3eb37d3c169173 Mon Sep 17 00:00:00 2001 From: "Bin.Li" Date: Mon, 20 Nov 2023 15:57:15 +0000 Subject: [PATCH 01/21] Inlcude surface ocean currents for the calculation of the air-sea fluxes. --- physics/satmedmfvdifq.F | 9 ++++++--- physics/satmedmfvdifq.meta | 16 ++++++++++++++++ physics/sfc_diff.f | 10 ++++++++-- physics/sfc_diff.meta | 23 +++++++++++++++++++++++ physics/sfc_nst.f | 13 ++++++++----- physics/sfc_nst.meta | 16 ++++++++++++++++ physics/sfc_ocean.F | 21 +++++++++++++-------- physics/sfc_ocean.meta | 16 ++++++++++++++++ z | 16 ++++++++++++++++ 9 files changed, 122 insertions(+), 18 deletions(-) create mode 100644 z diff --git a/physics/satmedmfvdifq.F b/physics/satmedmfvdifq.F index 73fc4aff8..4ccf47060 100644 --- a/physics/satmedmfvdifq.F +++ b/physics/satmedmfvdifq.F @@ -75,7 +75,7 @@ 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, & + & dv,du,tdt,rtg,u1,v1,t1,q1,ssu,ssv,swh,hlw,xmu, & & garea,zvfun,sigmaf, & & psk,rbsoil,zorl,u10m,v10m,fm,fh, & & tsea,heat,evap,stress,spd1,kpbl, & @@ -110,6 +110,7 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & & tdt(:,:), rtg(:,:,:) real(kind=kind_phys), intent(in) :: & & u1(:,:), v1(:,:), & + & ssu(:), ssv(:), & & t1(:,:), q1(:,:,:), & & swh(:,:), hlw(:,:), & & xmu(:), garea(:), & @@ -2376,8 +2377,10 @@ 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) +! 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) + dusfc(i) = -1.*rho_a(i)*stress(i)*(u1(i,1)-ssu(i))/spd1(i) + dvsfc(i) = -1.*rho_a(i)*stress(i)*(v1(i,1)-ssv(i))/spd1(i) enddo ! if(ldiag3d .and. .not. gen_tend) then diff --git a/physics/satmedmfvdifq.meta b/physics/satmedmfvdifq.meta index b6680dccb..b21e5d4f2 100644 --- a/physics/satmedmfvdifq.meta +++ b/physics/satmedmfvdifq.meta @@ -217,6 +217,22 @@ type = real kind = kind_phys intent = in +[ssu] + standard_name = ocn_current_zonal + long_name = ocn_current_zonal + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[ssv] + standard_name = ocn_current_merid + long_name = ocn_current_merid + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in [t1] standard_name = air_temperature long_name = layer mean air temperature diff --git a/physics/sfc_diff.f b/physics/sfc_diff.f index 6e834537a..e4abf42d9 100644 --- a/physics/sfc_diff.f +++ b/physics/sfc_diff.f @@ -61,6 +61,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) & z0pert,ztpert, & ! mg, sfc-perts !intent(in) & flag_iter,redrag, & !intent(in) & u10m,v10m,sfc_z0_type, & !hafs,z0 type !intent(in) + & u1,v1,ssu,ssv & !intent(in) & wet,dry,icy, & !intent(in) & thsfc_loc, & !intent(in) & tskin_wat, tskin_lnd, tskin_ice, & !intent(in) @@ -95,6 +96,7 @@ 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,ssu,ssv 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, & @@ -128,6 +130,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! real(kind=kind_phys) :: rat, tv1, thv1, restar, wind10m, & czilc, tem1, tem2, virtfac + real(kind=kind_phys), dimension(im) :: windrel ! real(kind=kind_phys) :: tvs, z0, z0max, ztmax, gdx @@ -167,6 +170,9 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! ! write(0,*)'in sfc_diff, sfc_z0_type=',sfc_z0_type + do i=1,im + windrel(i) = sqrt((u1(i)-ssu(i))**2+(v1(i)-ssv(i))**2) + enddo do i=1,im if(flag_iter(i)) then @@ -274,7 +280,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(i), & z0max, ztmax_lnd(i), tvs, grav, thsfc_loc, ! --- outputs: & rb_lnd(i), fm_lnd(i), fh_lnd(i), fm10_lnd(i), fh2_lnd(i), @@ -328,7 +334,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(i), & z0max, ztmax_ice(i), tvs, grav, thsfc_loc, ! --- outputs: & rb_ice(i), fm_ice(i), fh_ice(i), fm10_ice(i), fh2_ice(i), diff --git a/physics/sfc_diff.meta b/physics/sfc_diff.meta index eb30b8c50..95e2bce81 100644 --- a/physics/sfc_diff.meta +++ b/physics/sfc_diff.meta @@ -102,6 +102,13 @@ type = real kind = kind_phys intent = in +[windrel] + standard_name = relative_wind_speed_at_lowest_model_layer + long_name = relative wind speed at lowest model level + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys [prsl1] standard_name = air_pressure_at_surface_adjacent_layer long_name = Model layer 1 mean pressure @@ -210,6 +217,22 @@ type = real kind = kind_phys intent = in +[ssu] + standard_name = ocn_current_zonal + long_name = ocn_current_zonal + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[ssv] + standard_name = ocn_current_merid + long_name = ocn_current_merid + 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 diff --git a/physics/sfc_nst.f b/physics/sfc_nst.f index 2ca70666d..4855d7224 100644 --- a/physics/sfc_nst.f +++ b/physics/sfc_nst.f @@ -16,7 +16,7 @@ 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, & + & pi, tgice, sbc, ps, u1, v1, ssu, ssv, t1, q1, tref, cm, ch,& & lseaspray, fm, fm10, & & prsl1, prslki, prsik1, prslk1, wet, use_lake_model, xlon, & & sinlat, stress, & @@ -36,7 +36,7 @@ subroutine sfc_nst_run & ! ! ! call sfc_nst ! ! inputs: ! -! ( im, ps, u1, v1, t1, q1, tref, cm, ch, ! +! ( im, ps, u1, v1, ssu, ssv,t1, q1, tref, cm, ch, ! ! lseaspray, fm, fm10, ! ! prsl1, prslki, wet, use_lake_model, xlon, sinlat, stress, ! ! sfcemis, dlwflx, sfcnsw, rain, timestep, kdt,solhr,xcosz, ! @@ -222,6 +222,7 @@ subroutine sfc_nst_run & & rho_a, theta1, tv1, wndmag real(kind=kind_phys) elocp,tem,cpinv,hvapi + real(kind=kind_phys) windref ! ! nstm related prognostic fields ! @@ -309,7 +310,9 @@ subroutine sfc_nst_run & ! qss is saturation specific humidity at the water surface !! do i = 1, im +! windref = wind(i) if ( flag(i) ) then + windref = sqrt((u1(i)-ssu(i))**2 + (v1(i)-ssv(i))**2) nswsfc(i) = sfcnsw(i) ! net solar radiation at the air-sea surface (positive downward) wndmag(i) = sqrt(u1(i)*u1(i) + v1(i)*v1(i)) @@ -334,9 +337,9 @@ 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) + rch(i) = rho_a(i) * cp * ch(i) * windref + cmm(i) = cm (i) * windref + chh(i) = rho_a(i) * ch(i) * windref !> - Calculate latent and sensible heat flux over open water with tskin. ! at previous time step diff --git a/physics/sfc_nst.meta b/physics/sfc_nst.meta index dc35ec959..10330fbb3 100644 --- a/physics/sfc_nst.meta +++ b/physics/sfc_nst.meta @@ -134,6 +134,22 @@ type = real kind = kind_phys intent = in +[ssu] + standard_name = ocn_current_zonal + long_name = ocn_current_zonal + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[ssv] + standard_name = ocn_current_merid + long_name = ocn_current_merid + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in [t1] standard_name = air_temperature_at_surface_adjacent_layer long_name = surface layer mean temperature diff --git a/physics/sfc_ocean.F b/physics/sfc_ocean.F index 78d58d8f0..2423bd8d9 100644 --- a/physics/sfc_ocean.F +++ b/physics/sfc_ocean.F @@ -24,7 +24,7 @@ subroutine sfc_ocean_run & !................................... ! --- inputs: & ( im, hvap, cp, rd, eps, epsm1, rvrdm1, ps, u1, v1, t1, q1, & - & tskin, cm, ch, lseaspray, fm, fm10, & + & tskin, cm, ch, lseaspray, fm, fm10, ssu, ssv, & & 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 @@ -66,6 +66,7 @@ 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 ! +! ssu,ssv - real, u/v component of surface ocean current (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 ! @@ -109,7 +110,8 @@ 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, ssu, & + & ssv ! For sea spray effect logical, intent(in) :: lseaspray @@ -133,7 +135,7 @@ subroutine sfc_ocean_run & ! --- locals: real (kind=kind_phys) :: qss, rch, tem, - & elocp, cpinv, hvapi + & elocp, cpinv, hvapi, windref real (kind=kind_phys), dimension(im) :: rho, q0 integer :: i @@ -157,6 +159,7 @@ subroutine sfc_ocean_run & ! -- ... initialize CCPP error handling variables errmsg = '' errflg = 0 + print *, 'ssu ssv',ssu(1),ssv(1) cpinv = one/cp hvapi = one/hvap @@ -169,13 +172,15 @@ subroutine sfc_ocean_run & ! ps is in pascals, wind is wind speed, ! rho is density, qss is sat. hum. at surface +! windref = wind(i) if ( flag(i) ) then + windref = sqrt((u1(i)-ssu(i))**2 + (v1(i)-ssv(i))**2) 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) + tem = ch(i) * windref + cmm(i) = cm(i) * windref chh(i) = rho(i) * tem hflx(i) = dtsfc_med(i) @@ -192,9 +197,9 @@ 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) + rch = rho(i) * cp * ch(i) * windref + tem = ch(i) * windref + cmm(i) = cm(i) * windref chh(i) = rho(i) * tem !> - Calcualte sensible and latent heat flux over open water diff --git a/physics/sfc_ocean.meta b/physics/sfc_ocean.meta index 15812e723..7d2e55e27 100644 --- a/physics/sfc_ocean.meta +++ b/physics/sfc_ocean.meta @@ -86,6 +86,22 @@ type = real kind = kind_phys intent = in +[ssu] + standard_name = ocn_current_zonal + long_name = ocn_current_zonal + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[ssv] + standard_name = ocn_current_merid + long_name = ocn_current_merid + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in [t1] standard_name = air_temperature_at_surface_adjacent_layer long_name = surface layer mean temperature diff --git a/z b/z new file mode 100644 index 000000000..c1bc228c7 --- /dev/null +++ b/z @@ -0,0 +1,16 @@ +[ssu] + standard_name = ocn_current_zonal + long_name = ocn_current_zonal + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[ssv] + standard_name = ocn_current_merid + long_name = ocn_current_merid + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in From 32584c2807800047cbc34d8db423569292eca492 Mon Sep 17 00:00:00 2001 From: "Bin.Li" Date: Sat, 25 Nov 2023 15:29:18 +0000 Subject: [PATCH 02/21] Use the ocean current field for the air-sea flux calculation. --- physics/satmedmfvdif.F | 19 ++++++++++++++++++- physics/satmedmfvdif.meta | 16 ++++++++++++++++ physics/satmedmfvdifq.F | 19 +++++++++++++++++++ physics/sfc_diag.f | 21 +++++++++++++++++++-- physics/sfc_diag.meta | 16 ++++++++++++++++ physics/sfc_diff.f | 26 ++++++++++++++++++++++---- physics/sfc_nst.f | 32 ++++++++++++++++++++++++-------- physics/sfc_ocean.F | 31 ++++++++++++++++++++++--------- z | 16 ---------------- 9 files changed, 156 insertions(+), 40 deletions(-) delete mode 100644 z diff --git a/physics/satmedmfvdif.F b/physics/satmedmfvdif.F index 79f7bbea1..a0441e8f4 100644 --- a/physics/satmedmfvdif.F +++ b/physics/satmedmfvdif.F @@ -63,7 +63,7 @@ end subroutine satmedmfvdif_init !> @{ subroutine satmedmfvdif_run(im,km,ntrac,ntcw,ntiw,ntke, & & grav,rd,cp,rv,hvap,hfus,fv,eps,epsm1, & - & dv,du,tdt,rtg,u1,v1,t1,q1,swh,hlw,xmu,garea, & + & dv,du,tdt,rtg,u1,v1,ssu,ssv,t1,q1,swh,hlw,xmu,garea, & & psk,rbsoil,zorl,u10m,v10m,fm,fh, & & tsea,heat,evap,stress,spd1,kpbl, & & prsi,del,prsl,prslk,phii,phil,delt, & @@ -95,6 +95,7 @@ subroutine satmedmfvdif_run(im,km,ntrac,ntcw,ntiw,ntke, & & tdt(:,:), rtg(:,:,:) real(kind=kind_phys), intent(in) :: & & u1(:,:), v1(:,:), & + & ssu(:), ssv(:), & & t1(:,:), q1(:,:,:), & & swh(:,:), hlw(:,:), & & xmu(:), garea(:), & @@ -217,6 +218,9 @@ subroutine satmedmfvdif_run(im,km,ntrac,ntcw,ntiw,ntke, & ! real(kind=kind_phys) h1 integer :: idtend + integer ii + real(kind=kind_phys) :: ssumax, ssvmax + logical :: check_ssu_ssv !! parameter(wfac=7.0,cfac=4.5) parameter(gamcrt=3.,gamcrq=0.,sfcfrac=0.1) @@ -250,6 +254,19 @@ subroutine satmedmfvdif_run(im,km,ntrac,ntcw,ntiw,ntke, & ! Initialize CCPP error handling variables errmsg = '' errflg = 0 +! + check_ssu_ssv=.true. + if(check_ssu_ssv) then + ssumax=0.0 + ssvmax=0.0 + do ii=1,im + if(ssu(ii) .gt. ssumax) ssumax=ssu(ii) + if(ssv(ii) .gt. ssvmax) ssvmax=ssv(ii) + !windrel(ii) = sqrt((u1(ii)-ssu(ii))**2+(v1(ii)-ssv(ii))**2) + enddo + print*, 'in satmedmfvdif.F ssumax,ssvmax =',ssumax,ssvmax + endif + !if(abs(ssumax-0.02) .lt. 0.01) check_ssu_ssv=.false. !> -# Compute preliminary variables from input arguments dt2 = delt diff --git a/physics/satmedmfvdif.meta b/physics/satmedmfvdif.meta index 3609ed50f..522ce543b 100644 --- a/physics/satmedmfvdif.meta +++ b/physics/satmedmfvdif.meta @@ -211,6 +211,22 @@ type = real kind = kind_phys intent = in +[ssu] + standard_name = ocn_current_zonal + long_name = ocn_current_zonal + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[ssv] + standard_name = ocn_current_merid + long_name = ocn_current_merid + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in [t1] standard_name = air_temperature long_name = layer mean air temperature diff --git a/physics/satmedmfvdifq.F b/physics/satmedmfvdifq.F index 4ccf47060..62bf6473f 100644 --- a/physics/satmedmfvdifq.F +++ b/physics/satmedmfvdifq.F @@ -280,6 +280,25 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & parameter(cs0=0.4,csmf=0.5) parameter(rchck=1.5,ndt=20) +!BL + integer ii + real(kind=kind_phys) :: ssumax, ssvmax + logical :: check_ssu_ssv + + write(*,*)'in_satmedmfvdifq,u1 v1',u1(1,1),v1(1,1) + check_ssu_ssv=.true. + if(check_ssu_ssv) then + ssumax=0.0 + ssvmax=0.0 + do ii=1,im + if(ssu(ii) .gt. ssumax) ssumax=ssu(ii) + if(ssv(ii) .gt. ssvmax) ssvmax=ssv(ii) + enddo + print*, 'in satmedmfvdifq.F ssumax,ssvmax =',ssumax,ssvmax + endif + !if(abs(ssumax-0.02) .lt. 0.01) check_ssu_ssv=.false. +!BL + if (tc_pbl == 0) then ck0 = 0.4 ch0 = 0.4 diff --git a/physics/sfc_diag.f b/physics/sfc_diag.f index 768814e8c..b9006d6a9 100644 --- a/physics/sfc_diag.f +++ b/physics/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, & + & ssu,ssv, & & 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, & @@ -38,6 +39,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, & + & ssu, ssv, & & qsurf, prslki, evap, fm, fh, fm10, fh2, & & shflx, cdq, wind, xlat_d, xlon_d real(kind=kind_phys), dimension(:), intent(out) :: & @@ -67,10 +69,25 @@ subroutine sfc_diag_run (im,xlat_d,xlon_d, & ! real(kind=kind_phys) sig2k, fhi, qss ! ! real, parameter :: g=grav + integer ii + real(kind=kind_phys) :: ssumax, ssvmax + logical :: check_ssu_ssv ! ! Initialize CCPP error handling variables errmsg = '' errflg = 0 + + check_ssu_ssv=.true. + if(check_ssu_ssv) then + ssumax=0.0 + ssvmax=0.0 + do ii=1,im + if(ssu(ii) .gt. ssumax) ssumax=ssu(ii) + if(ssv(ii) .gt. ssvmax) ssvmax=ssv(ii) + enddo + print*, 'in sfc_diag ssumax,ssvmax =',ssumax,ssvmax + endif + !if(abs(ssumax-0.02).lt.0.01) check_ssu_ssv=.false. !-- testptlat = 35.3_kind_phys @@ -89,8 +106,8 @@ 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) + u10m(i) = ssu(i) + f10m(i) * (u1(i)-ssu(i)) + v10m(i) = ssv(i) + f10m(i) * (v1(i)-ssv(i)) 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_diag.meta b/physics/sfc_diag.meta index a16290b58..9a8a5517e 100644 --- a/physics/sfc_diag.meta +++ b/physics/sfc_diag.meta @@ -123,6 +123,22 @@ type = real kind = kind_phys intent = in +[ssu] + standard_name = ocn_current_zonal + long_name = ocn_current_zonal + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[ssv] + standard_name = ocn_current_merid + long_name = ocn_current_merid + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in [t1] standard_name = air_temperature_at_surface_adjacent_layer long_name = 1st model layer air temperature diff --git a/physics/sfc_diff.f b/physics/sfc_diff.f index e4abf42d9..0ac51fda0 100644 --- a/physics/sfc_diff.f +++ b/physics/sfc_diff.f @@ -61,7 +61,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) & z0pert,ztpert, & ! mg, sfc-perts !intent(in) & flag_iter,redrag, & !intent(in) & u10m,v10m,sfc_z0_type, & !hafs,z0 type !intent(in) - & u1,v1,ssu,ssv & !intent(in) + & u1,v1,ssu,ssv, & & wet,dry,icy, & !intent(in) & thsfc_loc, & !intent(in) & tskin_wat, tskin_lnd, tskin_ice, & !intent(in) @@ -127,10 +127,13 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! locals ! integer i + integer ii + real(kind=kind_phys) :: ssumax, ssvmax + real(kind=kind_phys), dimension(im) :: windrel + logical :: check_ssu_ssv ! real(kind=kind_phys) :: rat, tv1, thv1, restar, wind10m, & czilc, tem1, tem2, virtfac - real(kind=kind_phys), dimension(im) :: windrel ! real(kind=kind_phys) :: tvs, z0, z0max, ztmax, gdx @@ -168,11 +171,26 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! ps is in pascals, wind is wind speed, ! surface roughness length is converted to m from cm ! + ! write(0,*)'in sfc_diff, sfc_z0_type=',sfc_z0_type + + check_ssu_ssv=.true. + if(check_ssu_ssv) then + ssumax=0.0 + ssvmax=0.0 + do ii=1,im + if(ssu(ii) .gt. ssumax) ssumax=ssu(ii) + if(ssv(ii) .gt. ssvmax) ssvmax=ssv(ii) + enddo + print*, 'in sfc_diff ssumax,ssvmax =',ssumax,ssvmax + print*, 'in sfc_diff wind(1),u1(1),v1(1) =',wind(1),u1(1),v1(1) + endif + !if(abs(ssumax-0.02) .lt. 0.01) check_ssu_ssv=.false. do i=1,im - windrel(i) = sqrt((u1(i)-ssu(i))**2+(v1(i)-ssv(i))**2) + windrel(i)=sqrt( (u1(i)-ssu(i))**2 + (v1(i)-ssv(i))**2 ) enddo + do i=1,im if(flag_iter(i)) then @@ -389,7 +407,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(i), & 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_nst.f b/physics/sfc_nst.f index 4855d7224..8aad8fc8f 100644 --- a/physics/sfc_nst.f +++ b/physics/sfc_nst.f @@ -36,7 +36,7 @@ subroutine sfc_nst_run & ! ! ! call sfc_nst ! ! inputs: ! -! ( im, ps, u1, v1, ssu, ssv,t1, q1, tref, cm, ch, ! +! ( im, ps, u1, v1, ssu,ssv, t1, q1, tref, cm, ch, ! ! lseaspray, fm, fm10, ! ! prsl1, prslki, wet, use_lake_model, xlon, sinlat, stress, ! ! sfcemis, dlwflx, sfcnsw, rain, timestep, kdt,solhr,xcosz, ! @@ -75,6 +75,7 @@ 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 ! +! ssu, ssv - real, u/v component of surface current (m/s) im ! ! t1 - real, surface layer mean temperature ( k ) im ! ! q1 - real, surface layer mean specific humidity im ! ! tref - real, reference/foundation temperature ( k ) im ! @@ -185,7 +186,7 @@ subroutine sfc_nst_run & 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, & + & ssu, ssv, 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 @@ -222,7 +223,6 @@ subroutine sfc_nst_run & & rho_a, theta1, tv1, wndmag real(kind=kind_phys) elocp,tem,cpinv,hvapi - real(kind=kind_phys) windref ! ! nstm related prognostic fields ! @@ -259,11 +259,28 @@ subroutine sfc_nst_run & real (kind=kind_phys), parameter :: alps=0.75,bets=0.75,gams=0.15, & ws10cr=30., conlf=7.2e-9, consf=6.4e-8 ! + + integer ii + real(kind=kind_phys) :: ssumax, ssvmax + real(kind=kind_phys) :: windrel + logical :: check_ssu_ssv !====================================================================================================== cc ! Initialize CCPP error handling variables errmsg = '' errflg = 0 + check_ssu_ssv=.true. + if(check_ssu_ssv) then + ssumax=0.0 + ssvmax=0.0 + do ii=1,im + if(ssu(ii) .gt. ssumax) ssumax=ssu(ii) + if(ssv(ii) .gt. ssvmax) ssvmax=ssv(ii) + enddo + print*, 'in sfc_nst ssumax,ssvmax =',ssumax,ssvmax + print*, 'in sfc_nst wind(1),u1(1),v1(1) =',wind(1),u1(1),v1(1) + endif + !if(abs(ssumax-0.02) .lt. 0.01) check_ssu_ssv=.false. if (nstf_name1 == 0) return ! No NSST model used @@ -310,9 +327,7 @@ subroutine sfc_nst_run & ! qss is saturation specific humidity at the water surface !! do i = 1, im -! windref = wind(i) if ( flag(i) ) then - windref = sqrt((u1(i)-ssu(i))**2 + (v1(i)-ssv(i))**2) nswsfc(i) = sfcnsw(i) ! net solar radiation at the air-sea surface (positive downward) wndmag(i) = sqrt(u1(i)*u1(i) + v1(i)*v1(i)) @@ -337,9 +352,10 @@ subroutine sfc_nst_run & ! --- ... rcp = rho cp ch v - rch(i) = rho_a(i) * cp * ch(i) * windref - cmm(i) = cm (i) * windref - chh(i) = rho_a(i) * ch(i) * windref + windrel = sqrt( (u1(i)-ssu(i))**2 + (v1(i)-ssv(i))**2 ) + rch(i) = rho_a(i) * cp * ch(i) * windrel + cmm(i) = cm (i) * windrel + chh(i) = rho_a(i) * ch(i) * windrel !> - Calculate latent and sensible heat flux over open water with tskin. ! at previous time step diff --git a/physics/sfc_ocean.F b/physics/sfc_ocean.F index 2423bd8d9..7e3c7c46a 100644 --- a/physics/sfc_ocean.F +++ b/physics/sfc_ocean.F @@ -135,10 +135,14 @@ subroutine sfc_ocean_run & ! --- locals: real (kind=kind_phys) :: qss, rch, tem, - & elocp, cpinv, hvapi, windref + & elocp, cpinv, hvapi, windrel real (kind=kind_phys), dimension(im) :: rho, q0 integer :: i + integer :: ii + real (kind=kind_phys) :: ssumax,ssvmax + !logical,save :: check_ssu_ssv=.true. + logical :: check_ssu_ssv logical :: flag(im) ! @@ -159,7 +163,16 @@ subroutine sfc_ocean_run & ! -- ... initialize CCPP error handling variables errmsg = '' errflg = 0 - print *, 'ssu ssv',ssu(1),ssv(1) + check_ssu_ssv=.false. + if(check_ssu_ssv) then + ssumax=0.0 + ssvmax=0.0 + do ii=1,im + if(ssu(ii) .gt. ssumax) ssumax=ssu(ii) + if(ssv(ii) .gt. ssvmax) ssvmax=ssv(ii) + enddo + print *, 'in sfc_ocean ssumax ssvmax',ssumax, ssvmax + endif cpinv = one/cp hvapi = one/hvap @@ -172,15 +185,14 @@ subroutine sfc_ocean_run & ! ps is in pascals, wind is wind speed, ! rho is density, qss is sat. hum. at surface -! windref = wind(i) if ( flag(i) ) then - windref = sqrt((u1(i)-ssu(i))**2 + (v1(i)-ssv(i))**2) if (use_med_flux) then + windrel = sqrt((u1(i)-ssu(i))**2 + (v1(i)-ssv(i))**2) q0(i) = max( q1(i), qmin ) rho(i) = prsl1(i) / (rd*t1(i)*(one + rvrdm1*q0(i))) - tem = ch(i) * windref - cmm(i) = cm(i) * windref + tem = ch(i) * windrel + cmm(i) = cm(i) * windrel chh(i) = rho(i) * tem hflx(i) = dtsfc_med(i) @@ -197,9 +209,10 @@ subroutine sfc_ocean_run & ! --- ... rcp = rho cp ch v - rch = rho(i) * cp * ch(i) * windref - tem = ch(i) * windref - cmm(i) = cm(i) * windref + windrel = sqrt((u1(i)-ssu(i))**2 + (v1(i)-ssv(i))**2) + rch = rho(i) * cp * ch(i) * windrel + tem = ch(i) * windrel + cmm(i) = cm(i) * windrel chh(i) = rho(i) * tem !> - Calcualte sensible and latent heat flux over open water diff --git a/z b/z deleted file mode 100644 index c1bc228c7..000000000 --- a/z +++ /dev/null @@ -1,16 +0,0 @@ -[ssu] - standard_name = ocn_current_zonal - long_name = ocn_current_zonal - units = m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[ssv] - standard_name = ocn_current_merid - long_name = ocn_current_merid - units = m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in From cf408aa7c740e2dca1cf2140ec2c261d1a1b8af3 Mon Sep 17 00:00:00 2001 From: "Bin.Li" Date: Mon, 27 Nov 2023 10:27:31 +0000 Subject: [PATCH 03/21] Update sfc_diff.meta --- physics/sfc_diff.meta | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/physics/sfc_diff.meta b/physics/sfc_diff.meta index 95e2bce81..7f0139ab6 100644 --- a/physics/sfc_diff.meta +++ b/physics/sfc_diff.meta @@ -217,6 +217,22 @@ 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 [ssu] standard_name = ocn_current_zonal long_name = ocn_current_zonal From 6bdadb5e7c61f2cabe391736cb3d29e1d041b434 Mon Sep 17 00:00:00 2001 From: "Bin.Li" Date: Wed, 29 Nov 2023 09:47:20 +0000 Subject: [PATCH 04/21] Set check_ssu_ssv to false in the following files: satmedmfvdif.F satmedmfvdifq.F sfc_diag.f sfc_diff.f --- physics/satmedmfvdif.F | 4 +--- physics/satmedmfvdifq.F | 7 ++----- physics/sfc_diag.f | 3 +-- physics/sfc_diff.f | 3 +-- physics/sfc_nst.f | 3 +-- 5 files changed, 6 insertions(+), 14 deletions(-) diff --git a/physics/satmedmfvdif.F b/physics/satmedmfvdif.F index a0441e8f4..cc7ce95b3 100644 --- a/physics/satmedmfvdif.F +++ b/physics/satmedmfvdif.F @@ -255,18 +255,16 @@ subroutine satmedmfvdif_run(im,km,ntrac,ntcw,ntiw,ntke, & errmsg = '' errflg = 0 ! - check_ssu_ssv=.true. + check_ssu_ssv=.false. if(check_ssu_ssv) then ssumax=0.0 ssvmax=0.0 do ii=1,im if(ssu(ii) .gt. ssumax) ssumax=ssu(ii) if(ssv(ii) .gt. ssvmax) ssvmax=ssv(ii) - !windrel(ii) = sqrt((u1(ii)-ssu(ii))**2+(v1(ii)-ssv(ii))**2) enddo print*, 'in satmedmfvdif.F ssumax,ssvmax =',ssumax,ssvmax endif - !if(abs(ssumax-0.02) .lt. 0.01) check_ssu_ssv=.false. !> -# Compute preliminary variables from input arguments dt2 = delt diff --git a/physics/satmedmfvdifq.F b/physics/satmedmfvdifq.F index 62bf6473f..8a200eb92 100644 --- a/physics/satmedmfvdifq.F +++ b/physics/satmedmfvdifq.F @@ -280,13 +280,11 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & parameter(cs0=0.4,csmf=0.5) parameter(rchck=1.5,ndt=20) -!BL integer ii real(kind=kind_phys) :: ssumax, ssvmax logical :: check_ssu_ssv - write(*,*)'in_satmedmfvdifq,u1 v1',u1(1,1),v1(1,1) - check_ssu_ssv=.true. + check_ssu_ssv=.false. if(check_ssu_ssv) then ssumax=0.0 ssvmax=0.0 @@ -294,10 +292,9 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & if(ssu(ii) .gt. ssumax) ssumax=ssu(ii) if(ssv(ii) .gt. ssvmax) ssvmax=ssv(ii) enddo + write(*,*)'in_satmedmfvdifq,u1 v1',u1(1,1),v1(1,1) print*, 'in satmedmfvdifq.F ssumax,ssvmax =',ssumax,ssvmax endif - !if(abs(ssumax-0.02) .lt. 0.01) check_ssu_ssv=.false. -!BL if (tc_pbl == 0) then ck0 = 0.4 diff --git a/physics/sfc_diag.f b/physics/sfc_diag.f index b9006d6a9..acfad7b27 100644 --- a/physics/sfc_diag.f +++ b/physics/sfc_diag.f @@ -77,7 +77,7 @@ subroutine sfc_diag_run (im,xlat_d,xlon_d, & errmsg = '' errflg = 0 - check_ssu_ssv=.true. + check_ssu_ssv=.false. if(check_ssu_ssv) then ssumax=0.0 ssvmax=0.0 @@ -87,7 +87,6 @@ subroutine sfc_diag_run (im,xlat_d,xlon_d, & enddo print*, 'in sfc_diag ssumax,ssvmax =',ssumax,ssvmax endif - !if(abs(ssumax-0.02).lt.0.01) check_ssu_ssv=.false. !-- testptlat = 35.3_kind_phys diff --git a/physics/sfc_diff.f b/physics/sfc_diff.f index 0ac51fda0..58614c452 100644 --- a/physics/sfc_diff.f +++ b/physics/sfc_diff.f @@ -175,7 +175,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! write(0,*)'in sfc_diff, sfc_z0_type=',sfc_z0_type - check_ssu_ssv=.true. + check_ssu_ssv=.false. if(check_ssu_ssv) then ssumax=0.0 ssvmax=0.0 @@ -186,7 +186,6 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) print*, 'in sfc_diff ssumax,ssvmax =',ssumax,ssvmax print*, 'in sfc_diff wind(1),u1(1),v1(1) =',wind(1),u1(1),v1(1) endif - !if(abs(ssumax-0.02) .lt. 0.01) check_ssu_ssv=.false. do i=1,im windrel(i)=sqrt( (u1(i)-ssu(i))**2 + (v1(i)-ssv(i))**2 ) enddo diff --git a/physics/sfc_nst.f b/physics/sfc_nst.f index 8aad8fc8f..526271aa3 100644 --- a/physics/sfc_nst.f +++ b/physics/sfc_nst.f @@ -269,7 +269,7 @@ subroutine sfc_nst_run & ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - check_ssu_ssv=.true. + check_ssu_ssv=.false. if(check_ssu_ssv) then ssumax=0.0 ssvmax=0.0 @@ -280,7 +280,6 @@ subroutine sfc_nst_run & print*, 'in sfc_nst ssumax,ssvmax =',ssumax,ssvmax print*, 'in sfc_nst wind(1),u1(1),v1(1) =',wind(1),u1(1),v1(1) endif - !if(abs(ssumax-0.02) .lt. 0.01) check_ssu_ssv=.false. if (nstf_name1 == 0) return ! No NSST model used From a2a242487053a091b338f4ef1f3431f3304b205e Mon Sep 17 00:00:00 2001 From: "Bin.Li" Date: Wed, 29 Nov 2023 15:16:31 +0000 Subject: [PATCH 05/21] Update sfc_diff.meta --- physics/sfc_diff.meta | 7 ------- 1 file changed, 7 deletions(-) diff --git a/physics/sfc_diff.meta b/physics/sfc_diff.meta index 7f0139ab6..80a89fc1b 100644 --- a/physics/sfc_diff.meta +++ b/physics/sfc_diff.meta @@ -102,13 +102,6 @@ type = real kind = kind_phys intent = in -[windrel] - standard_name = relative_wind_speed_at_lowest_model_layer - long_name = relative wind speed at lowest model level - units = m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys [prsl1] standard_name = air_pressure_at_surface_adjacent_layer long_name = Model layer 1 mean pressure From 9fb9c05dfc63c90333dafcf038a325c9e6ffe856 Mon Sep 17 00:00:00 2001 From: "Bin.Li" Date: Wed, 6 Dec 2023 18:44:17 +0000 Subject: [PATCH 06/21] Add a namelist option for including surface ocean current in the computation of air-sea fluxes. --- physics/satmedmfvdifq.F | 30 +++++++++++++++----------- physics/satmedmfvdifq.meta | 7 +++++++ physics/sfc_diag.f | 17 ++++++++++----- physics/sfc_diag.meta | 7 +++++++ physics/sfc_diff.f | 32 +++++++++++++++++----------- physics/sfc_diff.meta | 7 +++++++ physics/sfc_nst.f | 43 ++++++++++++++++++++++++-------------- physics/sfc_nst.meta | 7 +++++++ physics/sfc_ocean.F | 42 ++++++++++++++++++++++++------------- physics/sfc_ocean.meta | 7 +++++++ physics/zzz | 12 +++++++++++ 11 files changed, 151 insertions(+), 60 deletions(-) create mode 100755 physics/zzz diff --git a/physics/satmedmfvdifq.F b/physics/satmedmfvdifq.F index 8a200eb92..9a2214704 100644 --- a/physics/satmedmfvdifq.F +++ b/physics/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,ssu,ssv,swh,hlw,xmu, & - & garea,zvfun,sigmaf, & + & dv,du,tdt,rtg,u1,v1,t1,q1,ssu,ssv,iopt_flx_over_ocn, & + & 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, & @@ -127,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) :: iopt_flx_over_ocn real(kind=kind_phys), intent(out) :: & & dusfc(:), dvsfc(:), & & dtsfc(:), dqsfc(:), & @@ -143,6 +144,7 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & !---------------------------------------------------------------------- !*** !*** local variables + real(kind=kind_phys) spd1_m(im) !*** integer i,is,k,n,ndt,km1,kmpbl,kmscu,ntrac1,idtend integer kps,kbx,kmx @@ -280,20 +282,20 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & parameter(cs0=0.4,csmf=0.5) parameter(rchck=1.5,ndt=20) - integer ii real(kind=kind_phys) :: ssumax, ssvmax logical :: check_ssu_ssv check_ssu_ssv=.false. - if(check_ssu_ssv) then + if(check_ssu_ssv .and. iopt_flx_over_ocn == 1) then ssumax=0.0 ssvmax=0.0 - do ii=1,im - if(ssu(ii) .gt. ssumax) ssumax=ssu(ii) - if(ssv(ii) .gt. ssvmax) ssvmax=ssv(ii) + do i=1,im + if(ssu(i) .gt. ssumax) ssumax=ssu(i) + if(ssv(i) .gt. ssvmax) ssvmax=ssv(i) enddo write(*,*)'in_satmedmfvdifq,u1 v1',u1(1,1),v1(1,1) - print*, 'in satmedmfvdifq.F ssumax,ssvmax =',ssumax,ssvmax + print*, 'in satmedmfvdifq.F ssumax,ssvmax',ssumax,ssvmax + print*,'in satmedmfvdifq.F iopt_flx_over_ocn',iopt_flx_over_ocn endif if (tc_pbl == 0) then @@ -2393,10 +2395,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) - dusfc(i) = -1.*rho_a(i)*stress(i)*(u1(i,1)-ssu(i))/spd1(i) - dvsfc(i) = -1.*rho_a(i)*stress(i)*(v1(i,1)-ssv(i))/spd1(i) + if(iopt_flx_over_ocn == 1) then + spd1_m(i)=sqrt( (u1(i,1)-ssu(i))**2+(v1(i,1)-ssv(i))**2 ) + dusfc(i) = -1.*rho_a(i)*stress(i)*(u1(i,1)-ssu(i))/spd1_m(i) + dvsfc(i) = -1.*rho_a(i)*stress(i)*(v1(i,1)-ssv(i))/spd1_m(i) + else + 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) + endif enddo ! if(ldiag3d .and. .not. gen_tend) then diff --git a/physics/satmedmfvdifq.meta b/physics/satmedmfvdifq.meta index b21e5d4f2..4b84d6c65 100644 --- a/physics/satmedmfvdifq.meta +++ b/physics/satmedmfvdifq.meta @@ -233,6 +233,13 @@ type = real kind = kind_phys intent = in +[iopt_flx_over_ocn] + standard_name = flag_for_air_sea_flux_computation_over_water + long_name = air-sea flux option + units = flag + dimensions = () + type = integer + intent = in [t1] standard_name = air_temperature long_name = layer mean air temperature diff --git a/physics/sfc_diag.f b/physics/sfc_diag.f index acfad7b27..5acda6181 100644 --- a/physics/sfc_diag.f +++ b/physics/sfc_diag.f @@ -17,7 +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, & - & ssu,ssv, & + & ssu,ssv,iopt_flx_over_ocn, & & 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 +31,7 @@ subroutine sfc_diag_run (im,xlat_d,xlon_d, & implicit none ! integer, intent(in) :: im, lsm, lsm_ruc, iopt_lake, iopt_lake_clm + integer, intent(in) :: iopt_flx_over_ocn logical, intent(in) :: use_lake2m logical, intent(in) :: thsfc_loc ! Flag for reference pot. temp. logical, intent(in) :: diag_flux ! Flag for flux method in 2-m diagnostics @@ -78,14 +79,15 @@ subroutine sfc_diag_run (im,xlat_d,xlon_d, & errflg = 0 check_ssu_ssv=.false. - if(check_ssu_ssv) then + if(check_ssu_ssv .and. iopt_flx_over_ocn ==1) then ssumax=0.0 ssvmax=0.0 do ii=1,im if(ssu(ii) .gt. ssumax) ssumax=ssu(ii) if(ssv(ii) .gt. ssvmax) ssvmax=ssv(ii) enddo - print*, 'in sfc_diag ssumax,ssvmax =',ssumax,ssvmax + print*, 'in sfc_diag ssumax ssvmax=', ssumax, ssvmax + print*, 'in sfc_diag iopt_flx_over_ocn=', iopt_flx_over_ocn endif !-- @@ -105,8 +107,13 @@ subroutine sfc_diag_run (im,xlat_d,xlon_d, & do i = 1, im f10m(i) = fm10(i) / fm(i) - u10m(i) = ssu(i) + f10m(i) * (u1(i)-ssu(i)) - v10m(i) = ssv(i) + f10m(i) * (v1(i)-ssv(i)) + if(iopt_flx_over_ocn ==1) then + u10m(i) = ssu(i) + f10m(i) * (u1(i)-ssu(i)) + v10m(i) = ssv(i) + f10m(i) * (v1(i)-ssv(i)) + else + u10m(i) = f10m(i) * u1(i) + v10m(i) = f10m(i) * v1(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_diag.meta b/physics/sfc_diag.meta index 9a8a5517e..834ad5871 100644 --- a/physics/sfc_diag.meta +++ b/physics/sfc_diag.meta @@ -139,6 +139,13 @@ type = real kind = kind_phys intent = in +[iopt_flx_over_ocn] + standard_name = flag_for_air_sea_flux_computation_over_water + long_name = air-sea flux option + units = flag + 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_diff.f b/physics/sfc_diff.f index 58614c452..62102151a 100644 --- a/physics/sfc_diff.f +++ b/physics/sfc_diff.f @@ -61,7 +61,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) & z0pert,ztpert, & ! mg, sfc-perts !intent(in) & flag_iter,redrag, & !intent(in) & u10m,v10m,sfc_z0_type, & !hafs,z0 type !intent(in) - & u1,v1,ssu,ssv, & + & u1,v1,ssu,ssv,iopt_flx_over_ocn, & & wet,dry,icy, & !intent(in) & thsfc_loc, & !intent(in) & tskin_wat, tskin_lnd, tskin_ice, & !intent(in) @@ -86,6 +86,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) :: iopt_flx_over_ocn ! option for including ocean current in the computation of flux integer, dimension(:), intent(in) :: vegtype @@ -129,10 +130,10 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) integer i integer ii real(kind=kind_phys) :: ssumax, ssvmax - real(kind=kind_phys), dimension(im) :: windrel + real(kind=kind_phys), dimension(im) :: windrel, wind10m logical :: check_ssu_ssv ! - real(kind=kind_phys) :: rat, tv1, thv1, restar, wind10m, + real(kind=kind_phys) :: rat, tv1, thv1, restar, & czilc, tem1, tem2, virtfac ! @@ -176,7 +177,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) check_ssu_ssv=.false. - if(check_ssu_ssv) then + if(check_ssu_ssv .and. iopt_flx_over_ocn == 1) then ssumax=0.0 ssvmax=0.0 do ii=1,im @@ -184,11 +185,18 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) if(ssv(ii) .gt. ssvmax) ssvmax=ssv(ii) enddo print*, 'in sfc_diff ssumax,ssvmax =',ssumax,ssvmax + print*, 'in sfc_diff iopt_flx_over_ocn =',iopt_flx_over_ocn print*, 'in sfc_diff wind(1),u1(1),v1(1) =',wind(1),u1(1),v1(1) + do i=1,im + windrel(i)=sqrt( (u1(i)-ssu(i))**2 + (v1(i)-ssv(i))**2 ) + wind10m(i)= sqrt( (u10m(i)-ssu(i))**2 + (v10m(i)-ssv(i))**2 ) + enddo + else + do i=1,im + wind10m(i)= sqrt( u10m(i)**2 + v10m(i)**2 ) + windrel(i)=wind(i) + enddo endif - do i=1,im - windrel(i)=sqrt( (u1(i)-ssu(i))**2 + (v1(i)-ssv(i))**2 ) - enddo do i=1,im if(flag_iter(i)) then @@ -375,7 +383,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) z0 = 0.01_kp * z0rl_wat(i) z0max = max(zmin, min(z0,z1(i))) ! ustar_wat(i) = sqrt(grav * z0 / charnock) - wind10m = sqrt(u10m(i)*u10m(i)+v10m(i)*v10m(i)) +! wind10m = sqrt(u10m(i)*u10m(i) + v10m(i)*v10m(i)) !** test xubin's new z0 @@ -394,9 +402,9 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ztmax_wat(i) = max(z0max * exp(-rat), zmin) ! if (sfc_z0_type == 6) then - call znot_t_v6(wind10m, ztmax_wat(i)) ! 10-m wind,m/s, ztmax(m) + call znot_t_v6(wind10m(i), ztmax_wat(i)) ! 10-m wind,m/s, ztmax(m) else if (sfc_z0_type == 7) then - call znot_t_v7(wind10m, ztmax_wat(i)) ! 10-m wind,m/s, ztmax(m) + call znot_t_v7(wind10m(i), ztmax_wat(i)) ! 10-m wind,m/s, ztmax(m) else if (sfc_z0_type > 0) then write(0,*)'no option for sfc_z0_type=',sfc_z0_type errflg = 1 @@ -437,10 +445,10 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) endif elseif (sfc_z0_type == 6) then ! wang - call znot_m_v6(wind10m, z0) ! wind, m/s, z0, m + call znot_m_v6(wind10m(i), z0) ! wind, m/s, z0, m z0rl_wat(i) = 100.0_kp * z0 ! cm elseif (sfc_z0_type == 7) then ! wang - call znot_m_v7(wind10m, z0) ! wind, m/s, z0, m + call znot_m_v7(wind10m(i), z0) ! wind, m/s, z0, m z0rl_wat(i) = 100.0_kp * z0 ! cm else z0rl_wat(i) = 1.0e-4_kp diff --git a/physics/sfc_diff.meta b/physics/sfc_diff.meta index 80a89fc1b..360c2a0c8 100644 --- a/physics/sfc_diff.meta +++ b/physics/sfc_diff.meta @@ -249,6 +249,13 @@ dimensions = () type = integer intent = in +[iopt_flx_over_ocn] + standard_name = flag_for_air_sea_flux_computation_over_water + long_name = air-sea flux option + units = flag + 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_nst.f b/physics/sfc_nst.f index 526271aa3..92d7b9c63 100644 --- a/physics/sfc_nst.f +++ b/physics/sfc_nst.f @@ -16,8 +16,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, ssu, ssv, t1, q1, tref, cm, ch,& - & lseaspray, fm, fm10, & + & pi, tgice, sbc, ps, u1, v1, ssu, ssv, iopt_flx_over_ocn, & + & 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, & @@ -36,8 +36,8 @@ subroutine sfc_nst_run & ! ! ! call sfc_nst ! ! inputs: ! -! ( im, ps, u1, v1, ssu,ssv, t1, q1, tref, cm, ch, ! -! lseaspray, fm, fm10, ! +! ( im, ps, u1, v1, ssu,ssv, iopt_flx_over_ocn, ! +! t1, q1, tref, cm, ch, lseaspray, fm, fm10, ! ! prsl1, prslki, wet, use_lake_model, xlon, sinlat, stress, ! ! sfcemis, dlwflx, sfcnsw, rain, timestep, kdt,solhr,xcosz, ! ! wind, flag_iter, flag_guess, nstf_name1, nstf_name4, ! @@ -76,6 +76,8 @@ subroutine sfc_nst_run & ! ps - real, surface pressure (pa) im ! ! u1, v1 - real, u/v component of surface layer wind (m/s) im ! ! ssu, ssv - real, u/v component of surface current (m/s) im ! +! iopt_flx_over_ocn - integer, option to include 1 ! +! ocean 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 ! @@ -182,7 +184,7 @@ subroutine sfc_nst_run & ! --- inputs: integer, intent(in) :: im, kdt, ipr, nstf_name1, nstf_name4, & - & nstf_name5 + & nstf_name5, iopt_flx_over_ocn 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, & @@ -260,26 +262,35 @@ subroutine sfc_nst_run & & ws10cr=30., conlf=7.2e-9, consf=6.4e-8 ! - integer ii real(kind=kind_phys) :: ssumax, ssvmax - real(kind=kind_phys) :: windrel - logical :: check_ssu_ssv + real(kind=kind_phys) :: windrel(im) + logical :: check_ssu_ssv !====================================================================================================== cc ! Initialize CCPP error handling variables errmsg = '' errflg = 0 check_ssu_ssv=.false. - if(check_ssu_ssv) then + if(check_ssu_ssv .and. iopt_flx_over_ocn ==1) then ssumax=0.0 ssvmax=0.0 - do ii=1,im - if(ssu(ii) .gt. ssumax) ssumax=ssu(ii) - if(ssv(ii) .gt. ssvmax) ssvmax=ssv(ii) + do i=1,im + if(ssu(i) .gt. ssumax) ssumax=ssu(i) + if(ssv(i) .gt. ssvmax) ssvmax=ssv(i) enddo print*, 'in sfc_nst ssumax,ssvmax =',ssumax,ssvmax + print*, 'in sfc_nst iopt_flx_over_ocn =',iopt_flx_over_ocn print*, 'in sfc_nst wind(1),u1(1),v1(1) =',wind(1),u1(1),v1(1) endif + if(iopt_flx_over_ocn ==1) then + do i=1,im + windrel(i) = sqrt( (u1(i)-ssu(i))**2 + (v1(i)-ssv(i))**2 ) + enddo + else + do i=1,im + windrel(i) = wind(i) + enddo + endif if (nstf_name1 == 0) return ! No NSST model used @@ -351,10 +362,10 @@ subroutine sfc_nst_run & ! --- ... rcp = rho cp ch v - windrel = sqrt( (u1(i)-ssu(i))**2 + (v1(i)-ssv(i))**2 ) - rch(i) = rho_a(i) * cp * ch(i) * windrel - cmm(i) = cm (i) * windrel - chh(i) = rho_a(i) * ch(i) * windrel + !windrel = sqrt( (u1(i)-ssu(i))**2 + (v1(i)-ssv(i))**2 ) + rch(i) = rho_a(i) * cp * ch(i) * windrel(i) + cmm(i) = cm (i) * windrel(i) + chh(i) = rho_a(i) * ch(i) * windrel(i) !> - Calculate latent and sensible heat flux over open water with tskin. ! at previous time step diff --git a/physics/sfc_nst.meta b/physics/sfc_nst.meta index 10330fbb3..eb5a2d379 100644 --- a/physics/sfc_nst.meta +++ b/physics/sfc_nst.meta @@ -150,6 +150,13 @@ type = real kind = kind_phys intent = in +[iopt_flx_over_ocn] + standard_name = flag_for_air_sea_flux_computation_over_water + long_name = air-sea flux option + units = flag + 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_ocean.F b/physics/sfc_ocean.F index 7e3c7c46a..27e309eca 100644 --- a/physics/sfc_ocean.F +++ b/physics/sfc_ocean.F @@ -24,7 +24,8 @@ subroutine sfc_ocean_run & !................................... ! --- inputs: & ( im, hvap, cp, rd, eps, epsm1, rvrdm1, ps, u1, v1, t1, q1, & - & tskin, cm, ch, lseaspray, fm, fm10, ssu, ssv, & + & tskin, cm, ch, lseaspray, fm, fm10, & + & ssu, ssv, iopt_flx_over_ocn, & & 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, ! +! ssu, ssv, iopt_flx_over_ocn, ! ! prsl1, prslki, wet, use_lake_model, wind, flag_iter, ! ! use_med_flux, ! ! outputs: ! @@ -67,6 +69,8 @@ subroutine sfc_ocean_run & ! ps - real, surface pressure im ! ! u1, v1 - real, u/v component of surface layer wind (m/s) im ! ! ssu,ssv - real, u/v component of surface ocean current (m/s) im ! +! iopt_flx_over_ocn - integer, option for including 1 ! +! ocean current in the computation of flux ! ! t1 - real, surface layer mean temperature ( k ) im ! ! q1 - real, surface layer mean specific humidity im ! ! tskin - real, ground surface skin temperature ( k ) im ! @@ -106,6 +110,7 @@ subroutine sfc_ocean_run & & zero = 0.0_kind_phys, qmin = 1.0e-8_kind_phys ! --- inputs: integer, intent(in) :: im + integer, intent(in) :: iopt_flx_over_ocn real (kind=kind_phys), intent(in) :: hvap, cp, rd, & & eps, epsm1, rvrdm1 @@ -135,11 +140,10 @@ subroutine sfc_ocean_run & ! --- locals: real (kind=kind_phys) :: qss, rch, tem, - & elocp, cpinv, hvapi, windrel + & elocp, cpinv, hvapi, windrel(im) real (kind=kind_phys), dimension(im) :: rho, q0 integer :: i - integer :: ii real (kind=kind_phys) :: ssumax,ssvmax !logical,save :: check_ssu_ssv=.true. logical :: check_ssu_ssv @@ -164,15 +168,25 @@ subroutine sfc_ocean_run & errmsg = '' errflg = 0 check_ssu_ssv=.false. - if(check_ssu_ssv) then + if(check_ssu_ssv .and. iopt_flx_over_ocn == 1) then ssumax=0.0 ssvmax=0.0 - do ii=1,im - if(ssu(ii) .gt. ssumax) ssumax=ssu(ii) - if(ssv(ii) .gt. ssvmax) ssvmax=ssv(ii) + do i=1,im + if(ssu(i) .gt. ssumax) ssumax=ssu(i) + if(ssv(i) .gt. ssvmax) ssvmax=ssv(i) enddo - print *, 'in sfc_ocean ssumax ssvmax',ssumax, ssvmax + print *, 'in sfc_ocean ssumax,ssvmax',ssumax,ssvmax + print *, 'in sfc_ocean iopt_flx_over_ocn',iopt_flx_over_ocn endif + if(iopt_flx_over_ocn == 1) then + do i=1,im + windrel(i) = sqrt((u1(i)-ssu(i))**2 + (v1(i)-ssv(i))**2) + enddo + else + do i=1,im + windrel(i) = wind(i) + enddo + endif cpinv = one/cp hvapi = one/hvap @@ -187,12 +201,11 @@ subroutine sfc_ocean_run & if ( flag(i) ) then if (use_med_flux) then - windrel = sqrt((u1(i)-ssu(i))**2 + (v1(i)-ssv(i))**2) q0(i) = max( q1(i), qmin ) rho(i) = prsl1(i) / (rd*t1(i)*(one + rvrdm1*q0(i))) - tem = ch(i) * windrel - cmm(i) = cm(i) * windrel + tem = ch(i) * windrel(i) + cmm(i) = cm(i) * windrel(i) chh(i) = rho(i) * tem hflx(i) = dtsfc_med(i) @@ -209,10 +222,9 @@ subroutine sfc_ocean_run & ! --- ... rcp = rho cp ch v - windrel = sqrt((u1(i)-ssu(i))**2 + (v1(i)-ssv(i))**2) - rch = rho(i) * cp * ch(i) * windrel - tem = ch(i) * windrel - cmm(i) = cm(i) * windrel + rch = rho(i) * cp * ch(i) * windrel(i) + tem = ch(i) * windrel(i) + cmm(i) = cm(i) * windrel(i) chh(i) = rho(i) * tem !> - Calcualte sensible and latent heat flux over open water diff --git a/physics/sfc_ocean.meta b/physics/sfc_ocean.meta index 7d2e55e27..f99d74773 100644 --- a/physics/sfc_ocean.meta +++ b/physics/sfc_ocean.meta @@ -102,6 +102,13 @@ type = real kind = kind_phys intent = in +[iopt_flx_over_ocn] + standard_name = flag_for_air_sea_flux_computation_over_water + long_name = air-sea flux option + units = flag + dimensions = () + type = integer + intent = in [t1] standard_name = air_temperature_at_surface_adjacent_layer long_name = surface layer mean temperature diff --git a/physics/zzz b/physics/zzz new file mode 100755 index 000000000..e9bd2da01 --- /dev/null +++ b/physics/zzz @@ -0,0 +1,12 @@ +#!/bin/sh +export src1=/scratch1/NCEPDEV/stmp4/Bin.Li/20231201/ufs-weather-model/FV3/ccpp/physics/physics +cp $src1/satmedmfvdifq.F . +cp $src1/satmedmfvdifq.meta . +cp $src1/sfc_diff.f . +cp $src1/sfc_diff.meta . +cp $src1/sfc_diag.f . +cp $src1/sfc_diag.meta . +cp $src1/sfc_nst.f . +cp $src1/sfc_nst.meta . +cp $src1/sfc_ocean.F . +cp $src1/sfc_ocean.meta . From 06b0563ff7483b223102f960d4845c455a90843e Mon Sep 17 00:00:00 2001 From: "Bin.Li" Date: Fri, 8 Dec 2023 16:12:26 +0000 Subject: [PATCH 07/21] Revise the namelist option to include sea surface current in the computation of air-sea fluxes. --- physics/satmedmfvdifq.F | 22 +++------------------- physics/satmedmfvdifq.meta | 2 +- physics/sfc_diag.f | 21 +++------------------ physics/sfc_diag.meta | 2 +- physics/sfc_diff.f | 19 +++---------------- physics/sfc_diff.meta | 2 +- physics/sfc_nst.meta | 2 +- physics/sfc_ocean.F | 25 ++++++------------------- physics/sfc_ocean.meta | 2 +- physics/zzz | 12 ------------ 10 files changed, 20 insertions(+), 89 deletions(-) delete mode 100755 physics/zzz diff --git a/physics/satmedmfvdifq.F b/physics/satmedmfvdifq.F index 9a2214704..55667d515 100644 --- a/physics/satmedmfvdifq.F +++ b/physics/satmedmfvdifq.F @@ -75,7 +75,7 @@ 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,ssu,ssv,iopt_flx_over_ocn, & + & dv,du,tdt,rtg,u1,v1,t1,q1,ssu,ssv,icplocn2atm, & & swh,hlw,xmu,garea,zvfun,sigmaf, & & psk,rbsoil,zorl,u10m,v10m,fm,fh, & & tsea,heat,evap,stress,spd1,kpbl, & @@ -127,7 +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) :: iopt_flx_over_ocn + integer, intent(in) :: icplocn2atm real(kind=kind_phys), intent(out) :: & & dusfc(:), dvsfc(:), & & dtsfc(:), dqsfc(:), & @@ -282,22 +282,6 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & parameter(cs0=0.4,csmf=0.5) parameter(rchck=1.5,ndt=20) - real(kind=kind_phys) :: ssumax, ssvmax - logical :: check_ssu_ssv - - check_ssu_ssv=.false. - if(check_ssu_ssv .and. iopt_flx_over_ocn == 1) then - ssumax=0.0 - ssvmax=0.0 - do i=1,im - if(ssu(i) .gt. ssumax) ssumax=ssu(i) - if(ssv(i) .gt. ssvmax) ssvmax=ssv(i) - enddo - write(*,*)'in_satmedmfvdifq,u1 v1',u1(1,1),v1(1,1) - print*, 'in satmedmfvdifq.F ssumax,ssvmax',ssumax,ssvmax - print*,'in satmedmfvdifq.F iopt_flx_over_ocn',iopt_flx_over_ocn - endif - if (tc_pbl == 0) then ck0 = 0.4 ch0 = 0.4 @@ -2395,7 +2379,7 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & enddo enddo do i = 1,im - if(iopt_flx_over_ocn == 1) then + if(icplocn2atm == 1) then spd1_m(i)=sqrt( (u1(i,1)-ssu(i))**2+(v1(i,1)-ssv(i))**2 ) dusfc(i) = -1.*rho_a(i)*stress(i)*(u1(i,1)-ssu(i))/spd1_m(i) dvsfc(i) = -1.*rho_a(i)*stress(i)*(v1(i,1)-ssv(i))/spd1_m(i) diff --git a/physics/satmedmfvdifq.meta b/physics/satmedmfvdifq.meta index 4b84d6c65..c97126457 100644 --- a/physics/satmedmfvdifq.meta +++ b/physics/satmedmfvdifq.meta @@ -233,7 +233,7 @@ type = real kind = kind_phys intent = in -[iopt_flx_over_ocn] +[icplocn2atm] standard_name = flag_for_air_sea_flux_computation_over_water long_name = air-sea flux option units = flag diff --git a/physics/sfc_diag.f b/physics/sfc_diag.f index 5acda6181..1fa7fa450 100644 --- a/physics/sfc_diag.f +++ b/physics/sfc_diag.f @@ -17,7 +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, & - & ssu,ssv,iopt_flx_over_ocn, & + & ssu,ssv,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,7 +31,7 @@ subroutine sfc_diag_run (im,xlat_d,xlon_d, & implicit none ! integer, intent(in) :: im, lsm, lsm_ruc, iopt_lake, iopt_lake_clm - integer, intent(in) :: iopt_flx_over_ocn + integer, intent(in) :: icplocn2atm logical, intent(in) :: use_lake2m logical, intent(in) :: thsfc_loc ! Flag for reference pot. temp. logical, intent(in) :: diag_flux ! Flag for flux method in 2-m diagnostics @@ -70,26 +70,11 @@ subroutine sfc_diag_run (im,xlat_d,xlon_d, & ! real(kind=kind_phys) sig2k, fhi, qss ! ! real, parameter :: g=grav - integer ii - real(kind=kind_phys) :: ssumax, ssvmax - logical :: check_ssu_ssv ! ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - check_ssu_ssv=.false. - if(check_ssu_ssv .and. iopt_flx_over_ocn ==1) then - ssumax=0.0 - ssvmax=0.0 - do ii=1,im - if(ssu(ii) .gt. ssumax) ssumax=ssu(ii) - if(ssv(ii) .gt. ssvmax) ssvmax=ssv(ii) - enddo - print*, 'in sfc_diag ssumax ssvmax=', ssumax, ssvmax - print*, 'in sfc_diag iopt_flx_over_ocn=', iopt_flx_over_ocn - endif - !-- testptlat = 35.3_kind_phys testptlon = 273.0_kind_phys @@ -107,7 +92,7 @@ subroutine sfc_diag_run (im,xlat_d,xlon_d, & do i = 1, im f10m(i) = fm10(i) / fm(i) - if(iopt_flx_over_ocn ==1) then + if(icplocn2atm ==1) then u10m(i) = ssu(i) + f10m(i) * (u1(i)-ssu(i)) v10m(i) = ssv(i) + f10m(i) * (v1(i)-ssv(i)) else diff --git a/physics/sfc_diag.meta b/physics/sfc_diag.meta index 834ad5871..da300d053 100644 --- a/physics/sfc_diag.meta +++ b/physics/sfc_diag.meta @@ -139,7 +139,7 @@ type = real kind = kind_phys intent = in -[iopt_flx_over_ocn] +[icplocn2atm] standard_name = flag_for_air_sea_flux_computation_over_water long_name = air-sea flux option units = flag diff --git a/physics/sfc_diff.f b/physics/sfc_diff.f index 62102151a..9c00b7040 100644 --- a/physics/sfc_diff.f +++ b/physics/sfc_diff.f @@ -61,7 +61,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) & z0pert,ztpert, & ! mg, sfc-perts !intent(in) & flag_iter,redrag, & !intent(in) & u10m,v10m,sfc_z0_type, & !hafs,z0 type !intent(in) - & u1,v1,ssu,ssv,iopt_flx_over_ocn, & + & u1,v1,ssu,ssv,icplocn2atm, & & wet,dry,icy, & !intent(in) & thsfc_loc, & !intent(in) & tskin_wat, tskin_lnd, tskin_ice, & !intent(in) @@ -86,7 +86,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) :: iopt_flx_over_ocn ! option for including ocean current in the computation of flux + integer, intent(in) :: icplocn2atm ! option for including ocean current in the computation of flux integer, dimension(:), intent(in) :: vegtype @@ -128,10 +128,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! locals ! integer i - integer ii - real(kind=kind_phys) :: ssumax, ssvmax real(kind=kind_phys), dimension(im) :: windrel, wind10m - logical :: check_ssu_ssv ! real(kind=kind_phys) :: rat, tv1, thv1, restar, & czilc, tem1, tem2, virtfac @@ -176,17 +173,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! write(0,*)'in sfc_diff, sfc_z0_type=',sfc_z0_type - check_ssu_ssv=.false. - if(check_ssu_ssv .and. iopt_flx_over_ocn == 1) then - ssumax=0.0 - ssvmax=0.0 - do ii=1,im - if(ssu(ii) .gt. ssumax) ssumax=ssu(ii) - if(ssv(ii) .gt. ssvmax) ssvmax=ssv(ii) - enddo - print*, 'in sfc_diff ssumax,ssvmax =',ssumax,ssvmax - print*, 'in sfc_diff iopt_flx_over_ocn =',iopt_flx_over_ocn - print*, 'in sfc_diff wind(1),u1(1),v1(1) =',wind(1),u1(1),v1(1) + if(icplocn2atm == 1) then do i=1,im windrel(i)=sqrt( (u1(i)-ssu(i))**2 + (v1(i)-ssv(i))**2 ) wind10m(i)= sqrt( (u10m(i)-ssu(i))**2 + (v10m(i)-ssv(i))**2 ) diff --git a/physics/sfc_diff.meta b/physics/sfc_diff.meta index 360c2a0c8..1233e17af 100644 --- a/physics/sfc_diff.meta +++ b/physics/sfc_diff.meta @@ -249,7 +249,7 @@ dimensions = () type = integer intent = in -[iopt_flx_over_ocn] +[icplocn2atm] standard_name = flag_for_air_sea_flux_computation_over_water long_name = air-sea flux option units = flag diff --git a/physics/sfc_nst.meta b/physics/sfc_nst.meta index eb5a2d379..7504b9d49 100644 --- a/physics/sfc_nst.meta +++ b/physics/sfc_nst.meta @@ -150,7 +150,7 @@ type = real kind = kind_phys intent = in -[iopt_flx_over_ocn] +[icplocn2atm] standard_name = flag_for_air_sea_flux_computation_over_water long_name = air-sea flux option units = flag diff --git a/physics/sfc_ocean.F b/physics/sfc_ocean.F index 27e309eca..cde28072a 100644 --- a/physics/sfc_ocean.F +++ b/physics/sfc_ocean.F @@ -25,7 +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, & - & ssu, ssv, iopt_flx_over_ocn, & + & ssu, ssv, 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 @@ -40,7 +40,7 @@ subroutine sfc_ocean_run & ! call sfc_ocean ! ! inputs: ! ! ( im, ps, u1, v1, t1, q1, tskin, cm, ch, lseaspray, fm, fm10, ! -! ssu, ssv, iopt_flx_over_ocn, ! +! ssu, ssv, icplocn2atm, ! ! prsl1, prslki, wet, use_lake_model, wind, flag_iter, ! ! use_med_flux, ! ! outputs: ! @@ -69,7 +69,7 @@ subroutine sfc_ocean_run & ! ps - real, surface pressure im ! ! u1, v1 - real, u/v component of surface layer wind (m/s) im ! ! ssu,ssv - real, u/v component of surface ocean current (m/s) im ! -! iopt_flx_over_ocn - integer, option for including 1 ! +! icplocn2atm - integer, option for including 1 ! ! ocean current in the computation of flux ! ! t1 - real, surface layer mean temperature ( k ) im ! ! q1 - real, surface layer mean specific humidity im ! @@ -110,7 +110,7 @@ subroutine sfc_ocean_run & & zero = 0.0_kind_phys, qmin = 1.0e-8_kind_phys ! --- inputs: integer, intent(in) :: im - integer, intent(in) :: iopt_flx_over_ocn + integer, intent(in) :: icplocn2atm real (kind=kind_phys), intent(in) :: hvap, cp, rd, & & eps, epsm1, rvrdm1 @@ -144,9 +144,6 @@ subroutine sfc_ocean_run & real (kind=kind_phys), dimension(im) :: rho, q0 integer :: i - real (kind=kind_phys) :: ssumax,ssvmax - !logical,save :: check_ssu_ssv=.true. - logical :: check_ssu_ssv logical :: flag(im) ! @@ -167,18 +164,8 @@ subroutine sfc_ocean_run & ! -- ... initialize CCPP error handling variables errmsg = '' errflg = 0 - check_ssu_ssv=.false. - if(check_ssu_ssv .and. iopt_flx_over_ocn == 1) then - ssumax=0.0 - ssvmax=0.0 - do i=1,im - if(ssu(i) .gt. ssumax) ssumax=ssu(i) - if(ssv(i) .gt. ssvmax) ssvmax=ssv(i) - enddo - print *, 'in sfc_ocean ssumax,ssvmax',ssumax,ssvmax - print *, 'in sfc_ocean iopt_flx_over_ocn',iopt_flx_over_ocn - endif - if(iopt_flx_over_ocn == 1) then + + if(icplocn2atm == 1) then do i=1,im windrel(i) = sqrt((u1(i)-ssu(i))**2 + (v1(i)-ssv(i))**2) enddo diff --git a/physics/sfc_ocean.meta b/physics/sfc_ocean.meta index f99d74773..dbb9c9131 100644 --- a/physics/sfc_ocean.meta +++ b/physics/sfc_ocean.meta @@ -102,7 +102,7 @@ type = real kind = kind_phys intent = in -[iopt_flx_over_ocn] +[icplocn2atm] standard_name = flag_for_air_sea_flux_computation_over_water long_name = air-sea flux option units = flag diff --git a/physics/zzz b/physics/zzz deleted file mode 100755 index e9bd2da01..000000000 --- a/physics/zzz +++ /dev/null @@ -1,12 +0,0 @@ -#!/bin/sh -export src1=/scratch1/NCEPDEV/stmp4/Bin.Li/20231201/ufs-weather-model/FV3/ccpp/physics/physics -cp $src1/satmedmfvdifq.F . -cp $src1/satmedmfvdifq.meta . -cp $src1/sfc_diff.f . -cp $src1/sfc_diff.meta . -cp $src1/sfc_diag.f . -cp $src1/sfc_diag.meta . -cp $src1/sfc_nst.f . -cp $src1/sfc_nst.meta . -cp $src1/sfc_ocean.F . -cp $src1/sfc_ocean.meta . From a799bc5d54d6cf3f6503d7214f0cbffc336bc5fb Mon Sep 17 00:00:00 2001 From: "Bin.Li" Date: Tue, 19 Dec 2023 14:46:51 +0000 Subject: [PATCH 08/21] Revise the following files for the computation of air-sea fluxes. --- physics/satmedmfvdifq.F | 12 +++---- physics/sfc_diag.f | 12 +++---- physics/sfc_diff.f | 77 +++++++++++++++++++++++------------------ physics/sfc_nst.f90 | 24 ++++++------- physics/sfc_ocean.F | 51 +++++++++++++++------------ 5 files changed, 95 insertions(+), 81 deletions(-) diff --git a/physics/satmedmfvdifq.F b/physics/satmedmfvdifq.F index 55667d515..24c12aa8b 100644 --- a/physics/satmedmfvdifq.F +++ b/physics/satmedmfvdifq.F @@ -144,7 +144,7 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & !---------------------------------------------------------------------- !*** !*** local variables - real(kind=kind_phys) spd1_m(im) + real(kind=kind_phys) spd1_m !*** integer i,is,k,n,ndt,km1,kmpbl,kmscu,ntrac1,idtend integer kps,kbx,kmx @@ -2379,13 +2379,13 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & enddo enddo do i = 1,im - if(icplocn2atm == 1) then - spd1_m(i)=sqrt( (u1(i,1)-ssu(i))**2+(v1(i,1)-ssv(i))**2 ) - dusfc(i) = -1.*rho_a(i)*stress(i)*(u1(i,1)-ssu(i))/spd1_m(i) - dvsfc(i) = -1.*rho_a(i)*stress(i)*(v1(i,1)-ssv(i))/spd1_m(i) - else + 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 + spd1_m=sqrt( (u1(i,1)-ssu(i))**2+(v1(i,1)-ssv(i))**2 ) + dusfc(i) = -1.*rho_a(i)*stress(i)*(u1(i,1)-ssu(i))/spd1_m + dvsfc(i) = -1.*rho_a(i)*stress(i)*(v1(i,1)-ssv(i))/spd1_m endif enddo ! diff --git a/physics/sfc_diag.f b/physics/sfc_diag.f index 1fa7fa450..183da8b0e 100644 --- a/physics/sfc_diag.f +++ b/physics/sfc_diag.f @@ -31,8 +31,8 @@ subroutine sfc_diag_run (im,xlat_d,xlon_d, & implicit none ! integer, intent(in) :: im, lsm, lsm_ruc, iopt_lake, iopt_lake_clm - integer, intent(in) :: icplocn2atm 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 @@ -74,7 +74,7 @@ subroutine sfc_diag_run (im,xlat_d,xlon_d, & ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - + !-- testptlat = 35.3_kind_phys testptlon = 273.0_kind_phys @@ -92,12 +92,12 @@ subroutine sfc_diag_run (im,xlat_d,xlon_d, & do i = 1, im f10m(i) = fm10(i) / fm(i) - if(icplocn2atm ==1) then - u10m(i) = ssu(i) + f10m(i) * (u1(i)-ssu(i)) - v10m(i) = ssv(i) + f10m(i) * (v1(i)-ssv(i)) - else + if(icplocn2atm ==0) then u10m(i) = f10m(i) * u1(i) v10m(i) = f10m(i) * v1(i) + else + u10m(i) = ssu(i)+f10m(i) * (u1(i)-ssu(i)) + v10m(i) = ssv(i)+f10m(i) * (v1(i)-ssv(i)) endif have_2m = use_lake_model(i)>0 .and. use_lake2m .and. & & iopt_lake==iopt_lake_clm diff --git a/physics/sfc_diff.f b/physics/sfc_diff.f index 9c00b7040..1b801aa7a 100644 --- a/physics/sfc_diff.f +++ b/physics/sfc_diff.f @@ -128,9 +128,9 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! locals ! integer i - real(kind=kind_phys), dimension(im) :: windrel, wind10m + real(kind=kind_phys) :: windrel ! - real(kind=kind_phys) :: rat, tv1, thv1, restar, + real(kind=kind_phys) :: rat, tv1, thv1, restar, wind10m, & czilc, tem1, tem2, virtfac ! @@ -170,21 +170,6 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! surface roughness length is converted to m from cm ! -! write(0,*)'in sfc_diff, sfc_z0_type=',sfc_z0_type - - - if(icplocn2atm == 1) then - do i=1,im - windrel(i)=sqrt( (u1(i)-ssu(i))**2 + (v1(i)-ssv(i))**2 ) - wind10m(i)= sqrt( (u10m(i)-ssu(i))**2 + (v10m(i)-ssv(i))**2 ) - enddo - else - do i=1,im - wind10m(i)= sqrt( u10m(i)**2 + v10m(i)**2 ) - windrel(i)=wind(i) - enddo - endif - do i=1,im if(flag_iter(i)) then @@ -290,13 +275,24 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) tem2 = max(sigmaf(i), 0.1_kp) zvfun(i) = sqrt(tem1 * tem2) ! - call stability + if(icplocn2atm == 0) then + call stability +! --- inputs: + & (z1(i), zvfun(i), gdx, tv1, thv1, wind(i), + & z0max, ztmax_lnd(i), tvs, grav, thsfc_loc, +! --- outputs: + & rb_lnd(i), fm_lnd(i), fh_lnd(i), fm10_lnd(i), fh2_lnd(i), + & cm_lnd(i), ch_lnd(i), stress_lnd(i), ustar_lnd(i)) + else + windrel=sqrt( (u1(i)-ssu(i))**2 + (v1(i)-ssv(i))**2 ) + call stability ! --- inputs: - & (z1(i), zvfun(i), gdx, tv1, thv1, windrel(i), - & z0max, ztmax_lnd(i), tvs, grav, thsfc_loc, + & (z1(i), zvfun(i), gdx, tv1, thv1, windrel, + & z0max, ztmax_lnd(i), tvs, grav, thsfc_loc, ! --- outputs: - & rb_lnd(i), fm_lnd(i), fh_lnd(i), fm10_lnd(i), fh2_lnd(i), - & cm_lnd(i), ch_lnd(i), stress_lnd(i), ustar_lnd(i)) + & rb_lnd(i), fm_lnd(i), fh_lnd(i), fm10_lnd(i), fh2_lnd(i), + & cm_lnd(i), ch_lnd(i), stress_lnd(i), ustar_lnd(i)) + endif endif ! Dry points if (icy(i)) then ! Some ice @@ -344,13 +340,23 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! ztmax_ice(i) = max(ztmax_ice(i), 1.0e-6) ! - call stability + if(icplocn2atm == 0) then + call stability +! --- inputs: + & (z1(i), zvfun(i), gdx, tv1, thv1, wind(i), + & z0max, ztmax_ice(i), tvs, grav, thsfc_loc, +! --- outputs: + & rb_ice(i), fm_ice(i), fh_ice(i), fm10_ice(i), fh2_ice(i), + & cm_ice(i), ch_ice(i), stress_ice(i), ustar_ice(i)) + else + call stability ! --- inputs: - & (z1(i), zvfun(i), gdx, tv1, thv1, windrel(i), - & z0max, ztmax_ice(i), tvs, grav, thsfc_loc, + & (z1(i), zvfun(i), gdx, tv1, thv1, windrel, + & z0max, ztmax_ice(i), tvs, grav, thsfc_loc, ! --- outputs: - & rb_ice(i), fm_ice(i), fh_ice(i), fm10_ice(i), fh2_ice(i), - & cm_ice(i), ch_ice(i), stress_ice(i), ustar_ice(i)) + & rb_ice(i), fm_ice(i), fh_ice(i), fm10_ice(i), fh2_ice(i), + & cm_ice(i), ch_ice(i), stress_ice(i), ustar_ice(i)) + endif endif ! Icy points ! BWG: Everything from here to end of subroutine was after @@ -370,7 +376,11 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) z0 = 0.01_kp * z0rl_wat(i) z0max = max(zmin, min(z0,z1(i))) ! ustar_wat(i) = sqrt(grav * z0 / charnock) -! wind10m = sqrt(u10m(i)*u10m(i) + v10m(i)*v10m(i)) + if(icplocn2atm == 0) then + wind10m=sqrt(u10m(i)*u10m(i) + v10m(i)*v10m(i)) + else + wind10m=sqrt((u10m(i)-ssu(i))**2 + (v10m(i)-ssv(i))**2) + endif !** test xubin's new z0 @@ -389,9 +399,9 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ztmax_wat(i) = max(z0max * exp(-rat), zmin) ! if (sfc_z0_type == 6) then - call znot_t_v6(wind10m(i), ztmax_wat(i)) ! 10-m wind,m/s, ztmax(m) + call znot_t_v6(wind10m, ztmax_wat(i)) ! 10-m wind,m/s, ztmax(m) else if (sfc_z0_type == 7) then - call znot_t_v7(wind10m(i), ztmax_wat(i)) ! 10-m wind,m/s, ztmax(m) + call znot_t_v7(wind10m, ztmax_wat(i)) ! 10-m wind,m/s, ztmax(m) else if (sfc_z0_type > 0) then write(0,*)'no option for sfc_z0_type=',sfc_z0_type errflg = 1 @@ -401,7 +411,8 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! call stability ! --- inputs: - & (z1(i), zvfun(i), gdx, tv1, thv1, windrel(i), +! & (z1(i), zvfun(i), gdx, tv1, thv1, windrel(i), + & (z1(i), zvfun(i), gdx, tv1, thv1, wind(i), & z0max, ztmax_wat(i), tvs, grav, thsfc_loc, ! --- outputs: & rb_wat(i), fm_wat(i), fh_wat(i), fm10_wat(i), fh2_wat(i), @@ -432,10 +443,10 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) endif elseif (sfc_z0_type == 6) then ! wang - call znot_m_v6(wind10m(i), z0) ! wind, m/s, z0, m + call znot_m_v6(wind10m, z0) ! wind, m/s, z0, m z0rl_wat(i) = 100.0_kp * z0 ! cm elseif (sfc_z0_type == 7) then ! wang - call znot_m_v7(wind10m(i), z0) ! wind, m/s, z0, m + call znot_m_v7(wind10m, z0) ! wind, m/s, z0, m z0rl_wat(i) = 100.0_kp * z0 ! cm else z0rl_wat(i) = 1.0e-4_kp diff --git a/physics/sfc_nst.f90 b/physics/sfc_nst.f90 index 3b5229ba4..1844a1077 100644 --- a/physics/sfc_nst.f90 +++ b/physics/sfc_nst.f90 @@ -240,21 +240,12 @@ 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(im) + real (kind=kind_phys) :: windrel ! !====================================================================================================== ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - if(icplocn2atm ==1) then - do i=1,im - windrel(i) = sqrt( (u1(i)-ssu(i))**2 + (v1(i)-ssv(i))**2 ) - enddo - else - do i=1,im - windrel(i) = wind(i) - enddo - endif if (nstf_name1 == 0) return ! No NSST model used @@ -326,9 +317,16 @@ subroutine sfc_nst_run & ! --- ... rcp = rho cp ch v - rch(i) = rho_a(i) * cp * ch(i) * windrel(i) - cmm(i) = cm (i) * windrel(i) - chh(i) = rho_a(i) * ch(i) * windrel(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 + windrel= sqrt( (u1(i)-ssu(i))**2 + (v1(i)-ssv(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_ocean.F b/physics/sfc_ocean.F index cde28072a..d8b33f3dc 100644 --- a/physics/sfc_ocean.F +++ b/physics/sfc_ocean.F @@ -40,7 +40,7 @@ subroutine sfc_ocean_run & ! call sfc_ocean ! ! inputs: ! ! ( im, ps, u1, v1, t1, q1, tskin, cm, ch, lseaspray, fm, fm10, ! -! ssu, ssv, icplocn2atm, ! +! ssu, ssv, icplocn2atm, ! ! prsl1, prslki, wet, use_lake_model, wind, flag_iter, ! ! use_med_flux, ! ! outputs: ! @@ -69,8 +69,8 @@ subroutine sfc_ocean_run & ! ps - real, surface pressure im ! ! u1, v1 - real, u/v component of surface layer wind (m/s) im ! ! ssu,ssv - real, u/v component of surface ocean current (m/s) im ! -! icplocn2atm - integer, option for including 1 ! -! ocean current in the computation of flux ! +! icplocn2atm - integrt, =1 if ssu and ssv 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 ! @@ -110,19 +110,18 @@ subroutine sfc_ocean_run & & zero = 0.0_kind_phys, qmin = 1.0e-8_kind_phys ! --- inputs: integer, intent(in) :: im - integer, intent(in) :: icplocn2atm 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, ssu, & - & ssv + & t1, q1, tskin, cm, ch, fm, fm10, prsl1, prslki, wind, ssu,ssv ! 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 @@ -140,8 +139,9 @@ subroutine sfc_ocean_run & ! --- locals: real (kind=kind_phys) :: qss, rch, tem, - & elocp, cpinv, hvapi, windrel(im) + & elocp, cpinv, hvapi real (kind=kind_phys), dimension(im) :: rho, q0 + real (kind=kind_phys), dimension(im) :: windrel integer :: i @@ -165,16 +165,6 @@ subroutine sfc_ocean_run & errmsg = '' errflg = 0 - if(icplocn2atm == 1) then - do i=1,im - windrel(i) = sqrt((u1(i)-ssu(i))**2 + (v1(i)-ssv(i))**2) - enddo - else - do i=1,im - windrel(i) = wind(i) - enddo - endif - cpinv = one/cp hvapi = one/hvap elocp = hvap/cp @@ -187,12 +177,21 @@ subroutine sfc_ocean_run & ! rho is density, qss is sat. hum. at surface if ( flag(i) ) then + if (icplocn2atm == 1) then + windrel(i)=sqrt( (u1(i)-ssu(i))**2+(v1(i)-ssv(i))**2 ) + endif + 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) * windrel(i) - cmm(i) = cm(i) * windrel(i) + + if (icplocn2atm == 0) then + tem = ch(i) * wind(i) + cmm(i) = cm(i) * wind(i) + else + tem = ch(i) * windrel(i) + cmm(i) = cm(i) * windrel(i) + endif chh(i) = rho(i) * tem hflx(i) = dtsfc_med(i) @@ -209,9 +208,15 @@ subroutine sfc_ocean_run & ! --- ... rcp = rho cp ch v - rch = rho(i) * cp * ch(i) * windrel(i) - tem = ch(i) * windrel(i) - cmm(i) = cm(i) * windrel(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 + 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 From a5ac3f5289e0c9ad700b65e35483f0592224fa70 Mon Sep 17 00:00:00 2001 From: "Bin.Li" Date: Tue, 26 Dec 2023 15:12:24 +0000 Subject: [PATCH 09/21] Updated sfc_diff.f to add the option to check the surface ocean current. --- physics/sfc_diff.f | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/physics/sfc_diff.f b/physics/sfc_diff.f index 1b801aa7a..9c143218e 100644 --- a/physics/sfc_diff.f +++ b/physics/sfc_diff.f @@ -126,6 +126,8 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) integer, intent(out) :: errflg ! ! locals + real(kind=kind_phys) :: ssumax, ssvmax + logical :: check_ssu_ssv ! integer i real(kind=kind_phys) :: windrel @@ -169,6 +171,18 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! ps is in pascals, wind is wind speed, ! surface roughness length is converted to m from cm ! + + check_ssu_ssv=.false. + if(check_ssu_ssv) then + ssumax=0.0 + ssvmax=0.0 + do i=1,im + if(ssu(i) .gt. ssumax) ssumax=ssu(i) + if(ssv(i) .gt. ssvmax) ssvmax=ssv(i) + enddo + print*, 'in sfc_diff ssumax,ssvmax im =',ssumax,ssvmax,im + print*, 'in sfc_diff wind(1),u1(1),v1(1) =',wind(1),u1(1),v1(1) + endif do i=1,im if(flag_iter(i)) then From 094860f48799e6e5737cbf1ab147770a34783629 Mon Sep 17 00:00:00 2001 From: "Bin.Li" Date: Wed, 27 Dec 2023 12:06:32 +0000 Subject: [PATCH 10/21] update sfc_diff.f --- physics/sfc_diff.f | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/sfc_diff.f b/physics/sfc_diff.f index 9c143218e..2f392919a 100644 --- a/physics/sfc_diff.f +++ b/physics/sfc_diff.f @@ -180,8 +180,8 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) if(ssu(i) .gt. ssumax) ssumax=ssu(i) if(ssv(i) .gt. ssvmax) ssvmax=ssv(i) enddo - print*, 'in sfc_diff ssumax,ssvmax im =',ssumax,ssvmax,im - print*, 'in sfc_diff wind(1),u1(1),v1(1) =',wind(1),u1(1),v1(1) + print*, 'sfc_diff ssumax,ssvmax im:',ssumax,ssvmax,im + print*, 'sfc_diff wind(1),u1(1):',wind(1),u1(1) endif do i=1,im From 19cad16dc1cf05626ef2df9fde8f47b0cf3070c1 Mon Sep 17 00:00:00 2001 From: "Bin.Li" Date: Sat, 30 Dec 2023 09:04:51 +0000 Subject: [PATCH 11/21] Update the following files: satmedmfvdif.F satmedmfvdif.meta satmedmfvdifq.F sfc_diag.f sfc_diff.f sfc_nst.f90 sfc_ocean.F --- physics/satmedmfvdif.F | 17 +---------------- physics/satmedmfvdif.meta | 16 ---------------- physics/satmedmfvdifq.F | 2 +- physics/sfc_diag.f | 4 ++-- physics/sfc_diff.f | 38 ++++++++++---------------------------- physics/sfc_nst.f90 | 4 ++-- physics/sfc_ocean.F | 9 ++++----- 7 files changed, 20 insertions(+), 70 deletions(-) diff --git a/physics/satmedmfvdif.F b/physics/satmedmfvdif.F index cc7ce95b3..79f7bbea1 100644 --- a/physics/satmedmfvdif.F +++ b/physics/satmedmfvdif.F @@ -63,7 +63,7 @@ end subroutine satmedmfvdif_init !> @{ subroutine satmedmfvdif_run(im,km,ntrac,ntcw,ntiw,ntke, & & grav,rd,cp,rv,hvap,hfus,fv,eps,epsm1, & - & dv,du,tdt,rtg,u1,v1,ssu,ssv,t1,q1,swh,hlw,xmu,garea, & + & dv,du,tdt,rtg,u1,v1,t1,q1,swh,hlw,xmu,garea, & & psk,rbsoil,zorl,u10m,v10m,fm,fh, & & tsea,heat,evap,stress,spd1,kpbl, & & prsi,del,prsl,prslk,phii,phil,delt, & @@ -95,7 +95,6 @@ subroutine satmedmfvdif_run(im,km,ntrac,ntcw,ntiw,ntke, & & tdt(:,:), rtg(:,:,:) real(kind=kind_phys), intent(in) :: & & u1(:,:), v1(:,:), & - & ssu(:), ssv(:), & & t1(:,:), q1(:,:,:), & & swh(:,:), hlw(:,:), & & xmu(:), garea(:), & @@ -218,9 +217,6 @@ subroutine satmedmfvdif_run(im,km,ntrac,ntcw,ntiw,ntke, & ! real(kind=kind_phys) h1 integer :: idtend - integer ii - real(kind=kind_phys) :: ssumax, ssvmax - logical :: check_ssu_ssv !! parameter(wfac=7.0,cfac=4.5) parameter(gamcrt=3.,gamcrq=0.,sfcfrac=0.1) @@ -254,17 +250,6 @@ subroutine satmedmfvdif_run(im,km,ntrac,ntcw,ntiw,ntke, & ! Initialize CCPP error handling variables errmsg = '' errflg = 0 -! - check_ssu_ssv=.false. - if(check_ssu_ssv) then - ssumax=0.0 - ssvmax=0.0 - do ii=1,im - if(ssu(ii) .gt. ssumax) ssumax=ssu(ii) - if(ssv(ii) .gt. ssvmax) ssvmax=ssv(ii) - enddo - print*, 'in satmedmfvdif.F ssumax,ssvmax =',ssumax,ssvmax - endif !> -# Compute preliminary variables from input arguments dt2 = delt diff --git a/physics/satmedmfvdif.meta b/physics/satmedmfvdif.meta index 522ce543b..3609ed50f 100644 --- a/physics/satmedmfvdif.meta +++ b/physics/satmedmfvdif.meta @@ -211,22 +211,6 @@ type = real kind = kind_phys intent = in -[ssu] - standard_name = ocn_current_zonal - long_name = ocn_current_zonal - units = m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[ssv] - standard_name = ocn_current_merid - long_name = ocn_current_merid - units = m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in [t1] standard_name = air_temperature long_name = layer mean air temperature diff --git a/physics/satmedmfvdifq.F b/physics/satmedmfvdifq.F index 24c12aa8b..90cba0553 100644 --- a/physics/satmedmfvdifq.F +++ b/physics/satmedmfvdifq.F @@ -2382,7 +2382,7 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & 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 + else if (icplocn2atm ==1) then spd1_m=sqrt( (u1(i,1)-ssu(i))**2+(v1(i,1)-ssv(i))**2 ) dusfc(i) = -1.*rho_a(i)*stress(i)*(u1(i,1)-ssu(i))/spd1_m dvsfc(i) = -1.*rho_a(i)*stress(i)*(v1(i,1)-ssv(i))/spd1_m diff --git a/physics/sfc_diag.f b/physics/sfc_diag.f index 183da8b0e..bdc96ade6 100644 --- a/physics/sfc_diag.f +++ b/physics/sfc_diag.f @@ -92,10 +92,10 @@ subroutine sfc_diag_run (im,xlat_d,xlon_d, & do i = 1, im f10m(i) = fm10(i) / fm(i) - if(icplocn2atm ==0) then + if (icplocn2atm ==0) then u10m(i) = f10m(i) * u1(i) v10m(i) = f10m(i) * v1(i) - else + else if (icplocn2atm ==1) then u10m(i) = ssu(i)+f10m(i) * (u1(i)-ssu(i)) v10m(i) = ssv(i)+f10m(i) * (v1(i)-ssv(i)) endif diff --git a/physics/sfc_diff.f b/physics/sfc_diff.f index 2f392919a..0c9bc5275 100644 --- a/physics/sfc_diff.f +++ b/physics/sfc_diff.f @@ -167,11 +167,13 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) errmsg = '' errflg = 0 + ! initialize variables. all units are supposedly m.k.s. unless specified ! ps is in pascals, wind is wind speed, ! surface roughness length is converted to m from cm ! - +! write(0,*)'in sfc_diff, sfc_z0_type=',sfc_z0_type + check_ssu_ssv=.false. if(check_ssu_ssv) then ssumax=0.0 @@ -289,24 +291,13 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) tem2 = max(sigmaf(i), 0.1_kp) zvfun(i) = sqrt(tem1 * tem2) ! - if(icplocn2atm == 0) then - call stability + call stability ! --- inputs: & (z1(i), zvfun(i), gdx, tv1, thv1, wind(i), & z0max, ztmax_lnd(i), tvs, grav, thsfc_loc, ! --- outputs: & rb_lnd(i), fm_lnd(i), fh_lnd(i), fm10_lnd(i), fh2_lnd(i), & cm_lnd(i), ch_lnd(i), stress_lnd(i), ustar_lnd(i)) - else - windrel=sqrt( (u1(i)-ssu(i))**2 + (v1(i)-ssv(i))**2 ) - call stability -! --- inputs: - & (z1(i), zvfun(i), gdx, tv1, thv1, windrel, - & z0max, ztmax_lnd(i), tvs, grav, thsfc_loc, -! --- outputs: - & rb_lnd(i), fm_lnd(i), fh_lnd(i), fm10_lnd(i), fh2_lnd(i), - & cm_lnd(i), ch_lnd(i), stress_lnd(i), ustar_lnd(i)) - endif endif ! Dry points if (icy(i)) then ! Some ice @@ -354,23 +345,13 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! ztmax_ice(i) = max(ztmax_ice(i), 1.0e-6) ! - if(icplocn2atm == 0) then - call stability + call stability ! --- inputs: & (z1(i), zvfun(i), gdx, tv1, thv1, wind(i), & z0max, ztmax_ice(i), tvs, grav, thsfc_loc, ! --- outputs: & rb_ice(i), fm_ice(i), fh_ice(i), fm10_ice(i), fh2_ice(i), & cm_ice(i), ch_ice(i), stress_ice(i), ustar_ice(i)) - else - call stability -! --- inputs: - & (z1(i), zvfun(i), gdx, tv1, thv1, windrel, - & z0max, ztmax_ice(i), tvs, grav, thsfc_loc, -! --- outputs: - & rb_ice(i), fm_ice(i), fh_ice(i), fm10_ice(i), fh2_ice(i), - & cm_ice(i), ch_ice(i), stress_ice(i), ustar_ice(i)) - endif endif ! Icy points ! BWG: Everything from here to end of subroutine was after @@ -390,10 +371,12 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) z0 = 0.01_kp * z0rl_wat(i) z0max = max(zmin, min(z0,z1(i))) ! ustar_wat(i) = sqrt(grav * z0 / charnock) - if(icplocn2atm == 0) then + if (icplocn2atm == 0) then wind10m=sqrt(u10m(i)*u10m(i) + v10m(i)*v10m(i)) - else + windrel=wind(i) + else if (icplocn2atm ==1) then wind10m=sqrt((u10m(i)-ssu(i))**2 + (v10m(i)-ssv(i))**2) + windrel=sqrt( (u1(i)-ssu(i))**2 + (v1(i)-ssv(i))**2 ) endif !** test xubin's new z0 @@ -425,8 +408,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! call stability ! --- inputs: -! & (z1(i), zvfun(i), gdx, tv1, thv1, windrel(i), - & (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_nst.f90 b/physics/sfc_nst.f90 index 1844a1077..06d2b061b 100644 --- a/physics/sfc_nst.f90 +++ b/physics/sfc_nst.f90 @@ -317,11 +317,11 @@ subroutine sfc_nst_run & ! --- ... rcp = rho cp ch v - if(icplocn2atm ==0) then + 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 + else if (icplocn2atm ==1) then windrel= sqrt( (u1(i)-ssu(i))**2 + (v1(i)-ssv(i))**2 ) rch(i) = rho_a(i) * cp * ch(i) * windrel cmm(i) = cm (i) * windrel diff --git a/physics/sfc_ocean.F b/physics/sfc_ocean.F index d8b33f3dc..0d1ebc2cd 100644 --- a/physics/sfc_ocean.F +++ b/physics/sfc_ocean.F @@ -177,9 +177,6 @@ subroutine sfc_ocean_run & ! rho is density, qss is sat. hum. at surface if ( flag(i) ) then - if (icplocn2atm == 1) then - windrel(i)=sqrt( (u1(i)-ssu(i))**2+(v1(i)-ssv(i))**2 ) - endif if (use_med_flux) then q0(i) = max( q1(i), qmin ) @@ -188,7 +185,8 @@ subroutine sfc_ocean_run & if (icplocn2atm == 0) then tem = ch(i) * wind(i) cmm(i) = cm(i) * wind(i) - else + else if (icplocn2atm ==1) then + windrel(i)=sqrt( (u1(i)-ssu(i))**2+(v1(i)-ssv(i))**2 ) tem = ch(i) * windrel(i) cmm(i) = cm(i) * windrel(i) endif @@ -212,7 +210,8 @@ subroutine sfc_ocean_run & rch = rho(i) * cp * ch(i) * wind(i) tem = ch(i) * wind(i) cmm(i) = cm(i) * wind(i) - else + else if (icplocn2atm ==1) then + windrel(i)=sqrt( (u1(i)-ssu(i))**2+(v1(i)-ssv(i))**2 ) rch = rho(i) * cp * ch(i) * windrel(i) tem = ch(i) * windrel(i) cmm(i) = cm(i) * windrel(i) From e8eaaf9c1f328bd2ef4f03d1831885b858f305e4 Mon Sep 17 00:00:00 2001 From: "Bin.Li" Date: Wed, 3 Jan 2024 10:48:38 +0000 Subject: [PATCH 12/21] Code cleanup --- physics/sfc_diff.f | 14 -------------- 1 file changed, 14 deletions(-) diff --git a/physics/sfc_diff.f b/physics/sfc_diff.f index 0c9bc5275..1976ab5c2 100644 --- a/physics/sfc_diff.f +++ b/physics/sfc_diff.f @@ -126,8 +126,6 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) integer, intent(out) :: errflg ! ! locals - real(kind=kind_phys) :: ssumax, ssvmax - logical :: check_ssu_ssv ! integer i real(kind=kind_phys) :: windrel @@ -174,18 +172,6 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! ! write(0,*)'in sfc_diff, sfc_z0_type=',sfc_z0_type - check_ssu_ssv=.false. - if(check_ssu_ssv) then - ssumax=0.0 - ssvmax=0.0 - do i=1,im - if(ssu(i) .gt. ssumax) ssumax=ssu(i) - if(ssv(i) .gt. ssvmax) ssvmax=ssv(i) - enddo - print*, 'sfc_diff ssumax,ssvmax im:',ssumax,ssvmax,im - print*, 'sfc_diff wind(1),u1(1):',wind(1),u1(1) - endif - do i=1,im if(flag_iter(i)) then From f80f52f250d60b311783fe3a317ef14cd93fab22 Mon Sep 17 00:00:00 2001 From: "Bin.Li" Date: Fri, 5 Jan 2024 08:59:25 +0000 Subject: [PATCH 13/21] Change the variable name for zonal ocean current from ssu to usfco. Change the variable name for meridional ocean current from ssv to vsfco. --- physics/satmedmfvdifq.F | 10 +++++----- physics/satmedmfvdifq.meta | 4 ++-- physics/sfc_diag.f | 8 ++++---- physics/sfc_diag.meta | 4 ++-- physics/sfc_diff.f | 9 +++++---- physics/sfc_diff.meta | 4 ++-- physics/sfc_nst.f90 | 8 ++++---- physics/sfc_nst.meta | 4 ++-- physics/sfc_ocean.F | 16 +++++++++------- physics/sfc_ocean.meta | 4 ++-- 10 files changed, 37 insertions(+), 34 deletions(-) diff --git a/physics/satmedmfvdifq.F b/physics/satmedmfvdifq.F index 90cba0553..9698a140f 100644 --- a/physics/satmedmfvdifq.F +++ b/physics/satmedmfvdifq.F @@ -75,7 +75,7 @@ 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,ssu,ssv,icplocn2atm, & + & 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, & @@ -110,7 +110,7 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & & tdt(:,:), rtg(:,:,:) real(kind=kind_phys), intent(in) :: & & u1(:,:), v1(:,:), & - & ssu(:), ssv(:), & + & usfco(:), vsfco(:), & & t1(:,:), q1(:,:,:), & & swh(:,:), hlw(:,:), & & xmu(:), garea(:), & @@ -2383,9 +2383,9 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & 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)-ssu(i))**2+(v1(i,1)-ssv(i))**2 ) - dusfc(i) = -1.*rho_a(i)*stress(i)*(u1(i,1)-ssu(i))/spd1_m - dvsfc(i) = -1.*rho_a(i)*stress(i)*(v1(i,1)-ssv(i))/spd1_m + 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 ! diff --git a/physics/satmedmfvdifq.meta b/physics/satmedmfvdifq.meta index c97126457..113843f11 100644 --- a/physics/satmedmfvdifq.meta +++ b/physics/satmedmfvdifq.meta @@ -217,7 +217,7 @@ type = real kind = kind_phys intent = in -[ssu] +[usfco] standard_name = ocn_current_zonal long_name = ocn_current_zonal units = m s-1 @@ -225,7 +225,7 @@ type = real kind = kind_phys intent = in -[ssv] +[vsfco] standard_name = ocn_current_merid long_name = ocn_current_merid units = m s-1 diff --git a/physics/sfc_diag.f b/physics/sfc_diag.f index bdc96ade6..b0432df6f 100644 --- a/physics/sfc_diag.f +++ b/physics/sfc_diag.f @@ -17,7 +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, & - & ssu,ssv,icplocn2atm, & + & 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, & @@ -40,7 +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, & - & ssu, ssv, & + & usfco, vsfco, & & qsurf, prslki, evap, fm, fh, fm10, fh2, & & shflx, cdq, wind, xlat_d, xlon_d real(kind=kind_phys), dimension(:), intent(out) :: & @@ -96,8 +96,8 @@ subroutine sfc_diag_run (im,xlat_d,xlon_d, & u10m(i) = f10m(i) * u1(i) v10m(i) = f10m(i) * v1(i) else if (icplocn2atm ==1) then - u10m(i) = ssu(i)+f10m(i) * (u1(i)-ssu(i)) - v10m(i) = ssv(i)+f10m(i) * (v1(i)-ssv(i)) + 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 diff --git a/physics/sfc_diag.meta b/physics/sfc_diag.meta index da300d053..44f3b5c6a 100644 --- a/physics/sfc_diag.meta +++ b/physics/sfc_diag.meta @@ -123,7 +123,7 @@ type = real kind = kind_phys intent = in -[ssu] +[usfco] standard_name = ocn_current_zonal long_name = ocn_current_zonal units = m s-1 @@ -131,7 +131,7 @@ type = real kind = kind_phys intent = in -[ssv] +[vsfco] standard_name = ocn_current_merid long_name = ocn_current_merid units = m s-1 diff --git a/physics/sfc_diff.f b/physics/sfc_diff.f index 1976ab5c2..96f96faeb 100644 --- a/physics/sfc_diff.f +++ b/physics/sfc_diff.f @@ -61,7 +61,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) & z0pert,ztpert, & ! mg, sfc-perts !intent(in) & flag_iter,redrag, & !intent(in) & u10m,v10m,sfc_z0_type, & !hafs,z0 type !intent(in) - & u1,v1,ssu,ssv,icplocn2atm, & + & u1,v1,usfco,vsfco,icplocn2atm, & & wet,dry,icy, & !intent(in) & thsfc_loc, & !intent(in) & tskin_wat, tskin_lnd, tskin_ice, & !intent(in) @@ -97,7 +97,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,ssu,ssv + 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, & @@ -361,8 +362,8 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) wind10m=sqrt(u10m(i)*u10m(i) + v10m(i)*v10m(i)) windrel=wind(i) else if (icplocn2atm ==1) then - wind10m=sqrt((u10m(i)-ssu(i))**2 + (v10m(i)-ssv(i))**2) - windrel=sqrt( (u1(i)-ssu(i))**2 + (v1(i)-ssv(i))**2 ) + 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 !** test xubin's new z0 diff --git a/physics/sfc_diff.meta b/physics/sfc_diff.meta index 1233e17af..3a141712b 100644 --- a/physics/sfc_diff.meta +++ b/physics/sfc_diff.meta @@ -226,7 +226,7 @@ type = real kind = kind_phys intent = in -[ssu] +[usfco] standard_name = ocn_current_zonal long_name = ocn_current_zonal units = m s-1 @@ -234,7 +234,7 @@ type = real kind = kind_phys intent = in -[ssv] +[vsfco] standard_name = ocn_current_merid long_name = ocn_current_merid units = m s-1 diff --git a/physics/sfc_nst.f90 b/physics/sfc_nst.f90 index 06d2b061b..1dd9d6117 100644 --- a/physics/sfc_nst.f90 +++ b/physics/sfc_nst.f90 @@ -26,7 +26,7 @@ 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, ssu, ssv, icplocn2atm, t1, & + 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, & @@ -84,7 +84,7 @@ 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 ! - ! ssu, ssv - real, u/v component of surface current (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 ! @@ -175,7 +175,7 @@ subroutine sfc_nst_run & 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, & - ssu, ssv, 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 @@ -322,7 +322,7 @@ subroutine sfc_nst_run & cmm(i) = cm (i) * wind(i) chh(i) = rho_a(i) * ch(i) * wind(i) else if (icplocn2atm ==1) then - windrel= sqrt( (u1(i)-ssu(i))**2 + (v1(i)-ssv(i))**2 ) + 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 diff --git a/physics/sfc_nst.meta b/physics/sfc_nst.meta index 7504b9d49..a9082515e 100644 --- a/physics/sfc_nst.meta +++ b/physics/sfc_nst.meta @@ -134,7 +134,7 @@ type = real kind = kind_phys intent = in -[ssu] +[usfco] standard_name = ocn_current_zonal long_name = ocn_current_zonal units = m s-1 @@ -142,7 +142,7 @@ type = real kind = kind_phys intent = in -[ssv] +[vsfco] standard_name = ocn_current_merid long_name = ocn_current_merid units = m s-1 diff --git a/physics/sfc_ocean.F b/physics/sfc_ocean.F index 0d1ebc2cd..505476510 100644 --- a/physics/sfc_ocean.F +++ b/physics/sfc_ocean.F @@ -25,7 +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, & - & ssu, ssv, icplocn2atm, & + & 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 @@ -40,7 +40,7 @@ subroutine sfc_ocean_run & ! call sfc_ocean ! ! inputs: ! ! ( im, ps, u1, v1, t1, q1, tskin, cm, ch, lseaspray, fm, fm10, ! -! ssu, ssv, icplocn2atm, ! +! usfco, vsfco, icplocn2atm, ! ! prsl1, prslki, wet, use_lake_model, wind, flag_iter, ! ! use_med_flux, ! ! outputs: ! @@ -68,8 +68,9 @@ 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 ! -! ssu,ssv - real, u/v component of surface ocean current (m/s) im ! -! icplocn2atm - integrt, =1 if ssu and ssv are used in the 1 ! +! 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 ! @@ -114,7 +115,8 @@ 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, ssu,ssv + & t1, q1, tskin, cm, ch, fm, fm10, prsl1, prslki, wind, & + & usfco, vsfco ! For sea spray effect logical, intent(in) :: lseaspray @@ -186,7 +188,7 @@ subroutine sfc_ocean_run & tem = ch(i) * wind(i) cmm(i) = cm(i) * wind(i) else if (icplocn2atm ==1) then - windrel(i)=sqrt( (u1(i)-ssu(i))**2+(v1(i)-ssv(i))**2 ) + 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 @@ -211,7 +213,7 @@ subroutine sfc_ocean_run & tem = ch(i) * wind(i) cmm(i) = cm(i) * wind(i) else if (icplocn2atm ==1) then - windrel(i)=sqrt( (u1(i)-ssu(i))**2+(v1(i)-ssv(i))**2 ) + 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) diff --git a/physics/sfc_ocean.meta b/physics/sfc_ocean.meta index dbb9c9131..ac063ab5d 100644 --- a/physics/sfc_ocean.meta +++ b/physics/sfc_ocean.meta @@ -86,7 +86,7 @@ type = real kind = kind_phys intent = in -[ssu] +[usfco] standard_name = ocn_current_zonal long_name = ocn_current_zonal units = m s-1 @@ -94,7 +94,7 @@ type = real kind = kind_phys intent = in -[ssv] +[vsfco] standard_name = ocn_current_merid long_name = ocn_current_merid units = m s-1 From fa1078f56b72f9a3f38c5332cefc372b69ed55c2 Mon Sep 17 00:00:00 2001 From: "Bin.Li" Date: Sat, 6 Jan 2024 11:54:13 +0000 Subject: [PATCH 14/21] Update sfc_diff.f. --- physics/sfc_diff.f | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/physics/sfc_diff.f b/physics/sfc_diff.f index 96f96faeb..5a9b1e54f 100644 --- a/physics/sfc_diff.f +++ b/physics/sfc_diff.f @@ -359,11 +359,11 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) z0max = max(zmin, min(z0,z1(i))) ! ustar_wat(i) = sqrt(grav * z0 / charnock) if (icplocn2atm == 0) then - wind10m=sqrt(u10m(i)*u10m(i) + v10m(i)*v10m(i)) + 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 ) + 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 !** test xubin's new z0 From ea70fbdaa81c2ad4b8f1b7a7b7bd31fa9115fc52 Mon Sep 17 00:00:00 2001 From: "Bin.Li" Date: Wed, 17 Jan 2024 15:42:07 +0000 Subject: [PATCH 15/21] Make changes for consistent style. --- physics/SFC_Layer/UFS/sfc_diff.f | 17 ++++++++--------- physics/SFC_Layer/UFS/sfc_nst.f90 | 2 +- physics/SFC_Models/Ocean/UFS/sfc_ocean.F | 1 - 3 files changed, 9 insertions(+), 11 deletions(-) diff --git a/physics/SFC_Layer/UFS/sfc_diff.f b/physics/SFC_Layer/UFS/sfc_diff.f index f4a102c91..eb5bd7b5c 100644 --- a/physics/SFC_Layer/UFS/sfc_diff.f +++ b/physics/SFC_Layer/UFS/sfc_diff.f @@ -168,7 +168,6 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) errmsg = '' errflg = 0 - ! initialize variables. all units are supposedly m.k.s. unless specified ! ps is in pascals, wind is wind speed, ! surface roughness length is converted to m from cm @@ -282,11 +281,11 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! call stability ! --- inputs: - & (z1(i), zvfun(i), gdx, tv1, thv1, wind(i), - & z0max, ztmax_lnd(i), tvs, grav, thsfc_loc, + & (z1(i), zvfun(i), gdx, tv1, thv1, wind(i), + & z0max, ztmax_lnd(i), tvs, grav, thsfc_loc, ! --- outputs: - & rb_lnd(i), fm_lnd(i), fh_lnd(i), fm10_lnd(i), fh2_lnd(i), - & cm_lnd(i), ch_lnd(i), stress_lnd(i), ustar_lnd(i)) + & rb_lnd(i), fm_lnd(i), fh_lnd(i), fm10_lnd(i), fh2_lnd(i), + & cm_lnd(i), ch_lnd(i), stress_lnd(i), ustar_lnd(i)) endif ! Dry points if (icy(i)) then ! Some ice @@ -336,11 +335,11 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! call stability ! --- inputs: - & (z1(i), zvfun(i), gdx, tv1, thv1, wind(i), - & z0max, ztmax_ice(i), tvs, grav, thsfc_loc, + & (z1(i), zvfun(i), gdx, tv1, thv1, wind(i), + & z0max, ztmax_ice(i), tvs, grav, thsfc_loc, ! --- outputs: - & rb_ice(i), fm_ice(i), fh_ice(i), fm10_ice(i), fh2_ice(i), - & cm_ice(i), ch_ice(i), stress_ice(i), ustar_ice(i)) + & rb_ice(i), fm_ice(i), fh_ice(i), fm10_ice(i), fh2_ice(i), + & cm_ice(i), ch_ice(i), stress_ice(i), ustar_ice(i)) endif ! Icy points ! BWG: Everything from here to end of subroutine was after diff --git a/physics/SFC_Layer/UFS/sfc_nst.f90 b/physics/SFC_Layer/UFS/sfc_nst.f90 index 1dd9d6117..9c3804211 100644 --- a/physics/SFC_Layer/UFS/sfc_nst.f90 +++ b/physics/SFC_Layer/UFS/sfc_nst.f90 @@ -27,7 +27,7 @@ module sfc_nst subroutine sfc_nst_run & ( im, hvap, cp, hfus, jcal, eps, epsm1, rvrdm1, rd, rhw0, & ! --- inputs: pi, tgice, sbc, ps, u1, v1, usfco, vsfco, icplocn2atm, t1, & - q1, tref, cm, ch, lseaspray, fm, fm10, & + 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, & diff --git a/physics/SFC_Models/Ocean/UFS/sfc_ocean.F b/physics/SFC_Models/Ocean/UFS/sfc_ocean.F index 505476510..88d23a7aa 100644 --- a/physics/SFC_Models/Ocean/UFS/sfc_ocean.F +++ b/physics/SFC_Models/Ocean/UFS/sfc_ocean.F @@ -179,7 +179,6 @@ subroutine sfc_ocean_run & ! 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))) From c9460205f6047047025536653e05675749b9d074 Mon Sep 17 00:00:00 2001 From: Jili Dong Date: Wed, 17 Jan 2024 15:54:26 +0000 Subject: [PATCH 16/21] fix NSSL MP init issue when initialized from other microphysics schemes --- physics/MP/NSSL/mp_nssl.F90 | 42 ++++++++++++++-- physics/MP/NSSL/mp_nssl.meta | 95 ++++++++++++++++++++++++++++++++++++ 2 files changed, 134 insertions(+), 3 deletions(-) diff --git a/physics/MP/NSSL/mp_nssl.F90 b/physics/MP/NSSL/mp_nssl.F90 index e79376709..ad1d41090 100644 --- a/physics/MP/NSSL/mp_nssl.F90 +++ b/physics/MP/NSSL/mp_nssl.F90 @@ -15,6 +15,7 @@ module mp_nssl private logical :: is_initialized = .False. + logical :: missing_vars_global = .False. real :: nssl_qccn contains @@ -26,7 +27,9 @@ module mp_nssl !! \htmlinclude mp_nssl_init.html !! subroutine mp_nssl_init(ncol, nlev, errflg, errmsg, threads, restart, & - mpirank, mpiroot, & + mpirank, mpiroot,mpicomm, & + qc, qr, qi, qs, qh, & + ccw, crw, cci, csw, chw, vh, & con_g, con_rd, con_cp, con_rv, & con_t0c, con_cliq, con_csol, con_eps, & imp_physics, imp_physics_nssl, & @@ -36,6 +39,9 @@ subroutine mp_nssl_init(ncol, nlev, errflg, errmsg, threads, restart, & use module_mp_nssl_2mom, only: nssl_2mom_init, nssl_2mom_init_const +#ifdef MPI + use mpi +#endif implicit none @@ -50,16 +56,32 @@ subroutine mp_nssl_init(ncol, nlev, errflg, errmsg, threads, restart, & integer, intent(in) :: mpirank integer, intent(in) :: mpiroot + integer, intent(in) :: mpicomm integer, intent(in) :: imp_physics integer, intent(in) :: imp_physics_nssl real(kind_phys), intent(in) :: nssl_cccn, nssl_alphah, nssl_alphahl real(kind_phys), intent(in) :: nssl_alphar, nssl_ehw0, nssl_ehlw0 logical, intent(in) :: nssl_ccn_on, nssl_hail_on, nssl_invertccn, nssl_3moment + real(kind_phys), intent(inout) :: qc (:,:) !(1:ncol,1:nlev) + real(kind_phys), intent(inout) :: qr (:,:) !(1:ncol,1:nlev) + real(kind_phys), intent(inout) :: qi (:,:) !(1:ncol,1:nlev) + real(kind_phys), intent(inout) :: qs (:,:) !(1:ncol,1:nlev) + real(kind_phys), intent(inout) :: qh (:,:) !(1:ncol,1:nlev) graupel + real(kind_phys), intent(inout) :: ccw(:,:) !(1:ncol,1:nlev) + real(kind_phys), intent(inout) :: crw(:,:) !(1:ncol,1:nlev) + real(kind_phys), intent(inout) :: cci(:,:) !(1:ncol,1:nlev) + real(kind_phys), intent(inout) :: csw(:,:) !(1:ncol,1:nlev) + real(kind_phys), intent(inout) :: chw(:,:) !(1:ncol,1:nlev) graupel number + real(kind_phys), intent(inout) :: vh (:,:) !(1:ncol,1:nlev) graupel volume + ! Local variables: dimensions used in nssl_init integer :: ims,ime, jms,jme, kms,kme, nx, nz, i,k real :: nssl_params(20) integer :: ihailv,ipc + real, parameter :: qmin = 1.e-12 + integer :: ierr + logical :: missing_vars = .False. ! Initialize the CCPP error handling variables @@ -143,6 +165,19 @@ subroutine mp_nssl_init(ncol, nlev, errflg, errmsg, threads, restart, & ! For restart runs, the init is done here if (restart) then + + ! For restart, check if the IC is from a different scheme that does not have all the needed variables + missing_vars = .False. + IF ( Any( qc > qmin .and. ccw == 0.0 ) ) missing_vars = .true. + IF ( .not. missing_vars .and. Any( qi > qmin .and. cci == 0.0 ) ) missing_vars = .true. + IF ( .not. missing_vars .and. Any( qs > qmin .and. csw == 0.0 ) ) missing_vars = .true. + IF ( .not. missing_vars .and. Any( qr > qmin .and. crw == 0.0 ) ) missing_vars = .true. + IF ( .not. missing_vars .and. Any( qh > qmin .and. (chw == 0.0 .or. vh == 0.0) ) ) missing_vars = .true. + +#ifdef MPI + call MPI_Allreduce(missing_vars, missing_vars_global, 1, MPI_LOGICAL, MPI_LOR, mpicomm, ierr) +#endif + is_initialized = .true. return end if @@ -319,6 +354,7 @@ subroutine mp_nssl_run(ncol, nlev, con_g, con_rd, mpirank, & real :: cwmas real(kind_phys), allocatable :: an(:,:,:,:) ! temporary scalar array + errflg = 0 @@ -529,8 +565,8 @@ subroutine mp_nssl_run(ncol, nlev, con_g, con_rd, mpirank, & dtptmp = dtp ntmul = 1 ENDIF - - IF ( first_time_step .and. .not. restart ) THEN + + IF ( first_time_step .and. ( .not. restart .or. missing_vars_global ) ) THEN itimestep = 0 ! gets incremented to 1 in call loop IF ( nssl_ccn_on ) THEN IF ( invertccn ) THEN diff --git a/physics/MP/NSSL/mp_nssl.meta b/physics/MP/NSSL/mp_nssl.meta index 1f2023ea9..8449f26cf 100644 --- a/physics/MP/NSSL/mp_nssl.meta +++ b/physics/MP/NSSL/mp_nssl.meta @@ -63,6 +63,101 @@ dimensions = () type = integer intent = in +[mpicomm] + standard_name = mpi_communicator + long_name = MPI communicator + units = index + dimensions = () + type = integer + intent = in +[qc] + standard_name = cloud_liquid_water_mixing_ratio + long_name = cloud water mixing ratio wrt dry+vapor (no condensates) + units = kg kg-1 + dimensions = (horizontal_dimension ,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[qr] + standard_name = rain_mixing_ratio + long_name = rain water mixing ratio wrt dry+vapor (no condensates) + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[qi] + standard_name = cloud_ice_mixing_ratio + long_name = ice water mixing ratio wrt dry+vapor (no condensates) + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[qs] + standard_name = snow_mixing_ratio + long_name = snow water mixing ratio wrt dry+vapor (no condensates) + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[qh] + standard_name = graupel_mixing_ratio + long_name = graupel mixing ratio wrt dry+vapor (no condensates) + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[ccw] + standard_name = mass_number_concentration_of_cloud_liquid_water_particles_in_air + long_name = cloud droplet number concentration + units = kg-1 + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[crw] + standard_name = mass_number_concentration_of_rain_water_in_air + long_name = rain number concentration + units = kg-1 + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[cci] + standard_name = mass_number_concentration_of_cloud_ice_water_crystals_in_air + long_name = ice number concentration + units = kg-1 + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[csw] + standard_name = mass_number_concentration_of_snow_in_air + long_name = snow number concentration + units = kg-1 + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[chw] + standard_name = mass_number_concentration_of_graupel_in_air + long_name = graupel number concentration + units = kg-1 + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[vh] + standard_name = graupel_volume + long_name = graupel particle volume + units = m3 kg-1 + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout [con_g] standard_name = gravitational_acceleration long_name = gravitational acceleration From 5fe0d63eee3eb05bb5e37b5e136229ac3d84cf98 Mon Sep 17 00:00:00 2001 From: "Bin.Li" Date: Thu, 25 Jan 2024 13:33:36 +0000 Subject: [PATCH 17/21] Change flag_for_air_sea_flux_computation_over_water to control_for_air_sea_flux_computation_over_water. --- physics/PBL/SATMEDMF/satmedmfvdifq.meta | 4 ++-- physics/SFC_Layer/UFS/sfc_diag.meta | 4 ++-- physics/SFC_Layer/UFS/sfc_diff.meta | 4 ++-- physics/SFC_Layer/UFS/sfc_nst.meta | 4 ++-- physics/SFC_Models/Ocean/UFS/sfc_ocean.meta | 4 ++-- 5 files changed, 10 insertions(+), 10 deletions(-) diff --git a/physics/PBL/SATMEDMF/satmedmfvdifq.meta b/physics/PBL/SATMEDMF/satmedmfvdifq.meta index ec80ba422..ff570dce0 100644 --- a/physics/PBL/SATMEDMF/satmedmfvdifq.meta +++ b/physics/PBL/SATMEDMF/satmedmfvdifq.meta @@ -234,9 +234,9 @@ kind = kind_phys intent = in [icplocn2atm] - standard_name = flag_for_air_sea_flux_computation_over_water + standard_name = control_for_air_sea_flux_computation_over_water long_name = air-sea flux option - units = flag + units = 1 dimensions = () type = integer intent = in diff --git a/physics/SFC_Layer/UFS/sfc_diag.meta b/physics/SFC_Layer/UFS/sfc_diag.meta index b432d75b7..f5e0ab89e 100644 --- a/physics/SFC_Layer/UFS/sfc_diag.meta +++ b/physics/SFC_Layer/UFS/sfc_diag.meta @@ -141,9 +141,9 @@ kind = kind_phys intent = in [icplocn2atm] - standard_name = flag_for_air_sea_flux_computation_over_water + standard_name = control_for_air_sea_flux_computation_over_water long_name = air-sea flux option - units = flag + units = 1 dimensions = () type = integer intent = in diff --git a/physics/SFC_Layer/UFS/sfc_diff.meta b/physics/SFC_Layer/UFS/sfc_diff.meta index eae4c58b0..f2bee7d2c 100644 --- a/physics/SFC_Layer/UFS/sfc_diff.meta +++ b/physics/SFC_Layer/UFS/sfc_diff.meta @@ -258,9 +258,9 @@ type = integer intent = in [icplocn2atm] - standard_name = flag_for_air_sea_flux_computation_over_water + standard_name = control_for_air_sea_flux_computation_over_water long_name = air-sea flux option - units = flag + units = 1 dimensions = () type = integer intent = in diff --git a/physics/SFC_Layer/UFS/sfc_nst.meta b/physics/SFC_Layer/UFS/sfc_nst.meta index ba075e5ae..2181f0bf4 100644 --- a/physics/SFC_Layer/UFS/sfc_nst.meta +++ b/physics/SFC_Layer/UFS/sfc_nst.meta @@ -151,9 +151,9 @@ kind = kind_phys intent = in [icplocn2atm] - standard_name = flag_for_air_sea_flux_computation_over_water + standard_name = control_for_air_sea_flux_computation_over_water long_name = air-sea flux option - units = flag + units = 1 dimensions = () type = integer intent = in diff --git a/physics/SFC_Models/Ocean/UFS/sfc_ocean.meta b/physics/SFC_Models/Ocean/UFS/sfc_ocean.meta index c380a7540..4672a6dc4 100644 --- a/physics/SFC_Models/Ocean/UFS/sfc_ocean.meta +++ b/physics/SFC_Models/Ocean/UFS/sfc_ocean.meta @@ -103,9 +103,9 @@ kind = kind_phys intent = in [icplocn2atm] - standard_name = flag_for_air_sea_flux_computation_over_water + standard_name = control_for_air_sea_flux_computation_over_water long_name = air-sea flux option - units = flag + units = 1 dimensions = () type = integer intent = in From 4bdf3fab29da51e487143e8b5e3ce8ed5d599127 Mon Sep 17 00:00:00 2001 From: Jili Dong Date: Thu, 25 Jan 2024 14:49:22 +0000 Subject: [PATCH 18/21] add kind_phys to parameter in mp_nssl --- physics/MP/NSSL/mp_nssl.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/MP/NSSL/mp_nssl.F90 b/physics/MP/NSSL/mp_nssl.F90 index ad1d41090..e250527c4 100644 --- a/physics/MP/NSSL/mp_nssl.F90 +++ b/physics/MP/NSSL/mp_nssl.F90 @@ -79,7 +79,7 @@ subroutine mp_nssl_init(ncol, nlev, errflg, errmsg, threads, restart, & integer :: ims,ime, jms,jme, kms,kme, nx, nz, i,k real :: nssl_params(20) integer :: ihailv,ipc - real, parameter :: qmin = 1.e-12 + real(kind_phys), parameter :: qmin = 1.e-12 integer :: ierr logical :: missing_vars = .False. @@ -347,7 +347,7 @@ subroutine mp_nssl_run(ncol, nlev, con_g, con_rd, mpirank, & its,ite, jts,jte, kts,kte, i,j,k integer :: itimestep ! timestep counter integer :: ntmul, n - real, parameter :: dtpmax = 60. ! allow up to dt=75 (1.25*60) + real(kind_phys), parameter :: dtpmax = 60. ! allow up to dt=75 (1.25*60) real(kind_phys) :: dtptmp integer, parameter :: ndebug = 0 logical :: invertccn From be9b2b726d5ab08a7630def5b7559d55fa6dcd1f Mon Sep 17 00:00:00 2001 From: Jili Dong Date: Thu, 25 Jan 2024 14:54:44 +0000 Subject: [PATCH 19/21] add more kind_phys to real variables in mp_nssl --- physics/MP/NSSL/mp_nssl.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/MP/NSSL/mp_nssl.F90 b/physics/MP/NSSL/mp_nssl.F90 index e250527c4..0b111f7cd 100644 --- a/physics/MP/NSSL/mp_nssl.F90 +++ b/physics/MP/NSSL/mp_nssl.F90 @@ -77,7 +77,7 @@ subroutine mp_nssl_init(ncol, nlev, errflg, errmsg, threads, restart, & ! Local variables: dimensions used in nssl_init integer :: ims,ime, jms,jme, kms,kme, nx, nz, i,k - real :: nssl_params(20) + real(kind_phys) :: nssl_params(20) integer :: ihailv,ipc real(kind_phys), parameter :: qmin = 1.e-12 integer :: ierr @@ -351,7 +351,7 @@ subroutine mp_nssl_run(ncol, nlev, con_g, con_rd, mpirank, & real(kind_phys) :: dtptmp integer, parameter :: ndebug = 0 logical :: invertccn - real :: cwmas + real(kind_phys) :: cwmas real(kind_phys), allocatable :: an(:,:,:,:) ! temporary scalar array From 51204101eeb68dcbed08d13cc0a341a25ee1a229 Mon Sep 17 00:00:00 2001 From: "Bin.Li" Date: Fri, 26 Jan 2024 09:27:17 +0000 Subject: [PATCH 20/21] Update standard_name and long_name for usfco and vsfco. --- physics/PBL/SATMEDMF/satmedmfvdifq.meta | 8 ++++---- physics/SFC_Layer/UFS/sfc_diag.meta | 8 ++++---- physics/SFC_Layer/UFS/sfc_diff.meta | 8 ++++---- physics/SFC_Layer/UFS/sfc_nst.meta | 8 ++++---- physics/SFC_Models/Ocean/UFS/sfc_ocean.meta | 8 ++++---- 5 files changed, 20 insertions(+), 20 deletions(-) diff --git a/physics/PBL/SATMEDMF/satmedmfvdifq.meta b/physics/PBL/SATMEDMF/satmedmfvdifq.meta index ff570dce0..e203187aa 100644 --- a/physics/PBL/SATMEDMF/satmedmfvdifq.meta +++ b/physics/PBL/SATMEDMF/satmedmfvdifq.meta @@ -218,16 +218,16 @@ kind = kind_phys intent = in [usfco] - standard_name = ocn_current_zonal - long_name = ocn_current_zonal + 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 = ocn_current_merid - long_name = ocn_current_merid + standard_name = y_ocean_current + long_name = meridional current at ocean surface units = m s-1 dimensions = (horizontal_loop_extent) type = real diff --git a/physics/SFC_Layer/UFS/sfc_diag.meta b/physics/SFC_Layer/UFS/sfc_diag.meta index f5e0ab89e..4fdf37916 100644 --- a/physics/SFC_Layer/UFS/sfc_diag.meta +++ b/physics/SFC_Layer/UFS/sfc_diag.meta @@ -125,16 +125,16 @@ kind = kind_phys intent = in [usfco] - standard_name = ocn_current_zonal - long_name = ocn_current_zonal + 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 = ocn_current_merid - long_name = ocn_current_merid + standard_name = y_ocean_current + long_name = meridional current at ocean surface units = m s-1 dimensions = (horizontal_loop_extent) type = real diff --git a/physics/SFC_Layer/UFS/sfc_diff.meta b/physics/SFC_Layer/UFS/sfc_diff.meta index f2bee7d2c..0964473cb 100644 --- a/physics/SFC_Layer/UFS/sfc_diff.meta +++ b/physics/SFC_Layer/UFS/sfc_diff.meta @@ -235,16 +235,16 @@ kind = kind_phys intent = in [usfco] - standard_name = ocn_current_zonal - long_name = ocn_current_zonal + 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 = ocn_current_merid - long_name = ocn_current_merid + standard_name = y_ocean_current + long_name = meridional current at ocean surface units = m s-1 dimensions = (horizontal_loop_extent) type = real diff --git a/physics/SFC_Layer/UFS/sfc_nst.meta b/physics/SFC_Layer/UFS/sfc_nst.meta index 2181f0bf4..80f468803 100644 --- a/physics/SFC_Layer/UFS/sfc_nst.meta +++ b/physics/SFC_Layer/UFS/sfc_nst.meta @@ -135,16 +135,16 @@ kind = kind_phys intent = in [usfco] - standard_name = ocn_current_zonal - long_name = ocn_current_zonal + 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 = ocn_current_merid - long_name = ocn_current_merid + standard_name = y_ocean_current + long_name = meridional current at ocean surface units = m s-1 dimensions = (horizontal_loop_extent) type = real diff --git a/physics/SFC_Models/Ocean/UFS/sfc_ocean.meta b/physics/SFC_Models/Ocean/UFS/sfc_ocean.meta index 4672a6dc4..15d9fb5c4 100644 --- a/physics/SFC_Models/Ocean/UFS/sfc_ocean.meta +++ b/physics/SFC_Models/Ocean/UFS/sfc_ocean.meta @@ -87,16 +87,16 @@ kind = kind_phys intent = in [usfco] - standard_name = ocn_current_zonal - long_name = ocn_current_zonal + 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 = ocn_current_merid - long_name = ocn_current_merid + standard_name = y_ocean_current + long_name = meridional current at ocean surface units = m s-1 dimensions = (horizontal_loop_extent) type = real From 5356ef23a826ad5235d5616ba616312e56e5303b Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Fri, 9 Feb 2024 20:44:51 -0500 Subject: [PATCH 21/21] fix use_lake_model type in scm_sfc_flux_spec.F90 --- .../UFS_SCM_NEPTUNE/scm_sfc_flux_spec.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/scm_sfc_flux_spec.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/scm_sfc_flux_spec.F90 index 835b468ff..a3cf2d740 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/scm_sfc_flux_spec.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/scm_sfc_flux_spec.F90 @@ -58,9 +58,9 @@ subroutine scm_sfc_flux_spec_run (im, u1, v1, z1, t1, q1, p1, roughness_length, use machine, only: kind_phys integer, intent(in) :: im, lkm - integer, intent(inout) :: islmsk(:) + integer, intent(inout) :: islmsk(:), use_lake_model(:) logical, intent(in) :: cplflx, cplice - logical, intent(inout) :: dry(:), icy(:), flag_cice(:), wet(:), use_lake_model(:) + logical, intent(inout) :: dry(:), icy(:), flag_cice(:), wet(:) real(kind=kind_phys), intent(in) :: cp, grav, hvap, rd, fvirt, vonKarman, min_seaice, tgice, min_lakeice real(kind=kind_phys), intent(in) :: u1(:), v1(:), z1(:), t1(:), q1(:), p1(:), roughness_length(:), & spec_sh_flux(:), spec_lh_flux(:), exner_inverse(:), T_surf(:), oceanfrac(:), lakefrac(:), lakedepth(:) @@ -212,12 +212,12 @@ subroutine scm_sfc_flux_spec_run (im, u1, v1, z1, t1, q1, p1, roughness_length, do i = 1, im if ((wet(i) .or. icy(i)) .and. lakefrac(i) > 0.0_kind_phys) then if (lkm == 1 .and. lakefrac(i) >= 0.15 .and. lakedepth(i) > 1.0_kind_phys) then - use_lake_model(i) = .true. + use_lake_model(i) = 1 else - use_lake_model(i) = .false. + use_lake_model(i) = 0 endif else - use_lake_model(i) = .false. + use_lake_model(i) = 0 endif enddo !