Merge pull request #1195 from scrasmussen/ufs-dev-332

ufs-dev 332

Author: grantfirl

CODEOWNERS

@@ -4,7 +4,7 @@
 
 # Default codeowners for files that don't have specific owners:
 
-*           @grantfirl @rhaesung @Qingfu-Liu @dustinswales @mzhangw
+*           @grantfirl @rhaesung @Qingfu-Liu @dustinswales @mzhangw @climbfuji
 
 
 # The following lines are from the CCPP Primary Schemes Points of Contact

physics/CONV/SAMF/samfdeepcnv.f

@@ -85,7 +85,8 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart,        &
      &    clam,c0s,c1,betal,betas,evef,pgcon,asolfac,cscale,            &
      &    do_ca, ca_closure, ca_entr, ca_trigger, nthresh,ca_deep,      &
      &    rainevap,sigmain,sigmaout,omegain,omegaout,betadcu,betamcu,   &
-     &    betascu,maxMF,do_mynnedmf,sigmab_coldstart,errmsg,errflg)
+     &    betascu,maxMF,do_mynnedmf,sigmab_coldstart,cat_adj_deep,      &
+     &    errmsg,errflg)
 
 !
       use machine , only : kind_phys
@@ -137,6 +138,7 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart,        &
       real(kind=kind_phys), intent(in) :: clam,  c0s,  c1,              &
      &                     betal,   betas,   asolfac,                   &
      &                     evef,  pgcon
+      real(kind_phys), intent(in) :: cat_adj_deep
       character(len=*), intent(out) :: errmsg
       integer,          intent(out) :: errflg
 !
@@ -2952,7 +2954,7 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart,        &
            umean(i) = max(umean(i), 1.)
            tauadv = gdx(i) / umean(i)
            advfac(i) = tauadv / dtconv(i)
-           advfac(i) = min(advfac(i), 1.)
+           advfac(i) = min(cat_adj_deep*advfac(i), 1.)
         endif
       enddo
 

physics/CONV/SAMF/samfdeepcnv.meta

@@ -762,6 +762,14 @@
   type = real
   kind = kind_phys
   intent = out
+[cat_adj_deep]
+  standard_name = adjustment_for_convective_advection_time_for_deep
+  long_name = adjustment for convective advection time for deep
+  units = none
+  dimensions = ()
+  type = real
+  kind = kind_phys
+  intent = in
 [errmsg]
   standard_name = ccpp_error_message
   long_name = error message for error handling in CCPP

physics/CONV/SAMF/samfshalcnv.f

@@ -59,7 +59,7 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap,            &
      &     dot,ncloud,hpbl,ud_mf,dt_mf,cnvw,cnvc,                       &
      &     clam,c0s,c1,evef,pgcon,asolfac,hwrf_samfshal,                & 
      &     sigmain,sigmaout,omegain,omegaout,betadcu,betamcu,betascu,   &
-     &     errmsg,errflg)
+     &     cat_adj_shal,errmsg,errflg)
 !
       use machine , only : kind_phys
       use funcphys , only : fpvs
@@ -98,8 +98,10 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap,            &
      &                     asolfac, evef, pgcon
       logical,          intent(in)  :: hwrf_samfshal,first_time_step,   &
      &     restart,progsigma,progomega
+      real(kind_phys), intent(in) :: cat_adj_shal
       character(len=*), intent(out) :: errmsg
       integer,          intent(out) :: errflg
+
 !
 !  local variables
       integer              i,j,indx, k, kk, km1, n
@@ -1992,7 +1994,7 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap,            &
            umean(i) = max(umean(i), 1.)
            tauadv = gdx(i) / umean(i)
            advfac(i) = tauadv / dtconv(i)
-           advfac(i) = min(advfac(i), 1.)
+           advfac(i) = min(cat_adj_shal*advfac(i), 1.)
         endif
       enddo
 c

physics/CONV/SAMF/samfshalcnv.meta

@@ -550,6 +550,14 @@
   dimensions = ()
   type = real
   intent = in
