HWRF Ferrier-Aligo MP scheme updates

CODEOWNERS

@@ -3,7 +3,7 @@
 
 # These owners will be the default owners for everything in the repo.
 #*       @defunkt
-*       @climbfuji @llpcarson @grantfirl @JulieSchramm
+*       @climbfuji @llpcarson @grantfirl @mzhangw
 
 # Order is important. The last matching pattern has the most precedence.
 # So if a pull request only touches javascript files, only these owners

physics/GFS_MP_generic.F90

@@ -191,11 +191,11 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt
       end if
 
       if (lsm==lsm_ruc .or. lsm==lsm_noahmp) then
-            raincprv(:)   = rainc(:)
-            rainncprv(:)  = frain * rain1(:)
-            iceprv(:)     = ice(:)
-            snowprv(:)    = snow(:)
-            graupelprv(:) = graupel(:)
+        raincprv(:)   = rainc(:)
+        rainncprv(:)  = frain * rain1(:)
+        iceprv(:)     = ice(:)
+        snowprv(:)    = snow(:)
+        graupelprv(:) = graupel(:)
         !for NoahMP, calculate precipitation rates from liquid water equivalent thickness for use in next time step
         !Note (GJF): Precipitation LWE thicknesses are multiplied by the frain factor, and are thus on the dynamics time step, but the conversion as written
         !            (with dtp in the denominator) assumes the rate is calculated on the physics time step. This only works as expected when dtf=dtp (i.e. when frain=1).
@@ -341,8 +341,10 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt
 
       if (cplflx .or. cplchm) then
         do i = 1, im
-          rain_cpl(i) = rain_cpl(i) + rain(i) * (one-srflag(i))
-          snow_cpl(i) = snow_cpl(i) + rain(i) * srflag(i)
+          drain_cpl(i) = rain(i) * (one-srflag(i))
+          dsnow_cpl(i) = rain(i) * srflag(i)
+          rain_cpl(i) = rain_cpl(i) + drain_cpl(i)
+          snow_cpl(i) = snow_cpl(i) + dsnow_cpl(i)
         enddo
       endif
 
@@ -376,15 +378,6 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt
       if (do_sppt) then
 !--- radiation heating rate
         dtdtr(1:im,:) = dtdtr(1:im,:) + dtdtc(1:im,:)*dtf
-        do i = 1, im
-          if (t850(i) > 273.16) then
-!--- change in change in rain precip
-             drain_cpl(i) = rain(i) - drain_cpl(i)
-          else
-!--- change in change in snow precip
-             dsnow_cpl(i) = rain(i) - dsnow_cpl(i)
-          endif
-        enddo
       endif
 
     end subroutine GFS_MP_generic_post_run

physics/GFS_PBL_generic.F90

@@ -331,7 +331,10 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac,
       character(len=*), intent(out) :: errmsg
       integer, intent(out) :: errflg
 
-      real(kind=kind_phys), parameter :: huge=1.0d30, epsln = 1.0d-10
+      real(kind=kind_phys), parameter :: zero  = 0.0d0
+      real(kind=kind_phys), parameter :: one   = 1.0d0
+      real(kind=kind_phys), parameter :: huge  = 9.9692099683868690E36 ! NetCDF float FillValue, same as in GFS_typedefs.F90
+      real(kind=kind_phys), parameter :: epsln = 1.0d-10 ! same as in GFS_physics_driver.F90
       integer :: i, k, kk, k1, n
       real(kind=kind_phys) :: tem, tem1, rho
 
@@ -486,7 +489,7 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac,
       if (cplchm) then
         do i = 1, im
           tem1 = max(q1(i), 1.e-8)
-          tem  = prsl(i,1) / (rd*t1(i)*(1.0+fvirt*tem1))
+          tem  = prsl(i,1) / (rd*t1(i)*(one+fvirt*tem1))
           ushfsfci(i) = -cp * tem * hflx(i) ! upward sensible heat flux
         enddo
         ! dkt_cpl has dimensions (1:im,1:levs), but dkt has (1:im,1:levs-1)
@@ -498,22 +501,22 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac,
 
       if (cplflx) then
         do i=1,im
-          if (oceanfrac(i) > 0.0) then ! Ocean only, NO LAKES
-            if (fice(i) > 1.-epsln) then ! no open water, use results from CICE
+          if (oceanfrac(i) > zero) then ! Ocean only, NO LAKES
+            if (fice(i) > one - epsln) then ! no open water, use results from CICE
               dusfci_cpl(i) = dusfc_cice(i)
               dvsfci_cpl(i) = dvsfc_cice(i)
               dtsfci_cpl(i) = dtsfc_cice(i)
               dqsfci_cpl(i) = dqsfc_cice(i)
