Merge pull request #712 from glemieux/newdim-patchage_by_fuelclass

Add new history output dimension patch age x fuel size class
NGEET · Dec 14, 2020 · 5534a94 · 5534a94
2 parents ac2b479 + 86e8f11
commit 5534a94
Show file tree

Hide file tree

Showing 7 changed files with 99 additions and 9 deletions.
diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90
@@ -124,6 +124,7 @@ module FatesHistoryInterfaceMod
   ! scag = size class bin x age bin
   ! scagpft = size class bin x age bin x PFT
   ! agepft  = age bin x PFT
+  ! agefuel = age bin x fuel size class
 
 
   ! A recipe for adding a new history variable to this module:
@@ -623,6 +624,9 @@ module FatesHistoryInterfaceMod
   integer :: ih_fabi_sha_top_si_can
   integer :: ih_crownarea_si_can
 
+  ! indices to (patch age x fuel size class) variables
+  integer :: ih_fuel_amount_age_fuel
+
   ! The number of variable dim/kind types we have defined (static)
 
   integer, parameter, public :: fates_history_num_dimensions = 50
@@ -664,7 +668,7 @@ module FatesHistoryInterfaceMod
      integer, private :: levfuel_index_, levcwdsc_index_, levscag_index_
      integer, private :: levcan_index_, levcnlf_index_, levcnlfpft_index_
      integer, private :: levscagpft_index_, levagepft_index_
-     integer, private :: levheight_index_
+     integer, private :: levheight_index_, levagefuel_index_
      integer, private :: levelem_index_, levelpft_index_
      integer, private :: levelcwd_index_, levelage_index_
      integer, private :: levcacls_index_, levcapf_index_
@@ -706,6 +710,7 @@ module FatesHistoryInterfaceMod
      procedure :: levelpft_index
      procedure :: levelcwd_index
      procedure :: levelage_index
+     procedure :: levagefuel_index
 
      ! private work functions
      procedure, private :: define_history_vars
@@ -732,6 +737,7 @@ module FatesHistoryInterfaceMod
      procedure, private :: set_levscagpft_index
      procedure, private :: set_levagepft_index
      procedure, private :: set_levheight_index
+     procedure, private :: set_levagefuel_index
 
      procedure, private :: set_levelem_index
      procedure, private :: set_levelpft_index
@@ -757,7 +763,7 @@ subroutine Init(this, num_threads, fates_bounds)
     use FatesIODimensionsMod, only : levscagpft, levagepft
     use FatesIODimensionsMod, only : levcan, levcnlf, levcnlfpft
     use FatesIODimensionsMod, only : fates_bounds_type
-    use FatesIODimensionsMod, only : levheight
+    use FatesIODimensionsMod, only : levheight, levagefuel
     use FatesIODimensionsMod, only : levelem, levelpft
     use FatesIODimensionsMod, only : levelcwd, levelage
 
@@ -879,6 +885,11 @@ subroutine Init(this, num_threads, fates_bounds)
     call this%dim_bounds(dim_count)%Init(levelage, num_threads, &
           fates_bounds%elage_begin, fates_bounds%elage_end)
 
+    dim_count = dim_count + 1
+    call this%set_levagefuel_index(dim_count)
+    call this%dim_bounds(dim_count)%Init(levagefuel, num_threads, &
+         fates_bounds%agefuel_begin, fates_bounds%agefuel_end)
+
 
     ! FIXME(bja, 2016-10) assert(dim_count == FatesHistorydimensionmod::num_dimension_types)
 
@@ -989,7 +1000,10 @@ subroutine SetThreadBoundsEach(this, thread_index, thread_bounds)
     call this%dim_bounds(index)%SetThreadBounds(thread_index, &
          thread_bounds%elage_begin, thread_bounds%elage_end)
 
-
+    index = this%levagefuel_index()
+    call this%dim_bounds(index)%SetThreadBounds(thread_index, &
+         thread_bounds%agefuel_begin, thread_bounds%agefuel_end)
+
 
 
 
