From 4e45989d1f6f78bb05aa789289d4cebebe9217b7 Mon Sep 17 00:00:00 2001 From: Qingfu Liu Date: Mon, 16 Oct 2023 09:46:45 -0400 Subject: [PATCH 01/42] Code update for HR4_roughness --- physics/sfc_diff.f | 43 +++++++++++++++++++++++++++++-------------- 1 file changed, 29 insertions(+), 14 deletions(-) diff --git a/physics/sfc_diff.f b/physics/sfc_diff.f index 6e834537a..561a087c4 100644 --- a/physics/sfc_diff.f +++ b/physics/sfc_diff.f @@ -348,12 +348,26 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) tvs = half * (tsurf_wat(i)+tskin_wat(i))/prsik1(i) & * virtfac endif - - 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 (sfc_z0_type == -1) then ! using wave model derived momentum roughness + tem1 = 0.11 * vis / ustar_wat(i) + z0 = tem1 + 0.01_kp * z0rl_wav(i) + if (redrag) then + z0max = max(min(z0, z0s_max),1.0e-7_kp) + else + z0max = max(min(z0,0.1_kp), 1.0e-7_kp) + endif + z0rl_wat(i) = 100.0_kp * z0max ! cm + else + z0 = 0.01_kp * z0rl_wat(i) + z0max = max(zmin, min(z0,z1(i))) + endif +! +! ustar_wat(i) = sqrt(grav * z0 / charnock) +! !** test xubin's new z0 ! ztmax = z0max @@ -423,17 +437,18 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) z0rl_wat(i) = 1.0e-4_kp endif - elseif (z0rl_wav(i) <= 1.0e-7_kp .or. & - & z0rl_wav(i) > 1.0_kp) then -! z0 = (charnock / grav) * ustar_wat(i) * ustar_wat(i) - tem1 = 0.11 * vis / ustar_wat(i) - z0 = tem1 + (charnock/grav)*ustar_wat(i)*ustar_wat(i) +! elseif (z0rl_wav(i) <= 1.0e-7_kp .or. & +! & z0rl_wav(i) > 1.0_kp) then +!! z0 = (charnock / grav) * ustar_wat(i) * ustar_wat(i) +! tem1 = 0.11 * vis / ustar_wat(i) +! z0 = tem1 + (charnock/grav)*ustar_wat(i)*ustar_wat(i) + +! if (redrag) then +! z0rl_wat(i) = 100.0_kp * max(min(z0, z0s_max),1.0e-7_kp) +! else +! z0rl_wat(i) = 100.0_kp * max(min(z0,0.1_kp), 1.0e-7_kp) +! endif - if (redrag) then - z0rl_wat(i) = 100.0_kp * max(min(z0, z0s_max),1.0e-7_kp) - else - z0rl_wat(i) = 100.0_kp * max(min(z0,0.1_kp), 1.0e-7_kp) - endif endif endif ! end of if(open ocean) From 3debf89fdc94111624f0b99da71e605418824183 Mon Sep 17 00:00:00 2001 From: Qingfu Liu Date: Mon, 16 Oct 2023 10:45:21 -0400 Subject: [PATCH 02/42] Code update for HR4_roughness --- physics/sfc_diff.f | 12 ------------ 1 file changed, 12 deletions(-) diff --git a/physics/sfc_diff.f b/physics/sfc_diff.f index 561a087c4..d56308b79 100644 --- a/physics/sfc_diff.f +++ b/physics/sfc_diff.f @@ -437,18 +437,6 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) z0rl_wat(i) = 1.0e-4_kp endif -! elseif (z0rl_wav(i) <= 1.0e-7_kp .or. & -! & z0rl_wav(i) > 1.0_kp) then -!! z0 = (charnock / grav) * ustar_wat(i) * ustar_wat(i) -! tem1 = 0.11 * vis / ustar_wat(i) -! z0 = tem1 + (charnock/grav)*ustar_wat(i)*ustar_wat(i) - -! if (redrag) then -! z0rl_wat(i) = 100.0_kp * max(min(z0, z0s_max),1.0e-7_kp) -! else -! z0rl_wat(i) = 100.0_kp * max(min(z0,0.1_kp), 1.0e-7_kp) -! endif - endif endif ! end of if(open ocean) From c2b130113acf235e7c5e65bfd5f97ca2e8e3a3d7 Mon Sep 17 00:00:00 2001 From: Qingfu Liu Date: Mon, 16 Oct 2023 10:55:07 -0400 Subject: [PATCH 03/42] Code update for HR4_roughness --- physics/sfc_diff.f | 2 -- 1 file changed, 2 deletions(-) diff --git a/physics/sfc_diff.f b/physics/sfc_diff.f index d56308b79..b28daef3b 100644 --- a/physics/sfc_diff.f +++ b/physics/sfc_diff.f @@ -366,8 +366,6 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) z0max = max(zmin, min(z0,z1(i))) endif ! -! ustar_wat(i) = sqrt(grav * z0 / charnock) -! !** test xubin's new z0 ! ztmax = z0max From 9dc3d4063619b999316e2e269a3eb37d3c169173 Mon Sep 17 00:00:00 2001 From: "Bin.Li" Date: Mon, 20 Nov 2023 15:57:15 +0000 Subject: [PATCH 04/42] 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 05/42] 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 06/42] 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 562377cc0b337f8f335eb5eec2b68ea3e9ec74e6 Mon Sep 17 00:00:00 2001 From: Qingfu Liu Date: Tue, 28 Nov 2023 15:30:10 -0500 Subject: [PATCH 07/42] remove files from old version --- physics/GFS_ccpp_suite_sim_pre.F90 | 442 ----------------------- physics/GFS_ccpp_suite_sim_pre.meta | 174 --------- physics/ccpp_suite_simulator.F90 | 212 ----------- physics/ccpp_suite_simulator.meta | 201 ----------- physics/module_ccpp_suite_simulator.F90 | 328 ----------------- physics/module_ccpp_suite_simulator.meta | 24 -- 6 files changed, 1381 deletions(-) delete mode 100644 physics/GFS_ccpp_suite_sim_pre.F90 delete mode 100644 physics/GFS_ccpp_suite_sim_pre.meta delete mode 100644 physics/ccpp_suite_simulator.F90 delete mode 100644 physics/ccpp_suite_simulator.meta delete mode 100644 physics/module_ccpp_suite_simulator.F90 delete mode 100644 physics/module_ccpp_suite_simulator.meta diff --git a/physics/GFS_ccpp_suite_sim_pre.F90 b/physics/GFS_ccpp_suite_sim_pre.F90 deleted file mode 100644 index fbaf5a1d9..000000000 --- a/physics/GFS_ccpp_suite_sim_pre.F90 +++ /dev/null @@ -1,442 +0,0 @@ -! ######################################################################################## -! -! Description: Interstitial CCPP suite to couple UFS physics to ccpp_suite_simulator. -! -! Contains: -! - load_ccpp_suite_sim(): read and load data into type used by ccpp_suite_simulator. -! called once during model initialization -! - GFS_ccpp_suite_sim_pre_run(): prepare GFS diagnostic physics tendencies for -! ccpp_suite_simulator. -! -! ######################################################################################## -module GFS_ccpp_suite_sim_pre - use machine, only: kind_phys - use module_ccpp_suite_simulator, only: base_physics_process - use netcdf - implicit none - public GFS_ccpp_suite_sim_pre_run, load_ccpp_suite_sim -contains - - ! ###################################################################################### - ! - ! SUBROUTINE GFS_ccpp_suite_sim_pre_run - ! - ! ###################################################################################### -!! \section arg_table_GFS_ccpp_suite_sim_pre_run -!! \htmlinclude GFS_ccpp_suite_sim_pre_run.html -!! - subroutine GFS_ccpp_suite_sim_pre_run(do_ccpp_suite_sim, dtend, ntqv, dtidx, dtp, & - index_of_process_dcnv, index_of_process_longwave, index_of_process_shortwave, & - index_of_process_scnv, index_of_process_orographic_gwd, index_of_process_pbl, & - index_of_process_mp, index_of_temperature, index_of_x_wind, index_of_y_wind, & - physics_process, iactive_T, iactive_u, iactive_v, iactive_q, active_phys_tend, & - errmsg, errflg) - - ! Inputs - logical, intent(in) :: do_ccpp_suite_sim - integer, intent(in) :: ntqv, index_of_process_dcnv, index_of_process_longwave, & - index_of_process_shortwave, index_of_process_scnv, & - index_of_process_orographic_gwd, index_of_process_pbl, index_of_process_mp, & - index_of_temperature, index_of_x_wind, index_of_y_wind - integer, intent(in), dimension(:,:) :: dtidx - real(kind_phys), intent(in) :: dtp - real(kind_phys), intent(in), dimension(:,:,:) :: dtend - type(base_physics_process),intent(in) :: physics_process(:) - integer, intent(in) :: iactive_T, iactive_u, iactive_v, iactive_q - - ! Outputs - real(kind_phys), intent(out) :: active_phys_tend(:,:,:) - character(len=*),intent(out) :: errmsg - integer, intent(out) :: errflg - - ! Locals - integer :: idtend, iactive - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - if (.not. do_ccpp_suite_sim) return - - ! Get tendency for "active" process. - - ! ###################################################################################### - ! DJS2023: For the UFS and SCM, the physics tendencies are stored in a multi-dimensional - ! array, CCPP standard_name = cumulative_change_of_state_variables. - ! These are not the instantaneous physics tendencies that are applied to the state by - ! the physics suites. Not all suites output physics tendencies... - ! Rather these are intended for diagnostic puposes and are accumulated over some - ! interval. - ! In the UFS/SCM this is controlled by the diagnostic bucket interval, namelist option - ! "fhzero". For this to work, you need to clear the diagnostic buckets after each - ! physics timestep when running in the UFS/SCM. - ! - ! In the SCM this is done by adding the following runtime options: - ! --n_itt_out 1 --n_itt_diag 1 - ! - ! ###################################################################################### - if (physics_process(1)%active_name == "LWRAD") iactive = index_of_process_longwave - if (physics_process(1)%active_name == "SWRAD") iactive = index_of_process_shortwave - if (physics_process(1)%active_name == "PBL") iactive = index_of_process_pbl - if (physics_process(1)%active_name == "GWD") iactive = index_of_process_orographic_gwd - if (physics_process(1)%active_name == "SCNV") iactive = index_of_process_scnv - if (physics_process(1)%active_name == "DCNV") iactive = index_of_process_dcnv - if (physics_process(1)%active_name == "cldMP") iactive = index_of_process_mp - - ! Heat - idtend = dtidx(index_of_temperature,iactive) - if (idtend >= 1) then - active_phys_tend(:,:,iactive_T) = dtend(:,:,idtend)/dtp - endif - - ! u-wind - idtend = dtidx(index_of_x_wind,iactive) - if (idtend >= 1) then - active_phys_tend(:,:,iactive_u) = dtend(:,:,idtend)/dtp - endif - - ! v-wind - idtend = dtidx(index_of_y_wind,iactive) - if (idtend >= 1) then - active_phys_tend(:,:,iactive_v) = dtend(:,:,idtend)/dtp - endif - - ! Moisture - idtend = dtidx(100+ntqv,iactive) - if (idtend >= 1) then - active_phys_tend(:,:,iactive_q) = dtend(:,:,idtend)/dtp - endif - - end subroutine GFS_ccpp_suite_sim_pre_run - - ! ###################################################################################### - subroutine load_ccpp_suite_sim(nlunit, nml_file, physics_process, iactive_T, & - iactive_u, iactive_v, iactive_q, errmsg, errflg) - - ! Inputs - integer, intent (in) :: nlunit - character(len=*), intent (in) :: nml_file - - ! Outputs - type(base_physics_process),intent(inout),allocatable :: physics_process(:) - integer, intent(inout) :: iactive_T, iactive_u, iactive_v, iactive_q - integer, intent(out) :: errflg - character(len=256), intent(out) :: errmsg - - ! Local variables - integer :: ncid, dimID, varID, status, ios, iprc, nlev_data, ntime_data - character(len=256) :: suite_sim_file - logical :: exists, do_ccpp_suite_sim - integer :: nprc_sim - - ! For each process there is a corresponding namelist entry, which is constructed as - ! follows: - ! {use_suite_sim[0(no)/1(yes)], time_split[0(no)/1(yes)], order[1:nPhysProcess]} - integer, dimension(3) :: & - prc_LWRAD_cfg = (/0,0,0/), & - prc_SWRAD_cfg = (/0,0,0/), & - prc_PBL_cfg = (/0,0,0/), & - prc_GWD_cfg = (/0,0,0/), & - prc_SCNV_cfg = (/0,0,0/), & - prc_DCNV_cfg = (/0,0,0/), & - prc_cldMP_cfg = (/0,0,0/) - - ! Namelist - namelist / ccpp_suite_sim_nml / do_ccpp_suite_sim, suite_sim_file, nprc_sim, & - prc_LWRAD_cfg, prc_SWRAD_cfg, prc_PBL_cfg, prc_GWD_cfg, prc_SCNV_cfg, & - prc_DCNV_cfg, prc_cldMP_cfg - - errmsg = '' - errflg = 0 - - ! Read in namelist - inquire (file = trim (nml_file), exist = exists) - if (.not. exists) then - errmsg = 'CCPP suite simulator namelist file: '//trim(nml_file)//' does not exist.' - errflg = 1 - return - else - open (unit = nlunit, file = nml_file, action = 'read', status = 'old', iostat = ios) - endif - rewind (nlunit) - read (nlunit, nml = ccpp_suite_sim_nml, iostat=status) - close (nlunit) - - ! Only proceed if suite simulator requested. - if (prc_SWRAD_cfg(1) == 1 .or. prc_LWRAD_cfg(1) == 1 .or. prc_PBL_cfg(1) == 1 .or. & - prc_GWD_cfg(1) == 1 .or. prc_SCNV_cfg(1) == 1 .or. prc_DCNV_cfg(1) == 1 .or. & - prc_cldMP_cfg(1) == 1 ) then - else - return - endif - - ! Check that input data file exists. - inquire (file = trim (suite_sim_file), exist = exists) - if (.not. exists) then - errmsg = 'CCPP suite simulator file: '//trim(suite_sim_file)//' does not exist' - errflg = 1 - return - endif - - ! - ! Read data file... - ! - - ! Open file - status = nf90_open(trim(suite_sim_file), NF90_NOWRITE, ncid) - if (status /= nf90_noerr) then - errmsg = 'Error reading in CCPP suite simulator file: '//trim(suite_sim_file) - errflg = 1 - return - endif - - ! Metadata (dimensions) - status = nf90_inq_dimid(ncid, 'time', dimid) - if (status == nf90_noerr) then - status = nf90_inquire_dimension(ncid, dimid, len = ntime_data) - else - errmsg = 'CCPP suite simulator file: '//trim(suite_sim_file)//' does not contain [time] dimension' - errflg = 1 - return - endif - - status = nf90_inq_dimid(ncid, 'lev', dimid) - if (status == nf90_noerr) then - status = nf90_inquire_dimension(ncid, dimid, len = nlev_data) - else - errmsg = 'CCPP suite simulator file: '//trim(suite_sim_file)//' does not contain [lev] dimension' - errflg = 1 - return - endif - - ! Allocate space and read in data - allocate(physics_process(nprc_sim)) - physics_process(1)%active_name = '' - physics_process(1)%iactive_scheme = 0 - physics_process(1)%active_tsp = .false. - do iprc = 1,nprc_sim - allocate(physics_process(iprc)%tend1d%T( nlev_data )) - allocate(physics_process(iprc)%tend1d%u( nlev_data )) - allocate(physics_process(iprc)%tend1d%v( nlev_data )) - allocate(physics_process(iprc)%tend1d%q( nlev_data )) - allocate(physics_process(iprc)%tend2d%time( ntime_data)) - allocate(physics_process(iprc)%tend2d%T( nlev_data, ntime_data)) - allocate(physics_process(iprc)%tend2d%u( nlev_data, ntime_data)) - allocate(physics_process(iprc)%tend2d%v( nlev_data, ntime_data)) - allocate(physics_process(iprc)%tend2d%q( nlev_data, ntime_data)) - - ! Temporal info - status = nf90_inq_varid(ncid, 'times', varID) - if (status == nf90_noerr) then - status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%time) - else - errmsg = 'SCM data tendency file: '//trim(suite_sim_file)//' does not contain times variable' - errflg = 1 - return - endif - - if (iprc == prc_SWRAD_cfg(3)) then - ! Metadata - physics_process(iprc)%order = iprc - physics_process(iprc)%name = "SWRAD" - if (prc_SWRAD_cfg(1) == 1) then - physics_process(iprc)%use_sim = .true. - else - physics_process(1)%nprg_active = 1 - iactive_T = 1 - endif - if (prc_SWRAD_cfg(2) == 1) then - physics_process(iprc)%time_split = .true. - endif - - ! Data - status = nf90_inq_varid(ncid, 'dT_dt_swrad', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%T) - endif - - if (iprc == prc_LWRAD_cfg(3)) then - ! Metadata - physics_process(iprc)%order = iprc - physics_process(iprc)%name = "LWRAD" - if (prc_LWRAD_cfg(1) == 1) then - physics_process(iprc)%use_sim = .true. - else - physics_process(1)%nprg_active = 1 - iactive_T = 1 - endif - if (prc_LWRAD_cfg(2) == 1) then - physics_process(iprc)%time_split = .true. - endif - - ! Data - status = nf90_inq_varid(ncid, 'dT_dt_lwrad', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%T) - endif - - if (iprc == prc_GWD_cfg(3)) then - ! Metadata - physics_process(iprc)%order = iprc - physics_process(iprc)%name = "GWD" - if (prc_GWD_cfg(1) == 1) then - physics_process(iprc)%use_sim = .true. - else - physics_process(1)%nprg_active = 3 - iactive_T = 1 - iactive_u = 2 - iactive_v = 3 - endif - if (prc_GWD_cfg(2) == 1) then - physics_process(iprc)%time_split = .true. - endif - - ! Data - status = nf90_inq_varid(ncid, 'dT_dt_cgwd', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%T) - status = nf90_inq_varid(ncid, 'du_dt_cgwd', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%u) - status = nf90_inq_varid(ncid, 'dv_dt_cgwd', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%v) - endif - - if (iprc == prc_PBL_cfg(3)) then - ! Metadata - physics_process(iprc)%order = iprc - physics_process(iprc)%name = "PBL" - if (prc_PBL_cfg(1) == 1) then - physics_process(iprc)%use_sim = .true. - else - physics_process(1)%nprg_active = 4 - iactive_T = 1 - iactive_u = 2 - iactive_v = 3 - iactive_q = 4 - endif - if (prc_PBL_cfg(2) == 1) then - physics_process(iprc)%time_split = .true. - endif - - ! Data - status = nf90_inq_varid(ncid, 'dT_dt_pbl', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%T) - status = nf90_inq_varid(ncid, 'dq_dt_pbl', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%q) - status = nf90_inq_varid(ncid, 'du_dt_pbl', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%u) - status = nf90_inq_varid(ncid, 'dv_dt_pbl', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%v) - endif - - if (iprc == prc_SCNV_cfg(3)) then - ! Metadata - physics_process(iprc)%order = iprc - physics_process(iprc)%name = "SCNV" - if (prc_SCNV_cfg(1) == 1) then - physics_process(iprc)%use_sim = .true. - else - physics_process(1)%nprg_active = 4 - iactive_T = 1 - iactive_u = 2 - iactive_v = 3 - iactive_q = 4 - endif - if (prc_SCNV_cfg(2) == 1) then - physics_process(iprc)%time_split = .true. - endif - - ! Data - status = nf90_inq_varid(ncid, 'dT_dt_shalconv', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%T) - status = nf90_inq_varid(ncid, 'du_dt_shalconv', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%u) - status = nf90_inq_varid(ncid, 'dv_dt_shalconv', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%v) - status = nf90_inq_varid(ncid, 'dq_dt_shalconv', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%q) - endif - - if (iprc == prc_DCNV_cfg(3)) then - ! Metadata - physics_process(iprc)%order = iprc - physics_process(iprc)%name = "DCNV" - if (prc_DCNV_cfg(1) == 1) then - physics_process(iprc)%use_sim = .true. - else - physics_process(1)%nprg_active = 4 - iactive_T = 1 - iactive_u = 2 - iactive_v = 3 - iactive_q = 4 - endif - if (prc_DCNV_cfg(2) == 1) then - physics_process(iprc)%time_split = .true. - endif - ! Data - status = nf90_inq_varid(ncid, 'dT_dt_deepconv', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%T) - status = nf90_inq_varid(ncid, 'du_dt_deepconv', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%u) - status = nf90_inq_varid(ncid, 'dv_dt_deepconv', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%v) - status = nf90_inq_varid(ncid, 'dq_dt_deepconv', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%q) - endif - - if (iprc == prc_cldMP_cfg(3)) then - ! Metadata - physics_process(iprc)%order = iprc - physics_process(iprc)%name = "cldMP" - if (prc_cldMP_cfg(1) == 1) then - physics_process(iprc)%use_sim = .true. - else - physics_process(1)%nprg_active = 2 - iactive_T = 1 - iactive_q = 2 - endif - if (prc_cldMP_cfg(2) == 1) then - physics_process(iprc)%time_split = .true. - endif - - ! Data - status = nf90_inq_varid(ncid, 'dT_dt_micro', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%T) - status = nf90_inq_varid(ncid, 'dq_dt_micro', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%q) - endif - - ! Which process-suite is "active"? Is process time-split? - if (.not. physics_process(iprc)%use_sim) then - physics_process(1)%iactive_scheme = iprc - physics_process(1)%active_name = physics_process(iprc)%name - if (physics_process(iprc)%time_split) then - physics_process(1)%active_tsp = .true. - endif - endif - - enddo - - if (physics_process(1)%iactive_scheme == 0) then - errflg = 1 - errmsg = "ERROR: No active suite set for CCPP suite simulator" - return - endif - - print*, "-----------------------------------" - print*, "--- Using CCPP suite simulator ---" - print*, "-----------------------------------" - do iprc = 1,nprc_sim - if (physics_process(iprc)%use_sim) then - print*," simulate_suite: ", trim(physics_process(iprc)%name) - print*," order: ", physics_process(iprc)%order - print*," time_split: ", physics_process(iprc)%time_split - else - print*, " active_suite: ", trim(physics_process(1)%active_name) - print*, " order: ", physics_process(physics_process(1)%iactive_scheme)%order - print*, " time_split : ", physics_process(1)%active_tsp - endif - enddo - print*, "-----------------------------------" - print*, "-----------------------------------" - - end subroutine load_ccpp_suite_sim - -end module GFS_ccpp_suite_sim_pre diff --git a/physics/GFS_ccpp_suite_sim_pre.meta b/physics/GFS_ccpp_suite_sim_pre.meta deleted file mode 100644 index cc73813fa..000000000 --- a/physics/GFS_ccpp_suite_sim_pre.meta +++ /dev/null @@ -1,174 +0,0 @@ -[ccpp-table-properties] - name = GFS_ccpp_suite_sim_pre - type = scheme - dependencies = machine.F,module_ccpp_suite_simulator.F90 - -######################################################################## -[ccpp-arg-table] - name = GFS_ccpp_suite_sim_pre_run - type = scheme -[do_ccpp_suite_sim] - standard_name = flag_for_ccpp_suite_simulator - long_name = flag for ccpp suite simulator - units = flag - dimensions = () - type = logical - intent = in -[physics_process] - standard_name = physics_process_type_for_CCPP_suite_simulator - long_name = physics process type for CCPP suite simulator - units = mixed - dimensions = (number_of_physics_process_in_CCPP_suite_simulator) - type = base_physics_process - intent = in -[dtend] - standard_name = cumulative_change_of_state_variables - long_name = diagnostic tendencies for state variables - units = mixed - dimensions = (horizontal_loop_extent,vertical_layer_dimension,cumulative_change_of_state_variables_outer_index_max) - type = real - kind = kind_phys - intent = in -[dtidx] - standard_name = cumulative_change_of_state_variables_outer_index - long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index - units = index - dimensions = (number_of_tracers_plus_one_hundred,number_of_cumulative_change_processes) - type = integer - intent = in -[dtp] - standard_name = timestep_for_physics - long_name = physics timestep - units = s - dimensions = () - type = real - kind = kind_phys - intent = in -[index_of_process_dcnv] - standard_name = index_of_deep_convection_process_process_in_cumulative_change_index - long_name = index of deep convection process in second dimension of array cumulative change index - units = index - dimensions = () - type = integer - intent = in -[index_of_process_longwave] - standard_name = index_of_longwave_heating_process_in_cumulative_change_index - long_name = index of longwave heating process in second dimension of array cumulative change index - units = index - dimensions = () - type = integer - intent = in -[index_of_process_shortwave] - standard_name = index_of_shortwave_heating_process_in_cumulative_change_index - long_name = index of shortwave heating process in second dimension of array cumulative change index - units = index - dimensions = () - type = integer - intent = in -[index_of_process_orographic_gwd] - standard_name = index_of_orographic_gravity_wave_drag_process_in_cumulative_change_index - long_name = index of orographic gravity wave drag process in second dimension of array cumulative change index - units = index - dimensions = () - type = integer - intent = in -[index_of_process_scnv] - standard_name = index_of_shallow_convection_process_process_in_cumulative_change_index - long_name = index of shallow convection process in second dimension of array cumulative change index - units = index - dimensions = () - type = integer - intent = in -[index_of_process_pbl] - standard_name = index_of_subgrid_scale_vertical_mixing_process_in_cumulative_change_index - long_name = index of subgrid scale vertical mixing process in second dimension of array cumulative change index - units = index - dimensions = () - type = integer - intent = in -[index_of_process_mp] - standard_name = index_of_microphysics_process_process_in_cumulative_change_index - long_name = index of microphysics transport process in second dimension of array cumulative change index - units = index - dimensions = () - type = integer - intent = in -[index_of_temperature] - standard_name = index_of_temperature_in_cumulative_change_index - long_name = index of temperature in first dimension of array cumulative change index - units = index - dimensions = () - type = integer - intent = in -[index_of_x_wind] - standard_name = index_of_x_wind_in_cumulative_change_index - long_name = index of x-wind in first dimension of array cumulative change index - units = index - dimensions = () - type = integer - intent = in -[index_of_y_wind] - standard_name = index_of_y_wind_in_cumulative_change_index - long_name = index of x-wind in first dimension of array cumulative change index - units = index - dimensions = () - type = integer - intent = in -[ntqv] - standard_name = index_of_specific_humidity_in_tracer_concentration_array - long_name = tracer index for water vapor (specific humidity) - units = index - dimensions = () - type = integer - intent = in -[active_phys_tend] - standard_name = tendencies_for_active_process_in_ccpp_suite_simulator - long_name = tendencies for active physics process in ccpp suite simulator - units = mixed - dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_prognostics_varaibles_in_CCPP_suite_simulator) - type = real - kind = kind_phys - intent = out -[iactive_T] - standard_name = index_for_active_T_in_CCPP_suite_simulator - long_name = index into active process tracer array for temperature in CCPP suite simulator - units = count - dimensions = () - type = integer - intent = in -[iactive_u] - standard_name = index_for_active_u_in_CCPP_suite_simulator - long_name = index into active process tracer array for zonal wind in CCPP suite simulator - units = count - dimensions = () - type = integer - intent = in -[iactive_v] - standard_name = index_for_active_v_in_CCPP_suite_simulator - long_name = index into active process tracer array for meridional wind in CCPP suite simulator - units = count - dimensions = () - type = integer - intent = in -[iactive_q] - standard_name = index_for_active_q_in_CCPP_suite_simulator - long_name = index into active process tracer array for moisture in CCPP suite simulator - units = count - dimensions = () - type = integer - intent = in -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out -[errflg] - standard_name = ccpp_error_code - long_name = error code for error handling in CCPP - units = 1 - dimensions = () - type = integer - intent = out \ No newline at end of file diff --git a/physics/ccpp_suite_simulator.F90 b/physics/ccpp_suite_simulator.F90 deleted file mode 100644 index c1592263d..000000000 --- a/physics/ccpp_suite_simulator.F90 +++ /dev/null @@ -1,212 +0,0 @@ -! ######################################################################################## -! -! Description: This suite simulates the evolution of the internal physics state -! represented by a CCPP Suite Definition File (SDF). -! -! To activate this suite it must be a) embedded within the SDF and b) activated through -! the physics namelist. -! The derived-data type "base_physics_process" contains the metadata needed to reconstruct -! the temporal evolution of the state. An array of base_physics_process, physics_process, -! is populated by the host during initialization and passed to the physics. Additionally, -! this type holds any data, or type-bound procedures, required by the suite simulator(s). -! -! For this initial demonstration we are using 2-dimensional (height, time) forcing data, -! which is on the same native vertical grid as the SCM. The dataset has a temporal -! resolution of 1-hour, created by averaging all local times from a Tropical Warm Pool -! International Cloud Experiment (TWPICE) case. This was to create a dataset with a -! (constant) diurnal cycle. -! -! ######################################################################################## -module ccpp_suite_simulator - use machine, only: kind_phys - use module_ccpp_suite_simulator, only: base_physics_process, sim_LWRAD, sim_SWRAD, & - sim_PBL, sim_GWD, sim_DCNV, sim_SCNV, sim_cldMP - implicit none - public ccpp_suite_simulator_run -contains - - ! ###################################################################################### - ! - ! SUBROUTINE ccpp_suite_simulator_run - ! - ! ###################################################################################### -!! \section arg_table_ccpp_suite_simulator_run -!! \htmlinclude ccpp_suite_simulator_run.html -!! - subroutine ccpp_suite_simulator_run(do_ccpp_suite_sim, kdt, nCol, nLay, dtp, jdat, & - iactive_T, iactive_u, iactive_v, iactive_q, proc_start, proc_end, physics_process,& - in_pre_active, in_post_active, tgrs, ugrs, vgrs, qgrs, active_phys_tend, gt0, gu0,& - gv0, gq0, errmsg, errflg) - - ! Inputs - logical, intent(in) :: do_ccpp_suite_sim - integer, intent(in) :: kdt, nCol, nLay, jdat(8), iactive_T, iactive_u, & - iactive_v, iactive_q - real(kind_phys), intent(in) :: dtp, tgrs(:,:), ugrs(:,:), vgrs(:,:), qgrs(:,:,:), & - active_phys_tend(:,:,:) - ! Outputs - type(base_physics_process),intent(inout) :: physics_process(:) - real(kind_phys), intent(inout) :: gt0(:,:), gu0(:,:), gv0(:,:), gq0(:,:) - character(len=*),intent(out) :: errmsg - integer, intent(out) :: errflg - integer, intent(inout) :: proc_start, proc_end - logical, intent(inout) :: in_pre_active, in_post_active - - ! Locals - integer :: iCol, year, month, day, hour, min, sec, iprc - real(kind_phys), dimension(nCol,nLay) :: gt1, gu1, gv1, dTdt, dudt, dvdt, gq1, dqdt - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - if (.not. do_ccpp_suite_sim) return - - ! Current forecast time (Data-format specific) - year = jdat(1) - month = jdat(2) - day = jdat(3) - hour = jdat(5) - min = jdat(6) - sec = jdat(7) - - ! Set state at beginning of the physics timestep. - gt1(:,:) = tgrs(:,:) - gu1(:,:) = ugrs(:,:) - gv1(:,:) = vgrs(:,:) - gq1(:,:) = qgrs(:,:,1) - dTdt(:,:) = 0. - dudt(:,:) = 0. - dvdt(:,:) = 0. - dqdt(:,:) = 0. - - ! - ! Set bookeeping indices - ! - if (in_pre_active) then - proc_start = 1 - proc_end = max(1,physics_process(1)%iactive_scheme-1) - endif - if (in_post_active) then - proc_start = physics_process(1)%iactive_scheme - proc_end = size(physics_process) - endif - - ! - ! Simulate internal physics timestep evolution. - ! - do iprc = proc_start,proc_end - do iCol = 1,nCol - - ! Reset locals - physics_process(iprc)%tend1d%T(:) = 0. - physics_process(iprc)%tend1d%u(:) = 0. - physics_process(iprc)%tend1d%v(:) = 0. - physics_process(iprc)%tend1d%q(:) = 0. - - ! Using scheme simulator - ! Very simple... - ! Interpolate 2D data (time,level) tendency to local time. - ! Here the data is already on the SCM vertical coordinate. - ! - ! In theory the data can be of any dimensionality and the onus falls on the - ! developer to extend the type "base_physics_process" to work with for their - ! application. - ! - if (physics_process(iprc)%use_sim) then - if (physics_process(iprc)%name == "LWRAD") then - call sim_LWRAD(year, month, day, hour, min, sec, physics_process(iprc)) - endif - if (physics_process(iprc)%name == "SWRAD")then - call sim_SWRAD(year, month, day, hour, min, sec, physics_process(iprc)) - endif - if (physics_process(iprc)%name == "GWD")then - call sim_GWD(year, month, day, hour, min, sec, physics_process(iprc)) - endif - if (physics_process(iprc)%name == "PBL")then - call sim_PBL(year, month, day, hour, min, sec, physics_process(iprc)) - endif - if (physics_process(iprc)%name == "SCNV")then - call sim_SCNV(year, month, day, hour, min, sec, physics_process(iprc)) - endif - if (physics_process(iprc)%name == "DCNV")then - call sim_DCNV(year, month, day, hour, min, sec, physics_process(iprc)) - endif - if (physics_process(iprc)%name == "cldMP")then - call sim_cldMP(year, month, day, hour, min, sec, physics_process(iprc)) - endif - - ! Using data tendency from "active" scheme(s). - else - if (iactive_T > 0) physics_process(iprc)%tend1d%T = active_phys_tend(iCol,:,iactive_T) - if (iactive_u > 0) physics_process(iprc)%tend1d%u = active_phys_tend(iCol,:,iactive_u) - if (iactive_v > 0) physics_process(iprc)%tend1d%v = active_phys_tend(iCol,:,iactive_v) - if (iactive_q > 0) physics_process(iprc)%tend1d%q = active_phys_tend(iCol,:,iactive_q) - endif - - ! Update state now? (time-split scheme) - if (physics_process(iprc)%time_split) then - gt1(iCol,:) = gt1(iCol,:) + (dTdt(iCol,:) + physics_process(iprc)%tend1d%T)*dtp - gu1(iCol,:) = gu1(iCol,:) + (dudt(iCol,:) + physics_process(iprc)%tend1d%u)*dtp - gv1(iCol,:) = gv1(iCol,:) + (dvdt(iCol,:) + physics_process(iprc)%tend1d%v)*dtp - gq1(iCol,:) = gq1(iCol,:) + (dqdt(iCol,:) + physics_process(iprc)%tend1d%q)*dtp - dTdt(iCol,:) = 0. - dudt(iCol,:) = 0. - dvdt(iCol,:) = 0. - dqdt(iCol,:) = 0. - ! Accumulate tendencies, update later? (process-split scheme) - else - dTdt(iCol,:) = dTdt(iCol,:) + physics_process(iprc)%tend1d%T - dudt(iCol,:) = dudt(iCol,:) + physics_process(iprc)%tend1d%u - dvdt(iCol,:) = dvdt(iCol,:) + physics_process(iprc)%tend1d%v - dqdt(iCol,:) = dqdt(iCol,:) + physics_process(iprc)%tend1d%q - endif - enddo ! END: Loop over columns - - ! Print diagnostics - if (physics_process(iprc)%use_sim) then - if (physics_process(iprc)%time_split) then - write(*,'(a25,i2,a4,i2,a5,a10,a35)') 'CCPP suite simulator: ',iprc,' of ',proc_end,' ',physics_process(iprc)%name,'time split scheme (simulated)' - else - write(*,'(a25,i2,a4,i2,a5,a10,a35)') 'CCPP suite simulator: ',iprc,' of ',proc_end,' ',physics_process(iprc)%name,'process split scheme (simulated)' - endif - else - if (physics_process(iprc)%time_split) then - write(*,'(a25,i2,a4,i2,a5,a10,a35)') 'CCPP suite simulator: ',iprc,' of ',proc_end,' ',physics_process(iprc)%name,'time split scheme (active)' - else - write(*,'(a25,i2,a4,i2,a5,a10,a35)') 'CCPP suite simulator: ',iprc,' of ',proc_end,' ',physics_process(iprc)%name,'process split scheme (active)' - endif - write(*,'(a25,i2)') ' # prog. vars.: ',physics_process(1)%nprg_active - endif - enddo ! END: Loop over physics processes - - ! - ! Update state with accumulated tendencies (process-split only) - ! (Suites where active scheme is last physical process) - ! - iprc = minval([iprc,proc_end]) - if (.not. physics_process(iprc)%time_split) then - do iCol = 1,nCol - gt0(iCol,:) = gt1(iCol,:) + dTdt(iCol,:)*dtp - gu0(iCol,:) = gu1(iCol,:) + dudt(iCol,:)*dtp - gv0(iCol,:) = gv1(iCol,:) + dvdt(iCol,:)*dtp - gq0(iCol,:) = gq1(iCol,:) + dqdt(iCol,:)*dtp - enddo - endif - - ! - ! Update bookeeping indices - ! - if (in_pre_active) then - in_pre_active = .false. - in_post_active = .true. - endif - - if (size(physics_process) == proc_end) then - in_pre_active = .true. - in_post_active = .false. - endif - - end subroutine ccpp_suite_simulator_run - -end module ccpp_suite_simulator diff --git a/physics/ccpp_suite_simulator.meta b/physics/ccpp_suite_simulator.meta deleted file mode 100644 index bfa664922..000000000 --- a/physics/ccpp_suite_simulator.meta +++ /dev/null @@ -1,201 +0,0 @@ -[ccpp-table-properties] - name = ccpp_suite_simulator - type = scheme - dependencies = machine.F,module_ccpp_suite_simulator.F90 - -[ccpp-arg-table] - name = ccpp_suite_simulator_run - type = scheme -[do_ccpp_suite_sim] - standard_name = flag_for_ccpp_suite_simulator - long_name = flag for ccpp suite simulator - units = flag - dimensions = () - type = logical - intent = in -[kdt] - standard_name = index_of_timestep - long_name = current forecast iteration - units = index - dimensions = () - type = integer - intent = in -[nCol] - standard_name = horizontal_loop_extent - long_name = horizontal dimension - units = count - dimensions = () - type = integer - intent = in -[nLay] - standard_name = vertical_layer_dimension - long_name = number of vertical levels - units = count - dimensions = () - type = integer - intent = in -[dtp] - standard_name = timestep_for_physics - long_name = physics timestep - units = s - dimensions = () - type = real - kind = kind_phys - intent = in -[jdat] - standard_name = date_and_time_of_forecast_in_united_states_order - long_name = current forecast date and time - units = none - dimensions = (8) - type = integer - intent = in -[proc_start] - standard_name = index_for_first_physics_process_in_CCPP_suite_simulator - long_name = index for first physics process in CCPP suite simulator - units = count - dimensions = () - type = integer - intent = inout -[proc_end] - standard_name = index_for_last_physics_process_in_CCPP_suite_simulator - long_name = index for last physics process in CCPP suite simulator - units = count - dimensions = () - type = integer - intent = inout -[in_pre_active] - standard_name = flag_to_indicate_location_in_physics_process_loop_before_active_scheme - long_name = flag to indicate location in physics process loop before active scheme - units = flag - dimensions = () - type = logical - intent = inout -[in_post_active] - standard_name = flag_to_indicate_location_in_physics_process_loop_after_active_scheme - long_name = flag to indicate location in physics process loop after active scheme - units = flag - dimensions = () - type = logical - intent = inout -[tgrs] - standard_name = air_temperature - long_name = model layer mean temperature - units = K - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[ugrs] - standard_name = x_wind - long_name = zonal wind - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[vgrs] - standard_name = y_wind - long_name = meridional wind - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[qgrs] - standard_name = tracer_concentration - long_name = model layer mean tracer concentration - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) - type = real - kind = kind_phys - intent = in -[active_phys_tend] - standard_name = tendencies_for_active_process_in_ccpp_suite_simulator - long_name = tendencies for active physics process in ccpp suite simulator - units = mixed - dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_prognostics_varaibles_in_CCPP_suite_simulator) - type = real - kind = kind_phys - intent = in -[iactive_T] - standard_name = index_for_active_T_in_CCPP_suite_simulator - long_name = index into active process tracer array for temperature in CCPP suite simulator - units = count - dimensions = () - type = integer - intent = in -[iactive_u] - standard_name = index_for_active_u_in_CCPP_suite_simulator - long_name = index into active process tracer array for zonal wind in CCPP suite simulator - units = count - dimensions = () - type = integer - intent = in -[iactive_v] - standard_name = index_for_active_v_in_CCPP_suite_simulator - long_name = index into active process tracer array for meridional wind in CCPP suite simulator - units = count - dimensions = () - type = integer - intent = in -[iactive_q] - standard_name = index_for_active_q_in_CCPP_suite_simulator - long_name = index into active process tracer array for moisture in CCPP suite simulator - units = count - dimensions = () - type = integer - intent = in -[gt0] - standard_name = air_temperature_of_new_state - long_name = temperature updated by physics - units = K - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[gu0] - standard_name = x_wind_of_new_state - long_name = zonal wind updated by physics - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[gv0] - standard_name = y_wind_of_new_state - long_name = meridional wind updated by physics - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[gq0] - standard_name = specific_humidity_of_new_state - long_name = tracer concentration updated by physics - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[physics_process] - standard_name = physics_process_type_for_CCPP_suite_simulator - long_name = physics process type for CCPP suite simulator - units = mixed - dimensions = (number_of_physics_process_in_CCPP_suite_simulator) - type = base_physics_process - intent = inout -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out -[errflg] - standard_name = ccpp_error_code - long_name = error code for error handling in CCPP - units = 1 - dimensions = () - type = integer - intent = out \ No newline at end of file diff --git a/physics/module_ccpp_suite_simulator.F90 b/physics/module_ccpp_suite_simulator.F90 deleted file mode 100644 index c4f9fc4e4..000000000 --- a/physics/module_ccpp_suite_simulator.F90 +++ /dev/null @@ -1,328 +0,0 @@ -! ######################################################################################## -! -! This module contains the type, base_physics_process, and supporting subroutines needed -! by the ccpp suite simulator. -! -! ######################################################################################## -module module_ccpp_suite_simulator -!> \section arg_table_module_ccpp_suite_simulator Argument table -!! \htmlinclude module_ccpp_suite_simulator.html -!! - use machine, only : kind_phys - implicit none - - public base_physics_process - - ! Type containing 1D (time) physics tendencies. - type phys_tend_1d - real(kind_phys), dimension(:), allocatable :: T - real(kind_phys), dimension(:), allocatable :: u - real(kind_phys), dimension(:), allocatable :: v - real(kind_phys), dimension(:), allocatable :: q - real(kind_phys), dimension(:), allocatable :: p - real(kind_phys), dimension(:), allocatable :: z - end type phys_tend_1d - - ! Type containing 2D (lev,time) physics tendencies. - type phys_tend_2d - real(kind_phys), dimension(:), allocatable :: time - real(kind_phys), dimension(:,:), allocatable :: T - real(kind_phys), dimension(:,:), allocatable :: u - real(kind_phys), dimension(:,:), allocatable :: v - real(kind_phys), dimension(:,:), allocatable :: q - real(kind_phys), dimension(:,:), allocatable :: p - real(kind_phys), dimension(:,:), allocatable :: z - end type phys_tend_2d - - ! Type containing 3D (loc,lev,time) physics tendencies. - type phys_tend_3d - real(kind_phys), dimension(:), allocatable :: time - real(kind_phys), dimension(:), allocatable :: lon - real(kind_phys), dimension(:), allocatable :: lat - real(kind_phys), dimension(:,:,:), allocatable :: T - real(kind_phys), dimension(:,:,:), allocatable :: u - real(kind_phys), dimension(:,:,:), allocatable :: v - real(kind_phys), dimension(:,:,:), allocatable :: q - end type phys_tend_3d - - ! Type containing 4D (lon,lat,lev,time) physics tendencies. - type phys_tend_4d - real(kind_phys), dimension(:), allocatable :: time - real(kind_phys), dimension(:,:), allocatable :: lon - real(kind_phys), dimension(:,:), allocatable :: lat - real(kind_phys), dimension(:,:,:,:), allocatable :: T - real(kind_phys), dimension(:,:,:,:), allocatable :: u - real(kind_phys), dimension(:,:,:,:), allocatable :: v - real(kind_phys), dimension(:,:,:,:), allocatable :: q - end type phys_tend_4d - -! This type contains the meta information and data for each physics process. - -!> \section arg_table_base_physics_process Argument Table -!! \htmlinclude base_physics_process.html -!! - type base_physics_process - character(len=16) :: name ! Physics process name - logical :: time_split = .false. ! Is process time-split? - logical :: use_sim = .false. ! Is process "active"? - integer :: order ! Order of process in process-loop - type(phys_tend_1d) :: tend1d ! Instantaneous data - type(phys_tend_2d) :: tend2d ! 2-dimensional data - type(phys_tend_3d) :: tend3d ! Not used. Placeholder for 3-dimensional spatial data. - type(phys_tend_4d) :: tend4d ! Not used. Placeholder for 4-dimensional spatio-tempo data. - character(len=16) :: active_name ! "Active" scheme: Physics process name - integer :: iactive_scheme ! "Active" scheme: Order of process in process-loop - logical :: active_tsp ! "Active" scheme: Is process time-split? - integer :: nprg_active ! "Active" scheme: Number of prognostic variables - contains - generic, public :: linterp => linterp_1D, linterp_2D - procedure, private :: linterp_1D - procedure, private :: linterp_2D - procedure, public :: find_nearest_loc_2d_1d - procedure, public :: cmp_time_wts - end type base_physics_process - -contains - - ! #################################################################################### - ! Type-bound procedure to compute tendency profile for time-of-day. - ! - ! For use with 1D data (level, time) tendencies with diurnal (24-hr) forcing. - ! #################################################################################### - function linterp_1D(this, var_name, year, month, day, hour, min, sec) result(err_message) - class(base_physics_process), intent(inout) :: this - character(len=*), intent(in) :: var_name - integer, intent(in) :: year, month, day, hour, min, sec - character(len=128) :: err_message - integer :: ti(1), tf(1), ntime - real(kind_phys) :: w1, w2 - - ! Interpolation weights - call this%cmp_time_wts(year, month, day, hour, min, sec, w1, w2, ti, tf) - - ntime = size(this%tend2d%T(1,:)) - - select case(var_name) - case("T") - if (tf(1) .le. ntime) then - this%tend1d%T = w1*this%tend2d%T(:,ti(1)) + w2*this%tend2d%T(:,tf(1)) - else - this%tend1d%T = this%tend2d%T(:,1) - endif - case("u") - if (tf(1) .le. ntime) then - this%tend1d%u = w1*this%tend2d%u(:,ti(1)) + w2*this%tend2d%u(:,tf(1)) - else - this%tend1d%u = this%tend2d%u(:,1) - endif - case("v") - if (tf(1) .le. ntime) then - this%tend1d%v = w1*this%tend2d%v(:,ti(1)) + w2*this%tend2d%v(:,tf(1)) - else - this%tend1d%v = this%tend2d%v(:,1) - endif - case("q") - if (tf(1) .le. ntime) then - this%tend1d%q = w1*this%tend2d%q(:,ti(1)) + w2*this%tend2d%q(:,tf(1)) - else - this%tend1d%q = this%tend2d%q(:,1) - endif - end select - - end function linterp_1D - - ! #################################################################################### - ! Type-bound procedure to compute tendency profile for time-of-day. - ! - ! For use with 2D data (location, level, time) tendencies with diurnal (24-hr) forcing. - ! This assumes that the location dimension has a [longitude, latitude] allocated with - ! each location. - ! #################################################################################### - function linterp_2D(this, var_name, lon, lat, year, month, day, hour, min, sec) result(err_message) - class(base_physics_process), intent(inout) :: this - character(len=*), intent(in) :: var_name - integer, intent(in) :: year, month, day, hour, min, sec - real(kind_phys), intent(in) :: lon, lat - character(len=128) :: err_message - integer :: ti(1), tf(1), iNearest - real(kind_phys) :: w1, w2 - - ! Interpolation weights (temporal) - call this%cmp_time_wts(year, month, day, hour, min, sec, w1, w2, ti, tf) - - ! Grab data tendency closest to column [lon,lat] - iNearest = this%find_nearest_loc_2d_1d(lon,lat) - - select case(var_name) - case("T") - this%tend1d%T = w1*this%tend3d%T(iNearest,:,ti(1)) + w2*this%tend3d%T(iNearest,:,tf(1)) - case("u") - this%tend1d%u = w1*this%tend3d%u(iNearest,:,ti(1)) + w2*this%tend3d%u(iNearest,:,tf(1)) - case("v") - this%tend1d%v = w1*this%tend3d%v(iNearest,:,ti(1)) + w2*this%tend3d%v(iNearest,:,tf(1)) - case("q") - this%tend1d%q = w1*this%tend3d%q(iNearest,:,ti(1)) + w2*this%tend3d%q(iNearest,:,tf(1)) - end select - end function linterp_2D - - ! #################################################################################### - ! Type-bound procedure to find nearest location. - ! For use with linterp_2D, NOT YET IMPLEMENTED. - ! #################################################################################### - pure function find_nearest_loc_2d_1d(this, lon, lat) - class(base_physics_process), intent(in) :: this - real(kind_phys), intent(in) :: lon, lat - integer :: find_nearest_loc_2d_1d - - find_nearest_loc_2d_1d = 1 - end function find_nearest_loc_2d_1d - - ! #################################################################################### - ! Type-bound procedure to compute linear interpolation weights for a diurnal (24-hour) - ! forcing. - ! #################################################################################### - subroutine cmp_time_wts(this, year, month, day, hour, minute, sec, w1, w2, ti, tf) - ! Inputs - class(base_physics_process), intent(in) :: this - integer, intent(in) :: year, month, day, hour, minute, sec - ! Outputs - integer,intent(out) :: ti(1), tf(1) - real(kind_phys),intent(out) :: w1, w2 - ! Locals - real(kind_phys) :: hrofday - - hrofday = hour*3600. + minute*60. + sec - ti = max(hour,1) - tf = min(ti + 1,24) - w1 = ((hour+1)*3600 - hrofday)/3600 - w2 = 1 - w1 - - end subroutine cmp_time_wts - - ! #################################################################################### - ! #################################################################################### - subroutine sim_LWRAD( year, month, day, hour, min, sec, process) - type(base_physics_process), intent(inout) :: process - integer, intent(in) :: year, month, day, hour, min, sec - character(len=128) :: errmsg - - if (allocated(process%tend2d%T)) then - errmsg = process%linterp("T", year,month,day,hour,min,sec) - endif - - end subroutine sim_LWRAD - - ! #################################################################################### - ! #################################################################################### - subroutine sim_SWRAD( year, month, day, hour, min, sec, process) - type(base_physics_process), intent(inout) :: process - integer, intent(in) :: year, month, day, hour, min, sec - character(len=128) :: errmsg - - if (allocated(process%tend2d%T)) then - errmsg = process%linterp("T", year,month,day,hour,min,sec) - endif - - end subroutine sim_SWRAD - - ! #################################################################################### - ! #################################################################################### - subroutine sim_GWD( year, month, day, hour, min, sec, process) - type(base_physics_process), intent(inout) :: process - integer, intent(in) :: year, month, day, hour, min, sec - character(len=128) :: errmsg - - if (allocated(process%tend2d%T)) then - errmsg = process%linterp("T", year,month,day,hour,min,sec) - endif - if (allocated(process%tend2d%u)) then - errmsg = process%linterp("u", year,month,day,hour,min,sec) - endif - if (allocated(process%tend2d%v)) then - errmsg = process%linterp("v", year,month,day,hour,min,sec) - endif - - end subroutine sim_GWD - - ! #################################################################################### - ! #################################################################################### - subroutine sim_PBL( year, month, day, hour, min, sec, process) - type(base_physics_process), intent(inout) :: process - integer, intent(in) :: year, month, day, hour, min, sec - character(len=128) :: errmsg - - if (allocated(process%tend2d%T)) then - errmsg = process%linterp("T", year,month,day,hour,min,sec) - endif - if (allocated(process%tend2d%u)) then - errmsg = process%linterp("u", year,month,day,hour,min,sec) - endif - if (allocated(process%tend2d%v)) then - errmsg = process%linterp("v", year,month,day,hour,min,sec) - endif - if (allocated(process%tend2d%q)) then - errmsg = process%linterp("q", year,month,day,hour,min,sec) - endif - - end subroutine sim_PBL - - ! #################################################################################### - ! #################################################################################### - subroutine sim_DCNV( year, month, day, hour, min, sec, process) - type(base_physics_process), intent(inout) :: process - integer, intent(in) :: year, month, day, hour, min, sec - character(len=128) :: errmsg - - if (allocated(process%tend2d%T)) then - errmsg = process%linterp("T", year,month,day,hour,min,sec) - endif - if (allocated(process%tend2d%u)) then - errmsg = process%linterp("u", year,month,day,hour,min,sec) - endif - if (allocated(process%tend2d%v)) then - errmsg = process%linterp("v", year,month,day,hour,min,sec) - endif - if (allocated(process%tend2d%q)) then - errmsg = process%linterp("q", year,month,day,hour,min,sec) - endif - - end subroutine sim_DCNV - - ! #################################################################################### - ! #################################################################################### - subroutine sim_SCNV( year, month, day, hour, min, sec, process) - type(base_physics_process), intent(inout) :: process - integer, intent(in) :: year, month, day, hour, min, sec - character(len=128) :: errmsg - - if (allocated(process%tend2d%T)) then - errmsg = process%linterp("T", year,month,day,hour,min,sec) - endif - if (allocated(process%tend2d%u)) then - errmsg = process%linterp("u", year,month,day,hour,min,sec) - endif - if (allocated(process%tend2d%v)) then - errmsg = process%linterp("v", year,month,day,hour,min,sec) - endif - if (allocated(process%tend2d%q)) then - errmsg = process%linterp("q", year,month,day,hour,min,sec) - endif - - end subroutine sim_SCNV - - ! #################################################################################### - ! #################################################################################### - subroutine sim_cldMP( year, month, day, hour, min, sec, process) - type(base_physics_process), intent(inout) :: process - integer, intent(in) :: year, month, day, hour, min, sec - character(len=128) :: errmsg - - if (allocated(process%tend2d%T)) then - errmsg = process%linterp("T", year,month,day,hour,min,sec) - endif - if (allocated(process%tend2d%q)) then - errmsg = process%linterp("q", year,month,day,hour,min,sec) - endif - end subroutine sim_cldMP - -end module module_ccpp_suite_simulator diff --git a/physics/module_ccpp_suite_simulator.meta b/physics/module_ccpp_suite_simulator.meta deleted file mode 100644 index cd8e3db1b..000000000 --- a/physics/module_ccpp_suite_simulator.meta +++ /dev/null @@ -1,24 +0,0 @@ -[ccpp-table-properties] - name = base_physics_process - type = ddt - dependencies = - -[ccpp-arg-table] - name = base_physics_process - type = ddt - -######################################################################## -[ccpp-table-properties] - name = module_ccpp_suite_simulator - type = module - dependencies = machine.F - -[ccpp-arg-table] - name = module_ccpp_suite_simulator - type = module -[base_physics_process] - standard_name = base_physics_process - long_name = definition of type base_physics_process - units = DDT - dimensions = () - type = base_physics_process From 12cd9c698ad9bc97bb4c84a2225542ccaf0ce3bc Mon Sep 17 00:00:00 2001 From: Qingfu Liu Date: Tue, 28 Nov 2023 15:35:12 -0500 Subject: [PATCH 08/42] update files satmedmfvdifq.F samfshalcnv.f sfc_diff.f --- physics/samfshalcnv.f | 2 +- physics/satmedmfvdifq.F | 2 +- physics/scm_sfc_flux_spec.F90 | 4 ++-- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/physics/samfshalcnv.f b/physics/samfshalcnv.f index 3869ea6ea..d0bab05dd 100644 --- a/physics/samfshalcnv.f +++ b/physics/samfshalcnv.f @@ -191,7 +191,7 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & parameter(cinacrmx=-120.,shevf=2.0) parameter(dtmax=10800.,dtmin=600.) parameter(bb1=4.0,bb2=0.8,csmf=0.2) - parameter(tkcrt=2.,cmxfac=15.) + parameter(tkcrt=2.,cmxfac=10.) ! parameter(bet1=1.875,cd1=.506,f1=2.0,gam1=.5) parameter(betaw=.03,dxcrtc0=9.e3) parameter(h1=0.33333333) diff --git a/physics/satmedmfvdifq.F b/physics/satmedmfvdifq.F index 73fc4aff8..7b54b6d12 100644 --- a/physics/satmedmfvdifq.F +++ b/physics/satmedmfvdifq.F @@ -271,7 +271,7 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & parameter(elmfac=1.0,elefac=1.0,cql=100.) parameter(dw2min=1.e-4,dkmax=1000.,xkgdx=1000.) parameter(qlcr=3.5e-5,zstblmax=2500.) - parameter(xkinv1=0.15,xkinv2=0.3) + parameter(xkinv1=0.4,xkinv2=0.3) parameter(h1=0.33333333,hcrinv=250.) parameter(vegflo=0.1,vegfup=1.0,z0lo=0.1,z0up=1.0) parameter(vc0=1.0,zc0=1.0) diff --git a/physics/scm_sfc_flux_spec.F90 b/physics/scm_sfc_flux_spec.F90 index e835b77ff..835b468ff 100644 --- a/physics/scm_sfc_flux_spec.F90 +++ b/physics/scm_sfc_flux_spec.F90 @@ -58,9 +58,9 @@ subroutine scm_sfc_flux_spec_run (im, u1, v1, z1, t1, q1, p1, roughness_length, use machine, only: kind_phys integer, intent(in) :: im, lkm - integer, intent(inout) :: islmsk(:), use_lake_model(:) + integer, intent(inout) :: islmsk(:) logical, intent(in) :: cplflx, cplice - logical, intent(inout) :: dry(:), icy(:), flag_cice(:), wet(:) + logical, intent(inout) :: dry(:), icy(:), flag_cice(:), wet(:), use_lake_model(:) real(kind=kind_phys), intent(in) :: cp, grav, hvap, rd, fvirt, vonKarman, min_seaice, tgice, min_lakeice real(kind=kind_phys), intent(in) :: u1(:), v1(:), z1(:), t1(:), q1(:), p1(:), roughness_length(:), & spec_sh_flux(:), spec_lh_flux(:), exner_inverse(:), T_surf(:), oceanfrac(:), lakefrac(:), lakedepth(:) From 6bdadb5e7c61f2cabe391736cb3d29e1d041b434 Mon Sep 17 00:00:00 2001 From: "Bin.Li" Date: Wed, 29 Nov 2023 09:47:20 +0000 Subject: [PATCH 09/42] 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 10/42] 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 11/42] 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 12/42] 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 d65507afb07edc4a50ba246843284552b99e437d Mon Sep 17 00:00:00 2001 From: Qingfu Liu Date: Thu, 14 Dec 2023 11:16:29 -0500 Subject: [PATCH 13/42] Fix CI 2 --- tools/check_encoding.py | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/tools/check_encoding.py b/tools/check_encoding.py index 1d24d4679..d964ebaab 100755 --- a/tools/check_encoding.py +++ b/tools/check_encoding.py @@ -15,11 +15,7 @@ if suffix in SUFFICES: with open(os.path.join(root, file)) as f: contents = f.read() - try: - contents.decode('ascii') - except UnicodeDecodeError: + if not contents.isascii(): for line in contents.split('\n'): - try: - line.decode('ascii') - except UnicodeDecodeError: + if not line.isascii(): raise Exception('Detected non-ascii characters in file {}, line: "{}"'.format(os.path.join(root, file), line)) From a799bc5d54d6cf3f6503d7214f0cbffc336bc5fb Mon Sep 17 00:00:00 2001 From: "Bin.Li" Date: Tue, 19 Dec 2023 14:46:51 +0000 Subject: [PATCH 14/42] 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 15/42] 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 16/42] 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 17/42] 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 18/42] 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 19/42] 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 20/42] 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 21/42] 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 22/42] 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 23/42] 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 24/42] 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 25/42] 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 26/42] Make changes for consistent style. --- physics/SFC_Layer/UFS/sfc_diff.f | 17 ++++++++--------- physics/SFC_Layer/UFS/sfc_nst.f90 | 2 +- physics/SFC_Models/Ocean/UFS/sfc_ocean.F | 1 - 3 files changed, 9 insertions(+), 11 deletions(-) diff --git a/physics/SFC_Layer/UFS/sfc_diff.f b/physics/SFC_Layer/UFS/sfc_diff.f index f4a102c91..eb5bd7b5c 100644 --- a/physics/SFC_Layer/UFS/sfc_diff.f +++ b/physics/SFC_Layer/UFS/sfc_diff.f @@ -168,7 +168,6 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) errmsg = '' errflg = 0 - ! initialize variables. all units are supposedly m.k.s. unless specified ! ps is in pascals, wind is wind speed, ! surface roughness length is converted to m from cm @@ -282,11 +281,11 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! call stability ! --- inputs: - & (z1(i), zvfun(i), gdx, tv1, thv1, wind(i), - & z0max, ztmax_lnd(i), tvs, grav, thsfc_loc, + & (z1(i), zvfun(i), gdx, tv1, thv1, wind(i), + & z0max, ztmax_lnd(i), tvs, grav, thsfc_loc, ! --- outputs: - & rb_lnd(i), fm_lnd(i), fh_lnd(i), fm10_lnd(i), fh2_lnd(i), - & cm_lnd(i), ch_lnd(i), stress_lnd(i), ustar_lnd(i)) + & rb_lnd(i), fm_lnd(i), fh_lnd(i), fm10_lnd(i), fh2_lnd(i), + & cm_lnd(i), ch_lnd(i), stress_lnd(i), ustar_lnd(i)) endif ! Dry points if (icy(i)) then ! Some ice @@ -336,11 +335,11 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! call stability ! --- inputs: - & (z1(i), zvfun(i), gdx, tv1, thv1, wind(i), - & z0max, ztmax_ice(i), tvs, grav, thsfc_loc, + & (z1(i), zvfun(i), gdx, tv1, thv1, wind(i), + & z0max, ztmax_ice(i), tvs, grav, thsfc_loc, ! --- outputs: - & rb_ice(i), fm_ice(i), fh_ice(i), fm10_ice(i), fh2_ice(i), - & cm_ice(i), ch_ice(i), stress_ice(i), ustar_ice(i)) + & rb_ice(i), fm_ice(i), fh_ice(i), fm10_ice(i), fh2_ice(i), + & cm_ice(i), ch_ice(i), stress_ice(i), ustar_ice(i)) endif ! Icy points ! BWG: Everything from here to end of subroutine was after diff --git a/physics/SFC_Layer/UFS/sfc_nst.f90 b/physics/SFC_Layer/UFS/sfc_nst.f90 index 1dd9d6117..9c3804211 100644 --- a/physics/SFC_Layer/UFS/sfc_nst.f90 +++ b/physics/SFC_Layer/UFS/sfc_nst.f90 @@ -27,7 +27,7 @@ module sfc_nst subroutine sfc_nst_run & ( im, hvap, cp, hfus, jcal, eps, epsm1, rvrdm1, rd, rhw0, & ! --- inputs: pi, tgice, sbc, ps, u1, v1, usfco, vsfco, icplocn2atm, t1, & - q1, tref, cm, ch, lseaspray, fm, fm10, & + q1, tref, cm, ch, lseaspray, fm, fm10, & prsl1, prslki, prsik1, prslk1, wet, use_lake_model, xlon, & sinlat, stress, & sfcemis, dlwflx, sfcnsw, rain, timestep, kdt, solhr,xcosz, & diff --git a/physics/SFC_Models/Ocean/UFS/sfc_ocean.F b/physics/SFC_Models/Ocean/UFS/sfc_ocean.F index 505476510..88d23a7aa 100644 --- a/physics/SFC_Models/Ocean/UFS/sfc_ocean.F +++ b/physics/SFC_Models/Ocean/UFS/sfc_ocean.F @@ -179,7 +179,6 @@ subroutine sfc_ocean_run & ! rho is density, qss is sat. hum. at surface if ( flag(i) ) then - if (use_med_flux) then q0(i) = max( q1(i), qmin ) rho(i) = prsl1(i) / (rd*t1(i)*(one + rvrdm1*q0(i))) From c9460205f6047047025536653e05675749b9d074 Mon Sep 17 00:00:00 2001 From: Jili Dong Date: Wed, 17 Jan 2024 15:54:26 +0000 Subject: [PATCH 27/42] fix NSSL MP init issue when initialized from other microphysics schemes --- physics/MP/NSSL/mp_nssl.F90 | 42 ++++++++++++++-- physics/MP/NSSL/mp_nssl.meta | 95 ++++++++++++++++++++++++++++++++++++ 2 files changed, 134 insertions(+), 3 deletions(-) diff --git a/physics/MP/NSSL/mp_nssl.F90 b/physics/MP/NSSL/mp_nssl.F90 index e79376709..ad1d41090 100644 --- a/physics/MP/NSSL/mp_nssl.F90 +++ b/physics/MP/NSSL/mp_nssl.F90 @@ -15,6 +15,7 @@ module mp_nssl private logical :: is_initialized = .False. + logical :: missing_vars_global = .False. real :: nssl_qccn contains @@ -26,7 +27,9 @@ module mp_nssl !! \htmlinclude mp_nssl_init.html !! subroutine mp_nssl_init(ncol, nlev, errflg, errmsg, threads, restart, & - mpirank, mpiroot, & + mpirank, mpiroot,mpicomm, & + qc, qr, qi, qs, qh, & + ccw, crw, cci, csw, chw, vh, & con_g, con_rd, con_cp, con_rv, & con_t0c, con_cliq, con_csol, con_eps, & imp_physics, imp_physics_nssl, & @@ -36,6 +39,9 @@ subroutine mp_nssl_init(ncol, nlev, errflg, errmsg, threads, restart, & use module_mp_nssl_2mom, only: nssl_2mom_init, nssl_2mom_init_const +#ifdef MPI + use mpi +#endif implicit none @@ -50,16 +56,32 @@ subroutine mp_nssl_init(ncol, nlev, errflg, errmsg, threads, restart, & integer, intent(in) :: mpirank integer, intent(in) :: mpiroot + integer, intent(in) :: mpicomm integer, intent(in) :: imp_physics integer, intent(in) :: imp_physics_nssl real(kind_phys), intent(in) :: nssl_cccn, nssl_alphah, nssl_alphahl real(kind_phys), intent(in) :: nssl_alphar, nssl_ehw0, nssl_ehlw0 logical, intent(in) :: nssl_ccn_on, nssl_hail_on, nssl_invertccn, nssl_3moment + real(kind_phys), intent(inout) :: qc (:,:) !(1:ncol,1:nlev) + real(kind_phys), intent(inout) :: qr (:,:) !(1:ncol,1:nlev) + real(kind_phys), intent(inout) :: qi (:,:) !(1:ncol,1:nlev) + real(kind_phys), intent(inout) :: qs (:,:) !(1:ncol,1:nlev) + real(kind_phys), intent(inout) :: qh (:,:) !(1:ncol,1:nlev) graupel + real(kind_phys), intent(inout) :: ccw(:,:) !(1:ncol,1:nlev) + real(kind_phys), intent(inout) :: crw(:,:) !(1:ncol,1:nlev) + real(kind_phys), intent(inout) :: cci(:,:) !(1:ncol,1:nlev) + real(kind_phys), intent(inout) :: csw(:,:) !(1:ncol,1:nlev) + real(kind_phys), intent(inout) :: chw(:,:) !(1:ncol,1:nlev) graupel number + real(kind_phys), intent(inout) :: vh (:,:) !(1:ncol,1:nlev) graupel volume + ! Local variables: dimensions used in nssl_init integer :: ims,ime, jms,jme, kms,kme, nx, nz, i,k real :: nssl_params(20) integer :: ihailv,ipc + real, parameter :: qmin = 1.e-12 + integer :: ierr + logical :: missing_vars = .False. ! Initialize the CCPP error handling variables @@ -143,6 +165,19 @@ subroutine mp_nssl_init(ncol, nlev, errflg, errmsg, threads, restart, & ! For restart runs, the init is done here if (restart) then + + ! For restart, check if the IC is from a different scheme that does not have all the needed variables + missing_vars = .False. + IF ( Any( qc > qmin .and. ccw == 0.0 ) ) missing_vars = .true. + IF ( .not. missing_vars .and. Any( qi > qmin .and. cci == 0.0 ) ) missing_vars = .true. + IF ( .not. missing_vars .and. Any( qs > qmin .and. csw == 0.0 ) ) missing_vars = .true. + IF ( .not. missing_vars .and. Any( qr > qmin .and. crw == 0.0 ) ) missing_vars = .true. + IF ( .not. missing_vars .and. Any( qh > qmin .and. (chw == 0.0 .or. vh == 0.0) ) ) missing_vars = .true. + +#ifdef MPI + call MPI_Allreduce(missing_vars, missing_vars_global, 1, MPI_LOGICAL, MPI_LOR, mpicomm, ierr) +#endif + is_initialized = .true. return end if @@ -319,6 +354,7 @@ subroutine mp_nssl_run(ncol, nlev, con_g, con_rd, mpirank, & real :: cwmas real(kind_phys), allocatable :: an(:,:,:,:) ! temporary scalar array + errflg = 0 @@ -529,8 +565,8 @@ subroutine mp_nssl_run(ncol, nlev, con_g, con_rd, mpirank, & dtptmp = dtp ntmul = 1 ENDIF - - IF ( first_time_step .and. .not. restart ) THEN + + IF ( first_time_step .and. ( .not. restart .or. missing_vars_global ) ) THEN itimestep = 0 ! gets incremented to 1 in call loop IF ( nssl_ccn_on ) THEN IF ( invertccn ) THEN diff --git a/physics/MP/NSSL/mp_nssl.meta b/physics/MP/NSSL/mp_nssl.meta index 1f2023ea9..8449f26cf 100644 --- a/physics/MP/NSSL/mp_nssl.meta +++ b/physics/MP/NSSL/mp_nssl.meta @@ -63,6 +63,101 @@ dimensions = () type = integer intent = in +[mpicomm] + standard_name = mpi_communicator + long_name = MPI communicator + units = index + dimensions = () + type = integer + intent = in +[qc] + standard_name = cloud_liquid_water_mixing_ratio + long_name = cloud water mixing ratio wrt dry+vapor (no condensates) + units = kg kg-1 + dimensions = (horizontal_dimension ,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[qr] + standard_name = rain_mixing_ratio + long_name = rain water mixing ratio wrt dry+vapor (no condensates) + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[qi] + standard_name = cloud_ice_mixing_ratio + long_name = ice water mixing ratio wrt dry+vapor (no condensates) + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[qs] + standard_name = snow_mixing_ratio + long_name = snow water mixing ratio wrt dry+vapor (no condensates) + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[qh] + standard_name = graupel_mixing_ratio + long_name = graupel mixing ratio wrt dry+vapor (no condensates) + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[ccw] + standard_name = mass_number_concentration_of_cloud_liquid_water_particles_in_air + long_name = cloud droplet number concentration + units = kg-1 + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[crw] + standard_name = mass_number_concentration_of_rain_water_in_air + long_name = rain number concentration + units = kg-1 + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[cci] + standard_name = mass_number_concentration_of_cloud_ice_water_crystals_in_air + long_name = ice number concentration + units = kg-1 + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[csw] + standard_name = mass_number_concentration_of_snow_in_air + long_name = snow number concentration + units = kg-1 + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[chw] + standard_name = mass_number_concentration_of_graupel_in_air + long_name = graupel number concentration + units = kg-1 + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[vh] + standard_name = graupel_volume + long_name = graupel particle volume + units = m3 kg-1 + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout [con_g] standard_name = gravitational_acceleration long_name = gravitational acceleration From 97e3b1ce4e9721ae6cc361733842de53a061d7ed Mon Sep 17 00:00:00 2001 From: Qingfu Liu Date: Thu, 18 Jan 2024 12:24:03 -0500 Subject: [PATCH 28/42] update surface physics z0 from waves --- physics/SFC_Layer/UFS/sfc_diff.f | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/physics/SFC_Layer/UFS/sfc_diff.f b/physics/SFC_Layer/UFS/sfc_diff.f index e1bf3c756..5dd6525f9 100644 --- a/physics/SFC_Layer/UFS/sfc_diff.f +++ b/physics/SFC_Layer/UFS/sfc_diff.f @@ -437,6 +437,18 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) z0rl_wat(i) = 1.0e-4_kp endif + elseif (z0rl_wav(i) <= 1.0e-7_kp .or. + & z0rl_wav(i) > 1.0_kp) then +! z0 = (charnock / grav) * ustar_wat(i) * ustar_wat(i) + tem1 = 0.11 * vis / ustar_wat(i) + z0 = tem1 + (charnock/grav)*ustar_wat(i)*ustar_wat(i) + + if (redrag) then + z0rl_wat(i) = 100.0_kp * max(min(z0, z0s_max),1.0e-7_kp) + else + z0rl_wat(i) = 100.0_kp * max(min(z0,0.1_kp), 1.0e-7_kp) + endif + endif endif ! end of if(open ocean) From 5fe0d63eee3eb05bb5e37b5e136229ac3d84cf98 Mon Sep 17 00:00:00 2001 From: "Bin.Li" Date: Thu, 25 Jan 2024 13:33:36 +0000 Subject: [PATCH 29/42] Change flag_for_air_sea_flux_computation_over_water to control_for_air_sea_flux_computation_over_water. --- physics/PBL/SATMEDMF/satmedmfvdifq.meta | 4 ++-- physics/SFC_Layer/UFS/sfc_diag.meta | 4 ++-- physics/SFC_Layer/UFS/sfc_diff.meta | 4 ++-- physics/SFC_Layer/UFS/sfc_nst.meta | 4 ++-- physics/SFC_Models/Ocean/UFS/sfc_ocean.meta | 4 ++-- 5 files changed, 10 insertions(+), 10 deletions(-) diff --git a/physics/PBL/SATMEDMF/satmedmfvdifq.meta b/physics/PBL/SATMEDMF/satmedmfvdifq.meta index ec80ba422..ff570dce0 100644 --- a/physics/PBL/SATMEDMF/satmedmfvdifq.meta +++ b/physics/PBL/SATMEDMF/satmedmfvdifq.meta @@ -234,9 +234,9 @@ kind = kind_phys intent = in [icplocn2atm] - standard_name = flag_for_air_sea_flux_computation_over_water + standard_name = control_for_air_sea_flux_computation_over_water long_name = air-sea flux option - units = flag + units = 1 dimensions = () type = integer intent = in diff --git a/physics/SFC_Layer/UFS/sfc_diag.meta b/physics/SFC_Layer/UFS/sfc_diag.meta index b432d75b7..f5e0ab89e 100644 --- a/physics/SFC_Layer/UFS/sfc_diag.meta +++ b/physics/SFC_Layer/UFS/sfc_diag.meta @@ -141,9 +141,9 @@ kind = kind_phys intent = in [icplocn2atm] - standard_name = flag_for_air_sea_flux_computation_over_water + standard_name = control_for_air_sea_flux_computation_over_water long_name = air-sea flux option - units = flag + units = 1 dimensions = () type = integer intent = in diff --git a/physics/SFC_Layer/UFS/sfc_diff.meta b/physics/SFC_Layer/UFS/sfc_diff.meta index eae4c58b0..f2bee7d2c 100644 --- a/physics/SFC_Layer/UFS/sfc_diff.meta +++ b/physics/SFC_Layer/UFS/sfc_diff.meta @@ -258,9 +258,9 @@ type = integer intent = in [icplocn2atm] - standard_name = flag_for_air_sea_flux_computation_over_water + standard_name = control_for_air_sea_flux_computation_over_water long_name = air-sea flux option - units = flag + units = 1 dimensions = () type = integer intent = in diff --git a/physics/SFC_Layer/UFS/sfc_nst.meta b/physics/SFC_Layer/UFS/sfc_nst.meta index ba075e5ae..2181f0bf4 100644 --- a/physics/SFC_Layer/UFS/sfc_nst.meta +++ b/physics/SFC_Layer/UFS/sfc_nst.meta @@ -151,9 +151,9 @@ kind = kind_phys intent = in [icplocn2atm] - standard_name = flag_for_air_sea_flux_computation_over_water + standard_name = control_for_air_sea_flux_computation_over_water long_name = air-sea flux option - units = flag + units = 1 dimensions = () type = integer intent = in diff --git a/physics/SFC_Models/Ocean/UFS/sfc_ocean.meta b/physics/SFC_Models/Ocean/UFS/sfc_ocean.meta index c380a7540..4672a6dc4 100644 --- a/physics/SFC_Models/Ocean/UFS/sfc_ocean.meta +++ b/physics/SFC_Models/Ocean/UFS/sfc_ocean.meta @@ -103,9 +103,9 @@ kind = kind_phys intent = in [icplocn2atm] - standard_name = flag_for_air_sea_flux_computation_over_water + standard_name = control_for_air_sea_flux_computation_over_water long_name = air-sea flux option - units = flag + units = 1 dimensions = () type = integer intent = in From 4bdf3fab29da51e487143e8b5e3ce8ed5d599127 Mon Sep 17 00:00:00 2001 From: Jili Dong Date: Thu, 25 Jan 2024 14:49:22 +0000 Subject: [PATCH 30/42] add kind_phys to parameter in mp_nssl --- physics/MP/NSSL/mp_nssl.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/MP/NSSL/mp_nssl.F90 b/physics/MP/NSSL/mp_nssl.F90 index ad1d41090..e250527c4 100644 --- a/physics/MP/NSSL/mp_nssl.F90 +++ b/physics/MP/NSSL/mp_nssl.F90 @@ -79,7 +79,7 @@ subroutine mp_nssl_init(ncol, nlev, errflg, errmsg, threads, restart, & integer :: ims,ime, jms,jme, kms,kme, nx, nz, i,k real :: nssl_params(20) integer :: ihailv,ipc - real, parameter :: qmin = 1.e-12 + real(kind_phys), parameter :: qmin = 1.e-12 integer :: ierr logical :: missing_vars = .False. @@ -347,7 +347,7 @@ subroutine mp_nssl_run(ncol, nlev, con_g, con_rd, mpirank, & its,ite, jts,jte, kts,kte, i,j,k integer :: itimestep ! timestep counter integer :: ntmul, n - real, parameter :: dtpmax = 60. ! allow up to dt=75 (1.25*60) + real(kind_phys), parameter :: dtpmax = 60. ! allow up to dt=75 (1.25*60) real(kind_phys) :: dtptmp integer, parameter :: ndebug = 0 logical :: invertccn From be9b2b726d5ab08a7630def5b7559d55fa6dcd1f Mon Sep 17 00:00:00 2001 From: Jili Dong Date: Thu, 25 Jan 2024 14:54:44 +0000 Subject: [PATCH 31/42] add more kind_phys to real variables in mp_nssl --- physics/MP/NSSL/mp_nssl.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/MP/NSSL/mp_nssl.F90 b/physics/MP/NSSL/mp_nssl.F90 index e250527c4..0b111f7cd 100644 --- a/physics/MP/NSSL/mp_nssl.F90 +++ b/physics/MP/NSSL/mp_nssl.F90 @@ -77,7 +77,7 @@ subroutine mp_nssl_init(ncol, nlev, errflg, errmsg, threads, restart, & ! Local variables: dimensions used in nssl_init integer :: ims,ime, jms,jme, kms,kme, nx, nz, i,k - real :: nssl_params(20) + real(kind_phys) :: nssl_params(20) integer :: ihailv,ipc real(kind_phys), parameter :: qmin = 1.e-12 integer :: ierr @@ -351,7 +351,7 @@ subroutine mp_nssl_run(ncol, nlev, con_g, con_rd, mpirank, & real(kind_phys) :: dtptmp integer, parameter :: ndebug = 0 logical :: invertccn - real :: cwmas + real(kind_phys) :: cwmas real(kind_phys), allocatable :: an(:,:,:,:) ! temporary scalar array From 51204101eeb68dcbed08d13cc0a341a25ee1a229 Mon Sep 17 00:00:00 2001 From: "Bin.Li" Date: Fri, 26 Jan 2024 09:27:17 +0000 Subject: [PATCH 32/42] 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 33/42] 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 34/42] 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 35/42] 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 36/42] 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 From df5d9d4366cfd83f1af09cb3af3cfa10ffb31226 Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Thu, 7 Mar 2024 12:47:52 -0500 Subject: [PATCH 37/42] add cs_conv V2 changes on top of latest ufs/dev code --- physics/CONV/Chikira_Sugiyama/cs_conv.F90 | 1468 ++++++++++++--------- 1 file changed, 820 insertions(+), 648 deletions(-) diff --git a/physics/CONV/Chikira_Sugiyama/cs_conv.F90 b/physics/CONV/Chikira_Sugiyama/cs_conv.F90 index ab7388df8..94dadba87 100644 --- a/physics/CONV/Chikira_Sugiyama/cs_conv.F90 +++ b/physics/CONV/Chikira_Sugiyama/cs_conv.F90 @@ -60,6 +60,7 @@ module cs_conv !DD and precipitation. Decrease for more precip real(kind_phys), public :: precz0, preczh, clmd, clmp, clmdpa + real(kind_phys), public, parameter :: c0t=0.002, d0t=0.002 ! ! Private data ! @@ -225,15 +226,17 @@ subroutine cs_conv_run( IJSDIM , KMAX , ntracp1 , NN, & ! ! output arguments of CS_CUMLUS ! - real(kind_phys), dimension(IJSDIM,KMAX,nctp) :: vverti + real(kind_phys), dimension(IJSDIM,KMAX+1,nctp) :: vverti, sigmai real(kind_phys) GTT(IJSDIM,KMAX) !< temperature tendency [K/s] real(kind_phys) GTQ(IJSDIM,KMAX,NTR) !< tracer tendency [kg/kg/s] real(kind_phys) GTU(IJSDIM,KMAX) !< zonal velocity tendency [m/s2] real(kind_phys) GTV(IJSDIM,KMAX) !< meridional velocity tendency [m/s2] - real(kind_phys) GTPRP(IJSDIM,KMAX) !< precipitation (including snowfall) flux at interfaces [kg/m2/s] - real(kind_phys) GSNWP(IJSDIM,KMAX) !< snowfall flux at interfaces [kg/m2/s] - + real(kind_phys) CMDET(IJSDIM,KMAX) !< detrainment mass flux [kg/m2/s] + real(kind_phys) GTPRP(IJSDIM,KMAX+1) !< precipitation (including snowfall) flux at interfaces [kg/m2/s] + real(kind_phys) GSNWP(IJSDIM,KMAX+1) !< snowfall flux at interfaces [kg/m2/s] + real(kind_phys) GMFX0(IJSDIM,KMAX+1) !< updraft mass flux [kg/m2/s] + real(kind_phys) GMFX1(IJSDIM,KMAX+1) !< downdraft mass flux [kg/m2/s] integer KT(IJSDIM,nctp) !< cloud top index for each cloud type real(kind_phys) :: cape(IJSDIM) !< convective available potential energy (J/kg) @@ -377,13 +380,14 @@ subroutine cs_conv_run( IJSDIM , KMAX , ntracp1 , NN, & !> -# Initialize the sigma diagnostics do n=1,nctp - do k=1,kmax + do k=1,kmax+1 do i=ists,iens vverti(i,k,n) = zero + sigmai(i,k,n) = zero enddo enddo enddo - do k=1,kmax + do k=1,kmax+1 do i=ists,iens sigma(i,k) = zero enddo @@ -394,9 +398,9 @@ subroutine cs_conv_run( IJSDIM , KMAX , ntracp1 , NN, & otspt(1:ntr,1), otspt(1:ntr,2), & lprnt , ipr , & GTT , GTQ , GTU , GTV , & ! output - dt_mf , & ! output - GTPRP , GSNWP , ud_mf , & ! output - dd_mf , cape , KT , & ! output + CMDET , & ! output + GTPRP , GSNWP , GMFX0 , & ! output + GMFX1 , cape , KT , & ! output CBMFX , & ! modified GDT , GDQ , GDU , GDV , & ! input GDTM , & ! input @@ -404,7 +408,7 @@ subroutine cs_conv_run( IJSDIM , KMAX , ntracp1 , NN, & delp , delpi , & DELTA , DELTI , ISTS , IENS, mype,& ! input fscav, fswtr, wcbmaxm, nctp, & - sigma, vverti, & ! input/output !DDsigma + sigmai, sigma, vverti, & ! input/output !DDsigma do_aw, do_awdd, flx_form) ! ! @@ -432,6 +436,10 @@ subroutine cs_conv_run( IJSDIM , KMAX , ntracp1 , NN, & t(i,k) = GDT(i,k) + GTT(i,k) * delta u(i,k) = GDU(i,k) + GTU(i,k) * delta v(i,k) = GDV(i,k) + GTV(i,k) * delta +! Set the mass fluxes. + ud_mf (i,k) = GMFX0(i,k) + dd_mf (i,k) = GMFX1(i,k) + dt_mf (i,k) = CMDET(i,k) enddo enddo @@ -458,8 +466,8 @@ subroutine cs_conv_run( IJSDIM , KMAX , ntracp1 , NN, & ! CNV_PRC3(i,k) = 0.0 CNV_NDROP(i,k) = 0.0 CNV_NICE(i,k) = 0.0 - cf_upi(i,k) = max(0.0, min(1.0, 0.5*(sigma(i,k)+sigma(i,kp1)))) - CLCN(i,k) = cf_upi(i,k) !downdraft is below updraft +! cf_upi(i,k) = max(0.0,min(0.01*log(1.0+500*ud_mf(i,k)),0.1)) +! CLCN(i,k) = cf_upi(i,k) !downdraft is below updraft !! clcn(i,k) = max(0.0,min(0.01*log(1.0+500*ud_mf(i,k)/delta),0.25)) w_upi(i,k) = 0.0 @@ -492,9 +500,9 @@ subroutine cs_conv_run( IJSDIM , KMAX , ntracp1 , NN, & ! CNV_PRC3(i,k) = 0.0 CNV_NDROP(i,k) = 0.0 CNV_NICE(i,k) = 0.0 - cf_upi(i,k) = max(0.0,min(0.01*log(1.0+500*ud_mf(i,k)),0.25)) +! cf_upi(i,k) = max(0.0,min(0.01*log(1.0+500*ud_mf(i,k)),0.1)) ! & 500*ud_mf(i,k)),0.60)) - CLCN(i,k) = cf_upi(i,k) !downdraft is below updraft +! CLCN(i,k) = cf_upi(i,k) !downdraft is below updraft w_upi(i,k) = ud_mf(i,k)*(t(i,k)+epsvt*gdq(i,k,1)) * rair & / (max(cf_upi(i,k),1.e-12)*gdp(i,k)) @@ -586,11 +594,11 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions GDT , GDQ , GDU , GDV , & ! input GDTM , & ! input GDP , GDPM , GDZ , GDZM , & ! input - delp , delpi , & + delp , delpinv , & DELTA , DELTI , ISTS , IENS, mype,& ! input fscav, fswtr, wcbmaxm, nctp, & ! - sigma, vverti, & ! input/output !DDsigma - do_aw, do_awdd, flx_form ) + sigmai, sigma, vverti, & ! input/output !DDsigma + do_aw, do_awdd, flx_form) ! IMPLICIT NONE @@ -598,6 +606,8 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions INTEGER, INTENT(IN) :: im, IJSDIM, KMAX, NTR, mype, nctp, ipr !! DD, for GFS, pass in logical, intent(in) :: do_aw, do_awdd, flx_form ! switch to apply Arakawa-Wu to the tendencies logical, intent(in) :: otspt1(ntr), otspt2(ntr), lprnt + REAL(kind_phys),intent(in) :: DELP (IJSDIM, KMAX) + REAL(kind_phys),intent(in) :: DELPINV (IJSDIM, KMAX) ! ! [OUTPUT] REAL(kind_phys), INTENT(OUT) :: GTT (IJSDIM, KMAX ) ! heating rate @@ -605,35 +615,35 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions REAL(kind_phys), INTENT(OUT) :: GTU (IJSDIM, KMAX ) ! tendency of u REAL(kind_phys), INTENT(OUT) :: GTV (IJSDIM, KMAX ) ! tendency of v REAL(kind_phys), INTENT(OUT) :: CMDET (IJSDIM, KMAX ) ! detrainment mass flux - + REAL(kind_phys) :: GTLDET( IJSDIM, KMAX ) ! cloud liquid tendency by detrainment + REAL(kind_phys) :: GTIDET( IJSDIM, KMAX ) ! cloud ice tendency by detrainment ! assuming there is no flux at the top of the atmospherea - Moorthi - REAL(kind_phys), INTENT(OUT) :: GTPRP (IJSDIM, KMAX ) ! rain+snow flux - REAL(kind_phys), INTENT(OUT) :: GSNWP (IJSDIM, KMAX ) ! snowfall flux - REAL(kind_phys), INTENT(OUT) :: GMFX0 (IJSDIM, KMAX ) ! updraft mass flux - REAL(kind_phys), INTENT(OUT) :: GMFX1 (IJSDIM, KMAX ) ! downdraft mass flux + REAL(kind_phys), INTENT(OUT) :: GTPRP (IJSDIM, KMAX+1 ) ! rain+snow flux + REAL(kind_phys), INTENT(OUT) :: GSNWP (IJSDIM, KMAX+1 ) ! snowfall flux + REAL(kind_phys), INTENT(OUT) :: GMFX0 (IJSDIM, KMAX+1 ) ! updraft mass flux + REAL(kind_phys), INTENT(OUT) :: GMFX1 (IJSDIM, KMAX+1 ) ! downdraft mass flux REAL(kind_phys), INTENT(OUT) :: CAPE (IJSDIM ) INTEGER , INTENT(OUT) :: KT (IJSDIM, NCTP ) ! cloud top ! ! [MODIFIED] - REAL(kind_phys), INTENT(INOUT) :: CBMFX (IM, NCTP) ! cloud base mass flux - -!DDsigma - output added for AW sigma diagnostics -! sigma and vert. velocity as a function of cloud type (1==sfc) - real(kind_phys), intent(out), dimension(IM,KMAX) :: sigma !sigma totaled over cloud type - on interfaces (1=sfc) - real(kind_phys), intent(out), dimension(IM,KMAX,nctp) :: vverti + REAL(kind_phys), INTENT(INOUT) :: CBMFX ( IM, NCTP ) !! cloud base mass flux + !DDsigma - output added for AW sigma diagnostics + real(kind_phys), intent(out) :: sigmai(IM,KMAX+1,nctp) !DDsigma sigma by cloud type - on interfaces (1=sfc) + real(kind_phys), intent(out) :: vverti(IM,KMAX+1,nctp) !DDsigma vert. vel. by cloud type - on interfaces (1=sfc) + real(kind_phys), intent(out) :: sigma(IM,KMAX+1) !DDsigma sigma totaled over cloud type - on interfaces (1=sfc) + ! for computing AW flux form of tendencies -! The tendencies are summed over all cloud types -! real(kind_phys), intent(out), dimension(IM,KMAX) :: & !DDsigmadiag - real(kind_phys), allocatable, dimension(:,:) :: sfluxterm, qvfluxterm,& ! tendencies of DSE and water vapor due to eddy mass flux - qlfluxterm, qifluxterm,& ! tendencies of cloud water and cloud ice due to eddy mass flux +! real(kind_phys), dimension(IM,KMAX) :: & !DDsigmadiag +! sfluxterm, qvfluxterm +! real(kind_phys), dimension(IM,KMAX) :: & !DDsigmadiag +! qlfluxterm, qifluxterm +! real(kind_phys), dimension(ijsdim,kmax,ntrq:ntr) :: trfluxterm ! tendencies of tracers due to eddy mass flux + real(kind_phys), dimension(IM,KMAX) :: & !DDsigmadiag + condtermt, condtermq, frzterm, prectermq, prectermfrz + !DDsigma -! The fluxes are for an individual cloud type and reused. -! condtermt, condtermq are eddy flux of temperature and water vapor - condtermt, condtermq, frzterm, & - prectermq, prectermfrz - real(kind_phys), allocatable, dimension(:,:,:) :: trfluxterm ! tendencies of tracers due to eddy mass flux ! ! [INPUT] REAL(kind_phys), INTENT(IN) :: GDT (IJSDIM, KMAX ) ! temperature T @@ -653,167 +663,190 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions ! ! [INTERNAL WORK] REAL(kind_phys), allocatable :: GPRCC (:, :) ! rainfall -! REAL(kind_phys) GPRCC (IJSDIM, NTR) ! rainfall -! REAL(kind_phys) GSNWC (IJSDIM) ! snowfall -! REAL(kind_phys) CUMCLW(IJSDIM, KMAX) ! cloud water in cumulus -! REAL(kind_phys) CUMFRC(IJSDIM) ! cumulus cloud fraction -! -! REAL(kind_phys) GTCFRC(IJSDIM, KMAX) ! change in cloud fraction -! REAL(kind_phys) FLIQC (IJSDIM, KMAX) ! liquid ratio in cumulus -! -! REAL(kind_phys) GDCFRC(IJSDIM, KMAX) ! cloud fraction -! - REAL(kind_phys) GDW (IJSDIM, KMAX) ! total water - REAL(kind_phys) DELP (IJSDIM, KMAX) - REAL(kind_phys) DELPI (IJSDIM, KMAX) - REAL(kind_phys) GDQS (IJSDIM, KMAX) ! saturate moisture - REAL(kind_phys) FDQS (IJSDIM, KMAX) - REAL(kind_phys) GAM (IJSDIM, KMAX) - REAL(kind_phys) GDS (IJSDIM, KMAX) ! dry static energy - REAL(kind_phys) GDH (IJSDIM, KMAX) ! moist static energy - REAL(kind_phys) GDHS (IJSDIM, KMAX) ! saturate MSE -! - REAL(kind_phys) GCYM (IJSDIM, KMAX, NCTP)! norm. mass flux (half lev) - REAL(kind_phys) GCHB (IJSDIM) ! cloud base MSE-Li*Qi - REAL(kind_phys) GCWB (IJSDIM) ! cloud base total water - REAL(kind_phys) GCUB (IJSDIM) ! cloud base U - REAL(kind_phys) GCVB (IJSDIM) ! cloud base V - REAL(kind_phys) GCIB (IJSDIM) ! cloud base ice - REAL(kind_phys) GCtrB (IJSDIM,ntrq:ntr) ! cloud base tracer - REAL(kind_phys) GCYT (IJSDIM, NCTP) ! norm. mass flux @top - REAL(kind_phys) GCHT (IJSDIM, NCTP) ! cloud top MSE - REAL(kind_phys) GCQT (IJSDIM, NCTP) ! cloud top q - REAL(kind_phys) GCwT (IJSDIM) ! cloud top total water - REAL(kind_phys) GCUT (IJSDIM, NCTP) ! cloud top U - REAL(kind_phys) GCVT (IJSDIM, NCTP) ! cloud top V - REAL(kind_phys) GCLT (IJSDIM, NCTP) ! cloud top cloud water - REAL(kind_phys) GCIT (IJSDIM, NCTP) ! cloud top cloud ice + REAL(kind_phys) GSNWC ( IJSDIM ) !! snowfall + REAL(kind_phys) CUMCLW( IJSDIM, KMAX ) !! cloud water in cumulus + REAL(kind_phys) CUMFRC( IJSDIM ) !! cumulus cloud fraction +!COSP + REAL(kind_phys) QLIQC ( IJSDIM, KMAX ) !! cumulus cloud liquid water [kg/kg] + REAL(kind_phys) QICEC ( IJSDIM, KMAX ) !! cumulus cloud ice [kg/kg] + REAL(kind_phys) GPRCPF( IJSDIM, KMAX ) !! rainfall flux at full level + REAL(kind_phys) GSNWPF( IJSDIM, KMAX ) !! snowfall flux at full level +! + REAL(kind_phys) GTCFRC( IJSDIM, KMAX ) !! change in cloud fraction + REAL(kind_phys) FLIQC ( IJSDIM, KMAX ) !! liquid ratio in cumulus +! +!#ifdef OPT_CHASER +! REAL(kind_phys) RFXC ( IJSDIM, KMAX+1 ) !! precipi. flx [kg/m2/s] +! REAL(kind_phys) SFXC ( IJSDIM, KMAX+1 ) !! ice/snow flx [kg/m2/s] +! INTEGER LEVCUM( IJSDIM, KMAX ) !! flag for cum. cloud top +! REAL(kind_phys) LNFRC ( IJSDIM, KMAX ) !! areal rates of clouds +! REAL(kind_phys) REVC ( IJSDIM, KMAX ) !! evaporation rates +!#endif +! + REAL(kind_phys) GDCFRC( IJSDIM, KMAX ) !! cloud fraction +! +! REAL(kind_phys) GTQL ( IJSDIM, KMAX ) !! tendency of cloud liquid +! + REAL(kind_phys) GDW ( IJSDIM, KMAX ) !! total water + REAL(kind_phys) GDQS ( IJSDIM, KMAX ) !! saturate moisture + REAL(kind_phys) FDQS ( IJSDIM, KMAX ) + REAL(kind_phys) GAM ( IJSDIM, KMAX ) + REAL(kind_phys) GDS ( IJSDIM, KMAX ) !! dry static energy + REAL(kind_phys) GDH ( IJSDIM, KMAX ) !! moist static energy + REAL(kind_phys) GDHS ( IJSDIM, KMAX ) !! saturate MSE +! + REAL(kind_phys) GCYM ( IJSDIM, KMAX, NCTP ) !! norm. mass flux (half lev) + REAL(kind_phys) GCHB ( IJSDIM ) !! cloud base MSE-Li*Qi + REAL(kind_phys) GCWB ( IJSDIM ) !! cloud base total water + REAL(kind_phys) GCtrB ( IJSDIM, ntrq:ntr ) !! cloud base water vapor tracer + REAL(kind_phys) GCUB ( IJSDIM ) !! cloud base U + REAL(kind_phys) GCVB ( IJSDIM ) !! cloud base V + REAL(kind_phys) GCIB ( IJSDIM ) !! cloud base ice + REAL(kind_phys) ELAM ( IJSDIM, KMAX, NCTP ) !! entrainment (rate*massflux) + REAL(kind_phys) GCYT ( IJSDIM, NCTP ) !! norm. mass flux @top + REAL(kind_phys) GCHT ( IJSDIM, NCTP ) !! cloud top MSE + REAL(kind_phys) GCQT ( IJSDIM, NCTP ) !! cloud top q + REAL(kind_phys) GCwT ( IJSDIM ) !! cloud top total water + REAL(kind_phys) GCUT ( IJSDIM, NCTP ) !! cloud top U + REAL(kind_phys) GCVT ( IJSDIM, NCTP ) !! cloud top V + REAL(kind_phys) GCLT ( IJSDIM, NCTP ) !! cloud top cloud water + REAL(kind_phys) GCIT ( IJSDIM, NCTP ) !! cloud top cloud ice REAL(kind_phys) GCtrT (IJSDIM, ntrq:ntr, NCTP) ! cloud top tracer - REAL(kind_phys) GTPRT (IJSDIM, NCTP) ! precipitation/M - REAL(kind_phys) GCLZ (IJSDIM, KMAX) ! cloud liquid for each CTP - REAL(kind_phys) GCIZ (IJSDIM, KMAX) ! cloud ice for each CTP - -! REAL(kind_phys) ACWF (IJSDIM, NCTP) ! cloud work function - REAL(kind_phys) ACWF (IJSDIM ) ! cloud work function - REAL(kind_phys) GPRCIZ(IJSDIM, KMAX) ! precipitation - REAL(kind_phys) GSNWIZ(IJSDIM, KMAX) ! snowfall - REAL(kind_phys) GTPRC0(IJSDIM) ! precip. before evap. - - REAL(kind_phys) GMFLX (IJSDIM, KMAX) ! mass flux (updraft+downdraft) - REAL(kind_phys) QLIQ (IJSDIM, KMAX) ! total cloud liquid - REAL(kind_phys) QICE (IJSDIM, KMAX) ! total cloud ice - REAL(kind_phys) GPRCI (IJSDIM, KMAX) ! rainfall generation - REAL(kind_phys) GSNWI (IJSDIM, KMAX) ! snowfall generation - - REAL(kind_phys) GPRCP (IJSDIM, KMAX) ! rainfall flux -! - REAL(kind_phys) GTEVP (IJSDIM, KMAX) ! evaporation+sublimation - REAL(kind_phys) GMDD (IJSDIM, KMAX) ! downdraft mass flux - -! REAL(kind_phys) CUMHGT(IJSDIM, NCTP) ! cloud top height -! REAL(kind_phys) CTOPP (IJSDIM) ! cloud top pressure - - REAL(kind_phys) GDZTR (IJSDIM) ! tropopause height -! REAL(kind_phys) FLIQOU(IJSDIM, KMAX) ! liquid ratio in cumulus - INTEGER KB (IJSDIM) - INTEGER KSTRT (IJSDIM) ! tropopause level - REAL(kind_phys) GAMX - REAL(kind_phys) CIN (IJSDIM) - INTEGER JBUOY (IJSDIM) - REAL(kind_phys) DELZ, BUOY, DELWC, DELER - REAL(kind_phys) WCBX (IJSDIM) -! REAL(kind_phys) ERMR (NCTP) ! entrainment rate (ASMODE) -! SAVE ERMR - INTEGER KTMX (NCTP) ! max of cloud top - INTEGER KTMXT ! max of cloud top -! REAL(kind_phys) TIMED - REAL(kind_phys) GDCLDX, GDMU2X, GDMU3X -! -! REAL(kind_phys) HBGT (IJSDIM) ! imbalance in column heat -! REAL(kind_phys) WBGT (IJSDIM) ! imbalance in column water + REAL(kind_phys) GTPRT ( IJSDIM, NCTP ) !! precipitation/M + REAL(kind_phys) GCLZ ( IJSDIM, KMAX ) !! cloud liquid for each CTP + REAL(kind_phys) GCIZ ( IJSDIM, KMAX ) !! cloud ice for each CTP + + REAL(kind_phys) ACWF ( IJSDIM ) !! cloud work function + REAL(kind_phys) GPRCIZ( IJSDIM, KMAX+1, NCTP ) !! precipitation + REAL(kind_phys) GSNWIZ( IJSDIM, KMAX+1, NCTP ) !! snowfall + REAL(kind_phys) GTPRC0( IJSDIM ) !! precip. before evap. + + REAL(kind_phys) GMFLX ( IJSDIM, KMAX+1 ) !! mass flux (updraft+downdraft) + REAL(kind_phys) QLIQ ( IJSDIM, KMAX ) !! total cloud liquid + REAL(kind_phys) QICE ( IJSDIM, KMAX ) !! total cloud ice + REAL(kind_phys) GPRCI ( IJSDIM, KMAX ) !! rainfall generation + REAL(kind_phys) GSNWI ( IJSDIM, KMAX ) !! snowfall generation + + REAL(kind_phys) GPRCP ( IJSDIM, KMAX+1 ) !! rainfall flux +! + REAL(kind_phys) GTEVP ( IJSDIM, KMAX ) !! evaporation+sublimation + REAL(kind_phys) GMDD ( IJSDIM, KMAX+1 ) !! downdraft mass flux + + REAL(kind_phys) CUMHGT( IJSDIM, NCTP ) !! cloud top height + REAL(kind_phys) CTOPP ( IJSDIM ) !! cloud top pressure + + REAL(kind_phys) GDZTR ( IJSDIM ) !! tropopause height + REAL(kind_phys) FLIQOU( IJSDIM, KMAX ) !! liquid ratio in cumulus +!#ifdef OPT_CHASER +! REAL(kind_phys) TOPFLX( IJSDIM, NCTP ) !! flux at each cloud top +!#endif + INTEGER KB ( IJSDIM ) + INTEGER KSTRT ( IJSDIM ) !! tropopause level + REAL(kind_phys) GAMX + REAL(kind_phys) CIN ( IJSDIM ) + INTEGER JBUOY ( IJSDIM ) + REAL(kind_phys) DELZ, BUOY, DELWC, DELER +!M REAL(kind_phys) WCB ( NCTP ) !! updraft velocity**2 @base +!M SAVE WCB + REAL(kind_phys) WCBX (IJSDIM) +! REAL(kind_phys) ERMR ( NCTP ) !! entrainment rate (ASMODE) +! SAVE ERMR + INTEGER KTMX ( NCTP ) !! max of cloud top + INTEGER KTMXT !! max of cloud top + REAL(kind_phys) TIMED + REAL(kind_phys) GDCLDX, GDMU2X, GDMU3X +! + LOGICAL OOUT1, OOUT2 + INTEGER KBMX, I, K, CTP, ierr, n, kp1, l, l1, kk, kbi, kmi, km1 + real(kind_phys) tem1, tem2, tem3, cbmfl, mflx_e, teme, tems + + REAL(kind_phys) HBGT ( IJSDIM ) !! imbalance in column heat + REAL(kind_phys) WBGT ( IJSDIM ) !! imbalance in column water -!DDsigma begin local work variables - all on model interfaces (sfc=1) - REAL(kind_phys) lamdai ! lamda for cloud type ctp - REAL(kind_phys) gdqm, gdlm, gdim ! water vapor + !DDsigma begin local work variables - all on model interfaces (sfc=1) + REAL(kind_phys) lamdai( IJSDIM, KMAX+1, nctp ) !! lamda for cloud type ctp + REAL(kind_phys) lamdaprod( IJSDIM, KMAX+1 ) !! product of (1+lamda) through cloud type ctp + REAL(kind_phys) gdrhom !! density + REAL(kind_phys) gdtvm !! virtual temperature + REAL(kind_phys) gdqm, gdwm,gdlm, gdim !! water vaper REAL(kind_phys) gdtrm(ntrq:ntr) ! tracer - -! the following are new arguments to cumup to get them out for AW - REAL(kind_phys) wcv (IJSDIM, KMAX) ! in-cloud vertical velocity - REAL(kind_phys) GCTM (IJSDIM, KMAX) ! cloud T (half lev) !DDsigmadiag make output - REAL(kind_phys) GCQM (IJSDIM, KMAX) ! cloud q (half lev) !DDsigmadiag make output - REAL(kind_phys) GCwM (IJSDIM, KMAX) ! cloud q (half lev) !DDsigmadiag make output - REAL(kind_phys) GCiM (IJSDIM, KMAX) ! cloud q (half lev) !DDsigmadiag make output - REAL(kind_phys) GClM (IJSDIM, KMAX) ! cloud q (half lev) !DDsigmadiag make output - REAL(kind_phys) GChM (IJSDIM, KMAX) ! cloud q (half lev) !DDsigmadiag make output + character(len=4) :: cproc !DDsigmadiag + + ! the following are new arguments to cumup to get them out + REAL(kind_phys) wcv( IJSDIM, KMAX+1, nctp) !! in-cloud vertical velocity + REAL(kind_phys) GCTM ( IJSDIM, KMAX+1 ) !! cloud T (half lev) !DDsigmadiag make output + REAL(kind_phys) GCQM ( IJSDIM, KMAX+1, nctp ) !! cloud q (half lev) !DDsigmadiag make output + REAL(kind_phys) GCwM ( IJSDIM, KMAX+1, nctp ) !! cloud q (half lev) !DDsigmadiag make output + REAL(kind_phys) GCiM ( IJSDIM, KMAX+1 ) !! cloud q (half lev) !DDsigmadiag make output + REAL(kind_phys) GClM ( IJSDIM, KMAX+1 ) !! cloud q (half lev) !DDsigmadiag make output + REAL(kind_phys) GChM ( IJSDIM, KMAX+1, nctp ) !! cloud q (half lev) !DDsigmadiag make output REAL(kind_phys) GCtrM (IJSDIM, KMAX, ntrq:ntr) ! cloud tracer (half lev) !DDsigmadiag make output - -! eddy flux profiles for dse, water vapor, cloud water, cloud ice - REAL(kind_phys), dimension(Kmax+1) :: sfluxtem, qvfluxtem, qlfluxtem, qifluxtem - REAL(kind_phys), dimension(Kmax+1,ntrq:ntr) :: trfluxtem ! tracer - -! tendency profiles - condensation heating, condensation moistening, heating due to -! freezing, total precip production, frozen precip production - REAL(kind_phys), dimension(ijsdim,Kmax) :: dtcondtem, dqcondtem, dtfrztem, dqprectem,& ! Moorthi - dfrzprectem, lamdaprod !< product of (1+lamda) through cloud type ctp - REAL(kind_phys), dimension(ijsdim,Kmax) :: dtevap, dqevap, dtmelt, dtsubl - -! factor to modify precip rate to force conservation of water. With bug fixes it's -! not doing anything now. - REAL(kind_phys), dimension(ijsdim) :: moistening_aw - real(kind_phys), dimension(ijsdim,kmax) :: gctbl, gcqbl,gcwbl, gcqlbl, gcqibl, & !DDsigmadiag updraft profiles below cloud Base - sigmad ! downdraft area fraction + +! these are the fluxes at the interfaces - AW will operate on them + REAL(kind_phys), dimension(ijsdim,Kmax+1,nctp) :: sfluxtem, qvfluxtem, qlfluxtem, qifluxtem + REAL(kind_phys), dimension(ijsdim,Kmax+1,ntrq:ntr,nctp) :: trfluxtem ! tracer + + REAL(kind_phys), dimension(ijsdim,Kmax+1) :: dtcondtem, dqcondtem, dtfrztem, dqprectem,dfrzprectem + REAL(kind_phys), dimension(ijsdim,Kmax) :: dtevap, dqevap, dtmelt, dtsubl + REAL(kind_phys), dimension(ijsdim) :: moistening_aw + real(kind_phys) rhs_q, rhs_h, sftem, qftem, qlftem, qiftem + real(kind_phys), dimension(ijsdim,kmax+1) :: gctbl, gcqbl,gcwbl, gcqlbl, gcqibl !DDsigmadiag updraft profiles below cloud Base real(kind_phys), dimension(ijsdim,kmax,ntrq:ntr) :: gctrbl !DDsigmadiag tracer updraft profiles below cloud Base -! rhs_q, rhs_h are residuals of condensed water, MSE budgets to compute condensation, -! and heating due to freezing - real(kind_phys) :: rhs_q, rhs_h, fsigma, sigmai, delpinv -! real(kind_phys) :: rhs_q, rhs_h, sftem, qftem, qlftem, qiftem, & -! fsigma ! factor to reduce mass flux terms (1-sigma**2) for AW -!DDsigma end local work variables -! -! profiles of heating due to precip evaporation, melting and sublimation, and the -! evap, melting and sublimation rates. - - REAL(kind_phys), allocatable, dimension(:,:) :: dtdwn, & ! t tendency downdraft detrainment - dqvdwn, & ! qv tendency downdraft detrainment - dqldwn, & ! ql tendency downdraft detrainment - dqidwn ! qi tendency downdraft detrainment - REAL(kind_phys), allocatable, dimension(:,:,:) :: dtrdwn ! tracer tendency downdraft detrainment - + real(kind_phys), dimension(ijsdim,kmax+1) :: sigmad + real(kind_phys) :: fsigma( IJSDIM, KMAX+1 ) ! factor to reduce mass flux terms (1-sigma**2) for AW + real(kind_phys) :: lamdamax ! for sorting lamda values + integer loclamdamax + real(kind_phys) :: pr_tot, pr_ice, pr_liq !DDsigma end local work variables ! ! [INTERNAL PARM] - REAL(kind_phys), parameter :: WCBMIN = zero ! min. of updraft velocity at cloud base - -!M REAL(kind_phys) :: WCBMAX = 1.4_kind_phys ! max. of updraft velocity at cloud base + REAL(kind_phys) :: WCBMIN = 0._kind_phys !! min. of updraft velocity at cloud base +!M REAL(kind_phys) :: WCBMAX = 1.4_kind_phys !! max. of updraft velocity at cloud base !M wcbas commented by Moorthi since it is not used -!M REAL(kind_phys) :: WCBAS = 2._kind_phys ! updraft velocity**2 at cloud base (ASMODE) -!M REAL(kind_phys) :: ERAMIN = 1.e-5_kind_phys ! min. of entrainment rate - ! used only in OPT_ASMODE -!M REAL(kind_phys) :: ERAMAX = 2.e-3_kind_phys ! max. of entrainment rate - ! used only in OPT_ASMODE - LOGICAL :: OINICB = .false. ! set 0.d0 to CBMFX when .true. - -! REAL(kind_phys) :: VARMIN = 1.e-13_kind_phys ! minimum of PDF variance -! REAL(kind_phys) :: VARMAX = 5.e-7_kind_phys ! maximum of PDF variance -! REAL(kind_phys) :: SKWMAX = 0.566_kind_phys ! maximum of PDF skewness +!M REAL(kind_phys) :: WCBAS = 2._kind_phys !! updraft velocity**2 at cloud base (ASMODE) +!M REAL(kind_phys) :: ERAMIN = 1.e-5_kind_phys !! min. of entrainment rate + !! used only in OPT_ASMODE +!M REAL(kind_phys) :: ERAMAX = 2.e-3_kind_phys !! max. of entrainment rate + !! used only in OPT_ASMODE +! downdraft mass flux terms now slot nctp+1 in the *fluxterm arrays + REAL(kind_phys) dtdwn ( IJSDIM, KMAX ) !! t tendency downdraft detrainment + REAL(kind_phys) dqvdwn ( IJSDIM, KMAX ) !! qv tendency downdraft detrainment + REAL(kind_phys) dqldwn ( IJSDIM, KMAX ) !! ql tendency downdraft detrainment + REAL(kind_phys) dqidwn ( IJSDIM, KMAX ) !! qi tendency downdraft detrainment + REAL(kind_phys), dimension(ijsdim,kmax,ntrq:ntr) :: dtrdwn ! tracer tendency downdraft detrainment + + LOGICAL :: OINICB = .false. !! set 0.d0 to CBMFX + + REAL(kind_phys) :: VARMIN = 1.e-13_kind_phys !! minimum of PDF variance + REAL(kind_phys) :: VARMAX = 5.e-7_kind_phys !! maximum of PDF variance + REAL(kind_phys) :: SKWMAX = 0.566_kind_phys !! maximum of PDF skewness + + REAL(kind_phys) :: PSTRMX = 400.e2_kind_phys !! max P of tropopause + REAL(kind_phys) :: PSTRMN = 50.e2_kind_phys !! min P of tropopause + REAL(kind_phys) :: GCRSTR = 1.e-4_kind_phys !! crit. dT/dz tropopause - REAL(kind_phys) :: PSTRMX = 400.e2_kind_phys ! max P of tropopause - REAL(kind_phys) :: PSTRMN = 50.e2_kind_phys ! min P of tropopause - REAL(kind_phys) :: GCRSTR = 1.e-4_kind_phys ! crit. dT/dz tropopause - - real(kind=kind_phys) :: tem, esat, mflx_e, cbmfl, tem1, tem2, tem3 - INTEGER :: KBMX, I, K, CTP, ierr, n, kp1, km1, kk, kbi, l, l1 + ! 0: mass fixer is not applied + ! tracers which may become negative values + ! e.g. subgrid-PDFs + ! 1: mass fixer is applied, total mass may change through cumulus scheme + ! e.g. moisture, liquid cloud, ice cloud, aerosols + ! 2: mass fixer is applied, total mass never change through cumulus scheme + ! e.g. CO2 + real(kind=kind_phys), parameter :: zero=0.0, one=1.0 + real(kind=kind_phys) :: tem, esat ! - LOGICAL, SAVE :: OFIRST = .TRUE. ! called first time? + LOGICAL, SAVE :: OFIRST = .TRUE. !! called first time? ! + IF ( OFIRST ) THEN - IF (OFIRST) THEN OFIRST = .FALSE. IF (OINICB) THEN CBMFX = zero ENDIF ENDIF ! + + kp1 = kmax + 1 do n=1,ntr do k=1,kmax do i=1,ijsdim @@ -821,65 +854,82 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions enddo enddo enddo - + do k=1,kmax+1 + do i=1,ijsdim + gmflx(i,k) = zero + gmfx0(i,k) = zero + enddo + enddo do k=1,kmax do i=1,ijsdim - gtt(i,k) = zero - gtu(i,k) = zero - gtv(i,k) = zero - gmflx(i,k) = zero - gmfx0(i,k) = zero - gprci(i,k) = zero - gsnwi(i,k) = zero - qliq(i,k) = zero - qice(i,k) = zero -! gtcfrc(i,k) = zero -! cumclw(i,k) = zero -! fliqc(i,k) = zero - sigma(i,k) = zero + gtt(i,k) = zero + gtu(i,k) = zero + gtv(i,k) = zero + gprci(i,k) = zero + gsnwi(i,k) = zero + qliq(i,k) = zero + qice(i,k) = zero +! gtcfrc(i,k) = zero +! cumclw(i,k) = zero +! fliqc(i,k) = zero + fliqou(i,k) = zero + gprcpf(i,k) = zero + gsnwpf(i,k) = zero + cmdet(i,k) = zero enddo enddo if (flx_form) then - allocate(sfluxterm(ijsdim,kmax), qvfluxterm(ijsdim,kmax), qlfluxterm(ijsdim,kmax), & - qifluxterm(ijsdim,kmax), condtermt(ijsdim,kmax), condtermq(ijsdim,kmax), & - frzterm(ijsdim,kmax), prectermq(ijsdim,kmax), prectermfrz(ijsdim,kmax), & - dtdwn(ijsdim,kmax), dqvdwn(ijsdim,kmax), dqldwn(ijsdim,kmax), & - dqidwn(ijsdim,kmax), trfluxterm(ijsdim,kmax,ntrq:ntr), & - dtrdwn(ijsdim,kmax,ntrq:ntr)) - do k=1,kmax - do i=1,ijsdim - sfluxterm(i,k) = zero - qvfluxterm(i,k) = zero - qlfluxterm(i,k) = zero - qifluxterm(i,k) = zero - condtermt(i,k) = zero - condtermq(i,k) = zero - frzterm(i,k) = zero - prectermq(i,k) = zero - prectermfrz(i,k) = zero - dtdwn(i,k) = zero - dqvdwn(i,k) = zero - dqldwn(i,k) = zero - dqidwn(i,k) = zero - cmdet(i,k) = zero + do ctp = 1,nctp + do k=1,kp1 + do i=1,ijsdim + sfluxtem(i,k,ctp) = zero + qvfluxtem(i,k,ctp) = zero + qlfluxtem(i,k,ctp) = zero + qifluxtem(i,k,ctp) = zero + enddo + enddo + do n = ntrq,ntr + do k=1,kp1 + do i=1,ijsdim + trfluxtem(i,k,n,ctp) = zero + enddo + enddo enddo enddo - do n = ntrq,ntr do k=1,kmax do i=1,ijsdim - trfluxterm(i,k,n) = zero - dtrdwn(i,k,n) = zero + condtermt(i,k) = zero + condtermq(i,k) = zero + frzterm(i,k) = zero + prectermq(i,k) = zero + prectermfrz(i,k) = zero enddo enddo - enddo + do k=1,kmax + do i=1,ijsdim + dtdwn(i,k) = zero + dqvdwn(i,k) = zero + dqldwn(i,k) = zero + dqidwn(i,k) = zero + enddo + enddo + do n = ntrq,ntr + do k=1,kmax + do i=1,ijsdim + dtrdwn(i,k,n) = zero + enddo + enddo + enddo endif do i=1,ijsdim -! gprcc(i,:) = zero - gtprc0(i) = zero -! hbgt(i) = zero -! wbgt(i) = zero - gdztr(i) = zero - kstrt(i) = kmax +! gprcc(i,:) = zero +! gmflx(i,kp1) = zero + gmfx0(i,kp1) = zero + gtprc0(i) = zero +! hbgt(i) = zero +! wbgt(i) = zero + gdztr(i) = zero + kstrt(i) = kmax enddo do k=1,kmax @@ -907,9 +957,8 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions ! !> -# Compute tropopause height (GDZTR) DO K=1,KMAX - kp1 = k + 1 DO I=ISTS,IENS - GAMX = (GDTM(I,KP1)-GDTM(I,K)) / (GDZM(I,KP1)-GDZM(I,K)) + GAMX = (GDTM(I,K+1)-GDTM(I,K)) / (GDZM(I,K+1)-GDZM(I,K)) IF ((GDP(I,K) < PSTRMX .AND. GAMX > GCRSTR) .OR. GDP(I,K) < PSTRMN) THEN KSTRT(I) = MIN(K, KSTRT(I)) ENDIF @@ -925,12 +974,12 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions !> -# Call cumbas() to compute cloud base properties CALL CUMBAS(IJSDIM, KMAX , & !DD dimensions - KB , GCYM(1,1,1) , KBMX , & ! output + KB , GCYM(:,:,1) , KBMX , & ! output ntr , ntrq , & GCHB , GCWB , GCUB , GCVB , & ! output GCIB , gctrb, & ! output GDH , GDW , GDHS , GDQS , & ! input - GDQ(1,1,iti) , GDU , GDV , GDZM , & ! input + GDQ(:,:,iti) , GDU , GDV , GDZM , & ! input GDPM , FDQS , GAM , & ! input lprnt, ipr, & ISTS , IENS , & !) ! input @@ -955,7 +1004,7 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions CAPE(I) = CAPE(I) + BUOY * GRAV * (GDZM(I,K+1) - GDZM(I,K)) JBUOY(I) = 2 ELSEIF (BUOY < zero .AND. JBUOY(I) /= 2) THEN - CIN(I) = CIN(I) - BUOY * GRAV * (GDZM(I,K+1) - GDZM(I,K)) + CIN(I) = CIN(I) + BUOY * GRAV * (GDZM(I,K+1) - GDZM(I,K)) JBUOY(I) = -1 ENDIF endif @@ -968,12 +1017,25 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions !DDsigma some initialization before summing over cloud type !> -# Initialize variables before summing over cloud types - do k=1,kmax ! Moorthi + if(flx_form) then + do k=1,kp1 ! Moorthi do i=1,ijsdim lamdaprod(i,k) = one + sigma(i,k) = 0.0 enddo enddo + do ctp=1,nctp + do k=1,kp1 + do i=1,ijsdim + lamdai(i,k,ctp) = zero + sigmai(i,k,ctp) = zero + vverti(i,k,ctp) = zero + enddo + enddo + enddo + endif + do ctp=2,nctp do k=1,kmax do i=1,ijsdim @@ -990,15 +1052,6 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions WCBX(I) = DELWC * DELWC enddo - do k=1,kmax ! Moorthi - do i=1,ijsdim - dqcondtem(i,k) = zero - dqprectem(i,k) = zero - dfrzprectem(i,k) = zero - dtfrztem(i,k) = zero - dtcondtem(i,k) = zero - enddo - enddo ! getting more incloud profiles of variables to compute eddy flux tendencies ! and condensation rates @@ -1010,51 +1063,48 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions !> -# Call cumup() to compute in-cloud properties CALL CUMUP(IJSDIM, KMAX, NTR, ntrq, & !DD dimensions ACWF , & ! output - GCLZ , GCIZ , GPRCIZ , GSNWIZ, & ! output - GCYT(1,CTP) , GCHT(1,CTP) , GCQT (1,CTP), & ! output - GCLT(1,CTP) , GCIT(1,CTP) , GTPRT(1,CTP), & ! output - GCUT(1,CTP) , GCVT(1,CTP) , gctrt(1,ntrq:ntr,ctp), & ! output - KT (1,CTP) , KTMX(CTP) , & ! output - GCYM(1,1,CTP) , & ! modified - wcv , & ! !DD-sigma new output + GCLZ , GCIZ , GPRCIZ(:,:,CTP), GSNWIZ(:,:,CTP), & ! output + GCYT(:,CTP) , GCHT(:,CTP) , GCQT (:,CTP), & ! output + GCLT(:,CTP) , GCIT(:,CTP) , GTPRT(:,CTP), & ! output + GCUT(:,CTP) , GCVT(:,CTP) , gctrt(:,ntrq:ntr,ctp), & ! output + KT (:,CTP) , KTMX(CTP) , & ! output + GCYM(:,:,CTP) , & ! modified + wcv(:,:,CTP) , & ! !DD-sigma new output GCHB , GCWB , GCUB , GCVB , & ! input !DDsigmadiag GCIB , gctrb , & ! input GDU , GDV , GDH , GDW , & ! input GDHS , GDQS , GDT , GDTM , & ! input - GDQ , GDQ(1,1,iti) , GDZ , GDZM , & ! input + GDQ , GDQ(:,:,iti) , GDZ , GDZM , & ! input GDPM , FDQS , GAM , GDZTR , & ! input CPRES , WCBX , & ! input KB , CTP , ISTS , IENS , & ! input - gctm , gcqm, gcwm, gchm, gcwt, gclm, gcim, gctrm, & ! additional incloud profiles and cloud top total water + gctm , gcqm(:,:,CTP), gcwm(:,:,CTP), gchm(:,:,CTP),& + gcwt, gclm, gcim, gctrm, & ! additional incloud profiles and cloud top total water lprnt , ipr ) ! !> -# Call cumbmx() to compute cloud base mass flux CALL CUMBMX(IJSDIM, KMAX, & !DD dimensions - CBMFX(1,CTP), & ! modified - ACWF , GCYT(1,CTP), GDZM , & ! input + CBMFX(:,CTP), & ! modified + ACWF , GCYT(:,CTP), GDZM , & ! input GDW , GDQS , DELP , & ! input - KT (1,CTP), KTMX(CTP) , KB , & ! input + KT (:,CTP), KTMX(CTP) , KB , & ! input DELTI , ISTS , IENS ) !DDsigma - begin sigma computation ! At this point cbmfx is updated and we have everything we need to compute sigma - do i=ISTS,IENS - if (flx_form) then -!> -# Initialize eddy fluxes for cloud types - do k=1,kmax+1 - sfluxtem(k) = zero - qvfluxtem(k) = zero - qlfluxtem(k) = zero - qifluxtem(k) = zero - enddo - do n=ntrq,ntr ! tracers - do k=1,kmax+1 - trfluxtem(k,n) = zero - enddo + if (flx_form) then + do k=1,kmax + 1 ! Moorthi + do i=1,ijsdim + dqcondtem(i,k) = zero + dqprectem(i,k) = zero + dfrzprectem(i,k) = zero + dtfrztem(i,k) = zero + dtcondtem(i,k) = zero enddo - endif + enddo + do i=ISTS,IENS cbmfl = cbmfx(i,ctp) kk = kt(i,ctp) ! cloud top index @@ -1062,56 +1112,54 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions kbi = kb(i) ! cloud base index do k=kbi,kk ! loop from cloud base to cloud top km1 = k - 1 - rhs_h = zero - rhs_q = zero -!> -# Interpolate environment variables to layer interface +! get environment variables interpolated to layer interface GDQM = half * (GDQ(I,K,1) + GDQ(I,KM1,1)) ! as computed in cumup ! GDwM = half * (GDw(I,K) + GDw(I,KM1 )) - GDlM = half * (GDQ(I,K,3) + GDQ(I,KM1,3)) - GDiM = half * (GDQ(I,K,2) + GDQ(I,KM1,2)) + GDlM = half * (GDQ(I,K,itl) + GDQ(I,KM1,itl)) + GDiM = half * (GDQ(I,K,iti) + GDQ(I,KM1,iti)) do n = ntrq,NTR GDtrM(n) = half * (GDQ(I,K,n) + GDQ(I,KM1,n)) ! as computed in cumup enddo mflx_e = gcym(i,k,ctp) * cbmfl ! mass flux at level k for cloud ctp - if (do_aw) then !> -# Compute lamda for a cloud type and then updraft area fraction !! (sigmai) following Equations 23 and 12 of !! Arakawa and Wu (2013) \cite arakawa_and_wu_2013 , respectively - lamdai = mflx_e * rair * gdtm(i,k)*(one+epsvt*gdqm) & - / (gdpm(i,k)*wcv(i,k)) - lamdaprod(i,k) = lamdaprod(i,k) * (one+lamdai) - -! vverti(i,k,ctp) = wcv(i,k) -! sigmai(i,k,ctp) = lamdai / lamdaprod(i,k) -! sigma(i,k) = max(zero, min(one, sigma(i,k) + sigmai(i,k,ctp))) - - sigmai = lamdai / lamdaprod(i,k) - sigma(i,k) = max(zero, min(one, sigma(i,k) + sigmai)) - vverti(i,k,ctp) = sigmai * wcv(i,k) - else - sigma(i,k) = 0.0 - endif + lamdai(i,k,ctp) = mflx_e * rair * gdtm(i,k)*(one+epsvt*gdqm) & + / (gdpm(i,k)*wcv(i,k,ctp)) + +! just compute lamdai here, we will compute sigma, sigmai, and vverti outside +! the cloud type loop after we can sort lamdai +! lamdaprod(i,k) = lamdaprod(i,k) * (one+lamdai(i,k,ctp)) +! +!! vverti(i,k,ctp) = wcv(i,k) +!! sigmai(i,k,ctp) = lamdai / lamdaprod(i,k) +!! sigma(i,k) = max(zero, min(one, sigma(i,k) + sigmai(i,k,ctp))) +! +! sigmai(i,k,ctp) = lamdai(i,k,ctp) / lamdaprod(i,k) +! sigma(i,k) = max(zero, min(one, sigma(i,k) + sigmai(i,k,ctp))) +! vverti(i,k,ctp) = sigmai(i,k,ctp) * wcv(i,k,ctp) - if (flx_form) then +! sigma effect won't be applied until later, when lamda is sorted ! fsigma = 1.0 ! no aw effect, comment following lines to undo AW - fsigma = one - sigma(i,k) +! fsigma = one - sigma(i,k) !> -# Compute tendencies based on mass flux and condensation ! fsigma is the AW reduction of flux tendencies if(k == kbi) then do l=2,kbi ! compute eddy fluxes below cloud base - tem = - fsigma * gcym(i,l,ctp) * cbmfl +! tem = - fsigma * gcym(i,l,ctp) * cbmfl + tem = - gcym(i,l,ctp) * cbmfl ! first get environment variables at layer interface l1 = l - 1 GDQM = half * (GDQ(I,l,1) + GDQ(I,l1,1)) - GDlM = half * (GDQ(I,l,3) + GDQ(I,l1,3)) - GDiM = half * (GDQ(I,l,2) + GDQ(I,l1,2)) + GDlM = half * (GDQ(I,l,itl) + GDQ(I,l1,itl)) + GDiM = half * (GDQ(I,l,iti) + GDQ(I,l1,iti)) !! GDwM = half * (GDw(I,l) + GDw(I,l1)) do n = ntrq,NTR GDtrM(n) = half * (GDQ(I,l,n) + GDQ(I,l1,n)) ! as computed in cumup @@ -1119,12 +1167,12 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions ! flux = mass flux * (updraft variable minus environment variable) !centered differences - sfluxtem(l) = tem * (gdtm(i,l)-gctbl(i,l)) - qvfluxtem(l) = tem * (gdqm-gcqbl(i,l)) - qlfluxtem(l) = tem * (gdlm-gcqlbl(i,l)) - qifluxtem(l) = tem * (gdim-gcqibl(i,l)) + sfluxtem(i,l,ctp) = tem * (gdtm(i,l)-gctbl(i,l)) + qvfluxtem(i,l,ctp) = tem * (gdqm-gcqbl(i,l)) + qlfluxtem(i,l,ctp) = tem * (gdlm-gcqlbl(i,l)) + qifluxtem(i,l,ctp) = tem * (gdim-gcqibl(i,l)) do n = ntrq,NTR - trfluxtem(l,n) = tem * (gdtrm(n)-gctrbl(i,l,n)) + trfluxtem(i,l,n,ctp) = tem * (gdtrm(n)-gctrbl(i,l,n)) enddo ! if(lprnt .and. i == ipr) write(0,*)' l=',l,' kbi=',kbi,' tem =', tem,' trfluxtem=',trfluxtem(l,ntr),& ! ' gdtrm=',gdtrm(ntr),' gctrbl=',gctrbl(i,l,ntr),' gq=',GDQ(I,l,ntr),GDQ(I,l1,ntr),' l1=',l1,' ctp=',ctp,& @@ -1146,14 +1194,15 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions else ! flux = mass flux * (updraft variable minus environment variable) - tem = - fsigma * mflx_e +! tem = - fsigma * mflx_e + tem = - mflx_e !centered - sfluxtem(k) = tem * (gdtm(i,k)+gocp*gdzm(i,k)-gctm(i,k)) - qvfluxtem(k) = tem * (gdqm-gcqm(i,k)) - qlfluxtem(k) = tem * (gdlm-gclm(i,k)) - qifluxtem(k) = tem * (gdim-gcim(i,k)) + sfluxtem(i,k,ctp) = tem * (gdtm(i,k)+gocp*gdzm(i,k)-gctm(i,k)) + qvfluxtem(i,k,ctp) = tem * (gdqm-gcqm(i,k,ctp)) + qlfluxtem(i,k,ctp) = tem * (gdlm-gclm(i,k)) + qifluxtem(i,k,ctp) = tem * (gdim-gcim(i,k)) do n = ntrq,NTR - trfluxtem(k,n) = tem * (gdtrm(n)-gctrm(i,k,n)) + trfluxtem(i,k,n,ctp) = tem * (gdtrm(n)-gctrm(i,k,n)) enddo !upstream - This better matches what the original CS tendencies do @@ -1185,117 +1234,57 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions ! ' fsigma=',fsigma,' mflx_e=',mflx_e,' trfluxtemk=',trfluxtem(k,ntr),' sigma=',sigma(i,k) -! the condensation terms - these come from the MSE and condensed water budgets for -! an entraining updraft -! if(k > kb(i)) then ! comment for test -! if(k <= kk) then ! Moorthi -! if(k < kt(i,ctp)) then -! rhs_h = cbmfl*(gcym(i,k)*gchm(i,k) - (gcym(i,km1)*gchm(i,km1) & -! + GDH(I,Km1 )*(gcym(i,k)-gcym(i,km1))) ) -! rhs_q = cbmfl*(gcym(i,k)*(gcwm(i,k)-gcqm(i,k)) & -! - (gcym(i,km1)*(gcwm(i,km1)-gcqm(i,km1)) & -! + (GDw( I,Km1 )-gdq(i,km1,1))*(gcym(i,k)-gcym(i,km1))) ) -! tem = cbmfl * (one - sigma(i,k)) - tem = cbmfl * (one - 0.5*(sigma(i,k)+sigma(i,km1))) - tem1 = gcym(i,k,ctp) * (one - sigma(i,k)) - tem2 = gcym(i,km1,ctp) * (one - sigma(i,km1)) - rhs_h = cbmfl * (tem1*gchm(i,k) - (tem2*gchm(i,km1) & - + GDH(I,Km1)*(tem1-tem2)) ) - rhs_q = cbmfl * (tem1*(gcwm(i,k)-gcqm(i,k)) & - - (tem2*(gcwm(i,km1)-gcqm(i,km1)) & - + (GDw(I,Km1)-gdq(i,km1,1))*(tem1-tem2)) ) - -! ELSE -! rhs_h = cbmfl*(gcht(i,ctp) - (gcym(i,k-1)*gchm(i,k-1) + GDH( I,K-1 )*(gcyt(i,ctp)-gcym(i,k-1))) ) -! rhs_q = cbmfl*((gcwt(i)-gcqt(i,ctp)) - (gcym(i,k-1)*(gcwm(i,k-1)-gcqm(i,k-1)) + (GDw( I,K-1 )-gdq(i,k-1,1))*(gcyt(i,ctp)-gcym(i,k-1))) ) -! endif - -!> -# Compute condensation, total precipitation production, frozen precipitation production, -!! heating due to freezing, and total temperature tendency due to in-cloud microphysics - dqcondtem(i,km1) = -rhs_q ! condensation -! dqprectem(i,km1) = cbmfl * (GPRCIZ(i,k) + GSNWIZ(i,k)) - dqprectem(i,km1) = tem * (GPRCIZ(i,k) + GSNWIZ(i,k)) ! total precip production -! dfrzprectem(i,km1) = cbmfl * GSNWIZ(i,k) - dfrzprectem(i,km1) = tem * GSNWIZ(i,k) ! production of frozen precip - dtfrztem(i,km1) = rhs_h*oneocp ! heating due to freezing - dtcondtem(i,km1) = - elocp * dqcondtem(i,km1) + dtfrztem(i,km1) - endif ! if(k > kbi) then - endif ! if (flx_form) enddo ! end of k=kbi,kk loop endif ! end of if(cbmfl > zero) -! get tendencies by difference of fluxes, sum over cloud type - - if (flx_form) then - do k = 1,kk - delpinv = delpi(i,k) -!> -# Sum single cloud microphysical tendencies over all cloud types - condtermt(i,k) = condtermt(i,k) + dtcondtem(i,k) * delpinv - condtermq(i,k) = condtermq(i,k) + dqcondtem(i,k) * delpinv - prectermq(i,k) = prectermq(i,k) + dqprectem(i,k) * delpinv - prectermfrz(i,k) = prectermfrz(i,k) + dfrzprectem(i,k) * delpinv - frzterm(i,k) = frzterm(i,k) + dtfrztem(i,k) * delpinv - -!> -# Compute flux tendencies and vertical flux divergence - sfluxterm(i,k) = sfluxterm(i,k) - (sfluxtem(k+1) - sfluxtem(k)) * delpinv - qvfluxterm(i,k) = qvfluxterm(i,k) - (qvfluxtem(k+1) - qvfluxtem(k)) * delpinv - qlfluxterm(i,k) = qlfluxterm(i,k) - (qlfluxtem(k+1) - qlfluxtem(k)) * delpinv - qifluxterm(i,k) = qifluxterm(i,k) - (qifluxtem(k+1) - qifluxtem(k)) * delpinv - do n = ntrq,ntr - trfluxterm(i,k,n) = trfluxterm(i,k,n) - (trfluxtem(k+1,n) - trfluxtem(k,n)) * delpinv - enddo -! if (lprnt .and. i == ipr) write(0,*)' k=',k,' trfluxtem=',trfluxtem(k+1,ntr),trfluxtem(k,ntr),& -! ' ctp=',ctp,' trfluxterm=',trfluxterm(i,k,ntr) - enddo - endif ! if (flx_form) enddo ! end of i loop -! - do i=ists,iens - if (cbmfx(i,ctp) > zero) then - tem = one - sigma(i,kt(i,ctp)) - gcyt(i,ctp) = tem * gcyt(i,ctp) - gtprt(i,ctp) = tem * gtprt(i,ctp) - gclt(i,ctp) = tem * gclt(i,ctp) - gcht(i,ctp) = tem * gcht(i,ctp) - gcqt(i,ctp) = tem * gcqt(i,ctp) - gcit(i,ctp) = tem * gcit(i,ctp) - if (.not. flx_form) then - do n = ntrq,ntr - gctrt(i,n,ctp) = tem * gctrt(i,n,ctp) - enddo - end if - gcut(i,ctp) = tem * gcut(i,ctp) - gcvt(i,ctp) = tem * gcvt(i,ctp) - do k=1,kmax - kk = kb(i) - if (k < kk) then - tem = one - sigma(i,kk) - tem1 = tem - else - tem = one - sigma(i,k) - tem1 = one - 0.5*(sigma(i,k)+sigma(i,k-1)) - endif - gcym(i,k,ctp) = tem * gcym(i,k,ctp) - gprciz(i,k) = tem1 * gprciz(i,k) - gsnwiz(i,k) = tem1 * gsnwiz(i,k) - gclz(i,k) = tem1 * gclz(i,k) - gciz(i,k) = tem1 * gciz(i,k) - enddo - endif - enddo + endif ! if (flx_form) +! +! we don't reduce these values in AW, just the tendencies due to fluxes +! do i=ists,iens +! if (cbmfx(i,ctp) > zero) then +! tem = one - sigma(i,kt(i,ctp)) +! gcyt(i,ctp) = tem * gcyt(i,ctp) +! gtprt(i,ctp) = tem * gtprt(i,ctp) +! gclt(i,ctp) = tem * gclt(i,ctp) +! gcht(i,ctp) = tem * gcht(i,ctp) +! gcqt(i,ctp) = tem * gcqt(i,ctp) +! gcit(i,ctp) = tem * gcit(i,ctp) +! do n = ntrq,ntr +! gctrt(i,n,ctp) = tem * gctrt(i,n,ctp) +! enddo +! gcut(i,ctp) = tem * gcut(i,ctp) +! gcvt(i,ctp) = tem * gcvt(i,ctp) +! do k=1,kmax +! kk = kb(i) +! if (k < kk) then +! tem = one - sigma(i,kk) +! tem1 = tem +! else +! tem = one - sigma(i,k) +! tem1 = one - 0.5*(sigma(i,k)+sigma(i,k-1)) +! endif +! gcym(i,k,ctp) = tem * gcym(i,k,ctp) +! gprciz(i,k) = tem1 * gprciz(i,k) +! gsnwiz(i,k) = tem1 * gsnwiz(i,k) +! gclz(i,k) = tem1 * gclz(i,k) +! gciz(i,k) = tem1 * gciz(i,k) +! enddo +! endif +! enddo ! !> -# Call cumflx() to compute cloud mass flux and precipitation CALL CUMFLX(IM , IJSDIM, KMAX , & !DD dimensions GMFX0 , GPRCI , GSNWI , CMDET, & ! output QLIQ , QICE , GTPRC0, & ! output - CBMFX(1,CTP) , GCYM(1,1,ctp), GPRCIZ , GSNWIZ , & ! input - GTPRT(1,CTP) , GCLZ , GCIZ , GCYT(1,ctp),& ! input - KB , KT(1,CTP) , KTMX(CTP) , & ! input + CBMFX(:,CTP) , GCYM(:,:,ctp), GPRCIZ(:,:,CTP), GSNWIZ(:,:,CTP) , & ! input + GTPRT(:,CTP) , GCLZ , GCIZ , GCYT(:,ctp),& ! input + KB , KT(:,CTP) , KTMX(CTP) , & ! input ISTS , IENS ) ! input ENDDO ! end of cloud type ctp loop @@ -1333,46 +1322,127 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions GDH , GDQ , GDU , GDV , & ! input ! GTT , GTQ , GTCFRC, GTU , GTV , & ! modified ! GDH , GDQ , GDCFRC, GDU , GDV , & ! input - CBMFX , GCYT , DELPI , GCHT , GCQT , & ! input - GCLT , GCIT , GCUT , GCVT , GDQ(1,1,iti),& ! input + CBMFX , GCYT , DELPInv , GCHT , GCQT , & ! input + GCLT , GCIT , GCUT , GCVT , GDQ(:,:,iti),& ! input gctrt , & KT , ISTS , IENS, nctp ) ! input endif !for now area fraction of the downdraft is zero, it will be computed -! within cumdwn and applied there -! Get AW downdraft eddy flux and microphysical tendencies out of downdraft code. +! within cumdwn and applied there. So we will get the total sigma now before calling it, +! and apply to the diabatic terms from the updrafts. - do k=1,kmax - do i=ists,iens - sigmad(i,k) = zero - enddo - enddo +! if (do_aw.and.flx_form) then + if (flx_form) then + do k=1,kp1 + do i=ists,iens + lamdamax = maxval(lamdai(i,k,:)) + do while (lamdamax > zero) + loclamdamax = maxloc(lamdai(i,k,:),dim=1) + lamdaprod(i,k) = lamdaprod(i,k) * (one+lamdai(i,k,loclamdamax)) + sigmai(i,k,loclamdamax) = lamdai(i,k,loclamdamax) / lamdaprod(i,k) + sigma(i,k) = max(zero, min(one, sigma(i,k) + sigmai(i,k,loclamdamax))) + vverti(i,k,loclamdamax) = sigmai(i,k,loclamdamax) * wcv(i,k,loclamdamax) + + ! make this lamdai negative so it won't be counted again + lamdai(i,k,loclamdamax) = -lamdai(i,k,loclamdamax) + ! get new lamdamax + lamdamax = maxval(lamdai(i,k,:)) + enddo + ! restore original values of lamdai + lamdai(i,k,:) = abs(lamdai(i,k,:)) +! write(6,'(i2,14f7.4)') k,sigmai(i,k,:) + enddo + enddo + endif + +! the condensation terms - these come from the MSE and condensed water budgets for +! an entraining updraft + if(flx_form) then + DO CTP=1,NCTP ! loop over cloud types + dtcondtem(:,:) = zero + dqcondtem(:,:) = zero + dqprectem(:,:) = zero + dfrzprectem(:,:) = zero + dtfrztem(:,:) = zero + do i=ISTS,IENS + cbmfl = cbmfx(i,ctp) + kk = kt(i,ctp) ! cloud top index + if(cbmfl > zero) then ! this should avoid zero wcv in the denominator + kbi = kb(i) ! cloud base index + do k=kbi,kk ! loop from cloud base to cloud top + km1 = k - 1 + rhs_h = zero + rhs_q = zero + if(k > kbi) then +! tem = cbmfl * (one - sigma(i,k)) + tem = cbmfl * (one - 0.5*(sigma(i,k)+sigma(i,km1))) + tem1 = gcym(i,k,ctp) * (one - sigma(i,k)) + tem2 = gcym(i,km1,ctp) * (one - sigma(i,km1)) + rhs_h = cbmfl * (tem1*gchm(i,k,ctp) - (tem2*gchm(i,km1,ctp) & + + GDH(I,Km1)*(tem1-tem2)) ) + rhs_q = cbmfl * (tem1*(gcwm(i,k,ctp)-gcqm(i,k,ctp)) & + - (tem2*(gcwm(i,km1,ctp)-gcqm(i,km1,ctp)) & + + (GDw(I,Km1)-gdq(i,km1,1))*(tem1-tem2)) ) +! + dqcondtem(i,km1) = -rhs_q ! condensation + dqprectem(i,km1) = tem * (GPRCIZ(i,k,ctp) + GSNWIZ(i,k,ctp)) ! total precip production + dfrzprectem(i,km1) = tem * GSNWIZ(i,k,ctp) ! production of frozen precip + dtfrztem(i,km1) = rhs_h*oneocp ! heating due to freezing +! total temperature tendency due to in cloud microphysics + dtcondtem(i,km1) = - elocp * dqcondtem(i,km1) + dtfrztem(i,km1) + + endif ! if(k > kbi) then + enddo ! end of k=kbi,kk loop + + endif ! end of if(cbmfl > zero) + + +! get tendencies by difference of fluxes, sum over cloud type + + do k = 1,kk +! sum single cloud microphysical tendencies over all cloud types + condtermt(i,k) = condtermt(i,k) + dtcondtem(i,k) * delpinv(i,k) + condtermq(i,k) = condtermq(i,k) + dqcondtem(i,k) * delpinv(i,k) + prectermq(i,k) = prectermq(i,k) + dqprectem(i,k) * delpinv(i,k) + prectermfrz(i,k) = prectermfrz(i,k) + dfrzprectem(i,k) * delpinv(i,k) + frzterm(i,k) = frzterm(i,k) + dtfrztem(i,k) * delpinv(i,k) + +! if (lprnt .and. i == ipr) write(0,*)' k=',k,' trfluxtem=',trfluxtem(k+1,ntr),trfluxtem(k,ntr),& +! ' ctp=',ctp,' trfluxterm=',trfluxterm(i,k,ntr) + enddo + + enddo ! end of i loop + enddo ! end of nctp loop + endif +!downdraft sigma and mass-flux tendency terms are now put into +! the nctp+1 slot of the cloud-type dimensiond variables + + do k=1,kmax + do i=ists,iens + sigmad(i,k) = zero + enddo + enddo !> -# Call cumdwn() to compute cumulus downdraft and assocated melt, freeze !! and evaporation - CALL CUMDWN(IM , IJSDIM, KMAX , NTR , ntrq , & ! DD dimensions + CALL CUMDWN(IM, IJSDIM, KMAX, NTR, ntrq, nctp, & ! DD dimensions GTT , GTQ , GTU , GTV , & ! modified GMFLX , & ! modified updraft+downdraft flux GPRCP , GSNWP , GTEVP , GMDD , & ! output GPRCI , GSNWI , & ! input - GDH , GDW , GDQ , GDQ(1,1,iti) , & ! input + GDH , GDW , GDQ , GDQ(:,:,iti) , & ! input GDQS , GDS , GDHS , GDT , & ! input GDU , GDV , GDZ , & ! input - GDZM , FDQS , DELP , DELPI , & ! input + GDZM , FDQS , DELP , DELPInv , & ! input sigmad, do_aw , do_awdd, flx_form, & ! DDsigma input dtmelt, dtevap, dtsubl, & ! DDsigma input dtdwn , dqvdwn, dqldwn, dqidwn, & ! DDsigma input dtrdwn, & KB , KTMXT , ISTS , IENS ) ! input -! here we substitute the AW tendencies into tendencies to be passed out -! if (do_aw) then -! do k=1,kmax -! do i=ists,iens -! sigma(i,k) = sigma(i,k) + sigmad(i,k) -! enddo -! enddo + +! sigma = sigma + sigmad !> -# Call cumsbw() to compute cloud subsidence heating if (.not. flx_form) then @@ -1381,20 +1451,20 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions CALL CUMSBH(IM , IJSDIM, KMAX , NTR , ntrq , & !DD dimensions GTT , GTQ , & ! modified GTU , GTV , & ! modified - GDH , GDQ , GDQ(1,1,iti) , & ! input + GDH , GDQ , GDQ(:,:,iti) , & ! input GDU , GDV , & ! input - DELPI , GMFLX , GMFX0 , & ! input + DELPINV , GMFLX , GMFX0 , & ! input KTMXT , CPRES , kb, ISTS , IENS ) ! input else CALL CUMSBW(IM , IJSDIM, KMAX , & !DD dimensions GTU , GTV , & ! modified GDU , GDV , & ! input - DELPI , GMFLX , GMFX0 , & ! input + DELPINV , GMFLX , GMFX0 , & ! input KTMXT , CPRES , kb, ISTS , IENS ) ! input endif ! -! for now the following routines appear to be of no consequence to AW - DD +! for now the following routines appear to be of no consequence - DD ! if (.not. flx_form) then ! Tracer Updraft properties @@ -1411,20 +1481,20 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions GCYM , GCYT , GCQT , GCLT , GCIT , & ! input GTPRT , GTEVP , GTPRC0, & ! input KB , KBMX , KT , KTMX , KTMXT , & ! input - DELPI , OTSPT1, ISTS , IENS, & ! input + DELPInv , OTSPT1, ISTS , IENS, & ! input fscav , fswtr, nctp) ! ! Tracer Change due to Downdraft ! --------------- CALL CUMDNR(im ,IJSDIM , KMAX , NTR , & !DD dimensions GTQ , & ! modified - GDQ , GMDD , DELPI , & ! input + GDQ , GMDD , DELPInv , & ! input KTMXT , OTSPT1, ISTS , IENS ) ! input !! !! Tracer change due to Subsidence !! --------------- !! This will be done by cumsbh, now DD 20170907 -! CALL CUMSBR(im , IJSDIM, KMAX , NTR , & !DD dimensions +! CALL CUMSBR(im , IJSDIM, KMAX , NTR ,NCTP, & !DD dimensions ! GTQ , & ! modified ! GDQ , DELPI , & ! input ! GMFLX , KTMXT , OTSPT2, & ! input @@ -1447,6 +1517,60 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions !> -# Compute AW tendencies of T, ql and qi if(flx_form) then ! compute AW tendencies ! AW lump all heating together, compute qv term + +! sigma interpolated to the layer for condensation, etc. terms, precipitation + if(do_aw) then + do k=1,kmax + kp1 = k+1 + do i=1,ijsdim + fsigma(i,k) = one - half*(sigma(i,k)+sigma(i,kp1)) + enddo + enddo + else + do k=1,kmax+1 + do i=1,ijsdim + fsigma(i,k) = one + enddo + enddo + endif + +! AW adjustment of precip fluxes from downdraft model + if(do_aw) then + kp1 = kmax+1 + DO I=ISTS,IENS + GSNWP( I,kp1 ) = zero + GPRCP( I,kp1 ) = zero + ENDDO + tem1 = cpoemelt/grav + tem2 = cpoel/grav + tem3 = cpoesub/grav + DO K=KMAX,1,-1 + kp1 = k+1 + DO I=ISTS,IENS + tem = -dtmelt(i,k) * delp(i,k) * tem1 + teme = -dtevap(i,k) * delp(i,k) * tem2 + tems = -dtsubl(i,k) * delp(i,k) * tem3 + GSNWP(I,k) = GSNWP(I,kp1) + fsigma(i,k) * (GSNWI(i,k) - tem - tems) + GPRCP(I,k) = GPRCP(I,kp1) + fsigma(i,k) * (GPRCI(i,k) + tem - teme) + ENDDO + ENDDO + endif + + +! some of the above routines have set the tendencies and they need to be +! reinitialized, gtt not needed, but gtq needed Anning 5/25/2020 + do n=1,ntr + do k=1,kmax + do i=1,ijsdim + gtq(i,k,n) = zero + enddo + enddo + enddo +! do k=1,kmax +! do i=1,ijsdim +! gtt(i,k) = zero +! enddo +! enddo do k=1,kmax do i=ists,iens dqevap(i,k) = - dtevap(i,k)*cpoel - dtsubl(i,k)*cpoesub @@ -1454,25 +1578,70 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions dtsubl(i,k) = zero enddo enddo - do i=1,ijsdim - moistening_aw(i) = zero - enddo - tem2 = one / delta + + +! diabatic terms from updraft and downdraft models DO K=1,KMAX DO I=ISTS,IENS tem = frzterm(i,k)*cpoEMELT - prectermfrz(i,k) - gtt(i,k) = dtdwn(i,k) + sfluxterm(i,k) + condtermt(i,k) & - + dtmelt(i,k) + dtevap(i,k) - gtq(i,k,1) = dqvdwn(i,k) + qvfluxterm(i,k) + condtermq(i,k) & - + dqevap(i,k) - gtq(i,k,itl) = dqldwn(i,k) + qlfluxterm(i,k) - condtermq(i,k) & +! gtt(i,k) = gtt(i,k) + fsigma(i,k)*(dtmelt(i,k) + dtevap(i,k)) + condtermt(i,k) +! gtq(i,k,1) = gtq(i,k,1) + fsigma(i,k)*dqevap(i,k) + condtermq(i,k) +! gtq(i,k,itl) = gtq(i,k,itl) - (condtermq(i,k) + prectermq(i,k) + tem) +! gtq(i,k,iti) = gtq(i,k,iti) + tem + gtt(i,k) = dtdwn(i,k) + condtermt(i,k) & + + fsigma(i,k)*(dtmelt(i,k) + dtevap(i,k)) + gtq(i,k,1) = dqvdwn(i,k) + condtermq(i,k) & + + fsigma(i,k) * dqevap(i,k) + gtq(i,k,itl) = dqldwn(i,k) - condtermq(i,k) & - prectermq(i,k) - tem - gtq(i,k,iti) = dqidwn(i,k) + qifluxterm(i,k) + tem + gtq(i,k,iti) = dqidwn(i,k) + tem + ! detrainment terms get zeroed ! gtldet(i,k) = zero ! gtidet(i,k) = zero + ENDDO + ENDDO +!! flux tendencies - compute the vertical flux divergence + DO ctp =1,nctp + DO I=ISTS,IENS + cbmfl = cbmfx(i,ctp) + kk = kt(i,ctp) ! cloud top index + if(cbmfl > zero) then ! this should avoid zero wcv in the denominator + DO K=1,kk + kp1 = k+1 + gtt(i,k) = gtt(i,k) - (fsigma(i,kp1)*sfluxtem(i,kp1,ctp) & + - fsigma(i,k)*sfluxtem(i,k,ctp)) * delpinv(i,k) + gtq(i,k,1) = gtq(i,k,1) - (fsigma(i,kp1)*qvfluxtem(i,kp1,ctp) & + - fsigma(i,k)*qvfluxtem(i,k,ctp)) * delpinv(i,k) + gtq(i,k,itl) = gtq(i,k,itl) - (fsigma(i,kp1)*qlfluxtem(i,kp1,ctp) & + - fsigma(i,k)*qlfluxtem(i,k,ctp)) * delpinv(i,k) + gtq(i,k,iti) = gtq(i,k,iti) - (fsigma(i,kp1)*qifluxtem(i,kp1,ctp) & + - fsigma(i,k)*qifluxtem(i,k,ctp)) * delpinv(i,k) + ENDDO +! replace tracer tendency only if to be advected. + DO n = ntrq,NTR + if (OTSPT2(n)) then + DO K=1,kk + kp1 = k+1 + gtq(i,k,n) = - (fsigma(i,kp1)*trfluxtem(i,kp1,n,ctp) & + - fsigma(i,k)*trfluxtem(i,k,n,ctp)) * delpinv(i,k) + ENDDO + endif + ENDDO + end if + ENDDO + ENDDO + +! if(kdt>4) stop 1000 + DO I=ISTS,IENS + moistening_aw(i) = zero + enddo +! adjust tendencies that will lead to negative water mixing ratios + tem2 = one / delta + DO K=1,KMAX + DO I=ISTS,IENS tem1 = - gdq(i,k,itl)*tem2 if (gtq(i,k,itl) < tem1) then tem3 = gtq(i,k,itl) - tem1 @@ -1504,7 +1673,7 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions if (OTSPT2(n)) then DO K=1,KMAX DO I=ISTS,IENS - gtq(i,k,n) = dtrdwn(i,k,n) + trfluxterm(i,k,n) + gtq(i,k,n) = gtq(i,k,n) + dtrdwn(i,k,n) ENDDO ENDDO endif @@ -1597,46 +1766,74 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions !> -# Ensures conservation of water. !In fact, no adjustment of the precip ! is occuring now which is a good sign! DD - if(flx_form .and. adjustp) then + if(flx_form) then DO I = ISTS, IENS if(gprcp(i,1)+gsnwp(i,1) > 1.e-12_kind_phys) then - moistening_aw(i) = - moistening_aw(i) / (gprcp(i,1)+gsnwp(i,1)) - else - moistening_aw(i) = 1.0 + moistening_aw(i) = -moistening_aw(i) / (gprcp(i,1)+gsnwp(i,1)) +! print*,'moistening_aw',moistening_aw(i) + gprcp(i,:) = gprcp(i,:) * moistening_aw(i) + gsnwp(i,:) = gsnwp(i,:) * moistening_aw(i) endif - ENDDO - do k=1,kmax - DO I = ISTS, IENS - gprcp(i,k) = max(0.0, gprcp(i,k) * moistening_aw(i)) - gsnwp(i,k) = max(0.0, gsnwp(i,k) * moistening_aw(i)) - ENDDO - enddo - + END DO endif + +! second method of determining sfc precip only +! if(flx_form) then +! DO I = ISTS, IENS +! pr_tot = zero +! pr_liq = zero +! pr_ice = zero +! do k = 1,kmax +! pr_tot = pr_tot - (gtq(i,k,1)+gtq(i,k,itl)+gtq(i,k,iti)) * delp(i,k) * gravi +! pr_ice = pr_ice + ( cp*gtt(i,k) + el*gtq(i,k,1) - emelt*gtq(i,k,iti) ) & +! * delp(i,k)*gravi +! enddo + !pr_ice = max( min(pr_tot, pr_ice / (emelt)),zero) +! pr_ice = pr_ice / emelt +! pr_liq = pr_tot - pr_ice +! END DO +! print *,'precip1',pr_tot*86400.,gprcp(1,1)*86400.,gsnwp(1,1)*86400. +! print *,'precip2',pr_tot*86400.,pr_liq*86400.,pr_ice*86400. +! endif + + DO K = 1, KMAX + DO I = ISTS, IENS + GPRCPF( I,K ) = 0.5*( GPRCP( I,K )+GPRCP( I,K+1 ) ) + GSNWPF( I,K ) = 0.5*( GSNWP( I,K )+GSNWP( I,K+1 ) ) + END DO + END DO + ! -! do i=ISTS,IENS -! GPRCC(I,1) = GPRCP(I,1) -! GSNWC(I ) = GSNWP(I,1) -! enddo - do k=1,kmax +! do i=ISTS,IENS +! GPRCC( I,1 ) = GPRCP( I,1 ) +! GSNWC( I ) = GSNWP( I,1 ) +! enddo + +! adjust sfc precip consistently with vertically integrated +! temperature and moisture tendencies + + do k=1,kmax+1 do i=ISTS,IENS GTPRP(I,k) = GPRCP(I,k) + GSNWP(I,k) enddo enddo ! !DD provide GFS with a separate downdraft mass flux - DO K=1,KMAX - DO I=ISTS,IENS - GMFX1(I,K) = GMFX0(I,K) - GMFLX(I,K) - ENDDO - ENDDO -! - if (flx_form) then - deallocate(sfluxterm, qvfluxterm, qlfluxterm, qifluxterm,& - condtermt, condtermq, frzterm, prectermq, & - prectermfrz, dtdwn, dqvdwn, dqldwn, & - dqidwn, trfluxterm, dtrdwn) - endif + if(do_aw) then + DO K = 1, KMAX+1 + DO I = ISTS, IENS + fsigma(i,k) = one - sigma(i,k) + GMFX0( I,K ) = GMFX0( I,K ) * fsigma(i,k) + GMFLX( I,K ) = GMFLX( I,K ) * fsigma(i,k) + END DO + END DO + endif + DO K = 1, KMAX+1 + DO I = ISTS, IENS + GMFX1( I,K ) = GMFX0( I,K ) - GMFLX( I,K ) + END DO + END DO + if (allocated(gprcc)) deallocate(gprcc) ! @@ -1748,28 +1945,6 @@ SUBROUTINE CUMBAS & ! cloud base ENDIF ENDDO ENDDO - DO K=KLCLB+1,KBMAX-1 - DO I=ISTS,IENS - spbl(i) = one - gdpm(i,k) * tx1(i) - IF (kb(i) > k .and. spbl(i) > spblmax) THEN - KB(I) = K - ENDIF - ENDDO - ENDDO -! DO K=KBMAX-1,KLCLB+1,-1 -! DO I=ISTS,IENS -! GAMX = FDQS(I,K) / (one+GAM(I,K)) * oneocp -! QSL(i) = GDQS(I,K) + GAMX * (GDH(I,KLCLB)-GDHS(I,K)) -! spbl(i) = one - gdpm(i,k) * tx1(i) -! IF (GDW(I,KLCLB) >= QSL(i) .and. spbl(i) >= spblcrit & -! .and. spbl(i) < spblcrit*6.0) THEN -! .and. spbl(i) < spblcrit*8.0) THEN -! KB(I) = K + KBOFS -! ENDIF -! ENDDO -! if(lprnt) write(0,*)' k=',k,' gdh1=',gdh(ipr,klclb),' gdhs=',gdhs(ipr,k),' kb=',kb(ipr) & -! ,' GDQS=',GDQS(ipr,k),' GDW=',GDW(ipr,KLCLB),' gdpm=',gdpm(ipr,k),' spbl=',spbl(ipr),' qsl=',qsl(ipr) -! ENDDO ENDIF ! do i=ists,iens @@ -1910,8 +2085,8 @@ SUBROUTINE CUMUP & !! in-cloud properties REAL(kind_phys) ACWF (IJSDIM) !< cloud work function REAL(kind_phys) GCLZ (IJSDIM, KMAX) !< cloud liquid water*eta REAL(kind_phys) GCIZ (IJSDIM, KMAX) !< cloud ice*eta - REAL(kind_phys) GPRCIZ(IJSDIM, KMAX) !< rain generation*eta - REAL(kind_phys) GSNWIZ(IJSDIM, KMAX) !< snow generation*eta + REAL(kind_phys) GPRCIZ(IJSDIM, KMAX+1) !< rain generation*eta + REAL(kind_phys) GSNWIZ(IJSDIM, KMAX+1) !< snow generation*eta REAL(kind_phys) GCYT (IJSDIM) !< norm. mass flux @top REAL(kind_phys) GCHT (IJSDIM) !< cloud top MSE*eta REAL(kind_phys) GCQT (IJSDIM) !< cloud top moisture*eta @@ -1924,7 +2099,7 @@ SUBROUTINE CUMUP & !! in-cloud properties REAL(kind_phys) GCwT (IJSDIM) !< cloud top v*eta INTEGER KT (IJSDIM) !< cloud top INTEGER KTMX !< max of cloud top - REAL(kind_phys) WCV (IJSDIM, KMAX) !< updraft velocity (half lev) !DD sigma make output + REAL(kind_phys) WCV (IJSDIM, KMAX+1) !< updraft velocity (half lev) !DD sigma make output ! ! [MODIFIED] REAL(kind_phys) GCYM (IJSDIM, KMAX) !< norm. mass flux @@ -1980,12 +2155,12 @@ SUBROUTINE CUMUP & !! in-cloud properties ! REAL(kind_phys) ELAR (IJSDIM, KMAX) !< entrainment rate REAL(kind_phys) ELAR !< entrainment rate at mid layer ! - REAL(kind_phys) GCHM (IJSDIM, KMAX) !< cloud MSE (half lev) - REAL(kind_phys) GCWM (IJSDIM, KMAX) !< cloud Qt (half lev) !DDsigmadiag - REAL(kind_phys) GCTM (IJSDIM, KMAX) !< cloud T (half lev) !DDsigmadiag make output - REAL(kind_phys) GCQM (IJSDIM, KMAX) !< cloud q (half lev) !DDsigmadiag make output - REAL(kind_phys) GCLM (IJSDIM, KMAX) !< cloud liquid ( half lev) - REAL(kind_phys) GCIM (IJSDIM, KMAX) !< cloud ice (half lev) + REAL(kind_phys) GCHM (IJSDIM, KMAX+1) !< cloud MSE (half lev) + REAL(kind_phys) GCWM (IJSDIM, KMAX+1) !< cloud Qt (half lev) !DDsigmadiag + REAL(kind_phys) GCTM (IJSDIM, KMAX+1) !< cloud T (half lev) !DDsigmadiag make output + REAL(kind_phys) GCQM (IJSDIM, KMAX+1) !< cloud q (half lev) !DDsigmadiag make output + REAL(kind_phys) GCLM (IJSDIM, KMAX+1) !< cloud liquid ( half lev) + REAL(kind_phys) GCIM (IJSDIM, KMAX+1) !< cloud ice (half lev) REAL(kind_phys) GCUM (IJSDIM, KMAX) !< cloud U (half lev) REAL(kind_phys) GCVM (IJSDIM, KMAX) !< cloud V (half lev) REAL(kind_phys) GCtrM (IJSDIM, KMAX,ntrq:ntr) !< cloud tracer (half lev) @@ -2021,8 +2196,9 @@ SUBROUTINE CUMUP & !! in-cloud properties ! REAL(kind_phys) :: WCCRT = zero !m REAL(kind_phys) :: WCCRT = 0.01 REAL(kind_phys) :: WCCRT = 1.0e-6_kind_phys, wvcrt=1.0e-3_kind_phys - REAL(kind_phys) :: TSICE = 268.15_kind_phys ! compatible with macrop_driver - REAL(kind_phys) :: TWICE = 238.15_kind_phys ! compatible with macrop_driver + REAL(kind_phys) :: TSICE = 273.15_kind_phys ! compatible with macrop_driver + REAL(kind_phys) :: TWICE = 233.15_kind_phys ! compatible with macrop_driver + REAL(kind_phys) :: c1t ! REAL(kind_phys) :: wfn_neg = 0.1 REAL(kind_phys) :: wfn_neg = 0.15 @@ -2033,10 +2209,15 @@ SUBROUTINE CUMUP & !! in-cloud properties REAL(kind_phys) :: esat, tem ! REAL(kind_phys) :: esat, tem, rhs_h, rhs_q ! +! [INTERNAL FUNC] + REAL(kind_phys) FPREC ! precipitation ratio in condensate + REAL(kind_phys) FRICE ! ice ratio in cloud water REAL(kind_phys) Z ! altitude REAL(kind_phys) ZH ! scale height REAL(kind_phys) T ! temperature ! + FPREC(Z,ZH) = MIN(MAX(one-EXP(-(Z-PRECZ0)/ZH), zero), one) + FRICE(T) = MIN(MAX((TSICE-T)/(TSICE-TWICE), zero), one) ! ! Note: iteration is not made to diagnose cloud ice for simplicity ! @@ -2052,14 +2233,25 @@ SUBROUTINE CUMUP & !! in-cloud properties GCVT (I) = zero GCwT (I) = zero enddo + do k=1,kmax+1 + do i=ists,iens + GPRCIZ(I,k) = zero + GSNWIZ(I,k) = zero + enddo + enddo + do k=1,kmax + do i=ists,iens + WCV (I,k) = unset_kind_phys + GCLM (I,k) = unset_kind_phys + GCIM (I,k) = unset_kind_phys + enddo + enddo do k=1,kmax do i=ists,iens ACWFK (I,k) = unset_kind_phys ACWFN (I,k) = unset_kind_phys GCLZ (I,k) = zero GCIZ (I,k) = zero - GPRCIZ(I,k) = zero - GSNWIZ(I,k) = zero ! GCHMZ (I,k) = zero GCWMZ (I,k) = zero @@ -2070,15 +2262,12 @@ SUBROUTINE CUMUP & !! in-cloud properties ! BUOY (I,k) = unset_kind_phys BUOYM (I,k) = unset_kind_phys - WCV (I,k) = unset_kind_phys GCY (I,k) = unset_kind_phys ! GCHM (I,k) = unset_kind_phys GCWM (I,k) = unset_kind_phys GCTM (I,k) = unset_kind_phys GCQM (I,k) = unset_kind_phys - GCLM (I,k) = unset_kind_phys - GCIM (I,k) = unset_kind_phys GCUM (I,k) = unset_kind_phys GCVM (I,k) = unset_kind_phys enddo @@ -2199,13 +2388,24 @@ SUBROUTINE CUMUP & !! in-cloud properties FDQSM = GDQSM * tem * (fact1 + fact2*tem) ! calculate d(qs)/dT CPGMI = one / (CP + EL*FDQSM) - PRCZH = PRECZH * MIN(GDZTR(I)*ZTREFI, one) - PRECR = FPREC(GDZM(I,K)-GDZMKB(I), PRCZH ) ! wrk = one / GCYM(I,K) DCTM = (GCHMZ(I,K)*wrk - GDHSM) * CPGMI GCQMZ(i) = min((GDQSM+FDQSM*DCTM)*GCYM(I,K), GCWMZ(I,K)) - GTPRMZ(I,K) = PRECR * (GCWMZ(I,K)-GCQMZ(i)) + if(PRECZH > zero) then + PRCZH = PRECZH * MIN(GDZTR(I)*ZTREFI, one) + PRECR = FPREC(GDZM(I,K)-GDZMKB(I), PRCZH ) + GTPRMZ(I,K) = PRECR * (GCWMZ(I,K)-GCQMZ(i)) + else + DELC=GDZ(I,K)-GDZ(I,KM1) + if(gdtm(i,k)>TSICE) then + c1t=c0t*delc + else + c1t=c0t*exp(d0t*(gdtm(i,k)-TSICE))*delc + end if + c1t=min(c1t, one) + GTPRMZ(I,K) = c1t * (GCWMZ(I,K)-GCQMZ(i)) + end if GTPRMZ(I,K) = MAX(GTPRMZ(I,K), GTPRMZ(I,KM1)) GCCMZ = GCWMZ(I,K) - GCQMZ(i) - GTPRMZ(I,K ) DELC = MIN(GCCMZ, zero) @@ -2274,7 +2474,11 @@ SUBROUTINE CUMUP & !! in-cloud properties wrk = one / GCYM(I,K) DCTM = (GCHMZ(I,K)*wrk - GDHSM) * CPGMI GCQMZ(i) = min((GDQSM+FDQSM*DCTM)*GCYM(I,K), GCWMZ(I,K)) - GTPRMZ(I,K) = PRECR * (GCWMZ(I,K)-GCQMZ(i)) + if(PRECZH > zero) then + GTPRMZ(I,K) = PRECR * (GCWMZ(I,K)-GCQMZ(i)) + else + GTPRMZ(I,K) = c1t * (GCWMZ(I,K)-GCQMZ(i)) + end if GTPRMZ(I,K) = MAX(GTPRMZ(I,K), GTPRMZ(I,KM1)) GCCMZ = GCWMZ(I,K) - GCQMZ(i) - GTPRMZ(I,K) DELC = MIN(GCCMZ, zero) @@ -2399,8 +2603,19 @@ SUBROUTINE CUMUP & !! in-cloud properties wrk = one / gcyt(i) DCT = (GCHT(I)*wrk - GDHS(I,K)) / (CP*(one + GAM(I,K))) GCQT(I) = min((GDQS(I,K) + FDQS(I,K)*DCT) * GCYT(I), GCWT(i)) - PRCZH = PRECZH * MIN(GDZTR(I)*ZTREFI, one) - GTPRT(I) = FPREC(GDZ(I,K)-GDZMKB(I), PRCZH) * (GCWT(i)-GCQT(I)) + if(PRECZH > zero) then + PRCZH = PRECZH * MIN(GDZTR(I)*ZTREFI, one) + GTPRT(I) = FPREC(GDZ(I,K)-GDZMKB(I), PRCZH) * (GCWT(i)-GCQT(I)) + else + DELC=GDZ(I,K)-GDZ(I,K-1) + if(gdtm(i,k)>TSICE) then + c1t=c0t*delc + else + c1t=c0t*exp(d0t*(gdtm(i,k)-TSICE))*delc + end if + c1t=min(c1t, one) + GTPRT(I) = c1t * (GCWT(i)-GCQT(I)) + end if GTPRT(I) = MAX(GTPRT(I), GTPRMZ(I,K)) GCCT = GCWT(i) - GCQT(I) - GTPRT(I) DELC = MIN(GCCT, zero) @@ -2503,24 +2718,6 @@ SUBROUTINE CUMUP & !! in-cloud properties ! ! WRITE( CTNUM, '(I2.2)' ) CTP ! - -contains - - pure function FPREC(Z,ZH) - implicit none - real(kind_phys), intent(in) :: Z - real(kind_phys), intent(in) :: ZH - real(kind_phys) :: FPREC - FPREC = MIN(MAX(one-EXP(-(Z-PRECZ0)/ZH), zero), one) - end function FPREC - - pure function FRICE(T) - implicit none - real(kind_phys), intent(in) :: T - real(kind_phys) :: FRICE - FRICE = MIN(MAX((TSICE-T)/(TSICE-TWICE), zero), one) - end function FRICE - END SUBROUTINE CUMUP !*********************************************************************** !>\ingroup cs_scheme @@ -2562,8 +2759,8 @@ SUBROUTINE CUMBMX & !! cloud base mass flux ! [INTERNAL PARAM] REAL(kind_phys) :: FMAX = 1.5e-2_kind_phys ! maximum flux ! REAL(kind_phys) :: RHMCRT = zero ! critical val. of cloud mean RH -! REAL(kind_phys) :: RHMCRT = 0.25_kind_phys ! critical val. of cloud mean RH - REAL(kind_phys) :: RHMCRT = 0.50_kind_phys ! critical val. of cloud mean RH + REAL(kind_phys) :: RHMCRT = 0.25_kind_phys ! critical val. of cloud mean RH +! REAL(kind_phys) :: RHMCRT = 0.50_kind_phys ! critical val. of cloud mean RH REAL(kind_phys) :: ALP1 = zero REAL(kind_phys) :: TAUD = 1.e3_kind_phys ! REAL(kind_phys) :: TAUD = 6.e2_kind_phys @@ -2624,7 +2821,7 @@ SUBROUTINE CUMFLX & !! cloud mass flux INTEGER, INTENT(IN) :: IJSDIM, KMAX, IM !! DD, for GFS, pass in ! ! [OUTPUT] - REAL(kind_phys) GMFLX (IJSDIM, KMAX) !< mass flux + REAL(kind_phys) GMFLX (IJSDIM, KMAX+1) !< mass flux REAL(kind_phys) CMDET (IJSDIM, KMAX) !< detrainment mass flux REAL(kind_phys) GPRCI (IJSDIM, KMAX) !< rainfall generation REAL(kind_phys) GSNWI (IJSDIM, KMAX) !< snowfall generation @@ -2636,8 +2833,8 @@ SUBROUTINE CUMFLX & !! cloud mass flux REAL(kind_phys) CBMFX (IJSDIM) !< cloud base mass flux REAL(kind_phys) GCYM (IJSDIM, KMAX) !< normalized mass flux REAL(kind_phys) GCYT (IJSDIM) !< detraining mass flux - REAL(kind_phys) GPRCIZ(IJSDIM, KMAX) !< precipitation/M - REAL(kind_phys) GSNWIZ(IJSDIM, KMAX) !< snowfall/M + REAL(kind_phys) GPRCIZ(IJSDIM, KMAX+1) !< precipitation/M + REAL(kind_phys) GSNWIZ(IJSDIM, KMAX+1) !< snowfall/M REAL(kind_phys) GTPRT (IJSDIM) !< rain+snow @top REAL(kind_phys) GCLZ (IJSDIM, KMAX) !< cloud liquid/M REAL(kind_phys) GCIZ (IJSDIM, KMAX) !< cloud ice/M @@ -2773,8 +2970,8 @@ SUBROUTINE CUMSBH & !! adiabat. descent REAL(kind_phys) GDU (IJSDIM, KMAX) REAL(kind_phys) GDV (IJSDIM, KMAX) REAL(kind_phys) DELPI (IJSDIM, KMAX) - REAL(kind_phys) GMFLX (IJSDIM, KMAX) !< mass flux (updraft+downdraft) - REAL(kind_phys) GMFX0 (IJSDIM, KMAX) !< mass flux (updraft only) + REAL(kind_phys) GMFLX (IJSDIM, KMAX+1) !< mass flux (updraft+downdraft) + REAL(kind_phys) GMFX0 (IJSDIM, KMAX+1) !< mass flux (updraft only) INTEGER KB(IJSDIM) !< cloud base index - negative means no convection INTEGER KTMX REAL(kind_phys) CPRES !< pressure factor for cumulus friction @@ -2890,8 +3087,8 @@ SUBROUTINE CUMSBW & !! adiabat. descent REAL(kind_phys) GDU (IJSDIM, KMAX) REAL(kind_phys) GDV (IJSDIM, KMAX) REAL(kind_phys) DELPI (IJSDIM, KMAX) - REAL(kind_phys) GMFLX (IJSDIM, KMAX) !< mass flux (updraft+downdraft) - REAL(kind_phys) GMFX0 (IJSDIM, KMAX) !< mass flux (updraft only) + REAL(kind_phys) GMFLX (IJSDIM, KMAX+1) !< mass flux (updraft+downdraft) + REAL(kind_phys) GMFX0 (IJSDIM, KMAX+1) !< mass flux (updraft only) INTEGER KB(IJSDIM) !< cloud base index - negative means no convection INTEGER KTMX, ISTS, IENS REAL(kind_phys) CPRES !< pressure factor for cumulus friction @@ -2962,7 +3159,7 @@ SUBROUTINE CUMDWN & ! Freeze & Melt & Evaporation ! IMPLICIT NONE - INTEGER, INTENT(IN) :: IM, IJSDIM, KMAX, NTR, ntrq ! DD, for GFS, pass in + INTEGER, INTENT(IN) :: IM, IJSDIM, KMAX, NTR , ntrq, nctp !! DD, for GFS, pass in logical, intent(in) :: do_aw, do_awdd, flx_form ! ! [MODIFY] @@ -2970,13 +3167,13 @@ SUBROUTINE CUMDWN & ! Freeze & Melt & Evaporation REAL(kind_phys) GTQ (IJSDIM, KMAX, NTR) !< Moisture etc tendency REAL(kind_phys) GTU (IJSDIM, KMAX) !< u tendency REAL(kind_phys) GTV (IJSDIM, KMAX) !< v tendency - REAL(kind_phys) GMFLX (IJSDIM, KMAX) !< mass flux + REAL(kind_phys) GMFLX (IJSDIM, KMAX+1) !< mass flux ! ! [OUTPUT] - REAL(kind_phys) GPRCP (IJSDIM, KMAX) !< rainfall flux - REAL(kind_phys) GSNWP (IJSDIM, KMAX) !< snowfall flux + REAL(kind_phys) GPRCP (IJSDIM, KMAX+1) !< rainfall flux + REAL(kind_phys) GSNWP (IJSDIM, KMAX+1) !< snowfall flux REAL(kind_phys) GTEVP (IJSDIM, KMAX) !< evaporation+sublimation - REAL(kind_phys) GMDD (IJSDIM, KMAX) !< downdraft mass flux + REAL(kind_phys) GMDD (IJSDIM, KMAX+1) !< downdraft mass flux !AW microphysical tendencies REAL(kind_phys) gtmelt (IJSDIM, KMAX) !< t tendency ice-liq @@ -2988,8 +3185,6 @@ SUBROUTINE CUMDWN & ! Freeze & Melt & Evaporation REAL(kind_phys) dqldwn (IJSDIM, KMAX) !< ql tendency downdraft detrainment REAL(kind_phys) dqidwn (IJSDIM, KMAX) !< qi tendency downdraft detrainment REAL(kind_phys) dtrdwn (IJSDIM, KMAX, ntrq:ntr) !< tracer tendency downdraft detrainment -! AW downdraft area fraction (assumed zero for now) - REAL(kind_phys) sigmad (IJSDIM,KMAX) !< DDsigma cloud downdraft area fraction ! [INPUT] REAL(kind_phys) GPRCI (IJSDIM, KMAX) !< rainfall generation @@ -3011,6 +3206,8 @@ SUBROUTINE CUMDWN & ! Freeze & Melt & Evaporation REAL(kind_phys) DELPI (IJSDIM, KMAX) INTEGER KB (IJSDIM) INTEGER KTMX, ISTS, IENS + REAL(kind_phys) sigmad (IM,KMAX+1) !< DDsigma cloud downdraft area fraction + ! ! [INTERNAL WORK] ! Note: Some variables have 3-dimensions for the purpose of budget check. @@ -3031,27 +3228,33 @@ SUBROUTINE CUMDWN & ! Freeze & Melt & Evaporation ! profiles of downdraft variables for AW flux tendencies REAL(kind_phys) GCdseD(ISTS:IENS, KMAX) !< downdraft dse REAL(kind_phys) GCqvD (ISTS:IENS, KMAX) !< downdraft qv -! REAL(kind_phys) GCqlD (ISTS:IENS, KMAX) !< downdraft ql -! REAL(kind_phys) GCqiD (ISTS:IENS, KMAX) !< downdraft qi + REAL(kind_phys) GCqlD (ISTS:IENS, KMAX) !< downdraft ql + REAL(kind_phys) GCqiD (ISTS:IENS, KMAX) !< downdraft qi REAL(kind_phys) GCtrD (ISTS:IENS, ntrq:ntr) !< downdraft tracer REAL(kind_phys) GCUD (ISTS:IENS) !< downdraft u REAL(kind_phys) GCVD (ISTS:IENS) !< downdraft v REAL(kind_phys) FSNOW (ISTS:IENS) REAL(kind_phys) GMDDD (ISTS:IENS) - - REAL(kind_phys) GDTW, GCHX, GCTX, GCQSX, GTPRP, EVSU, GTEVE, LVIC, & - DQW, DTW, GDQW, DZ, GCSD, FDET, GDHI, GMDDX, & - GMDDMX, GCHDX, GCWDX, GCUDD, GCVDD, GTHCI, GTQVCI, & - wrk, wrk1, wrk2, wrk3, wrk4, tx1, & - WMX, HMX, DDWMX, DDHMX, dp_above, dp_below, fsigma, & - fmelt, fevp, wrkn, gctrdd(ntrq:ntr) - + INTEGER I, K + REAL(kind_phys) GDTW + REAL(kind_phys) GCHX, GCTX, GCQSX, GTPRP, EVSU, GTEVE, LVIC + REAL(kind_phys) DQW, DTW, GDQW, DZ, GCSD, FDET, GDHI + REAL(kind_phys) GMDDX, GMDDMX + REAL(kind_phys) GCHDX, GCWDX + REAL(kind_phys) GCUDD, GCVDD + REAL(kind_phys) GTHCI, GTQVCI, GTQLCI, GTQICI !M REAL(kind_phys) GTHCI, GTQVCI, GTQLCI, GTQICI, GTUCI, GTVCI + real(kind_phys) wrk, fmelt, fevp, gctrdd(ntrq:ntr) !DD#ifdef OPT_CUMBGT -! Water, energy, downdraft water and downdraft energy budgets -! REAL(kind_phys), dimension(ISTS:IENS) :: WBGT, HBGT, DDWBGT, DDHBGT - integer ij, i, k, kp1, n + REAL(kind_phys) WBGT ( ISTS:IENS ) !! water budget + REAL(kind_phys) HBGT ( ISTS:IENS ) !! energy budget + REAL(kind_phys) DDWBGT( ISTS:IENS ) !! downdraft water budget + REAL(kind_phys) DDHBGT( ISTS:IENS ) !! downdraft energy budget + REAL(kind_phys) WMX, HMX, DDWMX, DDHMX, tx1, wrk1, wrk2, wrk3, wrk4, wrkn + REAL(kind_phys) dp_above, dp_below + real(kind_phys) fsigma + integer ij, n, kp1 !DD#endif ! ! [INTERNAL PARM] @@ -3109,46 +3312,23 @@ SUBROUTINE CUMDWN & ! Freeze & Melt & Evaporation gtsubl(I,k) = zero enddo enddo -! testing on oct 17 2016 - if (flx_form) then - if (.not. do_awdd) then - do k=1,kmax - do i=ists,iens - if (kb(i) > 0) then - dtdwn (i,k) = gtt(i,k) - dqvdwn(i,k) = gtq(i,k,1) - dqldwn(i,k) = gtq(i,k,itl) - dqidwn(i,k) = gtq(i,k,iti) - endif - enddo - enddo - do n=ntrq,ntr - do k=1,kmax - do i=ists,iens - if (kb(i) > 0) then - dtrdwn(i,k,n) = gtq(i,k,n) - endif - enddo - enddo - enddo - else - do k=1,kmax - do i=ists,iens - dtdwn (I,k) = zero - dqvdwn(I,k) = zero - dqldwn(I,k) = zero - dqidwn(I,k) = zero - enddo - enddo - do n=ntrq,ntr - do k=1,kmax - do i=ists,iens - dtrdwn(i,k,n) = zero - enddo - enddo - enddo - endif - endif + +! These are zeroed by the calling routine, cs_cumlus +! do k=1,kmax +! do i=ists,iens +! dtdwn (I,k) = zero +! dqvdwn(I,k) = zero +! dqldwn(I,k) = zero +! dqidwn(I,k) = zero +! enddo +! enddo +! do n=ntrq,ntr +! do k=1,kmax +! do i=ists,iens +! dtrdwn(i,k,n) = zero +! enddo +! enddo +! enddo ! do i=ists,iens GCHD(I) = zero @@ -3178,20 +3358,19 @@ SUBROUTINE CUMDWN & ! Freeze & Melt & Evaporation LVIC = ELocp + EMELTocp*FSNOW(I) GDTW = GDT(I,K) - LVIC*(GDQS(I,K) - GDQ(I,K,1)) & / (one + LVIC*FDQS(I,K)) + + DZ = GDZM(I,KP1) - GDZM(I,K) + FMELT = (one + FTMLT*(GDTW - TWSNOW)) & + * (one - TANH(GMFLX(I,KP1)/GMFLXC)) & + * (one - TANH(VTERMS*MELTAU/DZ)) IF (GDTW < TWSNOW) THEN - GSNWP(I,K) = GSNWP(I,KP1) + GPRCI(I,K) + GSNWI(I,K) - GTTEV(I,K) = EMELToCP * GPRCI(I,K) * DELPI(I,K) - SNMLT(I,K) = -GPRCI(I,K) + SNMLT(I,K) = GPRCP(I,KP1)*min(max(FMELT, one), zero) ELSE - DZ = GDZM(I,KP1) - GDZM(I,K) - FMELT = (one + FTMLT*(GDTW - TWSNOW)) & - * (one - TANH(GMFLX(I,KP1)/GMFLXC)) & - * (one - TANH(VTERMS*MELTAU/DZ)) SNMLT(I,K) = GSNWP(I,KP1)*max(min(FMELT, one), zero) - GSNWP(I,K) = GSNWP(I,KP1)+GSNWI(I,K) - SNMLT(I,K) - GPRCP(I,K) = GPRCP(I,KP1)+GPRCI(I,K) + SNMLT(I,K) - GTTEV(I,K) = -EMELToCP * SNMLT(I,K) * DELPI(I,K) ENDIF + GSNWP(I,K) = GSNWP(I,KP1)+GSNWI(I,K) - SNMLT(I,K) + GPRCP(I,K) = GPRCP(I,KP1)+GPRCI(I,K) + SNMLT(I,K) + GTTEV(I,K) = -EMELToCP * SNMLT(I,K) * DELPI(I,K) !DD heating rate due to precip melting for AW gtmelt(i,k) = gtmelt(i,k) + GTTEV(I,K) endif @@ -3350,8 +3529,15 @@ SUBROUTINE CUMDWN & ! Freeze & Melt & Evaporation GTQ(I,K,1) = GTQ(I,K,1) + GTQEV(I,K) ! GMFLX(I,K) = GMFLX(I,K) - GMDD(I,K) + endif + ENDDO ! end of i loop + ENDDO ! end of k loop ! AW tendencies due to vertical divergence of eddy fluxes + DO K=2,KTMX + kp1 = min(k+1,kmax) + DO I=ISTS,IENS + if (kb(i) > 0) then if (k > 1 .and. flx_form) then fsigma = one - sigmad(i,kp1) dp_below = wrk * (one - sigmad(i,k)) @@ -3381,28 +3567,6 @@ SUBROUTINE CUMDWN & ! Freeze & Melt & Evaporation endif ENDDO ! end of i loop ENDDO ! end of k loop -! - if (.not. do_awdd .and. flx_form) then - do k=1,kmax - do i=ists,iens - if (kb(i) > 0) then - dtdwn(i,k) = gtt(i,k) - dtdwn(i,k) - dqvdwn(i,k) = gtq(i,k,1) - dqvdwn(i,k) - dqldwn(i,k) = gtq(i,k,itl) - dqldwn(i,k) - dqidwn(i,k) = gtq(i,k,iti) - dqidwn(i,k) - endif - enddo - enddo - do n=ntrq,ntr - do k=1,kmax - do i=ists,iens - if (kb(i) > 0) then - dtrdwn(i,k,n) = gtq(i,k,n) - dtrdwn(i,k,n) - endif - enddo - enddo - enddo - endif ! END SUBROUTINE CUMDWN !*********************************************************************** @@ -3428,22 +3592,28 @@ SUBROUTINE CUMCLD & !! cloudiness REAL(kind_phys) FLIQC (IJSDIM, KMAX) !< liquid ratio in cumulus ! ! [INPUT] - REAL(kind_phys) GMFLX (IJSDIM, KMAX) ! cumulus mass flux + REAL(kind_phys) GMFLX (IJSDIM, KMAX+1) ! cumulus mass flux INTEGER KTMX INTEGER ISTS, IENS ! ! [WORK] INTEGER I, K REAL(kind_phys) CUMF, QC, wrk + LOGICAL, SAVE :: OFIRST = .TRUE. ! ! [INTERNAL PARAM] - REAL(kind_phys), parameter :: CMFMIN = 2.e-3_kind_phys, &!< Mc->cloudiness - CMFMAX = 3.e-1_kind_phys, &!< Mc->cloudiness - CLMIN = 1.e-3_kind_phys, &!< cloudiness Min. - CLMAX = 0.1_kind_phys, &!< cloudiness Max. - FACLW = 0.1_kind_phys, &!< Mc->CLW - FACLF = (CLMAX-CLMIN)/LOG(CMFMAX/CMFMIN) -! + REAL(kind_phys) :: FACLW = 0.1_kind_phys !> Mc->CLW + REAL(kind_phys) :: CMFMIN = 2.e-3_kind_phys !> Mc->cloudiness + REAL(kind_phys) :: CMFMAX = 3.e-1_kind_phys !> Mc->cloudiness + REAL(kind_phys) :: CLMIN = 1.e-3_kind_phys !> cloudiness Min. + REAL(kind_phys) :: CLMAX = 0.1_kind_phys !> cloudiness Max. + REAL(kind_phys), SAVE :: FACLF +! + IF ( OFIRST ) THEN + FACLF = (CLMAX-CLMIN)/LOG(CMFMAX/CMFMIN) + OFIRST = .FALSE. + END IF + CUMFRC(ISTS:IENS) = zero DO K=1,KTMX DO I=ISTS,IENS @@ -3668,26 +3838,28 @@ END SUBROUTINE CUMDNR !*********************************************************************** !>\ingroup cs_scheme SUBROUTINE CUMSBR & !! Tracer Subsidence - ( IM , IJSDIM, KMAX , NTR , & !DD dimensions + ( IM , IJSDIM, KMAX, NTR, NCTP, & !DD dimensions GTR , & ! modified - GDR , DELPI , & ! input + GDR , DELP , & ! input GMFLX , KTMX , OTSPT , & ! input + sigmai , sigma , & !DDsigma input ISTS, IENS ) ! input ! IMPLICIT NONE - INTEGER, INTENT(IN) :: IM, IJSDIM, KMAX, NTR !! DD, for GFS, pass in + INTEGER, INTENT(IN) :: IM, IJSDIM, KMAX, NTR, nctp !! DD, for GFS, pass in ! ! [MODIFY] REAL(kind_phys) GTR (IJSDIM, KMAX, NTR) !! tracer tendency ! ! [INPUT] REAL(kind_phys) GDR (IJSDIM, KMAX, NTR) !! tracer - REAL(kind_phys) DELPI (IJSDIM, KMAX) - REAL(kind_phys) GMFLX (IJSDIM, KMAX) !! mass flux + REAL(kind_phys) DELP (IJSDIM, KMAX) + REAL(kind_phys) GMFLX (IJSDIM, KMAX+1) !! mass flux INTEGER KTMX LOGICAL OTSPT (NTR) !! tracer transport on/off INTEGER ISTS, IENS + REAL(kind_phys) sigmai (IM,KMAX+1,NCTP), sigma(IM,KMAX+1) !!DDsigma cloud updraft fraction ! ! [INTERNAL WORK] INTEGER I, K, KM, KP, LT @@ -3703,14 +3875,14 @@ SUBROUTINE CUMSBR & !! Tracer Subsidence KM = MAX(K-1, 1) KP = MIN(K+1, KMAX) DO I=ISTS,IENS - SBR0 = GMFLX(I,KP) * (GDR(I,KP,LT) - GDR(I,K,LT)) - SBR1 = GMFLX(I,K) * (GDR(I,K,LT) - GDR(I,KM,LT)) - IF (GMFLX(I,K) > GMFLX(I,KP)) THEN + SBR0 = GMFLX(I,K+1) * (GDR(I,KP,LT) - GDR(I,K,LT)) + SBR1 = GMFLX(I,K) * (GDR(I,K,LT) - GDR(I,KM,LT)) + IF (GMFLX(I,K) > GMFLX(I,K+1)) THEN FX1 = half ELSE FX1 = zero END IF - GTR(I,K,LT) = GTR(I,K,LT) + DELPI(I,K) & + GTR(I,K,LT) = GTR(I,K,LT) + GRAV/DELP(I,K) & * ((one-FX(I))*SBR0 + FX1*SBR1) FX(I) = FX1 ENDDO @@ -3733,7 +3905,7 @@ SUBROUTINE CUMFXR & ! Tracer mass fixe INTEGER, INTENT(IN) :: IM, IJSDIM, KMAX, NTR !! DD, for GFS, pass in ! ! [MODIFY] - REAL(kind_phys) GTR (IJSDIM, KMAX, NTR) ! tracer tendency + REAL(kind_phys) GTR (IJSDIM, KMAX) ! tracer tendency ! ! [INPUT] REAL(kind_phys) GDR (IJSDIM, KMAX, NTR) ! tracer @@ -3815,14 +3987,14 @@ END SUBROUTINE CUMFXR !********************************************************************* !>\ingroup cs_scheme SUBROUTINE CUMFXR1 & ! Tracer mass fixer - ( IM , IJSDIM, KMAX , & !DD dimensions + ( IM , IJSDIM, KMAX ,nctp, & !DD dimensions GTR , & ! modified GDR , DELP , DELTA , KTMX , IMFXR , & ! input ISTS , IENS ) ! input ! IMPLICIT NONE - INTEGER, INTENT(IN) :: IM, IJSDIM, KMAX ! DD, for GFS, pass in + INTEGER, INTENT(IN) :: IM, IJSDIM, KMAX, nctp !! DD, for GFS, pass in ! ! [MODIFY] REAL(kind_phys) GTR (IJSDIM, KMAX) ! tracer tendency From 633f8d1d5bc8f58b1e17a7196f9d0e698133aba4 Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Thu, 7 Mar 2024 13:57:28 -0500 Subject: [PATCH 38/42] fix array dimension issue --- physics/CONV/Chikira_Sugiyama/cs_conv.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/CONV/Chikira_Sugiyama/cs_conv.F90 b/physics/CONV/Chikira_Sugiyama/cs_conv.F90 index 94dadba87..4ca545bc4 100644 --- a/physics/CONV/Chikira_Sugiyama/cs_conv.F90 +++ b/physics/CONV/Chikira_Sugiyama/cs_conv.F90 @@ -3139,7 +3139,7 @@ END SUBROUTINE CUMSBW !>\ingroup cs_scheme !! This subroution calculates freeze, melt and evaporation in cumulus downdraft. SUBROUTINE CUMDWN & ! Freeze & Melt & Evaporation - ( IM , IJSDIM, KMAX , NTR , ntrq, & !DD dimensions + ( IM , IJSDIM, KMAX , NTR,ntrq,nctp, & !DD dimensions GTT , GTQ , GTU , GTV , & ! modified GMFLX , & ! modified GPRCP , GSNWP , GTEVP , GMDD , & ! output @@ -3905,7 +3905,7 @@ SUBROUTINE CUMFXR & ! Tracer mass fixe INTEGER, INTENT(IN) :: IM, IJSDIM, KMAX, NTR !! DD, for GFS, pass in ! ! [MODIFY] - REAL(kind_phys) GTR (IJSDIM, KMAX) ! tracer tendency + REAL(kind_phys) GTR (IJSDIM, KMAX, NTR) ! tracer tendency ! ! [INPUT] REAL(kind_phys) GDR (IJSDIM, KMAX, NTR) ! tracer From 12b5882e675c70c10468ce6b7ad935bdd51747b5 Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Thu, 7 Mar 2024 14:32:50 -0500 Subject: [PATCH 39/42] remove some unnecessary comment edits and whitespace changes --- physics/CONV/Chikira_Sugiyama/cs_conv.F90 | 193 +++++++++++----------- 1 file changed, 96 insertions(+), 97 deletions(-) diff --git a/physics/CONV/Chikira_Sugiyama/cs_conv.F90 b/physics/CONV/Chikira_Sugiyama/cs_conv.F90 index 4ca545bc4..ae59db7ba 100644 --- a/physics/CONV/Chikira_Sugiyama/cs_conv.F90 +++ b/physics/CONV/Chikira_Sugiyama/cs_conv.F90 @@ -663,96 +663,96 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions ! ! [INTERNAL WORK] REAL(kind_phys), allocatable :: GPRCC (:, :) ! rainfall - REAL(kind_phys) GSNWC ( IJSDIM ) !! snowfall - REAL(kind_phys) CUMCLW( IJSDIM, KMAX ) !! cloud water in cumulus - REAL(kind_phys) CUMFRC( IJSDIM ) !! cumulus cloud fraction + REAL(kind_phys) GSNWC ( IJSDIM ) ! snowfall + REAL(kind_phys) CUMCLW( IJSDIM, KMAX ) ! cloud water in cumulus + REAL(kind_phys) CUMFRC( IJSDIM ) ! cumulus cloud fraction !COSP - REAL(kind_phys) QLIQC ( IJSDIM, KMAX ) !! cumulus cloud liquid water [kg/kg] - REAL(kind_phys) QICEC ( IJSDIM, KMAX ) !! cumulus cloud ice [kg/kg] - REAL(kind_phys) GPRCPF( IJSDIM, KMAX ) !! rainfall flux at full level - REAL(kind_phys) GSNWPF( IJSDIM, KMAX ) !! snowfall flux at full level + REAL(kind_phys) QLIQC ( IJSDIM, KMAX ) ! cumulus cloud liquid water [kg/kg] + REAL(kind_phys) QICEC ( IJSDIM, KMAX ) ! cumulus cloud ice [kg/kg] + REAL(kind_phys) GPRCPF( IJSDIM, KMAX ) ! rainfall flux at full level + REAL(kind_phys) GSNWPF( IJSDIM, KMAX ) ! snowfall flux at full level ! - REAL(kind_phys) GTCFRC( IJSDIM, KMAX ) !! change in cloud fraction - REAL(kind_phys) FLIQC ( IJSDIM, KMAX ) !! liquid ratio in cumulus + REAL(kind_phys) GTCFRC( IJSDIM, KMAX ) ! change in cloud fraction + REAL(kind_phys) FLIQC ( IJSDIM, KMAX ) ! liquid ratio in cumulus ! !#ifdef OPT_CHASER -! REAL(kind_phys) RFXC ( IJSDIM, KMAX+1 ) !! precipi. flx [kg/m2/s] -! REAL(kind_phys) SFXC ( IJSDIM, KMAX+1 ) !! ice/snow flx [kg/m2/s] -! INTEGER LEVCUM( IJSDIM, KMAX ) !! flag for cum. cloud top -! REAL(kind_phys) LNFRC ( IJSDIM, KMAX ) !! areal rates of clouds -! REAL(kind_phys) REVC ( IJSDIM, KMAX ) !! evaporation rates +! REAL(kind_phys) RFXC ( IJSDIM, KMAX+1 ) ! precipi. flx [kg/m2/s] +! REAL(kind_phys) SFXC ( IJSDIM, KMAX+1 ) ! ice/snow flx [kg/m2/s] +! INTEGER LEVCUM( IJSDIM, KMAX ) ! flag for cum. cloud top +! REAL(kind_phys) LNFRC ( IJSDIM, KMAX ) ! areal rates of clouds +! REAL(kind_phys) REVC ( IJSDIM, KMAX ) ! evaporation rates !#endif ! - REAL(kind_phys) GDCFRC( IJSDIM, KMAX ) !! cloud fraction + REAL(kind_phys) GDCFRC( IJSDIM, KMAX ) ! cloud fraction ! -! REAL(kind_phys) GTQL ( IJSDIM, KMAX ) !! tendency of cloud liquid +! REAL(kind_phys) GTQL ( IJSDIM, KMAX ) ! tendency of cloud liquid ! - REAL(kind_phys) GDW ( IJSDIM, KMAX ) !! total water - REAL(kind_phys) GDQS ( IJSDIM, KMAX ) !! saturate moisture + REAL(kind_phys) GDW ( IJSDIM, KMAX ) ! total water + REAL(kind_phys) GDQS ( IJSDIM, KMAX ) ! saturate moisture REAL(kind_phys) FDQS ( IJSDIM, KMAX ) REAL(kind_phys) GAM ( IJSDIM, KMAX ) - REAL(kind_phys) GDS ( IJSDIM, KMAX ) !! dry static energy - REAL(kind_phys) GDH ( IJSDIM, KMAX ) !! moist static energy - REAL(kind_phys) GDHS ( IJSDIM, KMAX ) !! saturate MSE -! - REAL(kind_phys) GCYM ( IJSDIM, KMAX, NCTP ) !! norm. mass flux (half lev) - REAL(kind_phys) GCHB ( IJSDIM ) !! cloud base MSE-Li*Qi - REAL(kind_phys) GCWB ( IJSDIM ) !! cloud base total water - REAL(kind_phys) GCtrB ( IJSDIM, ntrq:ntr ) !! cloud base water vapor tracer - REAL(kind_phys) GCUB ( IJSDIM ) !! cloud base U - REAL(kind_phys) GCVB ( IJSDIM ) !! cloud base V - REAL(kind_phys) GCIB ( IJSDIM ) !! cloud base ice - REAL(kind_phys) ELAM ( IJSDIM, KMAX, NCTP ) !! entrainment (rate*massflux) - REAL(kind_phys) GCYT ( IJSDIM, NCTP ) !! norm. mass flux @top - REAL(kind_phys) GCHT ( IJSDIM, NCTP ) !! cloud top MSE - REAL(kind_phys) GCQT ( IJSDIM, NCTP ) !! cloud top q - REAL(kind_phys) GCwT ( IJSDIM ) !! cloud top total water - REAL(kind_phys) GCUT ( IJSDIM, NCTP ) !! cloud top U - REAL(kind_phys) GCVT ( IJSDIM, NCTP ) !! cloud top V - REAL(kind_phys) GCLT ( IJSDIM, NCTP ) !! cloud top cloud water - REAL(kind_phys) GCIT ( IJSDIM, NCTP ) !! cloud top cloud ice + REAL(kind_phys) GDS ( IJSDIM, KMAX ) ! dry static energy + REAL(kind_phys) GDH ( IJSDIM, KMAX ) ! moist static energy + REAL(kind_phys) GDHS ( IJSDIM, KMAX ) ! saturate MSE +! + REAL(kind_phys) GCYM ( IJSDIM, KMAX, NCTP ) ! norm. mass flux (half lev) + REAL(kind_phys) GCHB ( IJSDIM ) ! cloud base MSE-Li*Qi + REAL(kind_phys) GCWB ( IJSDIM ) ! cloud base total water + REAL(kind_phys) GCtrB ( IJSDIM, ntrq:ntr ) ! cloud base water vapor tracer + REAL(kind_phys) GCUB ( IJSDIM ) ! cloud base U + REAL(kind_phys) GCVB ( IJSDIM ) ! cloud base V + REAL(kind_phys) GCIB ( IJSDIM ) ! cloud base ice + REAL(kind_phys) ELAM ( IJSDIM, KMAX, NCTP ) ! entrainment (rate*massflux) + REAL(kind_phys) GCYT ( IJSDIM, NCTP ) ! norm. mass flux @top + REAL(kind_phys) GCHT ( IJSDIM, NCTP ) ! cloud top MSE + REAL(kind_phys) GCQT ( IJSDIM, NCTP ) ! cloud top q + REAL(kind_phys) GCwT ( IJSDIM ) ! cloud top total water + REAL(kind_phys) GCUT ( IJSDIM, NCTP ) ! cloud top U + REAL(kind_phys) GCVT ( IJSDIM, NCTP ) ! cloud top V + REAL(kind_phys) GCLT ( IJSDIM, NCTP ) ! cloud top cloud water + REAL(kind_phys) GCIT ( IJSDIM, NCTP ) ! cloud top cloud ice REAL(kind_phys) GCtrT (IJSDIM, ntrq:ntr, NCTP) ! cloud top tracer - REAL(kind_phys) GTPRT ( IJSDIM, NCTP ) !! precipitation/M - REAL(kind_phys) GCLZ ( IJSDIM, KMAX ) !! cloud liquid for each CTP - REAL(kind_phys) GCIZ ( IJSDIM, KMAX ) !! cloud ice for each CTP + REAL(kind_phys) GTPRT ( IJSDIM, NCTP ) ! precipitation/M + REAL(kind_phys) GCLZ ( IJSDIM, KMAX ) ! cloud liquid for each CTP + REAL(kind_phys) GCIZ ( IJSDIM, KMAX ) ! cloud ice for each CTP - REAL(kind_phys) ACWF ( IJSDIM ) !! cloud work function - REAL(kind_phys) GPRCIZ( IJSDIM, KMAX+1, NCTP ) !! precipitation - REAL(kind_phys) GSNWIZ( IJSDIM, KMAX+1, NCTP ) !! snowfall - REAL(kind_phys) GTPRC0( IJSDIM ) !! precip. before evap. + REAL(kind_phys) ACWF ( IJSDIM ) ! cloud work function + REAL(kind_phys) GPRCIZ( IJSDIM, KMAX+1, NCTP ) ! precipitation + REAL(kind_phys) GSNWIZ( IJSDIM, KMAX+1, NCTP ) ! snowfall + REAL(kind_phys) GTPRC0( IJSDIM ) ! precip. before evap. - REAL(kind_phys) GMFLX ( IJSDIM, KMAX+1 ) !! mass flux (updraft+downdraft) - REAL(kind_phys) QLIQ ( IJSDIM, KMAX ) !! total cloud liquid - REAL(kind_phys) QICE ( IJSDIM, KMAX ) !! total cloud ice - REAL(kind_phys) GPRCI ( IJSDIM, KMAX ) !! rainfall generation - REAL(kind_phys) GSNWI ( IJSDIM, KMAX ) !! snowfall generation + REAL(kind_phys) GMFLX ( IJSDIM, KMAX+1 ) ! mass flux (updraft+downdraft) + REAL(kind_phys) QLIQ ( IJSDIM, KMAX ) ! total cloud liquid + REAL(kind_phys) QICE ( IJSDIM, KMAX ) ! total cloud ice + REAL(kind_phys) GPRCI ( IJSDIM, KMAX ) ! rainfall generation + REAL(kind_phys) GSNWI ( IJSDIM, KMAX ) ! snowfall generation - REAL(kind_phys) GPRCP ( IJSDIM, KMAX+1 ) !! rainfall flux + REAL(kind_phys) GPRCP ( IJSDIM, KMAX+1 ) ! rainfall flux ! - REAL(kind_phys) GTEVP ( IJSDIM, KMAX ) !! evaporation+sublimation - REAL(kind_phys) GMDD ( IJSDIM, KMAX+1 ) !! downdraft mass flux + REAL(kind_phys) GTEVP ( IJSDIM, KMAX ) ! evaporation+sublimation + REAL(kind_phys) GMDD ( IJSDIM, KMAX+1 ) ! downdraft mass flux - REAL(kind_phys) CUMHGT( IJSDIM, NCTP ) !! cloud top height - REAL(kind_phys) CTOPP ( IJSDIM ) !! cloud top pressure + REAL(kind_phys) CUMHGT( IJSDIM, NCTP ) ! cloud top height + REAL(kind_phys) CTOPP ( IJSDIM ) ! cloud top pressure - REAL(kind_phys) GDZTR ( IJSDIM ) !! tropopause height - REAL(kind_phys) FLIQOU( IJSDIM, KMAX ) !! liquid ratio in cumulus + REAL(kind_phys) GDZTR ( IJSDIM ) ! tropopause height + REAL(kind_phys) FLIQOU( IJSDIM, KMAX ) ! liquid ratio in cumulus !#ifdef OPT_CHASER ! REAL(kind_phys) TOPFLX( IJSDIM, NCTP ) !! flux at each cloud top !#endif INTEGER KB ( IJSDIM ) - INTEGER KSTRT ( IJSDIM ) !! tropopause level + INTEGER KSTRT ( IJSDIM ) ! tropopause level REAL(kind_phys) GAMX REAL(kind_phys) CIN ( IJSDIM ) INTEGER JBUOY ( IJSDIM ) REAL(kind_phys) DELZ, BUOY, DELWC, DELER -!M REAL(kind_phys) WCB ( NCTP ) !! updraft velocity**2 @base +!M REAL(kind_phys) WCB ( NCTP ) ! updraft velocity**2 @base !M SAVE WCB REAL(kind_phys) WCBX (IJSDIM) -! REAL(kind_phys) ERMR ( NCTP ) !! entrainment rate (ASMODE) +! REAL(kind_phys) ERMR ( NCTP ) ! entrainment rate (ASMODE) ! SAVE ERMR - INTEGER KTMX ( NCTP ) !! max of cloud top - INTEGER KTMXT !! max of cloud top + INTEGER KTMX ( NCTP ) ! max of cloud top + INTEGER KTMXT ! max of cloud top REAL(kind_phys) TIMED REAL(kind_phys) GDCLDX, GDMU2X, GDMU3X ! @@ -760,26 +760,26 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions INTEGER KBMX, I, K, CTP, ierr, n, kp1, l, l1, kk, kbi, kmi, km1 real(kind_phys) tem1, tem2, tem3, cbmfl, mflx_e, teme, tems - REAL(kind_phys) HBGT ( IJSDIM ) !! imbalance in column heat - REAL(kind_phys) WBGT ( IJSDIM ) !! imbalance in column water + REAL(kind_phys) HBGT ( IJSDIM ) ! imbalance in column heat + REAL(kind_phys) WBGT ( IJSDIM ) ! imbalance in column water !DDsigma begin local work variables - all on model interfaces (sfc=1) - REAL(kind_phys) lamdai( IJSDIM, KMAX+1, nctp ) !! lamda for cloud type ctp - REAL(kind_phys) lamdaprod( IJSDIM, KMAX+1 ) !! product of (1+lamda) through cloud type ctp - REAL(kind_phys) gdrhom !! density - REAL(kind_phys) gdtvm !! virtual temperature - REAL(kind_phys) gdqm, gdwm,gdlm, gdim !! water vaper + REAL(kind_phys) lamdai( IJSDIM, KMAX+1, nctp ) ! lamda for cloud type ctp + REAL(kind_phys) lamdaprod( IJSDIM, KMAX+1 ) ! product of (1+lamda) through cloud type ctp + REAL(kind_phys) gdrhom ! density + REAL(kind_phys) gdtvm ! virtual temperature + REAL(kind_phys) gdqm, gdwm,gdlm, gdim ! water vaper REAL(kind_phys) gdtrm(ntrq:ntr) ! tracer character(len=4) :: cproc !DDsigmadiag ! the following are new arguments to cumup to get them out - REAL(kind_phys) wcv( IJSDIM, KMAX+1, nctp) !! in-cloud vertical velocity - REAL(kind_phys) GCTM ( IJSDIM, KMAX+1 ) !! cloud T (half lev) !DDsigmadiag make output - REAL(kind_phys) GCQM ( IJSDIM, KMAX+1, nctp ) !! cloud q (half lev) !DDsigmadiag make output - REAL(kind_phys) GCwM ( IJSDIM, KMAX+1, nctp ) !! cloud q (half lev) !DDsigmadiag make output - REAL(kind_phys) GCiM ( IJSDIM, KMAX+1 ) !! cloud q (half lev) !DDsigmadiag make output - REAL(kind_phys) GClM ( IJSDIM, KMAX+1 ) !! cloud q (half lev) !DDsigmadiag make output - REAL(kind_phys) GChM ( IJSDIM, KMAX+1, nctp ) !! cloud q (half lev) !DDsigmadiag make output + REAL(kind_phys) wcv( IJSDIM, KMAX+1, nctp) ! in-cloud vertical velocity + REAL(kind_phys) GCTM ( IJSDIM, KMAX+1 ) ! cloud T (half lev) !DDsigmadiag make output + REAL(kind_phys) GCQM ( IJSDIM, KMAX+1, nctp ) ! cloud q (half lev) !DDsigmadiag make output + REAL(kind_phys) GCwM ( IJSDIM, KMAX+1, nctp ) ! cloud q (half lev) !DDsigmadiag make output + REAL(kind_phys) GCiM ( IJSDIM, KMAX+1 ) ! cloud q (half lev) !DDsigmadiag make output + REAL(kind_phys) GClM ( IJSDIM, KMAX+1 ) ! cloud q (half lev) !DDsigmadiag make output + REAL(kind_phys) GChM ( IJSDIM, KMAX+1, nctp ) ! cloud q (half lev) !DDsigmadiag make output REAL(kind_phys) GCtrM (IJSDIM, KMAX, ntrq:ntr) ! cloud tracer (half lev) !DDsigmadiag make output ! these are the fluxes at the interfaces - AW will operate on them @@ -800,30 +800,30 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions !DDsigma end local work variables ! ! [INTERNAL PARM] - REAL(kind_phys) :: WCBMIN = 0._kind_phys !! min. of updraft velocity at cloud base -!M REAL(kind_phys) :: WCBMAX = 1.4_kind_phys !! max. of updraft velocity at cloud base + REAL(kind_phys) :: WCBMIN = 0._kind_phys ! min. of updraft velocity at cloud base +!M REAL(kind_phys) :: WCBMAX = 1.4_kind_phys ! max. of updraft velocity at cloud base !M wcbas commented by Moorthi since it is not used -!M REAL(kind_phys) :: WCBAS = 2._kind_phys !! updraft velocity**2 at cloud base (ASMODE) -!M REAL(kind_phys) :: ERAMIN = 1.e-5_kind_phys !! min. of entrainment rate - !! used only in OPT_ASMODE -!M REAL(kind_phys) :: ERAMAX = 2.e-3_kind_phys !! max. of entrainment rate - !! used only in OPT_ASMODE +!M REAL(kind_phys) :: WCBAS = 2._kind_phys ! updraft velocity**2 at cloud base (ASMODE) +!M REAL(kind_phys) :: ERAMIN = 1.e-5_kind_phys ! min. of entrainment rate + ! used only in OPT_ASMODE +!M REAL(kind_phys) :: ERAMAX = 2.e-3_kind_phys ! max. of entrainment rate + ! used only in OPT_ASMODE ! downdraft mass flux terms now slot nctp+1 in the *fluxterm arrays - REAL(kind_phys) dtdwn ( IJSDIM, KMAX ) !! t tendency downdraft detrainment - REAL(kind_phys) dqvdwn ( IJSDIM, KMAX ) !! qv tendency downdraft detrainment - REAL(kind_phys) dqldwn ( IJSDIM, KMAX ) !! ql tendency downdraft detrainment - REAL(kind_phys) dqidwn ( IJSDIM, KMAX ) !! qi tendency downdraft detrainment + REAL(kind_phys) dtdwn ( IJSDIM, KMAX ) ! t tendency downdraft detrainment + REAL(kind_phys) dqvdwn ( IJSDIM, KMAX ) ! qv tendency downdraft detrainment + REAL(kind_phys) dqldwn ( IJSDIM, KMAX ) ! ql tendency downdraft detrainment + REAL(kind_phys) dqidwn ( IJSDIM, KMAX ) ! qi tendency downdraft detrainment REAL(kind_phys), dimension(ijsdim,kmax,ntrq:ntr) :: dtrdwn ! tracer tendency downdraft detrainment - LOGICAL :: OINICB = .false. !! set 0.d0 to CBMFX + LOGICAL :: OINICB = .false. ! set 0.d0 to CBMFX - REAL(kind_phys) :: VARMIN = 1.e-13_kind_phys !! minimum of PDF variance - REAL(kind_phys) :: VARMAX = 5.e-7_kind_phys !! maximum of PDF variance - REAL(kind_phys) :: SKWMAX = 0.566_kind_phys !! maximum of PDF skewness + REAL(kind_phys) :: VARMIN = 1.e-13_kind_phys ! minimum of PDF variance + REAL(kind_phys) :: VARMAX = 5.e-7_kind_phys ! maximum of PDF variance + REAL(kind_phys) :: SKWMAX = 0.566_kind_phys ! maximum of PDF skewness - REAL(kind_phys) :: PSTRMX = 400.e2_kind_phys !! max P of tropopause - REAL(kind_phys) :: PSTRMN = 50.e2_kind_phys !! min P of tropopause - REAL(kind_phys) :: GCRSTR = 1.e-4_kind_phys !! crit. dT/dz tropopause + REAL(kind_phys) :: PSTRMX = 400.e2_kind_phys ! max P of tropopause + REAL(kind_phys) :: PSTRMN = 50.e2_kind_phys ! min P of tropopause + REAL(kind_phys) :: GCRSTR = 1.e-4_kind_phys ! crit. dT/dz tropopause ! 0: mass fixer is not applied ! tracers which may become negative values @@ -835,10 +835,9 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions real(kind=kind_phys), parameter :: zero=0.0, one=1.0 real(kind=kind_phys) :: tem, esat ! - LOGICAL, SAVE :: OFIRST = .TRUE. !! called first time? + LOGICAL, SAVE :: OFIRST = .TRUE. ! called first time? ! - IF ( OFIRST ) THEN - + IF (OFIRST) THEN OFIRST = .FALSE. IF (OINICB) THEN CBMFX = zero From a0801b69045ad6f6bf656dc451fcb6d85ccee298 Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Fri, 8 Mar 2024 15:20:43 +0000 Subject: [PATCH 40/42] uncomment calculation of cf_upi in order to allow calculation of w_upi --- physics/CONV/Chikira_Sugiyama/cs_conv.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/CONV/Chikira_Sugiyama/cs_conv.F90 b/physics/CONV/Chikira_Sugiyama/cs_conv.F90 index ae59db7ba..4e7030dd5 100644 --- a/physics/CONV/Chikira_Sugiyama/cs_conv.F90 +++ b/physics/CONV/Chikira_Sugiyama/cs_conv.F90 @@ -466,7 +466,7 @@ subroutine cs_conv_run( IJSDIM , KMAX , ntracp1 , NN, & ! CNV_PRC3(i,k) = 0.0 CNV_NDROP(i,k) = 0.0 CNV_NICE(i,k) = 0.0 -! cf_upi(i,k) = max(0.0,min(0.01*log(1.0+500*ud_mf(i,k)),0.1)) + cf_upi(i,k) = max(0.0,min(0.01*log(1.0+500*ud_mf(i,k)),0.1)) ! CLCN(i,k) = cf_upi(i,k) !downdraft is below updraft !! clcn(i,k) = max(0.0,min(0.01*log(1.0+500*ud_mf(i,k)/delta),0.25)) @@ -500,7 +500,7 @@ subroutine cs_conv_run( IJSDIM , KMAX , ntracp1 , NN, & ! CNV_PRC3(i,k) = 0.0 CNV_NDROP(i,k) = 0.0 CNV_NICE(i,k) = 0.0 -! cf_upi(i,k) = max(0.0,min(0.01*log(1.0+500*ud_mf(i,k)),0.1)) + cf_upi(i,k) = max(0.0,min(0.01*log(1.0+500*ud_mf(i,k)),0.1)) ! & 500*ud_mf(i,k)),0.60)) ! CLCN(i,k) = cf_upi(i,k) !downdraft is below updraft From c77b9e8f4772450b5c7ec89575ccb53aa5bcaa22 Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Wed, 13 Mar 2024 10:11:08 -0400 Subject: [PATCH 41/42] fix metadata error in cs_conv.meta --- physics/CONV/Chikira_Sugiyama/cs_conv.meta | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/CONV/Chikira_Sugiyama/cs_conv.meta b/physics/CONV/Chikira_Sugiyama/cs_conv.meta index 49e460ed6..d75ab1006 100644 --- a/physics/CONV/Chikira_Sugiyama/cs_conv.meta +++ b/physics/CONV/Chikira_Sugiyama/cs_conv.meta @@ -258,7 +258,7 @@ standard_name = convective_updraft_area_fraction_at_model_interfaces long_name = convective updraft area fraction at model interfaces units = frac - dimensions = (horizontal_loop_extent,vertical_layer_dimension) + dimensions = (horizontal_loop_extent,vertical_interface_dimension) type = real kind = kind_phys intent = out From bbdec2ffceeb0cda70aaaa4f44e619a5468e7be3 Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Wed, 13 Mar 2024 10:50:38 -0400 Subject: [PATCH 42/42] fix convective_updraft_area_fraction_at_model_interfaces metadata --- physics/CONV/Chikira_Sugiyama/cs_conv_post.meta | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/CONV/Chikira_Sugiyama/cs_conv_post.meta b/physics/CONV/Chikira_Sugiyama/cs_conv_post.meta index 75de3fca7..5877c051b 100644 --- a/physics/CONV/Chikira_Sugiyama/cs_conv_post.meta +++ b/physics/CONV/Chikira_Sugiyama/cs_conv_post.meta @@ -33,7 +33,7 @@ standard_name = convective_updraft_area_fraction_at_model_interfaces long_name = convective updraft area fraction at model interfaces units = frac - dimensions = (horizontal_loop_extent,vertical_layer_dimension) + dimensions = (horizontal_loop_extent,vertical_interface_dimension) type = real kind = kind_phys intent = in