-            elseif (dry(i) .or. icy(i)) then   ! use stress_ocean from sfc_diff for opw component at mixed point
+            elseif (icy(i) .or. dry(i)) then ! use stress_ocean from sfc_diff for opw component at mixed point
               tem1 = max(q1(i), 1.e-8)
-              rho = prsl(i,1) / (rd*t1(i)*(1.0+fvirt*tem1))
-              if (wind(i) > 0.0) then
+              rho = prsl(i,1) / (rd*t1(i)*(one+fvirt*tem1))
+              if (wind(i) > zero) then
                 tem = - rho * stress_ocn(i) / wind(i)
                 dusfci_cpl(i) = tem * ugrs1(i)   ! U-momentum flux
                 dvsfci_cpl(i) = tem * vgrs1(i)   ! V-momentum flux
               else
-                dusfci_cpl(i) = 0.0
-                dvsfci_cpl(i) = 0.0
+                dusfci_cpl(i) = zero
+                dvsfci_cpl(i) = zero
               endif
               dtsfci_cpl(i) = cp   * rho * hflx_ocn(i) ! sensible heat flux over open ocean
               dqsfci_cpl(i) = hvap * rho * evap_ocn(i) ! latent heat flux over open ocean

physics/GFS_PBL_generic.meta

@@ -1089,35 +1089,35 @@
   intent = in
   optional = F
 [dusfc_cice]
-  standard_name = surface_x_momentum_flux_for_coupling_interstitial
-  long_name = sfc x momentum flux for coupling interstitial
+  standard_name = surface_x_momentum_flux_for_coupling
+  long_name = sfc x momentum flux for coupling
   units = Pa
   dimensions = (horizontal_dimension)
   type = real
   kind = kind_phys
   intent = in
   optional = F
 [dvsfc_cice]
-  standard_name = surface_y_momentum_flux_for_coupling_interstitial
-  long_name = sfc y momentum flux for coupling interstitial
+  standard_name = surface_y_momentum_flux_for_coupling
+  long_name = sfc y momentum flux for coupling
   units = Pa
   dimensions = (horizontal_dimension)
   type = real
   kind = kind_phys
   intent = in
   optional = F
 [dtsfc_cice]
-  standard_name = surface_upward_sensible_heat_flux_for_coupling_interstitial
-  long_name = sfc sensible heat flux for coupling interstitial
+  standard_name = surface_upward_sensible_heat_flux_for_coupling
+  long_name = sfc sensible heat flux for coupling
   units = W m-2
   dimensions = (horizontal_dimension)
   type = real
   kind = kind_phys
   intent = in
   optional = F
 [dqsfc_cice]
-  standard_name = surface_upward_latent_heat_flux_for_coupling_interstitial
-  long_name = sfc latent heat flux for coupling interstitial
+  standard_name = surface_upward_latent_heat_flux_for_coupling
+  long_name = sfc latent heat flux for coupling
   units = W m-2
   dimensions = (horizontal_dimension)
   type = real

physics/GFS_debug.F90

@@ -18,6 +18,7 @@ module GFS_diagtoscreen
 
       interface print_var
         module procedure print_logic_0d
+        module procedure print_logic_1d
         module procedure print_int_0d
         module procedure print_int_1d
         module procedure print_real_0d
@@ -116,6 +117,7 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling,
          do impi=0,mpisize-1
              do iomp=0,ompsize-1
                  if (mpirank==impi .and. omprank==iomp) then
+                     call print_var(mpirank,omprank, blkno, 'Model%kdt'        , Model%kdt)
                      ! Sfcprop
                      call print_var(mpirank,omprank, blkno, 'Sfcprop%slmsk'    , Sfcprop%slmsk)
                      call print_var(mpirank,omprank, blkno, 'Sfcprop%oceanfrac', Sfcprop%oceanfrac)
@@ -402,7 +404,12 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling,
                         call print_var(mpirank,omprank, blkno, 'Coupling%rain_cpl', Coupling%rain_cpl)
                         call print_var(mpirank,omprank, blkno, 'Coupling%snow_cpl', Coupling%snow_cpl)
                      end if
+                     if (Model%cplwav2atm) then
+                        call print_var(mpirank,omprank, blkno, 'Coupling%zorlwav_cpl' , Coupling%zorlwav_cpl  )
+                     end if
                      if (Model%cplflx) then