@@ -1006,7 +1020,7 @@ subroutine assemble_history_output_types(this)
     use FatesIOVariableKindMod, only : site_fuel_r8, site_cwdsc_r8, site_scag_r8
     use FatesIOVariableKindMod, only : site_scagpft_r8, site_agepft_r8
     use FatesIOVariableKindMod, only : site_can_r8, site_cnlf_r8, site_cnlfpft_r8
-    use FatesIOVariableKindMod, only : site_height_r8
+    use FatesIOVariableKindMod, only : site_height_r8, site_agefuel_r8
     use FatesIOVariableKindMod, only : site_elem_r8, site_elpft_r8
     use FatesIOVariableKindMod, only : site_elcwd_r8, site_elage_r8
 
@@ -1085,6 +1099,9 @@ subroutine assemble_history_output_types(this)
 
     call this%set_dim_indices(site_elage_r8, 1, this%column_index())
     call this%set_dim_indices(site_elage_r8, 2, this%levelage_index())
+
+    call this%set_dim_indices(site_agefuel_r8, 1, this%column_index())
+    call this%set_dim_indices(site_agefuel_r8, 2, this%levagefuel_index())
 
 
   end subroutine assemble_history_output_types
@@ -1444,6 +1461,21 @@ end function levelage_index
 
  ! ======================================================================================
 
+ subroutine set_levagefuel_index(this, index)
+     implicit none
+     class(fates_history_interface_type), intent(inout) :: this
+     integer, intent(in) :: index
+     this%levagefuel_index_ = index
+   end subroutine set_levagefuel_index
+
+   integer function levagefuel_index(this)
+      implicit none
+      class(fates_history_interface_type), intent(in) :: this
+      levagefuel_index = this%levagefuel_index_
+   end function levagefuel_index
+
+   ! ======================================================================================
+
  subroutine flush_hvars(this,nc,upfreq_in)
 
    class(fates_history_interface_type)        :: this
@@ -1537,7 +1569,7 @@ subroutine init_dim_kinds_maps(this)
     use FatesIOVariableKindMod, only : site_fuel_r8, site_cwdsc_r8, site_scag_r8
     use FatesIOVariableKindMod, only : site_scagpft_r8, site_agepft_r8
     use FatesIOVariableKindMod, only : site_can_r8, site_cnlf_r8, site_cnlfpft_r8
-    use FatesIOVariableKindMod, only : site_height_r8
+    use FatesIOVariableKindMod, only : site_height_r8, site_agefuel_r8
     use FatesIOVariableKindMod, only : site_elem_r8, site_elpft_r8
     use FatesIOVariableKindMod, only : site_elcwd_r8, site_elage_r8
 
@@ -1645,6 +1677,10 @@ subroutine init_dim_kinds_maps(this)
     index = index + 1
     call this%dim_kinds(index)%Init(site_elage_r8, 2)
 
+    ! site x age x fuel size class
+    index = index + 1
+    call this%dim_kinds(index)%Init(site_agefuel_r8, 2)
+
 
     ! FIXME(bja, 2016-10) assert(index == fates_history_num_dim_kinds)
   end subroutine init_dim_kinds_maps
@@ -1670,6 +1706,7 @@ subroutine update_history_dyn(this,nc,nsites,sites)
     use FatesSizeAgeTypeIndicesMod, only : get_sizeage_class_index
     use FatesSizeAgeTypeIndicesMod, only : get_sizeagepft_class_index
     use FatesSizeAgeTypeIndicesMod, only : get_agepft_class_index
+    use FatesSizeAgeTypeIndicesMod, only : get_agefuel_class_index
     use FatesSizeAgeTypeIndicesMod, only : get_age_class_index
     use FatesSizeAgeTypeIndicesMod, only : get_height_index
     use FatesSizeAgeTypeIndicesMod, only : sizetype_class_index
