Skip to content

Commit

Permalink
Merge pull request #1247 from adrifoster/fire_refactor_fuel
Browse files Browse the repository at this point in the history 
Refactor spitfire fuel calculations
  • Loading branch information
@adrifoster
adrifoster authored Nov 13, 2024
2 parents 1be3962 + bdb253f commit e3e7d2c
Show file tree
Hide file tree
Showing 32 changed files with 1,968 additions and 452 deletions.
35 changes: 14 additions & 21 deletions biogeochem/EDPatchDynamicsMod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -38,8 +38,7 @@ module EDPatchDynamicsMod
use FatesConstantsMod , only : ican_upper
use PRTGenericMod , only : num_elements
use PRTGenericMod , only : element_list
use FatesLitterMod , only : lg_sf
use FatesLitterMod , only : dl_sf
use FatesFuelClassesMod , only : fuel_classes
use FatesConstantsMod , only : N_DIST_TYPES
use EDTypesMod , only : AREA_INV
use EDTypesMod , only : dump_site
Expand Down Expand Up @@ -765,11 +764,11 @@ subroutine spawn_patches( currentSite, bc_in)

! Transfer the litter existing already in the donor patch to the new patch
! This call will only transfer non-burned litter to new patch
! and burned litter to atmosphere. Thus it is important to zero burnt_frac_litter when
! 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%burnt_frac_litter(:) = 0._r8
currentPatch%fuel%frac_burnt(:) = 0._r8
end if

call CopyPatchMeansTimers(currentPatch, newPatch)
Expand Down Expand Up @@ -1053,7 +1052,7 @@ subroutine spawn_patches( currentSite, bc_in)

! Grasses determine their fraction of leaves burned here

leaf_burn_frac = currentPatch%burnt_frac_litter(lg_sf)
leaf_burn_frac = currentPatch%fuel%frac_burnt(fuel_classes%live_grass())
endif

