Merge pull request #1302 from adrifoster/fuel_frac_fix

Don't zero out `patch%fuel%frac_burnt()` before we use it
NGEET · Jan 3, 2025 · 1689466 · 1689466
2 parents d50c906 + f11b673
commit 1689466
Show file tree

Hide file tree

Showing 2 changed files with 22 additions and 16 deletions.
diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90
@@ -767,13 +767,9 @@ subroutine spawn_patches( currentSite, bc_in)
                             ! and burned litter to atmosphere. Thus it is important to zero fuel%frac_burnt when
                             ! fire is not the current disturbance regime.
 
-                            if(i_disturbance_type .ne. dtype_ifire) then
-                               currentPatch%fuel%frac_burnt(:) = 0._r8
-                            end if
-
                             call CopyPatchMeansTimers(currentPatch, newPatch)
 
-                            call TransLitterNewPatch( currentSite, currentPatch, newPatch, patch_site_areadis)
+                            call TransLitterNewPatch( currentSite, currentPatch, newPatch, patch_site_areadis, i_disturbance_type)
 
                             ! Transfer in litter fluxes from plants in various contexts of death and destruction
                             select case(i_disturbance_type)
@@ -1045,7 +1041,6 @@ subroutine spawn_patches( currentSite, bc_in)
                                   ! Some of of the leaf mass from living plants has been
                                   ! burned off.  Here, we remove that mass, and
                                   ! tally it in the flux we sent to the atmosphere
-
                                   if(prt_params%woody(currentCohort%pft) == itrue)then
                                      leaf_burn_frac = currentCohort%fraction_crown_burned
                                   else
@@ -1724,9 +1719,7 @@ subroutine split_patch(currentSite, currentPatch, new_patch, fraction_to_keep, a
 
     call CopyPatchMeansTimers(currentPatch, new_patch)
 
-    call TransLitterNewPatch( currentSite, currentPatch, new_patch, temp_area)
-
-    currentPatch%fuel%frac_burnt(:) = 0._r8
+    call TransLitterNewPatch( currentSite, currentPatch, new_patch, temp_area, 0)
 
     ! Next, we loop through the cohorts in the donor patch, copy them with
     ! area modified number density into the new-patch, and apply survivorship.
@@ -1922,7 +1915,8 @@ end subroutine set_patchno
   subroutine TransLitterNewPatch(currentSite,        &
                                  currentPatch,       &
                                  newPatch,           &
-                                 patch_site_areadis)
+                                 patch_site_areadis, &
+                                 dist_type)
 
     ! -----------------------------------------------------------------------------------
     ! 
@@ -1971,6 +1965,7 @@ subroutine TransLitterNewPatch(currentSite,        &
     type(fates_patch_type) , intent(inout) :: newPatch           ! New patch
     real(r8)            , intent(in)    :: patch_site_areadis ! Area being donated
                                                               ! by current patch
+    integer,              intent(in)    :: dist_type          ! disturbance type
 
 
     ! locals
@@ -1993,6 +1988,7 @@ subroutine TransLitterNewPatch(currentSite,        &
     real(r8) :: litter_stock0,litter_stock1
     real(r8) :: burn_flux0,burn_flux1
     real(r8) :: error
+    real(r8) :: frac_burnt                 ! fraction burnt of current fuel type [0-1]
 
     do el = 1,num_elements
 
@@ -2076,15 +2072,19 @@ subroutine TransLitterNewPatch(currentSite,        &
           litter_stock0 = curr_litt%GetTotalLitterMass()*currentPatch%area + & 
                           new_litt%GetTotalLitterMass()*newPatch%area
        end if
-
+       
        do c = 1,ncwd
+         frac_burnt = 0.0_r8
+         if (dist_type == dtype_ifire .and. currentPatch%fire == 1) then
+            frac_burnt = currentPatch%fuel%frac_burnt(c)
+         end if 
 
           ! Transfer above ground CWD
           donatable_mass     = curr_litt%ag_cwd(c) * patch_site_areadis * &
-                               (1._r8 - currentPatch%fuel%frac_burnt(c))
+                               (1._r8 - frac_burnt)
 
           burned_mass        = curr_litt%ag_cwd(c) * patch_site_areadis * &
-                               currentPatch%fuel%frac_burnt(c)
+                               frac_burnt
 
           new_litt%ag_cwd(c) = new_litt%ag_cwd(c) + donatable_mass*donate_m2
           curr_litt%ag_cwd(c) = curr_litt%ag_cwd(c) + donatable_mass*retain_m2
@@ -2100,15 +2100,20 @@ subroutine TransLitterNewPatch(currentSite,        &
           end do
 
        enddo
-
+
+       frac_burnt = 0.0_r8
+       if (dist_type == dtype_ifire .and. currentPatch%fire == 1) then
+         frac_burnt = currentPatch%fuel%frac_burnt(fuel_classes%dead_leaves())
+      end if 
+
        do dcmpy=1,ndcmpy
 
            ! Transfer leaf fines
            donatable_mass           = curr_litt%leaf_fines(dcmpy) * patch_site_areadis * &
-                                      (1._r8 - currentPatch%fuel%frac_burnt(fuel_classes%dead_leaves()))
+                                      (1._r8 - frac_burnt)
 
            burned_mass              = curr_litt%leaf_fines(dcmpy) * patch_site_areadis * &
-                                      currentPatch%fuel%frac_burnt(fuel_classes%dead_leaves())
+                                       frac_burnt
 
            new_litt%leaf_fines(dcmpy) = new_litt%leaf_fines(dcmpy) + donatable_mass*donate_m2
            curr_litt%leaf_fines(dcmpy) = curr_litt%leaf_fines(dcmpy) + donatable_mass*retain_m2

diff --git a/fire/SFMainMod.F90 b/fire/SFMainMod.F90
@@ -71,6 +71,7 @@ subroutine DailyFireModel(currentSite, bc_in)
     do while(associated(currentPatch))
       currentPatch%frac_burnt = 0.0_r8
       currentPatch%fire = 0
+      currentPatch%fuel%frac_burnt(:) = 0.0_r8
       currentPatch => currentPatch%older
     end do