From 9dc3d4063619b999316e2e269a3eb37d3c169173 Mon Sep 17 00:00:00 2001 From: "Bin.Li" Date: Mon, 20 Nov 2023 15:57:15 +0000 Subject: [PATCH 01/26] 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/26] 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/26] 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/26] 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/26] 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/26] 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/26] 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/26] 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/26] 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 790960e3ff3203c69420282e87f7c164776c4e36 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 26 Dec 2023 20:30:50 -0700 Subject: [PATCH 10/26] Make ozone physics CCPP compliant by removing 'optional' and 'pointer' attributes --- physics/GFS_suite_stateout_update.F90 | 15 ++++++------ physics/GFS_suite_stateout_update.meta | 7 ++++++ physics/module_ozphys.F90 | 32 +++++++++++++++----------- 3 files changed, 34 insertions(+), 20 deletions(-) diff --git a/physics/GFS_suite_stateout_update.F90 b/physics/GFS_suite_stateout_update.F90 index e9e477fce..53867f6cc 100644 --- a/physics/GFS_suite_stateout_update.F90 +++ b/physics/GFS_suite_stateout_update.F90 @@ -18,7 +18,7 @@ module GFS_suite_stateout_update subroutine GFS_suite_stateout_update_run (im, levs, ntrac, dtp, tgrs, ugrs, vgrs, qgrs, & dudt, dvdt, dtdt, dqdt, gt0, gu0, gv0, gq0, oz0, ntiw, nqrimef, imp_physics, & imp_physics_fer_hires, epsq, ozphys, oz_phys_2015, oz_phys_2006, con_1ovg, prsl, & - dp, ozpl, do3_dt_prd, do3_dt_ozmx, do3_dt_temp, do3_dt_ohoz, errmsg, errflg) + dp, ozpl, qdiag3d, do3_dt_prd, do3_dt_ozmx, do3_dt_temp, do3_dt_ohoz, errmsg, errflg) ! Inputs integer, intent(in ) :: im @@ -31,12 +31,13 @@ subroutine GFS_suite_stateout_update_run (im, levs, ntrac, dtp, tgrs, ugrs, vgrs real(kind=kind_phys), intent(in ), dimension(:,:,:) :: qgrs, ozpl real(kind=kind_phys), intent(in ), dimension(:,:) :: dudt, dvdt, dtdt real(kind=kind_phys), intent(in ), dimension(:,:,:) :: dqdt + logical, intent(in) :: qdiag3d logical, intent(in) :: oz_phys_2015 logical, intent(in) :: oz_phys_2006 type(ty_ozphys), intent(in) :: ozphys ! Outputs (optional) - real(kind=kind_phys), intent(inout), dimension(:,:), pointer, optional :: & + real(kind=kind_phys), intent(inout), dimension(:,:) :: & do3_dt_prd, & ! Physics tendency: production and loss effect do3_dt_ozmx, & ! Physics tendency: ozone mixing ratio effect do3_dt_temp, & ! Physics tendency: temperature effect @@ -50,7 +51,7 @@ subroutine GFS_suite_stateout_update_run (im, levs, ntrac, dtp, tgrs, ugrs, vgrs ! Locals integer :: i, k - + ! Initialize CCPP error handling variables errmsg = '' errflg = 0 @@ -65,12 +66,12 @@ subroutine GFS_suite_stateout_update_run (im, levs, ntrac, dtp, tgrs, ugrs, vgrs ! If using photolysis physics schemes, update (prognostic) gas concentrations using ! updated state. if (oz_phys_2015) then - call ozphys%run_o3prog_2015(con_1ovg, dtp, prsl, gt0, dp, ozpl, oz0, do3_dt_prd, & - do3_dt_ozmx, do3_dt_temp, do3_dt_ohoz) + call ozphys%run_o3prog_2015(con_1ovg, dtp, prsl, gt0, dp, ozpl, oz0, qdiag3d, & + do3_dt_prd, do3_dt_ozmx, do3_dt_temp, do3_dt_ohoz) endif if (oz_phys_2006) then - call ozphys%run_o3prog_2006(con_1ovg, dtp, prsl, gt0, dp, ozpl, oz0, do3_dt_prd, & - do3_dt_ozmx, do3_dt_temp, do3_dt_ohoz) + call ozphys%run_o3prog_2006(con_1ovg, dtp, prsl, gt0, dp, ozpl, oz0, qdiag3d, & + do3_dt_prd, do3_dt_ozmx, do3_dt_temp, do3_dt_ohoz) endif ! If using Ferrier-Aligo microphysics, set bounds on the mass-weighted rime factor. diff --git a/physics/GFS_suite_stateout_update.meta b/physics/GFS_suite_stateout_update.meta index fae276d2f..75f7fe59e 100644 --- a/physics/GFS_suite_stateout_update.meta +++ b/physics/GFS_suite_stateout_update.meta @@ -44,6 +44,13 @@ dimensions = () type = ty_ozphys intent = in +[qdiag3d] + standard_name = flag_for_tracer_diagnostics_3D + long_name = flag for 3d tracer diagnostic fields + units = flag + dimensions = () + type = logical + intent = in [oz_phys_2015] standard_name = flag_for_nrl_2015_ozone_scheme long_name = flag for new (2015) ozone physics diff --git a/physics/module_ozphys.F90 b/physics/module_ozphys.F90 index f824736b1..8d0486422 100644 --- a/physics/module_ozphys.F90 +++ b/physics/module_ozphys.F90 @@ -198,7 +198,7 @@ end subroutine update_o3prog ! ######################################################################################### ! Procedure (type-bound) for NRL prognostic ozone (2015). ! ######################################################################################### - subroutine run_o3prog_2015(this, con_1ovg, dt, p, t, dp, ozpl, oz, do3_dt_prd, & + subroutine run_o3prog_2015(this, con_1ovg, dt, p, t, dp, ozpl, oz, do_diag, do3_dt_prd, & do3_dt_ozmx, do3_dt_temp, do3_dt_ohoz) class(ty_ozphys), intent(in) :: this real(kind_phys), intent(in) :: & @@ -213,7 +213,8 @@ subroutine run_o3prog_2015(this, con_1ovg, dt, p, t, dp, ozpl, oz, do3_dt_prd, ozpl ! Ozone forcing data real(kind_phys), intent(inout), dimension(:,:) :: & oz ! Ozone concentration updated by physics - real(kind_phys), intent(inout), dimension(:,:), pointer, optional :: & + logical, intent(in) :: do_diag + real(kind_phys), intent(inout), dimension(:,:) :: & do3_dt_prd, & ! Physics tendency: production and loss effect do3_dt_ozmx, & ! Physics tendency: ozone mixing ratio effect do3_dt_temp, & ! Physics tendency: temperature effect @@ -297,10 +298,12 @@ subroutine run_o3prog_2015(this, con_1ovg, dt, p, t, dp, ozpl, oz, do3_dt_prd, enddo ! Diagnostics (optional) - if (associated(do3_dt_prd)) do3_dt_prd(:,iLev) = (prod(:,1)-prod(:,2)*prod(:,6))*dt - if (associated(do3_dt_ozmx)) do3_dt_ozmx(:,iLev) = (oz(:,iLev) - ozib(:)) - if (associated(do3_dt_temp)) do3_dt_temp(:,iLev) = prod(:,3)*(t(:,iLev)-prod(:,5))*dt - if (associated(do3_dt_ohoz)) do3_dt_ohoz(:,iLev) = prod(:,4) * (colo3(:,iLev)-coloz(:,iLev))*dt + if (do_diag) then + do3_dt_prd(:,iLev) = (prod(:,1)-prod(:,2)*prod(:,6))*dt + do3_dt_ozmx(:,iLev) = (oz(:,iLev) - ozib(:)) + do3_dt_temp(:,iLev) = prod(:,3)*(t(:,iLev)-prod(:,5))*dt + do3_dt_ohoz(:,iLev) = prod(:,4) * (colo3(:,iLev)-coloz(:,iLev))*dt + endif enddo return @@ -309,7 +312,7 @@ end subroutine run_o3prog_2015 ! ######################################################################################### ! Procedure (type-bound) for NRL prognostic ozone (2006). ! ######################################################################################### - subroutine run_o3prog_2006(this, con_1ovg, dt, p, t, dp, ozpl, oz, do3_dt_prd, & + subroutine run_o3prog_2006(this, con_1ovg, dt, p, t, dp, ozpl, oz, do_diag, do3_dt_prd, & do3_dt_ozmx, do3_dt_temp, do3_dt_ohoz) class(ty_ozphys), intent(in) :: this real(kind_phys), intent(in) :: & @@ -324,7 +327,8 @@ subroutine run_o3prog_2006(this, con_1ovg, dt, p, t, dp, ozpl, oz, do3_dt_prd, ozpl ! Ozone forcing data real(kind_phys), intent(inout), dimension(:,:) :: & oz ! Ozone concentration updated by physics - real(kind_phys), intent(inout), dimension(:,:), pointer, optional :: & + logical, intent(in) :: do_diag + real(kind_phys), intent(inout), dimension(:,:) :: & do3_dt_prd, & ! Physics tendency: production and loss effect do3_dt_ozmx, & ! Physics tendency: ozone mixing ratio effect do3_dt_temp, & ! Physics tendency: temperature effect @@ -418,12 +422,14 @@ subroutine run_o3prog_2006(this, con_1ovg, dt, p, t, dp, ozpl, oz, do3_dt_prd, oz(iCol,iLev) = (ozib(iCol) + tem*dt) / (1.0 + prod(iCol,2)*dt) enddo endif - ! Diagnostics (optional) - if (associated(do3_dt_prd)) do3_dt_prd(:,iLev) = prod(:,1)*dt - if (associated(do3_dt_ozmx)) do3_dt_ozmx(:,iLev) = (oz(:,iLev) - ozib(:)) - if (associated(do3_dt_temp)) do3_dt_temp(:,iLev) = prod(:,3) * t(:,iLev) * dt - if (associated(do3_dt_ohoz)) do3_dt_ohoz(:,iLev) = prod(:,4) * colo3(:,iLev) * dt + ! Diagnostics (optional) + if (do_diag) then + do3_dt_prd(:,iLev) = prod(:,1)*dt + do3_dt_ozmx(:,iLev) = (oz(:,iLev) - ozib(:)) + do3_dt_temp(:,iLev) = prod(:,3) * t(:,iLev) * dt + do3_dt_ohoz(:,iLev) = prod(:,4) * colo3(:,iLev) * dt + endif enddo return From 094860f48799e6e5737cbf1ab147770a34783629 Mon Sep 17 00:00:00 2001 From: "Bin.Li" Date: Wed, 27 Dec 2023 12:06:32 +0000 Subject: [PATCH 11/26] 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 12/26] 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 13/26] 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 14/26] 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 15/26] 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 952d62af87b36bd47dfe129e9a8fc5e6b94b388c Mon Sep 17 00:00:00 2001 From: Soren Rasmussen Date: Sun, 24 Dec 2023 21:52:12 -0700 Subject: [PATCH 16/26] zmtb, zlwb, and zogw are initialized to 0.0 to fix "intent(out) variables not given an explicit value" warning. The following table provides justification for setting the variable to 0, it is how they are treated in other places. | file | line | description | |--------------------+------+-----------------------------| | ugwpv1_gsldrag.F90 | 521 | zlwb(:)= 0. ; zogw(:)=0. | | ugwp_driver_v0.F | 206 | zmtb(i) = 0.0 | | cires_ugwp.F90 | 297 | if (do_ugwp) zlwb(:) = 0. | --- physics/GWD/unified_ugwp.F90 | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/physics/GWD/unified_ugwp.F90 b/physics/GWD/unified_ugwp.F90 index 0bcbc4f62..0b649bd10 100644 --- a/physics/GWD/unified_ugwp.F90 +++ b/physics/GWD/unified_ugwp.F90 @@ -377,6 +377,10 @@ subroutine unified_ugwp_run(me, master, im, levs, ak,bk, ntrac, dtp, fhzero, kdt errmsg = '' errflg = 0 + ! Initialize variables not being used + zmtb(:) = 0.0 + zlwb(:) = 0.0 + zogb(:) = 0.0 ! 1) ORO stationary GWs ! ------------------ From f18350846725c93f6e6221ba765c329a689b3781 Mon Sep 17 00:00:00 2001 From: Soren Rasmussen Date: Sun, 24 Dec 2023 22:08:40 -0700 Subject: [PATCH 17/26] issue 1984 fix: "intent out variables not given a value" warning. The drain_cpl and dsnow_cpl vars are changed from intent(out) to intent(in) variables. This is to replicate the rain_cpl and snow_cpl variables. --- .../Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_pre.F90 | 4 ++-- .../UFS_SCM_NEPTUNE/GFS_surface_generic_pre.meta | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_pre.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_pre.F90 index 5d321814c..de5312af7 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_pre.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_pre.F90 @@ -87,8 +87,8 @@ subroutine GFS_surface_generic_pre_run (nthreads, im, levs, vfrac, islmsk, isot, real(kind=kind_phys), dimension(:), intent(inout) :: sigmaf, work3, zlvl ! Stochastic physics / surface perturbations - real(kind=kind_phys), dimension(:), intent(out) :: drain_cpl - real(kind=kind_phys), dimension(:), intent(out) :: dsnow_cpl + real(kind=kind_phys), dimension(:), intent(in) :: drain_cpl + real(kind=kind_phys), dimension(:), intent(in) :: dsnow_cpl real(kind=kind_phys), dimension(:), intent(in) :: rain_cpl real(kind=kind_phys), dimension(:), intent(in) :: snow_cpl integer, intent(in) :: lndp_type, n_var_lndp diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_pre.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_pre.meta index bbf7dd5c3..6221fbfda 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_pre.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_pre.meta @@ -297,7 +297,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = in [dsnow_cpl] standard_name = tendency_of_lwe_thickness_of_snowfall_amount_on_dynamics_timestep_for_coupling long_name = change in show_cpl (coupling_type) @@ -305,7 +305,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = in [rain_cpl] standard_name = cumulative_lwe_thickness_of_precipitation_amount_for_coupling long_name = total rain precipitation From ba7c62719debac58280c81b9e4161b0a870d0bf3 Mon Sep 17 00:00:00 2001 From: Soren Rasmussen Date: Tue, 26 Dec 2023 11:21:02 -0700 Subject: [PATCH 18/26] issue 1984 fix: initialize err_message to "" because they are intent(out) variables. Variable err_message will report any errors in open and read statements --- physics/photochem/module_ozphys.F90 | 41 ++++++++++++++++++++--------- 1 file changed, 29 insertions(+), 12 deletions(-) diff --git a/physics/photochem/module_ozphys.F90 b/physics/photochem/module_ozphys.F90 index f824736b1..873a223b6 100644 --- a/physics/photochem/module_ozphys.F90 +++ b/physics/photochem/module_ozphys.F90 @@ -95,13 +95,18 @@ function load_o3prog(this, file, fileID) result (err_message) integer, intent(in) :: fileID character(len=*), intent(in) :: file character(len=128) :: err_message - integer :: i1, i2, i3 + integer :: i1, i2, i3, ierr real(kind=4), dimension(:), allocatable :: lat4, pres4, time4, tempin real(kind=4) :: blatc4 + ! initialize error message + err_message = "" + ! Get dimensions from data file - open(unit=fileID,file=trim(file), form='unformatted', convert='big_endian') - read (fileID) this%ncf, this%nlat, this%nlev, this%ntime + open(unit=fileID,file=trim(file), form='unformatted', convert='big_endian', iostat=ierr, iomsg=err_message) + if (ierr /= 0 ) return + read (fileID, iostat=ierr, iomsg=err_message) this%ncf, this%nlat, this%nlev, this%ntime + if (ierr /= 0 ) return rewind(fileID) allocate (this%lat(this%nlat)) @@ -111,7 +116,8 @@ function load_o3prog(this, file, fileID) result (err_message) allocate (this%data(this%nlat,this%nlev,this%ncf,this%ntime)) allocate(lat4(this%nlat), pres4(this%nlev), time4(this%ntime+1)) - read (fileID) this%ncf, this%nlat, this%nlev, this%ntime, lat4, pres4, time4 + read (fileID, iostat=ierr, iomsg=err_message) this%ncf, this%nlat, this%nlev, this%ntime, lat4, pres4, time4 + if (ierr /= 0 ) return ! Store this%pres(:) = pres4(:) @@ -124,7 +130,8 @@ function load_o3prog(this, file, fileID) result (err_message) do i1=1,this%ntime do i2=1,this%ncf do i3=1,this%nlev - read(fileID) tempin + read(fileID, iostat=ierr, iomsg=err_message) tempin + if (ierr /= 0 ) return this%data(:,i3,i2,i1) = tempin(:) enddo enddo @@ -520,12 +527,18 @@ function load_o3clim(this, file, fileID) result (err_message) ! Locals real(kind=4) :: blatc4 - integer :: iLev, iLat, imo + integer :: iLev, iLat, imo, ierr real(kind=4), allocatable :: o3clim4(:,:,:), pstr4(:) integer, allocatable :: imond(:), ilatt(:,:) - open(unit=fileID,file=trim(file), form='unformatted', convert='big_endian') - read (fileID,end=101) this%nlatc, this%nlevc, this%ntimec, blatc4 + ! initialize error message + err_message = "" + + open(unit=fileID,file=trim(file),form='unformatted',convert='big_endian', iostat=ierr, iomsg=err_message) + if (ierr /= 0 ) return + read (fileID,end=101,iostat=ierr,iomsg=err_message) this%nlatc, this%nlevc, this%ntimec, blatc4 + if (ierr /= 0 ) return + 101 if (this%nlevc < 10 .or. this%nlevc > 100) then rewind (fileID) this%nlevc = 17 @@ -545,15 +558,18 @@ function load_o3clim(this, file, fileID) result (err_message) allocate (this%pkstr(this%nlevc), this%pstr(this%nlevc), this%datac(this%nlatc,this%nlevc,12)) if ( this%nlevc == 17 ) then ! For the operational ozone climatology do iLev = 1, this%nlevc - read (fileID,15) pstr4(iLev) + read (fileID,15,iostat=ierr,iomsg=err_message) pstr4(iLev) + if (ierr /= 0 ) return 15 format(f10.3) enddo do imo = 1, 12 do iLat = 1, this%nlatc - read (fileID,16) imond(imo), ilatt(iLat,imo), (o3clim4(iLat,iLev,imo),iLev=1,10) + read (fileID,16,iostat=ierr,iomsg=err_message) imond(imo), ilatt(iLat,imo), (o3clim4(iLat,iLev,imo),iLev=1,10) + if (ierr /= 0 ) return 16 format(i2,i4,10f6.2) - read (fileID,20) (o3clim4(iLat,iLev,imo),iLev=11,this%nlevc) + read (fileID,20,iostat=ierr,iomsg=err_message) (o3clim4(iLat,iLev,imo),iLev=11,this%nlevc) + if (ierr /= 0 ) return 20 format(6x,10f6.2) enddo enddo @@ -565,7 +581,8 @@ function load_o3clim(this, file, fileID) result (err_message) do imo = 1, 12 do iLev = 1, this%nlevc - read (fileID) (o3clim4(iLat,iLev,imo),iLat=1,this%nlatc) + read (fileID,iostat=ierr,iomsg=err_message) (o3clim4(iLat,iLev,imo),iLat=1,this%nlatc) + if (ierr /= 0 ) return enddo enddo endif ! end if_this%nlevc_block From 65bf1d0fdb8593235f5dcfec2cf95b5e87a020fb Mon Sep 17 00:00:00 2001 From: Soren Rasmussen Date: Thu, 11 Jan 2024 12:36:56 -0700 Subject: [PATCH 19/26] Removing a few variables that are not used in the *_pre function --- .../GFS_surface_generic_pre.F90 | 7 +--- .../GFS_surface_generic_pre.meta | 32 ------------------- 2 files changed, 1 insertion(+), 38 deletions(-) diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_pre.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_pre.F90 index de5312af7..b85168a2d 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_pre.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_pre.F90 @@ -61,8 +61,7 @@ end subroutine GFS_surface_generic_pre_init !! subroutine GFS_surface_generic_pre_run (nthreads, im, levs, vfrac, islmsk, isot, ivegsrc, stype, scolor,vtype, slope, & prsik_1, prslk_1, tsfc, phil, con_g, sigmaf, work3, zlvl, & - drain_cpl, dsnow_cpl, rain_cpl, snow_cpl, lndp_type, n_var_lndp, sfc_wts, & - lndp_var_list, lndp_prt_list, & + lndp_type, n_var_lndp, sfc_wts, lndp_var_list, lndp_prt_list, & z01d, zt1d, bexp1d, xlai1d, vegf1d, lndp_vgf, & cplflx, flag_cice, islmsk_cice, slimskin_cpl, & wind, u1, v1, cnvwind, smcwlt2, smcref2, vtype_save, stype_save,scolor_save, slope_save, & @@ -87,10 +86,6 @@ subroutine GFS_surface_generic_pre_run (nthreads, im, levs, vfrac, islmsk, isot, real(kind=kind_phys), dimension(:), intent(inout) :: sigmaf, work3, zlvl ! Stochastic physics / surface perturbations - real(kind=kind_phys), dimension(:), intent(in) :: drain_cpl - real(kind=kind_phys), dimension(:), intent(in) :: dsnow_cpl - real(kind=kind_phys), dimension(:), intent(in) :: rain_cpl - real(kind=kind_phys), dimension(:), intent(in) :: snow_cpl integer, intent(in) :: lndp_type, n_var_lndp character(len=3), dimension(:), intent(in) :: lndp_var_list real(kind=kind_phys), dimension(:), intent(in) :: lndp_prt_list diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_pre.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_pre.meta index 6221fbfda..2b21c606d 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_pre.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_pre.meta @@ -290,38 +290,6 @@ type = real kind = kind_phys intent = inout -[drain_cpl] - standard_name = tendency_of_lwe_thickness_of_rain_amount_on_dynamics_timestep_for_coupling - long_name = change in rain_cpl (coupling_type) - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[dsnow_cpl] - standard_name = tendency_of_lwe_thickness_of_snowfall_amount_on_dynamics_timestep_for_coupling - long_name = change in show_cpl (coupling_type) - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[rain_cpl] - standard_name = cumulative_lwe_thickness_of_precipitation_amount_for_coupling - long_name = total rain precipitation - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[snow_cpl] - standard_name = cumulative_lwe_thickness_of_snow_amount_for_coupling - long_name = total snow precipitation - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in [lndp_type] standard_name = control_for_stochastic_land_surface_perturbation long_name = index for stochastic land surface perturbations type From ea70fbdaa81c2ad4b8f1b7a7b7bd31fa9115fc52 Mon Sep 17 00:00:00 2001 From: "Bin.Li" Date: Wed, 17 Jan 2024 15:42:07 +0000 Subject: [PATCH 20/26] 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 5fe0d63eee3eb05bb5e37b5e136229ac3d84cf98 Mon Sep 17 00:00:00 2001 From: "Bin.Li" Date: Thu, 25 Jan 2024 13:33:36 +0000 Subject: [PATCH 21/26] 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 51204101eeb68dcbed08d13cc0a341a25ee1a229 Mon Sep 17 00:00:00 2001 From: "Bin.Li" Date: Fri, 26 Jan 2024 09:27:17 +0000 Subject: [PATCH 22/26] 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 fd71b22e93ee9d168d91c39d795b6f906f1c5f59 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Wed, 7 Feb 2024 16:51:19 +0000 Subject: [PATCH 23/26] Fix .gitmodule --- .gitmodules | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/.gitmodules b/.gitmodules index 24b9cf118..b2d51bdfe 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,7 +1,4 @@ -[submodule "physics/rte-rrtmgp"] +[submodule "physics/Radiation/RRTMGP/rte-rrtmgp"] path = physics/Radiation/RRTMGP/rte-rrtmgp url = https://github.com/earth-system-radiation/rte-rrtmgp branch = main -[submodule "physics/Radiation/RRTMGP/rte-rrtmgp"] - path = physics/Radiation/RRTMGP/rte-rrtmgp - url = https://github.com/earth-system-radiation/rte-rrtmgp From afa4f6e18e7c5336e693cef58a315d176b93c64a Mon Sep 17 00:00:00 2001 From: Qingfu Liu Date: Fri, 9 Feb 2024 13:45:34 -0500 Subject: [PATCH 24/26] remove unused variables from files unified_ugwp.F90, dcyc2t3.f and their related meta files --- physics/GWD/unified_ugwp.F90 | 8 ++------ physics/GWD/unified_ugwp.meta | 24 ------------------------ 2 files changed, 2 insertions(+), 30 deletions(-) diff --git a/physics/GWD/unified_ugwp.F90 b/physics/GWD/unified_ugwp.F90 index 0b649bd10..fcdee3b5d 100644 --- a/physics/GWD/unified_ugwp.F90 +++ b/physics/GWD/unified_ugwp.F90 @@ -253,7 +253,7 @@ subroutine unified_ugwp_run(me, master, im, levs, ak,bk, ntrac, dtp, fhzero, kdt cdmbgwd, jdat, xlat, xlat_d, sinlat, coslat, area, & ugrs, vgrs, tgrs, q1, prsi, prsl, prslk, phii, phil, & del, kpbl, dusfcg, dvsfcg, gw_dudt, gw_dvdt, gw_dtdt, gw_kdis, & - tau_tofd, tau_mtb, tau_ogw, tau_ngw, zmtb, zlwb, zogw, & + tau_tofd, tau_mtb, tau_ogw, tau_ngw, & dudt_mtb, dudt_tms, du3dt_mtb, du3dt_ogw, du3dt_tms, & dudt, dvdt, dtdt, rdxzb, con_g, con_omega, con_pi, con_cp, con_rd, con_rv, & con_rerth, con_fvirt, rain, ntke, q_tke, dqdt_tke, lprnt, ipr, & @@ -309,7 +309,7 @@ subroutine unified_ugwp_run(me, master, im, levs, ak,bk, ntrac, dtp, fhzero, kdt & slmsk(:) real(kind=kind_phys), intent(out), dimension(:) :: dusfcg, dvsfcg - real(kind=kind_phys), intent(out), dimension(:) :: zmtb, zlwb, zogw, rdxzb + real(kind=kind_phys), intent(out), dimension(:) :: rdxzb real(kind=kind_phys), intent(out), dimension(:) :: tau_mtb, tau_ogw, tau_tofd, tau_ngw real(kind=kind_phys), intent(out), dimension(:,:) :: gw_dudt, gw_dvdt, gw_dtdt, gw_kdis real(kind=kind_phys), intent(out), dimension(:,:) :: dudt_mtb, dudt_tms @@ -377,10 +377,6 @@ subroutine unified_ugwp_run(me, master, im, levs, ak,bk, ntrac, dtp, fhzero, kdt errmsg = '' errflg = 0 - ! Initialize variables not being used - zmtb(:) = 0.0 - zlwb(:) = 0.0 - zogb(:) = 0.0 ! 1) ORO stationary GWs ! ------------------ diff --git a/physics/GWD/unified_ugwp.meta b/physics/GWD/unified_ugwp.meta index a08ee3960..189f7072c 100644 --- a/physics/GWD/unified_ugwp.meta +++ b/physics/GWD/unified_ugwp.meta @@ -900,30 +900,6 @@ type = real kind = kind_phys intent = out -[zmtb] - standard_name = height_of_mountain_blocking - long_name = height of mountain blocking drag - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out -[zlwb] - standard_name = height_of_low_level_wave_breaking - long_name = height of low level wave breaking - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out -[zogw] - standard_name = height_of_launch_level_of_orographic_gravity_wave - long_name = height of launch level of orographic gravity wave - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out [dudt_mtb] standard_name = instantaneous_change_in_x_wind_due_to_mountain_blocking_drag long_name = instantaneous change in x wind due to mountain blocking drag From 82c6873942c387fcf7c2febbb707563ea95917ca Mon Sep 17 00:00:00 2001 From: Qingfu Liu Date: Fri, 9 Feb 2024 14:01:36 -0500 Subject: [PATCH 25/26] remove unused variables from files dcyc2t3.f and dcyc2t3.meta --- physics/Interstitials/UFS_SCM_NEPTUNE/dcyc2t3.f | 8 ++++---- physics/Interstitials/UFS_SCM_NEPTUNE/dcyc2t3.meta | 8 -------- 2 files changed, 4 insertions(+), 12 deletions(-) diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/dcyc2t3.f b/physics/Interstitials/UFS_SCM_NEPTUNE/dcyc2t3.f index 36299651d..1e373ae12 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/dcyc2t3.f +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/dcyc2t3.f @@ -44,7 +44,7 @@ module dcyc2t3 ! input/output: ! ! dtdt,dtdtnp, ! ! outputs: ! -! adjsfcdsw,adjsfcnsw,adjsfcdlw,adjsfculw, ! +! adjsfcdsw,adjsfcnsw,adjsfcdlw, ! ! adjsfculw_lnd,adjsfculw_ice,adjsfculw_wat,xmu,xcosz, ! ! adjnirbmu,adjnirdfu,adjvisbmu,adjvisdfu, ! ! adjdnnbmd,adjdnndfd,adjdnvbmd,adjdnvdfd) ! @@ -181,7 +181,7 @@ subroutine dcyc2t3_run & ! --- input/output: & dtdt,dtdtnp,htrlw, & ! --- outputs: - & adjsfcdsw,adjsfcnsw,adjsfcdlw,adjsfculw, & + & adjsfcdsw,adjsfcnsw,adjsfcdlw, & & adjsfculw_lnd,adjsfculw_ice,adjsfculw_wat,xmu,xcosz, & & adjnirbmu,adjnirdfu,adjvisbmu,adjvisdfu, & & adjnirbmd,adjnirdfd,adjvisbmd,adjvisdfd, & @@ -242,7 +242,7 @@ subroutine dcyc2t3_run & ! --- outputs: real(kind=kind_phys), dimension(:), intent(out) :: & - & adjsfcdsw, adjsfcnsw, adjsfcdlw, adjsfculw, xmu, xcosz, & + & adjsfcdsw, adjsfcnsw, adjsfcdlw, xmu, xcosz, & & adjnirbmu, adjnirdfu, adjvisbmu, adjvisdfu, & & adjnirbmd, adjnirdfd, adjvisbmd, adjvisdfd @@ -352,7 +352,7 @@ subroutine dcyc2t3_run & ! if (lprnt .and. i == ipr) write(0,*)' in dcyc3: dry==',dry(i) ! &,' wet=',wet(i),' icy=',icy(i),' tsfc3=',tsfc3(i,:) -! &,' sfcemis=',sfcemis(i,:),' adjsfculw=',adjsfculw(i,:) +! &,' sfcemis=',sfcemis(i,:) ! !> - normalize by average value over radiation period for daytime. diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/dcyc2t3.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/dcyc2t3.meta index 95b3f341b..6f8a0eda0 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/dcyc2t3.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/dcyc2t3.meta @@ -524,14 +524,6 @@ type = real kind = kind_phys intent = out -[adjsfculw] - standard_name = surface_upwelling_longwave_flux - long_name = surface upwelling longwave flux at current time - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out [adjsfculw_lnd] standard_name = surface_upwelling_longwave_flux_over_land long_name = surface upwelling longwave flux at current time over land From 3fa192f76e445d150ab9e52aa98614e1191205d0 Mon Sep 17 00:00:00 2001 From: "Shan.Sun" Date: Wed, 14 Feb 2024 18:14:08 +0000 Subject: [PATCH 26/26] ufs-community/ccpp-physics issue #172 (wrong ice temperature in the coupled UFS ATM output during summer) -- 'tisfc' is no longer modified by the atmospheric model, i.e., allowing the ice model to determine the ice temperature over both sea ice and lake ice; -- Changing tisfc from intent(inout) to intent(in). Co-authored-by: Jun Wang --- .../UFS_SCM_NEPTUNE/GFS_surface_composites_pre.F90 | 10 ++-------- .../UFS_SCM_NEPTUNE/GFS_surface_composites_pre.meta | 2 +- 2 files changed, 3 insertions(+), 9 deletions(-) diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_pre.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_pre.F90 index fd16dea59..d36a86721 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_pre.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_pre.F90 @@ -42,9 +42,9 @@ subroutine GFS_surface_composites_pre_run (im, lkm, frac_grid, iopt_lake, iopt_l real(kind=kind_phys), dimension(:), intent(in ) :: landfrac, lakefrac, lakedepth, oceanfrac real(kind=kind_phys), dimension(:), intent(inout) :: cice, hice real(kind=kind_phys), dimension(:), intent( out) :: frland - real(kind=kind_phys), dimension(:), intent(in ) :: snowd, tprcp, uustar, weasd, qss + real(kind=kind_phys), dimension(:), intent(in ) :: snowd, tprcp, uustar, weasd, qss, tisfc - real(kind=kind_phys), dimension(:), intent(inout) :: tsfc, tsfco, tsfcl, tisfc + real(kind=kind_phys), dimension(:), intent(inout) :: tsfc, tsfco, tsfcl real(kind=kind_phys), dimension(:), intent(inout) :: snowd_lnd, snowd_ice, tprcp_wat, & tprcp_lnd, tprcp_ice, tsfc_wat, tsurf_wat,tsurf_lnd, tsurf_ice, & uustar_wat, uustar_lnd, uustar_ice, weasd_lnd, weasd_ice, & @@ -86,7 +86,6 @@ subroutine GFS_surface_composites_pre_run (im, lkm, frac_grid, iopt_lake, iopt_l if (oceanfrac(i) > zero) then if (cice(i) >= min_seaice) then icy(i) = .true. - tisfc(i) = max(timin, min(tisfc(i), tgice)) if (cplflx) then islmsk_cice(i) = 4 flag_cice(i) = .true. @@ -111,7 +110,6 @@ subroutine GFS_surface_composites_pre_run (im, lkm, frac_grid, iopt_lake, iopt_l if (cice(i) >= min_lakeice) then icy(i) = .true. islmsk(i) = 2 - tisfc(i) = max(timin, min(tisfc(i), tgice)) else cice(i) = zero hice(i) = zero @@ -151,7 +149,6 @@ subroutine GFS_surface_composites_pre_run (im, lkm, frac_grid, iopt_lake, iopt_l if (oceanfrac(i) > zero) then if (cice(i) >= min_seaice) then icy(i) = .true. - tisfc(i) = max(timin, min(tisfc(i), tgice)) ! This cplice namelist option was added to deal with the ! situation of the FV3ATM-HYCOM coupling without an active sea ! ice (e.g., CICE6) component. By default, the cplice is true @@ -187,9 +184,6 @@ subroutine GFS_surface_composites_pre_run (im, lkm, frac_grid, iopt_lake, iopt_l is_clm = lkm>0 .and. iopt_lake==iopt_lake_clm .and. use_lake_model(i)>0 if (cice(i) >= min_lakeice) then icy(i) = .true. - if(.not.is_clm) then - tisfc(i) = max(timin, min(tisfc(i), tgice)) - endif islmsk(i) = 2 else cice(i) = zero diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_pre.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_pre.meta index 33e2f0523..4d1021118 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_pre.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_pre.meta @@ -358,7 +358,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = inout + intent = in [tsurf_wat] standard_name = surface_skin_temperature_after_iteration_over_water long_name = surface skin temperature after iteration over water