Enable UFS-GOCART integration

physics/GFS_DCNV_generic.F90

@@ -17,7 +17,7 @@ end subroutine GFS_DCNV_generic_pre_finalize
 !!
     subroutine GFS_DCNV_generic_pre_run (im, levs, ldiag3d, qdiag3d, do_cnvgwd, cplchm,&
                                          gu0, gv0, gt0, gq0_water_vapor,               &
-                                         save_u, save_v, save_t, save_qv, dqdti,       &
+                                         save_u, save_v, save_t, save_qv,              &
                                          errmsg, errflg)
 
       use machine, only: kind_phys
@@ -34,8 +34,6 @@ subroutine GFS_DCNV_generic_pre_run (im, levs, ldiag3d, qdiag3d, do_cnvgwd, cplc
       real(kind=kind_phys), dimension(:,:), intent(inout) :: save_v
       real(kind=kind_phys), dimension(:,:), intent(inout) :: save_t
       real(kind=kind_phys), dimension(:,:), intent(inout) :: save_qv
-      ! dqdti only allocated if cplchm is .true.
-      real(kind=kind_phys), dimension(:,:),     intent(inout) :: dqdti
       character(len=*), intent(out) :: errmsg
       integer, intent(out) :: errflg
 
@@ -70,10 +68,6 @@ subroutine GFS_DCNV_generic_pre_run (im, levs, ldiag3d, qdiag3d, do_cnvgwd, cplc
         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

@@ -127,15 +127,6 @@
   kind = kind_phys
   intent = inout
   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_loop_extent,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_PBL_generic.F90

@@ -83,7 +83,7 @@ subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac,
         ntqv, ntcw, ntiw, ntrw, ntsw, ntlnc, ntinc, ntrnc, ntsnc, ntgnc,                 &
         ntwa, ntia, ntgl, ntoz, ntke, ntkev, nqrimef, trans_aero, ntchs, ntchm,          &
         imp_physics, imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6,           &
-        imp_physics_zhao_carr, imp_physics_mg, imp_physics_fer_hires, cplchm, ltaerosol, &
+        imp_physics_zhao_carr, imp_physics_mg, imp_physics_fer_hires, ltaerosol, &
         hybedmf, do_shoc, satmedmf, qgrs, vdftra, save_u, save_v, save_t, save_q,        &
         ldiag3d, qdiag3d, lssav, ugrs, vgrs, tgrs, errmsg, errflg)
 
@@ -99,7 +99,7 @@ subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac,
       logical, intent(in) :: trans_aero, ldiag3d, qdiag3d, lssav
       integer, intent(in) :: imp_physics, imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6
       integer, intent(in) :: imp_physics_zhao_carr, imp_physics_mg, imp_physics_fer_hires
-      logical, intent(in) :: cplchm, ltaerosol, hybedmf, do_shoc, satmedmf
+      logical, intent(in) :: ltaerosol, hybedmf, do_shoc, satmedmf
 
       real(kind=kind_phys), dimension(:,:,:), intent(in) :: qgrs
       real(kind=kind_phys), dimension(:,:), intent(in) :: ugrs, vgrs, tgrs
@@ -247,7 +247,7 @@ subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac,
                                         imp_physics_mg, ntgl, imp_physics_gfdl, &
                                         imp_physics_zhao_carr, kk,              &
                                         errmsg, errflg)
-          if (.not.errflg==1) return
+          if (errflg /= 0) return
           !
           k1 = kk
           do n=ntchs,ntchm+ntchs-1
@@ -317,7 +317,7 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac,
         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, kdt, 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, &
+        dtsfc_cice, dqsfc_cice, wet, dry, icy, wind, stress_wat, hflx_wat, evap_wat, ugrs1, vgrs1, hffac, hefac, &
         ugrs, vgrs, tgrs, qgrs, save_u, save_v, save_t, save_q, errmsg, errflg)
 
       use machine,                only : kind_phys
@@ -366,9 +366,6 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac,
       logical, dimension(:),intent(in) :: wet, dry, icy
       real(kind=kind_phys), dimension(:), intent(out) ::  ushfsfci
 
-      real(kind=kind_phys), dimension(:,:), intent(inout) :: dkt_cpl
-      real(kind=kind_phys), dimension(:,:), intent(in)    :: dkt
-
       ! From canopy heat storage - reduction factors in latent/sensible heat flux due to surface roughness
       real(kind=kind_phys), dimension(:), intent(in) :: hffac, hefac
 
