Merge branch 'master' of https://github.com/NCAR/ccpp-physics into HEAD

physics/GFS_PBL_generic.F90

@@ -313,8 +313,8 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac,
         dqdt, dusfc_cpl, dvsfc_cpl, dtsfc_cpl,                                                                                 &
         dqsfc_cpl, dusfci_cpl, dvsfci_cpl, dtsfci_cpl, dqsfci_cpl, dusfc_diag, dvsfc_diag, dtsfc_diag, dqsfc_diag,             &
         dusfci_diag, dvsfci_diag, dtsfci_diag, dqsfci_diag, dt3dt, du3dt_PBL, du3dt_OGWD, dv3dt_PBL, dv3dt_OGWD, dq3dt,        &
-        dq3dt_ozone, rd, cp,fvirt, hvap, t1, q1, prsl, hflx, ushfsfci, oceanfrac, fice, dusfc_cice, dvsfc_cice, dtsfc_cice,    &
-        dqsfc_cice, wet, dry, icy, wind, stress_ocn, hflx_ocn, evap_ocn, ugrs1, vgrs1, dkt_cpl, dkt, hffac, hefac,             &
+        dq3dt_ozone, rd, cp, fvirt, hvap, t1, q1, prsl, hflx, ushfsfci, oceanfrac, flag_cice, dusfc_cice, dvsfc_cice,          &
+        dtsfc_cice, dqsfc_cice, wet, dry, icy, wind, stress_wat, hflx_wat, evap_wat, ugrs1, vgrs1, dkt_cpl, dkt, hffac, hefac, &
         ugrs, vgrs, tgrs, qgrs, save_u, save_v, save_t, save_q, errmsg, errflg)
 
       use machine,                only : kind_phys
@@ -329,17 +329,18 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac,
       integer, intent(in) :: imp_physics_zhao_carr, imp_physics_mg, imp_physics_fer_hires
       logical, intent(in) :: ltaerosol, cplflx, cplchm, lssav, ldiag3d, qdiag3d, lsidea
       logical, intent(in) :: hybedmf, do_shoc, satmedmf, shinhong, do_ysu
-      logical, intent(in) :: flag_for_pbl_generic_tend
-
+      logical, dimension(:), intent(in) :: flag_cice
+
+      logical, intent(in) :: flag_for_pbl_generic_tend      
       real(kind=kind_phys), dimension(im, levs), intent(in) :: save_u, save_v, save_t
       real(kind=kind_phys), dimension(im, levs, ntrac), intent(in) :: save_q
 
       real(kind=kind_phys), intent(in) :: dtf
       real(kind=kind_phys), intent(in) :: rd, cp, fvirt, hvap
-      real(kind=kind_phys), dimension(:), intent(in) :: t1, q1, hflx, oceanfrac, fice
+      real(kind=kind_phys), dimension(:), intent(in) :: t1, q1, hflx, oceanfrac
       real(kind=kind_phys), dimension(:,:), intent(in) :: prsl
       real(kind=kind_phys), dimension(:), intent(in) :: dusfc_cice, dvsfc_cice, dtsfc_cice, dqsfc_cice, &
-          wind, stress_ocn, hflx_ocn, evap_ocn, ugrs1, vgrs1
+          wind, stress_wat, hflx_wat, evap_wat, ugrs1, vgrs1
 
       real(kind=kind_phys), dimension(im, levs, ntrac), intent(in) :: qgrs
       real(kind=kind_phys), dimension(im, levs), intent(in) :: ugrs, vgrs, tgrs
@@ -373,15 +374,14 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac,
       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
 
       ! Initialize CCPP error handling variables
       errmsg = ''
       errflg = 0
 !GJF: dvdftra is only used if nvdiff != ntrac or (nvdiff == ntrac .and. )
-      if_nvdiff_ntrac: if (nvdiff == ntrac .and. (hybedmf .or. do_shoc .or. satmedmf)) then
+      if (nvdiff == ntrac .and. (hybedmf .or. do_shoc .or. satmedmf)) then
         dqdt = dvdftra
       elseif (nvdiff /= ntrac .and. .not. shinhong .and. .not. do_ysu) then
 !
@@ -393,7 +393,7 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac,
           enddo
         endif
 !
