Merge pull request #388 from climbfuji/update_dtc_develop_from_master

dtc/develop: update from master 2020/01/27

physics/GFS_DCNV_generic.F90

@@ -17,17 +17,17 @@ end subroutine GFS_DCNV_generic_pre_finalize
 !! \htmlinclude GFS_DCNV_generic_pre_run.html
 !!
 #endif
-    subroutine GFS_DCNV_generic_pre_run (im, levs, ldiag3d, do_cnvgwd, do_ca,        &
+    subroutine GFS_DCNV_generic_pre_run (im, levs, ldiag3d, do_cnvgwd, do_ca, cplchm,&
                                          isppt_deep, gu0, gv0, gt0, gq0_water_vapor, &
                                          save_u, save_v, save_t, save_qv, ca_deep,   &
-                                         errmsg, errflg)
+                                         dqdti, errmsg, errflg)
 
-      use machine,               only: kind_phys
+      use machine, only: kind_phys
 
       implicit none
 
       integer, intent(in) :: im, levs
-      logical, intent(in) :: ldiag3d, do_cnvgwd, do_ca, isppt_deep
+      logical, intent(in) :: ldiag3d, do_cnvgwd, do_ca, cplchm, isppt_deep
       real(kind=kind_phys), dimension(im,levs), intent(in)    :: gu0
       real(kind=kind_phys), dimension(im,levs), intent(in)    :: gv0
       real(kind=kind_phys), dimension(im,levs), intent(in)    :: gt0