@@ -1707,7 +1744,8 @@ subroutine update_history_dyn(this,nc,nsites,sites)
     integer  :: i_cwd,i_fuel            ! iterators for cwd and fuel dims
     integer  :: iscag        ! size-class x age index
     integer  :: iscagpft     ! size-class x age x pft index
-    integer  :: iagepft      ! age x pft index
+    integer  :: iagepft     ! age x pft index
+    integer  :: i_agefuel     ! age x fuel size class index
     integer  :: ican, ileaf, cnlf_indx  ! iterators for leaf and canopy level
     integer  :: height_bin_max, height_bin_min   ! which height bin a given cohort's canopy is in
     integer  :: i_heightbin  ! iterator for height bins
@@ -1968,6 +2006,7 @@ subroutine update_history_dyn(this,nc,nsites,sites)
                hio_fire_sum_fuel_si_age           => this%hvars(ih_fire_sum_fuel_si_age)%r82d, &
                hio_burnt_frac_litter_si_fuel      => this%hvars(ih_burnt_frac_litter_si_fuel)%r82d, &
                hio_fuel_amount_si_fuel            => this%hvars(ih_fuel_amount_si_fuel)%r82d, &
+               hio_fuel_amount_age_fuel            => this%hvars(ih_fuel_amount_age_fuel)%r82d, &
                hio_canopy_height_dist_si_height   => this%hvars(ih_canopy_height_dist_si_height)%r82d, &
                hio_leaf_height_dist_si_height     => this%hvars(ih_leaf_height_dist_si_height)%r82d, &
                hio_litter_moisture_si_fuel        => this%hvars(ih_litter_moisture_si_fuel)%r82d, &
@@ -2777,6 +2816,11 @@ subroutine update_history_dyn(this,nc,nsites,sites)
             end do
 
             do i_fuel = 1,nfsc
+
+               i_agefuel = get_agefuel_class_index(cpatch%age,i_fuel)
+               hio_fuel_amount_age_fuel(io_si,i_agefuel) = hio_fuel_amount_age_fuel(io_si,i_agefuel) + &
+                    cpatch%fuel_frac(i_fuel) * cpatch%sum_fuel * cpatch%area * AREA_INV
+
                hio_litter_moisture_si_fuel(io_si, i_fuel) = hio_litter_moisture_si_fuel(io_si, i_fuel) + &
                     cpatch%litter_moisture(i_fuel) * cpatch%area * AREA_INV
 
@@ -4115,7 +4159,7 @@ subroutine define_history_vars(this, initialize_variables)
     use FatesIOVariableKindMod, only : site_r8, site_ground_r8, site_size_pft_r8    
     use FatesIOVariableKindMod, only : site_size_r8, site_pft_r8, site_age_r8
     use FatesIOVariableKindMod, only : site_coage_pft_r8, site_coage_r8
-    use FatesIOVariableKindMod, only : site_height_r8
+    use FatesIOVariableKindMod, only : site_height_r8, site_agefuel_r8
     use FatesInterfaceTypesMod     , only : hlm_use_planthydro
 
     use FatesIOVariableKindMod, only : site_fuel_r8, site_cwdsc_r8, site_scag_r8
@@ -4454,6 +4498,11 @@ subroutine define_history_vars(this, initialize_variables)
          avgflag='A', vtype=site_fuel_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1,   &
          ivar=ivar, initialize=initialize_variables, index = ih_fuel_amount_si_fuel )
 
