Merge pull request ESCOMP#1142 from jennykowalcz/jkowalcz-ckoven-csta…

…rv_term_reporting

Carbon starvation termination mortality reporting

biogeochem/EDCanopyStructureMod.F90

@@ -11,6 +11,7 @@ module EDCanopyStructureMod
   use FatesConstantsMod     , only : nearzero, area_error_1
   use FatesConstantsMod     , only : rsnbl_math_prec
   use FatesConstantsMod     , only : nocomp_bareground
+  use FatesConstantsMod,      only : i_term_mort_type_canlev
   use FatesGlobals          , only : fates_log
   use EDPftvarcon           , only : EDPftvarcon_inst
   use PRTParametersMod      , only : prt_params
@@ -741,7 +742,7 @@ subroutine DemoteFromLayer(currentSite,currentPatch,i_lyr,bc_in)
              if(currentCohort%canopy_layer>nclmax )then
                 ! put the litter from the terminated cohorts
                 ! straight into the fragmenting pools
-                call terminate_cohort(currentSite,currentPatch,currentCohort,bc_in)
+                call terminate_cohort(currentSite,currentPatch,currentCohort,bc_in,i_term_mort_type_canlev)
                 deallocate(currentCohort, stat=istat, errmsg=smsg)
                 if (istat/=0) then
                    write(fates_log(),*) 'dealloc012: fail on deallocate(currentCohort):'//trim(smsg)

biogeochem/EDCohortDynamicsMod.F90

@@ -120,6 +120,10 @@ Module EDCohortDynamicsMod
   use PRTAllometricCNPMod,    only : acnp_bc_out_id_pefflux, acnp_bc_out_id_limiter
   use PRTAllometricCNPMod,    only : acnp_bc_in_id_cdamage
   use DamageMainMod,          only : undamaged_class
+  use FatesConstantsMod,      only : n_term_mort_types
+  use FatesConstantsMod,      only : i_term_mort_type_cstarv
+  use FatesConstantsMod,      only : i_term_mort_type_canlev
+  use FatesConstantsMod,      only : i_term_mort_type_numdens
 
   use shr_infnan_mod,         only : nan => shr_infnan_nan, assignment(=)  
   use shr_log_mod,            only : errMsg => shr_log_errMsg