+[cat_adj_shal]
+  standard_name = adjustment_for_convective_advection_time_for_shallow
+  long_name = adjustment for convective advection time for shallow
+  units = none
+  dimensions = ()
+  type = real
+  kind = kind_phys
+  intent = in
 [errmsg]
   standard_name = ccpp_error_message
   long_name = error message for error handling in CCPP

physics/MP/Thompson/module_mp_thompson.F90

@@ -1043,7 +1043,8 @@ subroutine mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc,     &
                               tprr_rcs, tprv_rev, tten3, qvten3,      &
                               qrten3, qsten3, qgten3, qiten3, niten3, &
                               nrten3, ncten3, qcten3,                 &
-                              pfils, pflls)
+                              pfils, pflls,                           &
+                              fs_fac_rain, fs_fac_snow)
 
          implicit none
 
@@ -1112,6 +1113,8 @@ subroutine mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc,     &
                            tprr_rcs, tprv_rev, tten3, qvten3,      &
                            qrten3, qsten3, qgten3, qiten3, niten3, &
                            nrten3, ncten3, qcten3
+         ! Fall speed adjustment
+         real(wp), INTENT (IN), optional  :: fs_fac_rain, fs_fac_snow
 
    !..Local variables
          real(wp), dimension(kts:kte):: &
@@ -1481,7 +1484,8 @@ subroutine mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc,     &
                            tprr_rcs1, tprv_rev1,                            &
                            tten1, qvten1, qrten1, qsten1,                   &
                            qgten1, qiten1, niten1, nrten1, ncten1, qcten1,  &
-                           pfil1, pfll1)
+                           pfil1, pfll1,                                    &
+                           fs_fac_rain, fs_fac_snow)
 
                pcp_ra(i,j) = pcp_ra(i,j) + pptrain
                pcp_sn(i,j) = pcp_sn(i,j) + pptsnow
@@ -1901,7 +1905,8 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d,     &
                         tprr_rcs1, tprv_rev1,                            &
                         tten1, qvten1, qrten1, qsten1,                   &
                         qgten1, qiten1, niten1, nrten1, ncten1, qcten1,  &
-                        pfil1, pfll1) 
+                        pfil1, pfll1,                                    &
+                        fs_fac_rain, fs_fac_snow)
 
       use mpi_f08
 
@@ -1937,6 +1942,8 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d,     &
                           tprr_rcs1, tprv_rev1, tten1, qvten1,       &
                           qrten1, qsten1, qgten1, qiten1, niten1,    &
                           nrten1, ncten1, qcten1
+      ! Fall speed adjustment
+      real(wp), intent(in), optional :: fs_fac_rain, fs_fac_snow
 
 #if ( WRF_CHEM == 1 )
       real(wp), dimension(kts:kte), intent(inout) :: &
@@ -2031,6 +2038,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d,     &
       logical :: debug_flag
       integer :: nu_c
 
+      real(wp) :: fallspeed_adjustment_factor
 !+---+
 
       debug_flag = .false.
@@ -3769,6 +3777,9 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d,     &
       enddo
 
       if (ANY(L_qr .eqv. .true.)) then
+         fallspeed_adjustment_factor=1.0
+         if ( present(fs_fac_rain) ) fallspeed_adjustment_factor=fs_fac_rain
+
          do k = kte, kts, -1
             vtr = 0.
             rhof(k) = SQRT(RHO_NOT/rho(k))
@@ -3777,15 +3788,15 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d,     &
                lamr = (am_r*crg(3)*org2*nr(k)/rr(k))**obmr
                vtr = rhof(k)*av_r*crg(6)*org3 * lamr**cre(3)                 &
                            *((lamr+fv_r)**(-cre(6)))