+    call this%set_history_var(vname='FUEL_AMOUNT_AGEFUEL', units='kg C / m2',                &
+         long='spitfire fuel quantity in each age x fuel class ', use_default='active',       &
+         avgflag='A', vtype=site_agefuel_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1,   &
+         ivar=ivar, initialize=initialize_variables, index = ih_fuel_amount_age_fuel )
+
     call this%set_history_var(vname='AREA_BURNT_BY_PATCH_AGE', units='m2/m2', &
          long='spitfire area burnt by patch age (divide by patch_area_by_age to get burnt fraction by age)', &
          use_default='active', &

diff --git a/main/FatesHistoryVariableType.F90 b/main/FatesHistoryVariableType.F90
@@ -14,7 +14,7 @@ module FatesHistoryVariableType
   use FatesIOVariableKindMod, only : site_can_r8, site_cnlf_r8, site_cnlfpft_r8 
   use FatesIOVariableKindMod, only : site_elem_r8, site_elpft_r8
   use FatesIOVariableKindMod, only : site_elcwd_r8, site_elage_r8
-  use FatesIOVariableKindMod, only : iotype_index
+  use FatesIOVariableKindMod, only : iotype_index, site_agefuel_r8
 
   implicit none
   private        ! By default everything is private
@@ -201,6 +201,10 @@ subroutine Init(this, vname, units, long, use_default, &
        allocate(this%r82d(lb1:ub1, lb2:ub2))
        this%r82d(:,:) = flushval
 
+   case(site_agefuel_r8)
+      allocate(this%r82d(lb1:ub1, lb2:ub2))
+      this%r82d(:,:) = flushval
+
     case default
        write(fates_log(),*) 'Incompatible vtype passed to set_history_var'
        write(fates_log(),*) 'vtype = ',trim(vtype),' ?'
@@ -328,6 +332,8 @@ subroutine Flush(this, thread, dim_bounds, dim_kinds)
        this%r82d(lb1:ub1, lb2:ub2) = this%flushval
     case(site_elage_r8)
        this%r82d(lb1:ub1, lb2:ub2) = this%flushval
+    case(site_agefuel_r8)
+       this%r82d(lb1:ub1, lb2:ub2) = this%flushval
     case default
        write(fates_log(),*) 'fates history variable type undefined while flushing history variables'
        stop

diff --git a/main/FatesIODimensionsMod.F90 b/main/FatesIODimensionsMod.F90
@@ -27,6 +27,7 @@ module FatesIODimensionsMod
     character(*), parameter, public  :: levcan = 'fates_levcan'        ! matches histFileMod
     character(*), parameter, public  :: levcnlf = 'fates_levcnlf'      ! matches histFileMod
     character(*), parameter, public  :: levcnlfpft = 'fates_levcnlfpf' ! matches histFileMod
+    character(*), parameter, public  :: levagefuel = 'fates_levagefuel' ! matches histFileMod
 
     character(*), parameter, public  :: levelem =  'fates_levelem'
     character(*), parameter, public  :: levelpft = 'fates_levelpft'
@@ -89,6 +90,8 @@ module FatesIODimensionsMod
     ! levagepft = This is a strcture that records the boundaries for the 
     ! number of patch age x pft
 
+    ! levagefuel = This is a strcture that records the boundaries for the 
+    ! number of patch age x fuel size class
 
     ! levelem  = This records the boundaries for the number of elements
     ! levelpft = This records the boundaries for elements x pft
@@ -143,6 +146,8 @@ module FatesIODimensionsMod
        integer :: elcwd_end
        integer :: elage_begin
        integer :: elage_end
+       integer :: agefuel_begin
+       integer :: agefuel_end
     end type fates_bounds_type
 
 

diff --git a/main/FatesIOVariableKindMod.F90 b/main/FatesIOVariableKindMod.F90
@@ -34,6 +34,7 @@ module FatesIOVariableKindMod
   character(*), parameter, public :: site_scag_r8 = 'SI_SCAG_R8'
   character(*), parameter, public :: site_scagpft_r8 = 'SI_SCAGPFT_R8'
   character(*), parameter, public :: site_agepft_r8 = 'SI_AGEPFT_R8'
+  character(*), parameter, public :: site_agefuel_r8 = 'SI_AGEFUEL_R8'
 
   ! Element, and multiplexed element dimensions
   character(*), parameter, public :: site_elem_r8  = 'SI_ELEM_R8'

diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90
@@ -915,6 +915,8 @@ subroutine fates_history_maps
        allocate( fates_hdim_pftmap_levscagpft(nlevsclass * nlevage * numpft))
        allocate( fates_hdim_agmap_levagepft(nlevage * numpft))
        allocate( fates_hdim_pftmap_levagepft(nlevage * numpft))
+       allocate( fates_hdim_agmap_levagefuel(nlevage * nfsc))
+       allocate( fates_hdim_fscmap_levagefuel(nlevage * nfsc))
 
        allocate( fates_hdim_elmap_levelpft(num_elements*numpft))
        allocate( fates_hdim_elmap_levelcwd(num_elements*ncwd))
@@ -1053,6 +1055,14 @@ subroutine fates_history_maps
           end do
        end do
 
+       i=0
+       do iage=1,nlevage
+          do ifuel=1,NFSC
+             i=i+1
+             fates_hdim_agmap_levagefuel(i) = iage
+             fates_hdim_fscmap_levagefuel(i) = ifuel
+          end do
+       end do
 
     end subroutine fates_history_maps
 

diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90
@@ -226,7 +226,7 @@ module FatesInterfaceTypesMod
    real(r8), public, allocatable :: fates_hdim_levage(:)           ! patch age lower bound dimension
    real(r8), public, allocatable :: fates_hdim_levheight(:)        ! height lower bound dimension
    integer , public, allocatable :: fates_hdim_levpft(:)           ! plant pft dimension
-   integer , public, allocatable :: fates_hdim_levfuel(:)          ! fire fuel class dimension
+   integer , public, allocatable :: fates_hdim_levfuel(:)          ! fire fuel size class (fsc) dimension
    integer , public, allocatable :: fates_hdim_levcwdsc(:)         ! cwd class dimension
    integer , public, allocatable :: fates_hdim_levcan(:)           ! canopy-layer dimension 
    integer , public, allocatable :: fates_hdim_levelem(:)              ! element dimension
@@ -242,6 +242,8 @@ module FatesInterfaceTypesMod
    integer , public, allocatable :: fates_hdim_pftmap_levscagpft(:)    ! map of pft into size-class x patch age x pft dimension
    integer , public, allocatable :: fates_hdim_agmap_levagepft(:)      ! map of patch-age into patch age x pft dimension
    integer , public, allocatable :: fates_hdim_pftmap_levagepft(:)     ! map of pft into patch age x pft dimension
+   integer , public, allocatable :: fates_hdim_agmap_levagefuel(:)     ! map of patch-age into patch age x fsc dimension
+   integer , public, allocatable :: fates_hdim_fscmap_levagefuel(:)    ! map of fuel size-class into patch age x fsc dimension
 
    integer , public, allocatable :: fates_hdim_elmap_levelpft(:)       ! map of elements in the element x pft dimension
    integer , public, allocatable :: fates_hdim_elmap_levelcwd(:)       ! map of elements in the element x cwd dimension

diff --git a/main/FatesSizeAgeTypeIndicesMod.F90 b/main/FatesSizeAgeTypeIndicesMod.F90
@@ -23,6 +23,7 @@ module FatesSizeAgeTypeIndicesMod
   public :: get_agepft_class_index
   public :: coagetype_class_index
   public :: get_coage_class_index
+  public :: get_agefuel_class_index
 
 contains
 
@@ -169,5 +170,21 @@ function get_agepft_class_index(age,pft) result(age_by_pft_class)
 
   end function get_agepft_class_index
 
+  ! =====================================================================================
+
+  function get_agefuel_class_index(age,fuel) result(age_by_fuel_class)
+
+   ! Arguments
+   real(r8),intent(in) :: age
+   integer,intent(in)  :: fuel
+
+   integer             :: age_class
+   integer             :: age_by_fuel_class
+
+   age_class         = get_age_class_index(age)
+
+   age_by_fuel_class = age_class + (fuel-1) * nlevage
+
+end function get_agefuel_class_index
 
 end module FatesSizeAgeTypeIndicesMod