Merge branch 'ufs/dev' of https://github.com/ufs-community/ccpp-physics into HEAD

Author: dustinswales

physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.F90

@@ -702,14 +702,16 @@ end subroutine GFS_phys_time_vary_init
 !>\section gen_GFS_phys_time_vary_timestep_init GFS_phys_time_vary_timestep_init General Algorithm
 !> @{
       subroutine GFS_phys_time_vary_timestep_init (                                                 &
-            me, master, cnx, cny, isc, jsc, nrcm, im, levs, kdt, idate, nsswr, fhswr, lsswr, fhour, &
+            me, master, cnx, cny, isc, jsc, nrcm, im, levs, kdt, idate, cplflx,                     &
+            nsswr, fhswr, lsswr, fhour,                                                             &
             imfdeepcnv, cal_pre, random_clds, nscyc, ntoz, h2o_phys, iaerclm, iccn, clstp,          &
             jindx1_o3, jindx2_o3, ddy_o3, ozpl, jindx1_h, jindx2_h, ddy_h, h2opl, iflip,            &
             jindx1_aer, jindx2_aer, ddy_aer, iindx1_aer, iindx2_aer, ddx_aer, aer_nm,               &
             jindx1_ci, jindx2_ci, ddy_ci, iindx1_ci, iindx2_ci, ddx_ci, in_nm, ccn_nm, fn_nml,      &
             imap, jmap, prsl, seed0, rann, nthrds, nx, ny, nsst, tile_num, nlunit, lsoil, lsoil_lsm,&
             kice, ialb, isot, ivegsrc, input_nml_file, use_ufo, nst_anl, frac_grid, fhcyc, phour,   &
-            lakefrac, min_seaice, min_lakeice, smc, slc, stc, smois, sh2o, tslb, tiice, tg3, tref,  &
+            oceanfrac, lakefrac, min_seaice, min_lakeice, smc, slc, stc, smois, sh2o, tslb, tiice,  &
+            tg3, tref,                                                                              &
             tsfc, tsfco, tisfc, hice, fice, facsf, facwf, alvsf, alvwf, alnsf, alnwf, zorli, zorll, &
             zorlo, weasd, slope, snoalb, canopy, vfrac, vtype, stype,scolor, shdmin, shdmax, snowd, &
             cv, cvb, cvt, oro, oro_uf, xlat_d, xlon_d, slmsk, landfrac, ozphys, h2ophys,            &
@@ -723,7 +725,7 @@ subroutine GFS_phys_time_vary_timestep_init (
                                                 nsswr, imfdeepcnv, iccn, nscyc, ntoz, iflip
          integer,              intent(in)    :: idate(:)
          real(kind_phys),      intent(in)    :: fhswr, fhour
-         logical,              intent(in)    :: lsswr, cal_pre, random_clds, h2o_phys, iaerclm
+         logical,              intent(in)    :: lsswr, cal_pre, random_clds, h2o_phys, iaerclm, cplflx
          real(kind_phys),      intent(out)   :: clstp
          integer,              intent(in), optional    :: jindx1_o3(:), jindx2_o3(:), jindx1_h(:), jindx2_h(:)
          real(kind_phys),      intent(in), optional    :: ddy_o3(:),  ddy_h(:)
@@ -753,7 +755,7 @@ subroutine GFS_phys_time_vary_timestep_init (
          character(len=*),     intent(in)    :: fn_nml
          logical,              intent(in)    :: use_ufo, nst_anl, frac_grid
          real(kind_phys),      intent(in)    :: fhcyc, phour, lakefrac(:), min_seaice, min_lakeice,  &
-                                                xlat_d(:), xlon_d(:), landfrac(:)
+                                                xlat_d(:), xlon_d(:), landfrac(:),oceanfrac(:)
          real(kind_phys),      intent(inout) :: smc(:,:), slc(:,:), stc(:,:), tiice(:,:), tg3(:),    &
                                       tsfc(:), tsfco(:), tisfc(:), hice(:), fice(:),                 &
                                       facsf(:), facwf(:), alvsf(:), alvwf(:), alnsf(:), alnwf(:),    &
@@ -926,6 +928,7 @@ subroutine GFS_phys_time_vary_timestep_init (
                  tsfco, tisfc, hice, fice, facsf, facwf, alvsf, alvwf, alnsf, alnwf,         &
                  zorli, zorll, zorlo, weasd, slope, snoalb, canopy, vfrac, vtype,            &
                  stype, scolor, shdmin, shdmax, snowd, cv, cvb, cvt, oro, oro_uf,            &
+                 cplflx, oceanfrac,                                                          &
                  xlat_d, xlon_d, slmsk, imap, jmap, errmsg, errflg)
            endif
          endif

physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.meta

@@ -1173,6 +1173,13 @@
   dimensions = (4)
   type = integer
   intent = in
+[cplflx]
+  standard_name = flag_for_surface_flux_coupling
+  long_name = flag controlling cplflx collection (default off)
+  units = flag
+  dimensions = ()
+  type = logical
+  intent = in
 [nsswr]
   standard_name = number_of_timesteps_between_shortwave_radiation_calls
   long_name = number of timesteps between shortwave radiation calls
@@ -1638,6 +1645,14 @@
   type = real
   kind = kind_phys
   intent = in
+[oceanfrac]
+  standard_name = sea_area_fraction
+  long_name = fraction of horizontal grid area occupied by ocean
+  units = frac
+  dimensions = (horizontal_dimension)
+  type = real
+  kind = kind_phys
+  intent = in
 [lakefrac]
   standard_name = lake_area_fraction
   long_name = fraction of horizontal grid area occupied by lake

physics/Interstitials/UFS_SCM_NEPTUNE/gcycle.F90

@@ -22,6 +22,7 @@ subroutine gcycle (me, nthrds, nx, ny, isc, jsc, nsst, tile_num, nlunit, fn_nml,
       tsfco, tisfc, hice, fice, facsf, facwf, alvsf, alvwf, alnsf, alnwf,          &
       zorli, zorll, zorlo, weasd, slope, snoalb, canopy, vfrac, vtype,             &
       stype, scolor, shdmin, shdmax, snowd, cv, cvb, cvt, oro, oro_uf,             &
+      cplflx, oceanfrac,                                                           &
       xlat_d, xlon_d, slmsk, imap, jmap, errmsg, errflg)
 !
 !
@@ -33,9 +34,9 @@ subroutine gcycle (me, nthrds, nx, ny, isc, jsc, nsst, tile_num, nlunit, fn_nml,
     integer,              intent(in)    :: idate(:), ialb, isot, ivegsrc
     character(len = 64), intent(in)     :: fn_nml
     character(len=*),     intent(in)    :: input_nml_file(:)
-    logical,              intent(in)    :: use_ufo, nst_anl, frac_grid
+    logical,              intent(in)    :: use_ufo, nst_anl, frac_grid, cplflx
     real(kind=kind_phys), intent(in)    :: fhcyc, phour, landfrac(:), lakefrac(:), &
-                                           min_seaice, min_lakeice,                &
+                                           min_seaice, min_lakeice,oceanfrac(:), &
                                            xlat_d(:), xlon_d(:)
     real(kind=kind_phys), intent(inout), optional ::   &
                                            smois(:,:), &
@@ -103,6 +104,17 @@ subroutine gcycle (me, nthrds, nx, ny, isc, jsc, nsst, tile_num, nlunit, fn_nml,
         STCFC1 (nx*ny*max(lsoil,lsoil_lsm)), &
         SLCFC1 (nx*ny*max(lsoil,lsoil_lsm))
 
+!
+! declare the variables (arrays) for cplflx, surface type dependent gcycle changes
+!
+    real(kind=kind_io8) ::                   &
+        hice_save    (nx*ny),                &        ! sea or lake ice thickness
+        fice_save    (nx*ny),                &        ! sea or lake ice fraction
+        snowd_save   (nx*ny),                &        ! water equivalent snow depth
+        snoalb_save  (nx*ny),                &        ! maximum snow albedo
+        tisfc_save   (nx*ny),                &        ! surface skin temperature over (sea or lake) ice
+        weasd_save   (nx*ny)                          ! water equiv of acc snow depth over land and (sea or lake)  ice
+
 
     real (kind=kind_io8) :: min_ice(nx*ny)
     integer              :: i_indx(nx*ny), j_indx(nx*ny)
@@ -131,11 +143,25 @@ subroutine gcycle (me, nthrds, nx, ny, isc, jsc, nsst, tile_num, nlunit, fn_nml,
       sig1t = 0.0_kind_phys
       npts  = nx*ny
 !
+! Some surface variables need to be updated by gcycle with coupled mode, and nsst mode dependent. A few variables are saved 
+! in order to be able to update them over the specific surface types only after call sfccycle
+!
+      if ( cplflx ) then
+        hice_save   = hice 
+        fice_save   = fice
+        snowd_save  = snowd
+        snoalb_save = snoalb
+        tisfc_save  = tisfc
+        weasd_save  = weasd
+      endif
+
       if ( nsst > 0 ) then
         TSFFCS = tref
       else
         TSFFCS = tsfco
-      end if
+      endif
+
+
 ! integer to real/double precision
       slpfcs = real(slope)
       vegfcs = real(vtype)
@@ -251,11 +277,45 @@ subroutine gcycle (me, nthrds, nx, ny, isc, jsc, nsst, tile_num, nlunit, fn_nml,
       close (nlunit)
 #endif
 !
-      if ( nsst > 0 ) then
-        tref = TSFFCS
+! The gcycle resulted change is applied to some variables in the way of the coupled mode dependent, water surface type (ocean or lake)
+! dependent and nsst mode dependent
+!
+      if ( cplflx ) then
+!       In coupled mode, keep these variables the same as is (before sfccycle is called) over ocean
+        do ix=1,npts
+          if ( oceanfrac(ix) > 0.0_kind_phys ) then      
+            hice(ix)   = hice_save(ix) 
+            fice(ix)   = fice_save(ix)
+            snowd(ix)  = snowd_save(ix)
+            snoalb(ix) = snoalb_save(ix)
+            tisfc(ix)  = tisfc_save(ix)
+            weasd(ix)  = weasd_save(ix)
+          endif
+        enddo
+!       In the coupled mode and when NSST is on, update tref over non-ocean 
+        if ( nsst > 0 ) then       
+          do ix=1,npts
+            if ( oceanfrac(ix) == 0.0_kind_phys ) then 
+              tref(ix)  = TSFFCS(ix) 
+            endif
+          enddo
+!       In the coupled mode and when NSST is off, update tsfc and tsfco over non-ocean
+        else             
+          do ix=1,npts
+            if ( oceanfrac(ix) == 0.0_kind_phys ) then 
+              tsfc(ix)  = TSFFCS(ix)
+              tsfco(ix) = TSFFCS(ix)
+            endif
+          enddo
+        endif
+!     The same as before (this modification) in uncoupled mode
       else
-        tsfc  = TSFFCS
-        tsfco = TSFFCS
+        if ( nsst > 0 ) then
+          tref = TSFFCS
+        else
+          tsfc  = TSFFCS
+          tsfco = TSFFCS
+        endif
       endif
 !
 ! real/double precision to integer