From 7644b0c46f17c97a865b5e4231a29970d6bbd8ae Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Tue, 16 Aug 2022 15:15:26 -0400 Subject: [PATCH 1/7] miscellaneous NRL-found checks on variables for stability and argument intent --- physics/cu_gf_deep.F90 | 8 ++++---- physics/h2ophys.f | 2 +- physics/radiation_astronomy.f | 4 +++- physics/sflx.f | 14 +++++--------- physics/ugwp_driver_v0.F | 2 +- 5 files changed, 14 insertions(+), 16 deletions(-) diff --git a/physics/cu_gf_deep.F90 b/physics/cu_gf_deep.F90 index 7d4b1ce02..e1976d55c 100644 --- a/physics/cu_gf_deep.F90 +++ b/physics/cu_gf_deep.F90 @@ -2908,12 +2908,12 @@ subroutine cup_env(z,qes,he,hes,t,q,p,z1, & !$acc declare copyin(p,t,q) real(kind=kind_phys), dimension (its:ite,kts:kte) & ,intent (out ) :: & - he,hes,qes -!$acc declare copyout(he,hes,qes) + hes,qes +!$acc declare copyout(hes,qes) real(kind=kind_phys), dimension (its:ite,kts:kte) & ,intent (inout) :: & - z -!$acc declare copy(z) + he,z +!$acc declare copy(he,z) real(kind=kind_phys), dimension (its:ite) & ,intent (in ) :: & psur,z1 diff --git a/physics/h2ophys.f b/physics/h2ophys.f index 47bc200c9..f46868e58 100644 --- a/physics/h2ophys.f +++ b/physics/h2ophys.f @@ -122,7 +122,7 @@ subroutine h2ophys_run(im, levs, kh2o, dt, h2o, ph2o, prsl, & enddo endif do i=1,im - if (prsl(i,l) < prsmax) then + if (prsl(i,l) < prsmax .and. pltc(i,2) /= 0.0) then h2oib(i) = h2o(i,l) ! no filling tem = 1.0 / pltc(i,2) ! 1/teff h2o(i,l) = (h2oib(i) + (pltc(i,1)+pltc(i,3)*tem)*dt) diff --git a/physics/radiation_astronomy.f b/physics/radiation_astronomy.f index f5a683bf3..1d60c74ef 100644 --- a/physics/radiation_astronomy.f +++ b/physics/radiation_astronomy.f @@ -887,7 +887,9 @@ subroutine coszmn & do i = 1, IM coszdg(i) = coszen(i) * rstp - if (istsun(i) > 0) coszen(i) = coszen(i) / istsun(i) + if (istsun(i) > 0 .and. coszen(i) /= 0.0_kind_phys) then + coszen(i) = coszen(i) / istsun(i) + endif enddo ! return diff --git a/physics/sflx.f b/physics/sflx.f index c2fe18a0c..a020e217a 100644 --- a/physics/sflx.f +++ b/physics/sflx.f @@ -906,15 +906,11 @@ subroutine gfssflx &! --- input eta = etp endif -#ifdef SINGLE_PREC - IF (ETP == 0.0) THEN - BETA = 0.0 - ELSE - BETA = ETA/ETP - ENDIF -#else - beta = eta / etp -#endif + if (etp == 0.0) then + beta = 0.0 + else + beta = eta/etp + endif !> - Convert the sign of soil heat flux so that: !! - ssoil>0: warm the surface (night time) diff --git a/physics/ugwp_driver_v0.F b/physics/ugwp_driver_v0.F index 6d5d5c2e2..0f4ad447e 100644 --- a/physics/ugwp_driver_v0.F +++ b/physics/ugwp_driver_v0.F @@ -1343,7 +1343,7 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, else kzw2 = zero endif - if ( kzw2 > zero ) then + if ( kzw2 > zero .and. cdf2 > zero) then v_kzw = sqrt(kzw2) ! !linsatdis: kzw2, kzw3, kdsat, c2f2, cdf2, cdf1 From 41429d1bdc60e0f07ac3c55d441aec6d42f90163 Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Tue, 16 Aug 2022 16:08:49 -0400 Subject: [PATCH 2/7] change some LUNs in iounitdef.f to avoid Cray CCE compiler error --- physics/iounitdef.f | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/physics/iounitdef.f b/physics/iounitdef.f index 61c711bb1..c6a4e591f 100644 --- a/physics/iounitdef.f +++ b/physics/iounitdef.f @@ -57,7 +57,7 @@ module module_iounitdef ! integer, parameter :: NISIGI2 = 12 integer, parameter :: NISFCI = 14 integer, parameter :: NICO2TR = 15 - integer, parameter :: NICO2CN = 102 + integer, parameter :: NICO2CN = 112 ! CCE (Cray) forbids 100-102 20211112 JM integer, parameter :: NIMTNVR = 24 integer, parameter :: NIDTBTH = 27 integer, parameter :: NIO3PRD = 28 @@ -66,9 +66,9 @@ module module_iounitdef ! integer, parameter :: NICLTUN = 43 integer, parameter :: NIO3CLM = 48 integer, parameter :: NIMICPH = 1 - integer, parameter :: NISFCYC = 101 - integer, parameter :: NIAERCM = 102 - integer, parameter :: NIRADSF = 102 + integer, parameter :: NISFCYC = 111 ! CCE (Cray) forbids 100-102 20210701 JM + integer, parameter :: NIAERCM = 112 ! CCE (Cray) forbids 100-102 20210701 JM + integer, parameter :: NIRADSF = 112 ! CCE (Cray) forbids 100-102 20210701 JM ! --- ... output units From 4daab35cc5a3a4160ac90e481e3b23df5a1ba617 Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Thu, 18 Aug 2022 14:34:35 -0400 Subject: [PATCH 3/7] remove ltp, lextop from radcons and send through argument lists as necessary; include NRL's lextop bugfix --- physics/GFS_rrtmg_post.meta | 2 +- physics/GFS_rrtmg_pre.F90 | 22 +++++++++++++--------- physics/GFS_rrtmg_pre.meta | 14 ++++++++++++++ physics/GFS_rrtmg_setup.F90 | 15 +++++++++------ physics/GFS_rrtmg_setup.meta | 14 ++++++++++++++ physics/radcons.f90 | 10 ---------- physics/rrtmg_lw_post.meta | 2 +- physics/rrtmg_sw_post.meta | 2 +- 8 files changed, 53 insertions(+), 28 deletions(-) diff --git a/physics/GFS_rrtmg_post.meta b/physics/GFS_rrtmg_post.meta index 0f45a2126..5fa6328a7 100644 --- a/physics/GFS_rrtmg_post.meta +++ b/physics/GFS_rrtmg_post.meta @@ -38,7 +38,7 @@ [ltp] standard_name = extra_top_layer long_name = extra top layers - units = none + units = count dimensions = () type = integer intent = in diff --git a/physics/GFS_rrtmg_pre.F90 b/physics/GFS_rrtmg_pre.F90 index f27a5cfea..835725eee 100644 --- a/physics/GFS_rrtmg_pre.F90 +++ b/physics/GFS_rrtmg_pre.F90 @@ -17,9 +17,9 @@ module GFS_rrtmg_pre !! \htmlinclude GFS_rrtmg_pre_run.html !! !>\section rrtmg_pre_gen General Algorithm - subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & - imfdeepcnv, imfdeepcnv_gf, me, ncnd, ntrac, num_p3d, npdf3d, ncnvcld3d,& - ntqv, ntcw,ntiw, ntlnc, ntinc, ntrnc, ntsnc, ntccn, & + subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, lextop, ltp, & + n_var_lndp, imfdeepcnv, imfdeepcnv_gf, me, ncnd, ntrac, num_p3d, & + npdf3d, ncnvcld3d, ntqv, ntcw,ntiw, ntlnc, ntinc, ntrnc, ntsnc, ntccn, & ntrw, ntsw, ntgl, nthl, ntwa, ntoz, & ntclamt, nleffr, nieffr, nseffr, lndp_type, kdt, & ntdu1, ntdu2, ntdu3, ntdu4, ntdu5, ntss1, ntss2, & @@ -50,7 +50,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & use physparam - use radcons, only: itsfc,ltp, lextop, qmin, & + use radcons, only: itsfc, qmin, & qme5, qme6, epsq, prsmin use funcphys, only: fpvs @@ -84,8 +84,8 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & use physparam, only : iaermdl implicit none - integer, intent(in) :: im, levs, lm, lmk, lmp, n_var_lndp, & - imfdeepcnv, & + integer, intent(in) :: im, levs, lm, lmk, lmp, ltp, & + n_var_lndp, imfdeepcnv, & imfdeepcnv_gf, me, ncnd, ntrac, & num_p3d, npdf3d, ncnvcld3d, ntqv, & ntcw, ntiw, ntlnc, ntinc, & @@ -120,8 +120,8 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & character(len=3), dimension(:), intent(in) :: lndp_var_list - logical, intent(in) :: lsswr, lslwr, ltaerosol, lgfdlmprad, & - uni_cld, effr_in, do_mynnedmf, & + logical, intent(in) :: lextop, lsswr, lslwr, ltaerosol, lgfdlmprad, & + uni_cld, effr_in, do_mynnedmf, & lmfshal, lmfdeep2, pert_clds logical, intent(in) :: aero_dir_fdb real(kind=kind_phys), dimension(:,:), intent(in) :: smoke_ext, dust_ext @@ -346,7 +346,9 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & plyr(i,k1) = prsl(i,k2) * 0.01 ! pa to mb (hpa) tlyr(i,k1) = tgrs(i,k2) prslk1(i,k1) = prslk(i,k2) - + rho(i,k1) = prsl(i,k2)/(con_rd*tlyr(i,k1)) + orho(i,k1) = 1.0/rho(i,k1) + !> - Compute relative humidity. es = min( prsl(i,k2), fpvs( tgrs(i,k2) ) ) ! fpvs and prsl in pa qs = max( QMIN, con_eps * es / (prsl(i,k2) + epsm1*es) ) @@ -402,6 +404,8 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & plyr(i,lyb) = 0.5 * plvl(i,lla) tlyr(i,lyb) = tlyr(i,lya) prslk1(i,lyb) = (plyr(i,lyb)*0.001) ** rocp ! plyr in hPa + rho(i,lyb) = plyr(i,lyb) *100.0/(con_rd*tlyr(i,lyb)) + orho(i,lyb) = 1.0/rho(i,lyb) rhly(i,lyb) = rhly(i,lya) qstl(i,lyb) = qstl(i,lya) enddo diff --git a/physics/GFS_rrtmg_pre.meta b/physics/GFS_rrtmg_pre.meta index b98512c7d..25102d078 100644 --- a/physics/GFS_rrtmg_pre.meta +++ b/physics/GFS_rrtmg_pre.meta @@ -44,6 +44,20 @@ dimensions = () type = integer intent = in +[lextop] + standard_name = do_extra_top_layer_for_radiation + long_name = use an extra top layer for radiation + units = flag + dimensions = () + type = logical + intent = in +[ltp] + standard_name = extra_top_layer + long_name = extra top layer for radiation + units = count + dimensions = () + type = integer + intent = in [n_var_lndp] standard_name = number_of_perturbed_land_surface_variables long_name = number of land surface variables perturbed diff --git a/physics/GFS_rrtmg_setup.F90 b/physics/GFS_rrtmg_setup.F90 index 803ccc84a..100da8452 100644 --- a/physics/GFS_rrtmg_setup.F90 +++ b/physics/GFS_rrtmg_setup.F90 @@ -13,8 +13,6 @@ module GFS_rrtmg_setup & iswcliq, & & kind_phys - use radcons, only: ltp, lextop - implicit none public GFS_rrtmg_setup_init, GFS_rrtmg_setup_timestep_init, GFS_rrtmg_setup_finalize @@ -50,7 +48,7 @@ subroutine GFS_rrtmg_setup_init ( & icliq_sw, crick_proof, ccnorm, & imp_physics, & norad_precip, idate, iflip, & - do_RRTMGP, me, errmsg, errflg) + do_RRTMGP, me, ltp, lextop, errmsg, errflg) ! ================= subprogram documentation block ================ ! ! ! ! subprogram: GFS_rrtmg_setup_init - a subprogram to initialize radiation ! @@ -141,6 +139,8 @@ subroutine GFS_rrtmg_setup_init ( & ! =0: index from toa to surface ! ! =1: index from surface to toa ! ! me : print control flag ! +! ltp : number of radiation extra top layers ! +! lextop : control flag to denote extra top layers are used ! ! ! ! subroutines called: radinit ! ! ! @@ -171,6 +171,8 @@ subroutine GFS_rrtmg_setup_init ( & integer, intent(in) :: iflip logical, intent(in) :: do_RRTMGP integer, intent(in) :: me + integer, intent(in) :: ltp + logical, intent(in) :: lextop character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -243,7 +245,7 @@ subroutine GFS_rrtmg_setup_init ( & call radinit & ! --- inputs: - & ( si, levr, imp_physics, me ) + & ( si, levr, imp_physics, me, ltp, lextop ) ! --- outputs: ! ( none ) @@ -324,7 +326,7 @@ end subroutine GFS_rrtmg_setup_finalize ! Private functions - subroutine radinit( si, NLAY, imp_physics, me ) + subroutine radinit( si, NLAY, imp_physics, me, ltp, lextop ) !................................... ! --- inputs: @@ -437,7 +439,8 @@ subroutine radinit( si, NLAY, imp_physics, me ) implicit none ! --- inputs: - integer, intent(in) :: NLAY, me, imp_physics + integer, intent(in) :: NLAY, me, imp_physics, ltp + logical, intent(in) :: lextop real (kind=kind_phys), intent(in) :: si(:) diff --git a/physics/GFS_rrtmg_setup.meta b/physics/GFS_rrtmg_setup.meta index ae0da3a5e..599f974f4 100644 --- a/physics/GFS_rrtmg_setup.meta +++ b/physics/GFS_rrtmg_setup.meta @@ -163,6 +163,20 @@ dimensions = () type = integer intent = in +[ltp] + standard_name = extra_top_layer + long_name = extra top layer for radiation + units = count + dimensions = () + type = integer + intent = in +[lextop] + standard_name = do_extra_top_layer_for_radiation + long_name = use an extra top layer for radiation + units = flag + dimensions = () + type = logical + intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/radcons.f90 b/physics/radcons.f90 index b767d2192..0ca7eeb19 100644 --- a/physics/radcons.f90 +++ b/physics/radcons.f90 @@ -47,16 +47,6 @@ module radcons !! control parameter ioznflg=0) logical :: loz1st =.true. -! DH* THIS MUST GO BUT NEED IT RIGHT NOW TO DEFINE LEXTOP -!> optional extra top layer on top of low ceiling models -!!\n LTP=0: no extra top layer - integer, parameter :: LTP = 0 ! no extra top layer -! integer, parameter :: LTP = 1 ! add an extra top layer -! *DH - -!> control flag for extra top layer - logical, parameter :: lextop = (LTP > 0) - !---------------------------- ! Module variable definitions !---------------------------- diff --git a/physics/rrtmg_lw_post.meta b/physics/rrtmg_lw_post.meta index fc52ff901..7f219c24f 100644 --- a/physics/rrtmg_lw_post.meta +++ b/physics/rrtmg_lw_post.meta @@ -24,7 +24,7 @@ [ltp] standard_name = extra_top_layer long_name = extra top layers - units = none + units = count dimensions = () type = integer intent = in diff --git a/physics/rrtmg_sw_post.meta b/physics/rrtmg_sw_post.meta index fb9c6dbf2..6a9f4efb5 100644 --- a/physics/rrtmg_sw_post.meta +++ b/physics/rrtmg_sw_post.meta @@ -31,7 +31,7 @@ [ltp] standard_name = extra_top_layer long_name = extra top layers - units = none + units = count dimensions = () type = integer intent = in From 779f70e8fa7679fd65eda6da14500efe4dd8ad16 Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Wed, 24 Aug 2022 15:06:26 -0400 Subject: [PATCH 4/7] add host-provided random number seeds for NRL --- physics/GFS_rad_time_vary.fv3.F90 | 37 ++++++++++++++++----------- physics/GFS_rad_time_vary.fv3.meta | 14 +++++++++++ physics/GFS_rad_time_vary.scm.F90 | 40 +++++++++++++++++++----------- physics/GFS_rad_time_vary.scm.meta | 14 +++++++++++ 4 files changed, 76 insertions(+), 29 deletions(-) diff --git a/physics/GFS_rad_time_vary.fv3.F90 b/physics/GFS_rad_time_vary.fv3.F90 index 34c743244..cef530b55 100644 --- a/physics/GFS_rad_time_vary.fv3.F90 +++ b/physics/GFS_rad_time_vary.fv3.F90 @@ -16,7 +16,7 @@ module GFS_rad_time_vary !> \section arg_table_GFS_rad_time_vary_timestep_init Argument Table !! \htmlinclude GFS_rad_time_vary_timestep_init.html !! - subroutine GFS_rad_time_vary_timestep_init ( & + subroutine GFS_rad_time_vary_timestep_init (lrseeds, rseeds, & lslwr, lsswr, isubc_lw, isubc_sw, icsdsw, icsdlw, cnx, cny, isc, jsc, & imap, jmap, sec, kdt, imp_physics, imp_physics_zhao_carr, ps_2delt, & ps_1delt, t_2delt, t_1delt, qv_2delt, qv_1delt, t, qv, ps, errmsg, errflg) @@ -29,6 +29,8 @@ subroutine GFS_rad_time_vary_timestep_init ( implicit none ! Interface variables + logical, intent(in) :: lrseeds + integer, intent(in) :: rseeds(:,:) integer, intent(in) :: isubc_lw, isubc_sw, cnx, cny, isc, jsc, kdt integer, intent(in) :: imp_physics, imp_physics_zhao_carr logical, intent(in) :: lslwr, lsswr @@ -47,7 +49,7 @@ subroutine GFS_rad_time_vary_timestep_init ( ! Local variables type (random_stat) :: stat - integer :: ix, j, i, nblks, ipseed + integer :: ix, j, i, ipseed integer :: numrdm(cnx*cny*2) ! Initialize CCPP error handling variables @@ -60,18 +62,25 @@ subroutine GFS_rad_time_vary_timestep_init ( !--- set up random seed index in a reproducible way for entire cubed-sphere face (lat-lon grid) if ((isubc_lw==2) .or. (isubc_sw==2)) then - ipseed = mod(nint(con_100*sqrt(sec)), ipsdlim) + 1 + ipsd0 - call random_setseed (ipseed, stat) - call random_index (ipsdlim, numrdm, stat) - - do ix=1,size(jmap) - j = jmap(ix) - i = imap(ix) - !--- for testing purposes, replace numrdm with '100' - icsdsw(ix) = numrdm(i+isc-1 + (j+jsc-2)*cnx) - icsdlw(ix) = numrdm(i+isc-1 + (j+jsc-2)*cnx + cnx*cny) - enddo - + !NRL If random seeds supplied by NEPTUNE + if(lrseeds) then + do ix=1,size(jmap) + icsdsw(ix) = rseeds(ix,1) + icsdlw(ix) = rseeds(ix,2) + enddo + else + ipseed = mod(nint(con_100*sqrt(sec)), ipsdlim) + 1 + ipsd0 + call random_setseed (ipseed, stat) + call random_index (ipsdlim, numrdm, stat) + + do ix=1,size(jmap) + j = jmap(ix) + i = imap(ix) + !--- for testing purposes, replace numrdm with '100' + icsdsw(ix) = numrdm(i+isc-1 + (j+jsc-2)*cnx) + icsdlw(ix) = numrdm(i+isc-1 + (j+jsc-2)*cnx + cnx*cny) + enddo + end if !lrseeds endif ! isubc_lw and isubc_sw if (imp_physics == imp_physics_zhao_carr) then diff --git a/physics/GFS_rad_time_vary.fv3.meta b/physics/GFS_rad_time_vary.fv3.meta index 0e7c7c024..f7a154eea 100644 --- a/physics/GFS_rad_time_vary.fv3.meta +++ b/physics/GFS_rad_time_vary.fv3.meta @@ -7,6 +7,20 @@ [ccpp-arg-table] name = GFS_rad_time_vary_timestep_init type = scheme +[lrseeds] + standard_name = do_host_provided_random_seeds + long_name = flag to use host-provided random seeds + units = flag + dimensions = () + type = logical + intent = in +[rseeds] + standard_name = random_number_seeds_from_host + long_name = random number seeds from host + units = none + dimensions = (horizontal_dimension, number_of_host_provided_random_number_streams) + type = integer + intent = in [lslwr] standard_name = flag_for_calling_longwave_radiation long_name = logical flags for lw radiation calls diff --git a/physics/GFS_rad_time_vary.scm.F90 b/physics/GFS_rad_time_vary.scm.F90 index d7d4cda26..924312a2a 100644 --- a/physics/GFS_rad_time_vary.scm.F90 +++ b/physics/GFS_rad_time_vary.scm.F90 @@ -11,11 +11,12 @@ module GFS_rad_time_vary contains !>\defgroup mod_GFS_rad_time_vary GFS Radiation Time Update +!! This module contains code related to GFS radiation setup. !> @{ !> \section arg_table_GFS_rad_time_vary_timestep_init Argument Table !! \htmlinclude GFS_rad_time_vary_timestep_init.html !! - subroutine GFS_rad_time_vary_timestep_init ( & + subroutine GFS_rad_time_vary_timestep_init (lrseeds, rseeds, & lslwr, lsswr, isubc_lw, isubc_sw, icsdsw, icsdlw, cnx, cny, isc, jsc, & imap, jmap, sec, kdt, imp_physics, imp_physics_zhao_carr, ps_2delt, & ps_1delt, t_2delt, t_1delt, qv_2delt, qv_1delt, t, qv, ps, errmsg, errflg) @@ -28,6 +29,8 @@ subroutine GFS_rad_time_vary_timestep_init ( implicit none ! Interface variables + logical, intent(in) :: lrseeds + integer, intent(in) :: rseeds(:,:) integer, intent(in) :: isubc_lw, isubc_sw, cnx, cny, isc, jsc, kdt integer, intent(in) :: imp_physics, imp_physics_zhao_carr logical, intent(in) :: lslwr, lsswr @@ -59,26 +62,33 @@ subroutine GFS_rad_time_vary_timestep_init ( !--- set up random seed index in a reproducible way for entire cubed-sphere face (lat-lon grid) if ((isubc_lw==2) .or. (isubc_sw==2)) then - ipseed = mod(nint(con_100*sqrt(sec)), ipsdlim) + 1 + ipsd0 - call random_setseed (ipseed, stat) - call random_index (ipsdlim, numrdm, stat) - - do ix=1,size(jmap) - j = jmap(ix) - i = imap(ix) - !--- for testing purposes, replace numrdm with '100' - icsdsw(ix) = numrdm(i+isc-1 + (j+jsc-2)*cnx) - icsdlw(ix) = numrdm(i+isc-1 + (j+jsc-2)*cnx + cnx*cny) - enddo - + !NRL If random seeds supplied by NEPTUNE + if(lrseeds) then + do ix=1,size(jmap) + icsdsw(ix) = rseeds(ix,1) + icsdlw(ix) = rseeds(ix,2) + enddo + else + ipseed = mod(nint(con_100*sqrt(sec)), ipsdlim) + 1 + ipsd0 + call random_setseed (ipseed, stat) + call random_index (ipsdlim, numrdm, stat) + + do ix=1,size(jmap) + j = jmap(ix) + i = imap(ix) + !--- for testing purposes, replace numrdm with '100' + icsdsw(ix) = numrdm(i+isc-1 + (j+jsc-2)*cnx) + icsdlw(ix) = numrdm(i+isc-1 + (j+jsc-2)*cnx + cnx*cny) + enddo + end if !lrseeds endif ! isubc_lw and isubc_sw if (imp_physics == imp_physics_zhao_carr) then if (kdt == 1) then t_2delt = t t_1delt = t - qv_2delt = max(qmin,qv) - qv_1delt = max(qmin,qv) + qv_2delt = qv + qv_1delt = qv ps_2delt = ps ps_1delt = ps endif diff --git a/physics/GFS_rad_time_vary.scm.meta b/physics/GFS_rad_time_vary.scm.meta index 0e7c7c024..f7a154eea 100644 --- a/physics/GFS_rad_time_vary.scm.meta +++ b/physics/GFS_rad_time_vary.scm.meta @@ -7,6 +7,20 @@ [ccpp-arg-table] name = GFS_rad_time_vary_timestep_init type = scheme +[lrseeds] + standard_name = do_host_provided_random_seeds + long_name = flag to use host-provided random seeds + units = flag + dimensions = () + type = logical + intent = in +[rseeds] + standard_name = random_number_seeds_from_host + long_name = random number seeds from host + units = none + dimensions = (horizontal_dimension, number_of_host_provided_random_number_streams) + type = integer + intent = in [lslwr] standard_name = flag_for_calling_longwave_radiation long_name = logical flags for lw radiation calls From 042557e4f6a266158cc9016de93c05268bddc853 Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Tue, 16 Aug 2022 16:23:48 -0400 Subject: [PATCH 5/7] fix SAS overshooting issue --- physics/samfdeepcnv.f | 10 ++++++++++ physics/sascnvn.F | 10 ++++++++++ 2 files changed, 20 insertions(+) diff --git a/physics/samfdeepcnv.f b/physics/samfdeepcnv.f index 2fe85e26c..20c0c6e97 100644 --- a/physics/samfdeepcnv.f +++ b/physics/samfdeepcnv.f @@ -1642,6 +1642,13 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, & ktcon1(i) = k flg(i) = .false. endif +!NRL MNM: Limit overshooting not to be deeper than the actual cloud + tem = zi(i,ktcon(i))-zi(i,kbcon(i)) + tem1 = zi(i,ktcon1(i))-zi(i,ktcon(i)) + if(tem1.ge.tem) then + ktcon1(i) = k + flg(i) = .false. + endif endif endif enddo @@ -3049,6 +3056,9 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, & dellat = (dellah(i,k) - hvap * dellaq(i,k)) / cp t1(i,k) = t1(i,k) + tem2 * dellat q1(i,k) = q1(i,k) + tem2 * dellaq(i,k) +! NRL MNM: Limit q1 + val = epsilon(1.0_kind_phys) + q1(i,k) = max(q1(i,k), val ) ! tem = tem2 / rcs(i) ! u1(i,k) = u1(i,k) + dellau(i,k) * tem ! v1(i,k) = v1(i,k) + dellav(i,k) * tem diff --git a/physics/sascnvn.F b/physics/sascnvn.F index 1ce1495aa..2908bed12 100644 --- a/physics/sascnvn.F +++ b/physics/sascnvn.F @@ -1005,6 +1005,13 @@ subroutine sascnvn_run( ktcon1(i) = k flg(i) = .false. endif +!NRL MNM: Limit overshooting not to be deeper than the actual cloud + tem = zi(i,ktcon(i))-zi(i,kbcon(i)) + tem1 = zi(i,ktcon1(i))-zi(i,ktcon(i)) + if(tem1.ge.tem) then + ktcon1(i) = k + flg(i) = .false. + endif endif endif enddo @@ -1871,6 +1878,9 @@ subroutine sascnvn_run( dellat = (dellah(i,k) - hvap * dellaq(i,k)) / cp t1(i,k) = t1(i,k) + dellat * xmb(i) * dt2 q1(i,k) = q1(i,k) + dellaq(i,k) * xmb(i) * dt2 +! NRL MNM: Limit q1 + val = epsilon(1.0_kind_phys) + q1(i,k) = max(q1(i,k), val ) ! tem = 1./rcs(i) ! u1(i,k) = u1(i,k) + dellau(i,k) * xmb(i) * dt2 * tem ! v1(i,k) = v1(i,k) + dellav(i,k) * xmb(i) * dt2 * tem From 19440817b331576b7696bd2cc2dd732f62ba9682 Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Thu, 25 Aug 2022 11:25:35 -0400 Subject: [PATCH 6/7] remove q1 clipping; change ktcon1 initialization from Jongil Han's review --- physics/samfdeepcnv.f | 5 +---- physics/sascnvn.F | 5 +---- 2 files changed, 2 insertions(+), 8 deletions(-) diff --git a/physics/samfdeepcnv.f b/physics/samfdeepcnv.f index 20c0c6e97..7c6f0880a 100644 --- a/physics/samfdeepcnv.f +++ b/physics/samfdeepcnv.f @@ -1618,7 +1618,7 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, & c do i = 1, im flg(i) = cnvflg(i) - ktcon1(i) = kmax(i) + ktcon1(i) = ktcon(i) enddo do k = 2, km1 do i = 1, im @@ -3056,9 +3056,6 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, & dellat = (dellah(i,k) - hvap * dellaq(i,k)) / cp t1(i,k) = t1(i,k) + tem2 * dellat q1(i,k) = q1(i,k) + tem2 * dellaq(i,k) -! NRL MNM: Limit q1 - val = epsilon(1.0_kind_phys) - q1(i,k) = max(q1(i,k), val ) ! tem = tem2 / rcs(i) ! u1(i,k) = u1(i,k) + dellau(i,k) * tem ! v1(i,k) = v1(i,k) + dellav(i,k) * tem diff --git a/physics/sascnvn.F b/physics/sascnvn.F index 2908bed12..08e7b4669 100644 --- a/physics/sascnvn.F +++ b/physics/sascnvn.F @@ -987,7 +987,7 @@ subroutine sascnvn_run( ! do i = 1, im flg(i) = cnvflg(i) - ktcon1(i) = kmax(i) - 1 + ktcon1(i) = ktcon(i) enddo do k = 2, km1 do i = 1, im @@ -1878,9 +1878,6 @@ subroutine sascnvn_run( dellat = (dellah(i,k) - hvap * dellaq(i,k)) / cp t1(i,k) = t1(i,k) + dellat * xmb(i) * dt2 q1(i,k) = q1(i,k) + dellaq(i,k) * xmb(i) * dt2 -! NRL MNM: Limit q1 - val = epsilon(1.0_kind_phys) - q1(i,k) = max(q1(i,k), val ) ! tem = 1./rcs(i) ! u1(i,k) = u1(i,k) + dellau(i,k) * xmb(i) * dt2 * tem ! v1(i,k) = v1(i,k) + dellav(i,k) * xmb(i) * dt2 * tem From 4cd35abbfca7f783e2e284ab1f597d15c6cb11bc Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Thu, 8 Sep 2022 13:45:08 -0400 Subject: [PATCH 7/7] clean up samfdeepcnv and sascnvn changes to address review comments --- physics/samfdeepcnv.f | 14 +++++--------- physics/sascnvn.F | 14 +++++--------- 2 files changed, 10 insertions(+), 18 deletions(-) diff --git a/physics/samfdeepcnv.f b/physics/samfdeepcnv.f index 7c6f0880a..2552ac622 100644 --- a/physics/samfdeepcnv.f +++ b/physics/samfdeepcnv.f @@ -1637,15 +1637,11 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, & ! aa2(i) = aa2(i) + !! & dz1 * eta(i,k) * grav * fv * ! & dz1 * grav * fv * -! & max(val,(qeso(i,k) - qo(i,k))) - if(aa2(i) < 0.) then - ktcon1(i) = k - flg(i) = .false. - endif -!NRL MNM: Limit overshooting not to be deeper than the actual cloud - tem = zi(i,ktcon(i))-zi(i,kbcon(i)) - tem1 = zi(i,ktcon1(i))-zi(i,ktcon(i)) - if(tem1.ge.tem) then +! & max(val,(qeso(i,k) - qo(i,k))) +!NRL MNM: Limit overshooting not to be deeper than half the actual cloud + tem = 0.5 * (zi(i,ktcon(i))-zi(i,kbcon(i))) + tem1 = zi(i,k)-zi(i,ktcon(i)) + if(aa2(i) < 0. .or. tem1 >= tem) then ktcon1(i) = k flg(i) = .false. endif diff --git a/physics/sascnvn.F b/physics/sascnvn.F index 08e7b4669..673231e05 100644 --- a/physics/sascnvn.F +++ b/physics/sascnvn.F @@ -1000,18 +1000,14 @@ subroutine sascnvn_run( aa2(i) = aa2(i) + & dz1 * (g / (cp * to(i,k))) & * dbyo(i,k) / (1. + gamma) - & * rfact - if(aa2(i).lt.0.) then - ktcon1(i) = k - flg(i) = .false. - endif + & * rfact !NRL MNM: Limit overshooting not to be deeper than the actual cloud - tem = zi(i,ktcon(i))-zi(i,kbcon(i)) - tem1 = zi(i,ktcon1(i))-zi(i,ktcon(i)) - if(tem1.ge.tem) then + tem = 0.5 * (zi(i,ktcon(i))-zi(i,kbcon(i))) + tem1 = zi(i,k)-zi(i,ktcon(i)) + if(aa2(i) < 0. .or. tem1 >= tem) then ktcon1(i) = k flg(i) = .false. - endif + endif endif endif enddo