diff --git a/physics/GFS_PBL_generic_post.F90 b/physics/GFS_PBL_generic_post.F90 index 5fab03d57..67b5443cd 100644 --- a/physics/GFS_PBL_generic_post.F90 +++ b/physics/GFS_PBL_generic_post.F90 @@ -365,27 +365,18 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, end if end if - if (cplaqm .and. .not.cplflx) then - do i=1,im - if (oceanfrac(i) > zero) then ! Ocean only, NO LAKES - if ( .not. wet(i)) then ! no open water - if (kdt > 1) then !use results from CICE - dtsfci_cpl(i) = dtsfc_cice(i) - dqsfci_cpl(i) = dqsfc_cice(i) - else !use PBL fluxes when CICE fluxes is unavailable - dtsfci_cpl(i) = dtsfc1(i)*hffac(i) - dqsfci_cpl(i) = dqsfc1(i) - end if - elseif (icy(i) .or. dry(i)) then ! use stress_ocean from sfc_diff for opw component at mixed point - rho = prsl(i,1) / (rd*t1(i)*(one+fvirt*max(q1(i), qmin))) - dtsfci_cpl(i) = cp * rho * hflx_wat(i) ! sensible heat flux over open ocean - dqsfci_cpl(i) = hvap * rho * evap_wat(i) ! latent heat flux over open ocean - else ! use results from PBL scheme for 100% open ocean + if (cplaqm) then + do i = 1, im + if (oceanfrac(i) > zero) then + if (.not.cplflx) then dtsfci_cpl(i) = dtsfc1(i)*hffac(i) dqsfci_cpl(i) = dqsfc1(i) - endif - endif ! Ocean only, NO LAKES - enddo + end if + else ! heat fluxes are required over land + dtsfci_cpl(i) = dtsfc1(i)*hffac(i) + dqsfci_cpl(i) = dqsfc1(i) + end if + end do end if !-------------------------------------------------------lssav if loop ---------- diff --git a/physics/GFS_rad_time_vary.fv3.F90 b/physics/GFS_rad_time_vary.fv3.F90 index c2f3540a6..978dc177f 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, ipsd0, ipsdlim,& ps_2delt, ps_1delt, t_2delt, t_1delt, qv_2delt, qv_1delt, t, qv, ps, & @@ -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, ipsd0, ipsdlim 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 561b2ade0..387625796 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 c8e782ebb..3f730eaf5 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, ipsd0, ipsdlim,& ps_2delt, ps_1delt, t_2delt, t_1delt, qv_2delt, qv_1delt, t, qv, ps, & @@ -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, ipsd0, ipsdlim 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 561b2ade0..387625796 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 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 d5540a043..315384913 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, top_at_1, & + subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,& + ltp, imfdeepcnv, imfdeepcnv_gf, me, ncnd, ntrac, num_p3d, npdf3d, & + ncnvcld3d,ntqv, ntcw,ntiw, ntlnc, ntinc, ntrnc, ntsnc, ntccn, top_at_1,& ntrw, ntsw, ntgl, nthl, ntwa, ntoz, & ntclamt, nleffr, nieffr, nseffr, lndp_type, kdt, & ntdu1, ntdu2, ntdu3, ntdu4, ntdu5, ntss1, ntss2, & @@ -49,8 +49,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & use machine, only: kind_phys - use radcons, only: itsfc,ltp, lextop, qmin, & - qme5, qme6, epsq, prsmin + use radcons, only: itsfc, qmin, qme5, qme6, epsq, prsmin use funcphys, only: fpvs use module_radiation_astronomy,only: coszmn ! sol_init, sol_update @@ -82,8 +81,8 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & make_RainNumber 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, & @@ -124,7 +123,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & logical, intent(in) :: lsswr, lslwr, ltaerosol, lgfdlmprad, & uni_cld, effr_in, do_mynnedmf, & lmfshal, lmfdeep2, pert_clds, lcrick,& - lcnorm, top_at_1 + lcnorm, top_at_1, lextop logical, intent(in) :: aero_dir_fdb real(kind=kind_phys), dimension(:,:), intent(in) :: smoke_ext, dust_ext @@ -347,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) ) @@ -403,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 752a6e1ed..4799c49cf 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 c61ce358e..9414884f0 100644 --- a/physics/GFS_rrtmg_setup.F90 +++ b/physics/GFS_rrtmg_setup.F90 @@ -7,7 +7,6 @@ module GFS_rrtmg_setup use machine, only: kind_phys - use radcons, only: ltp, lextop implicit none @@ -45,8 +44,7 @@ subroutine GFS_rrtmg_setup_init ( si, levr, ictm, isol, solar_file, ico2, & iaermdl, iaerflg, aeros_file, con_pi, con_t0c, con_c, con_boltz, & con_plnk, con_solr_2008, con_solr_2002, co2usr_file, co2cyc_file, & rad_hr_units, inc_minor_gas, icliq_lw, isubcsw, isubclw, iswmode, & - ipsd0, errmsg, errflg) - + ipsd0, ltp, lextop, errmsg, errflg) ! ================= subprogram documentation block ================ ! ! ! ! subprogram: GFS_rrtmg_setup_init - a subprogram to initialize radiation ! @@ -137,6 +135,8 @@ subroutine GFS_rrtmg_setup_init ( si, levr, ictm, isol, solar_file, ico2, & ! =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 ! ! ! @@ -153,12 +153,12 @@ subroutine GFS_rrtmg_setup_init ( si, levr, ictm, isol, solar_file, ico2, & ! interface variables real (kind=kind_phys), intent(in) :: si(:) integer, intent(in) :: levr, ictm, isol, ico2, iaer, ntcw, num_p3d, & - npdf3d, ntoz, iovr, iovr_rand, iovr_maxrand, iovr_max, & + ltp, npdf3d, ntoz, iovr, iovr_rand, iovr_maxrand, iovr_max, & iovr_dcorr, iovr_exp, iovr_exprand, icliq_sw, imp_physics, & iflip, me, rad_hr_units, icliq_lw, isubcsw, isubclw, iswmode integer, intent(in) :: idate(:) logical, intent(in) :: lcrick, lcnorm, lnoprec, do_RRTMGP, lalw1bd, & - inc_minor_gas + inc_minor_gas, lextop character(len=26),intent(in) :: aeros_file, solar_file, co2usr_file,& co2cyc_file real(kind_phys), intent(in) :: con_pi, con_t0c, con_c, con_boltz, & @@ -210,6 +210,7 @@ subroutine GFS_rrtmg_setup_init ( si, levr, ictm, isol, solar_file, ico2, & ' iflip=',iflip,' me=',me print *,' lcrick=',lcrick, & ' lcnorm=',lcnorm,' lnoprec=',lnoprec + print *, 'lextop=',lextop, ' ltp=',ltp endif ! Call initialization routines @@ -302,7 +303,6 @@ subroutine GFS_rrtmg_setup_finalize (errmsg, errflg) is_initialized = .false. end subroutine GFS_rrtmg_setup_finalize - !> This subroutine checks and updates time sensitive data used by !! radiation computations. This subroutine needs to be placed inside !! the time advancement loop but outside of the horizontal grid loop. diff --git a/physics/GFS_rrtmg_setup.meta b/physics/GFS_rrtmg_setup.meta index bf323676d..d6f0b0e7a 100644 --- a/physics/GFS_rrtmg_setup.meta +++ b/physics/GFS_rrtmg_setup.meta @@ -328,6 +328,20 @@ 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 +[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 [ipsd0] standard_name = initial_seed_for_mcica long_name = initial permutaion seed for mcica radiation 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/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 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/radiation_astronomy.f b/physics/radiation_astronomy.f index 686cfb200..b25c89a8c 100644 --- a/physics/radiation_astronomy.f +++ b/physics/radiation_astronomy.f @@ -899,7 +899,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/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 diff --git a/physics/samfdeepcnv.f b/physics/samfdeepcnv.f index 2fe85e26c..2552ac622 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 @@ -1637,8 +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 +! & 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 1ce1495aa..673231e05 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 @@ -1000,11 +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 + & * rfact +!NRL MNM: Limit overshooting not to be deeper than 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 + endif endif endif enddo diff --git a/physics/sflx.f b/physics/sflx.f index 999acf3ec..92205dd61 100644 --- a/physics/sflx.f +++ b/physics/sflx.f @@ -913,15 +913,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