EMC flake model in CCPP-physics

physics/GFS_PBL_generic.F90

@@ -368,7 +368,7 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac,
       real(kind=kind_phys), dimension(:), intent(inout) :: 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
 
-      logical, dimension(:),intent(in) :: wet, dry, icy
+      logical, dimension(:),intent(in) :: ocean, lake, dry, icy
       real(kind=kind_phys), dimension(:), intent(out) ::  ushfsfci
 
       real(kind=kind_phys), dimension(:,:), intent(inout) :: dkt_cpl
@@ -537,7 +537,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)*(one+fvirt*tem1))
+          tem  = prsl(i,1) / (rd*t1(i)*(1.0+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)
@@ -570,8 +570,8 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac,
                 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
+                dusfci_cpl(i) = 0.0
+                dvsfci_cpl(i) = 0.0
               endif
               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

physics/GFS_PBL_generic.meta

@@ -1230,9 +1230,17 @@
   kind = kind_phys
   intent = in
   optional = F
-[wet]
-  standard_name = flag_nonzero_wet_surface_fraction
-  long_name = flag indicating presence of some ocean or lake surface area fraction
+[ocean]
+  standard_name = flag_nonzero_ocean_surface_fraction
+  long_name = flag indicating presence of some ocean surface area fraction
+  units = flag
+  dimensions = (horizontal_dimension)
+  type = logical
+  intent = in
+  optional = F
+[lake]
+  standard_name = flag_nonzero_lake_surface_fraction
+  long_name = flag indicating presence of some lake surface area fraction
   units = flag
   dimensions = (horizontal_dimension)
   type = logical

physics/GFS_debug.F90

@@ -948,7 +948,7 @@ end subroutine GFS_checkland_finalize
 !!
         subroutine GFS_checkland_run (me, master, blkno, im, kdt, iter, flag_iter, flag_guess, &
                 flag_init, flag_restart, frac_grid, isot, ivegsrc, stype, vtype, slope,        &
-                soiltyp, vegtype, slopetyp, dry, icy, wet, lake, ocean,                        &
+                soiltyp, vegtype, slopetyp, dry, icy,  lake, ocean,                            &
                 oceanfrac, landfrac, lakefrac, slmsk, islmsk, errmsg, errflg )
 
            use machine, only: kind_phys
@@ -977,7 +977,7 @@ subroutine GFS_checkland_run (me, master, blkno, im, kdt, iter, flag_iter, flag_
            integer,          intent(in   ) :: slopetyp(im)
            logical,          intent(in   ) :: dry(im)
            logical,          intent(in   ) :: icy(im)
-           logical,          intent(in   ) :: wet(im)
+!           logical,          intent(in   ) :: wet(im)
            logical,          intent(in   ) :: lake(im)
            logical,          intent(in   ) :: ocean(im)
            real(kind_phys),  intent(in   ) :: oceanfrac(im)
@@ -1018,7 +1018,7 @@ subroutine GFS_checkland_run (me, master, blkno, im, kdt, iter, flag_iter, flag_
                write(0,'(a,2i5,1x,i5)')   'YYY: i, blk, slopetyp(i)   :', i, blkno, slopetyp(i)
                write(0,'(a,2i5,1x,1x,l)') 'YYY: i, blk, dry(i)        :', i, blkno, dry(i)
                write(0,'(a,2i5,1x,1x,l)') 'YYY: i, blk, icy(i)        :', i, blkno, icy(i)
-               write(0,'(a,2i5,1x,1x,l)') 'YYY: i, blk, wet(i)        :', i, blkno, wet(i)
+!               write(0,'(a,2i5,1x,1x,l)') 'YYY: i, blk, wet(i)        :', i, blkno, wet(i)
                write(0,'(a,2i5,1x,1x,l)') 'YYY: i, blk, lake(i)       :', i, blkno, lake(i)
                write(0,'(a,2i5,1x,1x,l)') 'YYY: i, blk, ocean(i)      :', i, blkno, ocean(i)
                write(0,'(a,2i5,1x,e16.7)')'YYY: i, blk, oceanfrac(i)  :', i, blkno, oceanfrac(i)

physics/GFS_debug.meta

@@ -462,14 +462,6 @@
   type = logical
   intent = in
   optional = F
-[wet]
-  standard_name = flag_nonzero_wet_surface_fraction
-  long_name = flag indicating some ocean or lake surface area fraction
-  units = flag
-  dimensions = (horizontal_dimension)
-  type = logical
-  intent = in
-  optional = F
 [lake]
   standard_name = flag_nonzero_lake_surface_fraction
   long_name = flag indicating some lake surface area fraction

physics/GFS_suite_interstitial.F90

@@ -187,8 +187,8 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl
       ! These arrays are only allocated if ldiag3d is .true.
       real(kind=kind_phys), intent(inout), dimension(:,:) :: dt3dt_lw, dt3dt_sw, dt3dt_pbl, dt3dt_dcnv, dt3dt_scnv, dt3dt_mp
 
-      logical,              intent(in   ), dimension(im) :: dry, icy, wet
-      real(kind=kind_phys), intent(in   ), dimension(im) :: frland
+      logical,              intent(in   ), dimension(im) :: dry, icy, ocean, lake
+      real(kind=kind_phys), intent(in   ), dimension(im) :: frland, frlake
       real(kind=kind_phys), intent(in   ) :: huge
 
       character(len=*),     intent(out) :: errmsg
@@ -228,7 +228,7 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl
 
         if (frac_grid) then
           do i=1,im
-            tem = (one - frland(i)) * cice(i) ! tem = ice fraction wrt whole cell
+            tem = one - cice(i) - frland(i) - frlake(i)
             if (flag_cice(i)) then
               adjsfculw(i) = adjsfculw_lnd(i) * frland(i)               &
                            + ulwsfc_cice(i)   * tem                     &

physics/GFS_suite_interstitial.meta

@@ -613,6 +613,15 @@
   kind = kind_phys
   intent = in
   optional = F
+[adjsfculw_lke]
+  standard_name = surface_upwelling_longwave_flux_over_lake_interstitial
+  long_name = surface upwelling longwave flux at current time over lake (temporary use as interstitial)
+  units = W m-2
+  dimensions = (horizontal_dimension)
+  type = real
+  kind = kind_phys
+  intent = in
+  optional = F
 [dlwsfc]
   standard_name = cumulative_surface_downwelling_longwave_flux_multiplied_by_timestep
   long_name = cumulative surface downwelling LW flux multiplied by timestep
@@ -736,9 +745,17 @@
   type = logical
   intent = in
   optional = F
-[wet]
-  standard_name = flag_nonzero_wet_surface_fraction
-  long_name = flag indicating presence of some ocean or lake surface area fraction
+[ocean]
+  standard_name = flag_nonzero_ocean_surface_fraction
+  long_name = flag indicating presence of some ocean surface area fraction
+  units = flag
+  dimensions = (horizontal_dimension)
+  type = logical
+  intent = in
+  optional = F
+[lake]
+  standard_name = flag_nonzero_lake_surface_fraction
+  long_name = flag indicating presence of some lake surface area fraction
   units = flag
   dimensions = (horizontal_dimension)
   type = logical
@@ -753,6 +770,15 @@
   kind = kind_phys
   intent = in
   optional = F
+[frlake]
+  standard_name = lake_area_fraction_for_microphysics
+  long_name = lake area fraction used in microphysics schemes
+  units = frac
+  dimensions = (horizontal_dimension)
+  type = real
+  kind = kind_phys
+  intent = in
+  optional = F
 [huge]
   standard_name = netcdf_float_fillvalue
   long_name = definition of NetCDF float FillValue

physics/GFS_surface_composites.F90

@@ -40,11 +40,11 @@ subroutine GFS_surface_composites_pre_run (im, frac_grid, flag_cice, cplflx, cpl
       integer,                             intent(in   ) :: im
       logical,                             intent(in   ) :: frac_grid, cplflx, cplwav2atm
       logical, dimension(im),              intent(in   ) :: flag_cice
-      logical,              dimension(im), intent(inout) :: dry, icy, lake, ocean, wet
+      logical,              dimension(im), intent(inout) :: dry, icy, lake, ocean
       real(kind=kind_phys),                intent(in   ) :: cimin
       real(kind=kind_phys), dimension(im), intent(in   ) :: landfrac, lakefrac, oceanfrac
       real(kind=kind_phys), dimension(im), intent(inout) :: cice
-      real(kind=kind_phys), dimension(im), intent(  out) :: frland
+      real(kind=kind_phys), dimension(im), intent(  out) :: frland, frlake
       real(kind=kind_phys), dimension(im), intent(in   ) :: zorl, snowd, tprcp, uustar, weasd
 
       real(kind=kind_phys), dimension(im), intent(inout) :: zorlo, zorll, tsfc, tsfco, tsfcl, tisfc, tsurf
@@ -72,6 +72,7 @@ subroutine GFS_surface_composites_pre_run (im, frac_grid, flag_cice, cplflx, cpl
       if (frac_grid) then  ! cice is ice fraction wrt water area
         do i=1,im
           frland(i) = landfrac(i)
+          frlake(i) = lakefrac(i)
           if (frland(i) > zero) dry(i) = .true.
           if (frland(i) < one) then
             if (flag_cice(i)) then
@@ -88,8 +89,13 @@ subroutine GFS_surface_composites_pre_run (im, frac_grid, flag_cice, cplflx, cpl
               endif
             endif
             if (cice(i) < one ) then
-              wet(i)=.true. ! some open ocean/lake water exists
-              if (.not. cplflx) tsfco(i) = max(tsfco(i), tisfc(i), tgice)
+!              wet(i)=.true. !there is some open ocean/lake water!
+              if(frlake(i) > zero) then
+                 lake(i) =  .true.
+              else
+                 ocean(i) = .true.
+                 if (.not. cplflx) tsfco(i) = max(tsfco(i), tisfc(i), tgice)
+              endif
             end if
           else
             cice(i) = zero
@@ -102,17 +108,23 @@ subroutine GFS_surface_composites_pre_run (im, frac_grid, flag_cice, cplflx, cpl
           frland(i) = zero
           if (islmsk(i) == 0) then
   !         tsfco(i) = Sfcprop%tsfc(i)
-            wet(i)  = .true.
+!            wet(i)  = .true.
+            ocean(i) = .true.
             cice(i) = zero
           elseif (islmsk(i) == 1) then
   !         Sfcprop%tsfcl(i) = Sfcprop%tsfc(i)
             dry(i)    = .true.
             frland(i) = one
             cice(i)   = zero
+          elseif (islmsk(i) == 5) then       !YWu
+            lake(i) = .true.
+!            print*,'lake',i,lake(i)
+            frlake(i) = one
           else 
             icy(i)  = .true.
             if (cice(i) < one) then
-              wet(i) = .true.
+!              wet(i) = .true.
+              ocean(i) = .true.
   !           tsfco(i) = tgice
               if (.not. cplflx) tsfco(i) = max(tisfc(i), tgice)
   !           if (.not. cplflx .or. lakefrac(i) > zero) tsfco(i) = max(tsfco(i), tisfc(i), tgice)
@@ -151,6 +163,16 @@ subroutine GFS_surface_composites_pre_run (im, frac_grid, flag_cice, cplflx, cpl
            snowd_wat(i) = zero
            semis_wat(i) = 0.984d0
         endif
+
+        if(lake(i)) then                    ! lake  YWu
+           zorl_lke(i) = zorlo(i)
+           tsfc_lke(i) = tsfco(i) 
+          tsurf_lke(i) = tsfco(i)
+          weasd_lke(i) = zero
+          snowd_lke(i) = zero
+          semis_lke(i) = 0.984d0
+       endif
+
         if (dry(i)) then                   ! Land
           uustar_lnd(i) = uustar(i)
            weasd_lnd(i) = weasd(i)
@@ -299,7 +321,7 @@ subroutine GFS_surface_composites_post_run (
 
       integer,                              intent(in) :: im, kice, km
       logical,                              intent(in) :: cplflx, frac_grid, cplwav2atm
-      logical, dimension(im),               intent(in) :: flag_cice, dry, wet, icy
+      logical, dimension(im),               intent(in) :: flag_cice, dry, ocean, lake, icy
       integer, dimension(im),               intent(in) :: islmsk
       real(kind=kind_phys), dimension(im),  intent(in) :: landfrac, lakefrac, oceanfrac,                                        &
         zorl_wat, zorl_lnd, zorl_ice, cd_wat, cd_lnd, cd_ice, cdq_wat, cdq_lnd, cdq_ice, rb_wat, rb_lnd, rb_ice, stress_wat,    &
@@ -337,6 +359,7 @@ subroutine GFS_surface_composites_post_run (
 
           ! Three-way composites (fields from sfc_diff)
           txl = landfrac(i)
+          txk = lakefrac(i)
           txi = cice(i)*(one - txl) ! txi = ice fraction wrt whole cell
           txo = max(zero, one - txl - txi)
 
@@ -416,7 +439,7 @@ subroutine GFS_surface_composites_post_run (
             fm10(i)   = fm10_lnd(i)
             fh2(i)    = fh2_lnd(i)
            !tsurf(i)  = tsurf_lnd(i)
-            tsfcl(i)  = tsfc_lnd(i) ! over land
+            tsfcl(i)  = tsfc_lnd(i)
             cmm(i)    = cmm_lnd(i)
             chh(i)    = chh_lnd(i)
             gflx(i)   = gflx_lnd(i)
@@ -428,9 +451,9 @@ subroutine GFS_surface_composites_post_run (
             hflx(i)   = hflx_lnd(i)
             qss(i)    = qss_lnd(i)
             tsfc(i)   = tsfc_lnd(i)
-            !hice(i)   = zero
-            !cice(i)   = zero
-            !tisfc(i)  = tsfc(i)
+            hice(i)   = zero
+            cice(i)   = zero
+            tisfc(i)  = tsfc(i)
           elseif (islmsk(i) == 0) then
             zorl(i)   = zorl_wat(i)
             cd(i)     = cd_wat(i)
@@ -471,9 +494,6 @@ subroutine GFS_surface_composites_post_run (
             fm10(i)   = fm10_ice(i)
             fh2(i)    = fh2_ice(i)
            !tsurf(i)  = tsurf_ice(i)
-            if (.not. flag_cice(i)) then
-              tisfc(i) = tice(i) ! over lake ice (and sea ice when uncoupled)
-            endif
             cmm(i)    = cmm_ice(i)
             chh(i)    = chh_ice(i)
             gflx(i)   = gflx_ice(i)