@@ -404,7 +401,7 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac,
                                         imp_physics_mg, ntgl, imp_physics_gfdl, &
                                         imp_physics_zhao_carr, kk,              &
                                         errmsg, errflg)
-          if (.not.errflg==1) return
+          if (errflg /= 0) return
           !
           k1 = kk
           do n=ntchs,ntchm+ntchs-1
@@ -533,15 +530,6 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac,
 
       endif ! nvdiff == ntrac
 
-      if (cplchm) then
-        do i = 1, im
-          tem  = prsl(i,1) / (rd*t1(i)*(one+fvirt*max(q1(i), qmin)))
-          ushfsfci(i) = -cp * tem * hflx(i) ! upward sensible heat flux
-        enddo
-        dkt_cpl(1:im,1:levs) = dkt(1:im,1:levs)
-      endif
-
-
 !  --- ...  coupling insertion
 
       if (cplflx) then
@@ -593,6 +581,24 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac,
         enddo
       endif
 
+      if (cplchm) then
+        if (cplflx) then
+          do i = 1, im
+            if (oceanfrac(i) > zero) then
+              ushfsfci(i) = dtsfci_cpl(i)
+            else
+              rho = prsl(i,1) / (rd*t1(i)*(one+fvirt*max(q1(i), qmin)))
+              ushfsfci(i) = cp * rho * hflx(i)
+            end if
+          end do
+        else
+          do i = 1, im
+            rho = prsl(i,1) / (rd*t1(i)*(one+fvirt*max(q1(i), qmin)))
+            ushfsfci(i) = cp * rho * hflx(i)
+          end do
+        end if
+      end if
+
 !-------------------------------------------------------lssav if loop ----------
       if (lssav) then
         do i=1,im

physics/GFS_PBL_generic.meta

@@ -255,14 +255,6 @@
   type = integer
   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
 [ltaerosol]
   standard_name = flag_for_aerosol_physics
   long_name = flag for aerosol physics
@@ -1316,24 +1308,6 @@
   kind = kind_phys
   intent = in
   optional = F
-[dkt_cpl]
-  standard_name = instantaneous_atmosphere_heat_diffusivity
-  long_name = instantaneous atmospheric heat diffusivity
-  units = m2 s-1
-  dimensions = (horizontal_loop_extent,vertical_dimension)
-  type = real
-  kind = kind_phys
-  intent = inout
-  optional = F
-[dkt]
-  standard_name = atmosphere_heat_diffusivity
-  long_name = atmospheric heat diffusivity
-  units = m2 s-1
-  dimensions = (horizontal_loop_extent,vertical_dimension)
-  type = real
-  kind = kind_phys
-  intent = in
-  optional = F
 [hffac]
   standard_name = surface_upward_sensible_heat_flux_reduction_factor
   long_name = surface upward sensible heat flux reduction factor from canopy heat storage

physics/GFS_SCNV_generic.F90

