Merge pull request #193 from esmf-org/feature/ufs_fire_cpl

Add fire coupling into ccpp physics including heat flux, upward specific humidity flux, and smoke tracer

physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_post.F90

@@ -23,22 +23,22 @@ module GFS_surface_composites_post
 !! \htmlinclude GFS_surface_composites_post_run.html
 !!
    subroutine GFS_surface_composites_post_run (                                                                                   &
-      im, kice, km, rd, rvrdm1, cplflx, cplwav2atm, frac_grid, flag_cice, thsfc_loc, islmsk, dry, wet, icy, wind, t1, q1, prsl1,  &
+      im, kice, km, rd, rvrdm1, cplflx, cplwav2atm, cpl_fire, frac_grid, flag_cice, thsfc_loc, islmsk, dry, wet, icy, wind, t1, q1, prsl1,  &
       landfrac, lakefrac, oceanfrac, zorl, zorlo, zorll, zorli, garea, frac_ice,                                                  &
       cd, cd_wat, cd_lnd, cd_ice, cdq, cdq_wat, cdq_lnd, cdq_ice, rb, rb_wat, rb_lnd, rb_ice, stress, stress_wat, stress_lnd,     &
       stress_ice, ffmm, ffmm_wat, ffmm_lnd, ffmm_ice, ffhh, ffhh_wat, ffhh_lnd, ffhh_ice, uustar, uustar_wat, uustar_lnd,         &
       uustar_ice, fm10, fm10_wat, fm10_lnd, fm10_ice, fh2, fh2_wat, fh2_lnd, fh2_ice, tsurf_wat, tsurf_lnd, tsurf_ice,            &
       cmm, cmm_wat, cmm_lnd, cmm_ice, chh, chh_wat, chh_lnd, chh_ice, gflx, gflx_wat, gflx_lnd, gflx_ice, ep1d, ep1d_wat,         &
       ep1d_lnd, ep1d_ice, weasd, weasd_lnd, weasd_ice, snowd, snowd_lnd, snowd_ice, tprcp, tprcp_wat,                             &
-      tprcp_lnd, tprcp_ice, evap, evap_wat, evap_lnd, evap_ice, hflx, hflx_wat, hflx_lnd, hflx_ice, qss, qss_wat, qss_lnd,        &
-      qss_ice, tsfc, tsfco, tsfcl, tsfc_wat, tisfc, hice, cice, tiice,                                                            &
+      tprcp_lnd, tprcp_ice, evap, evap_wat, evap_lnd, evap_ice, hflx, hflx_wat, hflx_lnd, hflx_ice, hflx_fire, evap_fire,         &
+      qss, qss_wat, qss_lnd, qss_ice, tsfc, tsfco, tsfcl, tsfc_wat, tisfc, hice, cice, tiice,                                     &
       sigmaf, zvfun, lheatstrg, h0facu, h0facs, hflxq, hffac, stc, lkm, iopt_lake, iopt_lake_clm, use_lake_model,                                                               &
       grav, prsik1, prslk1, prslki, z1, ztmax_wat, ztmax_lnd, ztmax_ice, huge, errmsg, errflg)
 
       implicit none
 
       integer,                              intent(in) :: im, kice, km, lkm, iopt_lake, iopt_lake_clm
-      logical,                              intent(in) :: cplflx, frac_grid, cplwav2atm, frac_ice
+      logical,                              intent(in) :: cplflx, frac_grid, cplwav2atm, frac_ice, cpl_fire
       logical,                              intent(in) :: lheatstrg
       logical, dimension(:),                intent(in) :: flag_cice, dry, icy
       logical, dimension(:),                intent(in) :: wet