-        if_trans_aero: if (trans_aero) then
+        if (trans_aero) then
           ! Set kk if chemistry-aerosol tracers are diffused
           call set_aerosol_tracer_index(imp_physics, imp_physics_wsm6,          &
                                         imp_physics_thompson, ltaerosol,        &
@@ -411,9 +411,9 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac,
               enddo
             enddo
           enddo
-        endif if_trans_aero
+        endif
 !
-        if_imp_physics: if (imp_physics == imp_physics_wsm6) then
+        if (imp_physics == imp_physics_wsm6) then
   ! WSM6
           do k=1,levs
             do i=1,im
@@ -525,9 +525,9 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac,
               dqdt(i,k,ntoz) = dvdftra(i,k,3)
             enddo
           enddo
-        endif if_imp_physics
+        endif
 
-      endif if_nvdiff_ntrac
+      endif ! nvdiff == ntrac
 
       if (cplchm) then
         do i = 1, im
@@ -542,27 +542,34 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac,
 
 !  --- ...  coupling insertion
 
-      if_cplflx: if (cplflx) then
+      if (cplflx) then
         do i=1,im
           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)
+            if ( .not. wet(i)) then ! no open water
+              if (flag_cice(i)) then !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)
+              else !use PBL fluxes when CICE fluxes is unavailable
+                dusfci_cpl(i) = dusfc1(i)
+                dvsfci_cpl(i) = dvsfc1(i)
+                dtsfci_cpl(i) = dtsfc1(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
               tem1 = max(q1(i), 1.e-8)
               rho = prsl(i,1) / (rd*t1(i)*(one+fvirt*tem1))
               if (wind(i) > zero) then
-                tem = - rho * stress_ocn(i) / wind(i)
+                tem = - rho * stress_wat(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) = 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
+              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
               dusfci_cpl(i) = dusfc1(i)
               dvsfci_cpl(i) = dvsfc1(i)
@@ -583,10 +590,10 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac,
 !!
           endif ! Ocean only, NO LAKES
         enddo
-      endif if_cplflx
+      endif
 
 !-------------------------------------------------------lssav if loop ----------
-      if_lssav: if (lssav) then
+      if (lssav) then
         do i=1,im
           dusfc_diag (i) = dusfc_diag(i) + dusfc1(i)*dtf
           dvsfc_diag (i) = dvsfc_diag(i) + dvsfc1(i)*dtf
@@ -598,7 +605,7 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac,
           dqsfci_diag(i) = dqsfc1(i)*hefac(i)
         enddo
 
-        if_diag: if (ldiag3d .and. flag_for_pbl_generic_tend .and. lssav) then
+        if (ldiag3d .and. flag_for_pbl_generic_tend .and. lssav) then
           if (lsidea) then
             dt3dt(1:im,:) = dt3dt(1:im,:) + dtdt(1:im,:)*dtf
           else
@@ -622,9 +629,9 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac,
               enddo
             enddo
           endif
-        endif if_diag
-        
-      endif if_lssav
+        endif
+
+      endif   ! end if_lssav
 
       end subroutine GFS_PBL_generic_post_run
 

physics/GFS_PBL_generic.meta

@@ -1166,13 +1166,12 @@
   kind = kind_phys
   intent = in
   optional = F
-[fice]
-  standard_name = sea_ice_concentration
-  long_name = ice fraction over open water
-  units = frac
+[flag_cice]
+  standard_name = flag_for_cice
+  long_name = flag for cice
+  units = flag
   dimensions = (horizontal_dimension)
-  type = real
-  kind = kind_phys
+  type = logical
   intent = in
   optional = F
 [dusfc_cice]
@@ -1244,7 +1243,7 @@
   kind = kind_phys
   intent = in
   optional = F
-[stress_ocn]
+[stress_wat]
   standard_name = surface_wind_stress_over_ocean
   long_name = surface wind stress over ocean
   units = m2 s-2
@@ -1253,7 +1252,7 @@
   kind = kind_phys
   intent = in
   optional = F
-[hflx_ocn]
+[hflx_wat]
   standard_name = kinematic_surface_upward_sensible_heat_flux_over_ocean
   long_name = kinematic surface upward sensible heat flux over ocean
   units = K m s-1
@@ -1262,7 +1261,7 @@
   kind = kind_phys
   intent = in
   optional = F
-[evap_ocn]
+[evap_wat]
   standard_name = kinematic_surface_upward_latent_heat_flux_over_ocean
   long_name = kinematic surface upward latent heat flux over ocean
   units = kg kg-1 m s-1

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)
@@ -560,6 +562,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