@@ -71,7 +71,7 @@ end subroutine GFS_SCNV_generic_post_finalize
 !! \htmlinclude GFS_SCNV_generic_post_run.html
 !!
       subroutine GFS_SCNV_generic_post_run (im, levs, nn, lssav, ldiag3d, qdiag3d, cplchm, &
-        frain, gu0, gv0, gt0, gq0_water_vapor, save_u, save_v, save_t, save_qv, dqdti, du3dt, dv3dt, dt3dt, dq3dt, clw,   &
+        frain, gu0, gv0, gt0, gq0_water_vapor, save_u, save_v, save_t, save_qv, du3dt, dv3dt, dt3dt, dq3dt, clw,   &
         shcnvcw, rain1, npdf3d, num_p3d, ncnvcld3d, cnvc, cnvw,                   &
         rainc, cnvprcp, cnvprcpb, cnvw_phy_f3d, cnvc_phy_f3d,                     &
         flag_for_scnv_generic_tend,                                               &
@@ -87,8 +87,7 @@ subroutine GFS_SCNV_generic_post_run (im, levs, nn, lssav, ldiag3d, qdiag3d, cpl
       real(kind=kind_phys), dimension(:, :), intent(in) :: gu0, gv0, gt0, gq0_water_vapor
       real(kind=kind_phys), dimension(:, :), intent(in) :: save_u, save_v, save_t, save_qv
 
-      ! dqdti, dt3dt, dq3dt, only allocated if ldiag3d == .true.
-      real(kind=kind_phys), dimension(:,:), intent(inout) :: dqdti
+      ! dt3dt, dq3dt, only allocated if ldiag3d == .true.
       real(kind=kind_phys), dimension(:,:), intent(inout) :: du3dt, dv3dt, dt3dt, dq3dt
       real(kind=kind_phys), dimension(:, :,:), intent(inout) :: clw
 
@@ -154,15 +153,6 @@ subroutine GFS_SCNV_generic_post_run (im, levs, nn, lssav, ldiag3d, qdiag3d, cpl
           endif
         endif
       endif
-!
-      if (cplchm) then
-        do k=1,levs
-          do i=1,im
-            tem  = (gq0_water_vapor(i,k)-save_qv(i,k)) * frain
-            dqdti(i,k) = dqdti(i,k) + tem
-          enddo
-        enddo
-      endif
 !
       do k=1,levs
         do i=1,im

physics/GFS_SCNV_generic.meta

@@ -284,15 +284,6 @@
   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_loop_extent,vertical_dimension)
-  type = real
-  kind = kind_phys
-  intent = inout
-  optional = F
 [du3dt]
   standard_name = cumulative_change_in_x_wind_due_to_shallow_convection
   long_name = cumulative change in x wind due to shallow convection

physics/GFS_debug.F90

@@ -860,8 +860,8 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling,
                      if (Model%cplchm) then
                         call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%rainc_cpl', Coupling%rainc_cpl)
                         call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%ushfsfci ', Coupling%ushfsfci )
-                        call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%dkt      ', Coupling%dkt      )
-                        call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%dqdti    ', Coupling%dqdti    )
+                        call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%pfi_lsan', Coupling%pfi_lsan )
+                        call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%pfl_lsan', Coupling%pfl_lsan )
                      end if
                      if (Model%do_sppt) then
                         call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%sppt_wts', Coupling%sppt_wts)

physics/GFS_suite_interstitial.F90

@@ -653,10 +653,10 @@ end subroutine GFS_suite_interstitial_4_finalize
 !> \section arg_table_GFS_suite_interstitial_4_run Argument Table
 !! \htmlinclude GFS_suite_interstitial_4_run.html
 !!
-    subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_total, ntrac, ntcw, ntiw, ntclamt, &
+    subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, tracers_total, ntrac, ntcw, ntiw, ntclamt, &
       ntrw, ntsw, ntrnc, ntsnc, ntgl, ntgnc, ntlnc, ntinc, nn, imp_physics, imp_physics_gfdl, imp_physics_thompson,  &
       imp_physics_zhao_carr, imp_physics_zhao_carr_pdf, convert_dry_rho, dtf, save_qc, save_qi, con_pi,              &
-      gq0, clw, prsl, save_tcp, con_rd, con_eps, nwfa, spechum, dqdti, errmsg, errflg)
+      gq0, clw, prsl, save_tcp, con_rd, con_eps, nwfa, spechum, errmsg, errflg)
 
       use machine,               only: kind_phys
       use module_mp_thompson_make_number_concentrations, only: make_IceNumber, make_DropletNumber
@@ -669,7 +669,7 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_to
         ntsw, ntrnc, ntsnc, ntgl, ntgnc, ntlnc, ntinc, nn, imp_physics, imp_physics_gfdl, imp_physics_thompson,           &
         imp_physics_zhao_carr, imp_physics_zhao_carr_pdf
 
-      logical,              intent(in   )                   :: ltaerosol, cplchm, convert_dry_rho
+      logical,                                  intent(in) :: ltaerosol, convert_dry_rho
 
       real(kind=kind_phys), intent(in   )                   :: con_pi, dtf
       real(kind=kind_phys), intent(in   ), dimension(:,:)   :: save_qc
@@ -683,9 +683,6 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_to
       real(kind=kind_phys), intent(in   ), dimension(:,:)   :: nwfa, save_tcp
       real(kind=kind_phys), intent(in   ), dimension(:,:)   :: spechum
 
