Skip to content

Commit

Permalink
Merge pull request #1215 from adrifoster/fire_weather_wind
Browse files Browse the repository at this point in the history
Fire weather refactor (non-b4b)
  • Loading branch information
glemieux authored Aug 29, 2024
2 parents b469786 + 04332a4 commit e06e0df
Show file tree
Hide file tree
Showing 9 changed files with 230 additions and 158 deletions.
1 change: 0 additions & 1 deletion biogeochem/EDPatchDynamicsMod.F90
Original file line number Diff line number Diff line change
Expand Up @@ -3289,7 +3289,6 @@ subroutine fuse_2_patches(csite, dp, rp)
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%effect_wspeed = (dp%effect_wspeed*dp%area + rp%effect_wspeed*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%tfc_ros = (dp%tfc_ros*dp%area + rp%tfc_ros*rp%area) * inv_sum_area
Expand Down
52 changes: 46 additions & 6 deletions biogeochem/FatesPatchMod.F90
Original file line number Diff line number Diff line change
Expand Up @@ -6,6 +6,7 @@ module FatesPatchMod
use FatesConstantsMod, only : primaryland, secondaryland
use FatesConstantsMod, only : n_landuse_cats
use FatesConstantsMod, only : TRS_regeneration
use FatesConstantsMod, only : itrue
use FatesGlobals, only : fates_log
use FatesGlobals, only : endrun => fates_endrun
use FatesUtilsMod, only : check_hlm_list
Expand All @@ -16,6 +17,8 @@ module FatesPatchMod
use FatesLitterMod, only : litter_type
use PRTGenericMod, only : num_elements
use PRTGenericMod, only : element_list
use PRTParametersMod, only : prt_params
use FatesConstantsMod, only : nocomp_bareground
use EDParamsMod, only : nlevleaf, nclmax, maxpft
use FatesConstantsMod, only : n_dbh_bins, n_dist_types
use FatesConstantsMod, only : t_water_freeze_k_1atm
Expand Down Expand Up @@ -100,6 +103,7 @@ module FatesPatchMod
! used to determine attenuation of parameters during photosynthesis
real(r8) :: total_canopy_area ! area that is covered by vegetation [m2]
real(r8) :: total_tree_area ! area that is covered by woody vegetation [m2]
real(r8) :: total_grass_area ! area that is covered by non-woody vegetation [m2]
real(r8) :: zstar ! height of smallest canopy tree, only meaningful in "strict PPA" mode [m]

! exposed leaf area in each canopy layer, pft, and leaf layer [m2 leaf/m2 contributing crown area]
Expand Down Expand Up @@ -213,7 +217,6 @@ module FatesPatchMod
! fire spread
real(r8) :: ros_front ! rate of forward spread of fire [m/min]
real(r8) :: ros_back ! rate of backward spread of fire [m/min]
real(r8) :: effect_wspeed ! windspeed modified by fraction of relative grass and tree cover [m/min]
real(r8) :: tau_l ! duration of lethal heating [min]
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]
Expand Down Expand Up @@ -241,6 +244,7 @@ module FatesPatchMod
procedure :: InitRunningMeans
procedure :: InitLitter
procedure :: Create
procedure :: UpdateTreeGrassArea
procedure :: FreeMemory
procedure :: Dump
procedure :: CheckVars
Expand Down Expand Up @@ -451,7 +455,8 @@ subroutine NanValues(this)
this%pft_agb_profile(:,:) = nan
this%canopy_layer_tlai(:) = nan
this%total_canopy_area = nan
this%total_tree_area = nan
this%total_tree_area = nan
this%total_grass_area = nan
this%zstar = nan


Expand Down Expand Up @@ -511,7 +516,6 @@ subroutine NanValues(this)
this%litter_moisture(:) = nan
this%ros_front = nan
this%ros_back = nan
this%effect_wspeed = nan
this%tau_l = nan
this%fi = nan
this%fire = fates_unset_int
Expand Down Expand Up @@ -565,7 +569,8 @@ subroutine ZeroValues(this)

! LEAF ORGANIZATION
this%canopy_layer_tlai(:) = 0.0_r8
this%total_tree_area = 0.0_r8
this%total_tree_area = 0.0_r8
this%total_grass_area = 0.0_r8
this%zstar = 0.0_r8

this%c_stomata = 0.0_r8
Expand All @@ -574,7 +579,6 @@ subroutine ZeroValues(this)

! RADIATION
this%rad_error(:) = 0.0_r8