@@ -382,12 +386,14 @@ subroutine terminate_cohorts( currentSite, currentPatch, level , call_index, bc_
     integer :: terminate  ! do we terminate (itrue) or not (ifalse)
     integer :: istat      ! return status code
     character(len=255) :: smsg
+    integer :: termination_type
     !----------------------------------------------------------------------
 
     currentCohort => currentPatch%shortest
     do while (associated(currentCohort))
 
        terminate = ifalse
+       termination_type = 0
        tallerCohort => currentCohort%taller
 
        leaf_c  = currentCohort%prt%GetState(leaf_organ, carbon12_element)
@@ -400,6 +406,7 @@ subroutine terminate_cohorts( currentSite, currentPatch, level , call_index, bc_
        ! Check if number density is so low is breaks math (level 1)
        if (currentcohort%n <  min_n_safemath .and. level == 1) then
           terminate = itrue
+          termination_type = i_term_mort_type_numdens
           if ( debug ) then
              write(fates_log(),*) 'terminating cohorts 0',currentCohort%n/currentPatch%area,currentCohort%dbh,currentCohort%pft,call_index
           endif
@@ -413,6 +420,7 @@ subroutine terminate_cohorts( currentSite, currentPatch, level , call_index, bc_
               currentCohort%n <= min_nppatch .or. &
               (currentCohort%dbh < 0.00001_r8 .and. store_c < 0._r8) ) then
             terminate = itrue
+            termination_type = i_term_mort_type_numdens
             if ( debug ) then
                write(fates_log(),*) 'terminating cohorts 1',currentCohort%n/currentPatch%area,currentCohort%dbh,currentCohort%pft,call_index
             endif
@@ -421,6 +429,7 @@ subroutine terminate_cohorts( currentSite, currentPatch, level , call_index, bc_
          ! Outside the maximum canopy layer
          if (currentCohort%canopy_layer > nclmax ) then
            terminate = itrue
+           termination_type = i_term_mort_type_canlev
            if ( debug ) then
              write(fates_log(),*) 'terminating cohorts 2', currentCohort%canopy_layer,currentCohort%pft,call_index
            endif
@@ -430,6 +439,7 @@ subroutine terminate_cohorts( currentSite, currentPatch, level , call_index, bc_
          if ( ( sapw_c+leaf_c+fnrt_c ) < 1e-10_r8  .or.  &
                store_c  < 1e-10_r8) then
             terminate = itrue
+            termination_type = i_term_mort_type_cstarv
             if ( debug ) then
               write(fates_log(),*) 'terminating cohorts 3', &
                     sapw_c,leaf_c,fnrt_c,store_c,currentCohort%pft,call_index
@@ -439,6 +449,7 @@ subroutine terminate_cohorts( currentSite, currentPatch, level , call_index, bc_
          ! Total cohort biomass is negative
          if ( ( struct_c+sapw_c+leaf_c+fnrt_c+store_c ) < 0._r8) then
             terminate = itrue
+            termination_type = i_term_mort_type_cstarv
             if ( debug ) then
                write(fates_log(),*) 'terminating cohorts 4', &
                     struct_c,sapw_c,leaf_c,fnrt_c,store_c,currentCohort%pft,call_index
@@ -448,7 +459,7 @@ subroutine terminate_cohorts( currentSite, currentPatch, level , call_index, bc_
       endif    !  if (.not.currentCohort%isnew .and. level == 2) then
 
       if (terminate == itrue) then
-         call terminate_cohort(currentSite, currentPatch, currentCohort, bc_in)
+         call terminate_cohort(currentSite, currentPatch, currentCohort, bc_in, termination_type)
          deallocate(currentCohort, stat=istat, errmsg=smsg)
          if (istat/=0) then
             write(fates_log(),*) 'dealloc001: fail on terminate_cohorts:deallocate(currentCohort):'//trim(smsg)
@@ -461,7 +472,7 @@ subroutine terminate_cohorts( currentSite, currentPatch, level , call_index, bc_
   end subroutine terminate_cohorts
 
   !-------------------------------------------------------------------------------------!
-  subroutine terminate_cohort(currentSite, currentPatch, currentCohort, bc_in)
+  subroutine terminate_cohort(currentSite, currentPatch, currentCohort, bc_in, termination_type)
    !
    ! !DESCRIPTION:
    ! Terminates an individual cohort and updates the site-level
@@ -474,6 +485,7 @@ subroutine terminate_cohort(currentSite, currentPatch, currentCohort, bc_in)
    type (fates_patch_type) , intent(inout), target :: currentPatch
    type (fates_cohort_type), intent(inout), target :: currentCohort
    type(bc_in_type), intent(in)                :: bc_in
+   integer, intent(in)                         :: termination_type
 
    ! !LOCAL VARIABLES:
    type (fates_cohort_type) , pointer :: shorterCohort
@@ -491,6 +503,12 @@ subroutine terminate_cohort(currentSite, currentPatch, currentCohort, bc_in)
 
    !----------------------------------------------------------------------
 
+   ! check termination_type; it should not be 0
+   if (termination_type == 0) then
+      write(fates_log(),*) 'termination_type=0'
+      call endrun(msg=errMsg(sourcefile, __LINE__))
+   endif
+
    leaf_c  = currentCohort%prt%GetState(leaf_organ, carbon12_element)
    store_c = currentCohort%prt%GetState(store_organ, carbon12_element)
    sapw_c  = currentCohort%prt%GetState(sapw_organ, carbon12_element)
@@ -506,16 +524,16 @@ subroutine terminate_cohort(currentSite, currentPatch, currentCohort, bc_in)
 
    ! Update the site-level carbon flux and individuals count for the appropriate canopy layer
    if(levcan==ican_upper) then
-      currentSite%term_nindivs_canopy(currentCohort%size_class,currentCohort%pft) = &
-            currentSite%term_nindivs_canopy(currentCohort%size_class,currentCohort%pft) + currentCohort%n
+      currentSite%term_nindivs_canopy(termination_type,currentCohort%size_class,currentCohort%pft) = &
+            currentSite%term_nindivs_canopy(termination_type,currentCohort%size_class,currentCohort%pft) + currentCohort%n
 
-      currentSite%term_carbonflux_canopy(currentCohort%pft) = currentSite%term_carbonflux_canopy(currentCohort%pft) + &
+      currentSite%term_carbonflux_canopy(termination_type,currentCohort%pft) = currentSite%term_carbonflux_canopy(termination_type,currentCohort%pft) + &
             currentCohort%n * (struct_c+sapw_c+leaf_c+fnrt_c+store_c+repro_c)
    else
-      currentSite%term_nindivs_ustory(currentCohort%size_class,currentCohort%pft) = &
-            currentSite%term_nindivs_ustory(currentCohort%size_class,currentCohort%pft) + currentCohort%n
+      currentSite%term_nindivs_ustory(termination_type,currentCohort%size_class,currentCohort%pft) = &
+            currentSite%term_nindivs_ustory(termination_type,currentCohort%size_class,currentCohort%pft) + currentCohort%n
 
-      currentSite%term_carbonflux_ustory(currentCohort%pft) = currentSite%term_carbonflux_ustory(currentCohort%pft) + &
+      currentSite%term_carbonflux_ustory(termination_type,currentCohort%pft) = currentSite%term_carbonflux_ustory(termination_type,currentCohort%pft) + &
             currentCohort%n * (struct_c+sapw_c+leaf_c+fnrt_c+store_c+repro_c)
    end if
 
@@ -553,7 +571,7 @@ subroutine terminate_cohort(currentSite, currentPatch, currentCohort, bc_in)
 
    call currentCohort%FreeMemory()
 
- end subroutine terminate_cohort  
+ end subroutine terminate_cohort 
 
   ! =====================================================================================
 

main/EDInitMod.F90

@@ -90,6 +90,7 @@ module EDInitMod
   use PRTGenericMod,          only : SetState
   use FatesSizeAgeTypeIndicesMod,only : get_age_class_index
   use DamageMainMod,          only : undamaged_class
+  use FatesConstantsMod,      only : n_term_mort_types
   use FatesInterfaceTypesMod    , only : hlm_num_luh2_transitions
 
   ! CIME GLOBALS
@@ -132,8 +133,8 @@ subroutine init_site_vars( site_in, bc_in, bc_out )
     integer :: el
 
     !
-    allocate(site_in%term_nindivs_canopy(1:nlevsclass,1:numpft))
-    allocate(site_in%term_nindivs_ustory(1:nlevsclass,1:numpft))
+    allocate(site_in%term_nindivs_canopy(1:n_term_mort_types,1:nlevsclass,1:numpft))
+    allocate(site_in%term_nindivs_ustory(1:n_term_mort_types,1:nlevsclass,1:numpft))
     allocate(site_in%demotion_rate(1:nlevsclass))
     allocate(site_in%promotion_rate(1:nlevsclass))
     allocate(site_in%imort_rate(1:nlevsclass,1:numpft))
@@ -169,8 +170,8 @@ subroutine init_site_vars( site_in, bc_in, bc_out )
        allocate(site_in%fmort_cflux_ustory_damage(1,1))
     end if
 
-    allocate(site_in%term_carbonflux_canopy(1:numpft))
-    allocate(site_in%term_carbonflux_ustory(1:numpft))
+    allocate(site_in%term_carbonflux_canopy(1:n_term_mort_types,1:numpft))
+    allocate(site_in%term_carbonflux_ustory(1:n_term_mort_types,1:numpft))
     allocate(site_in%imort_carbonflux(1:numpft))
     allocate(site_in%fmort_carbonflux_canopy(1:numpft))
     allocate(site_in%fmort_carbonflux_ustory(1:numpft))
@@ -287,15 +288,15 @@ subroutine zero_site( site_in )
     site_in%ema_npp = -9999.9_r8
 
     ! termination and recruitment info
-    site_in%term_nindivs_canopy(:,:) = 0._r8
-    site_in%term_nindivs_ustory(:,:) = 0._r8
+    site_in%term_nindivs_canopy(:,:,:) = 0._r8
+    site_in%term_nindivs_ustory(:,:,:) = 0._r8
     site_in%term_crownarea_canopy = 0._r8
     site_in%term_crownarea_ustory = 0._r8
     site_in%imort_crownarea = 0._r8
     site_in%fmort_crownarea_canopy = 0._r8
     site_in%fmort_crownarea_ustory = 0._r8
-    site_in%term_carbonflux_canopy(:) = 0._r8
-    site_in%term_carbonflux_ustory(:) = 0._r8
+    site_in%term_carbonflux_canopy(:,:) = 0._r8
+    site_in%term_carbonflux_ustory(:,:) = 0._r8
     site_in%recruitment_rate(:) = 0._r8
     site_in%imort_rate(:,:) = 0._r8
     site_in%imort_carbonflux(:) = 0._r8

main/EDTypesMod.F90

@@ -380,18 +380,18 @@ module EDTypesMod
      real(r8) :: fmort_crownarea_canopy                ! crownarea of canopy indivs killed due to fire per year. [m2/sec]
      real(r8) :: fmort_crownarea_ustory                ! crownarea of understory indivs killed due to fire per year [m2/sec] 
 
-     real(r8), allocatable :: term_nindivs_canopy(:,:) ! number of canopy individuals that were in cohorts which 
-                                                       ! were terminated this timestep, on size x pft
-     real(r8), allocatable :: term_nindivs_ustory(:,:) ! number of understory individuals that were in cohorts which 
-                                                       ! were terminated this timestep, on size x pft
-
-     real(r8), allocatable :: term_carbonflux_canopy(:)  ! carbon flux from live to dead pools associated 
-                                                         ! with termination mortality, per canopy level. [kgC/ha/day]
-     real(r8), allocatable :: term_carbonflux_ustory(:)  ! carbon flux from live to dead pools associated 
-                                                         ! with termination mortality, per canopy level.  [kgC/ha/day]    
-     real(r8), allocatable :: imort_carbonflux(:)        ! biomass of individuals killed due to impact mortality per year. [kgC/m2/sec]
-     real(r8), allocatable :: fmort_carbonflux_canopy(:) ! biomass of canopy indivs killed due to fire per year. [gC/m2/sec]
-     real(r8), allocatable :: fmort_carbonflux_ustory(:) ! biomass of understory indivs killed due to fire per year [gC/m2/sec] 
+     real(r8), allocatable :: term_nindivs_canopy(:,:,:)   ! number of canopy individuals that were in cohorts which 
+                                                           ! were terminated this timestep, by termination type, size x pft
+     real(r8), allocatable :: term_nindivs_ustory(:,:,:)   ! number of understory individuals that were in cohorts which 
+                                                           ! were terminated this timestep, by termination type, size x pft
+
+     real(r8), allocatable :: term_carbonflux_canopy(:,:)  ! carbon flux from live to dead pools associated 
+                                                           ! with termination mortality, by termination type and pft. [kgC/ha/day]
+     real(r8), allocatable :: term_carbonflux_ustory(:,:)  ! carbon flux from live to dead pools associated 
+                                                         ! with termination mortality, by termination type and pft.  [kgC/ha/day]    
+     real(r8), allocatable :: imort_carbonflux(:)        ! biomass of individuals killed due to impact mortality per year, by pft. [kgC/m2/sec]
+     real(r8), allocatable :: fmort_carbonflux_canopy(:) ! biomass of canopy indivs killed due to fire per year, by pft. [gC/m2/sec]
+     real(r8), allocatable :: fmort_carbonflux_ustory(:) ! biomass of understory indivs killed due to fire per year, by pft [gC/m2/sec] 
 
      real(r8), allocatable :: term_abg_flux(:,:)          ! aboveground biomass lost due to termination mortality x size x pft
      real(r8), allocatable :: imort_abg_flux(:,:)         ! aboveground biomass lost due to impact mortality x size x pft [kgC/m2/sec]

main/FatesConstantsMod.F90

@@ -336,5 +336,10 @@ module FatesConstantsMod
 
   real(fates_r8), parameter, public :: lmr_r_2 = -0.0402_fates_r8    ! (umol CO2/m**2/s/degree C)
 
-
+  ! some integers related to termination mortality
+  integer, parameter, public :: n_term_mort_types = 3
+  integer, parameter, public :: i_term_mort_type_cstarv = 1
+  integer, parameter, public :: i_term_mort_type_canlev = 2
+  integer, parameter, public :: i_term_mort_type_numdens = 3
+
 end module FatesConstantsMod