-      ! dqdti may not be allocated
-      real(kind=kind_phys), intent(inout), dimension(:,:)   :: dqdti
-
       character(len=*),     intent(  out)                   :: errmsg
       integer,              intent(  out)                   :: errflg
 
@@ -808,15 +805,6 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_to
         enddo
       endif   ! end if_ntcw
 
-! dqdt_v : instaneous moisture tendency (kg/kg/sec)
-      if (cplchm) then
-        do k=1,levs
-          do i=1,im
-            dqdti(i,k) = dqdti(i,k) * (one / dtf)
-          enddo
-        enddo
-      endif
-
     end subroutine GFS_suite_interstitial_4_run
 
   end module GFS_suite_interstitial_4

physics/GFS_suite_interstitial.meta

@@ -1610,14 +1610,6 @@
   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
 [tracers_total]
   standard_name = number_of_total_tracers
   long_name = total number of tracers
@@ -1886,15 +1878,6 @@
   kind = kind_phys
   intent = inout
   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_loop_extent,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_surface_generic.F90

@@ -209,7 +209,7 @@ end subroutine GFS_surface_generic_post_finalize
 !> \section arg_table_GFS_surface_generic_post_run Argument Table
 !! \htmlinclude GFS_surface_generic_post_run.html
 !!
-      subroutine GFS_surface_generic_post_run (im, cplflx, cplwav, lssav, icy, wet, dtf, ep1d, gflx, tgrs_1, qgrs_1, ugrs_1, vgrs_1,&
+      subroutine GFS_surface_generic_post_run (im, cplflx, cplchm, cplwav, lssav, icy, wet, dtf, ep1d, gflx, tgrs_1, qgrs_1, ugrs_1, vgrs_1,&
         adjsfcdlw, adjsfcdsw, adjnirbmd, adjnirdfd, adjvisbmd, adjvisdfd, adjsfculw, adjsfculw_wat, adjnirbmu, adjnirdfu,           &
         adjvisbmu, adjvisdfu,t2m, q2m, u10m, v10m, tsfc, tsfc_wat, pgr, xcosz, evbs, evcw, trans, sbsno, snowc, snohf,              &
         epi, gfluxi, t1, q1, u1, v1, dlwsfci_cpl, dswsfci_cpl, dlwsfc_cpl, dswsfc_cpl, dnirbmi_cpl, dnirdfi_cpl, dvisbmi_cpl,       &
@@ -221,7 +221,7 @@ subroutine GFS_surface_generic_post_run (im, cplflx, cplwav, lssav, icy, wet, dt
         implicit none
 
         integer,                                intent(in) :: im
-        logical,                                intent(in) :: cplflx, cplwav, lssav
+        logical,                                intent(in) :: cplflx, cplchm, cplwav, lssav
         logical, dimension(:),                  intent(in) :: icy, wet
         real(kind=kind_phys),                   intent(in) :: dtf
 
@@ -274,13 +274,19 @@ subroutine GFS_surface_generic_post_run (im, cplflx, cplwav, lssav, icy, wet, dt
           v1(i)     = vgrs_1(i)
         enddo
 
-        if (cplflx .or. cplwav) then
+        if (cplflx .or. cplchm .or. cplwav) then
           do i=1,im
             u10mi_cpl(i) = u10m(i)
             v10mi_cpl(i) = v10m(i)
           enddo
         endif
 
+        if (cplflx .or. cplchm) then
+          do i=1,im
+            tsfci_cpl(i) = tsfc(i)
+          enddo
+        endif
+
         if (cplflx) then
           do i=1,im
             dlwsfci_cpl (i) = adjsfcdlw(i)
@@ -302,8 +308,6 @@ subroutine GFS_surface_generic_post_run (im, cplflx, cplwav, lssav, icy, wet, dt
             nlwsfc_cpl  (i) = nlwsfc_cpl(i) + nlwsfci_cpl(i)*dtf
             t2mi_cpl    (i) = t2m(i)
             q2mi_cpl    (i) = q2m(i)
-            tsfci_cpl   (i) = tsfc(i)
-!           tsfci_cpl   (i) = tsfc_wat(i)
             psurfi_cpl  (i) = pgr(i)
           enddo
 

physics/GFS_surface_generic.meta

@@ -488,6 +488,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
 [cplwav]
   standard_name = flag_for_wave_coupling
   long_name = flag controlling cplwav collection (default off)