Merge remote-tracking branch 'upstream/ufs/dev' into feature/land

CMakeLists.txt

@@ -140,9 +140,10 @@ SET_PROPERTY(SOURCE ${SCHEMES} ${CAPS}
              APPEND_STRING PROPERTY COMPILE_FLAGS " ${CMAKE_Fortran_FLAGS_PHYSICS} ${OpenMP_Fortran_FLAGS}")
 
 # Lower optimization for certain schemes when compiling with Intel in Release mode
-if(CMAKE_BUILD_TYPE STREQUAL "Release" AND ${CMAKE_Fortran_COMPILER_ID} STREQUAL "Intel")
+if(CMAKE_BUILD_TYPE STREQUAL "Release" AND (${CMAKE_Fortran_COMPILER_ID} STREQUAL "Intel" OR ${CMAKE_Fortran_COMPILER_ID} STREQUAL "IntelLLVM"))
   # Define a list of schemes that need lower optimization with Intel in Release mode
   set(SCHEME_NAMES_LOWER_OPTIMIZATION module_sf_mynn.F90
+                                      module_mp_nssl_2mom.F90
                                       mynnedmf_wrapper.F90
                                       gcycle.F90)
   foreach(SCHEME_NAME IN LISTS SCHEME_NAMES_LOWER_OPTIMIZATION)