+                        call print_var(mpirank,omprank, blkno, 'Coupling%oro_cpl'     , Coupling%oro_cpl      )
+                        call print_var(mpirank,omprank, blkno, 'Coupling%slmsk_cpl'   , Coupling%slmsk_cpl    )
                         call print_var(mpirank,omprank, blkno, 'Coupling%slimskin_cpl', Coupling%slimskin_cpl )
                         call print_var(mpirank,omprank, blkno, 'Coupling%dusfcin_cpl ', Coupling%dusfcin_cpl  )
                         call print_var(mpirank,omprank, blkno, 'Coupling%dvsfcin_cpl ', Coupling%dvsfcin_cpl  )
@@ -466,11 +473,24 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling,
                         call print_var(mpirank,omprank, blkno, 'Coupling%shum_wts', Coupling%shum_wts)
                      end if
                      if (Model%do_skeb) then
-                        call print_var(mpirank,omprank, blkno, 'Coupling%skebu_wts', Coupling%skebu_wts)
-                        call print_var(mpirank,omprank, blkno, 'Coupling%skebv_wts', Coupling%skebv_wts)
+                        call print_var(mpirank,omprank, blkno, 'Coupling%skebu_wts', Coupling%skebu_wts )
+                        call print_var(mpirank,omprank, blkno, 'Coupling%skebv_wts', Coupling%skebv_wts )
                      end if
                      if (Model%do_sfcperts) then
-                        call print_var(mpirank,omprank, blkno, 'Coupling%sfc_wts', Coupling%sfc_wts)
+                        call print_var(mpirank,omprank, blkno, 'Coupling%sfc_wts'  , Coupling%sfc_wts   )
+                     end if
+                     if (Model%do_ca) then
+                        call print_var(mpirank,omprank, blkno, 'Coupling%tconvtend', Coupling%tconvtend )
+                        call print_var(mpirank,omprank, blkno, 'Coupling%qconvtend', Coupling%qconvtend )
+                        call print_var(mpirank,omprank, blkno, 'Coupling%uconvtend', Coupling%uconvtend )
+                        call print_var(mpirank,omprank, blkno, 'Coupling%vconvtend', Coupling%vconvtend )
+                        call print_var(mpirank,omprank, blkno, 'Coupling%ca_out   ', Coupling%ca_out    )
+                        call print_var(mpirank,omprank, blkno, 'Coupling%ca_deep  ', Coupling%ca_deep   )
+                        call print_var(mpirank,omprank, blkno, 'Coupling%ca_turb  ', Coupling%ca_turb   )
+                        call print_var(mpirank,omprank, blkno, 'Coupling%ca_shal  ', Coupling%ca_shal   )
+                        call print_var(mpirank,omprank, blkno, 'Coupling%ca_rad   ', Coupling%ca_rad    )
+                        call print_var(mpirank,omprank, blkno, 'Coupling%ca_micro ', Coupling%ca_micro  )
+                        call print_var(mpirank,omprank, blkno, 'Coupling%cape     ', Coupling%cape      )
                      end if
                      if(Model%imp_physics == Model%imp_physics_thompson .and. Model%ltaerosol) then
                         call print_var(mpirank,omprank, blkno, 'Coupling%nwfa2d', Coupling%nwfa2d)
@@ -539,6 +559,30 @@ subroutine print_int_0d(mpirank,omprank,blkno,name,var)
 
       end subroutine print_int_0d
 
+      subroutine print_logic_1d(mpirank,omprank,blkno,name,var)
+
+          use machine,               only: kind_phys
+
+          implicit none
+
+          integer, intent(in) :: mpirank, omprank, blkno
+          character(len=*), intent(in) :: name
+          logical, intent(in) :: var(:)
+
+          integer :: i
+
+#ifdef PRINT_SUM
+          write(0,'(2a,3i6,2i8)') 'XXX: ', trim(name), mpirank, omprank, blkno, size(var), count(var)
+#elif defined(PRINT_CHKSUM)
+          write(0,'(2a,3i6,2i8)') 'XXX: ', trim(name), mpirank, omprank, blkno, size(var), count(var)
+#else
+          do i=ISTART,min(IEND,size(var(:)))
+              write(0,'(2a,3i6,i6,1x,l)') 'XXX: ', trim(name), mpirank, omprank, blkno, i, var(i)
+          end do
+#endif
+
+      end subroutine print_logic_1d
+
       subroutine print_int_1d(mpirank,omprank,blkno,name,var)
 
           use machine,               only: kind_phys