Small changes to fire feedback to RUC LSM.

One more variable is added: fraction of grid cell burned by the fire.
This fraction is used to take into account fire's effect on surface albedo.
Also, added some debug prints.
These changes will change the results only when fire feedback is turned on. The default is .false.

physics/lsm_ruc.F90

@@ -360,6 +360,7 @@ subroutine lsm_ruc_run                                            & ! inputs
      &       cm_ice, ch_ice, snowfallac_ice, acsnow_ice, snowmt_ice,    &
      &       albdvis_ice, albdnir_ice,  albivis_ice,  albinir_ice,      &
      &       add_fire_heat_flux, fire_heat_flux_out,                    &
+     &       frac_grid_burned_out,                                      &
      ! --- out
      &       rhosnf, sbsno,                                             &
      &       cmm_lnd, chh_lnd, cmm_ice, chh_ice,                        &
@@ -431,7 +432,8 @@ subroutine lsm_ruc_run                                            & ! inputs
 !  ---  in
       real (kind_phys), dimension(:), intent(in) ::                      &
      &       rainnc, rainc, ice, snow, graupel, rhonewsn1
-      real (kind_phys), dimension(:), intent(in) :: fire_heat_flux_out
+      real (kind_phys), dimension(:), intent(in) :: fire_heat_flux_out,  &
+                                                    frac_grid_burned_out
       logical, intent(in) :: add_fire_heat_flux
 !  ---  in/out:
 !  --- on RUC levels
@@ -984,13 +986,6 @@ subroutine lsm_ruc_run                                            & ! inputs
         snoalb1d_lnd(i,j) = snoalb(i)
         albbck_lnd(i,j)   = min(0.9_kind_phys,albbcksol(i)) !sfalb_lnd_bck(i)
 
-        IF ( add_fire_heat_flux .and. fire_heat_flux_out(i) > 0) then !  JLS
-        ! limit albedo and greenness in the areas affected by the fire
-          albbck_lnd(i,j)   = min(0.1_kind_phys,albbck_lnd(i,j))
-          shdfac(i,j)       = min(50._kind_phys,shdfac(i,j)) ! %
-        ENDIF
-
-
         !-- spp_lsm
         if (spp_lsm == 1) then
           !-- spp for LSM is dimentioned as (1:lsoil_ruc)
@@ -1013,6 +1008,19 @@ subroutine lsm_ruc_run                                            & ! inputs
         alb_lnd(i,j) = albbck_lnd(i,j) * (one-sncovr_lnd(i,j)) + snoalb(i) * sncovr_lnd(i,j) ! sfalb_lnd(i)
         solnet_lnd(i,j) = dswsfc(i)*(one-alb_lnd(i,j)) !..net sw rad flx (dn-up) at sfc in w/m2
 
+        IF ( add_fire_heat_flux .and. fire_heat_flux_out(i) > 0) then !  JLS
+          if (debug_print) then 
+           print *,'alb_lnd before fire, xlat/xlon ', alb_lnd(i,j), xlat_d(i),xlon_d(i)
+           print *,'fire_heat_flux_out, frac_grid_burned_out, xlat/xlon ', &
+                    fire_heat_flux_out(i),frac_grid_burned_out(i),xlat_d(i),xlon_d(i)
+          endif
+          ! limit albedo in the areas affected by the fire
+          alb_lnd(i,j)   = alb_lnd(i,j) * (one-frac_grid_burned_out(i)) + 0.08_kind_phys*frac_grid_burned_out(i)
+          if (debug_print) then
+           print *,'alb_lnd after fire, xlat/xlon ', alb_lnd(i,j), xlat_d(i),xlon_d(i)
+          endif
+        ENDIF
+
         cmc(i,j) = canopy(i)            !  [mm] 
         soilt_lnd(i,j) = tsurf_lnd(i)   
         ! sanity check for snow temperature tsnow

physics/lsm_ruc.meta

@@ -1762,6 +1762,14 @@
   type = real
   kind = kind_phys
   intent = in
+[frac_grid_burned_out]
+  standard_name = fraction_of_grid_cell_burning
+  long_name = ration of the burnt area to the grid cell area
+  units = frac
+  dimensions = (horizontal_loop_extent)
+  type = real
+  kind = kind_phys
+  intent = in
 [errmsg]
   standard_name = ccpp_error_message
   long_name = error message for error handling in CCPP

physics/module_sf_ruclsm.F90

@@ -1825,7 +1825,10 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j,         & !--- input varia
          UPFLUX  = T3 *SOILT
          XINET   = EMISS_snowfree*(GLW-UPFLUX)
          RNET    = GSWnew + XINET
-         IF ( add_fire_heat_flux ) then ! JLS
+         IF ( add_fire_heat_flux .and. fire_heat_flux >0 ) then ! JLS
+          IF (debug_print ) THEN
+            print *,'RNET snow-free, fire_heat_flux, xlat/xlon',RNET, fire_heat_flux,xlat,xlon
+          ENDIF
             RNET = RNET + fire_heat_flux
          ENDIF
 
@@ -1949,7 +1952,10 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j,         & !--- input varia
 
       if (SEAICE .LT. 0.5_kind_phys) then
 ! LAND
-         IF ( add_fire_heat_flux ) then ! JLS
+         IF ( add_fire_heat_flux .and. fire_heat_flux>0 ) then ! JLS
+          IF (debug_print ) THEN
+           print *,'RNET snow, fire_heat_flux, xlat/xlon',RNET, fire_heat_flux,xlat,xlon
+          ENDIF
             RNET = RNET + fire_heat_flux
          ENDIF
            if(snow_mosaic==one)then
@@ -2242,6 +2248,13 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j,         & !--- input varia
 
        if(SEAICE .LT. 0.5_kind_phys) then
 !  LAND
+         IF ( add_fire_heat_flux .and. fire_heat_flux>0) then ! JLS
+          IF (debug_print ) THEN
+           print *,'RNET no snow, fire_heat_flux, xlat/xlon',RNET, fire_heat_flux,xlat,xlon
+          endif
+            RNET = RNET + fire_heat_flux
+         ENDIF
+
          CALL SOIL(debug_print,xlat, xlon, testptlat, testptlon,&
 !--- input variables
             i,j,iland,isoil,delt,ktau,conflx,nzs,nddzs,nroot,   &