@@ -37,9 +37,12 @@ subroutine GFS_DCNV_generic_pre_run (im, levs, ldiag3d, do_cnvgwd, do_ca,
       real(kind=kind_phys), dimension(im,levs), intent(inout) :: save_t
       real(kind=kind_phys), dimension(im,levs), intent(inout) :: save_qv
       real(kind=kind_phys), dimension(im),      intent(in)    :: ca_deep
+      ! dqdti only allocated if cplchm is .true.
+      real(kind=kind_phys), dimension(:,:),     intent(inout) :: dqdti
       character(len=*), intent(out) :: errmsg
       integer, intent(out) :: errflg
 
+      real(kind=kind_phys), parameter :: zero    = 0.0d0
       integer :: i, k
 
       ! Initialize CCPP error handling variables
@@ -70,14 +73,18 @@ subroutine GFS_DCNV_generic_pre_run (im, levs, ldiag3d, do_cnvgwd, do_ca,
         enddo
       endif
 
-      if (ldiag3d .or. isppt_deep) then
+      if (ldiag3d .or. cplchm .or. isppt_deep) then
         do k=1,levs
           do i=1,im
             save_qv(i,k) = gq0_water_vapor(i,k)
           enddo
         enddo
       endif
 
+      if (cplchm) then
+        dqdti = zero
+      endif
+
     end subroutine GFS_DCNV_generic_pre_run
 
     end module GFS_DCNV_generic_pre

physics/GFS_DCNV_generic.meta

@@ -41,6 +41,14 @@
   type = logical
   intent = in
   optional = F
+[cplchm]
+  standard_name = flag_for_chemistry_coupling
+  long_name = flag controlling cplchm collection (default off)
+  units = flag
+  dimensions = ()
+  type = logical
+  intent = in
+  optional = F
 [isppt_deep]
   standard_name = flag_for_combination_of_sppt_with_isppt_deep
   long_name = switch for combination with isppt_deep.
@@ -130,6 +138,15 @@
   kind = kind_phys
   intent = in
   optional = F
+[dqdti]
+  standard_name = instantaneous_water_vapor_specific_humidity_tendency_due_to_convection
+  long_name = instantaneous moisture tendency due to convection
+  units = kg kg-1 s-1
+  dimensions = (horizontal_dimension,vertical_dimension)
+  type = real
+  kind = kind_phys
+  intent = inout
+  optional = F
 [errmsg]
   standard_name = ccpp_error_message
   long_name = error message for error handling in CCPP

physics/GFS_rrtmg_post.F90

@@ -15,7 +15,7 @@ end subroutine GFS_rrtmg_post_init
 !!
       subroutine GFS_rrtmg_post_run (Model, Grid, Diag, Radtend, Statein, &
               Coupling, scmpsw, im, lm, ltp, kt, kb, kd, raddt, aerodp,   &
-              cldsa, mtopa, mbota, clouds1, cldtaulw, cldtausw,           &
+              cldsa, mtopa, mbota, clouds1, cldtaulw, cldtausw, nday,     &
               errmsg, errflg)
 
       use machine,                             only: kind_phys
@@ -41,7 +41,7 @@ subroutine GFS_rrtmg_post_run (Model, Grid, Diag, Radtend, Statein, &
       type(GFS_diag_type),                 intent(inout) :: Diag
       type(cmpfsw_type), dimension(size(Grid%xlon,1)), intent(in) :: scmpsw
 
-      integer,              intent(in) :: im, lm, ltp, kt, kb, kd
+      integer,              intent(in) :: im, lm, ltp, kt, kb, kd, nday
       real(kind=kind_phys), intent(in) :: raddt
 
       real(kind=kind_phys), dimension(size(Grid%xlon,1),NSPC1),          intent(in) :: aerodp
@@ -152,18 +152,40 @@ subroutine GFS_rrtmg_post_run (Model, Grid, Diag, Radtend, Statein, &
               Diag%fluxr(i,11-j) = Diag%fluxr(i,11-j) + tem0d * Statein%prsi(i,itop+kt)
               Diag%fluxr(i,14-j) = Diag%fluxr(i,14-j) + tem0d * Statein%prsi(i,ibtc+kb)
               Diag%fluxr(i,17-j) = Diag%fluxr(i,17-j) + tem0d * Statein%tgrs(i,itop)
+            enddo
+          enddo
 
 !       Anning adds optical depth and emissivity output
-              tem1 = 0.
-              tem2 = 0.
-              do k=ibtc,itop
-                tem1 = tem1 + cldtausw(i,k)      ! approx .55 mu channel
-                tem2 = tem2 + cldtaulw(i,k)      ! approx 10. mu channel
+          if (Model%lsswr .and. (nday > 0)) then
+            do j = 1, 3
+              do i = 1, IM
+                tem0d = raddt * cldsa(i,j)
+                itop  = mtopa(i,j) - kd
+                ibtc  = mbota(i,j) - kd
+                tem1 = 0.
+                do k=ibtc,itop
+                  tem1 = tem1 + cldtausw(i,k)      ! approx .55 um channel
+                enddo
+                Diag%fluxr(i,43-j) = Diag%fluxr(i,43-j) + tem0d * tem1
               enddo
-              Diag%fluxr(i,43-j) = Diag%fluxr(i,43-j) + tem0d * tem1
-              Diag%fluxr(i,46-j) = Diag%fluxr(i,46-j) + tem0d * (1.0-exp(-tem2))
             enddo
-          enddo
+          endif
+
+          if (Model%lslwr) then
+            do j = 1, 3
+              do i = 1, IM
+                tem0d = raddt * cldsa(i,j)
+                itop  = mtopa(i,j) - kd
+                ibtc  = mbota(i,j) - kd
+                tem2 = 0.
+                do k=ibtc,itop
+                  tem2 = tem2 + cldtaulw(i,k)      ! approx 10. um channel
+                enddo
+                Diag%fluxr(i,46-j) = Diag%fluxr(i,46-j) + tem0d * (1.0-exp(-tem2))
+              enddo
+            enddo
+          endif
+
         endif
 
       endif                                ! end_if_lssav

physics/GFS_rrtmg_post.meta

@@ -180,6 +180,14 @@
   kind = kind_phys
   intent = in
   optional = F
+[nday]
+  standard_name = daytime_points_dimension
+  long_name = daytime points dimension
+  units = count
+  dimensions = ()
+  type = integer
+  intent = in
+  optional = F
 [errmsg]
   standard_name = ccpp_error_message
   long_name = error message for error handling in CCPP

physics/GFS_surface_generic.F90

@@ -187,10 +187,11 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc,
 
       if (cplflx) then
         do i=1,im
-          islmsk_cice(i) = int(slimskin_cpl(i)+0.5)
-          if(islmsk_cice(i) == 4)then
-            flag_cice(i)   = .true.
-            ulwsfc_cice(i) = ulwsfcin_cpl(i)
+          islmsk_cice(i) = nint(slimskin_cpl(i))
+          flag_cice(i)   = (islmsk_cice(i) == 4)
+
+          if (flag_cice(i)) then
+!           ulwsfc_cice(i) = ulwsfcin_cpl(i)
             dusfc_cice(i)  = dusfcin_cpl(i)
             dvsfc_cice(i)  = dvsfcin_cpl(i)
             dtsfc_cice(i)  = dtsfcin_cpl(i)

physics/module_gfdl_cloud_microphys.F90

@@ -3320,7 +3320,7 @@ subroutine fall_speed (ktop, kbot, den, qs, qi, qg, ql, tk, vts, vti, vtg)
             else
                 tc (k) = tk (k) - tice
                 vti (k) = (3. + log10 (qi (k) * den (k))) * (tc (k) * (aa * tc (k) + bb) + cc) + dd * tc (k) + ee
-                vti (k) = vi0 * exp (log_10 * vti (k)) * 0.8 
+                vti (k) = vi0 * exp (log_10 * vti (k)) * 0.9
                 vti (k) = min (vi_max, max (vf_min, vti (k)))
             endif
         enddo

physics/samfdeepcnv.f

@@ -1554,22 +1554,22 @@ subroutine samfdeepcnv_run (im,ix,km,itc,ntc,cliq,cp,cvap,        &
       enddo
       enddo
       do i = 1, im
-        betamn = betas
-        if(islimsk(i) == 1) betamn = betal
-        if(ntk > 0) then
-          betamx = betamn + dbeta
-          if(tkemean(i) > tkemx) then
-            beta = betamn
-          else if(tkemean(i) < tkemn) then
-            beta = betamx
+        if(cnvflg(i)) then
+          betamn = betas
+          if(islimsk(i) == 1) betamn = betal
+          if(ntk > 0) then
+            betamx = betamn + dbeta
+            if(tkemean(i) > tkemx) then
+              beta = betamn
+            else if(tkemean(i) < tkemn) then
+              beta = betamx
+            else
+              tem = (betamx - betamn) * (tkemean(i) - tkemn)
+              beta = betamx - tem  / dtke
+            endif
           else
-            tem = (betamx - betamn) * (tkemean(i) - tkemn)
-            beta = betamx - tem  / dtke
+            beta = betamn
           endif
-        else
-          beta = betamn
-        endif
-        if(cnvflg(i)) then
           dz  = (sumx(i)+zi(i,1))/float(kbcon(i))
           tem = 1./float(kbcon(i))
           xlamd(i) = (1.-beta**tem)/dz

physics/satmedmfvdifq.F

@@ -184,7 +184,7 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke,       &
      &                     buop,    shrp,   dtn,
      &                     prnum,   prmax,  prmin,  prtke,
      &                     prscu,   pr0,    ri,
-     &                     dw2,     dw2min, zk,     
+     &                     dw2,     dw2min, zk,
      &                     elmfac,  elefac, dspmax,
      &                     alp,     clwt,   cql,
      &                     f0,      robn,   crbmin, crbmax,
@@ -193,7 +193,8 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke,       &
      &                     epsi,    beta,   chx,    cqx,
      &                     rdt,     rdz,    qmin,   qlmin,
      &                     rimin,   rbcr,   rbint,  tdzmin,
-     &                     rlmn,    rlmn1,  rlmx,   elmx,
+     &                     rlmn,    rlmn1,  rlmn2,
+     &                     rlmx,    elmx,
      &                     ttend,   utend,  vtend,  qtend,
      &                     zfac,    zfmin,  vk,     spdk2,
      &                     tkmin,   tkminx, xkzinv, xkgdx,
@@ -205,13 +206,14 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke,       &
 !
       real(kind=kind_phys) qlcr, zstblmax
 !
-      real(kind=kind_phys) h1 
+      real(kind=kind_phys) h1
 !!
       parameter(wfac=7.0,cfac=3.0)
       parameter(gamcrt=3.,gamcrq=0.,sfcfrac=0.1)
       parameter(vk=0.4,rimin=-100.)
       parameter(rbcr=0.25,zolcru=-0.02,tdzmin=1.e-3)
-      parameter(rlmn=30.,rlmn1=5.,rlmx=300.,elmx=300.)
+      parameter(rlmn=30.,rlmn1=5.,rlmn2=10.)
+      parameter(rlmx=300.,elmx=300.)
       parameter(prmin=0.25,prmax=4.0)
       parameter(pr0=1.0,prtke=1.0,prscu=0.67)
       parameter(f0=1.e-4,crbmin=0.15,crbmax=0.35)
@@ -751,8 +753,9 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke,       &
 !         if(tem1 > 1.e-5) then
           tem1 = tvx(i,k+1)-tvx(i,k)
           if(tem1 > 0.) then
-             xkzo(i,k)  = min(xkzo(i,k),xkzinv)
-             xkzmo(i,k) = min(xkzmo(i,k),xkzinv)
+             xkzo(i,k)  = min(xkzo(i,k), xkzinv)
+             xkzmo(i,k) = min(xkzmo(i,k), xkzinv)
+             rlmnz(i,k) = min(rlmnz(i,k), rlmn2)
           endif
         enddo
       enddo

physics/sflx.f

@@ -359,6 +359,7 @@ subroutine gfssflx                                                &!  ---  input
       runoff2 = 0.0
       runoff3 = 0.0
       snomlt  = 0.0
+      rc      = 0.0
 
 !  --- ...  define local variable ice to achieve:
 !             sea-ice case,          ice =  1