physics/GFS_suite_interstitial.F90

@@ -160,7 +160,7 @@ end subroutine GFS_suite_interstitial_2_finalize
     subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplflx, flag_cice, shal_cnv, old_monin, mstrat,       &
       do_shoc, frac_grid, imfshalcnv, dtf, xcosz, adjsfcdsw, adjsfcdlw, cice, pgr, ulwsfc_cice, lwhd, htrsw, htrlw, xmu, ctei_rm,    &
       work1, work2, prsi, tgrs, prsl, qgrs_water_vapor, qgrs_cloud_water, cp, hvap, prslk, suntim, adjsfculw, adjsfculw_lnd,         &
-      adjsfculw_ice, adjsfculw_ocn, dlwsfc, ulwsfc, psmean, dt3dt_lw, dt3dt_sw, dt3dt_pbl, dt3dt_dcnv, dt3dt_scnv, dt3dt_mp,         &
+      adjsfculw_ice, adjsfculw_wat, dlwsfc, ulwsfc, psmean, dt3dt_lw, dt3dt_sw, dt3dt_pbl, dt3dt_dcnv, dt3dt_scnv, dt3dt_mp,         &
       ctei_rml, ctei_r, kinver, dry, icy, wet, frland, huge, errmsg, errflg)
 
       implicit none
@@ -181,7 +181,7 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl
 
       integer,              intent(inout), dimension(im) :: kinver
       real(kind=kind_phys), intent(inout), dimension(im) :: suntim, dlwsfc, ulwsfc, psmean, ctei_rml, ctei_r
-      real(kind=kind_phys), intent(in   ), dimension(im) :: adjsfculw_lnd, adjsfculw_ice, adjsfculw_ocn
+      real(kind=kind_phys), intent(in   ), dimension(im) :: adjsfculw_lnd, adjsfculw_ice, adjsfculw_wat
       real(kind=kind_phys), intent(  out), dimension(im) :: adjsfculw
 
       ! These arrays are only allocated if ldiag3d is .true.
@@ -232,11 +232,11 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl
             if (flag_cice(i)) then
               adjsfculw(i) = adjsfculw_lnd(i) * frland(i)               &
                            + ulwsfc_cice(i)   * tem                     &
-                           + adjsfculw_ocn(i) * (one - frland(i) - tem)
+                           + adjsfculw_wat(i) * (one - frland(i) - tem)
             else
               adjsfculw(i) = adjsfculw_lnd(i) * frland(i)               &
                            + adjsfculw_ice(i) * tem                     &
-                           + adjsfculw_ocn(i) * (one - frland(i) - tem)
+                           + adjsfculw_wat(i) * (one - frland(i) - tem)
             endif
           enddo
         else
@@ -246,20 +246,20 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl
             elseif (icy(i)) then                 ! ice (and water)
               tem = one - cice(i)
               if (flag_cice(i)) then
-                if (wet(i) .and. adjsfculw_ocn(i) /= huge) then
-                  adjsfculw(i) = ulwsfc_cice(i)*cice(i) + adjsfculw_ocn(i)*tem
+                if (wet(i) .and. adjsfculw_wat(i) /= huge) then
+                  adjsfculw(i) = ulwsfc_cice(i)*cice(i) + adjsfculw_wat(i)*tem
                 else
                   adjsfculw(i) = ulwsfc_cice(i)
                 endif
               else
-                if (wet(i) .and. adjsfculw_ocn(i) /= huge) then
-                  adjsfculw(i) = adjsfculw_ice(i)*cice(i) + adjsfculw_ocn(i)*tem
+                if (wet(i) .and. adjsfculw_wat(i) /= huge) then
+                  adjsfculw(i) = adjsfculw_ice(i)*cice(i) + adjsfculw_wat(i)*tem
                 else
                   adjsfculw(i) = adjsfculw_ice(i)
                 endif
               endif
             else                                 ! all water
-              adjsfculw(i) = adjsfculw_ocn(i)
+              adjsfculw(i) = adjsfculw_wat(i)
             endif
           enddo
         endif

physics/GFS_suite_interstitial.meta

@@ -604,7 +604,7 @@
   kind = kind_phys
   intent = in
   optional = F
-[adjsfculw_ocn]
+[adjsfculw_wat]
   standard_name = surface_upwelling_longwave_flux_over_ocean_interstitial
   long_name = surface upwelling longwave flux at current time over ocean (temporary use as interstitial)
   units = W m-2