! Perform a check to make sure that spitfire gave
Expand Down Expand Up @@ -1727,7 +1726,7 @@ subroutine split_patch(currentSite, currentPatch, new_patch, fraction_to_keep, a

call TransLitterNewPatch( currentSite, currentPatch, new_patch, temp_area)

currentPatch%burnt_frac_litter(:) = 0._r8
currentPatch%fuel%frac_burnt(:) = 0._r8

! Next, we loop through the cohorts in the donor patch, copy them with
! area modified number density into the new-patch, and apply survivorship.
Expand Down Expand Up @@ -2082,10 +2081,10 @@ subroutine TransLitterNewPatch(currentSite, &

! Transfer above ground CWD
donatable_mass = curr_litt%ag_cwd(c) * patch_site_areadis * &
(1._r8 - currentPatch%burnt_frac_litter(c))
(1._r8 - currentPatch%fuel%frac_burnt(c))

burned_mass = curr_litt%ag_cwd(c) * patch_site_areadis * &
currentPatch%burnt_frac_litter(c)
currentPatch%fuel%frac_burnt(c)

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
Expand All @@ -2106,10 +2105,10 @@ subroutine TransLitterNewPatch(currentSite, &

! Transfer leaf fines
donatable_mass = curr_litt%leaf_fines(dcmpy) * patch_site_areadis * &
(1._r8 - currentPatch%burnt_frac_litter(dl_sf))
(1._r8 - currentPatch%fuel%frac_burnt(fuel_classes%dead_leaves()))

burned_mass = curr_litt%leaf_fines(dcmpy) * patch_site_areadis * &
currentPatch%burnt_frac_litter(dl_sf)
currentPatch%fuel%frac_burnt(fuel_classes%dead_leaves())

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
Expand Down Expand Up @@ -3266,6 +3265,8 @@ subroutine fuse_2_patches(csite, dp, rp)
do el = 1,num_elements
call rp%litter(el)%FuseLitter(rp%area,dp%area,dp%litter(el))
end do

call rp%fuel%Fuse(rp%area, dp%area, dp%fuel)

if ( rp%land_use_label .ne. dp%land_use_label) then
write(fates_log(),*) 'trying to fuse patches with different land_use_label values'
Expand Down Expand Up @@ -3296,22 +3297,15 @@ subroutine fuse_2_patches(csite, dp, rp)

call rp%tveg_longterm%FuseRMean(dp%tveg_longterm,rp%area*inv_sum_area)

rp%fuel_eff_moist = (dp%fuel_eff_moist*dp%area + rp%fuel_eff_moist*rp%area) * inv_sum_area
rp%livegrass = (dp%livegrass*dp%area + rp%livegrass*rp%area) * inv_sum_area
rp%sum_fuel = (dp%sum_fuel*dp%area + rp%sum_fuel*rp%area) * inv_sum_area
rp%fuel_bulkd = (dp%fuel_bulkd*dp%area + rp%fuel_bulkd*rp%area) * inv_sum_area
rp%fuel_sav = (dp%fuel_sav*dp%area + rp%fuel_sav*rp%area) * inv_sum_area
rp%fuel_mef = (dp%fuel_mef*dp%area + rp%fuel_mef*rp%area) * inv_sum_area
rp%ros_front = (dp%ros_front*dp%area + rp%ros_front*rp%area) * inv_sum_area
rp%tau_l = (dp%tau_l*dp%area + rp%tau_l*rp%area) * inv_sum_area
rp%fuel_frac(:) = (dp%fuel_frac(:)*dp%area + rp%fuel_frac(:)*rp%area) * inv_sum_area
rp%livegrass = (dp%livegrass*dp%area + rp%livegrass*rp%area) * inv_sum_area
rp%ros_front = (dp%ros_front*dp%area + rp%ros_front*rp%area) * inv_sum_area
rp%tau_l = (dp%tau_l*dp%area + rp%tau_l*rp%area) * inv_sum_area
rp%tfc_ros = (dp%tfc_ros*dp%area + rp%tfc_ros*rp%area) * inv_sum_area
rp%fi = (dp%fi*dp%area + rp%fi*rp%area) * inv_sum_area
rp%fd = (dp%fd*dp%area + rp%fd*rp%area) * inv_sum_area
rp%ros_back = (dp%ros_back*dp%area + rp%ros_back*rp%area) * inv_sum_area
rp%scorch_ht(:) = (dp%scorch_ht(:)*dp%area + rp%scorch_ht(:)*rp%area) * inv_sum_area
rp%frac_burnt = (dp%frac_burnt*dp%area + rp%frac_burnt*rp%area) * inv_sum_area
rp%burnt_frac_litter(:) = (dp%burnt_frac_litter(:)*dp%area + rp%burnt_frac_litter(:)*rp%area) * inv_sum_area
rp%btran_ft(:) = (dp%btran_ft(:)*dp%area + rp%btran_ft(:)*rp%area) * inv_sum_area
rp%zstar = (dp%zstar*dp%area + rp%zstar*rp%area) * inv_sum_area
rp%c_stomata = (dp%c_stomata*dp%area + rp%c_stomata*rp%area) * inv_sum_area
Expand Down Expand Up @@ -3406,7 +3400,6 @@ subroutine fuse_2_patches(csite, dp, rp)
olderp%younger => null()
end if


if(associated(olderp))then
! Update the older patch's new younger patch (becuase it isn't dp anymore)
olderp%younger => youngerp
Expand Down
6 changes: 3 additions & 3 deletions biogeochem/EDPhysiologyMod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -53,8 +53,8 @@ module EDPhysiologyMod
use EDTypesMod , only : site_massbal_type
use EDTypesMod , only : numlevsoil_max
use EDTypesMod , only : numWaterMem
use FatesFuelClassesMod , only : fuel_classes
use EDTypesMod , only : elem_diag_type
use FatesLitterMod , only : dl_sf
use EDParamsMod , only : dinc_vai, dlower_vai
use EDTypesMod , only : area_inv
use EDTypesMod , only : AREA
Expand Down Expand Up @@ -3269,11 +3269,11 @@ subroutine CWDOut( litt, fragmentation_scaler, nlev_eff_decomp )
do dcmpy = 1,ndcmpy

litt%leaf_fines_frag(dcmpy) = litt%leaf_fines(dcmpy) * &
years_per_day * SF_val_max_decomp(dl_sf) * fragmentation_scaler(soil_layer_index)
years_per_day * SF_val_max_decomp(fuel_classes%dead_leaves()) * fragmentation_scaler(soil_layer_index)

do ilyr = 1,nlev_eff_decomp
litt%root_fines_frag(dcmpy,ilyr) = litt%root_fines(dcmpy,ilyr) * &
years_per_day * SF_val_max_decomp(dl_sf) * fragmentation_scaler(ilyr)
years_per_day * SF_val_max_decomp(fuel_classes%dead_leaves()) * fragmentation_scaler(ilyr)
end do
enddo

Expand Down
12 changes: 0 additions & 12 deletions biogeochem/FatesLitterMod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -54,18 +54,6 @@ module FatesLitterMod
integer, public, parameter :: ilabile = 1 ! Array index for labile portion
integer, public, parameter :: icellulose = 2 ! Array index for cellulose portion
integer, public, parameter :: ilignin = 3 ! Array index for the lignin portion

! SPITFIRE

integer, parameter, public :: NFSC = NCWD+2 ! number fuel size classes (4 cwd size classes, leaf litter, and grass)
integer, parameter, public :: tw_sf = 1 ! array index of twig pool for spitfire
integer, parameter, public :: lb_sf = 3 ! array index of large branch pool for spitfire
integer, parameter, public :: tr_sf = 4 ! array index of dead trunk pool for spitfire
integer, parameter, public :: dl_sf = 5 ! array index of dead leaf pool for spitfire (dead grass and dead leaves)
integer, parameter, public :: lg_sf = 6 ! array index of live grass pool for spitfire



type, public :: litter_type

! This object is allocated for each element (C, N, P, etc) that we wish to track.
Expand Down
99 changes: 58 additions & 41 deletions biogeochem/FatesPatchMod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -6,17 +6,19 @@ module FatesPatchMod
use FatesConstantsMod, only : primaryland, secondaryland
use FatesConstantsMod, only : n_landuse_cats
use FatesConstantsMod, only : TRS_regeneration
use FatesConstantsMod, only : itrue
use FatesConstantsMod, only : itrue, ifalse
use FatesGlobals, only : fates_log
use FatesGlobals, only : endrun => fates_endrun
use FatesUtilsMod, only : check_hlm_list
use FatesUtilsMod, only : check_var_real
use FatesCohortMod, only : fates_cohort_type
use FatesRunningMeanMod, only : rmean_type, rmean_arr_type
use FatesLitterMod, only : nfsc
use FatesLitterMod, only : litter_type
use FatesFuelMod, only : fuel_type
use PRTGenericMod, only : num_elements
use PRTGenericMod, only : element_list
use PRTGenericMod, only : carbon12_element
use PRTGenericMod, only : struct_organ, leaf_organ, sapw_organ
use PRTParametersMod, only : prt_params
use FatesConstantsMod, only : nocomp_bareground
use EDParamsMod, only : nlevleaf, nclmax, maxpft
Expand Down Expand Up @@ -195,24 +197,14 @@ module FatesPatchMod

! LITTER AND COARSE WOODY DEBRIS
type(litter_type), pointer :: litter(:) ! litter (leaf,fnrt,CWD and seeds) for different elements
type(fuel_type), pointer :: fuel ! fuel class
real(r8), allocatable :: fragmentation_scaler(:) ! scale rate of litter fragmentation based on soil layer [0-1]

!---------------------------------------------------------------------------

! FUELS AND FIRE
! fuel characteristics
real(r8) :: sum_fuel ! total ground fuel related to ROS (omits 1000 hr fuels) [kgC/m2]
real(r8) :: fuel_frac(nfsc) ! fraction of each litter class in the ros_fuel [0-1]
real(r8) :: livegrass ! total aboveground grass biomass in patch [kgC/m2]
real(r8) :: fuel_bulkd ! average fuel bulk density of the ground fuel. [kg/m3]
! (incl. live grasses, omits 1000hr fuels)
real(r8) :: fuel_sav ! average surface area to volume ratio of the ground fuel [cm-1]
! (incl. live grasses, omits 1000hr fuels)
real(r8) :: fuel_mef ! average moisture of extinction factor
! of the ground fuel (incl. live grasses, omits 1000hr fuels)
real(r8) :: fuel_eff_moist ! effective avearage fuel moisture content of the ground fuel
! (incl. live grasses. omits 1000hr fuels)
real(r8) :: litter_moisture(nfsc) ! moisture of litter [m3/m3]

! fire spread
real(r8) :: ros_front ! rate of forward spread of fire [m/min]
Expand All @@ -221,13 +213,11 @@ module FatesPatchMod
real(r8) :: fi ! average fire intensity of flaming front [kJ/m/s] or [kW/m]
integer :: fire ! is there a fire? [1=yes; 0=no]
real(r8) :: fd ! fire duration [min]
real(r8) :: frac_burnt ! fraction of patch burnt by fire

! fire effects
real(r8) :: scorch_ht(maxpft) ! scorch height [m]
real(r8) :: frac_burnt ! fraction burnt [0-1/day]
real(r8) :: tfc_ros ! total intensity-relevant fuel consumed - no trunks [kgC/m2 of burned ground/day]
real(r8) :: burnt_frac_litter(nfsc) ! fraction of each litter pool burned, conditional on it being burned [0-1]

!---------------------------------------------------------------------------

! PLANT HYDRAULICS (not currently used in hydraulics RGK 03-2018)
Expand All @@ -245,6 +235,7 @@ module FatesPatchMod
procedure :: InitLitter
procedure :: Create
procedure :: UpdateTreeGrassArea
procedure :: UpdateLiveGrass
procedure :: FreeMemory
procedure :: Dump
procedure :: CheckVars
Expand Down Expand Up @@ -506,25 +497,17 @@ subroutine NanValues(this)
this%fragmentation_scaler(:) = nan

! FUELS AND FIRE
this%sum_fuel = nan
this%fuel_frac(:) = nan
this%livegrass = nan
this%fuel_bulkd = nan
this%fuel_sav = nan
this%fuel_mef = nan
this%fuel_eff_moist = nan
this%litter_moisture(:) = nan
this%ros_front = nan
this%ros_back = nan
this%tau_l = nan
this%fi = nan
this%fire = fates_unset_int
this%fd = nan
this%scorch_ht(:) = nan
this%tfc_ros = nan
this%frac_burnt = nan
this%tfc_ros = nan
this%burnt_frac_litter(:) = nan


end subroutine NanValues

!===========================================================================
Expand Down Expand Up @@ -600,23 +583,15 @@ subroutine ZeroValues(this)
this%fragmentation_scaler(:) = 0.0_r8

! FIRE
this%sum_fuel = 0.0_r8
this%fuel_frac(:) = 0.0_r8
this%livegrass = 0.0_r8
this%fuel_bulkd = 0.0_r8
this%fuel_sav = 0.0_r8
this%fuel_mef = 0.0_r8
this%fuel_eff_moist = 0.0_r8
this%litter_moisture(:) = 0.0_r8
this%ros_front = 0.0_r8
this%ros_back = 0.0_r8
this%tau_l = 0.0_r8
this%fi = 0.0_r8
this%fd = 0.0_r8
this%scorch_ht(:) = 0.0_r8
this%frac_burnt = 0.0_r8
this%tfc_ros = 0.0_r8
this%burnt_frac_litter(:) = 0.0_r8
this%frac_burnt = 0.0_r8

end subroutine ZeroValues

Expand Down Expand Up @@ -738,6 +713,10 @@ subroutine Create(this, age, area, land_use_label, nocomp_pft, num_swb, num_pft,
! initialize litter
call this%InitLitter(num_pft, num_levsoil)

! initialize fuel
allocate(this%fuel)
call this%fuel%Init()

this%twostr%scelg => null() ! The radiation module will check if this
! is associated, since it is not, it will then
! initialize and allocate
Expand Down Expand Up @@ -776,7 +755,7 @@ subroutine UpdateTreeGrassArea(this)
class(fates_patch_type), intent(inout) :: this ! patch object

! LOCALS:
type(fates_cohort_Type), pointer :: currentCohort ! cohort object
type(fates_cohort_type), pointer :: currentCohort ! cohort object
real(r8) :: tree_area ! treed area of patch [m2]
real(r8) :: grass_area ! grass area of patch [m2]

Expand All @@ -802,6 +781,38 @@ end subroutine UpdateTreeGrassArea

!===========================================================================

subroutine UpdateLiveGrass(this)
!
! DESCRIPTION:
! Calculates the sum of live grass biomass [kgC/m2] on a patch

! ARGUMENTS:
class(fates_patch_type), intent(inout) :: this ! patch

! LOCALS:
real(r8) :: live_grass ! live grass [kgC/m2]
type(fates_cohort_type), pointer :: currentCohort ! cohort type

live_grass = 0.0_r8
currentCohort => this%tallest
do while(associated(currentCohort))
! for grasses sum all aboveground tissues
if (prt_params%woody(currentCohort%pft) == ifalse) then
live_grass = live_grass + &
(currentCohort%prt%GetState(leaf_organ, carbon12_element) + &
currentCohort%prt%GetState(sapw_organ, carbon12_element) + &
currentCohort%prt%GetState(struct_organ, carbon12_element))* &
currentCohort%n/this%area
endif
currentCohort => currentCohort%shorter
enddo

this%livegrass = live_grass

end subroutine UpdateLiveGrass

!===========================================================================

subroutine FreeMemory(this, regeneration_model, numpft)
!
! DESCRIPTION:
Expand Down Expand Up @@ -849,7 +860,13 @@ subroutine FreeMemory(this, regeneration_model, numpft)
write(fates_log(),*) 'dealloc008: fail on deallocate(this%litter):'//trim(smsg)
call endrun(msg=errMsg(sourcefile, __LINE__))
endif


deallocate(this%fuel, stat=istat, errmsg=smsg)
if (istat/=0) then
write(fates_log(),*) 'dealloc009: fail on deallocate patch fuel:'//trim(smsg)
call endrun(msg=errMsg(sourcefile, __LINE__))
endif

! deallocate the allocatable arrays
deallocate(this%tr_soil_dir, &
this%tr_soil_dif, &
Expand Down Expand Up @@ -889,24 +906,24 @@ subroutine FreeMemory(this, regeneration_model, numpft)
end if

if (istat/=0) then
write(fates_log(),*) 'dealloc009: fail on deallocate patch vectors:'//trim(smsg)
write(fates_log(),*) 'dealloc010: fail on deallocate patch vectors:'//trim(smsg)
call endrun(msg=errMsg(sourcefile, __LINE__))
endif

! deallocate running means
deallocate(this%tveg24, stat=istat, errmsg=smsg)
if (istat/=0) then
write(fates_log(),*) 'dealloc010: fail on deallocate(this%tveg24):'//trim(smsg)
write(fates_log(),*) 'dealloc011: fail on deallocate(this%tveg24):'//trim(smsg)
call endrun(msg=errMsg(sourcefile, __LINE__))
endif
deallocate(this%tveg_lpa, stat=istat, errmsg=smsg)
if (istat/=0) then
write(fates_log(),*) 'dealloc011: fail on deallocate(this%tveg_lpa):'//trim(smsg)
write(fates_log(),*) 'dealloc012: fail on deallocate(this%tveg_lpa):'//trim(smsg)
call endrun(msg=errMsg(sourcefile, __LINE__))
endif
deallocate(this%tveg_longterm, stat=istat, errmsg=smsg)
if (istat/=0) then
write(fates_log(),*) 'dealloc012: fail on deallocate(this%tveg_longterm):'//trim(smsg)
write(fates_log(),*) 'dealloc013: fail on deallocate(this%tveg_longterm):'//trim(smsg)
call endrun(msg=errMsg(sourcefile, __LINE__))
endif

Expand Down
2 changes: 2 additions & 0 deletions fire/CMakeLists.txt
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3,6 +3,8 @@ list(APPEND fates_sources
SFParamsMod.F90
SFFireWeatherMod.F90
SFNesterovMod.F90
FatesFuelMod.F90
FatesFuelClassesMod.F90
)

sourcelist_to_parent(fates_sources)
Loading

0 comments on commit e3e7d2c

Please sign in to comment.