-               vtrk(k) = vtr
+               vtrk(k) = vtr*fallspeed_adjustment_factor
 ! First below is technically correct:
 !         vtr = rhof(k)*av_r*crg(5)*org2 * lamr**cre(2)                 &
 !                     *((lamr+fv_r)**(-cre(5)))
 ! Test: make number fall faster (but still slower than mass)
 ! Goal: less prominent size sorting
                vtr = rhof(k)*av_r*crg(7)/crg(12) * lamr**cre(12)             &
                            *((lamr+fv_r)**(-cre(7)))
-               vtnrk(k) = vtr
+               vtnrk(k) = vtr*fallspeed_adjustment_factor
             else
                vtrk(k) = vtrk(k+1)
                vtnrk(k) = vtnrk(k+1)
@@ -3869,6 +3880,9 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d,     &
 !+---+-----------------------------------------------------------------+
 
        if (ANY(L_qs .eqv. .true.)) then
+         fallspeed_adjustment_factor=1.0
+         if ( present(fs_fac_snow) ) fallspeed_adjustment_factor=fs_fac_snow
+
          nstep = 0
          do k = kte, kts, -1
             vts = 0.
@@ -3886,6 +3900,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d,     &
                t3_vts = Kap0*csg(1)*ils1**cse(1)
                t4_vts = Kap1*Mrat**mu_s*csg(7)*ils2**cse(7)
                vts = rhof(k)*av_s * (t1_vts+t2_vts)/(t3_vts+t4_vts)
+               vts=vts*fallspeed_adjustment_factor
                if (prr_sml(k) .gt. 0.0) then
       !           vtsk(k) = max(vts*vts_boost(k),                             &
       !    &                vts*((vtrk(k)-vts*vts_boost(k))/(temp(k)-T_0)))

physics/MP/Thompson/mp_thompson.F90

@@ -383,6 +383,7 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd,        &
                               spp_prt_list, spp_var_list,          &
                               spp_stddev_cutoff,                   &
                               cplchm, pfi_lsan, pfl_lsan,          &
+                              fs_fac_rain, fs_fac_snow,            &
                               is_initialized, errmsg, errflg)
 
          implicit none
@@ -465,6 +466,9 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd,        &
          real(kind=kind_phys), intent(inout), dimension(:,:), optional :: pfi_lsan
          real(kind=kind_phys), intent(inout), dimension(:,:), optional :: pfl_lsan
 
+         ! fall speed adjustment
+         real(kind_phys),           intent(in), optional :: fs_fac_rain, fs_fac_snow
+
          ! Local variables
 
          ! Reduced time step if subcycling is used
@@ -776,7 +780,8 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd,        &
                               tprv_rev=tprv_rev, tten3=tten3,                                &
                               qvten3=qvten3, qrten3=qrten3, qsten3=qsten3, qgten3=qgten3,    &
                               qiten3=qiten3, niten3=niten3, nrten3=nrten3, ncten3=ncten3,    &
-                              qcten3=qcten3, pfils=pfils, pflls=pflls)
+                              qcten3=qcten3, pfils=pfils, pflls=pflls,                       &
+                              fs_fac_rain=fs_fac_rain, fs_fac_snow=fs_fac_snow)
          else if (merra2_aerosol_aware) then
              call mp_gt_driver(qv=qv, qc=qc, qr=qr, qi=qi, qs=qs, qg=qg, ni=ni, nr=nr,        &
                                nc=nc, nwfa=nwfa, nifa=nifa,                                   &
@@ -818,7 +823,8 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd,        &
                                tprv_rev=tprv_rev, tten3=tten3,                                &
                                qvten3=qvten3, qrten3=qrten3, qsten3=qsten3, qgten3=qgten3,    &
                                qiten3=qiten3, niten3=niten3, nrten3=nrten3, ncten3=ncten3,    &
-                               qcten3=qcten3, pfils=pfils, pflls=pflls)
+                               qcten3=qcten3, pfils=pfils, pflls=pflls,                       &
+                               fs_fac_rain=fs_fac_rain, fs_fac_snow=fs_fac_snow)
          else
             call mp_gt_driver(qv=qv, qc=qc, qr=qr, qi=qi, qs=qs, qg=qg, ni=ni, nr=nr,        &
                               tt=tgrs, p=prsl, w=w, dz=dz, dt_in=dtstep, dt_inner=dt_inner,  &
@@ -858,7 +864,8 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd,        &
                               tprv_rev=tprv_rev, tten3=tten3,                                &
                               qvten3=qvten3, qrten3=qrten3, qsten3=qsten3, qgten3=qgten3,    &
                               qiten3=qiten3, niten3=niten3, nrten3=nrten3, ncten3=ncten3,    &
-                              qcten3=qcten3, pfils=pfils, pflls=pflls)
+                              qcten3=qcten3, pfils=pfils, pflls=pflls,                       &
+                              fs_fac_rain=fs_fac_rain, fs_fac_snow=fs_fac_snow)
          end if
          if (errflg/=0) return
 