@@ -156,7 +157,7 @@ if(CMAKE_BUILD_TYPE STREQUAL "Release" AND ${CMAKE_Fortran_COMPILER_ID} STREQUAL
 endif()
 
 # No optimization for certain schemes when compiling with Intel in Release mode
-if(CMAKE_BUILD_TYPE STREQUAL "Release" AND ${CMAKE_Fortran_COMPILER_ID} STREQUAL "Intel")
+if(CMAKE_BUILD_TYPE STREQUAL "Release" AND (${CMAKE_Fortran_COMPILER_ID} STREQUAL "Intel" OR ${CMAKE_Fortran_COMPILER_ID} STREQUAL "IntelLLVM"))
   # Define a list of schemes that can't be optimized with Intel in Release mode
   set(SCHEME_NAMES_NO_OPTIMIZATION GFS_typedefs.F90)
   foreach(SCHEME_NAME IN LISTS SCHEME_NAMES_NO_OPTIMIZATION)

physics/CONV/Grell_Freitas/cu_gf_deep.F90

@@ -425,9 +425,9 @@ subroutine cu_gf_deep_run(        &
      integer :: turn,pmin_lev(its:ite),start_level(its:ite),ktopkeep(its:ite)
      real(kind=kind_phys),    dimension (its:ite,kts:kte) :: dtempdz
      integer, dimension (its:ite,kts:kte) ::  k_inv_layers 
-     real(kind=kind_phys),    dimension (its:ite) :: c0    ! HCB
+     real(kind=kind_phys),    dimension (its:ite) :: c0, rrfs_factor  ! HCB
      real(kind=kind_phys),    dimension (its:ite,kts:kte) :: c0t3d    ! hli for smoke/dust wet scavenging
-!$acc declare create(pmin_lev,start_level,ktopkeep,dtempdz,k_inv_layers,c0,c0t3d)
+!$acc declare create(pmin_lev,start_level,ktopkeep,dtempdz,k_inv_layers,c0,rrfs_factor,c0t3d)
 
 ! rainevap from sas
      real(kind=kind_phys) zuh2(40)
@@ -486,6 +486,7 @@ subroutine cu_gf_deep_run(        &
 ! Set cloud water to rain water conversion rate (c0)
 !$acc kernels
       c0(:)=0.004
+      rrfs_factor(:)=1.
       do i=its,itf
          xland1(i)=int(xland(i)+.0001) ! 1.
          if(xland(i).gt.1.5 .or. xland(i).lt.0.5)then
@@ -495,6 +496,7 @@ subroutine cu_gf_deep_run(        &
          if(imid.eq.1)then
            c0(i)=0.002
          endif
+         if(kdt.le.(4500./dtime))rrfs_factor(i)=1.-(float(kdt)/(4500./dtime)-1.)**2
       enddo
 !$acc end kernels
 
@@ -591,7 +593,6 @@ subroutine cu_gf_deep_run(        &
          sig(i)=(1.-frh)**2
          !frh_out(i) = frh
          if(forcing(i,7).eq.0.)sig(i)=1.
-         if(kdt.le.(3600./dtime))sig(i)=1.
          frh_out(i) = frh*sig(i)
       enddo
 !$acc end kernels
@@ -2029,7 +2030,7 @@ subroutine cu_gf_deep_run(        &
             zuo,pre,pwo_ens,xmb,ktop,                                    &
             edto,pwdo,'deep',ierr2,ierr3,                                &
             po_cup,pr_ens,maxens3,                                       &
-            sig,closure_n,xland1,xmbm_in,xmbs_in,                        &
+            sig,closure_n,xland1,xmbm_in,xmbs_in,rrfs_factor,            &
             ichoice,imid,ipr,itf,ktf,                                    &
             its,ite, kts,kte,                                            &
             dicycle,xf_dicycle )
@@ -4056,7 +4057,7 @@ subroutine cup_output_ens_3d(xff_mid,xf_ens,ierr,dellat,dellaq,dellaqc,  &
               zu,pre,pw,xmb,ktop,                                           &
               edt,pwd,name,ierr2,ierr3,p_cup,pr_ens,                        &
               maxens3,                                                      &
-              sig,closure_n,xland1,xmbm_in,xmbs_in,                         &
+              sig,closure_n,xland1,xmbm_in,xmbs_in,rrfs_factor,             &
               ichoice,imid,ipr,itf,ktf,                                     &
               its,ite, kts,kte,                                             &
               dicycle,xf_dicycle )
@@ -4118,7 +4119,7 @@ subroutine cup_output_ens_3d(xff_mid,xf_ens,ierr,dellat,dellaq,dellaqc,  &
         ,intent (inout)                   ::                           &
         ierr,ierr2,ierr3
      integer, intent(in) :: dicycle
-     real(kind=kind_phys),    intent(in), dimension (its:ite) :: xf_dicycle
+     real(kind=kind_phys),    intent(in), dimension (its:ite) :: xf_dicycle, rrfs_factor
 !$acc declare copyin(zu,pwd,p_cup,sig,xmbm_in,xmbs_in,edt,xff_mid,dellat,dellaqc,dellaq,pw,ktop,xland1,xf_dicycle)
 !$acc declare copy(xf_ens,pr_ens,outtem,outq,outqc,pre,xmb,closure_n,ierr,ierr2,ierr3)
 !
@@ -4198,6 +4199,7 @@ subroutine cup_output_ens_3d(xff_mid,xf_ens,ierr,dellat,dellaq,dellaqc,  &
          clos_wei=16./max(1.,closure_n(i))
          xmb_ave(i)=min(xmb_ave(i),100.)
          xmb(i)=clos_wei*sig(i)*xmb_ave(i)
+         if(dx(i)<dx_thresh) xmb(i)=rrfs_factor(i)*xmb(i)
 
            if(xmb(i) < 1.e-16)then
               ierr(i)=19

physics/CONV/Grell_Freitas/cu_gf_driver.F90

@@ -883,6 +883,13 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,&
                  cutenm(i)=0.
               endif   ! pret > 0
 
+              maxupmf(i)=0.
+              if(forcing2(i,6).gt.0.)then
+                maxupmf(i)=maxval(xmb(i)*zu(i,kts:ktf)/forcing2(i,6))
+              endif
+              if (xland(i)==0)then ! cu precip rate (mm/h)
+                 if((maxupmf(i).lt.0.1) .or. (pret(i)*3600.lt.0.05)) pret(i)=0.
+              endif
               if(pret(i).gt.0.)then
                  cuten(i)=1.
                  cutenm(i)=0.
@@ -999,10 +1006,6 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,&
             gdc(i,15,10)=qfx(i)
             gdc(i,16,10)=pret(i)*3600.
 
-            maxupmf(i)=0.
-            if(forcing2(i,6).gt.0.)then
-              maxupmf(i)=maxval(xmb(i)*zu(i,kts:ktf)/forcing2(i,6))
-            endif
 
             if(ktop(i).gt.2 .and.pret(i).gt.0.)dt_mf(i,ktop(i)-1)=ud_mf(i,ktop(i))
             endif

physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.F90

@@ -208,7 +208,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,&
       real(kind=kind_phys), dimension(:,:,:), intent(out) :: faerlw1,&
                                                              faerlw2,&
                                                              faerlw3
-      real(kind=kind_phys), dimension(:,:),   intent(out) :: alpha
+      real(kind=kind_phys), dimension(:,:),   intent(out), optional :: alpha
       character(len=*), intent(out) :: errmsg
       integer,          intent(out) :: errflg
 

physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.meta

@@ -1474,6 +1474,7 @@
   type = real
   kind = kind_phys
   intent = out
+  optional = True
 [top_at_1]
   standard_name = flag_for_vertical_ordering_in_radiation
   long_name = flag for vertical ordering in radiation

physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_post.F90

@@ -23,22 +23,22 @@ module GFS_surface_composites_post
 !! \htmlinclude GFS_surface_composites_post_run.html
 !!
    subroutine GFS_surface_composites_post_run (                                                                                   &
-      im, kice, km, rd, rvrdm1, cplflx, cplwav2atm, frac_grid, flag_cice, thsfc_loc, islmsk, dry, wet, icy, wind, t1, q1, prsl1,  &
+      im, kice, km, rd, rvrdm1, cplflx, cplwav2atm, cpl_fire, frac_grid, flag_cice, thsfc_loc, islmsk, dry, wet, icy, wind, t1, q1, prsl1,  &
       landfrac, lakefrac, oceanfrac, zorl, zorlo, zorll, zorli, garea, frac_ice,                                                  &
       cd, cd_wat, cd_lnd, cd_ice, cdq, cdq_wat, cdq_lnd, cdq_ice, rb, rb_wat, rb_lnd, rb_ice, stress, stress_wat, stress_lnd,     &
       stress_ice, ffmm, ffmm_wat, ffmm_lnd, ffmm_ice, ffhh, ffhh_wat, ffhh_lnd, ffhh_ice, uustar, uustar_wat, uustar_lnd,         &
       uustar_ice, fm10, fm10_wat, fm10_lnd, fm10_ice, fh2, fh2_wat, fh2_lnd, fh2_ice, tsurf_wat, tsurf_lnd, tsurf_ice,            &
       cmm, cmm_wat, cmm_lnd, cmm_ice, chh, chh_wat, chh_lnd, chh_ice, gflx, gflx_wat, gflx_lnd, gflx_ice, ep1d, ep1d_wat,         &
       ep1d_lnd, ep1d_ice, weasd, weasd_lnd, weasd_ice, snowd, snowd_lnd, snowd_ice, tprcp, tprcp_wat,                             &
-      tprcp_lnd, tprcp_ice, evap, evap_wat, evap_lnd, evap_ice, hflx, hflx_wat, hflx_lnd, hflx_ice, qss, qss_wat, qss_lnd,        &
-      qss_ice, tsfc, tsfco, tsfcl, tsfc_wat, tisfc, hice, cice, tiice,                                                            &
+      tprcp_lnd, tprcp_ice, evap, evap_wat, evap_lnd, evap_ice, hflx, hflx_wat, hflx_lnd, hflx_ice, hflx_fire, evap_fire,         &
+      qss, qss_wat, qss_lnd, qss_ice, tsfc, tsfco, tsfcl, tsfc_wat, tisfc, hice, cice, tiice,                                     &
       sigmaf, zvfun, lheatstrg, h0facu, h0facs, hflxq, hffac, stc, lkm, iopt_lake, iopt_lake_clm, use_lake_model,                                                               &
       grav, prsik1, prslk1, prslki, z1, ztmax_wat, ztmax_lnd, ztmax_ice, huge, errmsg, errflg)
 
       implicit none
 
       integer,                              intent(in) :: im, kice, km, lkm, iopt_lake, iopt_lake_clm
-      logical,                              intent(in) :: cplflx, frac_grid, cplwav2atm, frac_ice
+      logical,                              intent(in) :: cplflx, frac_grid, cplwav2atm, frac_ice, cpl_fire
       logical,                              intent(in) :: lheatstrg
       logical, dimension(:),                intent(in) :: flag_cice, dry, icy
       logical, dimension(:),                intent(in) :: wet
@@ -51,6 +51,7 @@ subroutine GFS_surface_composites_post_run (
         snowd_lnd, snowd_ice, tprcp_wat, tprcp_lnd, tprcp_ice, evap_wat, evap_lnd, evap_ice, hflx_wat, hflx_lnd,                &
         hflx_ice, qss_wat, qss_lnd, qss_ice, tsfc_wat, zorlo, zorll, zorli, garea
 
+      real(kind=kind_phys), dimension(:),   intent(in), optional :: hflx_fire, evap_fire
       real(kind=kind_phys), dimension(:),   intent(inout) :: zorl, cd, cdq, rb, stress, ffmm, ffhh, uustar, fm10,               &
         fh2, cmm, chh, gflx, ep1d, weasd, snowd, tprcp, evap, hflx, qss, tsfc, tsfco, tsfcl, tisfc
 
@@ -275,6 +276,10 @@ subroutine GFS_surface_composites_post_run (
           else if (islmsk(i) == 1) then
           !-- land
             call composite_land
+            if (cpl_fire) then
+              hflx(i)   = hflx(i) + hflx_fire(i)
+              evap(i)   = evap(i) + evap_fire(i)
+            endif
           elseif (islmsk(i) == 0) then
           !-- water
             call composite_wet

physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_post.meta

@@ -816,6 +816,31 @@
   type = real
   kind = kind_phys
   intent = in
+[hflx_fire]
+  standard_name = kinematic_surface_upward_sensible_heat_flux_of_fire
+  long_name = kinematic surface upward sensible heat flux of fire
+  units = K m s-1
+  dimensions = (horizontal_loop_extent)
+  type = real
+  kind = kind_phys
+  intent = in
+  optional = True
+[evap_fire]
+  standard_name = surface_upward_specific_humidity_flux_of_fire
+  long_name = kinematic surface upward latent heat flux of fire
+  units = kg kg-1 m s-1
+  dimensions = (horizontal_loop_extent)
+  type = real
+  kind = kind_phys
+  intent = in
+  optional = True
+[cpl_fire]
+  standard_name = do_fire_coupling
+  long_name = flag controlling fire_behavior collection (default off)
+  units = flag
+  dimensions = ()
+  type = logical
+  intent = in
 [qss]
   standard_name = surface_specific_humidity
   long_name = surface air saturation specific humidity

physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_post.F90

@@ -45,7 +45,7 @@ end subroutine GFS_surface_generic_post_init
 !> \section arg_table_GFS_surface_generic_post_run Argument Table
 !! \htmlinclude GFS_surface_generic_post_run.html
 !!
-      subroutine GFS_surface_generic_post_run (im, cplflx, cplaqm, cplchm, cplwav, cpllnd, lssav, dry, icy, wet,                    &
+      subroutine GFS_surface_generic_post_run (im, cplflx, cplaqm, cplchm, cplwav, cpllnd, cpl_fire, lssav, dry, icy, wet,          &
         lsm, lsm_noahmp, dtf, ep1d, gflx, tgrs_1, qgrs_1, ugrs_1, vgrs_1,                                                           &
         adjsfcdlw, adjsfcdsw, adjnirbmd, adjnirdfd, adjvisbmd, adjvisdfd, adjsfculw, adjsfculw_wat, adjnirbmu, adjnirdfu,           &
         adjvisbmu, adjvisdfu, t2m, q2m, u10m, v10m, tsfc, tsfc_wat, pgr, xcosz, evbs, evcw, trans, sbsno, snowc, snohf, pah, pahi,  &
@@ -59,7 +59,7 @@ subroutine GFS_surface_generic_post_run (im, cplflx, cplaqm, cplchm, cplwav, cpl
         implicit none
 
         integer,                                intent(in) :: im
-        logical,                                intent(in) :: cplflx, cplaqm, cplchm, cplwav, cpllnd, lssav
+        logical,                                intent(in) :: cplflx, cplaqm, cplchm, cplwav, cpllnd, cpl_fire, lssav
         logical, dimension(:),                  intent(in) :: dry, icy, wet
         integer,                                intent(in) :: lsm, lsm_noahmp
         real(kind=kind_phys),                   intent(in) :: dtf
@@ -136,9 +136,20 @@ subroutine GFS_surface_generic_post_run (im, cplflx, cplaqm, cplchm, cplwav, cpl
             dswsfci_cpl (i) = adjsfcdsw(i)
             dlwsfc_cpl  (i) = dlwsfc_cpl(i) + adjsfcdlw(i)*dtf
             dswsfc_cpl  (i) = dswsfc_cpl(i) + adjsfcdsw(i)*dtf
+          enddo
+        endif
+
+        if (cplflx .or. cpllnd .or. cpl_fire) then
+          do i=1,im
             psurfi_cpl  (i) = pgr(i)
           enddo
         endif
+        if (cplflx .or. cpl_fire) then
+          do i=1,im
+            t2mi_cpl    (i) = t2m(i)
+            q2mi_cpl    (i) = q2m(i)
+          enddo
+        endif
 
         if (cplflx) then
           do i=1,im
@@ -155,8 +166,6 @@ subroutine GFS_surface_generic_post_run (im, cplflx, cplaqm, cplchm, cplwav, cpl
               nlwsfci_cpl(i) = adjsfcdlw(i) - adjsfculw_wat(i)
             endif
             nlwsfc_cpl  (i) = nlwsfc_cpl(i) + nlwsfci_cpl(i)*dtf
-            t2mi_cpl    (i) = t2m(i)
-            q2mi_cpl    (i) = q2m(i)
           enddo
         endif
 

physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_post.meta

@@ -126,6 +126,13 @@
   dimensions = ()
   type = logical
   intent = in
+[cpl_fire]
+  standard_name = do_fire_coupling
+  long_name = flag controlling fire_behavior collection (default off)
+  units = flag
+  dimensions = ()
+  type = logical
+  intent = in
 [lssav]
   standard_name = flag_for_diagnostics
   long_name = logical flag for storing diagnostics

physics/Interstitials/UFS_SCM_NEPTUNE/gcycle.F90

@@ -107,7 +107,7 @@ subroutine gcycle (me, nthrds, nx, ny, isc, jsc, nsst, tile_num, nlunit, fn_nml,
     real (kind=kind_io8) :: min_ice(nx*ny)
     integer              :: i_indx(nx*ny), j_indx(nx*ny)
     character(len=6)     :: tile_num_ch
-    real(kind=kind_phys) :: sig1t
+    real(kind=kind_phys) :: sig1t(nx*ny)
     integer              :: npts, nb, ix, jx, ls, ios, ll
     logical              :: exists
 

physics/Interstitials/UFS_SCM_NEPTUNE/sgscloud_radpre.F90

@@ -55,7 +55,7 @@ subroutine sgscloud_radpre_run(    &
            nlay, plyr, xlat, dz,de_lgth, &
            cldsa,mtopa,mbota,            &
            imp_physics, imp_physics_gfdl,&
-           imp_physics_fa,               &
+           imp_physics_fa, conv_cf_opt,  &
            iovr,                         &
            errmsg, errflg                )
 
@@ -75,7 +75,7 @@ subroutine sgscloud_radpre_run(    &
       real(kind=kind_phys)             :: gfac
       integer,             intent(in)  :: im, levs, imfdeepcnv, imfdeepcnv_gf, &
            &  nlay, imfdeepcnv_sas, imfdeepcnv_c3, imp_physics, & 
-           &  imp_physics_gfdl, imp_physics_fa
+           &  imp_physics_gfdl, imp_physics_fa, conv_cf_opt
       logical,             intent(in)  :: flag_init, flag_restart, do_mynnedmf
 
       real(kind=kind_phys), dimension(:,:), intent(inout) :: qc, qi
@@ -120,9 +120,6 @@ subroutine sgscloud_radpre_run(    &
       real :: a, f, sigq, qmq, qt, xl, th, thl, rsl, cpm, cb_cf
       real(kind=kind_phys) :: tlk
 
-      !Option to convective cloud fraction
-      integer, parameter :: conv_cf_opt = 0  !0: C-B, 1: X-R
-
       ! Initialize CCPP error handling variables
       errmsg = ''
       errflg = 0

physics/Interstitials/UFS_SCM_NEPTUNE/sgscloud_radpre.meta

@@ -275,6 +275,13 @@
   dimensions = ()
   type = integer
   intent = in
+[conv_cf_opt]
+  standard_name = option_for_convection_scheme_cloud_fraction_computation 
+  long_name = option for convection scheme cloud fraction computation
+  units = flag
+  dimensions = ()
+  type = integer
+  intent = in
 [qc_save]
   standard_name = cloud_condensed_water_mixing_ratio_save
   long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) before entering a physics scheme

physics/MP/Morrison_Gettelman/aerinterp.F90

@@ -282,7 +282,7 @@ SUBROUTINE aerinterpol( me,master,nthrds,npts,IDATE,FHOUR,iflip, jindx1,jindx2,
       character(*), intent(inout) :: errmsg
       integer, intent(in) :: iflip
       integer   i1,i2, iday,j,j1,j2,l,npts,nc,n1,n2,lev,k,i,ii, klev
-      real(kind=kind_phys) fhour,temj, tx1, tx2,temi, tem
+      real(kind=kind_phys) fhour,temj, tx1, tx2,temi, tem, tem1, tem2
       real(kind=kind_phys), dimension(npts) :: temij,temiy,temjx,ddxy
 
 !
@@ -363,10 +363,9 @@ SUBROUTINE aerinterpol( me,master,nthrds,npts,IDATE,FHOUR,iflip, jindx1,jindx2,
 !$OMP parallel num_threads(nthrds) default(none)             &
 !$OMP          shared(npts,ntrcaer,aerin,aer_pres,prsl)      &
 !$OMP          shared(ddx,ddy,jindx1,jindx2,iindx1,iindx2)   &
-!$OMP          shared(aerpm,aerpres,aerout,lev,nthrds) &
-!$OMP          shared(temij,temiy,temjx,ddxy)                &
-!$OMP          private(l,j,k,ii,i1,i2,j1,j2,tem)             &
-!$OMP          copyin(tx1,tx2) firstprivate(tx1,tx2)
+!$OMP          shared(aerpm,aerpres,aerout,lev,nthrds)       &
+!$OMP          shared(temij,temiy,temjx,ddxy,tx1,tx2)        &
+!$OMP          private(l,j,k,ii,i1,i2,j1,j2,tem,tem1,tem2)
 
 !$OMP do
 #endif
@@ -416,10 +415,10 @@ SUBROUTINE aerinterpol( me,master,nthrds,npts,IDATE,FHOUR,iflip, jindx1,jindx2,
               ENDIF
              ENDDO
              tem  = 1.0 / (aerpres(j,i1) - aerpres(j,i2))
-             tx1  = (prsl(j,L) - aerpres(j,i2)) * tem
-             tx2  = (aerpres(j,i1) - prsl(j,L)) * tem
+             tem1  = (prsl(j,L) - aerpres(j,i2)) * tem
+             tem2  = (aerpres(j,i1) - prsl(j,L)) * tem
              DO ii = 1, ntrcaer
-               aerout(j,L,ii) = aerpm(j,i1,ii)*tx1 + aerpm(j,i2,ii)*tx2
+               aerout(j,L,ii) = aerpm(j,i1,ii)*tem1 + aerpm(j,i2,ii)*tem2
              ENDDO
            endif
         ENDDO   !L-loop