@@ -51,6 +51,7 @@ subroutine GFS_surface_composites_post_run (
         snowd_lnd, snowd_ice, tprcp_wat, tprcp_lnd, tprcp_ice, evap_wat, evap_lnd, evap_ice, hflx_wat, hflx_lnd,                &
         hflx_ice, qss_wat, qss_lnd, qss_ice, tsfc_wat, zorlo, zorll, zorli, garea
 
+      real(kind=kind_phys), dimension(:),   intent(in), optional :: hflx_fire, evap_fire
       real(kind=kind_phys), dimension(:),   intent(inout) :: zorl, cd, cdq, rb, stress, ffmm, ffhh, uustar, fm10,               &
         fh2, cmm, chh, gflx, ep1d, weasd, snowd, tprcp, evap, hflx, qss, tsfc, tsfco, tsfcl, tisfc
 
@@ -275,6 +276,10 @@ subroutine GFS_surface_composites_post_run (
           else if (islmsk(i) == 1) then
           !-- land
             call composite_land
+            if (cpl_fire) then
+              hflx(i)   = hflx(i) + hflx_fire(i)
+              evap(i)   = evap(i) + evap_fire(i)
+            endif
           elseif (islmsk(i) == 0) then
           !-- water
             call composite_wet

physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_post.meta

@@ -816,6 +816,31 @@
   type = real
   kind = kind_phys
   intent = in
+[hflx_fire]
+  standard_name = kinematic_surface_upward_sensible_heat_flux_of_fire
+  long_name = kinematic surface upward sensible heat flux of fire
+  units = K m s-1
+  dimensions = (horizontal_loop_extent)
+  type = real
+  kind = kind_phys
+  intent = in
+  optional = True
+[evap_fire]
+  standard_name = surface_upward_specific_humidity_flux_of_fire
+  long_name = kinematic surface upward latent heat flux of fire
+  units = kg kg-1 m s-1
+  dimensions = (horizontal_loop_extent)
+  type = real
+  kind = kind_phys
+  intent = in
+  optional = True
+[cpl_fire]
+  standard_name = do_fire_coupling
+  long_name = flag controlling fire_behavior collection (default off)
+  units = flag
+  dimensions = ()
+  type = logical
+  intent = in
 [qss]
   standard_name = surface_specific_humidity
   long_name = surface air saturation specific humidity

physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_post.F90

@@ -45,7 +45,7 @@ end subroutine GFS_surface_generic_post_init
 !> \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, cplaqm, cplchm, cplwav, cpllnd, lssav, dry, icy, wet,                    &
+      subroutine GFS_surface_generic_post_run (im, cplflx, cplaqm, cplchm, cplwav, cpllnd, cpl_fire, lssav, dry, icy, wet,          &
         lsm, lsm_noahmp, 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, pah, pahi,  &
@@ -59,7 +59,7 @@ subroutine GFS_surface_generic_post_run (im, cplflx, cplaqm, cplchm, cplwav, cpl
         implicit none
 
         integer,                                intent(in) :: im
-        logical,                                intent(in) :: cplflx, cplaqm, cplchm, cplwav, cpllnd, lssav
+        logical,                                intent(in) :: cplflx, cplaqm, cplchm, cplwav, cpllnd, cpl_fire, lssav
         logical, dimension(:),                  intent(in) :: dry, icy, wet
         integer,                                intent(in) :: lsm, lsm_noahmp
         real(kind=kind_phys),                   intent(in) :: dtf
@@ -136,9 +136,20 @@ subroutine GFS_surface_generic_post_run (im, cplflx, cplaqm, cplchm, cplwav, cpl
             dswsfci_cpl (i) = adjsfcdsw(i)
             dlwsfc_cpl  (i) = dlwsfc_cpl(i) + adjsfcdlw(i)*dtf
             dswsfc_cpl  (i) = dswsfc_cpl(i) + adjsfcdsw(i)*dtf
+          enddo
+        endif
+
+        if (cplflx .or. cpllnd .or. cpl_fire) then
+          do i=1,im
             psurfi_cpl  (i) = pgr(i)
           enddo
         endif
+        if (cplflx .or. cpl_fire) then
+          do i=1,im
+            t2mi_cpl    (i) = t2m(i)
+            q2mi_cpl    (i) = q2m(i)
+          enddo
+        endif
 
         if (cplflx) then
           do i=1,im
@@ -155,8 +166,6 @@ subroutine GFS_surface_generic_post_run (im, cplflx, cplaqm, cplchm, cplwav, cpl
               nlwsfci_cpl(i) = adjsfcdlw(i) - adjsfculw_wat(i)
             endif
             nlwsfc_cpl  (i) = nlwsfc_cpl(i) + nlwsfci_cpl(i)*dtf
-            t2mi_cpl    (i) = t2m(i)
-            q2mi_cpl    (i) = q2m(i)
           enddo
         endif
 

physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_post.meta

@@ -126,6 +126,13 @@
   dimensions = ()
   type = logical
   intent = in
+[cpl_fire]
+  standard_name = do_fire_coupling
+  long_name = flag controlling fire_behavior collection (default off)
+  units = flag
+  dimensions = ()
+  type = logical
+  intent = in
 [lssav]
   standard_name = flag_for_diagnostics
   long_name = logical flag for storing diagnostics

physics/smoke_dust/rrfs_smoke_wrapper.F90

@@ -110,28 +110,30 @@ end subroutine rrfs_smoke_wrapper_init
 !!
 !>\section rrfs_smoke_wrapper rrfs-sd Scheme General Algorithm
 !> @{
-    subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate,          &
+    subroutine rrfs_smoke_wrapper_run(im, flag_init, kte, kme, ktau, dt, garea, land, jdate,          &
                    u10m, v10m, ustar, rlat, rlon, tskin, pb2d, t2m, dpt2m,                 &
                    pr3d, ph3d,phl3d, prl3d, tk3d, us3d, vs3d, spechum, w,                  &
                    nsoil, smc, tslb, vegtype_dom, vegtype_frac, soiltyp, nlcat,            &
-                   dswsfc, zorl, snow, julian,recmol,                                      &
+                   dswsfc, zorl, snow, julian, recmol,                                     &
                    idat, rain_cpl, rainc_cpl, hf2d, g, pi, con_cp, con_rd, con_fv,         &
                    dust12m_in, emi_ant_in, smoke_RRFS, smoke2d_RRFS,                       &
                    ntrac, qgrs, gq0, chem3d, tile_num,                                     &
-                   ntsmoke, ntdust, ntcoarsepm, imp_physics, imp_physics_thompson,         &
+                   ntfsmoke, ntsmoke, ntdust, ntcoarsepm,                                  &
+                   imp_physics, imp_physics_thompson,                                      &
                    nwfa, nifa, emanoc, emdust, emseas, drydep_flux_out, wetdpr,            &
                    ebb_smoke_in, frp_output, coef_bb, fire_type_out,                       &
                    ebu_smoke,fhist,min_fplume,                                             &
                    max_fplume, hwp, hwp_ave, wetness, ndvel, ddvel_inout,                  &
+                   smoke_fire, cpl_fire,                                                   &
                    peak_hr_out,lu_nofire_out,lu_qfire_out,                                 &
                    fire_heat_flux_out, frac_grid_burned_out, kpbl,oro,                     &
                    uspdavg, hpbl_thetav, mpicomm, mpirank, mpiroot, errmsg,errflg          )
-
     implicit none
 
 
     integer,        intent(in) :: im,kte,kme,ktau,nsoil,tile_num,jdate(8),idat(8)
-    integer,        intent(in) :: ntrac, ntsmoke, ntdust, ntcoarsepm, ndvel, nlcat
+    integer,        intent(in) :: ntrac, ntfsmoke, ntsmoke, ntdust, ntcoarsepm, ndvel, nlcat
+    logical,        intent(in) :: flag_init
     real(kind_phys),intent(in) :: dt, julian, g, pi, con_cp, con_rd, con_fv
 
     integer, parameter :: ids=1,jds=1,jde=1, kds=1
@@ -166,6 +168,8 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate,
     real(kind_phys), dimension(:),     intent(in),    optional :: wetness
     real(kind_phys), dimension(:),     intent(out),   optional :: lu_nofire_out,lu_qfire_out
     integer,         dimension(:),     intent(out),   optional :: fire_type_out
+    real(kind_phys), dimension(:),     intent(in),    optional :: smoke_fire
+    logical,                           intent(in)    :: cpl_fire
     integer,                           intent(in)    :: imp_physics, imp_physics_thompson
     integer,         dimension(:),     intent(in)    :: kpbl
     real(kind_phys), dimension(:),     intent(in)    :: oro
@@ -235,6 +239,19 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate,
     errmsg = ''
     errflg = 0
 
+    if (cpl_fire) then
+      if (flag_init) then
+        do i=1,im
+          do k=kts,kte
+            qgrs(i,k,ntfsmoke) = 0.
+          end do
+        end do
+      endif
+      do i=1,im
+        qgrs(i,kts,ntfsmoke) = qgrs(i,kts,ntfsmoke) + smoke_fire(i)
+      end do
+    endif
+
     if (.not. do_rrfs_sd) return
 
     ! -- set domain

physics/smoke_dust/rrfs_smoke_wrapper.meta

@@ -200,6 +200,13 @@
   dimensions = ()
   type = integer
   intent = in
+[flag_init]
+  standard_name = flag_for_first_timestep
+  long_name = flag signaling first time step for time integration loop
+  units = flag
+  dimensions = ()
+  type = logical
+  intent = in
 [kte]
   standard_name = vertical_layer_dimension
   long_name = vertical layer dimension
@@ -642,6 +649,13 @@
   dimensions = ()
   type = integer
   intent = in
+[ntfsmoke]
+  standard_name = index_for_fire_smoke_in_tracer_concentration_array
+  long_name = tracer index for fire smoke
+  units = index
+  dimensions = ()
+  type = integer
+  intent = in
 [ntdust]
   standard_name = index_for_dust_in_tracer_concentration_array
   long_name = tracer index for dust
@@ -946,6 +960,22 @@
   type = real
   kind = kind_phys
   intent = in
+[smoke_fire]
+  standard_name = smoke_emission_of_fire
+  long_name = smoke emission of fire
+  units = kg m-2
+  dimensions = (horizontal_loop_extent)
+  type = real
+  kind = kind_phys
+  intent = in
+  optional = True
+[cpl_fire]
+  standard_name = do_fire_coupling
+  long_name = flag controlling fire_behavior collection (default off)
+  units = flag
+  dimensions = ()
+  type = logical
+  intent = in
 [errmsg]
   standard_name = ccpp_error_message
   long_name = error message for error handling in CCPP