physics/MP/Thompson/mp_thompson.meta

@@ -943,6 +943,24 @@
   dimensions = ()
   type = logical
   intent = inout
+[fs_fac_rain]
+  standard_name = multiplicative_tuning_parameter_for_rain_fall_speed
+  long_name = multiplicative tuning parameter for rain fall speed
+  units = none
+  dimensions = ()
+  type = real
+  kind = kind_phys
+  intent = in
+  optional = True
+[fs_fac_snow]
+  standard_name = multiplicative_tuning_parameter_for_snow_fall_speed
+  long_name = multiplicative tuning parameter_for snow fall speed
+  units = none
+  dimensions = ()
+  type = real
+  kind = kind_phys
+  intent = in
+  optional = True
 [errmsg]
   standard_name = ccpp_error_message
   long_name = error message for error handling in CCPP

physics/Radiation/RRTMGP/rrtmgp_lw_cloud_optics.F90

@@ -48,7 +48,7 @@ module rrtmgp_lw_cloud_optics
   ! ######################################################################################
 !>
   subroutine rrtmgp_lw_cloud_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_clouds,         &
-       nrghice, mpicomm, mpirank, mpiroot, errmsg, errflg)
+       nrghice, mpicomm, mpirank, mpiroot1, errmsg, errflg)
 
     ! Inputs
     character(len=128),intent(in) :: &
@@ -61,7 +61,8 @@ subroutine rrtmgp_lw_cloud_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_clouds,
          mpicomm               !< MPI communicator
     integer, intent(in) :: & 
          mpirank,            & !< Current MPI rank
-         mpiroot               !< Master MPI rank
+         mpiroot1              !< Master MPI rank
+    integer :: mpiroot
 
     ! Outputs
     character(len=*), intent(out) :: &
@@ -77,6 +78,7 @@ subroutine rrtmgp_lw_cloud_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_clouds,
     errmsg = ''
     errflg = 0
 
+    mpiroot = 0
     ! Filenames are set in the physics_nml
     lw_cloud_props_file = trim(rrtmgp_root_dir)//trim(rrtmgp_lw_file_clouds)
 

physics/Radiation/RRTMGP/rrtmgp_lw_gas_optics.F90

@@ -72,7 +72,7 @@ module rrtmgp_lw_gas_optics
 
 !>
   subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas,                 &
-       active_gases_array, mpicomm, mpirank, mpiroot, errmsg, errflg)
+       active_gases_array, mpicomm, mpirank, mpiroot1, errmsg, errflg)
 
     ! Inputs
     character(len=128),intent(in) :: &
@@ -84,8 +84,9 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas,
          mpicomm             !< MPI communicator
     integer,intent(in) :: &
          mpirank,          & !< Current MPI rank
-         mpiroot             !< Master MPI rank
- 
+         mpiroot1            !< Master MPI rank
+    integer :: mpiroot
+
     ! Outputs
     character(len=*), intent(out) :: &
          errmsg              !< CCPP error message
@@ -102,6 +103,7 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas,
     errmsg = ''
     errflg = 0
 
+    mpiroot = 0
     ! Filenames are set in the physics_nml
     lw_gas_props_file  = trim(rrtmgp_root_dir)//trim(rrtmgp_lw_file_gas)