this%tr_soil_dir_dif(:) = 0.0_r8
this%fab(:) = 0.0_r8
this%fabi(:) = 0.0_r8
Expand Down Expand Up @@ -606,7 +610,6 @@ subroutine ZeroValues(this)
this%litter_moisture(:) = 0.0_r8
this%ros_front = 0.0_r8
this%ros_back = 0.0_r8
this%effect_wspeed = 0.0_r8
this%tau_l = 0.0_r8
this%fi = 0.0_r8
this%fd = 0.0_r8
Expand Down Expand Up @@ -763,6 +766,42 @@ end subroutine Create

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

subroutine UpdateTreeGrassArea(this)
!
! DESCRIPTION:
! calculate and update the total tree area and grass area (by canopy) on patch
!

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

! LOCALS:
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]

if (this%nocomp_pft_label /= nocomp_bareground) then
tree_area = 0.0_r8
grass_area = 0.0_r8

currentCohort => this%tallest
do while(associated(currentCohort))
if (prt_params%woody(currentCohort%pft) == itrue) then
tree_area = tree_area + currentCohort%c_area
else
grass_area = grass_area + currentCohort%c_area
end if
currentCohort => currentCohort%shorter
end do

this%total_tree_area = min(tree_area, this%area)
this%total_grass_area = min(grass_area, this%area)
end if

end subroutine UpdateTreeGrassArea

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

subroutine FreeMemory(this, regeneration_model, numpft)
!
! DESCRIPTION:
Expand Down Expand Up @@ -913,6 +952,7 @@ subroutine Dump(this)
write(fates_log(),*) 'pa%ncl_p = ',this%ncl_p
write(fates_log(),*) 'pa%total_canopy_area = ',this%total_canopy_area
write(fates_log(),*) 'pa%total_tree_area = ',this%total_tree_area
write(fates_log(),*) 'pa%total_grass_area = ',this%total_grass_area
write(fates_log(),*) 'pa%zstar = ',this%zstar
write(fates_log(),*) 'pa%solar_zenith_flag = ',this%solar_zenith_flag
write(fates_log(),*) 'pa%solar_zenith_angle = ',this%solar_zenith_angle
Expand Down
39 changes: 38 additions & 1 deletion fire/SFFireWeatherMod.F90
Original file line number Diff line number Diff line change
Expand Up @@ -6,27 +6,64 @@ module SFFireWeatherMod
private

type, abstract, public :: fire_weather

real(r8) :: fire_weather_index ! fire weather index
real(r8) :: effective_windspeed ! effective wind speed, corrected for by tree/grass cover [m/min]

contains

procedure(initialize_fire_weather), public, deferred :: Init
procedure(update_fire_weather), public, deferred :: Update
procedure(update_fire_weather), public, deferred :: UpdateIndex
procedure, public :: UpdateEffectiveWindSpeed

end type fire_weather

abstract interface
subroutine initialize_fire_weather(this)

import :: fire_weather

class(fire_weather), intent(inout) :: this

end subroutine initialize_fire_weather

subroutine update_fire_weather(this, temp_C, precip, rh, wind)

use FatesConstantsMod, only : r8 => fates_r8

import :: fire_weather

class(fire_weather), intent(inout) :: this
real(r8), intent(in) :: temp_C
real(r8), intent(in) :: precip
real(r8), intent(in) :: rh
real(r8), intent(in) :: wind

end subroutine update_fire_weather
end interface

contains

subroutine UpdateEffectiveWindSpeed(this, wind_speed, tree_fraction, grass_fraction, &
bare_fraction)
!
! DESCRIPTION:
! Calculates effective wind speed

! CONSTANTS:
real(r8), parameter :: wind_atten_treed = 0.4_r8 ! wind attenuation factor for tree fraction
real(r8), parameter :: wind_atten_grass = 0.6_r8 ! wind attenuation factor for grass fraction

! ARGUMENTS
class(fire_weather), intent(inout) :: this ! fire weather class
real(r8), intent(in) :: wind_speed ! wind speed [m/min]
real(r8), intent(in) :: tree_fraction ! tree fraction [0-1]
real(r8), intent(in) :: grass_fraction ! grass fraction [0-1]
real(r8), intent(in) :: bare_fraction ! bare ground fraction [0-1]

this%effective_windspeed = wind_speed*(tree_fraction*wind_atten_treed + &
(grass_fraction + bare_fraction)*wind_atten_grass)

end subroutine UpdateEffectiveWindSpeed

end module SFFireWeatherMod
Loading

0 comments on commit e06e0df

Please sign in to comment.