From 420431fb2a1a69b2c65124c8dc5224135b81e4b2 Mon Sep 17 00:00:00 2001 From: Shijie Shu Date: Mon, 7 Mar 2022 21:12:31 -0800 Subject: [PATCH 01/20] Added C based logging in FATES. Passed validation. --- biogeochem/EDLoggingMortalityMod.F90 | 316 +++++++++++++++++++++++-- biogeochem/EDMortalityFunctionsMod.F90 | 16 +- biogeochem/EDPatchDynamicsMod.F90 | 48 +++- main/EDInitMod.F90 | 1 + main/EDMainMod.F90 | 12 +- main/EDTypesMod.F90 | 5 + main/FatesHistoryInterfaceMod.F90 | 8 + main/FatesInterfaceMod.F90 | 14 ++ main/FatesInterfaceTypesMod.F90 | 8 + 9 files changed, 393 insertions(+), 35 deletions(-) diff --git a/biogeochem/EDLoggingMortalityMod.F90 b/biogeochem/EDLoggingMortalityMod.F90 index 976fea5a1c..0fb884df04 100644 --- a/biogeochem/EDLoggingMortalityMod.F90 +++ b/biogeochem/EDLoggingMortalityMod.F90 @@ -14,6 +14,7 @@ module EDLoggingMortalityMod ! ==================================================================================== use FatesConstantsMod , only : r8 => fates_r8 + use FatesConstantsMod , only : rsnbl_math_prec use EDTypesMod , only : ed_cohort_type use EDTypesMod , only : ed_patch_type use EDTypesMod , only : site_massbal_type @@ -47,6 +48,7 @@ module EDLoggingMortalityMod use FatesInterfaceTypesMod , only : hlm_day_of_year use FatesInterfaceTypesMod , only : hlm_days_per_year use FatesInterfaceTypesMod , only : hlm_use_lu_harvest + use FatesInterfaceTypesMod , only : hlm_harvest_bypass_criteria use FatesInterfaceTypesMod , only : hlm_num_lu_harvest_cats use FatesInterfaceTypesMod , only : hlm_use_logging use FatesInterfaceTypesMod , only : hlm_use_planthydro @@ -97,6 +99,8 @@ module EDLoggingMortalityMod public :: logging_time public :: IsItLoggingTime public :: get_harvest_rate_area + public :: get_harvestable_carbon + public :: get_harvest_rate_carbon public :: UpdateHarvestC contains @@ -197,7 +201,8 @@ subroutine LoggingMortality_frac( pft_i, dbh, canopy_layer, lmort_direct, & hlm_harvest_rates, hlm_harvest_catnames, & hlm_harvest_units, & patch_anthro_disturbance_label, secondary_age, & - frac_site_primary) + frac_site_primary, harvestable_forest_c, & + available_forest_c, harvest_tag) ! Arguments integer, intent(in) :: pft_i ! pft index @@ -208,6 +213,11 @@ subroutine LoggingMortality_frac( pft_i, dbh, canopy_layer, lmort_direct, & integer, intent(in) :: hlm_harvest_units ! unit type of hlm harvest rates: [area vs. mass] integer, intent(in) :: patch_anthro_disturbance_label ! patch level anthro_disturbance_label real(r8), intent(in) :: secondary_age ! patch level age_since_anthro_disturbance + real(r8), intent(in) :: harvestable_forest_c(:) ! total harvestable forest carbon + ! of all hlm harvest categories + real(r8), intent(in) :: available_forest_c(:) ! total forest carbon available for + ! harvest of all hlm harvest categories + real(r8), intent(in) :: frac_site_primary real(r8), intent(out) :: lmort_direct ! direct (harvestable) mortality fraction real(r8), intent(out) :: lmort_collateral ! collateral damage mortality fraction real(r8), intent(out) :: lmort_infra ! infrastructure mortality fraction @@ -215,10 +225,13 @@ subroutine LoggingMortality_frac( pft_i, dbh, canopy_layer, lmort_direct, & ! but suffer from forest degradation (i.e. they ! are moved to newly-anthro-disturbed secondary ! forest patch) - real(r8), intent(in) :: frac_site_primary + integer, intent(out) :: harvest_tag(:) ! tag to record the harvest status, 0 - successful; + ! 1 - can be successful if ignoring the criteria; + ! 2 - unsuccessful since not enough carbon ! Local variables - real(r8) :: harvest_rate ! the final harvest rate to apply to this cohort today + integer :: cur_harvest_tag ! the harvest tag of the cohort today + real(r8) :: harvest_rate ! the final harvest rate to apply to this cohort today ! todo: probably lower the dbhmin default value to 30 cm ! todo: change the default logging_event_code to 1 september (-244) @@ -255,40 +268,48 @@ subroutine LoggingMortality_frac( pft_i, dbh, canopy_layer, lmort_direct, & call get_harvest_rate_area (patch_anthro_disturbance_label, hlm_harvest_catnames, & hlm_harvest_rates, frac_site_primary, secondary_age, harvest_rate) + ! For area-based harvest, harvest_tag shall always be 0. + harvest_tag = 0 + cur_harvest_tag = 0 + if (fates_global_verbose()) then - write(fates_log(), *) 'Successfully Read Harvest Rate from HLM.' + write(fates_log(), *) 'Successfully Read Harvest Rate from HLM.', hlm_harvest_rates(:), harvest_rate end if else if (hlm_use_lu_harvest == itrue .and. hlm_harvest_units == hlm_harvest_carbon) then ! 2=use carbon from hlm - ! Shijie: Shall call another function, which transfer biomass/carbon into fraction? - ! Is it the correct place to call the function? - ! Inputs: patch_area, patch_biomass, what else? + ! shall call another subroutine, which transfers biomass/carbon into fraction - ! call get_harvest_rate_carbon (patch_anthro_disturbance_label, hlm_harvest_catnames, & - ! hlm_harvest_rates, frac_site_primary, secondary_age, harvest_rate) + call get_harvest_rate_carbon (patch_anthro_disturbance_label, hlm_harvest_catnames, & + hlm_harvest_rates, secondary_age, harvestable_forest_c, available_forest_c, & + harvest_rate, harvest_tag, cur_harvest_tag) - ! if (fates_global_verbose()) then - ! write(fates_log(), *) 'Successfully Read Harvest Rate from HLM.', hlm_harvest_rates(:), harvest_rate - ! end if + if (fates_global_verbose()) then + write(fates_log(), *) 'Successfully Read Harvest Rate from HLM.', hlm_harvest_rates(:), harvest_rate, & + harvestable_forest_c, available_forest_c + end if !write(fates_log(),*) 'HLM harvest carbon data not implemented yet. Exiting.' !call endrun(msg=errMsg(sourcefile, __LINE__)) - endif + end if ! transfer of area to secondary land is based on overall area affected, not just logged crown area ! l_degrad accounts for the affected area between logged crowns - if(int(prt_params%woody(pft_i)) == 1)then ! only set logging rates for trees - - ! direct logging rates, based on dbh min and max criteria - if (dbh >= logging_dbhmin .and. .not. & - ((logging_dbhmax < fates_check_param_set) .and. (dbh >= logging_dbhmax )) ) then - ! the logic of the above line is a bit unintuitive but allows turning off the dbhmax comparison entirely. - ! since there is an .and. .not. after the first conditional, the dbh:dbhmax comparison needs to be - ! the opposite of what would otherwise be expected... - lmort_direct = harvest_rate * logging_direct_frac - + if(int(prt_params%woody(pft_i)) == 1) then ! only set logging rates for trees + if (cur_harvest_tag == 0) then + ! direct logging rates, based on dbh min and max criteria + if (dbh >= logging_dbhmin .and. .not. & + ((logging_dbhmax < fates_check_param_set) .and. (dbh >= logging_dbhmax )) ) then + ! the logic of the above line is a bit unintuitive but allows turning off the dbhmax comparison entirely. + ! since there is an .and. .not. after the first conditional, the dbh:dbhmax comparison needs to be + ! the opposite of what would otherwise be expected... + lmort_direct = harvest_rate * logging_direct_frac + else + lmort_direct = 0.0_r8 + end if + else if (cur_harvest_tag == 1 .and. hlm_harvest_bypass_criteria == 1) then + lmort_direct = harvest_rate * logging_direct_frac else - lmort_direct = 0.0_r8 + lmort_direct = 0.0_r8 end if ! infrastructure (roads, skid trails, etc) mortality rates @@ -414,6 +435,253 @@ end subroutine get_harvest_rate_area ! ============================================================================ + subroutine get_harvestable_carbon (csite, site_area, hlm_harvest_catnames, harvestable_forest_c, available_forest_c) + + !USES: + use SFParamsMod, only : SF_val_cwd_frac + use EDTypesMod, only : AREA_INV + + + ! ------------------------------------------------------------------------------------------- + ! + ! DESCRIPTION: + ! get the total carbon availale for harvest for three different harvest categories: + ! primary forest, secondary mature forest and secondary young forest + ! under two different scenarios: + ! harvestable carbon: aggregate all cohorts matching the dbhmin harvest criteria + ! available carbon: aggregate all cohorts + ! + ! this subroutine shall be called outside the patch loop + ! output will be used to estimate the area-based harvest rate (get_harvest_rate_carbon) + ! for each cohort. + + ! Arguments + type(ed_site_type), intent(in), target :: csite + real(r8), intent(in) :: site_area ! temporary variable + character(len=64), intent(in) :: hlm_harvest_catnames(:) ! names of hlm harvest categories + + real(r8), intent(out) :: harvestable_forest_c(hlm_num_lu_harvest_cats) + real(r8), intent(out) :: available_forest_c(hlm_num_lu_harvest_cats) + + ! Local Variables + type(ed_patch_type), pointer :: currentPatch + type(ed_cohort_type), pointer :: currentCohort + real(r8) :: harvestable_patch_c ! temporary variable + real(r8) :: harvestable_cohort_c ! temporary variable + real(r8) :: available_patch_c ! temporary variable + real(r8) :: available_cohort_c ! temporary variable + real(r8) :: sapw_m ! Biomass of sap wood + real(r8) :: struct_m ! Biomass of structural organs + integer :: pft ! Index of plant functional type + integer :: h_index ! for looping over harvest categories + + ! Initialization + harvestable_forest_c = 0._r8 + available_forest_c = 0._r8 + + ! loop over patches + currentPatch => csite%oldest_patch + do while (associated(currentPatch)) + harvestable_patch_c = 0._r8 + available_patch_c = 0._r8 + currentCohort => currentPatch%tallest + + do while (associated(currentCohort)) + pft = currentCohort%pft + + ! only account for cohorts matching the following conditions + if(int(prt_params%woody(pft)) == 1)then ! only set logging rates for trees + sapw_m = currentCohort%prt%GetState(sapw_organ, all_carbon_elements) + struct_m = currentCohort%prt%GetState(struct_organ, all_carbon_elements) + ! logging_direct_frac shall be 1 for LUH2 driven simulation and global simulation + ! in site level study logging_direct_frac shall be surveyed + ! unit: [kgC ] = [kgC/plant] * [plant/ha] * [ha/ 10k m2] * [ m2 area ] + harvestable_cohort_c = logging_direct_frac * ( sapw_m + struct_m ) * & + prt_params%allom_agb_frac(currentCohort%pft) * & + SF_val_CWD_frac(ncwd) * logging_export_frac * & + currentCohort%n * AREA_INV * site_area + + ! No harvest for trees without canopy + if (currentCohort%canopy_layer>=1) then + ! logging amount are based on dbh min and max criteria + if (currentCohort%dbh >= logging_dbhmin .and. .not. & + ((logging_dbhmax < fates_check_param_set) .and. (currentCohort%dbh >= logging_dbhmax )) ) then + ! Harvestable C: aggregate cohorts fit the criteria + harvestable_patch_c = harvestable_patch_c + harvestable_cohort_c + ! Available C: aggregate all cohorts + available_patch_c = available_patch_c + harvestable_cohort_c + else + available_patch_c = available_patch_c + harvestable_cohort_c + end if + end if + end if + currentCohort => currentCohort%shorter + end do + + ! judge which category the current patch belong to + ! since we have not separated forest vs. non-forest + ! all carbon belongs to the forest categories + do h_index = 1,hlm_num_lu_harvest_cats + if (currentPatch%anthro_disturbance_label .eq. primaryforest) then + ! Primary + if(hlm_harvest_catnames(h_index) .eq. "HARVEST_VH1") then + harvestable_forest_c(h_index) = harvestable_forest_c(h_index) + harvestable_patch_c + available_forest_c(h_index) = available_forest_c(h_index) + available_patch_c + end if + else if (currentPatch%anthro_disturbance_label .eq. secondaryforest .and. & + currentPatch%age_since_anthro_disturbance >= secondary_age_threshold) then + ! Secondary mature + if(hlm_harvest_catnames(h_index) .eq. "HARVEST_SH1") then + harvestable_forest_c(h_index) = harvestable_forest_c(h_index) + harvestable_patch_c + available_forest_c(h_index) = available_forest_c(h_index) + available_patch_c + end if + else if (currentPatch%anthro_disturbance_label .eq. secondaryforest .and. & + currentPatch%age_since_anthro_disturbance < secondary_age_threshold) then + ! Secondary young + if(hlm_harvest_catnames(h_index) .eq. "HARVEST_SH2") then + harvestable_forest_c(h_index) = harvestable_forest_c(h_index) + harvestable_patch_c + available_forest_c(h_index) = available_forest_c(h_index) + available_patch_c + end if + end if + end do + currentPatch => currentPatch%younger + end do + + end subroutine get_harvestable_carbon + + ! ============================================================================ + + subroutine get_harvest_rate_carbon (patch_anthro_disturbance_label, hlm_harvest_catnames, & + hlm_harvest_rates, secondary_age, harvestable_forest_c, available_forest_c, & + harvest_rate, harvest_tag, cur_harvest_tag) + + ! ------------------------------------------------------------------------------------------- + ! + ! DESCRIPTION: + ! get the carbon-based harvest rates based on info passed to FATES from the boundary conditions in. + ! assumes logging_time == true + + ! Arguments + real(r8), intent(in) :: hlm_harvest_rates(:) ! annual harvest rate per hlm category + character(len=64), intent(in) :: hlm_harvest_catnames(:) ! names of hlm harvest categories + integer, intent(in) :: patch_anthro_disturbance_label ! patch level anthro_disturbance_label + real(r8), intent(in) :: secondary_age ! patch level age_since_anthro_disturbance + real(r8), intent(in) :: harvestable_forest_c(:) ! site level forest c matching criteria available for harvest + real(r8), intent(in) :: available_forest_c(:) ! site level total forest c available for harvest + real(r8), intent(out) :: harvest_rate + integer, intent(inout) :: harvest_tag(:) ! 0. normal harvest; 1. current site does not have enough C but + ! can perform harvest by ignoring criteria; 2. current site does + ! not have enough carbon + ! This harvest tag shall be a patch level variable but since all + ! logging functions happen within cohort loop we can only put the + ! calculation here. Can think about optimizing the logging calculation + ! in the future. + integer, intent(out), optional :: cur_harvest_tag ! harvest tag of the current cohort + + ! Local Variables + integer :: h_index ! for looping over harvest categories + integer :: icode ! Integer equivalent of the event code (parameter file only allows reals) + real(r8) :: harvest_rate_c ! Temporary variable + real(r8) :: harvest_rate_supply ! Temporary variable + + ! Loop around harvest categories to determine the hlm harvest rate demand and actual harvest rate for the + ! current cohort based on patch history info + harvest_rate = 0._r8 + harvest_rate_c = 0._r8 + harvest_rate_supply = 0._r8 + harvest_tag = 2 + + do h_index = 1,hlm_num_lu_harvest_cats + if (patch_anthro_disturbance_label .eq. primaryforest) then + if(hlm_harvest_catnames(h_index) .eq. "HARVEST_VH1" .or. & + hlm_harvest_catnames(h_index) .eq. "HARVEST_VH2") then + harvest_rate_c = harvest_rate_c + hlm_harvest_rates(h_index) + ! Determine the total supply of available C for harvest + if(harvestable_forest_c(h_index) >= harvest_rate_c) then + harvest_rate_supply = harvest_rate_supply + harvestable_forest_c(h_index) + harvest_tag(h_index) = 0 + else if (available_forest_c(h_index) >= harvest_rate_c) then + harvest_rate_supply = harvest_rate_supply + available_forest_c(h_index) + harvest_tag(h_index) = 1 + else + harvest_tag(h_index) = 2 + end if + endif + else if (patch_anthro_disturbance_label .eq. secondaryforest .and. & + secondary_age >= secondary_age_threshold) then + if(hlm_harvest_catnames(h_index) .eq. "HARVEST_SH1") then + harvest_rate_c = harvest_rate_c + hlm_harvest_rates(h_index) + if(harvestable_forest_c(h_index) >= harvest_rate_c) then + harvest_rate_supply = harvest_rate_supply + harvestable_forest_c(h_index) + harvest_tag(h_index) = 0 + else if (available_forest_c(h_index) >= harvest_rate_c) then + harvest_rate_supply = harvest_rate_supply + available_forest_c(h_index) + harvest_tag(h_index) = 1 + else + harvest_tag(h_index) = 2 + end if + endif + else if (patch_anthro_disturbance_label .eq. secondaryforest .and. & + secondary_age < secondary_age_threshold) then + if(hlm_harvest_catnames(h_index) .eq. "HARVEST_SH2" .or. & + hlm_harvest_catnames(h_index) .eq. "HARVEST_SH3") then + harvest_rate_c = harvest_rate_c + hlm_harvest_rates(h_index) + if(harvestable_forest_c(h_index) >= harvest_rate_c) then + harvest_rate_supply = harvest_rate_supply + harvestable_forest_c(h_index) + harvest_tag(h_index) = 0 + else if (available_forest_c(h_index) >= harvest_rate_c) then + harvest_rate_supply = harvest_rate_supply + available_forest_c(h_index) + harvest_tag(h_index) = 1 + else + harvest_tag(h_index) = 2 + end if + endif + endif + end do + + ! If any harvest category available, assign to cur_harvest_tag and trigger logging event + if(present(cur_harvest_tag))then + cur_harvest_tag = minval(harvest_tag) + !write(fates_log(), *) 'cur_harvest_tag:', cur_harvest_tag + !write(fates_log(), *) 'harvest tags:', harvest_tag + !write(fates_log(), *) 'harvest rate c:', harvest_rate_c + !write(fates_log(), *) 'harvest rate supply:', harvest_rate_supply + !write(fates_log(), *) 'hlm harvest rates:', hlm_harvest_rates + end if + + ! Transfer carbon-based harvest rate to area-based harvest rate + if (harvest_rate_supply > rsnbl_math_prec .and. harvest_rate_supply > harvest_rate_c) then + harvest_rate = harvest_rate_c / harvest_rate_supply + else + harvest_rate = 0._r8 + end if + + ! For carbon-based harvest rate, normalizing by site-level primary or secondary forest fraction + ! is not needed + + ! calculate today's harvest rate + ! whether to harvest today has already been determined by IsItLoggingTime + ! for icode == 2, icode < 0, and icode > 10000 apply the annual rate one time (no calc) + ! Bad logging event flag is caught in IsItLoggingTime, so don't check it here + icode = int(logging_event_code) + if(icode .eq. 1) then + ! Logging is turned off - not sure why we need another switch + harvest_rate = 0._r8 + else if(icode .eq. 3) then + ! Logging event every day - this may not work due to the mortality exclusivity + harvest_rate = harvest_rate / hlm_days_per_year + else if(icode .eq. 4) then + ! logging event once a month + if(hlm_current_day.eq.1 ) then + harvest_rate = harvest_rate / months_per_year + end if + end if + + end subroutine get_harvest_rate_carbon + + ! ============================================================================ + + subroutine logging_litter_fluxes(currentSite, currentPatch, newPatch, patch_site_areadis) ! ------------------------------------------------------------------------------------------- diff --git a/biogeochem/EDMortalityFunctionsMod.F90 b/biogeochem/EDMortalityFunctionsMod.F90 index fa0b933fc5..318d6e3801 100644 --- a/biogeochem/EDMortalityFunctionsMod.F90 +++ b/biogeochem/EDMortalityFunctionsMod.F90 @@ -208,7 +208,8 @@ end subroutine mortality_rates ! ============================================================================ - subroutine Mortality_Derivative( currentSite, currentCohort, bc_in, frac_site_primary) + subroutine Mortality_Derivative( currentSite, currentCohort, bc_in, frac_site_primary, & + harvestable_forest_c, available_forest_c, harvest_tag) ! ! !DESCRIPTION: @@ -217,7 +218,6 @@ subroutine Mortality_Derivative( currentSite, currentCohort, bc_in, frac_site_pr ! elsewhere). ! ! !USES: - use FatesInterfaceTypesMod, only : hlm_freq_day ! ! !ARGUMENTS @@ -225,6 +225,10 @@ subroutine Mortality_Derivative( currentSite, currentCohort, bc_in, frac_site_pr type(ed_cohort_type),intent(inout), target :: currentCohort type(bc_in_type), intent(in) :: bc_in real(r8), intent(in) :: frac_site_primary + real(r8), intent(in) :: harvestable_forest_c(:) + real(r8), intent(in) :: available_forest_c(:) + integer, intent(inout) :: harvest_tag(:) + ! ! !LOCAL VARIABLES: real(r8) :: cmort ! starvation mortality rate (fraction per year) @@ -235,6 +239,7 @@ subroutine Mortality_Derivative( currentSite, currentCohort, bc_in, frac_site_pr real(r8) :: asmort ! age dependent senescence mortality rate (fraction per year) real(r8) :: dndt_logging ! Mortality rate (per day) associated with the a logging event integer :: ipft ! local copy of the pft index + !---------------------------------------------------------------------- ipft = currentCohort%pft @@ -252,10 +257,11 @@ subroutine Mortality_Derivative( currentSite, currentCohort, bc_in, frac_site_pr bc_in%hlm_harvest_units, & currentCohort%patchptr%anthro_disturbance_label, & currentCohort%patchptr%age_since_anthro_disturbance, & - frac_site_primary) + frac_site_primary, & + harvestable_forest_c, & + available_forest_c, & + harvest_tag) - - if (currentCohort%canopy_layer > 1)then ! Include understory logging mortality rates not associated with disturbance diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index ec04c7eb36..7062c4243f 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -45,6 +45,8 @@ module EDPatchDynamicsMod use FatesInterfaceTypesMod , only : bc_in_type use FatesInterfaceTypesMod , only : hlm_days_per_year use FatesInterfaceTypesMod , only : numpft + use FatesInterfaceTypesMod , only : hlm_num_lu_harvest_cats + use FatesInterfaceTypesMod , only : hlm_harvest_bypass_criteria use FatesGlobals , only : endrun => fates_endrun use FatesConstantsMod , only : r8 => fates_r8 use FatesConstantsMod , only : itrue, ifalse @@ -54,6 +56,8 @@ module EDPatchDynamicsMod use EDLoggingMortalityMod, only : logging_litter_fluxes use EDLoggingMortalityMod, only : logging_time use EDLoggingMortalityMod, only : get_harvest_rate_area + use EDLoggingMortalityMod, only : get_harvest_rate_carbon + use EDLoggingMortalityMod, only : get_harvestable_carbon use EDParamsMod , only : fates_mortality_disturbance_fraction use FatesAllometryMod , only : carea_allom use FatesAllometryMod , only : set_root_fraction @@ -66,6 +70,7 @@ module EDPatchDynamicsMod use FatesConstantsMod , only : n_anthro_disturbance_categories use FatesConstantsMod , only : fates_unset_r8 use FatesConstantsMod , only : fates_unset_int + use FatesConstantsMod , only : hlm_harvest_carbon use EDCohortDynamicsMod , only : InitPRTObject use EDCohortDynamicsMod , only : InitPRTBoundaryConditions use ChecksBalancesMod, only : SiteMassStock @@ -151,7 +156,7 @@ subroutine disturbance_rates( site_in, bc_in) use EDMortalityFunctionsMod , only : mortality_rates ! loging flux use EDLoggingMortalityMod , only : LoggingMortality_frac - + use EDTypesMod , only : ed_resources_management_type ! !ARGUMENTS: type(ed_site_type) , intent(inout), target :: site_in @@ -177,8 +182,12 @@ subroutine disturbance_rates( site_in, bc_in) real(r8) :: dist_rate_ldist_notharvested integer :: threshold_sizeclass integer :: i_dist + integer :: h_index real(r8) :: frac_site_primary real(r8) :: harvest_rate + real(r8) :: harvestable_forest_c(hlm_num_lu_harvest_cats) + real(r8) :: available_forest_c(hlm_num_lu_harvest_cats) + integer :: harvest_tag(hlm_num_lu_harvest_cats) !---------------------------------------------------------------------------------------------- ! Calculate Mortality Rates (these were previously calculated during growth derivatives) @@ -187,6 +196,9 @@ subroutine disturbance_rates( site_in, bc_in) ! first calculate the fractino of the site that is primary land call get_frac_site_primary(site_in, frac_site_primary) + + ! get available biomass for harvest for all patches + call get_harvestable_carbon(site_in, bc_in%site_area, bc_in%hlm_harvest_catnames, harvestable_forest_c, available_forest_c) site_in%harvest_carbon_flux = 0._r8 @@ -218,7 +230,10 @@ subroutine disturbance_rates( site_in, bc_in) bc_in%hlm_harvest_units, & currentPatch%anthro_disturbance_label, & currentPatch%age_since_anthro_disturbance, & - frac_site_primary) + frac_site_primary, & + harvestable_forest_c, & + available_forest_c, & + harvest_tag) currentCohort%lmort_direct = lmort_direct currentCohort%lmort_collateral = lmort_collateral @@ -227,12 +242,13 @@ subroutine disturbance_rates( site_in, bc_in) ! estimate the wood product (trunk_product_site) if (currentCohort%canopy_layer>=1) then + ! kgC m-2 day-1 site_in%harvest_carbon_flux = site_in%harvest_carbon_flux + & currentCohort%lmort_direct * currentCohort%n * & ( currentCohort%prt%GetState(sapw_organ, all_carbon_elements) + & currentCohort%prt%GetState(struct_organ, all_carbon_elements)) * & prt_params%allom_agb_frac(currentCohort%pft) * & - SF_val_CWD_frac(ncwd) * logging_export_frac + SF_val_CWD_frac(ncwd) * logging_export_frac * AREA_INV endif currentCohort => currentCohort%taller @@ -241,6 +257,17 @@ subroutine disturbance_rates( site_in, bc_in) currentPatch => currentPatch%younger end do + ! Determine harvest debt from all three categories + do h_index = 1, hlm_num_lu_harvest_cats + if (harvest_tag(h_index) == 2 .or. & + (harvest_tag(h_index) == 1 .and. .not. (hlm_harvest_bypass_criteria))) then + if(logging_time) then + site_in%resources_management%harvest_debt = site_in%resources_management%harvest_debt + & + bc_in%hlm_harvest_rates(h_index) + end if + end if + end do + ! --------------------------------------------------------------------------------------------- ! Calculate Disturbance Rates based on the mortality rates just calculated ! --------------------------------------------------------------------------------------------- @@ -288,6 +315,11 @@ subroutine disturbance_rates( site_in, bc_in) currentCohort%lmort_infra + & currentCohort%l_degrad ) * & currentCohort%c_area/currentPatch%area + + if(currentPatch%disturbance_rates(dtype_ilog)>1.0) then + write(fates_log(),*) 'See luc mortalities:', currentCohort%lmort_direct, & + currentCohort%lmort_collateral, currentCohort%lmort_infra, currentCohort%l_degrad + end if ! Non-harvested part of the logging disturbance rate dist_rate_ldist_notharvested = dist_rate_ldist_notharvested + currentCohort%l_degrad * & @@ -303,8 +335,14 @@ subroutine disturbance_rates( site_in, bc_in) (currentPatch%area - currentPatch%total_canopy_area) .gt. fates_tiny ) then ! The canopy is NOT closed. - call get_harvest_rate_area (currentPatch%anthro_disturbance_label, bc_in%hlm_harvest_catnames, & - bc_in%hlm_harvest_rates, frac_site_primary, currentPatch%age_since_anthro_disturbance, harvest_rate) + if(bc_in%hlm_harvest_units == hlm_harvest_carbon) then + call get_harvest_rate_carbon (currentPatch%anthro_disturbance_label, bc_in%hlm_harvest_catnames, & + bc_in%hlm_harvest_rates, currentPatch%age_since_anthro_disturbance, harvestable_forest_c, & + available_forest_c, harvest_rate, harvest_tag) + else + call get_harvest_rate_area (currentPatch%anthro_disturbance_label, bc_in%hlm_harvest_catnames, & + bc_in%hlm_harvest_rates, frac_site_primary, currentPatch%age_since_anthro_disturbance, harvest_rate) + end if currentPatch%disturbance_rates(dtype_ilog) = currentPatch%disturbance_rates(dtype_ilog) + & (currentPatch%area - currentPatch%total_canopy_area) * harvest_rate / currentPatch%area diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index bb380b0a00..5ad29d9846 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -223,6 +223,7 @@ subroutine zero_site( site_in ) site_in%promotion_carbonflux = 0._r8 ! Resources management (logging/harvesting, etc) + site_in%resources_management%harvest_debt = 0.0_r8 site_in%resources_management%trunk_product_site = 0.0_r8 ! canopy spread diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index 3d70760090..678ce56502 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -75,6 +75,7 @@ module EDMainMod use FatesAllometryMod , only : h_allom,tree_sai,tree_lai use FatesPlantHydraulicsMod , only : UpdateSizeDepRhizHydStates use EDLoggingMortalityMod , only : IsItLoggingTime + use EDLoggingMortalityMod , only : get_harvestable_carbon use EDPatchDynamicsMod , only : get_frac_site_primary use FatesGlobals , only : endrun => fates_endrun use ChecksBalancesMod , only : SiteMassStock @@ -288,6 +289,7 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) ! FIX(SPM,032414) refactor so everything goes through interface ! ! !USES: + use FatesInterfaceTypesMod, only : hlm_num_lu_harvest_cats use FatesInterfaceTypesMod, only : hlm_use_cohort_age_tracking use FatesConstantsMod, only : itrue ! !ARGUMENTS: @@ -317,9 +319,16 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) !----------------------------------------------------------------------- real(r8) :: frac_site_primary + real(r8) :: harvestable_forest_c(hlm_num_lu_harvest_cats) + real(r8) :: available_forest_c(hlm_num_lu_harvest_cats) + integer :: harvest_tag(hlm_num_lu_harvest_cats) + call get_frac_site_primary(currentSite, frac_site_primary) + ! Patch level biomass are required for C-based harvest + call get_harvestable_carbon(currentSite, bc_in%site_area, bc_in%hlm_harvest_catnames, harvestable_forest_c, available_forest_c) + ! Set a pointer to this sites carbon12 mass balance site_cmass => currentSite%mass_balance(element_pos(carbon12_element)) @@ -352,7 +361,8 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) ft = currentCohort%pft ! Calculate the mortality derivatives - call Mortality_Derivative( currentSite, currentCohort, bc_in, frac_site_primary ) + call Mortality_Derivative( currentSite, currentCohort, bc_in, frac_site_primary, & + harvestable_forest_c, available_forest_c, harvest_tag) ! ----------------------------------------------------------------------------- ! Apply Plant Allocation and Reactive Transport diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index e77a83e00d..678fcfe40c 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -574,6 +574,7 @@ module EDTypesMod type, public :: ed_resources_management_type real(r8) :: trunk_product_site ! Actual trunk product at site level KgC/site + real(r8) :: harvest_debt ! the amount of kgC per site that did not successfully harvested !debug variables real(r8) :: delta_litter_stock ! kgC/site = kgC/ha @@ -1076,6 +1077,9 @@ subroutine dump_cohort(ccohort) write(fates_log(),*) 'co%hmort = ', ccohort%hmort write(fates_log(),*) 'co%frmort = ', ccohort%frmort write(fates_log(),*) 'co%asmort = ', ccohort%asmort + write(fates_log(),*) 'co%lmort_direct = ', ccohort%lmort_direct + write(fates_log(),*) 'co%lmort_collateral = ', ccohort%lmort_collateral + write(fates_log(),*) 'co%lmort_infra = ', ccohort%lmort_infra write(fates_log(),*) 'co%isnew = ', ccohort%isnew write(fates_log(),*) 'co%dndt = ', ccohort%dndt write(fates_log(),*) 'co%dhdt = ', ccohort%dhdt @@ -1087,6 +1091,7 @@ subroutine dump_cohort(ccohort) write(fates_log(),*) 'co%cambial_mort = ', ccohort%cambial_mort write(fates_log(),*) 'co%size_class = ', ccohort%size_class write(fates_log(),*) 'co%size_by_pft_class = ', ccohort%size_by_pft_class + if (associated(ccohort%co_hydr) ) then call dump_cohort_hydr(ccohort) endif diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index f9fa005b4c..6b1c015791 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -274,6 +274,7 @@ module FatesHistoryInterfaceMod integer :: ih_fall_disturbance_rate_si integer :: ih_potential_disturbance_rate_si integer :: ih_harvest_carbonflux_si + integer :: ih_harvest_debt_si ! Indices to site by size-class by age variables integer :: ih_nplant_si_scag @@ -1859,6 +1860,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_fall_disturbance_rate_si => this%hvars(ih_fall_disturbance_rate_si)%r81d, & hio_potential_disturbance_rate_si => this%hvars(ih_potential_disturbance_rate_si)%r81d, & hio_harvest_carbonflux_si => this%hvars(ih_harvest_carbonflux_si)%r81d, & + hio_harvest_debt_si => this%hvars(ih_harvest_debt_si)%r81d, & hio_gpp_si_scpf => this%hvars(ih_gpp_si_scpf)%r82d, & hio_npp_totl_si_scpf => this%hvars(ih_npp_totl_si_scpf)%r82d, & hio_npp_leaf_si_scpf => this%hvars(ih_npp_leaf_si_scpf)%r82d, & @@ -2148,6 +2150,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_potential_disturbance_rate_si(io_si) = sum(sites(s)%potential_disturbance_rates(1:N_DIST_TYPES)) hio_harvest_carbonflux_si(io_si) = sites(s)%harvest_carbon_flux + hio_harvest_debt_si(io_si) = sites(s)%resources_management%harvest_debt ipa = 0 cpatch => sites(s)%oldest_patch @@ -4852,6 +4855,11 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_harvest_carbonflux_si ) + call this%set_history_var(vname='HARVEST_DEBT', units='kg C', & + long='Accumulated carbon failed to be harvested', use_default='active', & + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_harvest_debt_si ) + ! Canopy Resistance call this%set_history_var(vname='C_STOMATA', units='umol m-2 s-1', & diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 16f0607e7d..f3fc165037 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -1171,6 +1171,7 @@ subroutine set_fates_ctrlparms(tag,ival,rval,cval) hlm_sf_anthro_ignitions_def = unset_int hlm_use_planthydro = unset_int hlm_use_lu_harvest = unset_int + hlm_harvest_bypass_criteria = unset_int hlm_num_lu_harvest_cats = unset_int hlm_use_cohort_age_tracking = unset_int hlm_use_logging = unset_int @@ -1232,6 +1233,13 @@ subroutine set_fates_ctrlparms(tag,ival,rval,cval) call endrun(msg=errMsg(sourcefile, __LINE__)) end if + if ( (hlm_harvest_bypass_criteria .lt. 0).or.(hlm_harvest_bypass_criteria .gt. 1) ) then + if (fates_global_verbose()) then + write(fates_log(), *) 'The FATES bypass harvest scenario flag must be 0 or 1, exiting' + end if + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + if ( (hlm_num_lu_harvest_cats .lt. 0) ) then if (fates_global_verbose()) then write(fates_log(), *) 'The FATES number of hlm harvest cats must be >= 0, exiting' @@ -1611,6 +1619,12 @@ subroutine set_fates_ctrlparms(tag,ival,rval,cval) write(fates_log(),*) 'Transfering hlm_use_lu_harvest= ',ival,' to FATES' end if + case('use_harvest_bypass_criteria') + hlm_harvest_bypass_criteria = ival + if (fates_global_verbose()) then + write(fates_log(),*) 'Transfering hlm_harvest_bypass_criteria= ',ival,' to FATES' + end if + case('num_lu_harvest_cats') hlm_num_lu_harvest_cats = ival if (fates_global_verbose()) then diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index f7e1b95d20..3c33a4088e 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -117,6 +117,12 @@ module FatesInterfaceTypesMod ! If 1, it automatically sets ! hlm_use_logging to 1 + integer, public :: hlm_harvest_bypass_criteria ! This flag signals whether or not to bypass the logging criteria + ! when using carbon-based harvest and all available forest C under + ! criteria are not enough + ! 0 = do not bypass criteria + ! 1 = allow to bypass the criteria + integer, public :: hlm_num_lu_harvest_cats ! number of hlm harvest categories (e.g. primary forest harvest, secondary young forest harvest, etc.) ! this is the first dimension of: ! harvest_rates in dynHarvestMod @@ -510,6 +516,8 @@ module FatesInterfaceTypesMod real(r8) :: pprodharv10_forest_mean ! harvest mortality proportion of deadstem to 10-yr pool + real(r8) :: site_area ! Actual area of current site [m2], only used in carbon-based harvest + ! Fixed biogeography mode real(r8), allocatable :: pft_areafrac(:) ! Fractional area of the FATES column occupied by each PFT From 672582234c50b4fd7ad005d9ab910fe59d317c68 Mon Sep 17 00:00:00 2001 From: Shijie Shu Date: Thu, 10 Mar 2022 12:55:42 -0800 Subject: [PATCH 02/20] Updated minor corrections from fatesluc branch. --- biogeochem/EDLoggingMortalityMod.F90 | 6 ++++-- biogeochem/FatesAllometryMod.F90 | 2 +- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/biogeochem/EDLoggingMortalityMod.F90 b/biogeochem/EDLoggingMortalityMod.F90 index 0fb884df04..4062b8c2d4 100644 --- a/biogeochem/EDLoggingMortalityMod.F90 +++ b/biogeochem/EDLoggingMortalityMod.F90 @@ -1137,9 +1137,11 @@ subroutine UpdateHarvestC(currentSite,bc_in,bc_out) end if bc_out%hrv_deadstemc_to_prod10c = bc_out%hrv_deadstemc_to_prod10c + & - currentSite%harvest_carbon_flux * bc_in%pprodharv10_forest_mean * unit_trans_factor + currentSite%mass_balance(element_pos(carbon12_element))%wood_product * & + AREA_INV * pprodharv10_forest_mean * unit_trans_factor bc_out%hrv_deadstemc_to_prod100c = bc_out%hrv_deadstemc_to_prod100c + & - currentSite%harvest_carbon_flux * (1-bc_in%pprodharv10_forest_mean) * unit_trans_factor + currentSite%mass_balance(element_pos(carbon12_element))%wood_product * & + AREA_INV * (1 - pprodharv10_forest_mean) * unit_trans_factor return end subroutine UpdateHarvestC diff --git a/biogeochem/FatesAllometryMod.F90 b/biogeochem/FatesAllometryMod.F90 index a24653e652..99f7b80688 100644 --- a/biogeochem/FatesAllometryMod.F90 +++ b/biogeochem/FatesAllometryMod.F90 @@ -2336,7 +2336,7 @@ subroutine ForceDBH( ipft, canopy_trim, d, h, bdead, bl ) end if call h_allom(d,ipft,h) - if(counter>10)then + if(counter>20)then write(fates_log(),*) 'dbh counter: ',counter,' is woody: ',& int(prt_params%woody(ipft))==itrue end if From d5bd30485ad654a59432eb8edb53cfa65e9ec6e1 Mon Sep 17 00:00:00 2001 From: Shijie Shu Date: Thu, 17 Mar 2022 12:56:23 -0700 Subject: [PATCH 03/20] Updated changes from parent branch "fatesluc". --- biogeochem/EDLoggingMortalityMod.F90 | 5 +++++ main/EDParamsMod.F90 | 10 ++++++++++ 2 files changed, 15 insertions(+) diff --git a/biogeochem/EDLoggingMortalityMod.F90 b/biogeochem/EDLoggingMortalityMod.F90 index 4062b8c2d4..c78a64d598 100644 --- a/biogeochem/EDLoggingMortalityMod.F90 +++ b/biogeochem/EDLoggingMortalityMod.F90 @@ -1089,6 +1089,11 @@ subroutine UpdateHarvestC(currentSite,bc_in,bc_out) ! Harvested C flux in HLM. ! ---------------------------------------------------------------------------------- use EDtypesMod , only : ed_site_type + use EDTypesMod , only : AREA_INV + use PRTGenericMod , only : element_pos + use PRTGenericMod , only : carbon12_element + use EDParamsMod , only : pprodharv10_forest_mean + use FatesInterfaceTypesMod , only : bc_in_type, bc_out_type ! Arguments diff --git a/main/EDParamsMod.F90 b/main/EDParamsMod.F90 index 8162939bc3..921513a2ac 100644 --- a/main/EDParamsMod.F90 +++ b/main/EDParamsMod.F90 @@ -151,6 +151,9 @@ module EDParamsMod real(r8),protected,public :: logging_export_frac ! "fraction of trunk product being shipped offsite, the ! leftovers will be left onsite as large CWD character(len=param_string_length),parameter,public :: logging_name_export_frac ="fates_logging_export_frac" + real(r8),protected,public :: pprodharv10_forest_mean ! "mean harvest mortality proportion of deadstem to 10-yr + ! product pool (pprodharv10) of all woody PFT types + character(len=param_string_length),parameter,public :: logging_name_pprodharv10="fates_pprodharv10_forest_mean" real(r8),protected,public :: eca_plant_escalar ! scaling factor for plant fine root biomass to ! calculate nutrient carrier enzyme abundance (ECA) @@ -208,6 +211,7 @@ subroutine FatesParamsInit() logging_event_code = nan logging_dbhmax_infra = nan logging_export_frac = nan + pprodharv10_forest_mean = nan eca_plant_escalar = nan q10_mr = nan q10_froz = nan @@ -348,6 +352,9 @@ subroutine FatesRegisterParams(fates_params) call fates_params%RegisterParameter(name=logging_name_export_frac, dimension_shape=dimension_shape_scalar, & dimension_names=dim_names_scalar) + call fates_params%RegisterParameter(name=logging_name_pprodharv10, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) + call fates_params%RegisterParameter(name=eca_name_plant_escalar, dimension_shape=dimension_shape_scalar, & dimension_names=dim_names_scalar) @@ -500,6 +507,9 @@ subroutine FatesReceiveParams(fates_params) call fates_params%RetreiveParameter(name=logging_name_export_frac, & data=logging_export_frac) + call fates_params%RetreiveParameter(name=logging_name_pprodharv10, & + data=pprodharv10_forest_mean) + call fates_params%RetreiveParameter(name=eca_name_plant_escalar, & data=eca_plant_escalar) From 14c300295f5e5a25029576ba520fcd0c3a42535e Mon Sep 17 00:00:00 2001 From: Shijie Shu Date: Thu, 16 Jun 2022 14:25:03 -0700 Subject: [PATCH 04/20] Added historical outputs of secondary patches. --- biogeochem/EDCanopyStructureMod.F90 | 3 +- biogeochem/EDLoggingMortalityMod.F90 | 19 +- biogeochem/EDPatchDynamicsMod.F90 | 286 ++++++++++++------------ main/EDInitMod.F90 | 1 + main/EDMainMod.F90 | 1 - main/EDTypesMod.F90 | 6 +- main/FatesHistoryInterfaceMod.F90 | 322 ++++++++++++++++++++++++--- 7 files changed, 451 insertions(+), 187 deletions(-) diff --git a/biogeochem/EDCanopyStructureMod.F90 b/biogeochem/EDCanopyStructureMod.F90 index 1d9d8206fe..694f3c2e46 100644 --- a/biogeochem/EDCanopyStructureMod.F90 +++ b/biogeochem/EDCanopyStructureMod.F90 @@ -1901,13 +1901,14 @@ subroutine update_hlm_dynamics(nsites,sites,fcolumn,bc_in,bc_out) use EDTypesMod , only : ed_patch_type, ed_cohort_type, & ed_site_type, AREA - use FatesInterfaceTypesMod , only : bc_out_type + use FatesInterfaceTypesMod , only : bc_in_type, bc_out_type ! ! !ARGUMENTS integer, intent(in) :: nsites type(ed_site_type), intent(inout), target :: sites(nsites) integer, intent(in) :: fcolumn(nsites) + type(bc_in_type), intent(inout) :: bc_in(nsites) type(bc_out_type), intent(inout) :: bc_out(nsites) ! Locals diff --git a/biogeochem/EDLoggingMortalityMod.F90 b/biogeochem/EDLoggingMortalityMod.F90 index bc3c90da0a..d17010a33a 100644 --- a/biogeochem/EDLoggingMortalityMod.F90 +++ b/biogeochem/EDLoggingMortalityMod.F90 @@ -374,12 +374,13 @@ subroutine get_harvest_rate_area (patch_anthro_disturbance_label, hlm_harvest_ca integer :: h_index ! for looping over harvest categories integer :: icode ! Integer equivalent of the event code (parameter file only allows reals) - ! Loop around harvest categories to determine the annual hlm harvest rate for the current cohort based on patch history info + ! Loop around harvest categories to determine the annual hlm harvest rate for the current cohort based on patch history info + ! We do account forest only since non-forest harvest has geographical mismatch to LUH2 dataset harvest_rate = 0._r8 do h_index = 1,hlm_num_lu_harvest_cats if (patch_anthro_disturbance_label .eq. primaryforest) then - if(hlm_harvest_catnames(h_index) .eq. "HARVEST_VH1" .or. & - hlm_harvest_catnames(h_index) .eq. "HARVEST_VH2") then + if(hlm_harvest_catnames(h_index) .eq. "HARVEST_VH1") then! .or. & + ! hlm_harvest_catnames(h_index) .eq. "HARVEST_VH2") then harvest_rate = harvest_rate + hlm_harvest_rates(h_index) endif else if (patch_anthro_disturbance_label .eq. secondaryforest .and. & @@ -389,8 +390,8 @@ subroutine get_harvest_rate_area (patch_anthro_disturbance_label, hlm_harvest_ca endif else if (patch_anthro_disturbance_label .eq. secondaryforest .and. & secondary_age < secondary_age_threshold) then - if(hlm_harvest_catnames(h_index) .eq. "HARVEST_SH2" .or. & - hlm_harvest_catnames(h_index) .eq. "HARVEST_SH3") then + if(hlm_harvest_catnames(h_index) .eq. "HARVEST_SH2") then! .or. & + ! hlm_harvest_catnames(h_index) .eq. "HARVEST_SH3") then harvest_rate = harvest_rate + hlm_harvest_rates(h_index) endif endif @@ -594,8 +595,8 @@ subroutine get_harvest_rate_carbon (patch_anthro_disturbance_label, hlm_harvest_ do h_index = 1,hlm_num_lu_harvest_cats if (patch_anthro_disturbance_label .eq. primaryforest) then - if(hlm_harvest_catnames(h_index) .eq. "HARVEST_VH1" .or. & - hlm_harvest_catnames(h_index) .eq. "HARVEST_VH2") then + if(hlm_harvest_catnames(h_index) .eq. "HARVEST_VH1") then! .or. & + ! hlm_harvest_catnames(h_index) .eq. "HARVEST_VH2") then harvest_rate_c = harvest_rate_c + hlm_harvest_rates(h_index) ! Determine the total supply of available C for harvest if(harvestable_forest_c(h_index) >= harvest_rate_c) then @@ -624,8 +625,8 @@ subroutine get_harvest_rate_carbon (patch_anthro_disturbance_label, hlm_harvest_ endif else if (patch_anthro_disturbance_label .eq. secondaryforest .and. & secondary_age < secondary_age_threshold) then - if(hlm_harvest_catnames(h_index) .eq. "HARVEST_SH2" .or. & - hlm_harvest_catnames(h_index) .eq. "HARVEST_SH3") then + if(hlm_harvest_catnames(h_index) .eq. "HARVEST_SH2") then! .or. & + ! hlm_harvest_catnames(h_index) .eq. "HARVEST_SH3") then harvest_rate_c = harvest_rate_c + hlm_harvest_rates(h_index) if(harvestable_forest_c(h_index) >= harvest_rate_c) then harvest_rate_supply = harvest_rate_supply + harvestable_forest_c(h_index) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index cfe719b44b..b1036035a0 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -191,9 +191,13 @@ subroutine disturbance_rates( site_in, bc_in) integer :: h_index real(r8) :: frac_site_primary real(r8) :: harvest_rate + real(r8) :: tempsum real(r8) :: harvestable_forest_c(hlm_num_lu_harvest_cats) real(r8) :: available_forest_c(hlm_num_lu_harvest_cats) integer :: harvest_tag(hlm_num_lu_harvest_cats) + integer :: harvest_debt_primary + integer :: harvest_debt_secondary + integer :: patch_no_secondary !---------------------------------------------------------------------------------------------- ! Calculate Mortality Rates (these were previously calculated during growth derivatives) @@ -208,6 +212,10 @@ subroutine disturbance_rates( site_in, bc_in) site_in%harvest_carbon_flux = 0._r8 + harvest_debt_primary = 0 + harvest_debt_secondary = 0 + patch_no_secondary = 0 + currentPatch => site_in%oldest_patch do while (associated(currentPatch)) @@ -259,21 +267,75 @@ subroutine disturbance_rates( site_in, bc_in) currentCohort => currentCohort%taller end do - currentPatch%disturbance_mode = fates_unset_int - currentPatch => currentPatch%younger - end do - ! Determine harvest debt from all three categories - do h_index = 1, hlm_num_lu_harvest_cats - if (harvest_tag(h_index) == 2 .or. & - (harvest_tag(h_index) == 1 .and. .not. (hlm_harvest_bypass_criteria))) then - if(logging_time) then - site_in%resources_management%harvest_debt = site_in%resources_management%harvest_debt + & - bc_in%hlm_harvest_rates(h_index) - end if + ! Determine harvest debt status from all three categories + ! Each cohort has the same harvest tag but not each patch + ! Hence this part shall be within the patch loop + ! TODO: we can define harvest debt as a fraction of the + ! harvest rate in the future + ! Warning: Non-forest harvest is not accounted for yet + ! Thus the harvest tag for non-forest are not effective + if(logging_time) then + harvest_debt_loop: do h_index = 1, hlm_num_lu_harvest_cats + ! Primary patch: Once a patch has debt, skip the calculation + if (harvest_debt_primary == 0) then + if ( currentPatch%anthro_disturbance_label .eq. primaryforest ) then + if ( harvest_tag(h_index) == 2 .or. & + (harvest_tag(h_index) == 1 .and. .not. (hlm_harvest_bypass_criteria))) then + ! h_index points to primary forest harvest + if((bc_in%hlm_harvest_catnames(h_index) .eq. "HARVEST_VH1")) then + harvest_debt_primary = 1 + exit harvest_debt_loop + end if + end if + end if + end if + ! Secondary patch + if (harvest_debt_secondary == 0) then + if ( currentPatch%anthro_disturbance_label .eq. secondaryforest ) then + patch_no_secondary = patch_no_secondary + 1 + if ( harvest_tag(h_index) == 2 .or. & + (harvest_tag(h_index) == 1 .and. .not. (hlm_harvest_bypass_criteria))) then + ! h_index points to secondary forest harvest + if((bc_in%hlm_harvest_catnames(h_index) .eq. "HARVEST_SH1") .or. & + (bc_in%hlm_harvest_catnames(h_index) .eq. "HARVEST_SH2")) then + harvest_debt_secondary = 1 + exit harvest_debt_loop + end if + end if + end if + end if + end do harvest_debt_loop end if + + currentPatch => currentPatch%younger end do + ! Obatin actual harvest debt. This shall be outside the patch loop + if(logging_time) then + do h_index = 1, hlm_num_lu_harvest_cats + if ( harvest_debt_primary == 1 ) then + ! Only account for primary forest harvest rate + if((bc_in%hlm_harvest_catnames(h_index) .eq. "HARVEST_VH1")) then !.or. & + ! (bc_in%hlm_harvest_catnames(h_index) .eq. "HARVEST_VH2")) then + site_in%resources_management%harvest_debt = site_in%resources_management%harvest_debt + & + bc_in%hlm_harvest_rates(h_index) + end if + end if + if (harvest_debt_secondary == 1 .or. patch_no_secondary == 0) then + ! Only account for secondary forest harvest rate + if((bc_in%hlm_harvest_catnames(h_index) .eq. "HARVEST_SH1") .or. & + (bc_in%hlm_harvest_catnames(h_index) .eq. "HARVEST_SH2")) then !.or. & + ! (bc_in%hlm_harvest_catnames(h_index) .eq. "HARVEST_SH3")) then + site_in%resources_management%harvest_debt = site_in%resources_management%harvest_debt + & + bc_in%hlm_harvest_rates(h_index) + site_in%resources_management%harvest_debt_sec = site_in%resources_management%harvest_debt_sec + & + bc_in%hlm_harvest_rates(h_index) + end if + end if + end do + end if + ! --------------------------------------------------------------------------------------------- ! Calculate Disturbance Rates based on the mortality rates just calculated ! --------------------------------------------------------------------------------------------- @@ -381,89 +443,12 @@ subroutine disturbance_rates( site_in, bc_in) endif endif - - - ! ------------------------------------------------------------------------------------------ - ! Determine which disturbance is dominant, and force mortality diagnostics in the upper - ! canopy to be zero for the non-dominant mode. Note: upper-canopy tree-fall mortality is - ! not always disturbance generating, so when tree-fall mort is non-dominant, make sure - ! to still diagnose and track the non-disturbance rate - ! ------------------------------------------------------------------------------------------ - - ! DISTURBANCE IS LOGGING - if (currentPatch%disturbance_rates(dtype_ilog) > currentPatch%disturbance_rates(dtype_ifall) .and. & - currentPatch%disturbance_rates(dtype_ilog) > currentPatch%disturbance_rates(dtype_ifire) ) then - - currentPatch%disturbance_rate = currentPatch%disturbance_rates(dtype_ilog) - currentPatch%disturbance_mode = dtype_ilog - - ! Update diagnostics - currentCohort => currentPatch%shortest - do while(associated(currentCohort)) - if(currentCohort%canopy_layer == 1)then - currentCohort%cmort = currentCohort%cmort*(1.0_r8 - fates_mortality_disturbance_fraction) - currentCohort%hmort = currentCohort%hmort*(1.0_r8 - fates_mortality_disturbance_fraction) - currentCohort%bmort = currentCohort%bmort*(1.0_r8 - fates_mortality_disturbance_fraction) - currentCohort%dmort = currentCohort%dmort*(1.0_r8 - fates_mortality_disturbance_fraction) - currentCohort%frmort = currentCohort%frmort*(1.0_r8 - fates_mortality_disturbance_fraction) - currentCohort%smort = currentCohort%smort*(1.0_r8 - fates_mortality_disturbance_fraction) - currentCohort%asmort = currentCohort%asmort*(1.0_r8 - fates_mortality_disturbance_fraction) - end if - currentCohort => currentCohort%taller - enddo !currentCohort - - ! DISTURBANCE IS FIRE - elseif (currentPatch%disturbance_rates(dtype_ifire) > currentPatch%disturbance_rates(dtype_ifall) .and. & - currentPatch%disturbance_rates(dtype_ifire) > currentPatch%disturbance_rates(dtype_ilog) ) then - - currentPatch%disturbance_rate = currentPatch%disturbance_rates(dtype_ifire) - currentPatch%disturbance_mode = dtype_ifire - - ! Update diagnostics, zero non-fire mortality rates - currentCohort => currentPatch%shortest - do while(associated(currentCohort)) - if(currentCohort%canopy_layer == 1)then - currentCohort%cmort = currentCohort%cmort*(1.0_r8 - fates_mortality_disturbance_fraction) - currentCohort%hmort = currentCohort%hmort*(1.0_r8 - fates_mortality_disturbance_fraction) - currentCohort%bmort = currentCohort%bmort*(1.0_r8 - fates_mortality_disturbance_fraction) - currentCohort%dmort = currentCohort%dmort*(1.0_r8 - fates_mortality_disturbance_fraction) - currentCohort%frmort = currentCohort%frmort*(1.0_r8 - fates_mortality_disturbance_fraction) - currentCohort%smort = currentCohort%smort*(1.0_r8 - fates_mortality_disturbance_fraction) - currentCohort%asmort = currentCohort%asmort*(1.0_r8 - fates_mortality_disturbance_fraction) - currentCohort%lmort_direct = 0.0_r8 - currentCohort%lmort_collateral = 0.0_r8 - currentCohort%lmort_infra = 0.0_r8 - currentCohort%l_degrad = 0.0_r8 - end if - - ! This may be counter-intuitive, but the diagnostic fire-mortality rate - ! will stay zero in the patch that undergoes fire, this is because - ! the actual cohorts who experience the fire are only those in the - ! newly created patch so currentCohort%fmort = 0.0_r8 - ! Don't worry, the cohorts in the newly created patch will reflect burn - - currentCohort => currentCohort%taller - enddo !currentCohort - - else ! If fire and logging are not greater than treefall, just set disturbance rate to tree-fall - ! which is most likely a 0.0 - - currentPatch%disturbance_rate = currentPatch%disturbance_rates(dtype_ifall) - currentPatch%disturbance_mode = dtype_ifall - - ! Update diagnostics, zero non-treefall mortality rates - currentCohort => currentPatch%shortest - do while(associated(currentCohort)) - if(currentCohort%canopy_layer == 1)then - currentCohort%lmort_direct = 0.0_r8 - currentCohort%lmort_collateral = 0.0_r8 - currentCohort%lmort_infra = 0.0_r8 - currentCohort%l_degrad = 0.0_r8 - end if - currentCohort => currentCohort%taller - enddo !currentCohort - - + ! if the sum of all disturbance rates is such that they will exceed total patch area on this day, then reduce them all proportionally. + if ( sum(currentPatch%disturbance_rates(:)) .gt. 1.0_r8 ) then + tempsum = sum(currentPatch%disturbance_rates(:)) + do i_dist = 1,N_DIST_TYPES + currentPatch%disturbance_rates(i_dist) = currentPatch%disturbance_rates(i_dist) / tempsum + end do endif currentPatch => currentPatch%younger @@ -528,6 +513,9 @@ subroutine spawn_patches( currentSite, bc_in) real(r8) :: leaf_m ! leaf mass during partial burn calculations logical :: found_youngest_primary ! logical for finding the first primary forest patch integer :: min_nocomp_pft, max_nocomp_pft, i_nocomp_pft + integer :: i_disturbance_type, i_dist2 ! iterators for looping over disturbance types + real(r8) :: disturbance_rate ! rate of disturbance being resolved [fraction of patch area / day] + real(r8) :: oldarea ! old patch area prior to disturbance !--------------------------------------------------------------------- storesmallcohort => null() ! storage of the smallest cohort for insertion routine @@ -552,6 +540,8 @@ subroutine spawn_patches( currentSite, bc_in) ! If nocomp is not enabled, then this is not much of a loop, it only passes through once. nocomp_pft_loop: do i_nocomp_pft = min_nocomp_pft,max_nocomp_pft + disturbance_type_loop: do i_disturbance_type = 1,N_DIST_TYPES + ! calculate area of disturbed land, in this timestep, by summing contributions from each existing patch. currentPatch => currentSite%youngest_patch @@ -562,47 +552,42 @@ subroutine spawn_patches( currentSite, bc_in) cp_nocomp_matches_1_if: if ( hlm_use_nocomp .eq. ifalse .or. & currentPatch%nocomp_pft_label .eq. i_nocomp_pft ) then - - if(currentPatch%disturbance_rate > (1.0_r8 + rsnbl_math_prec)) then - write(fates_log(),*) 'patch disturbance rate > 1 ?',currentPatch%disturbance_rate + + disturbance_rate = currentPatch%disturbance_rates(i_disturbance_type) + + if(disturbance_rate > (1.0_r8 + rsnbl_math_prec)) then + write(fates_log(),*) 'patch disturbance rate > 1 ?',disturbance_rate call dump_patch(currentPatch) call endrun(msg=errMsg(sourcefile, __LINE__)) end if - ! Check to make sure that the disturbance mode of the patch is set - if( .not.any(currentPatch%disturbance_mode == [dtype_ilog,dtype_ifall,dtype_ifire])) then - write(fates_log(),*) 'undefined disturbance mode? : ',currentPatch%disturbance_mode - call endrun(msg=errMsg(sourcefile, __LINE__)) - end if - - ! Only create new patches that have non-negligible amount of land - if((currentPatch%area*currentPatch%disturbance_rate) > nearzero ) then + if((currentPatch%area*disturbance_rate) > nearzero ) then ! figure out whether the receiver patch for disturbance from this patch will be ! primary or secondary land receiver patch is primary forest only if both the - ! donor patch is primary forest and the dominant disturbance type is not logging + ! donor patch is primary forest and the current disturbance type is not logging if ( currentPatch%anthro_disturbance_label .eq. primaryforest .and. & - (currentPatch%disturbance_mode .ne. dtype_ilog) ) then + (i_disturbance_type .ne. dtype_ilog) ) then - site_areadis_primary = site_areadis_primary + currentPatch%area * currentPatch%disturbance_rate + site_areadis_primary = site_areadis_primary + currentPatch%area * disturbance_rate ! track disturbance rates to output to history - currentSite%disturbance_rates_primary_to_primary(currentPatch%disturbance_mode) = & - currentSite%disturbance_rates_primary_to_primary(currentPatch%disturbance_mode) + & - currentPatch%area * currentPatch%disturbance_rate * AREA_INV + currentSite%disturbance_rates_primary_to_primary(i_disturbance_type) = & + currentSite%disturbance_rates_primary_to_primary(i_disturbance_type) + & + currentPatch%area * disturbance_rate * AREA_INV else - site_areadis_secondary = site_areadis_secondary + currentPatch%area * currentPatch%disturbance_rate + site_areadis_secondary = site_areadis_secondary + currentPatch%area * disturbance_rate ! track disturbance rates to output to history if (currentPatch%anthro_disturbance_label .eq. secondaryforest) then - currentSite%disturbance_rates_secondary_to_secondary(currentPatch%disturbance_mode) = & - currentSite%disturbance_rates_secondary_to_secondary(currentPatch%disturbance_mode) + & - currentPatch%area * currentPatch%disturbance_rate * AREA_INV + currentSite%disturbance_rates_secondary_to_secondary(i_disturbance_type) = & + currentSite%disturbance_rates_secondary_to_secondary(i_disturbance_type) + & + currentPatch%area * disturbance_rate * AREA_INV else - currentSite%disturbance_rates_primary_to_secondary(currentPatch%disturbance_mode) = & - currentSite%disturbance_rates_primary_to_secondary(currentPatch%disturbance_mode) + & - currentPatch%area * currentPatch%disturbance_rate * AREA_INV + currentSite%disturbance_rates_primary_to_secondary(i_disturbance_type) = & + currentSite%disturbance_rates_primary_to_secondary(i_disturbance_type) + & + currentPatch%area * disturbance_rate * AREA_INV endif endif @@ -676,17 +661,18 @@ subroutine spawn_patches( currentSite, bc_in) currentPatch%nocomp_pft_label .eq. i_nocomp_pft ) then ! This is the amount of patch area that is disturbed, and donated by the donor - patch_site_areadis = currentPatch%area * currentPatch%disturbance_rate + disturbance_rate = currentPatch%disturbance_rates(i_disturbance_type) + patch_site_areadis = currentPatch%area * disturbance_rate if ( patch_site_areadis > nearzero ) then ! figure out whether the receiver patch for disturbance from this patch ! will be primary or secondary land receiver patch is primary forest - ! only if both the donor patch is primary forest and the dominant + ! only if both the donor patch is primary forest and the current ! disturbance type is not logging if (currentPatch%anthro_disturbance_label .eq. primaryforest .and. & - (currentPatch%disturbance_mode .ne. dtype_ilog)) then + (i_disturbance_type .ne. dtype_ilog)) then new_patch => new_patch_primary else new_patch => new_patch_secondary @@ -699,11 +685,11 @@ subroutine spawn_patches( currentSite, bc_in) end if ! for the case where the donating patch is secondary forest, if - ! the dominant disturbance from this patch is non-anthropogenic, + ! the current disturbance from this patch is non-anthropogenic, ! we need to average in the time-since-anthropogenic-disturbance ! from the donor patch into that of the receiver patch if ( currentPatch%anthro_disturbance_label .eq. secondaryforest .and. & - (currentPatch%disturbance_mode .ne. dtype_ilog) ) then + (i_disturbance_type .ne. dtype_ilog) ) then new_patch%age_since_anthro_disturbance = new_patch%age_since_anthro_disturbance + & currentPatch%age_since_anthro_disturbance * (patch_site_areadis / site_areadis_secondary) @@ -714,9 +700,9 @@ 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 - ! fire is not the dominant disturbance regime. + ! fire is not the current disturbance regime. - if(currentPatch%disturbance_mode .ne. dtype_ifire) then + if(i_disturbance_type .ne. dtype_ifire) then currentPatch%burnt_frac_litter(:) = 0._r8 end if @@ -724,10 +710,10 @@ subroutine spawn_patches( currentSite, bc_in) ! Transfer in litter fluxes from plants in various contexts of death and destruction - if(currentPatch%disturbance_mode .eq. dtype_ilog) then + if(i_disturbance_type .eq. dtype_ilog) then call logging_litter_fluxes(currentSite, currentPatch, & new_patch, patch_site_areadis,bc_in) - elseif(currentPatch%disturbance_mode .eq. dtype_ifire) then + elseif(i_disturbance_type .eq. dtype_ifire) then call fire_litter_fluxes(currentSite, currentPatch, & new_patch, patch_site_areadis,bc_in) else @@ -786,8 +772,8 @@ subroutine spawn_patches( currentSite, bc_in) store_c = currentCohort%prt%GetState(store_organ, all_carbon_elements) total_c = sapw_c + struct_c + leaf_c + fnrt_c + store_c - ! treefall mortality is the dominant disturbance - if(currentPatch%disturbance_mode .eq. dtype_ifall) then + ! treefall mortality is the current disturbance + if(i_disturbance_type .eq. dtype_ifall) then if(currentCohort%canopy_layer == 1)then @@ -896,8 +882,8 @@ subroutine spawn_patches( currentSite, bc_in) endif endif - ! Fire is the dominant disturbance - elseif (currentPatch%disturbance_mode .eq. dtype_ifire ) then + ! Fire is the current disturbance + elseif (i_disturbance_type .eq. dtype_ifire ) then ! Number of members in the new patch, before we impose fire survivorship nc%n = currentCohort%n * patch_site_areadis/currentPatch%area @@ -995,8 +981,8 @@ subroutine spawn_patches( currentSite, bc_in) - ! Logging is the dominant disturbance - elseif (currentPatch%disturbance_mode .eq. dtype_ilog ) then + ! Logging is the current disturbance + elseif (i_disturbance_type .eq. dtype_ilog ) then ! If this cohort is in the upper canopy. It generated if(currentCohort%canopy_layer == 1)then @@ -1114,7 +1100,7 @@ subroutine spawn_patches( currentSite, bc_in) else write(fates_log(),*) 'unknown disturbance mode?' - write(fates_log(),*) 'disturbance_mode: ',currentPatch%disturbance_mode + write(fates_log(),*) 'i_disturbance_type: ', i_disturbance_type call endrun(msg=errMsg(sourcefile, __LINE__)) end if ! Select disturbance mode @@ -1155,8 +1141,18 @@ subroutine spawn_patches( currentSite, bc_in) call sort_cohorts(currentPatch) !update area of donor patch + oldarea = currentPatch%area currentPatch%area = currentPatch%area - patch_site_areadis + ! for all disturbance rates that haven't been resolved yet, increase their amount so that + ! they are the same amount of gridcell-scale disturbance relative to the original patch size + if (i_disturbance_type .ne. N_DIST_TYPES) then + do i_dist2 = i_disturbance_type+1,N_DIST_TYPES + currentPatch%disturbance_rates(i_dist2) = currentPatch%disturbance_rates(i_dist2) & + * oldarea / currentPatch%area + end do + end if + ! sort out the cohorts, since some of them may be so small as to need removing. ! the first call to terminate cohorts removes sparse number densities, ! the second call removes for all other reasons (sparse culling must happen @@ -1168,11 +1164,6 @@ subroutine spawn_patches( currentSite, bc_in) end if ! if ( new_patch%area > nearzero ) then - !zero disturbance rate trackers - currentPatch%disturbance_rate = 0._r8 - currentPatch%disturbance_rates = 0._r8 - currentPatch%fract_ldist_not_harvested = 0._r8 - end if cp_nocomp_matches_2_if currentPatch => currentPatch%younger @@ -1254,8 +1245,19 @@ subroutine spawn_patches( currentSite, bc_in) call check_patch_area(currentSite) call set_patchno(currentSite) - + + end do disturbance_type_loop + end do nocomp_pft_loop + + !zero disturbance rate trackers on all patches + currentPatch => currentSite%oldest_patch + do while(associated(currentPatch)) + currentPatch%disturbance_rates(:) = 0._r8 + currentPatch%fract_ldist_not_harvested = 0._r8 + currentPatch => currentPatch%younger + end do + return end subroutine spawn_patches @@ -2144,7 +2146,6 @@ subroutine create_patch(currentSite, new_patch, age, areap, label,nocomp_pft) ! This new value will be generated when the calculate disturbance ! rates routine is called. This does not need to be remembered or in the restart file. - new_patch%disturbance_mode = fates_unset_int new_patch%f_sun = 0._r8 new_patch%ed_laisun_z(:,:,:) = 0._r8 @@ -2247,8 +2248,7 @@ subroutine zero_patch(cp_p) currentPatch%pft_agb_profile(:,:) = nan ! DISTURBANCE - currentPatch%disturbance_rates = 0._r8 - currentPatch%disturbance_rate = 0._r8 + currentPatch%disturbance_rates(:) = 0._r8 currentPatch%fract_ldist_not_harvested = 0._r8 diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index dabdfb84f6..ac0b80a182 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -249,6 +249,7 @@ subroutine zero_site( site_in ) ! Resources management (logging/harvesting, etc) site_in%resources_management%harvest_debt = 0.0_r8 + site_in%resources_management%harvest_debt_sec = 0.0_r8 site_in%resources_management%trunk_product_site = 0.0_r8 ! canopy spread diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index 8b749cb17c..b1c9ebb511 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -855,7 +855,6 @@ subroutine TotalBalanceCheck (currentSite, call_index ) write(fates_log(),*) 'BG CWD (by layer): ', sum(litt%bg_cwd,dim=1) write(fates_log(),*) 'leaf litter:',sum(litt%leaf_fines) write(fates_log(),*) 'root litter (by layer): ',sum(litt%root_fines,dim=1) - write(fates_log(),*) 'dist mode: ',currentPatch%disturbance_mode write(fates_log(),*) 'anthro_disturbance_label: ',currentPatch%anthro_disturbance_label write(fates_log(),*) 'use_this_pft: ', currentSite%use_this_pft(:) if(print_cohorts)then diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index bd51a29746..ba32b647b1 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -537,9 +537,6 @@ module EDTypesMod real(r8) :: disturbance_rates(n_dist_types) ! disturbance rate from 1) mortality ! 2) fire: fraction/day ! 3) logging mortatliy - real(r8) :: disturbance_rate ! larger effective disturbance rate: fraction/day - integer :: disturbance_mode ! index identifying which disturbance was applied - ! can be one of: dtype_ifall, dtype_ilog or dtype_ifire real(r8) :: fract_ldist_not_harvested ! fraction of logged area that is canopy trees that weren't harvested @@ -594,6 +591,8 @@ module EDTypesMod real(r8) :: trunk_product_site ! Actual trunk product at site level KgC/site real(r8) :: harvest_debt ! the amount of kgC per site that did not successfully harvested + real(r8) :: harvest_debt_sec ! the amount of kgC per site from secondary patches that did + ! not successfully harvested !debug variables real(r8) :: delta_litter_stock ! kgC/site = kgC/ha @@ -1017,7 +1016,6 @@ subroutine dump_patch(cpatch) write(fates_log(),*) 'pa%gnd_alb_dir = ',cpatch%gnd_alb_dir(:) write(fates_log(),*) 'pa%c_stomata = ',cpatch%c_stomata write(fates_log(),*) 'pa%c_lblayer = ',cpatch%c_lblayer - write(fates_log(),*) 'pa%disturbance_rate = ',cpatch%disturbance_rate write(fates_log(),*) 'pa%disturbance_rates = ',cpatch%disturbance_rates(:) write(fates_log(),*) 'pa%anthro_disturbance_label = ',cpatch%anthro_disturbance_label write(fates_log(),*) '----------------------------------------' diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 5e89cd4c27..da508d8f2e 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -271,6 +271,12 @@ module FatesHistoryInterfaceMod integer :: ih_canopy_biomass_si integer :: ih_understory_biomass_si + integer :: ih_npp_secondary_si + integer :: ih_gpp_secondary_si + integer :: ih_aresp_secondary_si + integer :: ih_maint_resp_secondary_si + integer :: ih_growth_resp_secondary_si + integer :: ih_primaryland_fusion_error_si integer :: ih_disturbance_rate_p2p_si integer :: ih_disturbance_rate_p2s_si @@ -281,6 +287,7 @@ module FatesHistoryInterfaceMod integer :: ih_potential_disturbance_rate_si integer :: ih_harvest_carbonflux_si integer :: ih_harvest_debt_si + integer :: ih_harvest_debt_sec_si ! Indices to site by size-class by age variables integer :: ih_nplant_si_scag @@ -316,7 +323,9 @@ module FatesHistoryInterfaceMod integer :: ih_err_fates_si integer :: ih_npatches_si + integer :: ih_npatches_sec_si integer :: ih_ncohorts_si + integer :: ih_ncohorts_sec_si integer :: ih_demotion_carbonflux_si integer :: ih_promotion_carbonflux_si integer :: ih_canopy_mortality_carbonflux_si @@ -444,6 +453,7 @@ module FatesHistoryInterfaceMod integer :: ih_ddbh_understory_si_scls integer :: ih_agb_si_scls integer :: ih_biomass_si_scls + integer :: ih_mortality_canopy_secondary_si_scls ! mortality vars integer :: ih_m1_si_scls @@ -457,6 +467,14 @@ module FatesHistoryInterfaceMod integer :: ih_m9_si_scls integer :: ih_m10_si_scls + integer :: ih_m1_sec_si_scls + integer :: ih_m2_sec_si_scls + integer :: ih_m3_sec_si_scls + integer :: ih_m7_sec_si_scls + integer :: ih_m8_sec_si_scls + integer :: ih_m9_sec_si_scls + integer :: ih_m10_sec_si_scls + integer :: ih_m10_si_cacls integer :: ih_nplant_si_cacls @@ -506,15 +524,19 @@ module FatesHistoryInterfaceMod ! indices to (site x pft) variables integer :: ih_biomass_si_pft + integer :: ih_biomass_sec_si_pft integer :: ih_leafbiomass_si_pft integer :: ih_storebiomass_si_pft integer :: ih_nindivs_si_pft + integer :: ih_nindivs_sec_si_pft integer :: ih_recruitment_si_pft integer :: ih_mortality_si_pft integer :: ih_crownarea_si_pft integer :: ih_canopycrownarea_si_pft integer :: ih_gpp_si_pft + integer :: ih_gpp_sec_si_pft integer :: ih_npp_si_pft + integer :: ih_npp_sec_si_pft integer :: ih_nocomp_pftpatchfraction_si_pft integer :: ih_nocomp_pftnpatches_si_pft integer :: ih_nocomp_pftburnedarea_si_pft @@ -538,6 +560,8 @@ module FatesHistoryInterfaceMod integer :: ih_fire_intensity_si_age integer :: ih_fire_sum_fuel_si_age + integer :: ih_lai_secondary_si + ! indices to (site x height) variables integer :: ih_canopy_height_dist_si_height integer :: ih_leaf_height_dist_si_height @@ -1753,6 +1777,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) real(r8) :: binbottom,bintop ! edges of height bins real(r8) :: gpp_cached ! variable used to cache gpp value in previous time step; for C13 discrimination + real(r8) :: lai_patch_cached ! temporary variable to cache mean lai of current patch ! The following are all carbon states, turnover and net allocation flux variables ! the organs of relevance should be self explanatory @@ -1787,21 +1812,27 @@ subroutine update_history_dyn(this,nc,nsites,sites) integer :: tmp associate( hio_npatches_si => this%hvars(ih_npatches_si)%r81d, & + hio_npatches_sec_si => this%hvars(ih_npatches_sec_si)%r81d, & hio_ncohorts_si => this%hvars(ih_ncohorts_si)%r81d, & + hio_ncohorts_sec_si => this%hvars(ih_ncohorts_sec_si)%r81d, & hio_trimming_si => this%hvars(ih_trimming_si)%r81d, & hio_area_plant_si => this%hvars(ih_area_plant_si)%r81d, & hio_area_trees_si => this%hvars(ih_area_trees_si)%r81d, & hio_canopy_spread_si => this%hvars(ih_canopy_spread_si)%r81d, & hio_biomass_si_pft => this%hvars(ih_biomass_si_pft)%r82d, & + hio_biomass_sec_si_pft => this%hvars(ih_biomass_sec_si_pft)%r82d, & hio_leafbiomass_si_pft => this%hvars(ih_leafbiomass_si_pft)%r82d, & hio_storebiomass_si_pft => this%hvars(ih_storebiomass_si_pft)%r82d, & hio_nindivs_si_pft => this%hvars(ih_nindivs_si_pft)%r82d, & + hio_nindivs_sec_si_pft => this%hvars(ih_nindivs_sec_si_pft)%r82d, & hio_recruitment_si_pft => this%hvars(ih_recruitment_si_pft)%r82d, & hio_mortality_si_pft => this%hvars(ih_mortality_si_pft)%r82d, & hio_crownarea_si_pft => this%hvars(ih_crownarea_si_pft)%r82d, & hio_canopycrownarea_si_pft => this%hvars(ih_canopycrownarea_si_pft)%r82d, & hio_gpp_si_pft => this%hvars(ih_gpp_si_pft)%r82d, & + hio_gpp_sec_si_pft => this%hvars(ih_gpp_sec_si_pft)%r82d, & hio_npp_si_pft => this%hvars(ih_npp_si_pft)%r82d, & + hio_npp_sec_si_pft => this%hvars(ih_npp_sec_si_pft)%r82d, & hio_nesterov_fire_danger_si => this%hvars(ih_nesterov_fire_danger_si)%r81d, & hio_fire_nignitions_si => this%hvars(ih_fire_nignitions_si)%r81d, & hio_fire_fdi_si => this%hvars(ih_fire_fdi_si)%r81d, & @@ -1843,6 +1874,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_potential_disturbance_rate_si => this%hvars(ih_potential_disturbance_rate_si)%r81d, & hio_harvest_carbonflux_si => this%hvars(ih_harvest_carbonflux_si)%r81d, & hio_harvest_debt_si => this%hvars(ih_harvest_debt_si)%r81d, & + hio_harvest_debt_sec_si => this%hvars(ih_harvest_debt_sec_si)%r81d, & hio_gpp_si_scpf => this%hvars(ih_gpp_si_scpf)%r82d, & hio_npp_totl_si_scpf => this%hvars(ih_npp_totl_si_scpf)%r82d, & hio_npp_leaf_si_scpf => this%hvars(ih_npp_leaf_si_scpf)%r82d, & @@ -1864,6 +1896,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_bleaf_canopy_si_scpf => this%hvars(ih_bleaf_canopy_si_scpf)%r82d, & hio_bleaf_understory_si_scpf => this%hvars(ih_bleaf_understory_si_scpf)%r82d, & hio_mortality_canopy_si_scpf => this%hvars(ih_mortality_canopy_si_scpf)%r82d, & + hio_mortality_canopy_secondary_si_scls => this%hvars(ih_mortality_canopy_secondary_si_scls)%r82d, & hio_mortality_understory_si_scpf => this%hvars(ih_mortality_understory_si_scpf)%r82d, & hio_nplant_canopy_si_scpf => this%hvars(ih_nplant_canopy_si_scpf)%r82d, & hio_nplant_understory_si_scpf => this%hvars(ih_nplant_understory_si_scpf)%r82d, & @@ -1913,6 +1946,14 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_m10_si_scls => this%hvars(ih_m10_si_scls)%r82d, & hio_m10_si_cacls => this%hvars(ih_m10_si_cacls)%r82d, & + hio_m1_sec_si_scls => this%hvars(ih_m1_sec_si_scls)%r82d, & + hio_m2_sec_si_scls => this%hvars(ih_m2_sec_si_scls)%r82d, & + hio_m3_sec_si_scls => this%hvars(ih_m3_sec_si_scls)%r82d, & + hio_m7_sec_si_scls => this%hvars(ih_m7_sec_si_scls)%r82d, & + hio_m8_sec_si_scls => this%hvars(ih_m8_sec_si_scls)%r82d, & + hio_m9_sec_si_scls => this%hvars(ih_m9_sec_si_scls)%r82d, & + hio_m10_sec_si_scls => this%hvars(ih_m10_sec_si_scls)%r82d, & + hio_c13disc_si_scpf => this%hvars(ih_c13disc_si_scpf)%r82d, & hio_cwd_elcwd => this%hvars(ih_cwd_elcwd)%r82d, & @@ -1977,6 +2018,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_yesterdaycanopylevel_understory_si_scls => this%hvars(ih_yesterdaycanopylevel_understory_si_scls)%r82d, & hio_area_si_age => this%hvars(ih_area_si_age)%r82d, & hio_lai_si_age => this%hvars(ih_lai_si_age)%r82d, & + hio_lai_secondary_si => this%hvars(ih_lai_secondary_si)%r81d, & hio_canopy_area_si_age => this%hvars(ih_canopy_area_si_age)%r82d, & hio_ncl_si_age => this%hvars(ih_ncl_si_age)%r82d, & hio_npatches_si_age => this%hvars(ih_npatches_si_age)%r82d, & @@ -2112,6 +2154,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) end if hio_harvest_carbonflux_si(io_si) = sites(s)%harvest_carbon_flux hio_harvest_debt_si(io_si) = sites(s)%resources_management%harvest_debt + hio_harvest_debt_sec_si(io_si) = sites(s)%resources_management%harvest_debt_sec ! error in primary lands from patch fusion [m2 m-2 day-1] -> [m2 m-2 yr-1] hio_primaryland_fusion_error_si(io_si) = sites(s)%primary_land_patchfusion_error * days_per_year @@ -2149,6 +2192,9 @@ subroutine update_history_dyn(this,nc,nsites,sites) ! Increment the number of patches per site hio_npatches_si(io_si) = hio_npatches_si(io_si) + 1._r8 + if ( cpatch%anthro_disturbance_label .eq. secondaryforest ) then + hio_npatches_sec_si(io_si) = hio_npatches_sec_si(io_si) + 1._r8 + end if cpatch%age_class = get_age_class_index(cpatch%age) @@ -2161,9 +2207,9 @@ subroutine update_history_dyn(this,nc,nsites,sites) (cpatch%tveg24%GetMean()- t_water_freeze_k_1atm)*cpatch%area*AREA_INV ! Increment some patch-age-resolved diagnostics - hio_lai_si_age(io_si,cpatch%age_class) = hio_lai_si_age(io_si,cpatch%age_class) & + sum(cpatch%tlai_profile(:,:,:)) * cpatch%area + hio_ncl_si_age(io_si,cpatch%age_class) = hio_ncl_si_age(io_si,cpatch%age_class) & + cpatch%ncl_p * cpatch%area hio_npatches_si_age(io_si,cpatch%age_class) = hio_npatches_si_age(io_si,cpatch%age_class) + 1._r8 @@ -2189,6 +2235,19 @@ subroutine update_history_dyn(this,nc,nsites,sites) + cpatch%area * AREA_INV endif + ! Secondary forest mean LAI + if ( cpatch%anthro_disturbance_label .eq. secondaryforest ) then + lai_patch_cached = 0._r8 + do ican = 1, cpatch%NCL_p + do i_pft = 1, numpft + lai_patch_cached = lai_patch_cached + sum(cpatch%canopy_area_profile(ican,i_pft,1:cpatch%nrad(ican,i_pft)) * & + cpatch%tlai_profile(ican,i_pft,1:cpatch%nrad(ican,i_pft))) + end do + end do + hio_lai_secondary_si(io_si) = hio_lai_secondary_si(io_si) & + + lai_patch_cached * min(1.0_r8, (cpatch%total_canopy_area/cpatch%area)) * cpatch%area * AREA_INV + end if + ! patch-age-resolved fire variables do i_pft = 1,numpft ! for scorch height, weight the value by patch area within any @@ -2254,6 +2313,10 @@ subroutine update_history_dyn(this,nc,nsites,sites) ! Increment the number of cohorts per site hio_ncohorts_si(io_si) = hio_ncohorts_si(io_si) + 1._r8 + if ( cpatch%anthro_disturbance_label .eq. secondaryforest ) then + hio_ncohorts_sec_si(io_si) = hio_ncohorts_sec_si(io_si) + 1._r8 + end if + n_perm2 = ccohort%n * AREA_INV hio_canopy_area_si_age(io_si,cpatch%age_class) = hio_canopy_area_si_age(io_si,cpatch%age_class) & @@ -2346,9 +2409,19 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_nindivs_si_pft(io_si,ft) = hio_nindivs_si_pft(io_si,ft) + & ccohort%n * AREA_INV + if ( cpatch%anthro_disturbance_label .eq. secondaryforest ) then + hio_nindivs_sec_si_pft(io_si,ft) = hio_nindivs_sec_si_pft(io_si,ft) + & + ccohort%n * AREA_INV + end if + hio_biomass_si_pft(io_si, ft) = hio_biomass_si_pft(io_si, ft) + & (ccohort%n * AREA_INV) * total_m + if ( cpatch%anthro_disturbance_label .eq. secondaryforest ) then + hio_biomass_sec_si_pft(io_si, ft) = hio_biomass_sec_si_pft(io_si, ft) + & + (ccohort%n * AREA_INV) * total_m + end if + ! update total biomass per age bin hio_biomass_si_age(io_si,cpatch%age_class) = hio_biomass_si_age(io_si,cpatch%age_class) & + total_m * ccohort%n * AREA_INV @@ -2431,6 +2504,14 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_npp_si_pft(io_si, ft) = hio_npp_si_pft(io_si, ft) + & ccohort%npp_acc_hold * n_perm2 / days_per_year / sec_per_day + if ( cpatch%anthro_disturbance_label .eq. secondaryforest ) then + hio_gpp_sec_si_pft(io_si, ft) = hio_gpp_sec_si_pft(io_si, ft) + & + ccohort%gpp_acc_hold * n_perm2 / days_per_year / sec_per_day + hio_npp_sec_si_pft(io_si, ft) = hio_npp_sec_si_pft(io_si, ft) + & + ccohort%npp_acc_hold * n_perm2 / days_per_year / sec_per_day + end if + + ! Site by Size-Class x PFT (SCPF) ! ------------------------------------------------------------------------ @@ -2564,6 +2645,25 @@ subroutine update_history_dyn(this,nc,nsites,sites) ccohort%frmort*ccohort%n / m2_per_ha hio_m9_si_scls(io_si,scls) = hio_m9_si_scls(io_si,scls) + ccohort%smort*ccohort%n / m2_per_ha + ! Examine secondary forest mortality and mortality rates + + if(cpatch%anthro_disturbance_label .eq. secondaryforest) then + + if (hlm_use_cohort_age_tracking .eq.itrue) then + hio_m10_sec_si_scls(io_si,scls) = hio_m10_sec_si_scls(io_si,scls) + & + ccohort%asmort*ccohort%n / m2_per_ha + end if + + hio_m1_sec_si_scls(io_si,scls) = hio_m1_sec_si_scls(io_si,scls) + ccohort%bmort*ccohort%n / m2_per_ha + hio_m2_sec_si_scls(io_si,scls) = hio_m2_sec_si_scls(io_si,scls) + ccohort%hmort*ccohort%n / m2_per_ha + hio_m3_sec_si_scls(io_si,scls) = hio_m3_sec_si_scls(io_si,scls) + ccohort%cmort*ccohort%n / m2_per_ha + hio_m7_sec_si_scls(io_si,scls) = hio_m7_sec_si_scls(io_si,scls) + & + (ccohort%lmort_direct+ccohort%lmort_collateral+ccohort%lmort_infra) * ccohort%n / m2_per_ha + hio_m8_sec_si_scls(io_si,scls) = hio_m8_sec_si_scls(io_si,scls) + & + ccohort%frmort*ccohort%n / m2_per_ha + hio_m9_sec_si_scls(io_si,scls) = hio_m9_sec_si_scls(io_si,scls) + ccohort%smort*ccohort%n / m2_per_ha + end if + !C13 discrimination if(gpp_cached + ccohort%gpp_acc_hold > 0.0_r8)then hio_c13disc_si_scpf(io_si,scpf) = ((hio_c13disc_si_scpf(io_si,scpf) * gpp_cached) + & @@ -2741,6 +2841,15 @@ subroutine update_history_dyn(this,nc,nsites,sites) (ccohort%lmort_direct + ccohort%lmort_collateral + ccohort%lmort_infra) * & ccohort%n * sec_per_day * days_per_year / m2_per_ha + if ( cpatch%anthro_disturbance_label .eq. secondaryforest ) then + hio_mortality_canopy_secondary_si_scls(io_si,scls) = hio_mortality_canopy_secondary_si_scls(io_si,scls) + & + (ccohort%bmort + ccohort%hmort + ccohort%cmort + & + ccohort%frmort + ccohort%smort + ccohort%asmort) * ccohort%n / m2_per_ha + & + (ccohort%lmort_direct + ccohort%lmort_collateral + ccohort%lmort_infra) * & + ccohort%n * sec_per_day * days_per_year / m2_per_ha + end if + + hio_nplant_understory_si_scpf(io_si,scpf) = hio_nplant_understory_si_scpf(io_si,scpf) + ccohort%n / m2_per_ha hio_nplant_understory_si_scls(io_si,scls) = hio_nplant_understory_si_scls(io_si,scls) + ccohort%n / m2_per_ha hio_lai_understory_si_scls(io_si,scls) = hio_lai_understory_si_scls(io_si,scls) + & @@ -2994,6 +3103,12 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_mortality_canopy_si_scls(io_si,i_scls) = hio_mortality_canopy_si_scls(io_si,i_scls) + & sites(s)%fmort_rate_canopy(i_scls, i_pft) / m2_per_ha + ! Shijie: Think about how to add later? + !if ( cpatch%anthro_disturbance_label .eq. secondaryforest ) then + ! hio_mortality_canopy_secondary_si_scls(io_si,i_scls) = hio_mortality_canopy_secondary_si_scls(io_si,i_scls) + & + ! sites(s)%term_nindivs_canopy(i_scls,i_pft) * days_per_year / m2_per_ha + !end if + ! the fire mortality rates for each layer are total dead, since the usable ! output will then normalize by the counts, we are allowed to sum over layers hio_mortality_understory_si_scpf(io_si,i_scpf) = hio_mortality_understory_si_scpf(io_si,i_scpf) + & @@ -3503,10 +3618,15 @@ subroutine update_history_hifrq(this,nc,nsites,sites,bc_in,dt_tstep) real(r8) :: per_dt_tstep ! Time step in frequency units (/s) associate( hio_gpp_si => this%hvars(ih_gpp_si)%r81d, & + hio_gpp_secondary_si => this%hvars(ih_gpp_secondary_si)%r81d, & hio_npp_si => this%hvars(ih_npp_si)%r81d, & + hio_npp_secondary_si => this%hvars(ih_npp_secondary_si)%r81d, & hio_aresp_si => this%hvars(ih_aresp_si)%r81d, & + hio_aresp_secondary_si => this%hvars(ih_aresp_secondary_si)%r81d, & hio_maint_resp_si => this%hvars(ih_maint_resp_si)%r81d, & + hio_maint_resp_secondary_si => this%hvars(ih_maint_resp_secondary_si)%r81d, & hio_growth_resp_si => this%hvars(ih_growth_resp_si)%r81d, & + hio_growth_resp_secondary_si => this%hvars(ih_growth_resp_secondary_si)%r81d, & hio_c_stomata_si => this%hvars(ih_c_stomata_si)%r81d, & hio_c_lblayer_si => this%hvars(ih_c_lblayer_si)%r81d, & hio_rad_error_si => this%hvars(ih_rad_error_si)%r81d, & @@ -3651,6 +3771,20 @@ subroutine update_history_hifrq(this,nc,nsites,sites,bc_in,dt_tstep) hio_maint_resp_si(io_si) = hio_maint_resp_si(io_si) + & ccohort%resp_m * n_perm2 * per_dt_tstep + ! Secondary forest only + if ( cpatch%anthro_disturbance_label .eq. secondaryforest ) then + hio_npp_secondary_si(io_si) = hio_npp_secondary_si(io_si) + & + npp * n_perm2 * per_dt_tstep + hio_gpp_secondary_si(io_si) = hio_gpp_secondary_si(io_si) + & + ccohort%gpp_tstep * n_perm2 * per_dt_tstep + hio_aresp_secondary_si(io_si) = hio_aresp_secondary_si(io_si) + & + aresp * n_perm2 * per_dt_tstep + hio_growth_resp_secondary_si(io_si) = hio_growth_resp_secondary_si(io_si) + & + resp_g * n_perm2 * per_dt_tstep + hio_maint_resp_secondary_si(io_si) = hio_maint_resp_secondary_si(io_si) + & + ccohort%resp_m * n_perm2 * per_dt_tstep + end if + ! Add up the total Net Ecosystem Production ! for this timestep. [kgC/m2/s] hio_nep_si(io_si) = hio_nep_si(io_si) + & @@ -4377,6 +4511,18 @@ subroutine define_history_vars(this, initialize_variables) upfreq=1, ivar=ivar, initialize=initialize_variables, & index=ih_ncohorts_si) + call this%set_history_var(vname='FATES_NPATCHES_SECONDARY', units='', & + long='total number of patches per site', use_default='active', & + avgflag='A', vtype=site_r8, hlms='CLM:ALM', & + upfreq=1, ivar=ivar, initialize=initialize_variables, & + index=ih_npatches_sec_si) + + call this%set_history_var(vname='FATES_NCOHORTS_SECONDARY', units='', & + long='total number of cohorts per site', use_default='active', & + avgflag='A', vtype=site_r8, hlms='CLM:ALM', & + upfreq=1, ivar=ivar, initialize=initialize_variables, & + index=ih_ncohorts_sec_si) + ! Patch variables call this%set_history_var(vname='FATES_TRIMMING', units='1', & long='degree to which canopy expansion is limited by leaf economics (0-1)', & @@ -4469,6 +4615,12 @@ subroutine define_history_vars(this, initialize_variables) upfreq=1, ivar=ivar, initialize=initialize_variables, & index=ih_biomass_si_pft) + call this%set_history_var(vname='FATES_VEGC_SE_PF', units='kg m-2', & + long='total PFT-level biomass in kg of carbon per land area, secondary patches', & + use_default='active', avgflag='A', vtype=site_pft_r8, hlms='CLM:ALM', & + upfreq=1, ivar=ivar, initialize=initialize_variables, & + index=ih_biomass_sec_si_pft) + call this%set_history_var(vname='FATES_LEAFC_PF', units='kg m-2', & long='total PFT-level leaf biomass in kg carbon per m2 land area', & use_default='active', avgflag='A', vtype=site_pft_r8, hlms='CLM:ALM', & @@ -4505,12 +4657,30 @@ subroutine define_history_vars(this, initialize_variables) upfreq=1, ivar=ivar, initialize=initialize_variables, & index=ih_npp_si_pft) + call this%set_history_var(vname='FATES_GPP_SE_PF', units='kg m-2 s-1', & + long='total PFT-level GPP in kg carbon per m2 land area per second, secondary patches', & + use_default='active', avgflag='A', vtype=site_pft_r8, hlms='CLM:ALM', & + upfreq=1, ivar=ivar, initialize=initialize_variables, & + index=ih_gpp_sec_si_pft) + + call this%set_history_var(vname='FATES_NPP_SE_PF', units='kg m-2 yr-1', & + long='total PFT-level NPP in kg carbon per m2 land area per second, secondary patches', & + use_default='active', avgflag='A', vtype=site_pft_r8, hlms='CLM:ALM', & + upfreq=1, ivar=ivar, initialize=initialize_variables, & + index=ih_npp_sec_si_pft) + call this%set_history_var(vname='FATES_NPLANT_PF', units='m-2', & long='total PFT-level number of individuals per m2 land area', & use_default='active', avgflag='A', vtype=site_pft_r8, hlms='CLM:ALM', & upfreq=1, ivar=ivar, initialize=initialize_variables, & index=ih_nindivs_si_pft) + call this%set_history_var(vname='FATES_NPLANT_SEC_PF', units='m-2', & + long='total PFT-level number of individuals per m2 land area, secondary patches', & + use_default='active', avgflag='A', vtype=site_pft_r8, hlms='CLM:ALM', & + upfreq=1, ivar=ivar, initialize=initialize_variables, & + index=ih_nindivs_sec_si_pft) + call this%set_history_var(vname='FATES_RECRUITMENT_PF', & units='m-2 yr-1', & long='PFT-level recruitment rate in number of individuals per m2 land area per year', & @@ -4556,6 +4726,12 @@ subroutine define_history_vars(this, initialize_variables) upfreq=1, ivar=ivar, initialize=initialize_variables, & index=ih_lai_si_age) + call this%set_history_var(vname='FATES_LAI_SECONDARY', units='m2 m-2', & + long='leaf area index per m2 land area, secondary patches', & + use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & + upfreq=1, ivar=ivar, initialize=initialize_variables, & + index=ih_lai_secondary_si) + call this%set_history_var(vname='FATES_CANOPYAREA_AP', units='m2 m-2', & long='canopy area by age bin per m2 land area', use_default='active', & avgflag='A', vtype=site_age_r8, hlms='CLM:ALM', upfreq=1, ivar=ivar, & @@ -5144,64 +5320,69 @@ subroutine define_history_vars(this, initialize_variables) ! disturbance rates call this%set_history_var(vname='PRIMARYLAND_PATCHFUSION_ERROR', units='m2 m-2 d-1', & long='Error in total primary lands associated with patch fusion', use_default='active', & - avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + avgflag='A', vtype=site_r8, hlms='CLM:ALM', upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_primaryland_fusion_error_si ) call this%set_history_var(vname='DISTURBANCE_RATE_P2P', units='m2 m-2 d-1', & long='Disturbance rate from primary to primary lands', use_default='active', & - avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + avgflag='A', vtype=site_r8, hlms='CLM:ALM', upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_disturbance_rate_p2p_si ) call this%set_history_var(vname='DISTURBANCE_RATE_P2S', units='m2 m-2 d-1', & long='Disturbance rate from primary to secondary lands', use_default='active', & - avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + avgflag='A', vtype=site_r8, hlms='CLM:ALM', upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_disturbance_rate_p2s_si ) call this%set_history_var(vname='DISTURBANCE_RATE_S2S', units='m2 m-2 d-1', & long='Disturbance rate from secondary to secondary lands', use_default='active', & - avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + avgflag='A', vtype=site_r8, hlms='CLM:ALM', upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_disturbance_rate_s2s_si ) - call this%set_history_var(vname='DISTURBANCE_RATE_FIRE', units='m2 m-2 d-1', & - long='Disturbance rate from fire', use_default='active', & - avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & - ivar=ivar, initialize=initialize_variables, index = ih_fire_disturbance_rate_si ) - - call this%set_history_var(vname='DISTURBANCE_RATE_LOGGING', units='m2 m-2 d-1', & - long='Disturbance rate from logging', use_default='active', & - avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & - ivar=ivar, initialize=initialize_variables, index = ih_logging_disturbance_rate_si ) - - call this%set_history_var(vname='DISTURBANCE_RATE_TREEFALL', units='m2 m-2 d-1', & - long='Disturbance rate from treefall', use_default='active', & - avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & - ivar=ivar, initialize=initialize_variables, index = ih_fall_disturbance_rate_si ) - - call this%set_history_var(vname='DISTURBANCE_RATE_POTENTIAL', units='m2 m-2 d-1', & - long='Potential (i.e., including unresolved) disturbance rate', use_default='active', & - avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & - ivar=ivar, initialize=initialize_variables, index = ih_potential_disturbance_rate_si ) +! call this%set_history_var(vname='DISTURBANCE_RATE_FIRE', units='m2 m-2 d-1', & +! long='Disturbance rate from fire', use_default='active', & +! avgflag='A', vtype=site_r8, hlms='CLM:ALM', upfreq=1, & +! ivar=ivar, initialize=initialize_variables, index = ih_fire_disturbance_rate_si ) +! +! call this%set_history_var(vname='DISTURBANCE_RATE_LOGGING', units='m2 m-2 d-1', & +! long='Disturbance rate from logging', use_default='active', & +! avgflag='A', vtype=site_r8, hlms='CLM:ALM', upfreq=1, & +! ivar=ivar, initialize=initialize_variables, index = ih_logging_disturbance_rate_si ) +! +! call this%set_history_var(vname='DISTURBANCE_RATE_TREEFALL', units='m2 m-2 d-1', & +! long='Disturbance rate from treefall', use_default='active', & +! avgflag='A', vtype=site_r8, hlms='CLM:ALM', upfreq=1, & +! ivar=ivar, initialize=initialize_variables, index = ih_fall_disturbance_rate_si ) +! +! call this%set_history_var(vname='DISTURBANCE_RATE_POTENTIAL', units='m2 m-2 d-1', & +! long='Potential (i.e., including unresolved) disturbance rate', use_default='active', & +! avgflag='A', vtype=site_r8, hlms='CLM:ALM', upfreq=1, & +! ivar=ivar, initialize=initialize_variables, index = ih_potential_disturbance_rate_si ) call this%set_history_var(vname='HARVEST_CARBON_FLUX', units='kg C m-2 d-1', & long='Harvest carbon flux', use_default='active', & - avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + avgflag='A', vtype=site_r8, hlms='CLM:ALM', upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_harvest_carbonflux_si ) call this%set_history_var(vname='HARVEST_DEBT', units='kg C', & long='Accumulated carbon failed to be harvested', use_default='active', & - avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + avgflag='A', vtype=site_r8, hlms='CLM:ALM', upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_harvest_debt_si ) + call this%set_history_var(vname='HARVEST_DEBT_SEC', units='kg C', & + long='Accumulated carbon failed to be harvested from secondary patches', use_default='active', & + avgflag='A', vtype=site_r8, hlms='CLM:ALM', upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_harvest_debt_sec_si ) + ! Canopy Resistance call this%set_history_var(vname='C_STOMATA', units='umol m-2 s-1', & long='mean stomatal conductance', use_default='active', & - avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & + avgflag='A', vtype=site_r8, hlms='CLM:ALM', upfreq=2, & ivar=ivar, initialize=initialize_variables, index = ih_c_stomata_si ) call this%set_history_var(vname='C_LBLAYER', units='umol m-2 s-1', & long='mean leaf boundary layer conductance', use_default='active', & - avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & + avgflag='A', vtype=site_r8, hlms='CLM:ALM', upfreq=2, & ivar=ivar, initialize=initialize_variables, index = ih_c_lblayer_si ) @@ -5212,28 +5393,55 @@ subroutine define_history_vars(this, initialize_variables) use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & upfreq=2, ivar=ivar, initialize=initialize_variables, index = ih_npp_si) + call this%set_history_var(vname='FATES_NPP_SECONDARY', units='kg m-2 s-1', & + long='net primary production in kg carbon per m2 per second, secondary patches', & + use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & + upfreq=2, ivar=ivar, initialize=initialize_variables, index = ih_npp_secondary_si) + call this%set_history_var(vname='FATES_GPP', units='kg m-2 s-1', & long='gross primary production in kg carbon per m2 per second', & use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & upfreq=2, ivar=ivar, initialize=initialize_variables, index = ih_gpp_si) + call this%set_history_var(vname='FATES_GPP_SECONDARY', units='kg m-2 s-1', & + long='gross primary production in kg carbon per m2 per second, secondary patches', & + use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & + upfreq=2, ivar=ivar, initialize=initialize_variables, index = ih_gpp_secondary_si) + call this%set_history_var(vname='FATES_AUTORESP', units='kg m-2 s-1', & long='autotrophic respiration in kg carbon per m2 per second', & use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & upfreq=2, ivar=ivar, initialize=initialize_variables, index = ih_aresp_si) + call this%set_history_var(vname='FATES_AUTORESP_SECONDARY', units='kg m-2 s-1', & + long='autotrophic respiration in kg carbon per m2 per second, secondary patches', & + use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & + upfreq=2, ivar=ivar, initialize=initialize_variables, index = ih_aresp_secondary_si) + call this%set_history_var(vname='FATES_GROWTH_RESP', units='kg m-2 s-1', & long='growth respiration in kg carbon per m2 per second', & use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & upfreq=2, ivar=ivar, initialize=initialize_variables, & index = ih_growth_resp_si) + call this%set_history_var(vname='FATES_GROWTH_RESP_SECONDARY', units='kg m-2 s-1', & + long='growth respiration in kg carbon per m2 per second, secondary patches', & + use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & + upfreq=2, ivar=ivar, initialize=initialize_variables, & + index = ih_growth_resp_secondary_si) + call this%set_history_var(vname='FATES_MAINT_RESP', units='kg m-2 s-1', & - long='maintenance respiration in kg carbon per m2 land area per second', & + long='maintenance respiration in kg carbon per m2 land area per second, secondary patches', & use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & upfreq=2, ivar=ivar, initialize=initialize_variables, & index = ih_maint_resp_si) + call this%set_history_var(vname='FATES_MAINT_RESP_SECONDARY', units='kg m-2 s-1', & + long='maintenance respiration in kg carbon per m2 land area per second', & + use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & + upfreq=2, ivar=ivar, initialize=initialize_variables, & + index = ih_maint_resp_secondary_si) + ! Canopy resistance call this%set_history_var(vname='FATES_STOMATAL_COND_AP', & @@ -6074,6 +6282,13 @@ subroutine define_history_vars(this, initialize_variables) hlms='CLM:ALM', upfreq=1, ivar=ivar, & initialize=initialize_variables, index = ih_mortality_canopy_si_scls) + call this%set_history_var(vname='FATES_MORTALITY_CANOPY_SE_SZ', & + units = 'm-2 yr-1', & + long='total mortality of canopy trees by size class in number of plants per m2, secondary patches', & + use_default='active', avgflag='A', vtype=site_size_r8, & + hlms='CLM:ALM', upfreq=1, ivar=ivar, & + initialize=initialize_variables, index = ih_mortality_canopy_secondary_si_scls) + call this%set_history_var(vname='FATES_NPLANT_USTORY_SZ', & units = 'm-2', & long='number of understory plants per m2 by size class', & @@ -6127,6 +6342,27 @@ subroutine define_history_vars(this, initialize_variables) hlms='CLM:ALM', upfreq=1, ivar=ivar, & initialize=initialize_variables, index = ih_m3_si_scls) + call this%set_history_var(vname='FATES_MORTALITY_BACKGROUND_SE_SZ', & + units = 'm-2 yr-1', & + long='background mortality by size in number of plants per m2 per year, secondary patches', & + use_default='active', avgflag='A', vtype=site_size_r8, & + hlms='CLM:ALM', upfreq=1, ivar=ivar, & + initialize=initialize_variables, index = ih_m1_sec_si_scls) + + call this%set_history_var(vname='FATES_MORTALITY_HYDRAULIC_SE_SZ', & + units = 'm-2 yr-1', & + long='hydraulic mortality by size in number of plants per m2 per year, secondary patches', & + use_default='active', avgflag='A', vtype=site_size_r8, & + hlms='CLM:ALM', upfreq=1, ivar=ivar, & + initialize=initialize_variables, index = ih_m2_sec_si_scls) + + call this%set_history_var(vname='FATES_MORTALITY_CSTARV_SE_SZ', & + units = 'm-2 yr-1', & + long='carbon starvation mortality by size in number of plants per m2 per year, secondary patches', & + use_default='active', avgflag='A', vtype=site_size_r8, & + hlms='CLM:ALM', upfreq=1, ivar=ivar, & + initialize=initialize_variables, index = ih_m3_sec_si_scls) + call this%set_history_var(vname='FATES_MORTALITY_IMPACT_SZ', & units = 'm-2 yr-1', & long='impact mortality by size in number of plants per m2 per year', & @@ -6183,6 +6419,34 @@ subroutine define_history_vars(this, initialize_variables) hlms='CLM:ALM', upfreq=1, ivar=ivar, & initialize=initialize_variables, index = ih_m10_si_cacls) + call this%set_history_var(vname='FATES_MORTALITY_LOGGING_SE_SZ', & + units = 'm-2 yr-1', & + long='logging mortality by size in number of plants per m2 per event, secondary patches', & + use_default='active', avgflag='A', vtype=site_size_r8, & + hlms='CLM:ALM', upfreq=1, ivar=ivar, & + initialize=initialize_variables, index = ih_m7_sec_si_scls) + + call this%set_history_var(vname='FATES_MORTALITY_FREEZING_SE_SZ', & + units = 'm-2 event-1', & + long='freezing mortality by size in number of plants per m2 per event, secondary patches', & + use_default='active', avgflag='A', vtype=site_size_r8, & + hlms='CLM:ALM', upfreq=1, ivar=ivar, & + initialize=initialize_variables, index = ih_m8_sec_si_scls) + + call this%set_history_var(vname='FATES_MORTALITY_SENESCENCE_SE_SZ', & + units = 'm-2 yr-1', & + long='senescence mortality by size in number of plants per m2 per event, secondary patches', & + use_default='active', avgflag='A', vtype=site_size_r8, & + hlms='CLM:ALM', upfreq=1, ivar=ivar, & + initialize=initialize_variables, index = ih_m9_sec_si_scls) + + call this%set_history_var(vname='FATES_MORTALITY_AGESCEN_SE_SZ', & + units = 'm-2 yr-1', & + long='age senescence mortality by size in number of plants per m2 per year, secondary patches', & + use_default='active', avgflag='A', vtype=site_size_r8, & + hlms='CLM:ALM', upfreq=1, ivar=ivar, & + initialize=initialize_variables, index = ih_m10_sec_si_scls) + call this%set_history_var(vname='FATES_NPP_CANOPY_SZ', units = 'kg m-2 s-1', & long='NPP of canopy plants by size class in kg carbon per m2 per second', & use_default='inactive', avgflag='A', vtype=site_size_r8, & From 67b9211e36b3a47fe027ed24826326f4681b5078 Mon Sep 17 00:00:00 2001 From: Shijie Shu Date: Tue, 2 Aug 2022 14:37:21 -0700 Subject: [PATCH 05/20] Pass NPP and AR to ELM for calculating NBP. --- main/EDMainMod.F90 | 9 +++++++++ main/FatesInterfaceMod.F90 | 3 +++ main/FatesInterfaceTypesMod.F90 | 2 ++ parteh/PRTGenericMod.F90 | 18 ++++++++++-------- 4 files changed, 24 insertions(+), 8 deletions(-) diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index b1c9ebb511..d0e5af8d96 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -342,6 +342,10 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) call get_frac_site_primary(currentSite, frac_site_primary) + ! Clear site GPP and AR passing to HLM + bc_out%gpp_site = 0._r8 + bc_out%ar_site = 0._r8 + ! Patch level biomass are required for C-based harvest call get_harvestable_carbon(currentSite, bc_in%site_area, bc_in%hlm_harvest_catnames, harvestable_forest_c, available_forest_c) @@ -422,6 +426,11 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) currentCohort%gpp_acc_hold = currentCohort%gpp_acc * real(hlm_days_per_year,r8) currentCohort%resp_acc_hold = currentCohort%resp_acc * real(hlm_days_per_year,r8) + ! Passing gpp_acc_hold to HLM + bc_out%gpp_site = bc_out%gpp_site + currentCohort%gpp_acc_hold * & + AREA_INV * currentCohort%n / hlm_days_per_year / sec_per_day + bc_out%ar_site = bc_out%ar_site + currentCohort%resp_acc_hold * & + AREA_INV * currentCohort%n / hlm_days_per_year / sec_per_day ! Conduct Maintenance Turnover (parteh) if(debug) call currentCohort%prt%CheckMassConservation(ft,3) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index d9ea82efcf..14ac272ae6 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -365,6 +365,9 @@ subroutine zero_bcs(fates,s) end if fates%bc_out(s)%plant_stored_h2o_si = 0.0_r8 + ! Land Use realated + fates%bc_out(s)%gpp_site = 0.0_r8 + fates%bc_out(s)%ar_site = 0.0_r8 fates%bc_out(s)%hrv_deadstemc_to_prod10c = 0.0_r8 fates%bc_out(s)%hrv_deadstemc_to_prod100c = 0.0_r8 diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index d1b0dddd12..e29aca8e39 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -710,6 +710,8 @@ module FatesInterfaceTypesMod ! FATES LULCC real(r8) :: hrv_deadstemc_to_prod10c ! Harvested C flux to 10-yr wood product pool [Site-Level, gC m-2 s-1] real(r8) :: hrv_deadstemc_to_prod100c ! Harvested C flux to 100-yr wood product pool [Site-Level, gC m-2 s-1] + real(r8) :: gpp_site ! Site level GPP, for NBP diagnosis in HLM [Site-Level, gC m-2 s-1] + real(r8) :: ar_site ! Site level Autotrophic Resp, for NBP diagnosis in HLM [Site-Level, gC m-2 s-1] end type bc_out_type diff --git a/parteh/PRTGenericMod.F90 b/parteh/PRTGenericMod.F90 index 3dab9563a3..00c0ac677b 100644 --- a/parteh/PRTGenericMod.F90 +++ b/parteh/PRTGenericMod.F90 @@ -866,15 +866,17 @@ subroutine DeallocatePRTVartypes(this) ! Check to see if there is any value in these pools? ! SHould not deallocate if there is any carbon left - do i_var = 1, prt_global%num_vars - deallocate(this%variables(i_var)%val) - deallocate(this%variables(i_var)%val0) - deallocate(this%variables(i_var)%net_alloc) - deallocate(this%variables(i_var)%turnover) - deallocate(this%variables(i_var)%burned) - end do + if(allocated(this%variables)) then + do i_var = 1, prt_global%num_vars + deallocate(this%variables(i_var)%val) + deallocate(this%variables(i_var)%val0) + deallocate(this%variables(i_var)%net_alloc) + deallocate(this%variables(i_var)%turnover) + deallocate(this%variables(i_var)%burned) + end do - deallocate(this%variables) + deallocate(this%variables) + end if if(allocated(this%bc_in))then deallocate(this%bc_in) From ce81248dc4ae8cc65b38a2e9a63d261a6352cd13 Mon Sep 17 00:00:00 2001 From: Shijie Shu Date: Thu, 22 Sep 2022 18:17:54 -0700 Subject: [PATCH 06/20] Removed hlm_harvest_bypass_criteria. Applied fix on global restart run. --- biogeochem/EDLoggingMortalityMod.F90 | 3 -- biogeochem/EDPatchDynamicsMod.F90 | 5 ++- biogeochem/EDPhysiologyMod.F90 | 12 +++++-- main/EDInitMod.F90 | 14 ++++++--- main/EDTypesMod.F90 | 4 +++ main/FatesHistoryInterfaceMod.F90 | 12 +++---- main/FatesInterfaceMod.F90 | 14 --------- main/FatesInterfaceTypesMod.F90 | 6 ---- main/FatesRestartInterfaceMod.F90 | 47 ++++++++++++++++------------ 9 files changed, 57 insertions(+), 60 deletions(-) diff --git a/biogeochem/EDLoggingMortalityMod.F90 b/biogeochem/EDLoggingMortalityMod.F90 index d17010a33a..cb5dcc84dd 100644 --- a/biogeochem/EDLoggingMortalityMod.F90 +++ b/biogeochem/EDLoggingMortalityMod.F90 @@ -49,7 +49,6 @@ module EDLoggingMortalityMod use FatesInterfaceTypesMod , only : hlm_day_of_year use FatesInterfaceTypesMod , only : hlm_days_per_year use FatesInterfaceTypesMod , only : hlm_use_lu_harvest - use FatesInterfaceTypesMod , only : hlm_harvest_bypass_criteria use FatesInterfaceTypesMod , only : hlm_num_lu_harvest_cats use FatesInterfaceTypesMod , only : hlm_use_logging use FatesInterfaceTypesMod , only : hlm_use_planthydro @@ -307,8 +306,6 @@ subroutine LoggingMortality_frac( pft_i, dbh, canopy_layer, lmort_direct, & else lmort_direct = 0.0_r8 end if - else if (cur_harvest_tag == 1 .and. hlm_harvest_bypass_criteria == 1) then - lmort_direct = harvest_rate * logging_direct_frac else lmort_direct = 0.0_r8 end if diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index b1036035a0..b190d48168 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -50,7 +50,6 @@ module EDPatchDynamicsMod use FatesInterfaceTypesMod , only : hlm_use_nocomp use FatesInterfaceTypesMod , only : hlm_use_fixed_biogeog use FatesInterfaceTypesMod , only : hlm_num_lu_harvest_cats - use FatesInterfaceTypesMod , only : hlm_harvest_bypass_criteria use FatesGlobals , only : endrun => fates_endrun use FatesConstantsMod , only : r8 => fates_r8 use FatesConstantsMod , only : itrue, ifalse @@ -281,7 +280,7 @@ subroutine disturbance_rates( site_in, bc_in) if (harvest_debt_primary == 0) then if ( currentPatch%anthro_disturbance_label .eq. primaryforest ) then if ( harvest_tag(h_index) == 2 .or. & - (harvest_tag(h_index) == 1 .and. .not. (hlm_harvest_bypass_criteria))) then + (harvest_tag(h_index) == 1 )) then ! h_index points to primary forest harvest if((bc_in%hlm_harvest_catnames(h_index) .eq. "HARVEST_VH1")) then harvest_debt_primary = 1 @@ -295,7 +294,7 @@ subroutine disturbance_rates( site_in, bc_in) if ( currentPatch%anthro_disturbance_label .eq. secondaryforest ) then patch_no_secondary = patch_no_secondary + 1 if ( harvest_tag(h_index) == 2 .or. & - (harvest_tag(h_index) == 1 .and. .not. (hlm_harvest_bypass_criteria))) then + (harvest_tag(h_index) == 1 )) then ! h_index points to secondary forest harvest if((bc_in%hlm_harvest_catnames(h_index) .eq. "HARVEST_SH1") .or. & (bc_in%hlm_harvest_catnames(h_index) .eq. "HARVEST_SH2")) then diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 5d66f56d39..6577b47b35 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -746,7 +746,12 @@ subroutine phenology( currentSite, bc_in ) ! This is the integer model day. The first day of the simulation is 1, and it ! continues monotonically, indefinitely - model_day_int = nint(hlm_model_day) + ! Advance it. (this should be a global, no reason + ! for site level, but we don't have global scalars in the + ! restart file) + + currentSite%phen_model_date = currentSite%phen_model_date + 1 + model_day_int = currentSite%phen_model_date ! Use the following layer index to calculate drought conditions @@ -851,7 +856,7 @@ subroutine phenology( currentSite, bc_in ) end if if (model_day_int < currentSite%cleafondate) then - dayssincecleafon = model_day_int - (currentSite%cleafondate-365) + dayssincecleafon = model_day_int - (currentSite%cleafondate - 365) else dayssincecleafon = model_day_int - currentSite%cleafondate end if @@ -1063,6 +1068,8 @@ subroutine phenology( currentSite, bc_in ) call phenology_leafonoff(currentSite) + return + end subroutine phenology @@ -1591,7 +1598,6 @@ subroutine SeedIn( currentSite, bc_in ) ! !USES: use EDTypesMod, only : area use EDTypesMod, only : homogenize_seed_pfts - !use FatesInterfaceTypesMod, only : hlm_use_fixed_biogeog ! For future reduced complexity? ! ! !ARGUMENTS type(ed_site_type), intent(inout), target :: currentSite diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index ac0b80a182..917a718cf4 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -22,6 +22,7 @@ module EDInitMod use EDPatchDynamicsMod , only : set_patchno use EDPhysiologyMod , only : assign_cohort_sp_properties use ChecksBalancesMod , only : SiteMassStock + use FatesInterfaceTypesMod , only : hlm_day_of_year use EDTypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type use EDTypesMod , only : numWaterMem use EDTypesMod , only : num_vegtemp_mem @@ -201,6 +202,8 @@ subroutine zero_site( site_in ) site_in%water_memory(:) = nan site_in%vegtemp_memory(:) = nan ! record of last 10 days temperature for senescence model. + site_in%phen_model_date = fates_unset_int + ! Disturbance rates tracking site_in%primary_land_patchfusion_error = 0.0_r8 site_in%harvest_carbon_flux = 0.0_r8 @@ -316,11 +319,12 @@ subroutine set_site_properties( nsites, sites,bc_in ) ! is memory-less, but needed ! for first value in history file - sites(s)%cleafondate = cleafon - sites(s)%cleafoffdate = cleafoff - sites(s)%dleafoffdate = dleafoff - sites(s)%dleafondate = dleafon - sites(s)%grow_deg_days = GDD + sites(s)%phen_model_date = 0 + sites(s)%cleafondate = cleafon - hlm_day_of_year + sites(s)%cleafoffdate = cleafoff - hlm_day_of_year + sites(s)%dleafoffdate = dleafoff - hlm_day_of_year + sites(s)%dleafondate = dleafon - hlm_day_of_year + sites(s)%grow_deg_days = GDD sites(s)%water_memory(1:numWaterMem) = watermem sites(s)%vegtemp_memory(1:num_vegtemp_mem) = 0._r8 diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index ba32b647b1..f5a2a12ceb 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -749,6 +749,10 @@ module EDTypesMod integer :: cleafoffdate ! model date (day integer) of leaf off (cold):- integer :: dleafondate ! model date (day integer) of leaf on drought:- integer :: dleafoffdate ! model date (day integer) of leaf off drought:- + integer :: phen_model_date ! current model date (day integer) + ! this date stays continuous when + ! in runs that are restarted, regardless of + ! the conditions of restart real(r8) :: water_memory(numWaterMem) ! last 10 days of soil moisture memory... diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index da508d8f2e..f9e3e1dc4f 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -1764,7 +1764,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) integer :: height_bin_max, height_bin_min ! which height bin a given cohort's canopy is in integer :: i_heightbin ! iterator for height bins integer :: el ! Loop index for elements - integer :: model_day_int ! integer model day from reference + integer :: model_day_int ! Integer model day since simulation start integer :: ageclass_since_anthrodist ! what is the equivalent age class for ! time-since-anthropogenic-disturbance of secondary forest @@ -2062,7 +2062,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_cleafoff_si => this%hvars(ih_cleafoff_si)%r81d, & hio_cleafon_si => this%hvars(ih_cleafon_si)%r81d, & hio_dleafoff_si => this%hvars(ih_dleafoff_si)%r81d, & - hio_dleafon_si => this%hvars(ih_dleafoff_si)%r81d, & + hio_dleafon_si => this%hvars(ih_dleafon_si)%r81d, & hio_tveg24 => this%hvars(ih_tveg24_si)%r81d, & hio_meanliqvol_si => this%hvars(ih_meanliqvol_si)%r81d, & hio_cbal_err_fates_si => this%hvars(ih_cbal_err_fates_si)%r81d, & @@ -2118,10 +2118,10 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_gdd_si(io_si) = sites(s)%grow_deg_days ! Model days elapsed since leaf on/off for cold- and drought-deciduous - hio_cleafoff_si(io_si) = real(model_day_int - sites(s)%cleafoffdate,r8) - hio_cleafon_si(io_si) = real(model_day_int - sites(s)%cleafondate,r8) - hio_dleafoff_si(io_si) = real(model_day_int - sites(s)%dleafoffdate,r8) - hio_dleafon_si(io_si) = real(model_day_int - sites(s)%dleafondate,r8) + hio_cleafoff_si(io_si) = real(sites(s)%phen_model_date - sites(s)%cleafoffdate,r8) + hio_cleafon_si(io_si) = real(sites(s)%phen_model_date - sites(s)%cleafondate,r8) + hio_dleafoff_si(io_si) = real(sites(s)%phen_model_date - sites(s)%dleafoffdate,r8) + hio_dleafon_si(io_si) = real(sites(s)%phen_model_date - sites(s)%dleafondate,r8) ! Mean liquid water content (m3/m3) used for drought phenology if(model_day_int>numWaterMem)then diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 14ac272ae6..cc3e305fac 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -1294,7 +1294,6 @@ subroutine set_fates_ctrlparms(tag,ival,rval,cval) hlm_sf_anthro_ignitions_def = unset_int hlm_use_planthydro = unset_int hlm_use_lu_harvest = unset_int - hlm_harvest_bypass_criteria = unset_int hlm_num_lu_harvest_cats = unset_int hlm_use_cohort_age_tracking = unset_int hlm_use_logging = unset_int @@ -1357,13 +1356,6 @@ subroutine set_fates_ctrlparms(tag,ival,rval,cval) call endrun(msg=errMsg(sourcefile, __LINE__)) end if - if ( (hlm_harvest_bypass_criteria .lt. 0).or.(hlm_harvest_bypass_criteria .gt. 1) ) then - if (fates_global_verbose()) then - write(fates_log(), *) 'The FATES bypass harvest scenario flag must be 0 or 1, exiting' - end if - call endrun(msg=errMsg(sourcefile, __LINE__)) - end if - if ( (hlm_num_lu_harvest_cats .lt. 0) ) then if (fates_global_verbose()) then write(fates_log(), *) 'The FATES number of hlm harvest cats must be >= 0, exiting' @@ -1777,12 +1769,6 @@ subroutine set_fates_ctrlparms(tag,ival,rval,cval) write(fates_log(),*) 'Transfering hlm_use_lu_harvest= ',ival,' to FATES' end if - case('use_harvest_bypass_criteria') - hlm_harvest_bypass_criteria = ival - if (fates_global_verbose()) then - write(fates_log(),*) 'Transfering hlm_harvest_bypass_criteria= ',ival,' to FATES' - end if - case('num_lu_harvest_cats') hlm_num_lu_harvest_cats = ival if (fates_global_verbose()) then diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index e29aca8e39..35bf37aa7e 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -120,12 +120,6 @@ module FatesInterfaceTypesMod ! If 1, it automatically sets ! hlm_use_logging to 1 - integer, public :: hlm_harvest_bypass_criteria ! This flag signals whether or not to bypass the logging criteria - ! when using carbon-based harvest and all available forest C under - ! criteria are not enough - ! 0 = do not bypass criteria - ! 1 = allow to bypass the criteria - integer, public :: hlm_num_lu_harvest_cats ! number of hlm harvest categories (e.g. primary forest harvest, secondary young forest harvest, etc.) ! this is the first dimension of: ! harvest_rates in dynHarvestMod diff --git a/main/FatesRestartInterfaceMod.F90 b/main/FatesRestartInterfaceMod.F90 index 0605767cd6..a423282144 100644 --- a/main/FatesRestartInterfaceMod.F90 +++ b/main/FatesRestartInterfaceMod.F90 @@ -83,10 +83,11 @@ module FatesRestartInterfaceMod integer :: ir_dd_status_si integer :: ir_nchill_days_si integer :: ir_ncold_days_si - integer :: ir_leafondate_si - integer :: ir_leafoffdate_si + integer :: ir_cleafondate_si + integer :: ir_cleafoffdate_si integer :: ir_dleafondate_si integer :: ir_dleafoffdate_si + integer :: ir_phenmodeldate_si integer :: ir_acc_ni_si integer :: ir_gdd_si integer :: ir_snow_depth_si @@ -618,22 +619,26 @@ subroutine define_restart_vars(this, initialize_variables) long_name='cold day counter', units='unitless', flushval = flushinvalid, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_ncold_days_si ) - call this%set_restart_var(vname='fates_leafondate', vtype=site_int, & - long_name='the day of year for leaf on', units='day of year', flushval = flushinvalid, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_leafondate_si ) + call this%set_restart_var(vname='fates_cold_leafondate', vtype=site_int, & + long_name='the model day of last cold leaf on', units='absolute integer day', flushval = flushinvalid, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_cleafondate_si ) - call this%set_restart_var(vname='fates_leafoffdate', vtype=site_int, & - long_name='the day of year for leaf off', units='day of year', flushval = flushinvalid, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_leafoffdate_si ) + call this%set_restart_var(vname='fates_cold_leafoffdate', vtype=site_int, & + long_name='the model day last cold leaf off', units='absolute integer day', flushval = flushinvalid, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_cleafoffdate_si ) call this%set_restart_var(vname='fates_drought_leafondate', vtype=site_int, & - long_name='the day of year for drought based leaf-on', units='day of year', flushval = flushinvalid, & + long_name='the model day of last drought based leaf-on', units='absolute integer day', flushval = flushinvalid, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_dleafondate_si ) call this%set_restart_var(vname='fates_drought_leafoffdate', vtype=site_int, & - long_name='the day of year for drought based leaf-off', units='day of year', flushval = flushinvalid, & + long_name='the model day of last drought based leaf-off', units='absolute integer day', flushval = flushinvalid, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_dleafoffdate_si ) + call this%set_restart_var(vname='fates_phen_model_date', vtype=site_int, & + long_name='integer model day used for phen timing', units='absolute integer day', flushval = flushinvalid, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_phenmodeldate_si ) + call this%set_restart_var(vname='fates_acc_nesterov_id', vtype=site_r8, & long_name='a nesterov index accumulator', units='unitless', flushval = flushzero, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_acc_ni_si ) @@ -1748,10 +1753,11 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_dd_status_si => this%rvars(ir_dd_status_si)%int1d, & rio_nchill_days_si => this%rvars(ir_nchill_days_si)%int1d, & rio_ncold_days_si => this%rvars(ir_ncold_days_si)%int1d, & - rio_leafondate_si => this%rvars(ir_leafondate_si)%int1d, & - rio_leafoffdate_si => this%rvars(ir_leafoffdate_si)%int1d, & + rio_cleafondate_si => this%rvars(ir_cleafondate_si)%int1d, & + rio_cleafoffdate_si => this%rvars(ir_cleafoffdate_si)%int1d, & rio_dleafondate_si => this%rvars(ir_dleafondate_si)%int1d, & rio_dleafoffdate_si => this%rvars(ir_dleafoffdate_si)%int1d, & + rio_phenmodeldate_si => this%rvars(ir_phenmodeldate_si)%int1d, & rio_acc_ni_si => this%rvars(ir_acc_ni_si)%r81d, & rio_gdd_si => this%rvars(ir_gdd_si)%r81d, & rio_snow_depth_si => this%rvars(ir_snow_depth_si)%r81d, & @@ -2232,9 +2238,9 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_dd_status_si(io_idx_si) = sites(s)%dstatus rio_nchill_days_si(io_idx_si) = sites(s)%nchilldays rio_ncold_days_si(io_idx_si) = sites(s)%ncolddays - rio_leafondate_si(io_idx_si) = sites(s)%cleafondate - rio_leafoffdate_si(io_idx_si) = sites(s)%cleafoffdate - + rio_cleafondate_si(io_idx_si) = sites(s)%cleafondate + rio_cleafoffdate_si(io_idx_si) = sites(s)%cleafoffdate + rio_phenmodeldate_si(io_idx_si)= sites(s)%phen_model_date rio_dleafondate_si(io_idx_si) = sites(s)%dleafondate rio_dleafoffdate_si(io_idx_si) = sites(s)%dleafoffdate rio_acc_ni_si(io_idx_si) = sites(s)%acc_NI @@ -2579,10 +2585,11 @@ subroutine get_restart_vectors(this, nc, nsites, sites) rio_dd_status_si => this%rvars(ir_dd_status_si)%int1d, & rio_nchill_days_si => this%rvars(ir_nchill_days_si)%int1d, & rio_ncold_days_si => this%rvars(ir_ncold_days_si)%int1d, & - rio_leafondate_si => this%rvars(ir_leafondate_si)%int1d, & - rio_leafoffdate_si => this%rvars(ir_leafoffdate_si)%int1d, & + rio_cleafondate_si => this%rvars(ir_cleafondate_si)%int1d, & + rio_cleafoffdate_si => this%rvars(ir_cleafoffdate_si)%int1d, & rio_dleafondate_si => this%rvars(ir_dleafondate_si)%int1d, & rio_dleafoffdate_si => this%rvars(ir_dleafoffdate_si)%int1d, & + rio_phenmodeldate_si => this%rvars(ir_phenmodeldate_si)%int1d, & rio_acc_ni_si => this%rvars(ir_acc_ni_si)%r81d, & rio_gdd_si => this%rvars(ir_gdd_si)%r81d, & rio_snow_depth_si => this%rvars(ir_snow_depth_si)%r81d, & @@ -3093,14 +3100,14 @@ subroutine get_restart_vectors(this, nc, nsites, sites) sites(s)%dstatus = rio_dd_status_si(io_idx_si) sites(s)%nchilldays = rio_nchill_days_si(io_idx_si) sites(s)%ncolddays = rio_ncold_days_si(io_idx_si) - sites(s)%cleafondate = rio_leafondate_si(io_idx_si) - sites(s)%cleafoffdate = rio_leafoffdate_si(io_idx_si) + sites(s)%cleafondate = rio_cleafondate_si(io_idx_si) + sites(s)%cleafoffdate = rio_cleafoffdate_si(io_idx_si) sites(s)%dleafondate = rio_dleafondate_si(io_idx_si) sites(s)%dleafoffdate = rio_dleafoffdate_si(io_idx_si) sites(s)%acc_NI = rio_acc_ni_si(io_idx_si) sites(s)%grow_deg_days = rio_gdd_si(io_idx_si) + sites(s)%phen_model_date= rio_phenmodeldate_si(io_idx_si) sites(s)%snow_depth = rio_snow_depth_si(io_idx_si) - sites(s)%resources_management%trunk_product_site = rio_trunk_product_si(io_idx_si) end do From 1fb522068614c2840e2f5c2178328e29ac8f70ab Mon Sep 17 00:00:00 2001 From: Shijie Shu Date: Wed, 26 Oct 2022 15:06:19 -0700 Subject: [PATCH 07/20] Remove "available_forest_c" and simplify the logic. --- biogeochem/EDLoggingMortalityMod.F90 | 33 +++++++------------------- biogeochem/EDMortalityFunctionsMod.F90 | 4 +--- biogeochem/EDPatchDynamicsMod.F90 | 12 ++++------ main/EDMainMod.F90 | 5 ++-- 4 files changed, 15 insertions(+), 39 deletions(-) diff --git a/biogeochem/EDLoggingMortalityMod.F90 b/biogeochem/EDLoggingMortalityMod.F90 index 2f02a7d3bf..79adc81838 100644 --- a/biogeochem/EDLoggingMortalityMod.F90 +++ b/biogeochem/EDLoggingMortalityMod.F90 @@ -203,7 +203,7 @@ subroutine LoggingMortality_frac( pft_i, dbh, canopy_layer, lmort_direct, & hlm_harvest_units, & patch_anthro_disturbance_label, secondary_age, & frac_site_primary, harvestable_forest_c, & - available_forest_c, harvest_tag) + harvest_tag) ! Arguments integer, intent(in) :: pft_i ! pft index @@ -216,8 +216,6 @@ subroutine LoggingMortality_frac( pft_i, dbh, canopy_layer, lmort_direct, & real(r8), intent(in) :: secondary_age ! patch level age_since_anthro_disturbance real(r8), intent(in) :: harvestable_forest_c(:) ! total harvestable forest carbon ! of all hlm harvest categories - real(r8), intent(in) :: available_forest_c(:) ! total forest carbon available for - ! harvest of all hlm harvest categories real(r8), intent(in) :: frac_site_primary real(r8), intent(out) :: lmort_direct ! direct (harvestable) mortality fraction real(r8), intent(out) :: lmort_collateral ! collateral damage mortality fraction @@ -282,12 +280,12 @@ subroutine LoggingMortality_frac( pft_i, dbh, canopy_layer, lmort_direct, & ! shall call another subroutine, which transfers biomass/carbon into fraction call get_harvest_rate_carbon (patch_anthro_disturbance_label, hlm_harvest_catnames, & - hlm_harvest_rates, secondary_age, harvestable_forest_c, available_forest_c, & + hlm_harvest_rates, secondary_age, harvestable_forest_c, & harvest_rate, harvest_tag, cur_harvest_tag) if (fates_global_verbose()) then write(fates_log(), *) 'Successfully Read Harvest Rate from HLM.', hlm_harvest_rates(:), harvest_rate & - harvestable_forest_c, available_forest_c + harvestable_forest_c end if write(fates_log(),*) 'HLM harvest carbon data not implemented yet. Exiting.' @@ -435,7 +433,7 @@ end subroutine get_harvest_rate_area ! ============================================================================ - subroutine get_harvestable_carbon (csite, site_area, hlm_harvest_catnames, harvestable_forest_c, available_forest_c) + subroutine get_harvestable_carbon (csite, site_area, hlm_harvest_catnames, harvestable_forest_c ) !USES: use SFParamsMod, only : SF_val_cwd_frac @@ -461,7 +459,6 @@ subroutine get_harvestable_carbon (csite, site_area, hlm_harvest_catnames, harve character(len=64), intent(in) :: hlm_harvest_catnames(:) ! names of hlm harvest categories real(r8), intent(out) :: harvestable_forest_c(hlm_num_lu_harvest_cats) - real(r8), intent(out) :: available_forest_c(hlm_num_lu_harvest_cats) ! Local Variables type(ed_patch_type), pointer :: currentPatch @@ -477,7 +474,6 @@ subroutine get_harvestable_carbon (csite, site_area, hlm_harvest_catnames, harve ! Initialization harvestable_forest_c = 0._r8 - available_forest_c = 0._r8 ! loop over patches currentPatch => csite%oldest_patch @@ -526,21 +522,18 @@ subroutine get_harvestable_carbon (csite, site_area, hlm_harvest_catnames, harve ! Primary if(hlm_harvest_catnames(h_index) .eq. "HARVEST_VH1") then harvestable_forest_c(h_index) = harvestable_forest_c(h_index) + harvestable_patch_c - available_forest_c(h_index) = available_forest_c(h_index) + available_patch_c end if else if (currentPatch%anthro_disturbance_label .eq. secondaryforest .and. & currentPatch%age_since_anthro_disturbance >= secondary_age_threshold) then ! Secondary mature if(hlm_harvest_catnames(h_index) .eq. "HARVEST_SH1") then harvestable_forest_c(h_index) = harvestable_forest_c(h_index) + harvestable_patch_c - available_forest_c(h_index) = available_forest_c(h_index) + available_patch_c end if else if (currentPatch%anthro_disturbance_label .eq. secondaryforest .and. & currentPatch%age_since_anthro_disturbance < secondary_age_threshold) then ! Secondary young if(hlm_harvest_catnames(h_index) .eq. "HARVEST_SH2") then harvestable_forest_c(h_index) = harvestable_forest_c(h_index) + harvestable_patch_c - available_forest_c(h_index) = available_forest_c(h_index) + available_patch_c end if end if end do @@ -552,7 +545,7 @@ end subroutine get_harvestable_carbon ! ============================================================================ subroutine get_harvest_rate_carbon (patch_anthro_disturbance_label, hlm_harvest_catnames, & - hlm_harvest_rates, secondary_age, harvestable_forest_c, available_forest_c, & + hlm_harvest_rates, secondary_age, harvestable_forest_c, & harvest_rate, harvest_tag, cur_harvest_tag) ! ------------------------------------------------------------------------------------------- @@ -567,7 +560,6 @@ subroutine get_harvest_rate_carbon (patch_anthro_disturbance_label, hlm_harvest_ integer, intent(in) :: patch_anthro_disturbance_label ! patch level anthro_disturbance_label real(r8), intent(in) :: secondary_age ! patch level age_since_anthro_disturbance real(r8), intent(in) :: harvestable_forest_c(:) ! site level forest c matching criteria available for harvest - real(r8), intent(in) :: available_forest_c(:) ! site level total forest c available for harvest real(r8), intent(out) :: harvest_rate integer, intent(inout) :: harvest_tag(:) ! 0. normal harvest; 1. current site does not have enough C but ! can perform harvest by ignoring criteria; 2. current site does @@ -600,11 +592,8 @@ subroutine get_harvest_rate_carbon (patch_anthro_disturbance_label, hlm_harvest_ if(harvestable_forest_c(h_index) >= harvest_rate_c) then harvest_rate_supply = harvest_rate_supply + harvestable_forest_c(h_index) harvest_tag(h_index) = 0 - else if (available_forest_c(h_index) >= harvest_rate_c) then - harvest_rate_supply = harvest_rate_supply + available_forest_c(h_index) - harvest_tag(h_index) = 1 else - harvest_tag(h_index) = 2 + harvest_tag(h_index) = 1 end if endif else if (patch_anthro_disturbance_label .eq. secondaryforest .and. & @@ -614,11 +603,8 @@ subroutine get_harvest_rate_carbon (patch_anthro_disturbance_label, hlm_harvest_ if(harvestable_forest_c(h_index) >= harvest_rate_c) then harvest_rate_supply = harvest_rate_supply + harvestable_forest_c(h_index) harvest_tag(h_index) = 0 - else if (available_forest_c(h_index) >= harvest_rate_c) then - harvest_rate_supply = harvest_rate_supply + available_forest_c(h_index) - harvest_tag(h_index) = 1 else - harvest_tag(h_index) = 2 + harvest_tag(h_index) = 1 end if endif else if (patch_anthro_disturbance_label .eq. secondaryforest .and. & @@ -629,11 +615,8 @@ subroutine get_harvest_rate_carbon (patch_anthro_disturbance_label, hlm_harvest_ if(harvestable_forest_c(h_index) >= harvest_rate_c) then harvest_rate_supply = harvest_rate_supply + harvestable_forest_c(h_index) harvest_tag(h_index) = 0 - else if (available_forest_c(h_index) >= harvest_rate_c) then - harvest_rate_supply = harvest_rate_supply + available_forest_c(h_index) - harvest_tag(h_index) = 1 else - harvest_tag(h_index) = 2 + harvest_tag(h_index) = 1 end if endif endif diff --git a/biogeochem/EDMortalityFunctionsMod.F90 b/biogeochem/EDMortalityFunctionsMod.F90 index 45b86adb68..5ab67a04bf 100644 --- a/biogeochem/EDMortalityFunctionsMod.F90 +++ b/biogeochem/EDMortalityFunctionsMod.F90 @@ -216,7 +216,7 @@ end subroutine mortality_rates ! ============================================================================ subroutine Mortality_Derivative( currentSite, currentCohort, bc_in, frac_site_primary, & - harvestable_forest_c, available_forest_c, harvest_tag) + harvestable_forest_c, harvest_tag) ! ! !DESCRIPTION: @@ -233,7 +233,6 @@ subroutine Mortality_Derivative( currentSite, currentCohort, bc_in, frac_site_pr type(bc_in_type), intent(in) :: bc_in real(r8), intent(in) :: frac_site_primary real(r8), intent(in) :: harvestable_forest_c(:) - real(r8), intent(in) :: available_forest_c(:) integer, intent(inout) :: harvest_tag(:) ! @@ -266,7 +265,6 @@ subroutine Mortality_Derivative( currentSite, currentCohort, bc_in, frac_site_pr currentCohort%patchptr%age_since_anthro_disturbance, & frac_site_primary, & harvestable_forest_c, & - available_forest_c, & harvest_tag) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 6fd42101af..6e88e6cf08 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -196,7 +196,6 @@ subroutine disturbance_rates( site_in, bc_in) real(r8) :: harvest_rate real(r8) :: tempsum real(r8) :: harvestable_forest_c(hlm_num_lu_harvest_cats) - real(r8) :: available_forest_c(hlm_num_lu_harvest_cats) integer :: harvest_tag(hlm_num_lu_harvest_cats) integer :: harvest_debt_primary integer :: harvest_debt_secondary @@ -211,7 +210,7 @@ subroutine disturbance_rates( site_in, bc_in) call get_frac_site_primary(site_in, frac_site_primary) ! get available biomass for harvest for all patches - call get_harvestable_carbon(site_in, bc_in%site_area, bc_in%hlm_harvest_catnames, harvestable_forest_c, available_forest_c) + call get_harvestable_carbon(site_in, bc_in%site_area, bc_in%hlm_harvest_catnames, harvestable_forest_c) site_in%harvest_carbon_flux = 0._r8 harvest_debt_primary = 0 @@ -248,7 +247,6 @@ subroutine disturbance_rates( site_in, bc_in) currentPatch%age_since_anthro_disturbance, & frac_site_primary, & harvestable_forest_c, & - available_forest_c, & harvest_tag) currentCohort%lmort_direct = lmort_direct @@ -282,8 +280,7 @@ subroutine disturbance_rates( site_in, bc_in) ! Primary patch: Once a patch has debt, skip the calculation if (harvest_debt_primary == 0) then if ( currentPatch%anthro_disturbance_label .eq. primaryforest ) then - if ( harvest_tag(h_index) == 2 .or. & - (harvest_tag(h_index) == 1 )) then + if ( harvest_tag(h_index) == 1 ) then ! h_index points to primary forest harvest if((bc_in%hlm_harvest_catnames(h_index) .eq. "HARVEST_VH1")) then harvest_debt_primary = 1 @@ -296,8 +293,7 @@ subroutine disturbance_rates( site_in, bc_in) if (harvest_debt_secondary == 0) then if ( currentPatch%anthro_disturbance_label .eq. secondaryforest ) then patch_no_secondary = patch_no_secondary + 1 - if ( harvest_tag(h_index) == 2 .or. & - (harvest_tag(h_index) == 1 )) then + if ( harvest_tag(h_index) == 1 ) then ! h_index points to secondary forest harvest if((bc_in%hlm_harvest_catnames(h_index) .eq. "HARVEST_SH1") .or. & (bc_in%hlm_harvest_catnames(h_index) .eq. "HARVEST_SH2")) then @@ -410,7 +406,7 @@ subroutine disturbance_rates( site_in, bc_in) if(bc_in%hlm_harvest_units == hlm_harvest_carbon) then call get_harvest_rate_carbon (currentPatch%anthro_disturbance_label, bc_in%hlm_harvest_catnames, & bc_in%hlm_harvest_rates, currentPatch%age_since_anthro_disturbance, harvestable_forest_c, & - available_forest_c, harvest_rate, harvest_tag) + harvest_rate, harvest_tag) else call get_harvest_rate_area (currentPatch%anthro_disturbance_label, bc_in%hlm_harvest_catnames, & bc_in%hlm_harvest_rates, frac_site_primary, currentPatch%age_since_anthro_disturbance, harvest_rate) diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index 790e5dc12e..fa62058bcf 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -336,7 +336,6 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) real(r8) :: frac_site_primary real(r8) :: harvestable_forest_c(hlm_num_lu_harvest_cats) - real(r8) :: available_forest_c(hlm_num_lu_harvest_cats) integer :: harvest_tag(hlm_num_lu_harvest_cats) @@ -347,7 +346,7 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) bc_out%ar_site = 0._r8 ! Patch level biomass are required for C-based harvest - call get_harvestable_carbon(currentSite, bc_in%site_area, bc_in%hlm_harvest_catnames, harvestable_forest_c, available_forest_c) + call get_harvestable_carbon(currentSite, bc_in%site_area, bc_in%hlm_harvest_catnames, harvestable_forest_c) ! Set a pointer to this sites carbon12 mass balance site_cmass => currentSite%mass_balance(element_pos(carbon12_element)) @@ -383,7 +382,7 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) ! Calculate the mortality derivatives call Mortality_Derivative( currentSite, currentCohort, bc_in, frac_site_primary, & - harvestable_forest_c, available_forest_c, harvest_tag) + harvestable_forest_c, harvest_tag ) ! ----------------------------------------------------------------------------- ! Apply Plant Allocation and Reactive Transport From ad337ea66b92e7420d7d05e83d1c8298f2f04eb7 Mon Sep 17 00:00:00 2001 From: Shijie Shu Date: Fri, 28 Oct 2022 14:28:02 -0700 Subject: [PATCH 08/20] Minor revisions on comments, temporary commit --- biogeochem/EDCanopyStructureMod.F90 | 3 +- biogeochem/EDLoggingMortalityMod.F90 | 58 ++++++----------- biogeochem/EDMortalityFunctionsMod.F90 | 2 +- biogeochem/EDPatchDynamicsMod.F90 | 25 +++----- main/FatesHistoryInterfaceMod.F90 | 86 +++----------------------- 5 files changed, 37 insertions(+), 137 deletions(-) diff --git a/biogeochem/EDCanopyStructureMod.F90 b/biogeochem/EDCanopyStructureMod.F90 index 8d12f0827d..65af6fa31f 100644 --- a/biogeochem/EDCanopyStructureMod.F90 +++ b/biogeochem/EDCanopyStructureMod.F90 @@ -1785,7 +1785,6 @@ subroutine update_hlm_dynamics(nsites,sites,fcolumn,bc_out) integer, intent(in) :: nsites type(ed_site_type), intent(inout), target :: sites(nsites) integer, intent(in) :: fcolumn(nsites) - type(bc_in_type), intent(inout) :: bc_in(nsites) type(bc_out_type), intent(inout) :: bc_out(nsites) ! Locals @@ -1978,7 +1977,7 @@ subroutine update_hlm_dynamics(nsites,sites,fcolumn,bc_out) end if ! Pass FATES Harvested C to bc_out. - call UpdateHarvestC(sites(s),bc_in(s),bc_out(s)) + call UpdateHarvestC(sites(s),bc_out(s)) end do diff --git a/biogeochem/EDLoggingMortalityMod.F90 b/biogeochem/EDLoggingMortalityMod.F90 index 79adc81838..4b3383b333 100644 --- a/biogeochem/EDLoggingMortalityMod.F90 +++ b/biogeochem/EDLoggingMortalityMod.F90 @@ -87,11 +87,6 @@ module EDLoggingMortalityMod real(r8), parameter :: harvest_litter_localization = 0.0_r8 - ! ! transfer factor from kg biomass (dry matter) to kg carbon - ! ! now we applied a simple fraction of 50% based on the IPCC - ! ! guideline - ! real(r8), parameter :: carbon_per_kg_biomass = 0.5_r8 - character(len=*), parameter, private :: sourcefile = & __FILE__ @@ -284,13 +279,9 @@ subroutine LoggingMortality_frac( pft_i, dbh, canopy_layer, lmort_direct, & harvest_rate, harvest_tag, cur_harvest_tag) if (fates_global_verbose()) then - write(fates_log(), *) 'Successfully Read Harvest Rate from HLM.', hlm_harvest_rates(:), harvest_rate & - harvestable_forest_c + write(fates_log(), *) 'Successfully Read Harvest Rate from HLM.', hlm_harvest_rates(:), harvest_rate, harvestable_forest_c end if - write(fates_log(),*) 'HLM harvest carbon data not implemented yet. Exiting.' - call endrun(msg=errMsg(sourcefile, __LINE__)) - endif ! transfer of area to secondary land is based on overall area affected, not just logged crown area @@ -304,7 +295,9 @@ subroutine LoggingMortality_frac( pft_i, dbh, canopy_layer, lmort_direct, & ! since there is an .and. .not. after the first conditional, the dbh:dbhmax comparison needs to be ! the opposite of what would otherwise be expected... lmort_direct = harvest_rate * logging_direct_frac - + else + lmort_direct = 0.0_r8 + end if else lmort_direct = 0.0_r8 end if @@ -375,8 +368,8 @@ subroutine get_harvest_rate_area (patch_anthro_disturbance_label, hlm_harvest_ca harvest_rate = 0._r8 do h_index = 1,hlm_num_lu_harvest_cats if (patch_anthro_disturbance_label .eq. primaryforest) then - if(hlm_harvest_catnames(h_index) .eq. "HARVEST_VH1") then! .or. & - ! hlm_harvest_catnames(h_index) .eq. "HARVEST_VH2") then + if(hlm_harvest_catnames(h_index) .eq. "HARVEST_VH1" .or. & + hlm_harvest_catnames(h_index) .eq. "HARVEST_VH2") then harvest_rate = harvest_rate + hlm_harvest_rates(h_index) endif else if (patch_anthro_disturbance_label .eq. secondaryforest .and. & @@ -386,8 +379,8 @@ subroutine get_harvest_rate_area (patch_anthro_disturbance_label, hlm_harvest_ca endif else if (patch_anthro_disturbance_label .eq. secondaryforest .and. & secondary_age < secondary_age_threshold) then - if(hlm_harvest_catnames(h_index) .eq. "HARVEST_SH2") then! .or. & - ! hlm_harvest_catnames(h_index) .eq. "HARVEST_SH3") then + if(hlm_harvest_catnames(h_index) .eq. "HARVEST_SH2" .or. & + hlm_harvest_catnames(h_index) .eq. "HARVEST_SH3") then harvest_rate = harvest_rate + hlm_harvest_rates(h_index) endif endif @@ -447,7 +440,6 @@ subroutine get_harvestable_carbon (csite, site_area, hlm_harvest_catnames, harve ! primary forest, secondary mature forest and secondary young forest ! under two different scenarios: ! harvestable carbon: aggregate all cohorts matching the dbhmin harvest criteria - ! available carbon: aggregate all cohorts ! ! this subroutine shall be called outside the patch loop ! output will be used to estimate the area-based harvest rate (get_harvest_rate_carbon) @@ -463,10 +455,8 @@ subroutine get_harvestable_carbon (csite, site_area, hlm_harvest_catnames, harve ! Local Variables type(ed_patch_type), pointer :: currentPatch type(ed_cohort_type), pointer :: currentCohort - real(r8) :: harvestable_patch_c ! temporary variable - real(r8) :: harvestable_cohort_c ! temporary variable - real(r8) :: available_patch_c ! temporary variable - real(r8) :: available_cohort_c ! temporary variable + real(r8) :: harvestable_patch_c ! temporary variable, kgC site-1 + real(r8) :: harvestable_cohort_c ! temporary variable, kgC site-1 real(r8) :: sapw_m ! Biomass of sap wood real(r8) :: struct_m ! Biomass of structural organs integer :: pft ! Index of plant functional type @@ -479,7 +469,6 @@ subroutine get_harvestable_carbon (csite, site_area, hlm_harvest_catnames, harve currentPatch => csite%oldest_patch do while (associated(currentPatch)) harvestable_patch_c = 0._r8 - available_patch_c = 0._r8 currentCohort => currentPatch%tallest do while (associated(currentCohort)) @@ -504,10 +493,6 @@ subroutine get_harvestable_carbon (csite, site_area, hlm_harvest_catnames, harve ((logging_dbhmax < fates_check_param_set) .and. (currentCohort%dbh >= logging_dbhmax )) ) then ! Harvestable C: aggregate cohorts fit the criteria harvestable_patch_c = harvestable_patch_c + harvestable_cohort_c - ! Available C: aggregate all cohorts - available_patch_c = available_patch_c + harvestable_cohort_c - else - available_patch_c = available_patch_c + harvestable_cohort_c end if end if end if @@ -559,8 +544,8 @@ subroutine get_harvest_rate_carbon (patch_anthro_disturbance_label, hlm_harvest_ character(len=64), intent(in) :: hlm_harvest_catnames(:) ! names of hlm harvest categories integer, intent(in) :: patch_anthro_disturbance_label ! patch level anthro_disturbance_label real(r8), intent(in) :: secondary_age ! patch level age_since_anthro_disturbance - real(r8), intent(in) :: harvestable_forest_c(:) ! site level forest c matching criteria available for harvest - real(r8), intent(out) :: harvest_rate + real(r8), intent(in) :: harvestable_forest_c(:) ! site level forest c matching criteria available for harvest, kgC site-1 + real(r8), intent(out) :: harvest_rate ! area fraction integer, intent(inout) :: harvest_tag(:) ! 0. normal harvest; 1. current site does not have enough C but ! can perform harvest by ignoring criteria; 2. current site does ! not have enough carbon @@ -573,20 +558,20 @@ subroutine get_harvest_rate_carbon (patch_anthro_disturbance_label, hlm_harvest_ ! Local Variables integer :: h_index ! for looping over harvest categories integer :: icode ! Integer equivalent of the event code (parameter file only allows reals) - real(r8) :: harvest_rate_c ! Temporary variable - real(r8) :: harvest_rate_supply ! Temporary variable + real(r8) :: harvest_rate_c ! Temporary variable, kgC site-1 + real(r8) :: harvest_rate_supply ! Temporary variable, kgC site-1 ! Loop around harvest categories to determine the hlm harvest rate demand and actual harvest rate for the ! current cohort based on patch history info harvest_rate = 0._r8 harvest_rate_c = 0._r8 harvest_rate_supply = 0._r8 - harvest_tag = 2 + harvest_tag(:) = 1 do h_index = 1,hlm_num_lu_harvest_cats if (patch_anthro_disturbance_label .eq. primaryforest) then - if(hlm_harvest_catnames(h_index) .eq. "HARVEST_VH1") then! .or. & - ! hlm_harvest_catnames(h_index) .eq. "HARVEST_VH2") then + if(hlm_harvest_catnames(h_index) .eq. "HARVEST_VH1" .or. & + hlm_harvest_catnames(h_index) .eq. "HARVEST_VH2") then harvest_rate_c = harvest_rate_c + hlm_harvest_rates(h_index) ! Determine the total supply of available C for harvest if(harvestable_forest_c(h_index) >= harvest_rate_c) then @@ -609,8 +594,8 @@ subroutine get_harvest_rate_carbon (patch_anthro_disturbance_label, hlm_harvest_ endif else if (patch_anthro_disturbance_label .eq. secondaryforest .and. & secondary_age < secondary_age_threshold) then - if(hlm_harvest_catnames(h_index) .eq. "HARVEST_SH2") then! .or. & - ! hlm_harvest_catnames(h_index) .eq. "HARVEST_SH3") then + if(hlm_harvest_catnames(h_index) .eq. "HARVEST_SH2" .or. & + hlm_harvest_catnames(h_index) .eq. "HARVEST_SH3") then harvest_rate_c = harvest_rate_c + hlm_harvest_rates(h_index) if(harvestable_forest_c(h_index) >= harvest_rate_c) then harvest_rate_supply = harvest_rate_supply + harvestable_forest_c(h_index) @@ -625,11 +610,6 @@ subroutine get_harvest_rate_carbon (patch_anthro_disturbance_label, hlm_harvest_ ! If any harvest category available, assign to cur_harvest_tag and trigger logging event if(present(cur_harvest_tag))then cur_harvest_tag = minval(harvest_tag) - !write(fates_log(), *) 'cur_harvest_tag:', cur_harvest_tag - !write(fates_log(), *) 'harvest tags:', harvest_tag - !write(fates_log(), *) 'harvest rate c:', harvest_rate_c - !write(fates_log(), *) 'harvest rate supply:', harvest_rate_supply - !write(fates_log(), *) 'hlm harvest rates:', hlm_harvest_rates end if ! Transfer carbon-based harvest rate to area-based harvest rate diff --git a/biogeochem/EDMortalityFunctionsMod.F90 b/biogeochem/EDMortalityFunctionsMod.F90 index 5ab67a04bf..0259772e20 100644 --- a/biogeochem/EDMortalityFunctionsMod.F90 +++ b/biogeochem/EDMortalityFunctionsMod.F90 @@ -232,7 +232,7 @@ subroutine Mortality_Derivative( currentSite, currentCohort, bc_in, frac_site_pr type(ed_cohort_type),intent(inout), target :: currentCohort type(bc_in_type), intent(in) :: bc_in real(r8), intent(in) :: frac_site_primary - real(r8), intent(in) :: harvestable_forest_c(:) + real(r8), intent(in) :: harvestable_forest_c(:) ! total carbon available for logging, kgC site-1 integer, intent(inout) :: harvest_tag(:) ! diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 6e88e6cf08..ed11a4d6be 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -212,7 +212,6 @@ subroutine disturbance_rates( site_in, bc_in) ! get available biomass for harvest for all patches call get_harvestable_carbon(site_in, bc_in%site_area, bc_in%hlm_harvest_catnames, harvestable_forest_c) - site_in%harvest_carbon_flux = 0._r8 harvest_debt_primary = 0 harvest_debt_secondary = 0 patch_no_secondary = 0 @@ -254,21 +253,13 @@ subroutine disturbance_rates( site_in, bc_in) currentCohort%lmort_infra = lmort_infra currentCohort%l_degrad = l_degrad - ! estimate the wood product (trunk_product_site) - if (currentCohort%canopy_layer>=1) then - ! kgC m-2 day-1 - site_in%harvest_carbon_flux = site_in%harvest_carbon_flux + & - currentCohort%lmort_direct * currentCohort%n * & - ( currentCohort%prt%GetState(sapw_organ, all_carbon_elements) + & - currentCohort%prt%GetState(struct_organ, all_carbon_elements)) * & - prt_params%allom_agb_frac(currentCohort%pft) * & - SF_val_CWD_frac(ncwd) * logging_export_frac * AREA_INV - endif - currentCohort => currentCohort%taller end do - ! Determine harvest debt status from all three categories + ! Determine harvest debt for primary land and secondary land + ! Harvest debt is the accumulated total carbon amount once + ! available carbon for harvest is smaller than the harvest + ! rate of forcing data for each site. ! Each cohort has the same harvest tag but not each patch ! Hence this part shall be within the patch loop ! TODO: we can define harvest debt as a fraction of the @@ -314,8 +305,8 @@ subroutine disturbance_rates( site_in, bc_in) do h_index = 1, hlm_num_lu_harvest_cats if ( harvest_debt_primary == 1 ) then ! Only account for primary forest harvest rate - if((bc_in%hlm_harvest_catnames(h_index) .eq. "HARVEST_VH1")) then !.or. & - ! (bc_in%hlm_harvest_catnames(h_index) .eq. "HARVEST_VH2")) then + if((bc_in%hlm_harvest_catnames(h_index) .eq. "HARVEST_VH1") .or. & + (bc_in%hlm_harvest_catnames(h_index) .eq. "HARVEST_VH2")) then site_in%resources_management%harvest_debt = site_in%resources_management%harvest_debt + & bc_in%hlm_harvest_rates(h_index) end if @@ -323,8 +314,8 @@ subroutine disturbance_rates( site_in, bc_in) if (harvest_debt_secondary == 1 .or. patch_no_secondary == 0) then ! Only account for secondary forest harvest rate if((bc_in%hlm_harvest_catnames(h_index) .eq. "HARVEST_SH1") .or. & - (bc_in%hlm_harvest_catnames(h_index) .eq. "HARVEST_SH2")) then !.or. & - ! (bc_in%hlm_harvest_catnames(h_index) .eq. "HARVEST_SH3")) then + (bc_in%hlm_harvest_catnames(h_index) .eq. "HARVEST_SH2") .or. & + (bc_in%hlm_harvest_catnames(h_index) .eq. "HARVEST_SH3")) then site_in%resources_management%harvest_debt = site_in%resources_management%harvest_debt + & bc_in%hlm_harvest_rates(h_index) site_in%resources_management%harvest_debt_sec = site_in%resources_management%harvest_debt_sec + & diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index cbc13104f0..f634a02c15 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -1796,7 +1796,6 @@ subroutine update_history_dyn(this,nc,nsites,sites) real(r8) :: binbottom,bintop ! edges of height bins real(r8) :: gpp_cached ! variable used to cache gpp value in previous time step; for C13 discrimination - real(r8) :: lai_patch_cached ! temporary variable to cache mean lai of current patch ! The following are all carbon states, turnover and net allocation flux variables ! the organs of relevance should be self explanatory @@ -2183,7 +2182,6 @@ subroutine update_history_dyn(this,nc,nsites,sites) this%hvars(ih_h2oveg_recruit_si)%r81d(io_si) = sites(s)%si_hydr%h2oveg_recruit this%hvars(ih_h2oveg_growturn_err_si)%r81d(io_si) = sites(s)%si_hydr%h2oveg_growturn_err end if - hio_harvest_carbonflux_si(io_si) = sites(s)%harvest_carbon_flux hio_harvest_debt_si(io_si) = sites(s)%resources_management%harvest_debt hio_harvest_debt_sec_si(io_si) = sites(s)%resources_management%harvest_debt_sec @@ -2266,15 +2264,8 @@ subroutine update_history_dyn(this,nc,nsites,sites) ! Secondary forest mean LAI if ( cpatch%anthro_disturbance_label .eq. secondaryforest ) then - lai_patch_cached = 0._r8 - do ican = 1, cpatch%NCL_p - do i_pft = 1, numpft - lai_patch_cached = lai_patch_cached + sum(cpatch%canopy_area_profile(ican,i_pft,1:cpatch%nrad(ican,i_pft)) * & - cpatch%tlai_profile(ican,i_pft,1:cpatch%nrad(ican,i_pft))) - end do - end do hio_lai_secondary_si(io_si) = hio_lai_secondary_si(io_si) & - + lai_patch_cached * min(1.0_r8, (cpatch%total_canopy_area/cpatch%area)) * cpatch%area * AREA_INV + + sum(cpatch%tlai_profile(:,:,:)) * cpatch%total_canopy_area end if ! patch-age-resolved fire variables @@ -3100,6 +3091,13 @@ subroutine update_history_dyn(this,nc,nsites,sites) endif end do + ! divide secondary plant leaf area by secondary forest area to get the secondary forest LAI + if (hio_fraction_secondary_forest_si(io_si) .gt. nearzero) then + hio_lai_secondary_si(io_si) = hio_lai_secondary_si(io_si) / (hio_fraction_secondary_forest_si(io_si)*AREA) + else + hio_lai_secondary_si(io_si) = 0._r8 + end if + ! pass the cohort termination mortality as a flux to the history, and then reset the termination mortality buffer ! note there are various ways of reporting the total mortality, so pass to these as well do i_pft = 1, numpft @@ -5412,74 +5410,6 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=site_r8, hlms='CLM:ALM', upfreq=2, & ivar=ivar, initialize=initialize_variables, index = ih_rad_error_si) - ! disturbance rates - call this%set_history_var(vname='PRIMARYLAND_PATCHFUSION_ERROR', units='m2 m-2 d-1', & - long='Error in total primary lands associated with patch fusion', use_default='active', & - avgflag='A', vtype=site_r8, hlms='CLM:ALM', upfreq=1, & - ivar=ivar, initialize=initialize_variables, index = ih_primaryland_fusion_error_si ) - - call this%set_history_var(vname='DISTURBANCE_RATE_P2P', units='m2 m-2 d-1', & - long='Disturbance rate from primary to primary lands', use_default='active', & - avgflag='A', vtype=site_r8, hlms='CLM:ALM', upfreq=1, & - ivar=ivar, initialize=initialize_variables, index = ih_disturbance_rate_p2p_si ) - - call this%set_history_var(vname='DISTURBANCE_RATE_P2S', units='m2 m-2 d-1', & - long='Disturbance rate from primary to secondary lands', use_default='active', & - avgflag='A', vtype=site_r8, hlms='CLM:ALM', upfreq=1, & - ivar=ivar, initialize=initialize_variables, index = ih_disturbance_rate_p2s_si ) - - call this%set_history_var(vname='DISTURBANCE_RATE_S2S', units='m2 m-2 d-1', & - long='Disturbance rate from secondary to secondary lands', use_default='active', & - avgflag='A', vtype=site_r8, hlms='CLM:ALM', upfreq=1, & - ivar=ivar, initialize=initialize_variables, index = ih_disturbance_rate_s2s_si ) - -! call this%set_history_var(vname='DISTURBANCE_RATE_FIRE', units='m2 m-2 d-1', & -! long='Disturbance rate from fire', use_default='active', & -! avgflag='A', vtype=site_r8, hlms='CLM:ALM', upfreq=1, & -! ivar=ivar, initialize=initialize_variables, index = ih_fire_disturbance_rate_si ) -! -! call this%set_history_var(vname='DISTURBANCE_RATE_LOGGING', units='m2 m-2 d-1', & -! long='Disturbance rate from logging', use_default='active', & -! avgflag='A', vtype=site_r8, hlms='CLM:ALM', upfreq=1, & -! ivar=ivar, initialize=initialize_variables, index = ih_logging_disturbance_rate_si ) -! -! call this%set_history_var(vname='DISTURBANCE_RATE_TREEFALL', units='m2 m-2 d-1', & -! long='Disturbance rate from treefall', use_default='active', & -! avgflag='A', vtype=site_r8, hlms='CLM:ALM', upfreq=1, & -! ivar=ivar, initialize=initialize_variables, index = ih_fall_disturbance_rate_si ) -! -! call this%set_history_var(vname='DISTURBANCE_RATE_POTENTIAL', units='m2 m-2 d-1', & -! long='Potential (i.e., including unresolved) disturbance rate', use_default='active', & -! avgflag='A', vtype=site_r8, hlms='CLM:ALM', upfreq=1, & -! ivar=ivar, initialize=initialize_variables, index = ih_potential_disturbance_rate_si ) - - call this%set_history_var(vname='HARVEST_CARBON_FLUX', units='kg C m-2 d-1', & - long='Harvest carbon flux', use_default='active', & - avgflag='A', vtype=site_r8, hlms='CLM:ALM', upfreq=1, & - ivar=ivar, initialize=initialize_variables, index = ih_harvest_carbonflux_si ) - - call this%set_history_var(vname='HARVEST_DEBT', units='kg C', & - long='Accumulated carbon failed to be harvested', use_default='active', & - avgflag='A', vtype=site_r8, hlms='CLM:ALM', upfreq=1, & - ivar=ivar, initialize=initialize_variables, index = ih_harvest_debt_si ) - - call this%set_history_var(vname='HARVEST_DEBT_SEC', units='kg C', & - long='Accumulated carbon failed to be harvested from secondary patches', use_default='active', & - avgflag='A', vtype=site_r8, hlms='CLM:ALM', upfreq=1, & - ivar=ivar, initialize=initialize_variables, index = ih_harvest_debt_sec_si ) - - ! Canopy Resistance - - call this%set_history_var(vname='C_STOMATA', units='umol m-2 s-1', & - long='mean stomatal conductance', use_default='active', & - avgflag='A', vtype=site_r8, hlms='CLM:ALM', upfreq=2, & - ivar=ivar, initialize=initialize_variables, index = ih_c_stomata_si ) - - call this%set_history_var(vname='C_LBLAYER', units='umol m-2 s-1', & - long='mean leaf boundary layer conductance', use_default='active', & - avgflag='A', vtype=site_r8, hlms='CLM:ALM', upfreq=2, & - ivar=ivar, initialize=initialize_variables, index = ih_c_lblayer_si ) - ! Ecosystem Carbon Fluxes (updated rapidly, upfreq=2) From 81ebf3264eb862652dc45859511a231200de56b2 Mon Sep 17 00:00:00 2001 From: Shijie Shu Date: Fri, 28 Oct 2022 14:28:02 -0700 Subject: [PATCH 09/20] Minor revisions on comments and merged with master branch, temporary commit --- biogeochem/EDCanopyStructureMod.F90 | 2 +- biogeochem/EDLoggingMortalityMod.F90 | 257 ++++++++++++++++++++++--- biogeochem/EDMortalityFunctionsMod.F90 | 4 + biogeochem/EDPatchDynamicsMod.F90 | 72 ++++++- main/FatesHistoryInterfaceMod.F90 | 15 ++ 5 files changed, 326 insertions(+), 24 deletions(-) diff --git a/biogeochem/EDCanopyStructureMod.F90 b/biogeochem/EDCanopyStructureMod.F90 index f195f59f0a..5ac8343a2e 100644 --- a/biogeochem/EDCanopyStructureMod.F90 +++ b/biogeochem/EDCanopyStructureMod.F90 @@ -2063,7 +2063,7 @@ subroutine update_hlm_dynamics(nsites,sites,fcolumn,bc_out) ! Pass FATES Harvested C to bc_out. call UpdateHarvestC(sites(s),bc_out(s)) - + end do ! This call to RecruitWaterStorage() makes an accounting of diff --git a/biogeochem/EDLoggingMortalityMod.F90 b/biogeochem/EDLoggingMortalityMod.F90 index b03e9485f5..cf920cd429 100644 --- a/biogeochem/EDLoggingMortalityMod.F90 +++ b/biogeochem/EDLoggingMortalityMod.F90 @@ -86,11 +86,6 @@ module EDLoggingMortalityMod real(r8), parameter :: harvest_litter_localization = 0.0_r8 - ! ! transfer factor from kg biomass (dry matter) to kg carbon - ! ! now we applied a simple fraction of 50% based on the IPCC - ! ! guideline - ! real(r8), parameter :: carbon_per_kg_biomass = 0.5_r8 - character(len=*), parameter, private :: sourcefile = & __FILE__ @@ -267,30 +262,30 @@ subroutine LoggingMortality_frac( pft_i, dbh, canopy_layer, lmort_direct, & ! Is it the correct place to call the function? ! Inputs: patch_area, patch_biomass, what else? - ! call get_harvest_rate_carbon (patch_anthro_disturbance_label, hlm_harvest_catnames, & - ! hlm_harvest_rates, frac_site_primary, secondary_age, harvest_rate) + call get_harvest_rate_carbon (patch_anthro_disturbance_label, hlm_harvest_catnames, & + hlm_harvest_rates, secondary_age, harvestable_forest_c, & + harvest_rate, harvest_tag, cur_harvest_tag) - ! if (fates_global_verbose()) then - ! write(fates_log(), *) 'Successfully Read Harvest Rate from HLM.', hlm_harvest_rates(:), harvest_rate - ! end if - - write(fates_log(),*) 'HLM harvest carbon data not implemented yet. Exiting.' - call endrun(msg=errMsg(sourcefile, __LINE__)) + if (fates_global_verbose()) then + write(fates_log(), *) 'Successfully Read Harvest Rate from HLM.', hlm_harvest_rates(:), harvest_rate, harvestable_forest_c + end if endif ! transfer of area to secondary land is based on overall area affected, not just logged crown area ! l_degrad accounts for the affected area between logged crowns if(prt_params%woody(pft_i) == itrue)then ! only set logging rates for trees - - ! direct logging rates, based on dbh min and max criteria - if (dbh >= logging_dbhmin .and. .not. & - ((logging_dbhmax < fates_check_param_set) .and. (dbh >= logging_dbhmax )) ) then - ! the logic of the above line is a bit unintuitive but allows turning off the dbhmax comparison entirely. - ! since there is an .and. .not. after the first conditional, the dbh:dbhmax comparison needs to be - ! the opposite of what would otherwise be expected... - lmort_direct = harvest_rate * logging_direct_frac - + if (cur_harvest_tag == 0) then + ! direct logging rates, based on dbh min and max criteria + if (dbh >= logging_dbhmin .and. .not. & + ((logging_dbhmax < fates_check_param_set) .and. (dbh >= logging_dbhmax )) ) then + ! the logic of the above line is a bit unintuitive but allows turning off the dbhmax comparison entirely. + ! since there is an .and. .not. after the first conditional, the dbh:dbhmax comparison needs to be + ! the opposite of what would otherwise be expected... + lmort_direct = harvest_rate * logging_direct_frac + else + lmort_direct = 0.0_r8 + end if else lmort_direct = 0.0_r8 end if @@ -418,6 +413,224 @@ end subroutine get_harvest_rate_area ! ============================================================================ + subroutine get_harvestable_carbon (csite, site_area, hlm_harvest_catnames, harvestable_forest_c ) + + !USES: + use SFParamsMod, only : SF_val_cwd_frac + use EDTypesMod, only : AREA_INV + + + ! ------------------------------------------------------------------------------------------- + ! + ! DESCRIPTION: + ! get the total carbon availale for harvest for three different harvest categories: + ! primary forest, secondary mature forest and secondary young forest + ! under two different scenarios: + ! harvestable carbon: aggregate all cohorts matching the dbhmin harvest criteria + ! + ! this subroutine shall be called outside the patch loop + ! output will be used to estimate the area-based harvest rate (get_harvest_rate_carbon) + ! for each cohort. + + ! Arguments + type(ed_site_type), intent(in), target :: csite + real(r8), intent(in) :: site_area ! temporary variable + character(len=64), intent(in) :: hlm_harvest_catnames(:) ! names of hlm harvest categories + + real(r8), intent(out) :: harvestable_forest_c(hlm_num_lu_harvest_cats) + + ! Local Variables + type(ed_patch_type), pointer :: currentPatch + type(ed_cohort_type), pointer :: currentCohort + real(r8) :: harvestable_patch_c ! temporary variable, kgC site-1 + real(r8) :: harvestable_cohort_c ! temporary variable, kgC site-1 + real(r8) :: sapw_m ! Biomass of sap wood + real(r8) :: struct_m ! Biomass of structural organs + integer :: pft ! Index of plant functional type + integer :: h_index ! for looping over harvest categories + + ! Initialization + harvestable_forest_c = 0._r8 + + ! loop over patches + currentPatch => csite%oldest_patch + do while (associated(currentPatch)) + harvestable_patch_c = 0._r8 + currentCohort => currentPatch%tallest + + do while (associated(currentCohort)) + pft = currentCohort%pft + + ! only account for cohorts matching the following conditions + if(int(prt_params%woody(pft)) == 1)then ! only set logging rates for trees + sapw_m = currentCohort%prt%GetState(sapw_organ, all_carbon_elements) + struct_m = currentCohort%prt%GetState(struct_organ, all_carbon_elements) + ! logging_direct_frac shall be 1 for LUH2 driven simulation and global simulation + ! in site level study logging_direct_frac shall be surveyed + ! unit: [kgC ] = [kgC/plant] * [plant/ha] * [ha/ 10k m2] * [ m2 area ] + harvestable_cohort_c = logging_direct_frac * ( sapw_m + struct_m ) * & + prt_params%allom_agb_frac(currentCohort%pft) * & + SF_val_CWD_frac(ncwd) * logging_export_frac * & + currentCohort%n * AREA_INV * site_area + + ! No harvest for trees without canopy + if (currentCohort%canopy_layer>=1) then + ! logging amount are based on dbh min and max criteria + if (currentCohort%dbh >= logging_dbhmin .and. .not. & + ((logging_dbhmax < fates_check_param_set) .and. (currentCohort%dbh >= logging_dbhmax )) ) then + ! Harvestable C: aggregate cohorts fit the criteria + harvestable_patch_c = harvestable_patch_c + harvestable_cohort_c + end if + end if + end if + currentCohort => currentCohort%shorter + end do + + ! judge which category the current patch belong to + ! since we have not separated forest vs. non-forest + ! all carbon belongs to the forest categories + do h_index = 1,hlm_num_lu_harvest_cats + if (currentPatch%anthro_disturbance_label .eq. primaryforest) then + ! Primary + if(hlm_harvest_catnames(h_index) .eq. "HARVEST_VH1") then + harvestable_forest_c(h_index) = harvestable_forest_c(h_index) + harvestable_patch_c + end if + else if (currentPatch%anthro_disturbance_label .eq. secondaryforest .and. & + currentPatch%age_since_anthro_disturbance >= secondary_age_threshold) then + ! Secondary mature + if(hlm_harvest_catnames(h_index) .eq. "HARVEST_SH1") then + harvestable_forest_c(h_index) = harvestable_forest_c(h_index) + harvestable_patch_c + end if + else if (currentPatch%anthro_disturbance_label .eq. secondaryforest .and. & + currentPatch%age_since_anthro_disturbance < secondary_age_threshold) then + ! Secondary young + if(hlm_harvest_catnames(h_index) .eq. "HARVEST_SH2") then + harvestable_forest_c(h_index) = harvestable_forest_c(h_index) + harvestable_patch_c + end if + end if + end do + currentPatch => currentPatch%younger + end do + + end subroutine get_harvestable_carbon + + ! ============================================================================ + + subroutine get_harvest_rate_carbon (patch_anthro_disturbance_label, hlm_harvest_catnames, & + hlm_harvest_rates, secondary_age, harvestable_forest_c, & + harvest_rate, harvest_tag, cur_harvest_tag) + + ! ------------------------------------------------------------------------------------------- + ! + ! DESCRIPTION: + ! get the carbon-based harvest rates based on info passed to FATES from the boundary conditions in. + ! assumes logging_time == true + + ! Arguments + real(r8), intent(in) :: hlm_harvest_rates(:) ! annual harvest rate per hlm category + character(len=64), intent(in) :: hlm_harvest_catnames(:) ! names of hlm harvest categories + integer, intent(in) :: patch_anthro_disturbance_label ! patch level anthro_disturbance_label + real(r8), intent(in) :: secondary_age ! patch level age_since_anthro_disturbance + real(r8), intent(in) :: harvestable_forest_c(:) ! site level forest c matching criteria available for harvest, kgC site-1 + real(r8), intent(out) :: harvest_rate ! area fraction + integer, intent(inout) :: harvest_tag(:) ! 0. normal harvest; 1. current site does not have enough C but + ! can perform harvest by ignoring criteria; 2. current site does + ! not have enough carbon + ! This harvest tag shall be a patch level variable but since all + ! logging functions happen within cohort loop we can only put the + ! calculation here. Can think about optimizing the logging calculation + ! in the future. + integer, intent(out), optional :: cur_harvest_tag ! harvest tag of the current cohort + + ! Local Variables + integer :: h_index ! for looping over harvest categories + integer :: icode ! Integer equivalent of the event code (parameter file only allows reals) + real(r8) :: harvest_rate_c ! Temporary variable, kgC site-1 + real(r8) :: harvest_rate_supply ! Temporary variable, kgC site-1 + + ! Loop around harvest categories to determine the hlm harvest rate demand and actual harvest rate for the + ! current cohort based on patch history info + harvest_rate = 0._r8 + harvest_rate_c = 0._r8 + harvest_rate_supply = 0._r8 + harvest_tag(:) = 1 + + do h_index = 1,hlm_num_lu_harvest_cats + if (patch_anthro_disturbance_label .eq. primaryforest) then + if(hlm_harvest_catnames(h_index) .eq. "HARVEST_VH1" .or. & + hlm_harvest_catnames(h_index) .eq. "HARVEST_VH2") then + harvest_rate_c = harvest_rate_c + hlm_harvest_rates(h_index) + ! Determine the total supply of available C for harvest + if(harvestable_forest_c(h_index) >= harvest_rate_c) then + harvest_rate_supply = harvest_rate_supply + harvestable_forest_c(h_index) + harvest_tag(h_index) = 0 + else + harvest_tag(h_index) = 1 + end if + endif + else if (patch_anthro_disturbance_label .eq. secondaryforest .and. & + secondary_age >= secondary_age_threshold) then + if(hlm_harvest_catnames(h_index) .eq. "HARVEST_SH1") then + harvest_rate_c = harvest_rate_c + hlm_harvest_rates(h_index) + if(harvestable_forest_c(h_index) >= harvest_rate_c) then + harvest_rate_supply = harvest_rate_supply + harvestable_forest_c(h_index) + harvest_tag(h_index) = 0 + else + harvest_tag(h_index) = 1 + end if + endif + else if (patch_anthro_disturbance_label .eq. secondaryforest .and. & + secondary_age < secondary_age_threshold) then + if(hlm_harvest_catnames(h_index) .eq. "HARVEST_SH2" .or. & + hlm_harvest_catnames(h_index) .eq. "HARVEST_SH3") then + harvest_rate_c = harvest_rate_c + hlm_harvest_rates(h_index) + if(harvestable_forest_c(h_index) >= harvest_rate_c) then + harvest_rate_supply = harvest_rate_supply + harvestable_forest_c(h_index) + harvest_tag(h_index) = 0 + else + harvest_tag(h_index) = 1 + end if + endif + endif + end do + + ! If any harvest category available, assign to cur_harvest_tag and trigger logging event + if(present(cur_harvest_tag))then + cur_harvest_tag = minval(harvest_tag) + end if + + ! Transfer carbon-based harvest rate to area-based harvest rate + if (harvest_rate_supply > rsnbl_math_prec .and. harvest_rate_supply > harvest_rate_c) then + harvest_rate = harvest_rate_c / harvest_rate_supply + else + harvest_rate = 0._r8 + end if + + ! For carbon-based harvest rate, normalizing by site-level primary or secondary forest fraction + ! is not needed + + ! calculate today's harvest rate + ! whether to harvest today has already been determined by IsItLoggingTime + ! for icode == 2, icode < 0, and icode > 10000 apply the annual rate one time (no calc) + ! Bad logging event flag is caught in IsItLoggingTime, so don't check it here + icode = int(logging_event_code) + if(icode .eq. 1) then + ! Logging is turned off - not sure why we need another switch + harvest_rate = 0._r8 + else if(icode .eq. 3) then + ! Logging event every day - this may not work due to the mortality exclusivity + harvest_rate = harvest_rate / hlm_days_per_year + else if(icode .eq. 4) then + ! logging event once a month + if(hlm_current_day.eq.1 ) then + harvest_rate = harvest_rate / months_per_year + end if + end if + + end subroutine get_harvest_rate_carbon + + ! ============================================================================ + subroutine logging_litter_fluxes(currentSite, currentPatch, newPatch, patch_site_areadis, bc_in) ! ------------------------------------------------------------------------------------------- diff --git a/biogeochem/EDMortalityFunctionsMod.F90 b/biogeochem/EDMortalityFunctionsMod.F90 index 605c377508..40dc0fb067 100644 --- a/biogeochem/EDMortalityFunctionsMod.F90 +++ b/biogeochem/EDMortalityFunctionsMod.F90 @@ -231,6 +231,10 @@ subroutine Mortality_Derivative( currentSite, currentCohort, bc_in, frac_site_pr type(ed_cohort_type),intent(inout), target :: currentCohort type(bc_in_type), intent(in) :: bc_in real(r8), intent(in) :: frac_site_primary + + real(r8), intent(in) :: harvestable_forest_c(:) ! total carbon available for logging, kgC site-1 + integer, intent(inout) :: harvest_tag(:) + ! ! !LOCAL VARIABLES: real(r8) :: cmort ! starvation mortality rate (fraction per year) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 56d9cc3b5a..e42c21478c 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -197,6 +197,10 @@ subroutine disturbance_rates( site_in, bc_in) ! first calculate the fractino of the site that is primary land call get_frac_site_primary(site_in, frac_site_primary) + harvest_debt_primary = 0 + harvest_debt_secondary = 0 + patch_no_secondary = 0 + currentPatch => site_in%oldest_patch do while (associated(currentPatch)) @@ -234,10 +238,76 @@ subroutine disturbance_rates( site_in, bc_in) currentCohort => currentCohort%taller end do - currentPatch%disturbance_mode = fates_unset_int + + ! Determine harvest debt for primary land and secondary land + ! Harvest debt is the accumulated total carbon amount once + ! available carbon for harvest is smaller than the harvest + ! rate of forcing data for each site. + ! Each cohort has the same harvest tag but not each patch + ! Hence this part shall be within the patch loop + ! TODO: we can define harvest debt as a fraction of the + ! harvest rate in the future + ! Warning: Non-forest harvest is not accounted for yet + ! Thus the harvest tag for non-forest are not effective + if(logging_time) then + harvest_debt_loop: do h_index = 1, hlm_num_lu_harvest_cats + ! Primary patch: Once a patch has debt, skip the calculation + if (harvest_debt_primary == 0) then + if ( currentPatch%anthro_disturbance_label .eq. primaryforest ) then + if ( harvest_tag(h_index) == 1 ) then + ! h_index points to primary forest harvest + if((bc_in%hlm_harvest_catnames(h_index) .eq. "HARVEST_VH1")) then + harvest_debt_primary = 1 + exit harvest_debt_loop + end if + end if + end if + end if + ! Secondary patch + if (harvest_debt_secondary == 0) then + if ( currentPatch%anthro_disturbance_label .eq. secondaryforest ) then + patch_no_secondary = patch_no_secondary + 1 + if ( harvest_tag(h_index) == 1 ) then + ! h_index points to secondary forest harvest + if((bc_in%hlm_harvest_catnames(h_index) .eq. "HARVEST_SH1") .or. & + (bc_in%hlm_harvest_catnames(h_index) .eq. "HARVEST_SH2")) then + harvest_debt_secondary = 1 + exit harvest_debt_loop + end if + end if + end if + end if + end do harvest_debt_loop + end if + currentPatch => currentPatch%younger end do + ! Obatin actual harvest debt. This shall be outside the patch loop + if(logging_time) then + do h_index = 1, hlm_num_lu_harvest_cats + if ( harvest_debt_primary == 1 ) then + ! Only account for primary forest harvest rate + if((bc_in%hlm_harvest_catnames(h_index) .eq. "HARVEST_VH1") .or. & + (bc_in%hlm_harvest_catnames(h_index) .eq. "HARVEST_VH2")) then + site_in%resources_management%harvest_debt = site_in%resources_management%harvest_debt + & + bc_in%hlm_harvest_rates(h_index) + end if + end if + if (harvest_debt_secondary == 1 .or. patch_no_secondary == 0) then + ! Only account for secondary forest harvest rate + if((bc_in%hlm_harvest_catnames(h_index) .eq. "HARVEST_SH1") .or. & + (bc_in%hlm_harvest_catnames(h_index) .eq. "HARVEST_SH2") .or. & + (bc_in%hlm_harvest_catnames(h_index) .eq. "HARVEST_SH3")) then + site_in%resources_management%harvest_debt = site_in%resources_management%harvest_debt + & + bc_in%hlm_harvest_rates(h_index) + site_in%resources_management%harvest_debt_sec = site_in%resources_management%harvest_debt_sec + & + bc_in%hlm_harvest_rates(h_index) + end if + end if + end do + end if + ! --------------------------------------------------------------------------------------------- ! Calculate Disturbance Rates based on the mortality rates just calculated ! --------------------------------------------------------------------------------------------- diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 3ef7fd14df..ada2330a58 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -2135,6 +2135,8 @@ subroutine update_history_dyn(this,nc,nsites,sites) this%hvars(ih_h2oveg_recruit_si)%r81d(io_si) = sites(s)%si_hydr%h2oveg_recruit this%hvars(ih_h2oveg_growturn_err_si)%r81d(io_si) = sites(s)%si_hydr%h2oveg_growturn_err end if + hio_harvest_debt_si(io_si) = sites(s)%resources_management%harvest_debt + hio_harvest_debt_sec_si(io_si) = sites(s)%resources_management%harvest_debt_sec ! error in primary lands from patch fusion [m2 m-2 day-1] -> [m2 m-2 yr-1] hio_primaryland_fusion_error_si(io_si) = sites(s)%primary_land_patchfusion_error * days_per_year @@ -2210,6 +2212,12 @@ subroutine update_history_dyn(this,nc,nsites,sites) + cpatch%area * AREA_INV endif + ! Secondary forest mean LAI + if ( cpatch%anthro_disturbance_label .eq. secondaryforest ) then + hio_lai_secondary_si(io_si) = hio_lai_secondary_si(io_si) & + + sum(cpatch%tlai_profile(:,:,:)) * cpatch%total_canopy_area + end if + ! patch-age-resolved fire variables do i_pft = 1,numpft ! for scorch height, weight the value by patch area within any @@ -2970,6 +2978,13 @@ subroutine update_history_dyn(this,nc,nsites,sites) endif end do + ! divide secondary plant leaf area by secondary forest area to get the secondary forest LAI + if (hio_fraction_secondary_forest_si(io_si) .gt. nearzero) then + hio_lai_secondary_si(io_si) = hio_lai_secondary_si(io_si) / (hio_fraction_secondary_forest_si(io_si)*AREA) + else + hio_lai_secondary_si(io_si) = 0._r8 + end if + ! pass the cohort termination mortality as a flux to the history, and then reset the termination mortality buffer ! note there are various ways of reporting the total mortality, so pass to these as well do i_pft = 1, numpft From 91d4576c997361dd815c0c68bbf96c2834d67abe Mon Sep 17 00:00:00 2001 From: Shijie Shu Date: Mon, 31 Oct 2022 12:22:36 -0700 Subject: [PATCH 10/20] Patch up paralell disturbance and model phenology issue. --- biogeochem/EDPatchDynamicsMod.F90 | 207 ++++++++++-------------------- biogeochem/EDPhysiologyMod.F90 | 10 +- main/EDInitMod.F90 | 29 +++-- main/EDMainMod.F90 | 1 - main/EDTypesMod.F90 | 9 +- main/FatesHistoryInterfaceMod.F90 | 12 +- main/FatesRestartInterfaceMod.F90 | 47 ++++--- 7 files changed, 132 insertions(+), 183 deletions(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index e42c21478c..022bed4ac6 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -188,6 +188,7 @@ subroutine disturbance_rates( site_in, bc_in) integer :: i_dist real(r8) :: frac_site_primary real(r8) :: harvest_rate + real(r8) :: tempsum !---------------------------------------------------------------------------------------------- ! Calculate Mortality Rates (these were previously calculated during growth derivatives) @@ -402,90 +403,11 @@ subroutine disturbance_rates( site_in, bc_in) call FatesWarn(msg,index=2) endif - - - - ! ------------------------------------------------------------------------------------------ - ! Determine which disturbance is dominant, and force mortality diagnostics in the upper - ! canopy to be zero for the non-dominant mode. Note: upper-canopy tree-fall mortality is - ! not always disturbance generating, so when tree-fall mort is non-dominant, make sure - ! to still diagnose and track the non-disturbance rate - ! ------------------------------------------------------------------------------------------ - - ! DISTURBANCE IS LOGGING - if (currentPatch%disturbance_rates(dtype_ilog) > currentPatch%disturbance_rates(dtype_ifall) .and. & - currentPatch%disturbance_rates(dtype_ilog) > currentPatch%disturbance_rates(dtype_ifire) ) then - - currentPatch%disturbance_rate = currentPatch%disturbance_rates(dtype_ilog) - currentPatch%disturbance_mode = dtype_ilog - - ! Update diagnostics - currentCohort => currentPatch%shortest - do while(associated(currentCohort)) - if(currentCohort%canopy_layer == 1)then - currentCohort%cmort = currentCohort%cmort*(1.0_r8 - fates_mortality_disturbance_fraction) - currentCohort%hmort = currentCohort%hmort*(1.0_r8 - fates_mortality_disturbance_fraction) - currentCohort%bmort = currentCohort%bmort*(1.0_r8 - fates_mortality_disturbance_fraction) - currentCohort%dmort = currentCohort%dmort*(1.0_r8 - fates_mortality_disturbance_fraction) - currentCohort%frmort = currentCohort%frmort*(1.0_r8 - fates_mortality_disturbance_fraction) - currentCohort%smort = currentCohort%smort*(1.0_r8 - fates_mortality_disturbance_fraction) - currentCohort%asmort = currentCohort%asmort*(1.0_r8 - fates_mortality_disturbance_fraction) - end if - currentCohort => currentCohort%taller - enddo !currentCohort - - ! DISTURBANCE IS FIRE - elseif (currentPatch%disturbance_rates(dtype_ifire) > currentPatch%disturbance_rates(dtype_ifall) .and. & - currentPatch%disturbance_rates(dtype_ifire) > currentPatch%disturbance_rates(dtype_ilog) ) then - - currentPatch%disturbance_rate = currentPatch%disturbance_rates(dtype_ifire) - currentPatch%disturbance_mode = dtype_ifire - - ! Update diagnostics, zero non-fire mortality rates - currentCohort => currentPatch%shortest - do while(associated(currentCohort)) - if(currentCohort%canopy_layer == 1)then - currentCohort%cmort = currentCohort%cmort*(1.0_r8 - fates_mortality_disturbance_fraction) - currentCohort%hmort = currentCohort%hmort*(1.0_r8 - fates_mortality_disturbance_fraction) - currentCohort%bmort = currentCohort%bmort*(1.0_r8 - fates_mortality_disturbance_fraction) - currentCohort%dmort = currentCohort%dmort*(1.0_r8 - fates_mortality_disturbance_fraction) - currentCohort%frmort = currentCohort%frmort*(1.0_r8 - fates_mortality_disturbance_fraction) - currentCohort%smort = currentCohort%smort*(1.0_r8 - fates_mortality_disturbance_fraction) - currentCohort%asmort = currentCohort%asmort*(1.0_r8 - fates_mortality_disturbance_fraction) - currentCohort%lmort_direct = 0.0_r8 - currentCohort%lmort_collateral = 0.0_r8 - currentCohort%lmort_infra = 0.0_r8 - currentCohort%l_degrad = 0.0_r8 - end if - - ! This may be counter-intuitive, but the diagnostic fire-mortality rate - ! will stay zero in the patch that undergoes fire, this is because - ! the actual cohorts who experience the fire are only those in the - ! newly created patch so currentCohort%fmort = 0.0_r8 - ! Don't worry, the cohorts in the newly created patch will reflect burn - - currentCohort => currentCohort%taller - enddo !currentCohort - - else ! If fire and logging are not greater than treefall, just set disturbance rate to tree-fall - ! which is most likely a 0.0 - - currentPatch%disturbance_rate = currentPatch%disturbance_rates(dtype_ifall) - currentPatch%disturbance_mode = dtype_ifall - - ! Update diagnostics, zero non-treefall mortality rates - currentCohort => currentPatch%shortest - do while(associated(currentCohort)) - if(currentCohort%canopy_layer == 1)then - currentCohort%lmort_direct = 0.0_r8 - currentCohort%lmort_collateral = 0.0_r8 - currentCohort%lmort_infra = 0.0_r8 - currentCohort%l_degrad = 0.0_r8 - end if - currentCohort => currentCohort%taller - enddo !currentCohort - - + if ( sum(currentPatch%disturbance_rates(:)) .gt. 1.0_r8 ) then + tempsum = sum(currentPatch%disturbance_rates(:)) + do i_dist = 1,N_DIST_TYPES + currentPatch%disturbance_rates(i_dist) = currentPatch%disturbance_rates(i_dist) / tempsum + end do endif currentPatch => currentPatch%younger @@ -550,6 +472,9 @@ subroutine spawn_patches( currentSite, bc_in) real(r8) :: leaf_m ! leaf mass during partial burn calculations logical :: found_youngest_primary ! logical for finding the first primary forest patch integer :: min_nocomp_pft, max_nocomp_pft, i_nocomp_pft + integer :: i_disturbance_type, i_dist2 ! iterators for looping over disturbance types + real(r8) :: disturbance_rate ! rate of disturbance being resolved [fraction of patch area / day] + real(r8) :: oldarea ! old patch area prior to disturbance !--------------------------------------------------------------------- storesmallcohort => null() ! storage of the smallest cohort for insertion routine @@ -574,6 +499,8 @@ subroutine spawn_patches( currentSite, bc_in) ! If nocomp is not enabled, then this is not much of a loop, it only passes through once. nocomp_pft_loop: do i_nocomp_pft = min_nocomp_pft,max_nocomp_pft + disturbance_type_loop: do i_disturbance_type = 1,N_DIST_TYPES + ! calculate area of disturbed land, in this timestep, by summing contributions from each existing patch. currentPatch => currentSite%youngest_patch @@ -584,47 +511,42 @@ subroutine spawn_patches( currentSite, bc_in) cp_nocomp_matches_1_if: if ( hlm_use_nocomp .eq. ifalse .or. & currentPatch%nocomp_pft_label .eq. i_nocomp_pft ) then - - if(currentPatch%disturbance_rate > (1.0_r8 + rsnbl_math_prec)) then - write(fates_log(),*) 'patch disturbance rate > 1 ?',currentPatch%disturbance_rate + + disturbance_rate = currentPatch%disturbance_rates(i_disturbance_type) + + if(disturbance_rate > (1.0_r8 + rsnbl_math_prec)) then + write(fates_log(),*) 'patch disturbance rate > 1 ?',disturbance_rate call dump_patch(currentPatch) call endrun(msg=errMsg(sourcefile, __LINE__)) end if - ! Check to make sure that the disturbance mode of the patch is set - if( .not.any(currentPatch%disturbance_mode == [dtype_ilog,dtype_ifall,dtype_ifire])) then - write(fates_log(),*) 'undefined disturbance mode? : ',currentPatch%disturbance_mode - call endrun(msg=errMsg(sourcefile, __LINE__)) - end if - - ! Only create new patches that have non-negligible amount of land - if((currentPatch%area*currentPatch%disturbance_rate) > nearzero ) then + if((currentPatch%area*disturbance_rate) > nearzero ) then ! figure out whether the receiver patch for disturbance from this patch will be ! primary or secondary land receiver patch is primary forest only if both the - ! donor patch is primary forest and the dominant disturbance type is not logging + ! donor patch is primary forest and the current disturbance type is not logging if ( currentPatch%anthro_disturbance_label .eq. primaryforest .and. & - (currentPatch%disturbance_mode .ne. dtype_ilog) ) then + (i_disturbance_type .ne. dtype_ilog) ) then - site_areadis_primary = site_areadis_primary + currentPatch%area * currentPatch%disturbance_rate + site_areadis_primary = site_areadis_primary + currentPatch%area * disturbance_rate ! track disturbance rates to output to history - currentSite%disturbance_rates_primary_to_primary(currentPatch%disturbance_mode) = & - currentSite%disturbance_rates_primary_to_primary(currentPatch%disturbance_mode) + & - currentPatch%area * currentPatch%disturbance_rate * AREA_INV + currentSite%disturbance_rates_primary_to_primary(i_disturbance_type) = & + currentSite%disturbance_rates_primary_to_primary(i_disturbance_type) + & + currentPatch%area * disturbance_rate * AREA_INV else - site_areadis_secondary = site_areadis_secondary + currentPatch%area * currentPatch%disturbance_rate + site_areadis_secondary = site_areadis_secondary + currentPatch%area * disturbance_rate ! track disturbance rates to output to history if (currentPatch%anthro_disturbance_label .eq. secondaryforest) then - currentSite%disturbance_rates_secondary_to_secondary(currentPatch%disturbance_mode) = & - currentSite%disturbance_rates_secondary_to_secondary(currentPatch%disturbance_mode) + & - currentPatch%area * currentPatch%disturbance_rate * AREA_INV + currentSite%disturbance_rates_secondary_to_secondary(i_disturbance_type) = & + currentSite%disturbance_rates_secondary_to_secondary(i_disturbance_type) + & + currentPatch%area * disturbance_rate * AREA_INV else - currentSite%disturbance_rates_primary_to_secondary(currentPatch%disturbance_mode) = & - currentSite%disturbance_rates_primary_to_secondary(currentPatch%disturbance_mode) + & - currentPatch%area * currentPatch%disturbance_rate * AREA_INV + currentSite%disturbance_rates_primary_to_secondary(i_disturbance_type) = & + currentSite%disturbance_rates_primary_to_secondary(i_disturbance_type) + & + currentPatch%area * disturbance_rate * AREA_INV endif endif @@ -698,17 +620,17 @@ subroutine spawn_patches( currentSite, bc_in) currentPatch%nocomp_pft_label .eq. i_nocomp_pft ) then ! This is the amount of patch area that is disturbed, and donated by the donor - patch_site_areadis = currentPatch%area * currentPatch%disturbance_rate - + disturbance_rate = currentPatch%disturbance_rates(i_disturbance_type) + patch_site_areadis = currentPatch%area * disturbance_rate if ( patch_site_areadis > nearzero ) then ! figure out whether the receiver patch for disturbance from this patch ! will be primary or secondary land receiver patch is primary forest - ! only if both the donor patch is primary forest and the dominant + ! only if both the donor patch is primary forest and the current ! disturbance type is not logging if (currentPatch%anthro_disturbance_label .eq. primaryforest .and. & - (currentPatch%disturbance_mode .ne. dtype_ilog)) then + (i_disturbance_type .ne. dtype_ilog)) then new_patch => new_patch_primary else new_patch => new_patch_secondary @@ -721,24 +643,23 @@ subroutine spawn_patches( currentSite, bc_in) end if ! for the case where the donating patch is secondary forest, if - ! the dominant disturbance from this patch is non-anthropogenic, + ! the current disturbance from this patch is non-anthropogenic, ! we need to average in the time-since-anthropogenic-disturbance ! from the donor patch into that of the receiver patch if ( currentPatch%anthro_disturbance_label .eq. secondaryforest .and. & - (currentPatch%disturbance_mode .ne. dtype_ilog) ) then + (i_disturbance_type .ne. dtype_ilog) ) then new_patch%age_since_anthro_disturbance = new_patch%age_since_anthro_disturbance + & currentPatch%age_since_anthro_disturbance * (patch_site_areadis / site_areadis_secondary) endif - ! 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 - ! fire is not the dominant disturbance regime. + ! fire is not the current disturbance regime. - if(currentPatch%disturbance_mode .ne. dtype_ifire) then + if(i_disturbance_type .ne. dtype_ifire) then currentPatch%burnt_frac_litter(:) = 0._r8 end if @@ -746,10 +667,10 @@ subroutine spawn_patches( currentSite, bc_in) ! Transfer in litter fluxes from plants in various contexts of death and destruction - if(currentPatch%disturbance_mode .eq. dtype_ilog) then + if(i_disturbance_type .eq. dtype_ilog) then call logging_litter_fluxes(currentSite, currentPatch, & new_patch, patch_site_areadis,bc_in) - elseif(currentPatch%disturbance_mode .eq. dtype_ifire) then + elseif(i_disturbance_type .eq. dtype_ifire) then call fire_litter_fluxes(currentSite, currentPatch, & new_patch, patch_site_areadis,bc_in) else @@ -808,8 +729,8 @@ subroutine spawn_patches( currentSite, bc_in) store_c = currentCohort%prt%GetState(store_organ, all_carbon_elements) total_c = sapw_c + struct_c + leaf_c + fnrt_c + store_c - ! treefall mortality is the dominant disturbance - if(currentPatch%disturbance_mode .eq. dtype_ifall) then + ! treefall mortality is the current disturbance + if(i_disturbance_type .eq. dtype_ifall) then if(currentCohort%canopy_layer == 1)then @@ -919,8 +840,8 @@ subroutine spawn_patches( currentSite, bc_in) endif endif - ! Fire is the dominant disturbance - elseif (currentPatch%disturbance_mode .eq. dtype_ifire ) then + ! Fire is the current disturbance + elseif (i_disturbance_type .eq. dtype_ifire ) then ! Number of members in the new patch, before we impose fire survivorship nc%n = currentCohort%n * patch_site_areadis/currentPatch%area @@ -1020,8 +941,8 @@ subroutine spawn_patches( currentSite, bc_in) - ! Logging is the dominant disturbance - elseif (currentPatch%disturbance_mode .eq. dtype_ilog ) then + ! Logging is the current disturbance + elseif (i_disturbance_type .eq. dtype_ilog ) then ! If this cohort is in the upper canopy. It generated if(currentCohort%canopy_layer == 1)then @@ -1055,7 +976,7 @@ subroutine spawn_patches( currentSite, bc_in) else - ! WHat to do with cohorts in the understory of a logging generated + ! What to do with cohorts in the understory of a logging generated ! disturbance patch? if(prt_params%woody(currentCohort%pft) == itrue)then @@ -1140,7 +1061,7 @@ subroutine spawn_patches( currentSite, bc_in) else write(fates_log(),*) 'unknown disturbance mode?' - write(fates_log(),*) 'disturbance_mode: ',currentPatch%disturbance_mode + write(fates_log(),*) 'i_disturbance_type: ', i_disturbance_type call endrun(msg=errMsg(sourcefile, __LINE__)) end if ! Select disturbance mode @@ -1181,8 +1102,18 @@ subroutine spawn_patches( currentSite, bc_in) call sort_cohorts(currentPatch) !update area of donor patch + oldarea = currentPatch%area currentPatch%area = currentPatch%area - patch_site_areadis + ! for all disturbance rates that haven't been resolved yet, increase their amount so that + ! they are the same amount of gridcell-scale disturbance relative to the original patch size + if (i_disturbance_type .ne. N_DIST_TYPES) then + do i_dist2 = i_disturbance_type+1,N_DIST_TYPES + currentPatch%disturbance_rates(i_dist2) = currentPatch%disturbance_rates(i_dist2) & + * oldarea / currentPatch%area + end do + end if + ! sort out the cohorts, since some of them may be so small as to need removing. ! the first call to terminate cohorts removes sparse number densities, ! the second call removes for all other reasons (sparse culling must happen @@ -1194,11 +1125,6 @@ subroutine spawn_patches( currentSite, bc_in) end if ! if ( new_patch%area > nearzero ) then - !zero disturbance rate trackers - currentPatch%disturbance_rate = 0._r8 - currentPatch%disturbance_rates = 0._r8 - currentPatch%fract_ldist_not_harvested = 0._r8 - end if cp_nocomp_matches_2_if currentPatch => currentPatch%younger @@ -1280,8 +1206,19 @@ subroutine spawn_patches( currentSite, bc_in) call check_patch_area(currentSite) call set_patchno(currentSite) - + + end do disturbance_type_loop + end do nocomp_pft_loop + + !zero disturbance rate trackers on all patches + currentPatch => currentSite%oldest_patch + do while(associated(currentPatch)) + currentPatch%disturbance_rates(:) = 0._r8 + currentPatch%fract_ldist_not_harvested = 0._r8 + currentPatch => currentPatch%younger + end do + return end subroutine spawn_patches @@ -2170,7 +2107,6 @@ subroutine create_patch(currentSite, new_patch, age, areap, label,nocomp_pft) ! This new value will be generated when the calculate disturbance ! rates routine is called. This does not need to be remembered or in the restart file. - new_patch%disturbance_mode = fates_unset_int new_patch%f_sun = 0._r8 new_patch%ed_laisun_z(:,:,:) = 0._r8 @@ -2273,8 +2209,7 @@ subroutine zero_patch(cp_p) currentPatch%pft_agb_profile(:,:) = nan ! DISTURBANCE - currentPatch%disturbance_rates = 0._r8 - currentPatch%disturbance_rate = 0._r8 + currentPatch%disturbance_rates(:) = 0._r8 currentPatch%fract_ldist_not_harvested = 0._r8 diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 9a43af3226..6721f0dfa8 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -737,8 +737,12 @@ subroutine phenology( currentSite, bc_in ) ! This is the integer model day. The first day of the simulation is 1, and it ! continues monotonically, indefinitely - model_day_int = nint(hlm_model_day) + ! Advance it. (this should be a global, no reason + ! for site level, but we don't have global scalars in the + ! restart file) + currentSite%phen_model_date = currentSite%phen_model_date + 1 + model_day_int = currentSite%phen_model_date ! Use the following layer index to calculate drought conditions ilayer_swater = minloc(abs(bc_in%z_sisl(:)-dphen_soil_depth),dim=1) @@ -842,7 +846,7 @@ subroutine phenology( currentSite, bc_in ) end if if (model_day_int < currentSite%cleafondate) then - dayssincecleafon = model_day_int - (currentSite%cleafondate-365) + dayssincecleafon = model_day_int - (currentSite%cleafondate - 365) else dayssincecleafon = model_day_int - currentSite%cleafondate end if @@ -1054,6 +1058,7 @@ subroutine phenology( currentSite, bc_in ) call phenology_leafonoff(currentSite) + return end subroutine phenology @@ -1582,7 +1587,6 @@ subroutine SeedIn( currentSite, bc_in ) ! !USES: use EDTypesMod, only : area use EDTypesMod, only : homogenize_seed_pfts - !use FatesInterfaceTypesMod, only : hlm_use_fixed_biogeog ! For future reduced complexity? ! ! !ARGUMENTS type(ed_site_type), intent(inout), target :: currentSite diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index 451834a9ec..d0e38d9df9 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -22,6 +22,7 @@ module EDInitMod use EDPatchDynamicsMod , only : set_patchno use EDPhysiologyMod , only : assign_cohort_sp_properties use ChecksBalancesMod , only : SiteMassStock + use FatesInterfaceTypesMod , only : hlm_day_of_year use EDTypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type use EDTypesMod , only : numWaterMem use EDTypesMod , only : num_vegtemp_mem @@ -200,13 +201,15 @@ subroutine zero_site( site_in ) site_in%snow_depth = nan site_in%nchilldays = fates_unset_int site_in%ncolddays = fates_unset_int - site_in%cleafondate = fates_unset_int ! doy of leaf on - site_in%cleafoffdate = fates_unset_int ! doy of leaf off - site_in%dleafondate = fates_unset_int ! doy of leaf on drought - site_in%dleafoffdate = fates_unset_int ! doy of leaf on drought + site_in%cleafondate = fates_unset_int + site_in%cleafoffdate = fates_unset_int + site_in%dleafondate = fates_unset_int + site_in%dleafoffdate = fates_unset_int site_in%water_memory(:) = nan site_in%vegtemp_memory(:) = nan ! record of last 10 days temperature for senescence model. + site_in%phen_model_date = fates_unset_int + ! Disturbance rates tracking site_in%primary_land_patchfusion_error = 0.0_r8 site_in%potential_disturbance_rates(:) = 0.0_r8 @@ -315,15 +318,15 @@ subroutine set_site_properties( nsites, sites,bc_in ) do s = 1,nsites sites(s)%nchilldays = 0 sites(s)%ncolddays = 0 ! recalculated in phenology - ! immediately, so yes this - ! is memory-less, but needed - ! for first value in history file - - sites(s)%cleafondate = cleafon - sites(s)%cleafoffdate = cleafoff - sites(s)%dleafoffdate = dleafoff - sites(s)%dleafondate = dleafon - sites(s)%grow_deg_days = GDD + ! immediately, so yes this + ! is memory-less, but needed + ! for first value in history file + sites(s)%phen_model_date = 0 + sites(s)%cleafondate = cleafon - hlm_day_of_year + sites(s)%cleafoffdate = cleafoff - hlm_day_of_year + sites(s)%dleafoffdate = dleafoff - hlm_day_of_year + sites(s)%dleafondate = dleafon - hlm_day_of_year + sites(s)%grow_deg_days = GDD sites(s)%water_memory(1:numWaterMem) = watermem sites(s)%vegtemp_memory(1:num_vegtemp_mem) = 0._r8 diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index d05966ef14..7b9d623413 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -847,7 +847,6 @@ subroutine TotalBalanceCheck (currentSite, call_index ) write(fates_log(),*) 'BG CWD (by layer): ', sum(litt%bg_cwd,dim=1) write(fates_log(),*) 'leaf litter:',sum(litt%leaf_fines) write(fates_log(),*) 'root litter (by layer): ',sum(litt%root_fines,dim=1) - write(fates_log(),*) 'dist mode: ',currentPatch%disturbance_mode write(fates_log(),*) 'anthro_disturbance_label: ',currentPatch%anthro_disturbance_label write(fates_log(),*) 'use_this_pft: ', currentSite%use_this_pft(:) if(print_cohorts)then diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 1c76f44a54..6f3bf6ee52 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -532,9 +532,6 @@ module EDTypesMod real(r8) :: disturbance_rates(n_dist_types) ! disturbance rate from 1) mortality ! 2) fire: fraction/day ! 3) logging mortatliy - real(r8) :: disturbance_rate ! larger effective disturbance rate: fraction/day - integer :: disturbance_mode ! index identifying which disturbance was applied - ! can be one of: dtype_ifall, dtype_ilog or dtype_ifire real(r8) :: fract_ldist_not_harvested ! fraction of logged area that is canopy trees that weren't harvested @@ -745,6 +742,11 @@ module EDTypesMod integer :: dleafondate ! model date (day integer) of leaf on drought:- integer :: dleafoffdate ! model date (day integer) of leaf off drought:- + integer :: phen_model_date ! current model date (day integer) + ! this date stays continuous when + ! in runs that are restarted, regardless of + ! the conditions of restart + real(r8) :: water_memory(numWaterMem) ! last 10 days of soil moisture memory... @@ -1008,7 +1010,6 @@ subroutine dump_patch(cpatch) write(fates_log(),*) 'pa%gnd_alb_dir = ',cpatch%gnd_alb_dir(:) write(fates_log(),*) 'pa%c_stomata = ',cpatch%c_stomata write(fates_log(),*) 'pa%c_lblayer = ',cpatch%c_lblayer - write(fates_log(),*) 'pa%disturbance_rate = ',cpatch%disturbance_rate write(fates_log(),*) 'pa%disturbance_rates = ',cpatch%disturbance_rates(:) write(fates_log(),*) 'pa%anthro_disturbance_label = ',cpatch%anthro_disturbance_label write(fates_log(),*) '----------------------------------------' diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index ada2330a58..829a683ecd 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -1755,7 +1755,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) integer :: height_bin_max, height_bin_min ! which height bin a given cohort's canopy is in integer :: i_heightbin ! iterator for height bins integer :: el ! Loop index for elements - integer :: model_day_int ! integer model day from reference + integer :: model_day_int ! Integer model day since simulation start integer :: ageclass_since_anthrodist ! what is the equivalent age class for ! time-since-anthropogenic-disturbance of secondary forest @@ -2041,7 +2041,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_cleafoff_si => this%hvars(ih_cleafoff_si)%r81d, & hio_cleafon_si => this%hvars(ih_cleafon_si)%r81d, & hio_dleafoff_si => this%hvars(ih_dleafoff_si)%r81d, & - hio_dleafon_si => this%hvars(ih_dleafoff_si)%r81d, & + hio_dleafon_si => this%hvars(ih_dleafon_si)%r81d, & hio_tveg24 => this%hvars(ih_tveg24_si)%r81d, & hio_meanliqvol_si => this%hvars(ih_meanliqvol_si)%r81d, & hio_cbal_err_fates_si => this%hvars(ih_cbal_err_fates_si)%r81d, & @@ -2101,10 +2101,10 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_gdd_si(io_si) = sites(s)%grow_deg_days ! Model days elapsed since leaf on/off for cold- and drought-deciduous - hio_cleafoff_si(io_si) = real(model_day_int - sites(s)%cleafoffdate,r8) - hio_cleafon_si(io_si) = real(model_day_int - sites(s)%cleafondate,r8) - hio_dleafoff_si(io_si) = real(model_day_int - sites(s)%dleafoffdate,r8) - hio_dleafon_si(io_si) = real(model_day_int - sites(s)%dleafondate,r8) + hio_cleafoff_si(io_si) = real(sites(s)%phen_model_date - sites(s)%cleafoffdate,r8) + hio_cleafon_si(io_si) = real(sites(s)%phen_model_date - sites(s)%cleafondate,r8) + hio_dleafoff_si(io_si) = real(sites(s)%phen_model_date - sites(s)%dleafoffdate,r8) + hio_dleafon_si(io_si) = real(sites(s)%phen_model_date - sites(s)%dleafondate,r8) ! Mean liquid water content (m3/m3) used for drought phenology if(model_day_int>numWaterMem)then diff --git a/main/FatesRestartInterfaceMod.F90 b/main/FatesRestartInterfaceMod.F90 index c61c87fd4b..7de6fcb5aa 100644 --- a/main/FatesRestartInterfaceMod.F90 +++ b/main/FatesRestartInterfaceMod.F90 @@ -83,10 +83,11 @@ module FatesRestartInterfaceMod integer :: ir_dd_status_si integer :: ir_nchill_days_si integer :: ir_ncold_days_si - integer :: ir_leafondate_si - integer :: ir_leafoffdate_si + integer :: ir_cleafondate_si + integer :: ir_cleafoffdate_si integer :: ir_dleafondate_si integer :: ir_dleafoffdate_si + integer :: ir_phenmodeldate_si integer :: ir_acc_ni_si integer :: ir_gdd_si integer :: ir_snow_depth_si @@ -618,22 +619,26 @@ subroutine define_restart_vars(this, initialize_variables) long_name='cold day counter', units='unitless', flushval = flushinvalid, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_ncold_days_si ) - call this%set_restart_var(vname='fates_leafondate', vtype=site_int, & - long_name='the day of year for leaf on', units='day of year', flushval = flushinvalid, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_leafondate_si ) + call this%set_restart_var(vname='fates_cold_leafondate', vtype=site_int, & + long_name='the model day of last cold leaf on', units='absolute integer day', flushval = flushinvalid, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_cleafondate_si ) - call this%set_restart_var(vname='fates_leafoffdate', vtype=site_int, & - long_name='the day of year for leaf off', units='day of year', flushval = flushinvalid, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_leafoffdate_si ) + call this%set_restart_var(vname='fates_cold_leafoffdate', vtype=site_int, & + long_name='the model day last cold leaf off', units='absolute integer day', flushval = flushinvalid, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_cleafoffdate_si ) call this%set_restart_var(vname='fates_drought_leafondate', vtype=site_int, & - long_name='the day of year for drought based leaf-on', units='day of year', flushval = flushinvalid, & + long_name='the model day of last drought based leaf-on', units='absolute integer day', flushval = flushinvalid, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_dleafondate_si ) call this%set_restart_var(vname='fates_drought_leafoffdate', vtype=site_int, & - long_name='the day of year for drought based leaf-off', units='day of year', flushval = flushinvalid, & + long_name='the model day of last drought based leaf-off', units='absolute integer day', flushval = flushinvalid, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_dleafoffdate_si ) + call this%set_restart_var(vname='fates_phen_model_date', vtype=site_int, & + long_name='integer model day used for phen timing', units='absolute integer day', flushval = flushinvalid, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_phenmodeldate_si ) + call this%set_restart_var(vname='fates_acc_nesterov_id', vtype=site_r8, & long_name='a nesterov index accumulator', units='unitless', flushval = flushzero, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_acc_ni_si ) @@ -1752,10 +1757,11 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_dd_status_si => this%rvars(ir_dd_status_si)%int1d, & rio_nchill_days_si => this%rvars(ir_nchill_days_si)%int1d, & rio_ncold_days_si => this%rvars(ir_ncold_days_si)%int1d, & - rio_leafondate_si => this%rvars(ir_leafondate_si)%int1d, & - rio_leafoffdate_si => this%rvars(ir_leafoffdate_si)%int1d, & + rio_cleafondate_si => this%rvars(ir_cleafondate_si)%int1d, & + rio_cleafoffdate_si => this%rvars(ir_cleafoffdate_si)%int1d, & rio_dleafondate_si => this%rvars(ir_dleafondate_si)%int1d, & rio_dleafoffdate_si => this%rvars(ir_dleafoffdate_si)%int1d, & + rio_phenmodeldate_si => this%rvars(ir_phenmodeldate_si)%int1d, & rio_acc_ni_si => this%rvars(ir_acc_ni_si)%r81d, & rio_gdd_si => this%rvars(ir_gdd_si)%r81d, & rio_snow_depth_si => this%rvars(ir_snow_depth_si)%r81d, & @@ -2244,9 +2250,9 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_dd_status_si(io_idx_si) = sites(s)%dstatus rio_nchill_days_si(io_idx_si) = sites(s)%nchilldays rio_ncold_days_si(io_idx_si) = sites(s)%ncolddays - rio_leafondate_si(io_idx_si) = sites(s)%cleafondate - rio_leafoffdate_si(io_idx_si) = sites(s)%cleafoffdate - + rio_cleafondate_si(io_idx_si) = sites(s)%cleafondate + rio_cleafoffdate_si(io_idx_si) = sites(s)%cleafoffdate + rio_phenmodeldate_si(io_idx_si)= sites(s)%phen_model_date rio_dleafondate_si(io_idx_si) = sites(s)%dleafondate rio_dleafoffdate_si(io_idx_si) = sites(s)%dleafoffdate rio_acc_ni_si(io_idx_si) = sites(s)%acc_NI @@ -2591,10 +2597,11 @@ subroutine get_restart_vectors(this, nc, nsites, sites) rio_dd_status_si => this%rvars(ir_dd_status_si)%int1d, & rio_nchill_days_si => this%rvars(ir_nchill_days_si)%int1d, & rio_ncold_days_si => this%rvars(ir_ncold_days_si)%int1d, & - rio_leafondate_si => this%rvars(ir_leafondate_si)%int1d, & - rio_leafoffdate_si => this%rvars(ir_leafoffdate_si)%int1d, & + rio_cleafondate_si => this%rvars(ir_cleafondate_si)%int1d, & + rio_cleafoffdate_si => this%rvars(ir_cleafoffdate_si)%int1d, & rio_dleafondate_si => this%rvars(ir_dleafondate_si)%int1d, & rio_dleafoffdate_si => this%rvars(ir_dleafoffdate_si)%int1d, & + rio_phenmodeldate_si => this%rvars(ir_phenmodeldate_si)%int1d, & rio_acc_ni_si => this%rvars(ir_acc_ni_si)%r81d, & rio_gdd_si => this%rvars(ir_gdd_si)%r81d, & rio_snow_depth_si => this%rvars(ir_snow_depth_si)%r81d, & @@ -3109,14 +3116,14 @@ subroutine get_restart_vectors(this, nc, nsites, sites) sites(s)%dstatus = rio_dd_status_si(io_idx_si) sites(s)%nchilldays = rio_nchill_days_si(io_idx_si) sites(s)%ncolddays = rio_ncold_days_si(io_idx_si) - sites(s)%cleafondate = rio_leafondate_si(io_idx_si) - sites(s)%cleafoffdate = rio_leafoffdate_si(io_idx_si) + sites(s)%cleafondate = rio_cleafondate_si(io_idx_si) + sites(s)%cleafoffdate = rio_cleafoffdate_si(io_idx_si) sites(s)%dleafondate = rio_dleafondate_si(io_idx_si) sites(s)%dleafoffdate = rio_dleafoffdate_si(io_idx_si) sites(s)%acc_NI = rio_acc_ni_si(io_idx_si) sites(s)%grow_deg_days = rio_gdd_si(io_idx_si) + sites(s)%phen_model_date= rio_phenmodeldate_si(io_idx_si) sites(s)%snow_depth = rio_snow_depth_si(io_idx_si) - sites(s)%resources_management%trunk_product_site = rio_trunk_product_si(io_idx_si) end do From bed5e4052c61e4e35045dd3e9cffc628f1154843 Mon Sep 17 00:00:00 2001 From: Shijie Shu Date: Tue, 1 Nov 2022 11:30:49 -0700 Subject: [PATCH 11/20] Patch up some errors when merging with FATES API 24. --- biogeochem/EDLoggingMortalityMod.F90 | 18 +- biogeochem/EDMortalityFunctionsMod.F90 | 5 +- biogeochem/EDPatchDynamicsMod.F90 | 28 ++- main/EDMainMod.F90 | 20 +- main/EDTypesMod.F90 | 3 + main/FatesHistoryInterfaceMod.F90 | 277 +++++++++++++++++++++++-- main/FatesInterfaceTypesMod.F90 | 6 +- 7 files changed, 334 insertions(+), 23 deletions(-) diff --git a/biogeochem/EDLoggingMortalityMod.F90 b/biogeochem/EDLoggingMortalityMod.F90 index cf920cd429..8145191bcc 100644 --- a/biogeochem/EDLoggingMortalityMod.F90 +++ b/biogeochem/EDLoggingMortalityMod.F90 @@ -14,6 +14,7 @@ module EDLoggingMortalityMod ! ==================================================================================== use FatesConstantsMod , only : r8 => fates_r8 + use FatesConstantsMod , only : rsnbl_math_prec use EDTypesMod , only : ed_cohort_type use EDTypesMod , only : ed_patch_type use EDTypesMod , only : site_massbal_type @@ -94,6 +95,8 @@ module EDLoggingMortalityMod public :: logging_time public :: IsItLoggingTime public :: get_harvest_rate_area + public :: get_harvestable_carbon + public :: get_harvest_rate_carbon public :: UpdateHarvestC contains @@ -194,7 +197,9 @@ subroutine LoggingMortality_frac( pft_i, dbh, canopy_layer, lmort_direct, & hlm_harvest_rates, hlm_harvest_catnames, & hlm_harvest_units, & patch_anthro_disturbance_label, secondary_age, & - frac_site_primary) + frac_site_primary, harvestable_forest_c, & + harvest_tag) + ! Arguments integer, intent(in) :: pft_i ! pft index @@ -205,6 +210,9 @@ subroutine LoggingMortality_frac( pft_i, dbh, canopy_layer, lmort_direct, & integer, intent(in) :: hlm_harvest_units ! unit type of hlm harvest rates: [area vs. mass] integer, intent(in) :: patch_anthro_disturbance_label ! patch level anthro_disturbance_label real(r8), intent(in) :: secondary_age ! patch level age_since_anthro_disturbance + real(r8), intent(in) :: harvestable_forest_c(:) ! total harvestable forest carbon + ! of all hlm harvest categories + real(r8), intent(in) :: frac_site_primary real(r8), intent(out) :: lmort_direct ! direct (harvestable) mortality fraction real(r8), intent(out) :: lmort_collateral ! collateral damage mortality fraction real(r8), intent(out) :: lmort_infra ! infrastructure mortality fraction @@ -212,9 +220,11 @@ subroutine LoggingMortality_frac( pft_i, dbh, canopy_layer, lmort_direct, & ! but suffer from forest degradation (i.e. they ! are moved to newly-anthro-disturbed secondary ! forest patch) - real(r8), intent(in) :: frac_site_primary + integer, intent(out) :: harvest_tag(:) ! tag to record the harvest status, 0 - successful; + ! 1 - unsuccessful since not enough carbon ! Local variables + integer :: cur_harvest_tag ! the harvest tag of the cohort today real(r8) :: harvest_rate ! the final harvest rate to apply to this cohort today ! todo: probably lower the dbhmin default value to 30 cm @@ -252,6 +262,10 @@ subroutine LoggingMortality_frac( pft_i, dbh, canopy_layer, lmort_direct, & call get_harvest_rate_area (patch_anthro_disturbance_label, hlm_harvest_catnames, & hlm_harvest_rates, frac_site_primary, secondary_age, harvest_rate) + ! For area-based harvest, harvest_tag shall always be 0. + harvest_tag = 0 + cur_harvest_tag = 0 + if (fates_global_verbose()) then write(fates_log(), *) 'Successfully Read Harvest Rate from HLM.' end if diff --git a/biogeochem/EDMortalityFunctionsMod.F90 b/biogeochem/EDMortalityFunctionsMod.F90 index 40dc0fb067..8f4009512b 100644 --- a/biogeochem/EDMortalityFunctionsMod.F90 +++ b/biogeochem/EDMortalityFunctionsMod.F90 @@ -214,7 +214,8 @@ end subroutine mortality_rates ! ============================================================================ - subroutine Mortality_Derivative( currentSite, currentCohort, bc_in, frac_site_primary) + subroutine Mortality_Derivative( currentSite, currentCohort, bc_in, frac_site_primary, & + harvestable_forest_c, harvest_tag) ! ! !DESCRIPTION: @@ -262,7 +263,7 @@ subroutine Mortality_Derivative( currentSite, currentCohort, bc_in, frac_site_pr bc_in%hlm_harvest_units, & currentCohort%patchptr%anthro_disturbance_label, & currentCohort%patchptr%age_since_anthro_disturbance, & - frac_site_primary) + frac_site_primary, harvestable_forest_c, harvest_tag) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 022bed4ac6..95aaefa763 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -48,6 +48,7 @@ module EDPatchDynamicsMod use FatesInterfaceTypesMod , only : hlm_use_sp use FatesInterfaceTypesMod , only : hlm_use_nocomp use FatesInterfaceTypesMod , only : hlm_use_fixed_biogeog + use FatesInterfaceTypesMod , only : hlm_num_lu_harvest_cats use FatesGlobals , only : endrun => fates_endrun use FatesConstantsMod , only : r8 => fates_r8 use FatesConstantsMod , only : itrue, ifalse @@ -58,6 +59,8 @@ module EDPatchDynamicsMod use EDLoggingMortalityMod, only : logging_litter_fluxes use EDLoggingMortalityMod, only : logging_time use EDLoggingMortalityMod, only : get_harvest_rate_area + use EDLoggingMortalityMod, only : get_harvest_rate_carbon + use EDLoggingMortalityMod, only : get_harvestable_carbon use EDParamsMod , only : fates_mortality_disturbance_fraction use FatesAllometryMod , only : carea_allom use FatesAllometryMod , only : set_root_fraction @@ -70,6 +73,7 @@ module EDPatchDynamicsMod use FatesConstantsMod , only : n_anthro_disturbance_categories use FatesConstantsMod , only : fates_unset_r8 use FatesConstantsMod , only : fates_unset_int + use FatesConstantsMod , only : hlm_harvest_carbon use EDCohortDynamicsMod , only : InitPRTObject use EDCohortDynamicsMod , only : InitPRTBoundaryConditions use ChecksBalancesMod, only : SiteMassStock @@ -186,9 +190,15 @@ subroutine disturbance_rates( site_in, bc_in) real(r8) :: dist_rate_ldist_notharvested integer :: threshold_sizeclass integer :: i_dist + integer :: h_index real(r8) :: frac_site_primary real(r8) :: harvest_rate real(r8) :: tempsum + real(r8) :: harvestable_forest_c(hlm_num_lu_harvest_cats) + integer :: harvest_tag(hlm_num_lu_harvest_cats) + integer :: harvest_debt_primary + integer :: harvest_debt_secondary + integer :: patch_no_secondary !---------------------------------------------------------------------------------------------- ! Calculate Mortality Rates (these were previously calculated during growth derivatives) @@ -197,6 +207,10 @@ subroutine disturbance_rates( site_in, bc_in) ! first calculate the fractino of the site that is primary land call get_frac_site_primary(site_in, frac_site_primary) + + ! get available biomass for harvest for all patches + call get_harvestable_carbon(site_in, bc_in%site_area, bc_in%hlm_harvest_catnames, harvestable_forest_c) + harvest_debt_primary = 0 harvest_debt_secondary = 0 @@ -230,7 +244,9 @@ subroutine disturbance_rates( site_in, bc_in) bc_in%hlm_harvest_units, & currentPatch%anthro_disturbance_label, & currentPatch%age_since_anthro_disturbance, & - frac_site_primary) + frac_site_primary, & + harvestable_forest_c, & + harvest_tag) currentCohort%lmort_direct = lmort_direct currentCohort%lmort_collateral = lmort_collateral @@ -371,8 +387,14 @@ subroutine disturbance_rates( site_in, bc_in) (currentPatch%area - currentPatch%total_canopy_area) .gt. fates_tiny ) then ! The canopy is NOT closed. - call get_harvest_rate_area (currentPatch%anthro_disturbance_label, bc_in%hlm_harvest_catnames, & - bc_in%hlm_harvest_rates, frac_site_primary, currentPatch%age_since_anthro_disturbance, harvest_rate) + if(bc_in%hlm_harvest_units == hlm_harvest_carbon) then + call get_harvest_rate_carbon (currentPatch%anthro_disturbance_label, bc_in%hlm_harvest_catnames, & + bc_in%hlm_harvest_rates, currentPatch%age_since_anthro_disturbance, harvestable_forest_c, & + harvest_rate, harvest_tag) + else + call get_harvest_rate_area (currentPatch%anthro_disturbance_label, bc_in%hlm_harvest_catnames, & + bc_in%hlm_harvest_rates, frac_site_primary, currentPatch%age_since_anthro_disturbance, harvest_rate) + end if currentPatch%disturbance_rates(dtype_ilog) = currentPatch%disturbance_rates(dtype_ilog) + & (currentPatch%area - currentPatch%total_canopy_area) * harvest_rate / currentPatch%area diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index 7b9d623413..aa2670f534 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -80,6 +80,7 @@ module EDMainMod use FatesPlantHydraulicsMod , only : AccumulateMortalityWaterStorage use FatesAllometryMod , only : h_allom,tree_sai,tree_lai use EDLoggingMortalityMod , only : IsItLoggingTime + use EDLoggingMortalityMod , only : get_harvestable_carbon use EDPatchDynamicsMod , only : get_frac_site_primary use FatesGlobals , only : endrun => fates_endrun use ChecksBalancesMod , only : SiteMassStock @@ -303,6 +304,7 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) ! FIX(SPM,032414) refactor so everything goes through interface ! ! !USES: + use FatesInterfaceTypesMod, only : hlm_num_lu_harvest_cats use FatesInterfaceTypesMod, only : hlm_use_cohort_age_tracking use FatesConstantsMod, only : itrue ! !ARGUMENTS: @@ -333,9 +335,19 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) !----------------------------------------------------------------------- real(r8) :: frac_site_primary + real(r8) :: harvestable_forest_c(hlm_num_lu_harvest_cats) + integer :: harvest_tag(hlm_num_lu_harvest_cats) + call get_frac_site_primary(currentSite, frac_site_primary) + ! Clear site GPP and AR passing to HLM + bc_out%gpp_site = 0._r8 + bc_out%ar_site = 0._r8 + + ! Patch level biomass are required for C-based harvest + call get_harvestable_carbon(currentSite, bc_in%site_area, bc_in%hlm_harvest_catnames, harvestable_forest_c) + ! Set a pointer to this sites carbon12 mass balance site_cmass => currentSite%mass_balance(element_pos(carbon12_element)) @@ -369,7 +381,8 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) ft = currentCohort%pft ! Calculate the mortality derivatives - call Mortality_Derivative( currentSite, currentCohort, bc_in, frac_site_primary ) + call Mortality_Derivative( currentSite, currentCohort, bc_in, frac_site_primary, & + harvestable_forest_c, harvest_tag) ! ----------------------------------------------------------------------------- ! Apply Plant Allocation and Reactive Transport @@ -413,6 +426,11 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) currentCohort%gpp_acc_hold = currentCohort%gpp_acc * real(hlm_days_per_year,r8) currentCohort%resp_acc_hold = currentCohort%resp_acc * real(hlm_days_per_year,r8) + ! Passing gpp_acc_hold to HLM + bc_out%gpp_site = bc_out%gpp_site + currentCohort%gpp_acc_hold * & + AREA_INV * currentCohort%n / hlm_days_per_year / sec_per_day + bc_out%ar_site = bc_out%ar_site + currentCohort%resp_acc_hold * & + AREA_INV * currentCohort%n / hlm_days_per_year / sec_per_day ! Conduct Maintenance Turnover (parteh) if(debug) call currentCohort%prt%CheckMassConservation(ft,3) diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 6f3bf6ee52..df2a75b44b 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -585,6 +585,9 @@ module EDTypesMod type, public :: ed_resources_management_type real(r8) :: trunk_product_site ! Actual trunk product at site level KgC/site + real(r8) :: harvest_debt ! the amount of kgC per site that did not successfully harvested + real(r8) :: harvest_debt_sec ! the amount of kgC per site from secondary patches that did + ! not successfully harvested !debug variables real(r8) :: delta_litter_stock ! kgC/site = kgC/ha diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 829a683ecd..8b8fb053e1 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -276,6 +276,12 @@ module FatesHistoryInterfaceMod integer :: ih_canopy_biomass_si integer :: ih_understory_biomass_si + integer :: ih_npp_secondary_si + integer :: ih_gpp_secondary_si + integer :: ih_aresp_secondary_si + integer :: ih_maint_resp_secondary_si + integer :: ih_growth_resp_secondary_si + integer :: ih_primaryland_fusion_error_si integer :: ih_disturbance_rate_p2p_si integer :: ih_disturbance_rate_p2s_si @@ -285,6 +291,8 @@ module FatesHistoryInterfaceMod integer :: ih_fall_disturbance_rate_si integer :: ih_potential_disturbance_rate_si integer :: ih_harvest_carbonflux_si + integer :: ih_harvest_debt_si + integer :: ih_harvest_debt_sec_si ! Indices to site by size-class by age variables integer :: ih_nplant_si_scag @@ -305,7 +313,7 @@ module FatesHistoryInterfaceMod ! Indices to (site) variables integer :: ih_tveg24_si - integer :: ih_tveg_si + !integer :: ih_tveg_si integer :: ih_nep_si integer :: ih_hr_si @@ -320,7 +328,9 @@ module FatesHistoryInterfaceMod integer :: ih_err_fates_si integer :: ih_npatches_si + integer :: ih_npatches_sec_si integer :: ih_ncohorts_si + integer :: ih_ncohorts_sec_si integer :: ih_demotion_carbonflux_si integer :: ih_promotion_carbonflux_si integer :: ih_canopy_mortality_carbonflux_si @@ -448,6 +458,7 @@ module FatesHistoryInterfaceMod integer :: ih_ddbh_understory_si_scls integer :: ih_agb_si_scls integer :: ih_biomass_si_scls + integer :: ih_mortality_canopy_secondary_si_scls ! mortality vars integer :: ih_m1_si_scls @@ -461,6 +472,14 @@ module FatesHistoryInterfaceMod integer :: ih_m9_si_scls integer :: ih_m10_si_scls + integer :: ih_m1_sec_si_scls + integer :: ih_m2_sec_si_scls + integer :: ih_m3_sec_si_scls + integer :: ih_m7_sec_si_scls + integer :: ih_m8_sec_si_scls + integer :: ih_m9_sec_si_scls + integer :: ih_m10_sec_si_scls + integer :: ih_m10_si_cacls integer :: ih_nplant_si_cacls @@ -510,9 +529,11 @@ module FatesHistoryInterfaceMod ! indices to (site x pft) variables integer :: ih_biomass_si_pft + integer :: ih_biomass_sec_si_pft integer :: ih_leafbiomass_si_pft integer :: ih_storebiomass_si_pft integer :: ih_nindivs_si_pft + integer :: ih_nindivs_sec_si_pft integer :: ih_recruitment_si_pft integer :: ih_mortality_si_pft integer :: ih_mortality_carbonflux_si_pft @@ -522,7 +543,9 @@ module FatesHistoryInterfaceMod integer :: ih_crownarea_si_pft integer :: ih_canopycrownarea_si_pft integer :: ih_gpp_si_pft + integer :: ih_gpp_sec_si_pft integer :: ih_npp_si_pft + integer :: ih_npp_sec_si_pft integer :: ih_nocomp_pftpatchfraction_si_pft integer :: ih_nocomp_pftnpatches_si_pft integer :: ih_nocomp_pftburnedarea_si_pft @@ -546,6 +569,8 @@ module FatesHistoryInterfaceMod integer :: ih_fire_intensity_si_age integer :: ih_fire_sum_fuel_si_age + integer :: ih_lai_secondary_si + ! indices to (site x height) variables integer :: ih_canopy_height_dist_si_height integer :: ih_leaf_height_dist_si_height @@ -1802,16 +1827,20 @@ subroutine update_history_dyn(this,nc,nsites,sites) integer :: tmp associate( hio_npatches_si => this%hvars(ih_npatches_si)%r81d, & + hio_npatches_sec_si => this%hvars(ih_npatches_sec_si)%r81d, & hio_ncohorts_si => this%hvars(ih_ncohorts_si)%r81d, & + hio_ncohorts_sec_si => this%hvars(ih_ncohorts_sec_si)%r81d, & hio_trimming_si => this%hvars(ih_trimming_si)%r81d, & hio_area_plant_si => this%hvars(ih_area_plant_si)%r81d, & hio_area_trees_si => this%hvars(ih_area_trees_si)%r81d, & hio_fates_fraction_si => this%hvars(ih_fates_fraction_si)%r81d, & hio_canopy_spread_si => this%hvars(ih_canopy_spread_si)%r81d, & hio_biomass_si_pft => this%hvars(ih_biomass_si_pft)%r82d, & + hio_biomass_sec_si_pft => this%hvars(ih_biomass_sec_si_pft)%r82d, & hio_leafbiomass_si_pft => this%hvars(ih_leafbiomass_si_pft)%r82d, & hio_storebiomass_si_pft => this%hvars(ih_storebiomass_si_pft)%r82d, & hio_nindivs_si_pft => this%hvars(ih_nindivs_si_pft)%r82d, & + hio_nindivs_sec_si_pft => this%hvars(ih_nindivs_sec_si_pft)%r82d, & hio_recruitment_si_pft => this%hvars(ih_recruitment_si_pft)%r82d, & hio_mortality_si_pft => this%hvars(ih_mortality_si_pft)%r82d, & hio_mortality_carbonflux_si_pft => this%hvars(ih_mortality_carbonflux_si_pft)%r82d, & @@ -1821,7 +1850,9 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_crownarea_si_pft => this%hvars(ih_crownarea_si_pft)%r82d, & hio_canopycrownarea_si_pft => this%hvars(ih_canopycrownarea_si_pft)%r82d, & hio_gpp_si_pft => this%hvars(ih_gpp_si_pft)%r82d, & + hio_gpp_sec_si_pft => this%hvars(ih_gpp_sec_si_pft)%r82d, & hio_npp_si_pft => this%hvars(ih_npp_si_pft)%r82d, & + hio_npp_sec_si_pft => this%hvars(ih_npp_sec_si_pft)%r82d, & hio_nesterov_fire_danger_si => this%hvars(ih_nesterov_fire_danger_si)%r81d, & hio_fire_nignitions_si => this%hvars(ih_fire_nignitions_si)%r81d, & hio_fire_fdi_si => this%hvars(ih_fire_fdi_si)%r81d, & @@ -1862,6 +1893,8 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_fall_disturbance_rate_si => this%hvars(ih_fall_disturbance_rate_si)%r81d, & hio_potential_disturbance_rate_si => this%hvars(ih_potential_disturbance_rate_si)%r81d, & hio_harvest_carbonflux_si => this%hvars(ih_harvest_carbonflux_si)%r81d, & + hio_harvest_debt_si => this%hvars(ih_harvest_debt_si)%r81d, & + hio_harvest_debt_sec_si => this%hvars(ih_harvest_debt_sec_si)%r81d, & hio_gpp_si_scpf => this%hvars(ih_gpp_si_scpf)%r82d, & hio_npp_totl_si_scpf => this%hvars(ih_npp_totl_si_scpf)%r82d, & hio_npp_leaf_si_scpf => this%hvars(ih_npp_leaf_si_scpf)%r82d, & @@ -1885,6 +1918,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_lai_canopy_si_scpf => this%hvars(ih_lai_canopy_si_scpf)%r82d, & hio_lai_understory_si_scpf => this%hvars(ih_lai_understory_si_scpf)%r82d, & hio_mortality_canopy_si_scpf => this%hvars(ih_mortality_canopy_si_scpf)%r82d, & + hio_mortality_canopy_secondary_si_scls => this%hvars(ih_mortality_canopy_secondary_si_scls)%r82d, & hio_mortality_understory_si_scpf => this%hvars(ih_mortality_understory_si_scpf)%r82d, & hio_nplant_canopy_si_scpf => this%hvars(ih_nplant_canopy_si_scpf)%r82d, & hio_nplant_understory_si_scpf => this%hvars(ih_nplant_understory_si_scpf)%r82d, & @@ -1934,6 +1968,14 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_m10_si_scls => this%hvars(ih_m10_si_scls)%r82d, & hio_m10_si_cacls => this%hvars(ih_m10_si_cacls)%r82d, & + hio_m1_sec_si_scls => this%hvars(ih_m1_sec_si_scls)%r82d, & + hio_m2_sec_si_scls => this%hvars(ih_m2_sec_si_scls)%r82d, & + hio_m3_sec_si_scls => this%hvars(ih_m3_sec_si_scls)%r82d, & + hio_m7_sec_si_scls => this%hvars(ih_m7_sec_si_scls)%r82d, & + hio_m8_sec_si_scls => this%hvars(ih_m8_sec_si_scls)%r82d, & + hio_m9_sec_si_scls => this%hvars(ih_m9_sec_si_scls)%r82d, & + hio_m10_sec_si_scls => this%hvars(ih_m10_sec_si_scls)%r82d, & + hio_c13disc_si_scpf => this%hvars(ih_c13disc_si_scpf)%r82d, & hio_cwd_elcwd => this%hvars(ih_cwd_elcwd)%r82d, & @@ -1998,6 +2040,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_yesterdaycanopylevel_understory_si_scls => this%hvars(ih_yesterdaycanopylevel_understory_si_scls)%r82d, & hio_area_si_age => this%hvars(ih_area_si_age)%r82d, & hio_lai_si_age => this%hvars(ih_lai_si_age)%r82d, & + hio_lai_secondary_si => this%hvars(ih_lai_secondary_si)%r81d, & hio_canopy_area_si_age => this%hvars(ih_canopy_area_si_age)%r82d, & hio_ncl_si_age => this%hvars(ih_ncl_si_age)%r82d, & hio_npatches_si_age => this%hvars(ih_npatches_si_age)%r82d, & @@ -2172,6 +2215,9 @@ subroutine update_history_dyn(this,nc,nsites,sites) ! Increment the number of patches per site hio_npatches_si(io_si) = hio_npatches_si(io_si) + 1._r8 + if ( cpatch%anthro_disturbance_label .eq. secondaryforest ) then + hio_npatches_sec_si(io_si) = hio_npatches_sec_si(io_si) + 1._r8 + end if cpatch%age_class = get_age_class_index(cpatch%age) @@ -2283,6 +2329,10 @@ subroutine update_history_dyn(this,nc,nsites,sites) ! Increment the number of cohorts per site hio_ncohorts_si(io_si) = hio_ncohorts_si(io_si) + 1._r8 + if ( cpatch%anthro_disturbance_label .eq. secondaryforest ) then + hio_ncohorts_sec_si(io_si) = hio_ncohorts_sec_si(io_si) + 1._r8 + end if + n_perm2 = ccohort%n * AREA_INV hio_canopy_area_si_age(io_si,cpatch%age_class) = hio_canopy_area_si_age(io_si,cpatch%age_class) & @@ -2375,9 +2425,19 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_nindivs_si_pft(io_si,ft) = hio_nindivs_si_pft(io_si,ft) + & ccohort%n * AREA_INV + if ( cpatch%anthro_disturbance_label .eq. secondaryforest ) then + hio_nindivs_sec_si_pft(io_si,ft) = hio_nindivs_sec_si_pft(io_si,ft) + & + ccohort%n * AREA_INV + end if + hio_biomass_si_pft(io_si, ft) = hio_biomass_si_pft(io_si, ft) + & (ccohort%n * AREA_INV) * total_m + if ( cpatch%anthro_disturbance_label .eq. secondaryforest ) then + hio_biomass_sec_si_pft(io_si, ft) = hio_biomass_sec_si_pft(io_si, ft) + & + (ccohort%n * AREA_INV) * total_m + end if + ! update total biomass per age bin hio_biomass_si_age(io_si,cpatch%age_class) = hio_biomass_si_age(io_si,cpatch%age_class) & + total_m * ccohort%n * AREA_INV @@ -2460,6 +2520,13 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_npp_si_pft(io_si, ft) = hio_npp_si_pft(io_si, ft) + & ccohort%npp_acc_hold * n_perm2 / days_per_year / sec_per_day + if ( cpatch%anthro_disturbance_label .eq. secondaryforest ) then + hio_gpp_sec_si_pft(io_si, ft) = hio_gpp_sec_si_pft(io_si, ft) + & + ccohort%gpp_acc_hold * n_perm2 / days_per_year / sec_per_day + hio_npp_sec_si_pft(io_si, ft) = hio_npp_sec_si_pft(io_si, ft) + & + ccohort%npp_acc_hold * n_perm2 / days_per_year / sec_per_day + end if + ! Site by Size-Class x PFT (SCPF) ! ------------------------------------------------------------------------ @@ -2592,7 +2659,24 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_m8_si_scls(io_si,scls) = hio_m8_si_scls(io_si,scls) + & ccohort%frmort*ccohort%n / m2_per_ha hio_m9_si_scls(io_si,scls) = hio_m9_si_scls(io_si,scls) + ccohort%smort*ccohort%n / m2_per_ha + ! Examine secondary forest mortality and mortality rates + if(cpatch%anthro_disturbance_label .eq. secondaryforest) then + + if (hlm_use_cohort_age_tracking .eq.itrue) then + hio_m10_sec_si_scls(io_si,scls) = hio_m10_sec_si_scls(io_si,scls) + & + ccohort%asmort*ccohort%n / m2_per_ha + end if + + hio_m1_sec_si_scls(io_si,scls) = hio_m1_sec_si_scls(io_si,scls) + ccohort%bmort*ccohort%n / m2_per_ha + hio_m2_sec_si_scls(io_si,scls) = hio_m2_sec_si_scls(io_si,scls) + ccohort%hmort*ccohort%n / m2_per_ha + hio_m3_sec_si_scls(io_si,scls) = hio_m3_sec_si_scls(io_si,scls) + ccohort%cmort*ccohort%n / m2_per_ha + hio_m7_sec_si_scls(io_si,scls) = hio_m7_sec_si_scls(io_si,scls) + & + (ccohort%lmort_direct+ccohort%lmort_collateral+ccohort%lmort_infra) * ccohort%n / m2_per_ha + hio_m8_sec_si_scls(io_si,scls) = hio_m8_sec_si_scls(io_si,scls) + & + ccohort%frmort*ccohort%n / m2_per_ha + hio_m9_sec_si_scls(io_si,scls) = hio_m9_sec_si_scls(io_si,scls) + ccohort%smort*ccohort%n / m2_per_ha + end if !C13 discrimination if(gpp_cached + ccohort%gpp_acc_hold > 0.0_r8)then @@ -2787,6 +2871,15 @@ subroutine update_history_dyn(this,nc,nsites,sites) (ccohort%lmort_direct + ccohort%lmort_collateral + ccohort%lmort_infra) * & ccohort%n * sec_per_day * days_per_year / m2_per_ha + if ( cpatch%anthro_disturbance_label .eq. secondaryforest ) then + hio_mortality_canopy_secondary_si_scls(io_si,scls) = hio_mortality_canopy_secondary_si_scls(io_si,scls) + & + (ccohort%bmort + ccohort%hmort + ccohort%cmort + & + ccohort%frmort + ccohort%smort + ccohort%asmort) * ccohort%n / m2_per_ha + & + (ccohort%lmort_direct + ccohort%lmort_collateral + ccohort%lmort_infra) * & + ccohort%n * sec_per_day * days_per_year / m2_per_ha + end if + + hio_nplant_understory_si_scpf(io_si,scpf) = hio_nplant_understory_si_scpf(io_si,scpf) + ccohort%n / m2_per_ha hio_nplant_understory_si_scls(io_si,scls) = hio_nplant_understory_si_scls(io_si,scls) + ccohort%n / m2_per_ha hio_lai_understory_si_scls(io_si,scls) = hio_lai_understory_si_scls(io_si,scls) + & @@ -3566,10 +3659,15 @@ subroutine update_history_hifrq(this,nc,nsites,sites,bc_in,dt_tstep) real(r8) :: per_dt_tstep ! Time step in frequency units (/s) associate( hio_gpp_si => this%hvars(ih_gpp_si)%r81d, & + hio_gpp_secondary_si => this%hvars(ih_gpp_secondary_si)%r81d, & hio_npp_si => this%hvars(ih_npp_si)%r81d, & + hio_npp_secondary_si => this%hvars(ih_npp_secondary_si)%r81d, & hio_aresp_si => this%hvars(ih_aresp_si)%r81d, & + hio_aresp_secondary_si => this%hvars(ih_aresp_secondary_si)%r81d, & hio_maint_resp_si => this%hvars(ih_maint_resp_si)%r81d, & + hio_maint_resp_secondary_si => this%hvars(ih_maint_resp_secondary_si)%r81d, & hio_growth_resp_si => this%hvars(ih_growth_resp_si)%r81d, & + hio_growth_resp_secondary_si => this%hvars(ih_growth_resp_secondary_si)%r81d, & hio_c_stomata_si => this%hvars(ih_c_stomata_si)%r81d, & hio_c_lblayer_si => this%hvars(ih_c_lblayer_si)%r81d, & hio_rad_error_si => this%hvars(ih_rad_error_si)%r81d, & @@ -3634,8 +3732,8 @@ subroutine update_history_hifrq(this,nc,nsites,sites,bc_in,dt_tstep) hio_fabi_sun_top_si_can => this%hvars(ih_fabi_sun_top_si_can)%r82d, & hio_fabi_sha_top_si_can => this%hvars(ih_fabi_sha_top_si_can)%r82d, & hio_parsun_top_si_can => this%hvars(ih_parsun_top_si_can)%r82d, & - hio_parsha_top_si_can => this%hvars(ih_parsha_top_si_can)%r82d, & - hio_tveg => this%hvars(ih_tveg_si)%r81d) + hio_parsha_top_si_can => this%hvars(ih_parsha_top_si_can)%r82d)!, & + !hio_tveg => this%hvars(ih_tveg_si)%r81d) ! Flush the relevant history variables call this%flush_hvars(nc,upfreq_in=2) @@ -3690,12 +3788,12 @@ subroutine update_history_hifrq(this,nc,nsites,sites,bc_in,dt_tstep) hio_rad_error_si(io_si) = hio_rad_error_si(io_si) + & cpatch%radiation_error * cpatch%area * AREA_INV - ! Only accumulate the instantaneous vegetation temperature for vegetated patches - if (cpatch%patchno .ne. 0) then - hio_tveg(io_si) = hio_tveg(io_si) + & - (bc_in(s)%t_veg_pa(cpatch%patchno) - t_water_freeze_k_1atm) * & - cpatch%area / site_area_veg - end if + ! ! Only accumulate the instantaneous vegetation temperature for vegetated patches + ! if (cpatch%patchno .ne. 0) then + ! hio_tveg(io_si) = hio_tveg(io_si) + & + ! (bc_in(s)%t_veg_pa(cpatch%patchno) - t_water_freeze_k_1atm) * & + ! cpatch%area / site_area_veg + ! end if ccohort => cpatch%shortest do while(associated(ccohort)) @@ -3725,6 +3823,21 @@ subroutine update_history_hifrq(this,nc,nsites,sites,bc_in,dt_tstep) hio_maint_resp_si(io_si) = hio_maint_resp_si(io_si) + & ccohort%resp_m * n_perm2 * per_dt_tstep + ! Secondary forest only + if ( cpatch%anthro_disturbance_label .eq. secondaryforest ) then + hio_npp_secondary_si(io_si) = hio_npp_secondary_si(io_si) + & + npp * n_perm2 * per_dt_tstep + hio_gpp_secondary_si(io_si) = hio_gpp_secondary_si(io_si) + & + ccohort%gpp_tstep * n_perm2 * per_dt_tstep + hio_aresp_secondary_si(io_si) = hio_aresp_secondary_si(io_si) + & + aresp * n_perm2 * per_dt_tstep + hio_growth_resp_secondary_si(io_si) = hio_growth_resp_secondary_si(io_si) + & + resp_g * n_perm2 * per_dt_tstep + hio_maint_resp_secondary_si(io_si) = hio_maint_resp_secondary_si(io_si) + & + ccohort%resp_m * n_perm2 * per_dt_tstep + end if + + ! Add up the total Net Ecosystem Production ! for this timestep. [kgC/m2/s] hio_nep_si(io_si) = hio_nep_si(io_si) + & @@ -4448,6 +4561,18 @@ subroutine define_history_vars(this, initialize_variables) upfreq=1, ivar=ivar, initialize=initialize_variables, & index=ih_ncohorts_si) + call this%set_history_var(vname='FATES_NPATCHES_SECONDARY', units='', & + long='total number of patches per site', use_default='active', & + avgflag='A', vtype=site_r8, hlms='CLM:ALM', & + upfreq=1, ivar=ivar, initialize=initialize_variables, & + index=ih_npatches_sec_si) + + call this%set_history_var(vname='FATES_NCOHORTS_SECONDARY', units='', & + long='total number of cohorts per site', use_default='active', & + avgflag='A', vtype=site_r8, hlms='CLM:ALM', & + upfreq=1, ivar=ivar, initialize=initialize_variables, & + index=ih_ncohorts_sec_si) + ! Patch variables call this%set_history_var(vname='FATES_TRIMMING', units='1', & long='degree to which canopy expansion is limited by leaf economics (0-1)', & @@ -4546,6 +4671,12 @@ subroutine define_history_vars(this, initialize_variables) upfreq=1, ivar=ivar, initialize=initialize_variables, & index=ih_biomass_si_pft) + call this%set_history_var(vname='FATES_VEGC_SE_PF', units='kg m-2', & + long='total PFT-level biomass in kg of carbon per land area, secondary patches', & + use_default='active', avgflag='A', vtype=site_pft_r8, hlms='CLM:ALM', & + upfreq=1, ivar=ivar, initialize=initialize_variables, & + index=ih_biomass_sec_si_pft) + call this%set_history_var(vname='FATES_LEAFC_PF', units='kg m-2', & long='total PFT-level leaf biomass in kg carbon per m2 land area', & use_default='active', avgflag='A', vtype=site_pft_r8, hlms='CLM:ALM', & @@ -4582,12 +4713,30 @@ subroutine define_history_vars(this, initialize_variables) upfreq=1, ivar=ivar, initialize=initialize_variables, & index=ih_npp_si_pft) + call this%set_history_var(vname='FATES_GPP_SE_PF', units='kg m-2 s-1', & + long='total PFT-level GPP in kg carbon per m2 land area per second, secondary patches', & + use_default='active', avgflag='A', vtype=site_pft_r8, hlms='CLM:ALM', & + upfreq=1, ivar=ivar, initialize=initialize_variables, & + index=ih_gpp_sec_si_pft) + + call this%set_history_var(vname='FATES_NPP_SE_PF', units='kg m-2 yr-1', & + long='total PFT-level NPP in kg carbon per m2 land area per second, secondary patches', & + use_default='active', avgflag='A', vtype=site_pft_r8, hlms='CLM:ALM', & + upfreq=1, ivar=ivar, initialize=initialize_variables, & + index=ih_npp_sec_si_pft) + call this%set_history_var(vname='FATES_NPLANT_PF', units='m-2', & long='total PFT-level number of individuals per m2 land area', & use_default='active', avgflag='A', vtype=site_pft_r8, hlms='CLM:ALM', & upfreq=1, ivar=ivar, initialize=initialize_variables, & index=ih_nindivs_si_pft) + call this%set_history_var(vname='FATES_NPLANT_SEC_PF', units='m-2', & + long='total PFT-level number of individuals per m2 land area, secondary patches', & + use_default='active', avgflag='A', vtype=site_pft_r8, hlms='CLM:ALM', & + upfreq=1, ivar=ivar, initialize=initialize_variables, & + index=ih_nindivs_sec_si_pft) + call this%set_history_var(vname='FATES_RECRUITMENT_PF', & units='m-2 yr-1', & long='PFT-level recruitment rate in number of individuals per m2 land area per year', & @@ -4633,6 +4782,12 @@ subroutine define_history_vars(this, initialize_variables) upfreq=1, ivar=ivar, initialize=initialize_variables, & index=ih_lai_si_age) + call this%set_history_var(vname='FATES_LAI_SECONDARY', units='m2 m-2', & + long='leaf area index per m2 land area, secondary patches', & + use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & + upfreq=1, ivar=ivar, initialize=initialize_variables, & + index=ih_lai_secondary_si) + call this%set_history_var(vname='FATES_CANOPYAREA_AP', units='m2 m-2', & long='canopy area by age bin per m2 land area', use_default='active', & avgflag='A', vtype=site_age_r8, hlms='CLM:ALM', upfreq=1, ivar=ivar, & @@ -5205,11 +5360,11 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=site_r8, hlms='CLM:ALM', upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_tveg24_si ) - call this%set_history_var(vname='FATES_TVEG', units='degree_Celsius', & - long='fates instantaneous mean vegetation temperature by site', & - use_default='active', & - avgflag='A', vtype=site_r8, hlms='CLM:ALM', upfreq=2, & - ivar=ivar, initialize=initialize_variables, index = ih_tveg_si ) + ! call this%set_history_var(vname='FATES_TVEG', units='degree_Celsius', & + ! long='fates instantaneous mean vegetation temperature by site', & + ! use_default='active', & + ! avgflag='A', vtype=site_r8, hlms='CLM:ALM', upfreq=2, & + ! ivar=ivar, initialize=initialize_variables, index = ih_tveg_si ) ! radiation error @@ -5218,6 +5373,17 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=site_r8, hlms='CLM:ALM', upfreq=2, & ivar=ivar, initialize=initialize_variables, index = ih_rad_error_si) + call this%set_history_var(vname='FATES_HARVEST_DEBT', units='kg C', & + long='Accumulated carbon failed to be harvested', use_default='active', & + avgflag='A', vtype=site_r8, hlms='CLM:ALM', upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_harvest_debt_si ) + + call this%set_history_var(vname='FATES_HARVEST_DEBT_SEC', units='kg C', & + long='Accumulated carbon failed to be harvested from secondary patches', use_default='active', & + avgflag='A', vtype=site_r8, hlms='CLM:ALM', upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_harvest_debt_sec_si ) + + ! Ecosystem Carbon Fluxes (updated rapidly, upfreq=2) @@ -5226,28 +5392,55 @@ subroutine define_history_vars(this, initialize_variables) use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & upfreq=2, ivar=ivar, initialize=initialize_variables, index = ih_npp_si) + call this%set_history_var(vname='FATES_NPP_SECONDARY', units='kg m-2 s-1', & + long='net primary production in kg carbon per m2 per second, secondary patches', & + use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & + upfreq=2, ivar=ivar, initialize=initialize_variables, index = ih_npp_secondary_si) + call this%set_history_var(vname='FATES_GPP', units='kg m-2 s-1', & long='gross primary production in kg carbon per m2 per second', & use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & upfreq=2, ivar=ivar, initialize=initialize_variables, index = ih_gpp_si) + call this%set_history_var(vname='FATES_GPP_SECONDARY', units='kg m-2 s-1', & + long='gross primary production in kg carbon per m2 per second, secondary patches', & + use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & + upfreq=2, ivar=ivar, initialize=initialize_variables, index = ih_gpp_secondary_si) + call this%set_history_var(vname='FATES_AUTORESP', units='kg m-2 s-1', & long='autotrophic respiration in kg carbon per m2 per second', & use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & upfreq=2, ivar=ivar, initialize=initialize_variables, index = ih_aresp_si) + call this%set_history_var(vname='FATES_AUTORESP_SECONDARY', units='kg m-2 s-1', & + long='autotrophic respiration in kg carbon per m2 per second, secondary patches', & + use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & + upfreq=2, ivar=ivar, initialize=initialize_variables, index = ih_aresp_secondary_si) + call this%set_history_var(vname='FATES_GROWTH_RESP', units='kg m-2 s-1', & long='growth respiration in kg carbon per m2 per second', & use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & upfreq=2, ivar=ivar, initialize=initialize_variables, & index = ih_growth_resp_si) + call this%set_history_var(vname='FATES_GROWTH_RESP_SECONDARY', units='kg m-2 s-1', & + long='growth respiration in kg carbon per m2 per second, secondary patches', & + use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & + upfreq=2, ivar=ivar, initialize=initialize_variables, & + index = ih_growth_resp_secondary_si) + call this%set_history_var(vname='FATES_MAINT_RESP', units='kg m-2 s-1', & long='maintenance respiration in kg carbon per m2 land area per second', & use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & upfreq=2, ivar=ivar, initialize=initialize_variables, & index = ih_maint_resp_si) + call this%set_history_var(vname='FATES_MAINT_RESP_SECONDARY', units='kg m-2 s-1', & + long='maintenance respiration in kg carbon per m2 land area per second', & + use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & + upfreq=2, ivar=ivar, initialize=initialize_variables, & + index = ih_maint_resp_secondary_si) + ! Canopy resistance call this%set_history_var(vname='FATES_STOMATAL_COND_AP', & @@ -6127,6 +6320,13 @@ subroutine define_history_vars(this, initialize_variables) hlms='CLM:ALM', upfreq=1, ivar=ivar, & initialize=initialize_variables, index = ih_mortality_canopy_si_scls) + call this%set_history_var(vname='FATES_MORTALITY_CANOPY_SE_SZ', & + units = 'm-2 yr-1', & + long='total mortality of canopy trees by size class in number of plants per m2, secondary patches', & + use_default='active', avgflag='A', vtype=site_size_r8, & + hlms='CLM:ALM', upfreq=1, ivar=ivar, & + initialize=initialize_variables, index = ih_mortality_canopy_secondary_si_scls) + call this%set_history_var(vname='FATES_NPLANT_USTORY_SZ', & units = 'm-2', & long='number of understory plants per m2 by size class', & @@ -6180,6 +6380,27 @@ subroutine define_history_vars(this, initialize_variables) hlms='CLM:ALM', upfreq=1, ivar=ivar, & initialize=initialize_variables, index = ih_m3_si_scls) + call this%set_history_var(vname='FATES_MORTALITY_BACKGROUND_SE_SZ', & + units = 'm-2 yr-1', & + long='background mortality by size in number of plants per m2 per year, secondary patches', & + use_default='active', avgflag='A', vtype=site_size_r8, & + hlms='CLM:ALM', upfreq=1, ivar=ivar, & + initialize=initialize_variables, index = ih_m1_sec_si_scls) + + call this%set_history_var(vname='FATES_MORTALITY_HYDRAULIC_SE_SZ', & + units = 'm-2 yr-1', & + long='hydraulic mortality by size in number of plants per m2 per year, secondary patches', & + use_default='active', avgflag='A', vtype=site_size_r8, & + hlms='CLM:ALM', upfreq=1, ivar=ivar, & + initialize=initialize_variables, index = ih_m2_sec_si_scls) + + call this%set_history_var(vname='FATES_MORTALITY_CSTARV_SE_SZ', & + units = 'm-2 yr-1', & + long='carbon starvation mortality by size in number of plants per m2 per year, secondary patches', & + use_default='active', avgflag='A', vtype=site_size_r8, & + hlms='CLM:ALM', upfreq=1, ivar=ivar, & + initialize=initialize_variables, index = ih_m3_sec_si_scls) + call this%set_history_var(vname='FATES_MORTALITY_IMPACT_SZ', & units = 'm-2 yr-1', & long='impact mortality by size in number of plants per m2 per year', & @@ -6236,6 +6457,34 @@ subroutine define_history_vars(this, initialize_variables) hlms='CLM:ALM', upfreq=1, ivar=ivar, & initialize=initialize_variables, index = ih_m10_si_cacls) + call this%set_history_var(vname='FATES_MORTALITY_LOGGING_SE_SZ', & + units = 'm-2 yr-1', & + long='logging mortality by size in number of plants per m2 per event, secondary patches', & + use_default='active', avgflag='A', vtype=site_size_r8, & + hlms='CLM:ALM', upfreq=1, ivar=ivar, & + initialize=initialize_variables, index = ih_m7_sec_si_scls) + + call this%set_history_var(vname='FATES_MORTALITY_FREEZING_SE_SZ', & + units = 'm-2 event-1', & + long='freezing mortality by size in number of plants per m2 per event, secondary patches', & + use_default='active', avgflag='A', vtype=site_size_r8, & + hlms='CLM:ALM', upfreq=1, ivar=ivar, & + initialize=initialize_variables, index = ih_m8_sec_si_scls) + + call this%set_history_var(vname='FATES_MORTALITY_SENESCENCE_SE_SZ', & + units = 'm-2 yr-1', & + long='senescence mortality by size in number of plants per m2 per event, secondary patches', & + use_default='active', avgflag='A', vtype=site_size_r8, & + hlms='CLM:ALM', upfreq=1, ivar=ivar, & + initialize=initialize_variables, index = ih_m9_sec_si_scls) + + call this%set_history_var(vname='FATES_MORTALITY_AGESCEN_SE_SZ', & + units = 'm-2 yr-1', & + long='age senescence mortality by size in number of plants per m2 per year, secondary patches', & + use_default='active', avgflag='A', vtype=site_size_r8, & + hlms='CLM:ALM', upfreq=1, ivar=ivar, & + initialize=initialize_variables, index = ih_m10_sec_si_scls) + call this%set_history_var(vname='FATES_NPP_CANOPY_SZ', units = 'kg m-2 s-1', & long='NPP of canopy plants by size class in kg carbon per m2 per second', & use_default='inactive', avgflag='A', vtype=site_size_r8, & diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index f08fba4ce8..0b6eda45c8 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -532,6 +532,8 @@ module FatesInterfaceTypesMod integer :: hlm_harvest_units ! what units are the harvest rates specified in? [area vs carbon] + real(r8) :: site_area ! Actual area of current site [m2], only used in carbon-based harvest + ! Fixed biogeography mode real(r8), allocatable :: pft_areafrac(:) ! Fractional area of the FATES column occupied by each PFT @@ -725,7 +727,9 @@ module FatesInterfaceTypesMod ! FATES LULCC real(r8) :: hrv_deadstemc_to_prod10c ! Harvested C flux to 10-yr wood product pool [Site-Level, gC m-2 s-1] real(r8) :: hrv_deadstemc_to_prod100c ! Harvested C flux to 100-yr wood product pool [Site-Level, gC m-2 s-1] - + real(r8) :: gpp_site ! Site level GPP, for NBP diagnosis in HLM [Site-Level, gC m-2 s-1] + real(r8) :: ar_site ! Site level Autotrophic Resp, for NBP diagnosis in HLM [Site-Level, gC m-2 s-1] + end type bc_out_type From 422723e2653d18ef02cb8cb040518ae170bdce41 Mon Sep 17 00:00:00 2001 From: Shijie Shu Date: Thu, 3 Nov 2022 17:21:54 -0700 Subject: [PATCH 12/20] Ignore small logging rate which would produce tiny secondary patch. --- biogeochem/EDLoggingMortalityMod.F90 | 3 +++ biogeochem/EDPatchDynamicsMod.F90 | 7 ++++++- 2 files changed, 9 insertions(+), 1 deletion(-) diff --git a/biogeochem/EDLoggingMortalityMod.F90 b/biogeochem/EDLoggingMortalityMod.F90 index 8145191bcc..93af25cb01 100644 --- a/biogeochem/EDLoggingMortalityMod.F90 +++ b/biogeochem/EDLoggingMortalityMod.F90 @@ -620,6 +620,9 @@ subroutine get_harvest_rate_carbon (patch_anthro_disturbance_label, hlm_harvest_ harvest_rate = 0._r8 end if + ! Prevent the generation of tiny secondary patches + if(harvest_rate < 1e-8) harvest_rate = 0._r8 + ! For carbon-based harvest rate, normalizing by site-level primary or secondary forest fraction ! is not needed diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 95aaefa763..374b5a92ad 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -372,7 +372,7 @@ subroutine disturbance_rates( site_in, bc_in) currentCohort%lmort_infra + & currentCohort%l_degrad ) * & currentCohort%c_area/currentPatch%area - + ! Non-harvested part of the logging disturbance rate dist_rate_ldist_notharvested = dist_rate_ldist_notharvested + currentCohort%l_degrad * & currentCohort%c_area/currentPatch%area @@ -404,6 +404,11 @@ subroutine disturbance_rates( site_in, bc_in) (currentPatch%area - currentPatch%total_canopy_area) * harvest_rate / currentPatch%area endif + ! For nocomp mode, we need to prevent producing too small patches, which may produce small patches + if(hlm_use_nocomp .and. currentPatch%disturbance_rates(dtype_ilog)*currentPatch%area < min_patch_area_forced ) then + currentPatch%disturbance_rates(dtype_ilog) = 0._r8 + end if + ! fraction of the logging disturbance rate that is non-harvested if (currentPatch%disturbance_rates(dtype_ilog) .gt. nearzero) then currentPatch%fract_ldist_not_harvested = dist_rate_ldist_notharvested / & From fec6597f21b3f70abd87d50bfe82622ab297d7f8 Mon Sep 17 00:00:00 2001 From: Shijie Shu Date: Wed, 9 Nov 2022 14:35:11 -0800 Subject: [PATCH 13/20] Clarify calculations and comments on the harvest debt. --- biogeochem/EDLoggingMortalityMod.F90 | 74 +++++++++++------ biogeochem/EDMortalityFunctionsMod.F90 | 8 +- biogeochem/EDPatchDynamicsMod.F90 | 108 +++++++++++-------------- main/FatesHistoryInterfaceMod.F90 | 6 +- 4 files changed, 108 insertions(+), 88 deletions(-) diff --git a/biogeochem/EDLoggingMortalityMod.F90 b/biogeochem/EDLoggingMortalityMod.F90 index 93af25cb01..b7c4209faf 100644 --- a/biogeochem/EDLoggingMortalityMod.F90 +++ b/biogeochem/EDLoggingMortalityMod.F90 @@ -220,8 +220,12 @@ subroutine LoggingMortality_frac( pft_i, dbh, canopy_layer, lmort_direct, & ! but suffer from forest degradation (i.e. they ! are moved to newly-anthro-disturbed secondary ! forest patch) - integer, intent(out) :: harvest_tag(:) ! tag to record the harvest status, 0 - successful; + integer, intent(out) :: harvest_tag(:) ! tag to record the harvest status + ! for the calculation of harvest debt in C-based + ! harvest mode + ! 0 - successful; ! 1 - unsuccessful since not enough carbon + ! 2 - not applicable ! Local variables integer :: cur_harvest_tag ! the harvest tag of the cohort today @@ -262,9 +266,9 @@ subroutine LoggingMortality_frac( pft_i, dbh, canopy_layer, lmort_direct, & call get_harvest_rate_area (patch_anthro_disturbance_label, hlm_harvest_catnames, & hlm_harvest_rates, frac_site_primary, secondary_age, harvest_rate) - ! For area-based harvest, harvest_tag shall always be 0. - harvest_tag = 0 - cur_harvest_tag = 0 + ! For area-based harvest, harvest_tag shall always be 2 (not applicable). + harvest_tag = 2 + cur_harvest_tag = 2 if (fates_global_verbose()) then write(fates_log(), *) 'Successfully Read Harvest Rate from HLM.' @@ -456,8 +460,8 @@ subroutine get_harvestable_carbon (csite, site_area, hlm_harvest_catnames, harve ! Local Variables type(ed_patch_type), pointer :: currentPatch type(ed_cohort_type), pointer :: currentCohort - real(r8) :: harvestable_patch_c ! temporary variable, kgC site-1 - real(r8) :: harvestable_cohort_c ! temporary variable, kgC site-1 + real(r8) :: harvestable_patch_c ! patch level total carbon available for harvest, kgC site-1 + real(r8) :: harvestable_cohort_c ! cohort level total carbon available for harvest, kgC site-1 real(r8) :: sapw_m ! Biomass of sap wood real(r8) :: struct_m ! Biomass of structural organs integer :: pft ! Index of plant functional type @@ -562,50 +566,73 @@ subroutine get_harvest_rate_carbon (patch_anthro_disturbance_label, hlm_harvest_ real(r8) :: harvest_rate_c ! Temporary variable, kgC site-1 real(r8) :: harvest_rate_supply ! Temporary variable, kgC site-1 - ! Loop around harvest categories to determine the hlm harvest rate demand and actual harvest rate for the + ! This subroutine follows the same logic of get_harvest_rate_area + ! Loop over harvest categories to determine the hlm harvest rate demand and actual harvest rate for the ! current cohort based on patch history info + + ! Initialize local variables harvest_rate = 0._r8 harvest_rate_c = 0._r8 harvest_rate_supply = 0._r8 - harvest_tag(:) = 1 + harvest_tag(:) = 2 + ! Since we have five harvest categories from forcing data but in FATES non-forest harvest + ! is merged with forest harvest, we only have three logging type in FATES (primary, secondary + ! mature and secondary young). + ! Get the harvest rate from HLM do h_index = 1,hlm_num_lu_harvest_cats if (patch_anthro_disturbance_label .eq. primaryforest) then if(hlm_harvest_catnames(h_index) .eq. "HARVEST_VH1" .or. & hlm_harvest_catnames(h_index) .eq. "HARVEST_VH2") then harvest_rate_c = harvest_rate_c + hlm_harvest_rates(h_index) - ! Determine the total supply of available C for harvest - if(harvestable_forest_c(h_index) >= harvest_rate_c) then - harvest_rate_supply = harvest_rate_supply + harvestable_forest_c(h_index) - harvest_tag(h_index) = 0 - else - harvest_tag(h_index) = 1 - end if endif else if (patch_anthro_disturbance_label .eq. secondaryforest .and. & secondary_age >= secondary_age_threshold) then if(hlm_harvest_catnames(h_index) .eq. "HARVEST_SH1") then harvest_rate_c = harvest_rate_c + hlm_harvest_rates(h_index) + endif + else if (patch_anthro_disturbance_label .eq. secondaryforest .and. & + secondary_age < secondary_age_threshold) then + if(hlm_harvest_catnames(h_index) .eq. "HARVEST_SH2" .or. & + hlm_harvest_catnames(h_index) .eq. "HARVEST_SH3") then + harvest_rate_c = harvest_rate_c + hlm_harvest_rates(h_index) + endif + endif + end do + + ! Determine harvest status (succesful or not) + ! Here only three categories are used + do h_index = 1,hlm_num_lu_harvest_cats + if (patch_anthro_disturbance_label .eq. primaryforest) then + if(hlm_harvest_catnames(h_index) .eq. "HARVEST_VH1" ) then if(harvestable_forest_c(h_index) >= harvest_rate_c) then harvest_rate_supply = harvest_rate_supply + harvestable_forest_c(h_index) harvest_tag(h_index) = 0 else harvest_tag(h_index) = 1 end if - endif + end if else if (patch_anthro_disturbance_label .eq. secondaryforest .and. & - secondary_age < secondary_age_threshold) then - if(hlm_harvest_catnames(h_index) .eq. "HARVEST_SH2" .or. & - hlm_harvest_catnames(h_index) .eq. "HARVEST_SH3") then - harvest_rate_c = harvest_rate_c + hlm_harvest_rates(h_index) + secondary_age >= secondary_age_threshold) then + if(hlm_harvest_catnames(h_index) .eq. "HARVEST_SH1" ) then if(harvestable_forest_c(h_index) >= harvest_rate_c) then harvest_rate_supply = harvest_rate_supply + harvestable_forest_c(h_index) harvest_tag(h_index) = 0 else harvest_tag(h_index) = 1 end if - endif - endif + end if + else if (patch_anthro_disturbance_label .eq. secondaryforest .and. & + secondary_age < secondary_age_threshold) then + if(hlm_harvest_catnames(h_index) .eq. "HARVEST_SH2" ) then + if(harvestable_forest_c(h_index) >= harvest_rate_c) then + harvest_rate_supply = harvest_rate_supply + harvestable_forest_c(h_index) + harvest_tag(h_index) = 0 + else + harvest_tag(h_index) = 1 + end if + end if + end if end do ! If any harvest category available, assign to cur_harvest_tag and trigger logging event @@ -617,7 +644,8 @@ subroutine get_harvest_rate_carbon (patch_anthro_disturbance_label, hlm_harvest_ if (harvest_rate_supply > rsnbl_math_prec .and. harvest_rate_supply > harvest_rate_c) then harvest_rate = harvest_rate_c / harvest_rate_supply else - harvest_rate = 0._r8 + ! Force to harvest the whole cohort + harvest_rate = 1._r8 end if ! Prevent the generation of tiny secondary patches diff --git a/biogeochem/EDMortalityFunctionsMod.F90 b/biogeochem/EDMortalityFunctionsMod.F90 index 8f4009512b..65a26c8ced 100644 --- a/biogeochem/EDMortalityFunctionsMod.F90 +++ b/biogeochem/EDMortalityFunctionsMod.F90 @@ -234,8 +234,12 @@ subroutine Mortality_Derivative( currentSite, currentCohort, bc_in, frac_site_pr real(r8), intent(in) :: frac_site_primary real(r8), intent(in) :: harvestable_forest_c(:) ! total carbon available for logging, kgC site-1 - integer, intent(inout) :: harvest_tag(:) - + integer, intent(out) :: harvest_tag(:) ! tag to record the harvest status + ! for the calculation of harvest debt in C-based + ! harvest mode + ! 0 - successful; + ! 1 - unsuccessful since not enough carbon + ! 2 - not applicable ! ! !LOCAL VARIABLES: real(r8) :: cmort ! starvation mortality rate (fraction per year) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 374b5a92ad..b2ad741b7d 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -194,10 +194,11 @@ subroutine disturbance_rates( site_in, bc_in) real(r8) :: frac_site_primary real(r8) :: harvest_rate real(r8) :: tempsum + real(r8) :: harvest_debt_pri + real(r8) :: harvest_debt_sec_mature + real(r8) :: harvest_debt_sec_young real(r8) :: harvestable_forest_c(hlm_num_lu_harvest_cats) integer :: harvest_tag(hlm_num_lu_harvest_cats) - integer :: harvest_debt_primary - integer :: harvest_debt_secondary integer :: patch_no_secondary !---------------------------------------------------------------------------------------------- @@ -211,10 +212,11 @@ subroutine disturbance_rates( site_in, bc_in) ! get available biomass for harvest for all patches call get_harvestable_carbon(site_in, bc_in%site_area, bc_in%hlm_harvest_catnames, harvestable_forest_c) - - harvest_debt_primary = 0 - harvest_debt_secondary = 0 + ! Initialize local variables patch_no_secondary = 0 + harvest_debt_pri = 0._r8 + harvest_debt_sec_mature = 0._r8 + harvest_debt_sec_young = 0._r8 currentPatch => site_in%oldest_patch do while (associated(currentPatch)) @@ -256,70 +258,56 @@ subroutine disturbance_rates( site_in, bc_in) currentCohort => currentCohort%taller end do - ! Determine harvest debt for primary land and secondary land - ! Harvest debt is the accumulated total carbon amount once - ! available carbon for harvest is smaller than the harvest - ! rate of forcing data for each site. - ! Each cohort has the same harvest tag but not each patch - ! Hence this part shall be within the patch loop - ! TODO: we can define harvest debt as a fraction of the - ! harvest rate in the future - ! Warning: Non-forest harvest is not accounted for yet - ! Thus the harvest tag for non-forest are not effective - if(logging_time) then - harvest_debt_loop: do h_index = 1, hlm_num_lu_harvest_cats - ! Primary patch: Once a patch has debt, skip the calculation - if (harvest_debt_primary == 0) then - if ( currentPatch%anthro_disturbance_label .eq. primaryforest ) then - if ( harvest_tag(h_index) == 1 ) then - ! h_index points to primary forest harvest - if((bc_in%hlm_harvest_catnames(h_index) .eq. "HARVEST_VH1")) then - harvest_debt_primary = 1 - exit harvest_debt_loop - end if - end if - end if - end if - ! Secondary patch - if (harvest_debt_secondary == 0) then - if ( currentPatch%anthro_disturbance_label .eq. secondaryforest ) then - patch_no_secondary = patch_no_secondary + 1 - if ( harvest_tag(h_index) == 1 ) then - ! h_index points to secondary forest harvest - if((bc_in%hlm_harvest_catnames(h_index) .eq. "HARVEST_SH1") .or. & - (bc_in%hlm_harvest_catnames(h_index) .eq. "HARVEST_SH2")) then - harvest_debt_secondary = 1 - exit harvest_debt_loop - end if - end if - end if - end if - end do harvest_debt_loop - end if + ! ! Counter of secondary patch used in logging debt calculation + ! if ( currentPatch%anthro_disturbance_label .eq. secondaryforest ) then + ! patch_no_secondary = patch_no_secondary + 1 + ! end if currentPatch => currentPatch%younger end do - ! Obatin actual harvest debt. This shall be outside the patch loop + ! Calculate if we have harvest debt for primary and secondary land + ! Harvest debt is the accumulated total carbon + ! deficiency once the carbon amount available for harvest + ! is smaller than the harvest rate of forcing data. + ! Harvest debt is calculated on site level + ! TODO: we can define harvest debt as a fraction of the + ! harvest rate in the future + ! Note 1: Non-forest harvest is accounted for under forest + ! harvest, thus the harvest tag for non-forest is not applicable (= 2) + ! Note 2: Since we will completely harvest all forest C from patches + ! with debt, the harvest debt shall subtract the harvestable forest C + if(logging_time) then + ! First we need to get harvest rate for all three categories do h_index = 1, hlm_num_lu_harvest_cats - if ( harvest_debt_primary == 1 ) then - ! Only account for primary forest harvest rate - if((bc_in%hlm_harvest_catnames(h_index) .eq. "HARVEST_VH1") .or. & - (bc_in%hlm_harvest_catnames(h_index) .eq. "HARVEST_VH2")) then - site_in%resources_management%harvest_debt = site_in%resources_management%harvest_debt + & - bc_in%hlm_harvest_rates(h_index) - end if + ! Primary forest harvest rate + if(bc_in%hlm_harvest_catnames(h_index) .eq. "HARVEST_VH1" .or. & + bc_in%hlm_harvest_catnames(h_index) .eq. "HARVEST_VH2" ) then + harvest_debt_pri = harvest_debt_pri + bc_in%hlm_harvest_rates(h_index) + else if(bc_in%hlm_harvest_catnames(h_index) .eq. "HARVEST_SH1") then + harvest_debt_sec_mature = harvest_debt_sec_mature + bc_in%hlm_harvest_rates(h_index) + else if(bc_in%hlm_harvest_catnames(h_index) .eq. "HARVEST_SH2" .or. & + bc_in%hlm_harvest_catnames(h_index) .eq. "HARVEST_SH3") then + harvest_debt_sec_mature = harvest_debt_sec_mature + bc_in%hlm_harvest_rates(h_index) end if - if (harvest_debt_secondary == 1 .or. patch_no_secondary == 0) then - ! Only account for secondary forest harvest rate - if((bc_in%hlm_harvest_catnames(h_index) .eq. "HARVEST_SH1") .or. & - (bc_in%hlm_harvest_catnames(h_index) .eq. "HARVEST_SH2") .or. & - (bc_in%hlm_harvest_catnames(h_index) .eq. "HARVEST_SH3")) then + end do + ! Next we get the harvest debt through the harvest tag + do h_index = 1, hlm_num_lu_harvest_cats + if (harvest_tag(h_index) .eq. 1) then + if(bc_in%hlm_harvest_catnames(h_index) .eq. "HARVEST_VH1") then + site_in%resources_management%harvest_debt = site_in%resources_management%harvest_debt + & + harvest_debt_pri - harvestable_forest_c(h_index) + else if(bc_in%hlm_harvest_catnames(h_index) .eq. "HARVEST_SH1") then + site_in%resources_management%harvest_debt = site_in%resources_management%harvest_debt + & + harvest_debt_sec_mature - harvestable_forest_c(h_index) + site_in%resources_management%harvest_debt_sec = site_in%resources_management%harvest_debt_sec + & + harvest_debt_sec_mature - harvestable_forest_c(h_index) + else if(bc_in%hlm_harvest_catnames(h_index) .eq. "HARVEST_SH2") then site_in%resources_management%harvest_debt = site_in%resources_management%harvest_debt + & - bc_in%hlm_harvest_rates(h_index) + harvest_debt_sec_young - harvestable_forest_c(h_index) site_in%resources_management%harvest_debt_sec = site_in%resources_management%harvest_debt_sec + & - bc_in%hlm_harvest_rates(h_index) + harvest_debt_sec_young - harvestable_forest_c(h_index) end if end if end do diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 8b8fb053e1..acc32afba4 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -4839,20 +4839,20 @@ subroutine define_history_vars(this, initialize_variables) call this%set_history_var(vname='FATES_SECONDARY_FOREST_FRACTION', & units='m2 m-2', long='secondary forest fraction', & - use_default='inactive', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & + use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & upfreq=1, ivar=ivar, initialize=initialize_variables, & index=ih_fraction_secondary_forest_si) call this%set_history_var(vname='FATES_WOOD_PRODUCT', units='kg m-2', & long='total wood product from logging in kg carbon per m2 land area', & - use_default='inactive', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & + use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & upfreq=1, ivar=ivar, initialize=initialize_variables, & index=ih_woodproduct_si) call this%set_history_var(vname='FATES_SECONDARY_FOREST_VEGC', & units='kg m-2', & long='biomass on secondary lands in kg carbon per m2 land area (mult by FATES_SECONDARY_FOREST_FRACTION to get per secondary forest area)', & - use_default='inactive', avgflag='A', vtype=site_r8, & + use_default='active', avgflag='A', vtype=site_r8, & hlms='CLM:ALM', upfreq=1, ivar=ivar, initialize=initialize_variables, & index=ih_biomass_secondary_forest_si) From b62fe84cbfd29ddafc116d07b380ce98490e8026 Mon Sep 17 00:00:00 2001 From: Shijie Shu Date: Fri, 11 Nov 2022 15:01:46 -0800 Subject: [PATCH 14/20] Change back EDPatchDynamicsMod.F90 for sanity purpose. --- biogeochem/EDLoggingMortalityMod.F90 | 6 +- biogeochem/EDPatchDynamicsMod.F90 | 1375 +++++++++++++------------- 2 files changed, 691 insertions(+), 690 deletions(-) diff --git a/biogeochem/EDLoggingMortalityMod.F90 b/biogeochem/EDLoggingMortalityMod.F90 index e1736b9495..4e2da8d83c 100644 --- a/biogeochem/EDLoggingMortalityMod.F90 +++ b/biogeochem/EDLoggingMortalityMod.F90 @@ -642,8 +642,10 @@ subroutine get_harvest_rate_carbon (patch_anthro_disturbance_label, hlm_harvest_ if (harvest_rate_supply > rsnbl_math_prec .and. harvest_rate_supply > harvest_rate_c) then harvest_rate = harvest_rate_c / harvest_rate_supply else - ! Force to harvest the whole cohort - harvest_rate = 1._r8 + ! If we force harvest rate to 1 when we don't have enough C, we will produce + ! primary patch with no area, which cannot be terminated under nocomp mode. + ! So we still keep the harvest rate to 0 for now. + harvest_rate = 0._r8 end if ! Prevent the generation of tiny secondary patches diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index b2ad741b7d..c0f6ade5e3 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -162,6 +162,7 @@ subroutine disturbance_rates( site_in, bc_in) ! !USES: use EDMortalityFunctionsMod , only : mortality_rates + use EDMortalityFunctionsMod , only : ExemptTreefallDist ! loging flux use EDLoggingMortalityMod , only : LoggingMortality_frac @@ -273,10 +274,8 @@ subroutine disturbance_rates( site_in, bc_in) ! Harvest debt is calculated on site level ! TODO: we can define harvest debt as a fraction of the ! harvest rate in the future - ! Note 1: Non-forest harvest is accounted for under forest + ! Note: Non-forest harvest is accounted for under forest ! harvest, thus the harvest tag for non-forest is not applicable (= 2) - ! Note 2: Since we will completely harvest all forest C from patches - ! with debt, the harvest debt shall subtract the harvestable forest C if(logging_time) then ! First we need to get harvest rate for all three categories @@ -297,17 +296,17 @@ subroutine disturbance_rates( site_in, bc_in) if (harvest_tag(h_index) .eq. 1) then if(bc_in%hlm_harvest_catnames(h_index) .eq. "HARVEST_VH1") then site_in%resources_management%harvest_debt = site_in%resources_management%harvest_debt + & - harvest_debt_pri - harvestable_forest_c(h_index) + harvest_debt_pri else if(bc_in%hlm_harvest_catnames(h_index) .eq. "HARVEST_SH1") then site_in%resources_management%harvest_debt = site_in%resources_management%harvest_debt + & - harvest_debt_sec_mature - harvestable_forest_c(h_index) + harvest_debt_sec_mature site_in%resources_management%harvest_debt_sec = site_in%resources_management%harvest_debt_sec + & - harvest_debt_sec_mature - harvestable_forest_c(h_index) + harvest_debt_sec_mature else if(bc_in%hlm_harvest_catnames(h_index) .eq. "HARVEST_SH2") then site_in%resources_management%harvest_debt = site_in%resources_management%harvest_debt + & - harvest_debt_sec_young - harvestable_forest_c(h_index) + harvest_debt_sec_young site_in%resources_management%harvest_debt_sec = site_in%resources_management%harvest_debt_sec + & - harvest_debt_sec_young - harvestable_forest_c(h_index) + harvest_debt_sec_young end if end if end do @@ -348,10 +347,12 @@ subroutine disturbance_rates( site_in, bc_in) if(currentCohort%canopy_layer == 1)then - ! Treefall Disturbance Rate - currentPatch%disturbance_rates(dtype_ifall) = currentPatch%disturbance_rates(dtype_ifall) + & - fates_mortality_disturbance_fraction * & - min(1.0_r8,currentCohort%dmort)*hlm_freq_day*currentCohort%c_area/currentPatch%area + ! Treefall Disturbance Rate. Only count this for trees, not grasses + if ( .not. ExemptTreefallDist(currentCohort) ) then + currentPatch%disturbance_rates(dtype_ifall) = currentPatch%disturbance_rates(dtype_ifall) + & + fates_mortality_disturbance_fraction * & + min(1.0_r8,currentCohort%dmort)*hlm_freq_day*currentCohort%c_area/currentPatch%area + end if ! Logging Disturbance Rate currentPatch%disturbance_rates(dtype_ilog) = currentPatch%disturbance_rates(dtype_ilog) + & @@ -361,6 +362,11 @@ subroutine disturbance_rates( site_in, bc_in) currentCohort%l_degrad ) * & currentCohort%c_area/currentPatch%area + if(currentPatch%disturbance_rates(dtype_ilog)>1.0) then + write(fates_log(),*) 'See luc mortalities:', currentCohort%lmort_direct, & + currentCohort%lmort_collateral, currentCohort%lmort_infra, currentCohort%l_degrad + end if + ! Non-harvested part of the logging disturbance rate dist_rate_ldist_notharvested = dist_rate_ldist_notharvested + currentCohort%l_degrad * & currentCohort%c_area/currentPatch%area @@ -370,7 +376,7 @@ subroutine disturbance_rates( site_in, bc_in) enddo !currentCohort ! for non-closed-canopy areas subject to logging, add an additional increment of area disturbed - ! equivalent to the fradction logged to account for transfer of interstitial ground area to new secondary lands + ! equivalent to the fraction logged to account for transfer of interstitial ground area to new secondary lands if ( logging_time .and. & (currentPatch%area - currentPatch%total_canopy_area) .gt. fates_tiny ) then ! The canopy is NOT closed. @@ -392,11 +398,6 @@ subroutine disturbance_rates( site_in, bc_in) (currentPatch%area - currentPatch%total_canopy_area) * harvest_rate / currentPatch%area endif - ! For nocomp mode, we need to prevent producing too small patches, which may produce small patches - if(hlm_use_nocomp .and. currentPatch%disturbance_rates(dtype_ilog)*currentPatch%area < min_patch_area_forced ) then - currentPatch%disturbance_rates(dtype_ilog) = 0._r8 - end if - ! fraction of the logging disturbance rate that is non-harvested if (currentPatch%disturbance_rates(dtype_ilog) .gt. nearzero) then currentPatch%fract_ldist_not_harvested = dist_rate_ldist_notharvested / & @@ -418,6 +419,7 @@ subroutine disturbance_rates( site_in, bc_in) call FatesWarn(msg,index=2) endif + ! if the sum of all disturbance rates is such that they will exceed total patch area on this day, then reduce them all proportionally. if ( sum(currentPatch%disturbance_rates(:)) .gt. 1.0_r8 ) then tempsum = sum(currentPatch%disturbance_rates(:)) do i_dist = 1,N_DIST_TYPES @@ -510,719 +512,721 @@ subroutine spawn_patches( currentSite, bc_in) ! in the nocomp cases, since every patch has a PFT identity, it can only receive patch area from patches ! that have the same identity. In order to allow this, we have this very high level loop over nocomp PFTs - ! and only do the disturbance for any patches that have that nocomp PFT identity. + ! and only do the disturbance for any patches that have that nocomp PFT identity. ! If nocomp is not enabled, then this is not much of a loop, it only passes through once. nocomp_pft_loop: do i_nocomp_pft = min_nocomp_pft,max_nocomp_pft - disturbance_type_loop: do i_disturbance_type = 1,N_DIST_TYPES + disturbance_type_loop: do i_disturbance_type = 1,N_DIST_TYPES - ! calculate area of disturbed land, in this timestep, by summing contributions from each existing patch. - currentPatch => currentSite%youngest_patch + ! calculate area of disturbed land, in this timestep, by summing contributions from each existing patch. + currentPatch => currentSite%youngest_patch - site_areadis_primary = 0.0_r8 - site_areadis_secondary = 0.0_r8 + site_areadis_primary = 0.0_r8 + site_areadis_secondary = 0.0_r8 - do while(associated(currentPatch)) + do while(associated(currentPatch)) - cp_nocomp_matches_1_if: if ( hlm_use_nocomp .eq. ifalse .or. & - currentPatch%nocomp_pft_label .eq. i_nocomp_pft ) then + cp_nocomp_matches_1_if: if ( hlm_use_nocomp .eq. ifalse .or. & + currentPatch%nocomp_pft_label .eq. i_nocomp_pft ) then - disturbance_rate = currentPatch%disturbance_rates(i_disturbance_type) + disturbance_rate = currentPatch%disturbance_rates(i_disturbance_type) - if(disturbance_rate > (1.0_r8 + rsnbl_math_prec)) then - write(fates_log(),*) 'patch disturbance rate > 1 ?',disturbance_rate - call dump_patch(currentPatch) - call endrun(msg=errMsg(sourcefile, __LINE__)) - end if + if(disturbance_rate > (1.0_r8 + rsnbl_math_prec)) then + write(fates_log(),*) 'patch disturbance rate > 1 ?',disturbance_rate + call dump_patch(currentPatch) + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if - ! Only create new patches that have non-negligible amount of land - if((currentPatch%area*disturbance_rate) > nearzero ) then - - ! figure out whether the receiver patch for disturbance from this patch will be - ! primary or secondary land receiver patch is primary forest only if both the - ! donor patch is primary forest and the current disturbance type is not logging - if ( currentPatch%anthro_disturbance_label .eq. primaryforest .and. & - (i_disturbance_type .ne. dtype_ilog) ) then - - site_areadis_primary = site_areadis_primary + currentPatch%area * disturbance_rate + ! Only create new patches that have non-negligible amount of land + if((currentPatch%area*disturbance_rate) > nearzero ) then - ! track disturbance rates to output to history - currentSite%disturbance_rates_primary_to_primary(i_disturbance_type) = & - currentSite%disturbance_rates_primary_to_primary(i_disturbance_type) + & - currentPatch%area * disturbance_rate * AREA_INV - else - site_areadis_secondary = site_areadis_secondary + currentPatch%area * disturbance_rate + ! figure out whether the receiver patch for disturbance from this patch will be + ! primary or secondary land receiver patch is primary forest only if both the + ! donor patch is primary forest and the current disturbance type is not logging + if ( currentPatch%anthro_disturbance_label .eq. primaryforest .and. & + (i_disturbance_type .ne. dtype_ilog) ) then - ! track disturbance rates to output to history - if (currentPatch%anthro_disturbance_label .eq. secondaryforest) then - currentSite%disturbance_rates_secondary_to_secondary(i_disturbance_type) = & - currentSite%disturbance_rates_secondary_to_secondary(i_disturbance_type) + & - currentPatch%area * disturbance_rate * AREA_INV - else - currentSite%disturbance_rates_primary_to_secondary(i_disturbance_type) = & - currentSite%disturbance_rates_primary_to_secondary(i_disturbance_type) + & - currentPatch%area * disturbance_rate * AREA_INV - endif + site_areadis_primary = site_areadis_primary + currentPatch%area * disturbance_rate - endif - - end if - - end if cp_nocomp_matches_1_if - currentPatch => currentPatch%older - enddo ! end loop over patches. sum area disturbed for all patches. + ! track disturbance rates to output to history + currentSite%disturbance_rates_primary_to_primary(i_disturbance_type) = & + currentSite%disturbance_rates_primary_to_primary(i_disturbance_type) + & + currentPatch%area * disturbance_rate * AREA_INV + else + site_areadis_secondary = site_areadis_secondary + currentPatch%area * disturbance_rate - ! It is possible that no disturbance area was generated - if ( (site_areadis_primary + site_areadis_secondary) > nearzero) then - - age = 0.0_r8 + ! track disturbance rates to output to history + if (currentPatch%anthro_disturbance_label .eq. secondaryforest) then + currentSite%disturbance_rates_secondary_to_secondary(i_disturbance_type) = & + currentSite%disturbance_rates_secondary_to_secondary(i_disturbance_type) + & + currentPatch%area * disturbance_rate * AREA_INV + else + currentSite%disturbance_rates_primary_to_secondary(i_disturbance_type) = & + currentSite%disturbance_rates_primary_to_secondary(i_disturbance_type) + & + currentPatch%area * disturbance_rate * AREA_INV + endif - ! create two empty patches, to absorb newly disturbed primary and secondary forest area - ! first create patch to receive primary forest area - if ( site_areadis_primary .gt. nearzero ) then - allocate(new_patch_primary) + endif - call create_patch(currentSite, new_patch_primary, age, & - site_areadis_primary, primaryforest, i_nocomp_pft) - - ! Initialize the litter pools to zero, these - ! pools will be populated by looping over the existing patches - ! and transfering in mass - do el=1,num_elements - call new_patch_primary%litter(el)%InitConditions(init_leaf_fines=0._r8, & - init_root_fines=0._r8, & - init_ag_cwd=0._r8, & - init_bg_cwd=0._r8, & - init_seed=0._r8, & - init_seed_germ=0._r8) - end do - new_patch_primary%tallest => null() - new_patch_primary%shortest => null() + end if - endif + end if cp_nocomp_matches_1_if + currentPatch => currentPatch%older + enddo ! end loop over patches. sum area disturbed for all patches. + + ! It is possible that no disturbance area was generated + if ( (site_areadis_primary + site_areadis_secondary) > nearzero) then + + age = 0.0_r8 + + ! create two empty patches, to absorb newly disturbed primary and secondary forest area + ! first create patch to receive primary forest area + if ( site_areadis_primary .gt. nearzero ) then + allocate(new_patch_primary) + + call create_patch(currentSite, new_patch_primary, age, & + site_areadis_primary, primaryforest, i_nocomp_pft) + + ! Initialize the litter pools to zero, these + ! pools will be populated by looping over the existing patches + ! and transfering in mass + do el=1,num_elements + call new_patch_primary%litter(el)%InitConditions(init_leaf_fines=0._r8, & + init_root_fines=0._r8, & + init_ag_cwd=0._r8, & + init_bg_cwd=0._r8, & + init_seed=0._r8, & + init_seed_germ=0._r8) + end do + new_patch_primary%tallest => null() + new_patch_primary%shortest => null() - ! next create patch to receive secondary forest area - if ( site_areadis_secondary .gt. nearzero) then - allocate(new_patch_secondary) - call create_patch(currentSite, new_patch_secondary, age, & - site_areadis_secondary, secondaryforest,i_nocomp_pft) - - ! Initialize the litter pools to zero, these - ! pools will be populated by looping over the existing patches - ! and transfering in mass - do el=1,num_elements - call new_patch_secondary%litter(el)%InitConditions(init_leaf_fines=0._r8, & - init_root_fines=0._r8, & - init_ag_cwd=0._r8, & - init_bg_cwd=0._r8, & - init_seed=0._r8, & - init_seed_germ=0._r8) - end do - new_patch_secondary%tallest => null() - new_patch_secondary%shortest => null() + endif - endif - - ! loop round all the patches that contribute surviving indivduals and litter - ! pools to the new patch. We only loop the pre-existing patches, so - ! quit the loop if the current patch is either null, or matches the - ! two new pointers. + ! next create patch to receive secondary forest area + if ( site_areadis_secondary .gt. nearzero) then + allocate(new_patch_secondary) + call create_patch(currentSite, new_patch_secondary, age, & + site_areadis_secondary, secondaryforest,i_nocomp_pft) + + ! Initialize the litter pools to zero, these + ! pools will be populated by looping over the existing patches + ! and transfering in mass + do el=1,num_elements + call new_patch_secondary%litter(el)%InitConditions(init_leaf_fines=0._r8, & + init_root_fines=0._r8, & + init_ag_cwd=0._r8, & + init_bg_cwd=0._r8, & + init_seed=0._r8, & + init_seed_germ=0._r8) + end do + new_patch_secondary%tallest => null() + new_patch_secondary%shortest => null() - currentPatch => currentSite%oldest_patch - do while(associated(currentPatch)) + endif - cp_nocomp_matches_2_if: if ( hlm_use_nocomp .eq. ifalse .or. & - currentPatch%nocomp_pft_label .eq. i_nocomp_pft ) then + ! loop round all the patches that contribute surviving indivduals and litter + ! pools to the new patch. We only loop the pre-existing patches, so + ! quit the loop if the current patch is either null, or matches the + ! two new pointers. - ! This is the amount of patch area that is disturbed, and donated by the donor - disturbance_rate = currentPatch%disturbance_rates(i_disturbance_type) - patch_site_areadis = currentPatch%area * disturbance_rate - - if ( patch_site_areadis > nearzero ) then - - ! figure out whether the receiver patch for disturbance from this patch - ! will be primary or secondary land receiver patch is primary forest - ! only if both the donor patch is primary forest and the current - ! disturbance type is not logging - if (currentPatch%anthro_disturbance_label .eq. primaryforest .and. & - (i_disturbance_type .ne. dtype_ilog)) then - new_patch => new_patch_primary - else - new_patch => new_patch_secondary - endif - - if(.not.associated(new_patch))then - write(fates_log(),*) 'Patch spawning has attempted to point to' - write(fates_log(),*) 'an un-allocated patch' - call endrun(msg=errMsg(sourcefile, __LINE__)) - end if - - ! for the case where the donating patch is secondary forest, if - ! the current disturbance from this patch is non-anthropogenic, - ! we need to average in the time-since-anthropogenic-disturbance - ! from the donor patch into that of the receiver patch - if ( currentPatch%anthro_disturbance_label .eq. secondaryforest .and. & - (i_disturbance_type .ne. dtype_ilog) ) then - - new_patch%age_since_anthro_disturbance = new_patch%age_since_anthro_disturbance + & - currentPatch%age_since_anthro_disturbance * (patch_site_areadis / site_areadis_secondary) + currentPatch => currentSite%oldest_patch + do while(associated(currentPatch)) - endif - - ! 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 - ! fire is not the current disturbance regime. + cp_nocomp_matches_2_if: if ( hlm_use_nocomp .eq. ifalse .or. & + currentPatch%nocomp_pft_label .eq. i_nocomp_pft ) then - if(i_disturbance_type .ne. dtype_ifire) then - currentPatch%burnt_frac_litter(:) = 0._r8 - end if + ! This is the amount of patch area that is disturbed, and donated by the donor + disturbance_rate = currentPatch%disturbance_rates(i_disturbance_type) + patch_site_areadis = currentPatch%area * disturbance_rate - call TransLitterNewPatch( currentSite, currentPatch, new_patch, patch_site_areadis) - ! Transfer in litter fluxes from plants in various contexts of death and destruction + if ( patch_site_areadis > nearzero ) then - if(i_disturbance_type .eq. dtype_ilog) then - call logging_litter_fluxes(currentSite, currentPatch, & - new_patch, patch_site_areadis,bc_in) - elseif(i_disturbance_type .eq. dtype_ifire) then - call fire_litter_fluxes(currentSite, currentPatch, & - new_patch, patch_site_areadis,bc_in) - else - call mortality_litter_fluxes(currentSite, currentPatch, & - new_patch, patch_site_areadis,bc_in) - endif + ! figure out whether the receiver patch for disturbance from this patch + ! will be primary or secondary land receiver patch is primary forest + ! only if both the donor patch is primary forest and the current + ! disturbance type is not logging + if (currentPatch%anthro_disturbance_label .eq. primaryforest .and. & + (i_disturbance_type .ne. dtype_ilog)) then + new_patch => new_patch_primary + else + new_patch => new_patch_secondary + endif + if(.not.associated(new_patch))then + write(fates_log(),*) 'Patch spawning has attempted to point to' + write(fates_log(),*) 'an un-allocated patch' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if - ! Copy any means or timers from the original patch to the new patch - ! These values will inherit all info from the original patch - ! -------------------------------------------------------------------------- - call new_patch%tveg24%CopyFromDonor(currentPatch%tveg24) - call new_patch%tveg_lpa%CopyFromDonor(currentPatch%tveg_lpa) - - - ! -------------------------------------------------------------------------- - ! The newly formed patch from disturbance (new_patch), has now been given - ! some litter from dead plants and pre-existing litter from the donor patches. - ! - ! Next, we loop through the cohorts in the donor patch, copy them with - ! area modified number density into the new-patch, and apply survivorship. - ! ------------------------------------------------------------------------- - - currentCohort => currentPatch%shortest - do while(associated(currentCohort)) - - allocate(nc) - if(hlm_use_planthydro.eq.itrue) call InitHydrCohort(CurrentSite,nc) - - ! Initialize the PARTEH object and point to the - ! correct boundary condition fields - nc%prt => null() - call InitPRTObject(nc%prt) - call InitPRTBoundaryConditions(nc) - - ! (Keeping as an example) - ! Allocate running mean functions - !allocate(nc%tveg_lpa) - !call nc%tveg_lpa%InitRMean(ema_lpa,init_value=new_patch%tveg_lpa%GetMean()) - - call zero_cohort(nc) - - ! nc is the new cohort that goes in the disturbed patch (new_patch)... currentCohort - ! is the curent cohort that stays in the donor patch (currentPatch) - call copy_cohort(currentCohort, nc) - - !this is the case as the new patch probably doesn't have a closed canopy, and - ! even if it does, that will be sorted out in canopy_structure. - nc%canopy_layer = 1 - nc%canopy_layer_yesterday = 1._r8 - - sapw_c = currentCohort%prt%GetState(sapw_organ, all_carbon_elements) - struct_c = currentCohort%prt%GetState(struct_organ, all_carbon_elements) - leaf_c = currentCohort%prt%GetState(leaf_organ, all_carbon_elements) - fnrt_c = currentCohort%prt%GetState(fnrt_organ, all_carbon_elements) - store_c = currentCohort%prt%GetState(store_organ, all_carbon_elements) - total_c = sapw_c + struct_c + leaf_c + fnrt_c + store_c - - ! treefall mortality is the current disturbance - if(i_disturbance_type .eq. dtype_ifall) then - - if(currentCohort%canopy_layer == 1)then - - ! In the donor patch we are left with fewer trees because the area has decreased - ! the plant density for large trees does not actually decrease in the donor patch - ! because this is the part of the original patch where no trees have actually fallen - ! The diagnostic cmort,bmort,hmort, and frmort rates have already been saved - - currentCohort%n = currentCohort%n * (1.0_r8 - fates_mortality_disturbance_fraction * & - min(1.0_r8,currentCohort%dmort * hlm_freq_day)) - - nc%n = 0.0_r8 ! kill all of the trees who caused the disturbance. - - nc%cmort = nan ! The mortality diagnostics are set to nan - ! because the cohort should dissappear - nc%hmort = nan - nc%bmort = nan - nc%frmort = nan - nc%smort = nan - nc%asmort = nan - nc%lmort_direct = nan - nc%lmort_collateral = nan - nc%lmort_infra = nan - nc%l_degrad = nan - - else - ! small trees - if( prt_params%woody(currentCohort%pft) == itrue)then - - - ! Survivorship of undestory woody plants. Two step process. - ! Step 1: Reduce current number of plants to reflect the - ! change in area. - ! The number density per square are doesn't change, - ! but since the patch is smaller and cohort counts - ! are absolute, reduce this number. - - nc%n = currentCohort%n * patch_site_areadis/currentPatch%area - - ! because the mortality rate due to impact for the cohorts which - ! had been in the understory and are now in the newly- - ! disturbed patch is very high, passing the imort directly to history - ! results in large numerical errors, on account of the sharply - ! reduced number densities. so instead pass this info via a - ! site-level diagnostic variable before reducing the number density. - - currentSite%imort_rate(currentCohort%size_class, currentCohort%pft) = & - currentSite%imort_rate(currentCohort%size_class, currentCohort%pft) + & - nc%n * ED_val_understorey_death / hlm_freq_day - - - currentSite%imort_carbonflux(currentCohort%pft) = & - currentSite%imort_carbonflux(currentCohort%pft) + & - (nc%n * ED_val_understorey_death / hlm_freq_day ) * & - total_c * g_per_kg * days_per_sec * years_per_day * ha_per_m2 - - ! Step 2: Apply survivor ship function based on the understory death fraction - ! remaining of understory plants of those that are knocked over - ! by the overstorey trees dying... - nc%n = nc%n * (1.0_r8 - ED_val_understorey_death) - - ! since the donor patch split and sent a fraction of its members - ! to the new patch and a fraction to be preserved in itself, - ! when reporting diagnostic rates, we must carry over the mortality rates from - ! the donor that were applied before the patch split. Remember this is only - ! for diagnostics. But think of it this way, the rates are weighted by - ! number density in EDCLMLink, and the number density of this new patch is donated - ! so with the number density must come the effective mortality rates. - - nc%cmort = currentCohort%cmort - nc%hmort = currentCohort%hmort - nc%bmort = currentCohort%bmort - nc%frmort = currentCohort%frmort - nc%smort = currentCohort%smort - nc%asmort = currentCohort%asmort - nc%dmort = currentCohort%dmort - nc%lmort_direct = currentCohort%lmort_direct - nc%lmort_collateral = currentCohort%lmort_collateral - nc%lmort_infra = currentCohort%lmort_infra - - ! understory trees that might potentially be knocked over in the disturbance. - ! The existing (donor) patch should not have any impact mortality, it should - ! only lose cohorts due to the decrease in area. This is not mortality. - ! Besides, the current and newly created patch sum to unity - - currentCohort%n = currentCohort%n * (1._r8 - patch_site_areadis/currentPatch%area) - - else - ! grass is not killed by mortality disturbance events. Just move it into the new patch area. - ! Just split the grass into the existing and new patch structures - nc%n = currentCohort%n * patch_site_areadis/currentPatch%area - - ! Those remaining in the existing - currentCohort%n = currentCohort%n * (1._r8 - patch_site_areadis/currentPatch%area) - - nc%cmort = currentCohort%cmort - nc%hmort = currentCohort%hmort - nc%bmort = currentCohort%bmort - nc%frmort = currentCohort%frmort - nc%smort = currentCohort%smort - nc%asmort = currentCohort%asmort - nc%dmort = currentCohort%dmort - nc%lmort_direct = currentCohort%lmort_direct - nc%lmort_collateral = currentCohort%lmort_collateral - nc%lmort_infra = currentCohort%lmort_infra - - endif - endif - - ! Fire is the current disturbance - elseif (i_disturbance_type .eq. dtype_ifire ) then - - ! Number of members in the new patch, before we impose fire survivorship - nc%n = currentCohort%n * patch_site_areadis/currentPatch%area - - ! loss of individuals from source patch due to area shrinking - currentCohort%n = currentCohort%n * (1._r8 - patch_site_areadis/currentPatch%area) - - levcan = currentCohort%canopy_layer - - if(levcan==ican_upper) then - - ! before changing number densities, track total rate of trees that died - ! due to fire, as well as from each fire mortality term - currentSite%fmort_rate_canopy(currentCohort%size_class, currentCohort%pft) = & - currentSite%fmort_rate_canopy(currentCohort%size_class, currentCohort%pft) + & - nc%n * currentCohort%fire_mort / hlm_freq_day - - currentSite%fmort_carbonflux_canopy(currentCohort%pft) = & - currentSite%fmort_carbonflux_canopy(currentCohort%pft) + & - (nc%n * currentCohort%fire_mort) * & - total_c * g_per_kg * days_per_sec * ha_per_m2 - - else - currentSite%fmort_rate_ustory(currentCohort%size_class, currentCohort%pft) = & - currentSite%fmort_rate_ustory(currentCohort%size_class, currentCohort%pft) + & - nc%n * currentCohort%fire_mort / hlm_freq_day - - currentSite%fmort_carbonflux_ustory(currentCohort%pft) = & - currentSite%fmort_carbonflux_ustory(currentCohort%pft) + & - (nc%n * currentCohort%fire_mort) * & - total_c * g_per_kg * days_per_sec * ha_per_m2 - end if - - currentSite%fmort_rate_cambial(currentCohort%size_class, currentCohort%pft) = & - currentSite%fmort_rate_cambial(currentCohort%size_class, currentCohort%pft) + & - nc%n * currentCohort%cambial_mort / hlm_freq_day - currentSite%fmort_rate_crown(currentCohort%size_class, currentCohort%pft) = & - currentSite%fmort_rate_crown(currentCohort%size_class, currentCohort%pft) + & - nc%n * currentCohort%crownfire_mort / hlm_freq_day - - ! loss of individual from fire in new patch. - nc%n = nc%n * (1.0_r8 - currentCohort%fire_mort) - - nc%cmort = currentCohort%cmort - nc%hmort = currentCohort%hmort - nc%bmort = currentCohort%bmort - nc%frmort = currentCohort%frmort - nc%smort = currentCohort%smort - nc%asmort = currentCohort%asmort - nc%dmort = currentCohort%dmort - nc%lmort_direct = currentCohort%lmort_direct - nc%lmort_collateral = currentCohort%lmort_collateral - nc%lmort_infra = currentCohort%lmort_infra - - - ! 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 + ! for the case where the donating patch is secondary forest, if + ! the current disturbance from this patch is non-anthropogenic, + ! we need to average in the time-since-anthropogenic-disturbance + ! from the donor patch into that of the receiver patch + if ( currentPatch%anthro_disturbance_label .eq. secondaryforest .and. & + (i_disturbance_type .ne. dtype_ilog) ) then - ! Grasses determine their fraction of leaves burned here + new_patch%age_since_anthro_disturbance = new_patch%age_since_anthro_disturbance + & + currentPatch%age_since_anthro_disturbance * (patch_site_areadis / site_areadis_secondary) - leaf_burn_frac = currentPatch%burnt_frac_litter(lg_sf) - endif - - ! Perform a check to make sure that spitfire gave - ! us reasonable mortality and burn fraction rates - - if( (leaf_burn_frac < 0._r8) .or. & - (leaf_burn_frac > 1._r8) .or. & - (currentCohort%fire_mort < 0._r8) .or. & - (currentCohort%fire_mort > 1._r8)) then - write(fates_log(),*) 'unexpected fire fractions' - write(fates_log(),*) prt_params%woody(currentCohort%pft) - write(fates_log(),*) leaf_burn_frac - write(fates_log(),*) currentCohort%fire_mort - call endrun(msg=errMsg(sourcefile, __LINE__)) - end if - - do el = 1,num_elements - - leaf_m = nc%prt%GetState(leaf_organ, element_list(el)) - - currentSite%mass_balance(el)%burn_flux_to_atm = & - currentSite%mass_balance(el)%burn_flux_to_atm + & - leaf_burn_frac * leaf_m * nc%n - end do + endif - ! Here the mass is removed from the plant - call PRTBurnLosses(nc%prt, leaf_organ, leaf_burn_frac) - currentCohort%fraction_crown_burned = 0.0_r8 - nc%fraction_crown_burned = 0.0_r8 + ! 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 + ! fire is not the current disturbance regime. + if(i_disturbance_type .ne. dtype_ifire) then + currentPatch%burnt_frac_litter(:) = 0._r8 + end if + call TransLitterNewPatch( currentSite, currentPatch, new_patch, patch_site_areadis) - ! Logging is the current disturbance - elseif (i_disturbance_type .eq. dtype_ilog ) then - - ! If this cohort is in the upper canopy. It generated - if(currentCohort%canopy_layer == 1)then - - ! calculate the survivorship of disturbed trees because non-harvested - nc%n = currentCohort%n * currentCohort%l_degrad - ! nc%n = (currentCohort%l_degrad / (currentCohort%l_degrad + & - ! currentCohort%lmort_direct + currentCohort%lmort_collateral + - ! currentCohort%lmort_infra) ) * & - ! currentCohort%n * patch_site_areadis/currentPatch%area - - ! Reduce counts in the existing/donor patch according to the logging rate - currentCohort%n = currentCohort%n * & - (1.0_r8 - min(1.0_r8,(currentCohort%lmort_direct + & - currentCohort%lmort_collateral + & - currentCohort%lmort_infra + currentCohort%l_degrad))) - - nc%cmort = currentCohort%cmort - nc%hmort = currentCohort%hmort - nc%bmort = currentCohort%bmort - nc%frmort = currentCohort%frmort - nc%smort = currentCohort%smort - nc%asmort = currentCohort%asmort - nc%dmort = currentCohort%dmort - - ! since these are the ones that weren't logged, - ! set the logging mortality rates as zero - nc%lmort_direct = 0._r8 - nc%lmort_collateral = 0._r8 - nc%lmort_infra = 0._r8 - - else - - ! What to do with cohorts in the understory of a logging generated - ! disturbance patch? - - if(prt_params%woody(currentCohort%pft) == itrue)then - - - ! Survivorship of undestory woody plants. Two step process. - ! Step 1: Reduce current number of plants to reflect the - ! change in area. - ! The number density per square are doesn't change, - ! but since the patch is smaller - ! and cohort counts are absolute, reduce this number. - nc%n = currentCohort%n * patch_site_areadis/currentPatch%area - - ! because the mortality rate due to impact for the cohorts which had - ! been in the understory and are now in the newly- - ! disturbed patch is very high, passing the imort directly to - ! history results in large numerical errors, on account - ! of the sharply reduced number densities. so instead pass this info - ! via a site-level diagnostic variable before reducing - ! the number density. - currentSite%imort_rate(currentCohort%size_class, currentCohort%pft) = & - currentSite%imort_rate(currentCohort%size_class, currentCohort%pft) + & - nc%n * currentPatch%fract_ldist_not_harvested * & - logging_coll_under_frac / hlm_freq_day - - currentSite%imort_carbonflux(currentCohort%pft) = & - currentSite%imort_carbonflux(currentCohort%pft) + & - (nc%n * currentPatch%fract_ldist_not_harvested * & - logging_coll_under_frac/ hlm_freq_day ) * & - total_c * g_per_kg * days_per_sec * years_per_day * ha_per_m2 - - - ! Step 2: Apply survivor ship function based on the understory death fraction - - ! remaining of understory plants of those that are knocked - ! over by the overstorey trees dying... - ! LOGGING SURVIVORSHIP OF UNDERSTORY PLANTS IS SET AS A NEW PARAMETER - ! in the fatesparameter files - nc%n = nc%n * (1.0_r8 - & - (1.0_r8-currentPatch%fract_ldist_not_harvested) * logging_coll_under_frac) - - ! Step 3: Reduce the number count of cohorts in the - ! original/donor/non-disturbed patch to reflect the area change - currentCohort%n = currentCohort%n * (1._r8 - patch_site_areadis/currentPatch%area) - - nc%cmort = currentCohort%cmort - nc%hmort = currentCohort%hmort - nc%bmort = currentCohort%bmort - nc%frmort = currentCohort%frmort - nc%smort = currentCohort%smort - nc%asmort = currentCohort%asmort - nc%dmort = currentCohort%dmort - nc%lmort_direct = currentCohort%lmort_direct - nc%lmort_collateral = currentCohort%lmort_collateral - nc%lmort_infra = currentCohort%lmort_infra - + ! Transfer in litter fluxes from plants in various contexts of death and destruction + + if(i_disturbance_type .eq. dtype_ilog) then + call logging_litter_fluxes(currentSite, currentPatch, & + new_patch, patch_site_areadis,bc_in) + elseif(i_disturbance_type .eq. dtype_ifire) then + call fire_litter_fluxes(currentSite, currentPatch, & + new_patch, patch_site_areadis,bc_in) else - - ! grass is not killed by mortality disturbance events. - ! Just move it into the new patch area. - ! Just split the grass into the existing and new patch structures - nc%n = currentCohort%n * patch_site_areadis/currentPatch%area - - ! Those remaining in the existing - currentCohort%n = currentCohort%n * (1._r8 - patch_site_areadis/currentPatch%area) - - ! No grass impact mortality imposed on the newly created patch - nc%cmort = currentCohort%cmort - nc%hmort = currentCohort%hmort - nc%bmort = currentCohort%bmort - nc%frmort = currentCohort%frmort - nc%smort = currentCohort%smort - nc%asmort = currentCohort%asmort - nc%dmort = currentCohort%dmort - nc%lmort_direct = currentCohort%lmort_direct - nc%lmort_collateral = currentCohort%lmort_collateral - nc%lmort_infra = currentCohort%lmort_infra - - endif ! is/is-not woody - - endif ! Select canopy layer - - else - write(fates_log(),*) 'unknown disturbance mode?' - write(fates_log(),*) 'i_disturbance_type: ', i_disturbance_type - call endrun(msg=errMsg(sourcefile, __LINE__)) - end if ! Select disturbance mode - - if (nc%n > 0.0_r8) then - storebigcohort => new_patch%tallest - storesmallcohort => new_patch%shortest - if(associated(new_patch%tallest))then - tnull = 0 - else - tnull = 1 - new_patch%tallest => nc - nc%taller => null() - endif - - if(associated(new_patch%shortest))then - snull = 0 + call mortality_litter_fluxes(currentSite, currentPatch, & + new_patch, patch_site_areadis,bc_in) + endif + + + ! Copy any means or timers from the original patch to the new patch + ! These values will inherit all info from the original patch + ! -------------------------------------------------------------------------- + call new_patch%tveg24%CopyFromDonor(currentPatch%tveg24) + call new_patch%tveg_lpa%CopyFromDonor(currentPatch%tveg_lpa) + + + ! -------------------------------------------------------------------------- + ! The newly formed patch from disturbance (new_patch), has now been given + ! some litter from dead plants and pre-existing litter from the donor patches. + ! + ! Next, we loop through the cohorts in the donor patch, copy them with + ! area modified number density into the new-patch, and apply survivorship. + ! ------------------------------------------------------------------------- + + currentCohort => currentPatch%shortest + do while(associated(currentCohort)) + + allocate(nc) + if(hlm_use_planthydro.eq.itrue) call InitHydrCohort(CurrentSite,nc) + + ! Initialize the PARTEH object and point to the + ! correct boundary condition fields + nc%prt => null() + call InitPRTObject(nc%prt) + call InitPRTBoundaryConditions(nc) + + ! (Keeping as an example) + ! Allocate running mean functions + !allocate(nc%tveg_lpa) + !call nc%tveg_lpa%InitRMean(ema_lpa,init_value=new_patch%tveg_lpa%GetMean()) + + call zero_cohort(nc) + + ! nc is the new cohort that goes in the disturbed patch (new_patch)... currentCohort + ! is the curent cohort that stays in the donor patch (currentPatch) + call copy_cohort(currentCohort, nc) + + !this is the case as the new patch probably doesn't have a closed canopy, and + ! even if it does, that will be sorted out in canopy_structure. + nc%canopy_layer = 1 + nc%canopy_layer_yesterday = 1._r8 + + sapw_c = currentCohort%prt%GetState(sapw_organ, all_carbon_elements) + struct_c = currentCohort%prt%GetState(struct_organ, all_carbon_elements) + leaf_c = currentCohort%prt%GetState(leaf_organ, all_carbon_elements) + fnrt_c = currentCohort%prt%GetState(fnrt_organ, all_carbon_elements) + store_c = currentCohort%prt%GetState(store_organ, all_carbon_elements) + total_c = sapw_c + struct_c + leaf_c + fnrt_c + store_c + + ! treefall mortality is the current disturbance + if(i_disturbance_type .eq. dtype_ifall) then + + if(currentCohort%canopy_layer == 1)then + + ! In the donor patch we are left with fewer trees because the area has decreased + ! the plant density for large trees does not actually decrease in the donor patch + ! because this is the part of the original patch where no trees have actually fallen + ! The diagnostic cmort,bmort,hmort, and frmort rates have already been saved + + currentCohort%n = currentCohort%n * (1.0_r8 - fates_mortality_disturbance_fraction * & + min(1.0_r8,currentCohort%dmort * hlm_freq_day)) + + nc%n = 0.0_r8 ! kill all of the trees who caused the disturbance. + + nc%cmort = nan ! The mortality diagnostics are set to nan + ! because the cohort should dissappear + nc%hmort = nan + nc%bmort = nan + nc%frmort = nan + nc%smort = nan + nc%asmort = nan + nc%lmort_direct = nan + nc%lmort_collateral = nan + nc%lmort_infra = nan + nc%l_degrad = nan + + else + ! small trees + if( prt_params%woody(currentCohort%pft) == itrue)then + + + ! Survivorship of undestory woody plants. Two step process. + ! Step 1: Reduce current number of plants to reflect the + ! change in area. + ! The number density per square are doesn't change, + ! but since the patch is smaller and cohort counts + ! are absolute, reduce this number. + + nc%n = currentCohort%n * patch_site_areadis/currentPatch%area + + ! because the mortality rate due to impact for the cohorts which + ! had been in the understory and are now in the newly- + ! disturbed patch is very high, passing the imort directly to history + ! results in large numerical errors, on account of the sharply + ! reduced number densities. so instead pass this info via a + ! site-level diagnostic variable before reducing the number density. + + currentSite%imort_rate(currentCohort%size_class, currentCohort%pft) = & + currentSite%imort_rate(currentCohort%size_class, currentCohort%pft) + & + nc%n * ED_val_understorey_death / hlm_freq_day + + + currentSite%imort_carbonflux(currentCohort%pft) = & + currentSite%imort_carbonflux(currentCohort%pft) + & + (nc%n * ED_val_understorey_death / hlm_freq_day ) * & + total_c * g_per_kg * days_per_sec * years_per_day * ha_per_m2 + + ! Step 2: Apply survivor ship function based on the understory death fraction + ! remaining of understory plants of those that are knocked over + ! by the overstorey trees dying... + nc%n = nc%n * (1.0_r8 - ED_val_understorey_death) + + ! since the donor patch split and sent a fraction of its members + ! to the new patch and a fraction to be preserved in itself, + ! when reporting diagnostic rates, we must carry over the mortality rates from + ! the donor that were applied before the patch split. Remember this is only + ! for diagnostics. But think of it this way, the rates are weighted by + ! number density in EDCLMLink, and the number density of this new patch is donated + ! so with the number density must come the effective mortality rates. + + nc%cmort = currentCohort%cmort + nc%hmort = currentCohort%hmort + nc%bmort = currentCohort%bmort + nc%frmort = currentCohort%frmort + nc%smort = currentCohort%smort + nc%asmort = currentCohort%asmort + nc%dmort = currentCohort%dmort + nc%lmort_direct = currentCohort%lmort_direct + nc%lmort_collateral = currentCohort%lmort_collateral + nc%lmort_infra = currentCohort%lmort_infra + + ! understory trees that might potentially be knocked over in the disturbance. + ! The existing (donor) patch should not have any impact mortality, it should + ! only lose cohorts due to the decrease in area. This is not mortality. + ! Besides, the current and newly created patch sum to unity + + currentCohort%n = currentCohort%n * (1._r8 - patch_site_areadis/currentPatch%area) + + else + ! grass is not killed by mortality disturbance events. Just move it into the new patch area. + ! Just split the grass into the existing and new patch structures + nc%n = currentCohort%n * patch_site_areadis/currentPatch%area + + ! Those remaining in the existing + currentCohort%n = currentCohort%n * (1._r8 - patch_site_areadis/currentPatch%area) + + nc%cmort = currentCohort%cmort + nc%hmort = currentCohort%hmort + nc%bmort = currentCohort%bmort + nc%frmort = currentCohort%frmort + nc%smort = currentCohort%smort + nc%asmort = currentCohort%asmort + nc%dmort = currentCohort%dmort + nc%lmort_direct = currentCohort%lmort_direct + nc%lmort_collateral = currentCohort%lmort_collateral + nc%lmort_infra = currentCohort%lmort_infra + + endif + endif + + ! Fire is the current disturbance + elseif (i_disturbance_type .eq. dtype_ifire ) then + + ! Number of members in the new patch, before we impose fire survivorship + nc%n = currentCohort%n * patch_site_areadis/currentPatch%area + + ! loss of individuals from source patch due to area shrinking + currentCohort%n = currentCohort%n * (1._r8 - patch_site_areadis/currentPatch%area) + + levcan = currentCohort%canopy_layer + + if(levcan==ican_upper) then + + ! before changing number densities, track total rate of trees that died + ! due to fire, as well as from each fire mortality term + currentSite%fmort_rate_canopy(currentCohort%size_class, currentCohort%pft) = & + currentSite%fmort_rate_canopy(currentCohort%size_class, currentCohort%pft) + & + nc%n * currentCohort%fire_mort / hlm_freq_day + + currentSite%fmort_carbonflux_canopy(currentCohort%pft) = & + currentSite%fmort_carbonflux_canopy(currentCohort%pft) + & + (nc%n * currentCohort%fire_mort) * & + total_c * g_per_kg * days_per_sec * ha_per_m2 + + else + currentSite%fmort_rate_ustory(currentCohort%size_class, currentCohort%pft) = & + currentSite%fmort_rate_ustory(currentCohort%size_class, currentCohort%pft) + & + nc%n * currentCohort%fire_mort / hlm_freq_day + + currentSite%fmort_carbonflux_ustory(currentCohort%pft) = & + currentSite%fmort_carbonflux_ustory(currentCohort%pft) + & + (nc%n * currentCohort%fire_mort) * & + total_c * g_per_kg * days_per_sec * ha_per_m2 + end if + + currentSite%fmort_rate_cambial(currentCohort%size_class, currentCohort%pft) = & + currentSite%fmort_rate_cambial(currentCohort%size_class, currentCohort%pft) + & + nc%n * currentCohort%cambial_mort / hlm_freq_day + currentSite%fmort_rate_crown(currentCohort%size_class, currentCohort%pft) = & + currentSite%fmort_rate_crown(currentCohort%size_class, currentCohort%pft) + & + nc%n * currentCohort%crownfire_mort / hlm_freq_day + + ! loss of individual from fire in new patch. + nc%n = nc%n * (1.0_r8 - currentCohort%fire_mort) + + nc%cmort = currentCohort%cmort + nc%hmort = currentCohort%hmort + nc%bmort = currentCohort%bmort + nc%frmort = currentCohort%frmort + nc%smort = currentCohort%smort + nc%asmort = currentCohort%asmort + nc%dmort = currentCohort%dmort + nc%lmort_direct = currentCohort%lmort_direct + nc%lmort_collateral = currentCohort%lmort_collateral + nc%lmort_infra = currentCohort%lmort_infra + + + ! 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 + + ! Grasses determine their fraction of leaves burned here + + leaf_burn_frac = currentPatch%burnt_frac_litter(lg_sf) + endif + + ! Perform a check to make sure that spitfire gave + ! us reasonable mortality and burn fraction rates + + if( (leaf_burn_frac < 0._r8) .or. & + (leaf_burn_frac > 1._r8) .or. & + (currentCohort%fire_mort < 0._r8) .or. & + (currentCohort%fire_mort > 1._r8)) then + write(fates_log(),*) 'unexpected fire fractions' + write(fates_log(),*) prt_params%woody(currentCohort%pft) + write(fates_log(),*) leaf_burn_frac + write(fates_log(),*) currentCohort%fire_mort + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + do el = 1,num_elements + + leaf_m = nc%prt%GetState(leaf_organ, element_list(el)) + + currentSite%mass_balance(el)%burn_flux_to_atm = & + currentSite%mass_balance(el)%burn_flux_to_atm + & + leaf_burn_frac * leaf_m * nc%n + end do + + ! Here the mass is removed from the plant + + call PRTBurnLosses(nc%prt, leaf_organ, leaf_burn_frac) + currentCohort%fraction_crown_burned = 0.0_r8 + nc%fraction_crown_burned = 0.0_r8 + + + + ! Logging is the current disturbance + elseif (i_disturbance_type .eq. dtype_ilog ) then + + ! If this cohort is in the upper canopy. It generated + if(currentCohort%canopy_layer == 1)then + + ! calculate the survivorship of disturbed trees because non-harvested + nc%n = currentCohort%n * currentCohort%l_degrad + ! nc%n = (currentCohort%l_degrad / (currentCohort%l_degrad + & + ! currentCohort%lmort_direct + currentCohort%lmort_collateral + + ! currentCohort%lmort_infra) ) * & + ! currentCohort%n * patch_site_areadis/currentPatch%area + + ! Reduce counts in the existing/donor patch according to the logging rate + currentCohort%n = currentCohort%n * & + (1.0_r8 - min(1.0_r8,(currentCohort%lmort_direct + & + currentCohort%lmort_collateral + & + currentCohort%lmort_infra + currentCohort%l_degrad))) + + nc%cmort = currentCohort%cmort + nc%hmort = currentCohort%hmort + nc%bmort = currentCohort%bmort + nc%frmort = currentCohort%frmort + nc%smort = currentCohort%smort + nc%asmort = currentCohort%asmort + nc%dmort = currentCohort%dmort + + ! since these are the ones that weren't logged, + ! set the logging mortality rates as zero + nc%lmort_direct = 0._r8 + nc%lmort_collateral = 0._r8 + nc%lmort_infra = 0._r8 + + else + + ! What to do with cohorts in the understory of a logging generated + ! disturbance patch? + + if(prt_params%woody(currentCohort%pft) == itrue)then + + + ! Survivorship of undestory woody plants. Two step process. + ! Step 1: Reduce current number of plants to reflect the + ! change in area. + ! The number density per square are doesn't change, + ! but since the patch is smaller + ! and cohort counts are absolute, reduce this number. + nc%n = currentCohort%n * patch_site_areadis/currentPatch%area + + ! because the mortality rate due to impact for the cohorts which had + ! been in the understory and are now in the newly- + ! disturbed patch is very high, passing the imort directly to + ! history results in large numerical errors, on account + ! of the sharply reduced number densities. so instead pass this info + ! via a site-level diagnostic variable before reducing + ! the number density. + currentSite%imort_rate(currentCohort%size_class, currentCohort%pft) = & + currentSite%imort_rate(currentCohort%size_class, currentCohort%pft) + & + nc%n * currentPatch%fract_ldist_not_harvested * & + logging_coll_under_frac / hlm_freq_day + + currentSite%imort_carbonflux(currentCohort%pft) = & + currentSite%imort_carbonflux(currentCohort%pft) + & + (nc%n * currentPatch%fract_ldist_not_harvested * & + logging_coll_under_frac/ hlm_freq_day ) * & + total_c * g_per_kg * days_per_sec * years_per_day * ha_per_m2 + + + ! Step 2: Apply survivor ship function based on the understory death fraction + + ! remaining of understory plants of those that are knocked + ! over by the overstorey trees dying... + ! LOGGING SURVIVORSHIP OF UNDERSTORY PLANTS IS SET AS A NEW PARAMETER + ! in the fatesparameter files + nc%n = nc%n * (1.0_r8 - & + (1.0_r8-currentPatch%fract_ldist_not_harvested) * logging_coll_under_frac) + + ! Step 3: Reduce the number count of cohorts in the + ! original/donor/non-disturbed patch to reflect the area change + currentCohort%n = currentCohort%n * (1._r8 - patch_site_areadis/currentPatch%area) + + nc%cmort = currentCohort%cmort + nc%hmort = currentCohort%hmort + nc%bmort = currentCohort%bmort + nc%frmort = currentCohort%frmort + nc%smort = currentCohort%smort + nc%asmort = currentCohort%asmort + nc%dmort = currentCohort%dmort + nc%lmort_direct = currentCohort%lmort_direct + nc%lmort_collateral = currentCohort%lmort_collateral + nc%lmort_infra = currentCohort%lmort_infra + + else + + ! grass is not killed by mortality disturbance events. + ! Just move it into the new patch area. + ! Just split the grass into the existing and new patch structures + nc%n = currentCohort%n * patch_site_areadis/currentPatch%area + + ! Those remaining in the existing + currentCohort%n = currentCohort%n * (1._r8 - patch_site_areadis/currentPatch%area) + + ! No grass impact mortality imposed on the newly created patch + nc%cmort = currentCohort%cmort + nc%hmort = currentCohort%hmort + nc%bmort = currentCohort%bmort + nc%frmort = currentCohort%frmort + nc%smort = currentCohort%smort + nc%asmort = currentCohort%asmort + nc%dmort = currentCohort%dmort + nc%lmort_direct = currentCohort%lmort_direct + nc%lmort_collateral = currentCohort%lmort_collateral + nc%lmort_infra = currentCohort%lmort_infra + + endif ! is/is-not woody + + endif ! Select canopy layer + + else + write(fates_log(),*) 'unknown disturbance mode?' + write(fates_log(),*) 'i_disturbance_type: ',i_disturbance_type + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if ! Select disturbance mode + + if (nc%n > 0.0_r8) then + storebigcohort => new_patch%tallest + storesmallcohort => new_patch%shortest + if(associated(new_patch%tallest))then + tnull = 0 + else + tnull = 1 + new_patch%tallest => nc + nc%taller => null() + endif + + if(associated(new_patch%shortest))then + snull = 0 + else + snull = 1 + new_patch%shortest => nc + nc%shorter => null() + endif + nc%patchptr => new_patch + call insert_cohort(nc, new_patch%tallest, new_patch%shortest, & + tnull, snull, storebigcohort, storesmallcohort) + + new_patch%tallest => storebigcohort + new_patch%shortest => storesmallcohort + else + + ! Get rid of the new temporary cohort + call DeallocateCohort(nc) + deallocate(nc) + + endif + + currentCohort => currentCohort%taller + enddo ! currentCohort + call sort_cohorts(currentPatch) + + !update area of donor patch + oldarea = currentPatch%area + currentPatch%area = currentPatch%area - patch_site_areadis + + ! for all disturbance rates that haven't been resolved yet, increase their amount so that + ! they are the same amount of gridcell-scale disturbance relative to the original patch size + if (i_disturbance_type .ne. N_DIST_TYPES) then + do i_dist2 = i_disturbance_type+1,N_DIST_TYPES + currentPatch%disturbance_rates(i_dist2) = currentPatch%disturbance_rates(i_dist2) & + * oldarea / currentPatch%area + end do + end if + + ! sort out the cohorts, since some of them may be so small as to need removing. + ! the first call to terminate cohorts removes sparse number densities, + ! the second call removes for all other reasons (sparse culling must happen + ! before fusion) + call terminate_cohorts(currentSite, currentPatch, 1,16,bc_in) + call fuse_cohorts(currentSite,currentPatch, bc_in) + call terminate_cohorts(currentSite, currentPatch, 2,16,bc_in) + call sort_cohorts(currentPatch) + + end if ! if ( new_patch%area > nearzero ) then + + end if cp_nocomp_matches_2_if + currentPatch => currentPatch%younger + + enddo ! currentPatch patch loop. + + !*************************/ + !** INSERT NEW PATCH(ES) INTO LINKED LIST + !*************************/ + + if ( site_areadis_primary .gt. nearzero) then + currentPatch => currentSite%youngest_patch + ! insert new youngest primary patch after all the secondary patches, if there are any. + ! this requires first finding the current youngest primary to insert the new one ahead of + if (currentPatch%anthro_disturbance_label .eq. secondaryforest ) then + found_youngest_primary = .false. + do while(associated(currentPatch) .and. .not. found_youngest_primary) + currentPatch => currentPatch%older + if (associated(currentPatch)) then + if (currentPatch%anthro_disturbance_label .eq. primaryforest) then + found_youngest_primary = .true. + endif + endif + end do + if (associated(currentPatch)) then + ! the case where we've found a youngest primary patch + new_patch_primary%older => currentPatch + new_patch_primary%younger => currentPatch%younger + currentPatch%younger%older => new_patch_primary + currentPatch%younger => new_patch_primary else - snull = 1 - new_patch%shortest => nc - nc%shorter => null() + ! the case where we haven't, because the patches are all secondaary, + ! and are putting a primary patch at the oldest end of the + ! linked list (not sure how this could happen, but who knows...) + new_patch_primary%older => null() + new_patch_primary%younger => currentSite%oldest_patch + currentSite%oldest_patch%older => new_patch_primary + currentSite%oldest_patch => new_patch_primary endif - nc%patchptr => new_patch - call insert_cohort(nc, new_patch%tallest, new_patch%shortest, & - tnull, snull, storebigcohort, storesmallcohort) - - new_patch%tallest => storebigcohort - new_patch%shortest => storesmallcohort else - - ! Get rid of the new temporary cohort - call DeallocateCohort(nc) - deallocate(nc) - + ! the case where there are no secondary patches at the start of the linked list (prior logic) + new_patch_primary%older => currentPatch + new_patch_primary%younger => null() + currentPatch%younger => new_patch_primary + currentSite%youngest_patch => new_patch_primary endif - - currentCohort => currentCohort%taller - enddo ! currentCohort - call sort_cohorts(currentPatch) - - !update area of donor patch - oldarea = currentPatch%area - currentPatch%area = currentPatch%area - patch_site_areadis - - ! for all disturbance rates that haven't been resolved yet, increase their amount so that - ! they are the same amount of gridcell-scale disturbance relative to the original patch size - if (i_disturbance_type .ne. N_DIST_TYPES) then - do i_dist2 = i_disturbance_type+1,N_DIST_TYPES - currentPatch%disturbance_rates(i_dist2) = currentPatch%disturbance_rates(i_dist2) & - * oldarea / currentPatch%area - end do - end if + endif + + ! insert first secondary at the start of the list + if ( site_areadis_secondary .gt. nearzero) then + currentPatch => currentSite%youngest_patch + new_patch_secondary%older => currentPatch + new_patch_secondary%younger=> null() + currentPatch%younger => new_patch_secondary + currentSite%youngest_patch => new_patch_secondary + endif - ! sort out the cohorts, since some of them may be so small as to need removing. + + ! sort out the cohorts, since some of them may be so small as to need removing. ! the first call to terminate cohorts removes sparse number densities, ! the second call removes for all other reasons (sparse culling must happen ! before fusion) - call terminate_cohorts(currentSite, currentPatch, 1,16,bc_in) - call fuse_cohorts(currentSite,currentPatch, bc_in) - call terminate_cohorts(currentSite, currentPatch, 2,16,bc_in) - call sort_cohorts(currentPatch) - end if ! if ( new_patch%area > nearzero ) then - - end if cp_nocomp_matches_2_if - currentPatch => currentPatch%younger - - enddo ! currentPatch patch loop. + if ( site_areadis_primary .gt. nearzero) then + call terminate_cohorts(currentSite, new_patch_primary, 1,17, bc_in) + call fuse_cohorts(currentSite,new_patch_primary, bc_in) + call terminate_cohorts(currentSite, new_patch_primary, 2,17, bc_in) + call sort_cohorts(new_patch_primary) + endif - !*************************/ - !** INSERT NEW PATCH(ES) INTO LINKED LIST - !*************************/ - - if ( site_areadis_primary .gt. nearzero) then - currentPatch => currentSite%youngest_patch - ! insert new youngest primary patch after all the secondary patches, if there are any. - ! this requires first finding the current youngest primary to insert the new one ahead of - if (currentPatch%anthro_disturbance_label .eq. secondaryforest ) then - found_youngest_primary = .false. - do while(associated(currentPatch) .and. .not. found_youngest_primary) - currentPatch => currentPatch%older - if (associated(currentPatch)) then - if (currentPatch%anthro_disturbance_label .eq. primaryforest) then - found_youngest_primary = .true. - endif - endif - end do - if (associated(currentPatch)) then - ! the case where we've found a youngest primary patch - new_patch_primary%older => currentPatch - new_patch_primary%younger => currentPatch%younger - currentPatch%younger%older => new_patch_primary - currentPatch%younger => new_patch_primary - else - ! the case where we haven't, because the patches are all secondaary, - ! and are putting a primary patch at the oldest end of the - ! linked list (not sure how this could happen, but who knows...) - new_patch_primary%older => null() - new_patch_primary%younger => currentSite%oldest_patch - currentSite%oldest_patch%older => new_patch_primary - currentSite%oldest_patch => new_patch_primary + if ( site_areadis_secondary .gt. nearzero) then + call terminate_cohorts(currentSite, new_patch_secondary, 1,18,bc_in) + call fuse_cohorts(currentSite,new_patch_secondary, bc_in) + call terminate_cohorts(currentSite, new_patch_secondary, 2,18,bc_in) + call sort_cohorts(new_patch_secondary) endif - else - ! the case where there are no secondary patches at the start of the linked list (prior logic) - new_patch_primary%older => currentPatch - new_patch_primary%younger => null() - currentPatch%younger => new_patch_primary - currentSite%youngest_patch => new_patch_primary - endif - endif - - ! insert first secondary at the start of the list - if ( site_areadis_secondary .gt. nearzero) then - currentPatch => currentSite%youngest_patch - new_patch_secondary%older => currentPatch - new_patch_secondary%younger=> null() - currentPatch%younger => new_patch_secondary - currentSite%youngest_patch => new_patch_secondary - endif - - - ! sort out the cohorts, since some of them may be so small as to need removing. - ! the first call to terminate cohorts removes sparse number densities, - ! the second call removes for all other reasons (sparse culling must happen - ! before fusion) - - if ( site_areadis_primary .gt. nearzero) then - call terminate_cohorts(currentSite, new_patch_primary, 1,17, bc_in) - call fuse_cohorts(currentSite,new_patch_primary, bc_in) - call terminate_cohorts(currentSite, new_patch_primary, 2,17, bc_in) - call sort_cohorts(new_patch_primary) - endif - - if ( site_areadis_secondary .gt. nearzero) then - call terminate_cohorts(currentSite, new_patch_secondary, 1,18,bc_in) - call fuse_cohorts(currentSite,new_patch_secondary, bc_in) - call terminate_cohorts(currentSite, new_patch_secondary, 2,18,bc_in) - call sort_cohorts(new_patch_secondary) - endif - - endif !end new_patch area - - - call check_patch_area(currentSite) - call set_patchno(currentSite) - - end do disturbance_type_loop + + endif !end new_patch area + + + call check_patch_area(currentSite) + call set_patchno(currentSite) + + end do disturbance_type_loop end do nocomp_pft_loop @@ -2401,11 +2405,6 @@ subroutine fuse_patches( csite, bc_in ) tpp => currentSite%youngest_patch tpp_loop: do while(associated(tpp)) - if(.not.associated(currentPatch))then - write(fates_log(),*) 'FATES fuse_patches(): currentPatch is not associated?' - call endrun(msg=errMsg(sourcefile, __LINE__)) - endif - both_associated_if: if(associated(tpp).and.associated(currentPatch))then !--------------------------------------------------------------------! ! only fuse patches whose anthropogenic disturbance category matches ! From b35025e727028454ae7c1c8f9949526f8fb5a062 Mon Sep 17 00:00:00 2001 From: Shijie Shu Date: Wed, 23 Nov 2022 16:42:50 -0800 Subject: [PATCH 15/20] Ignore small logging disturbance. --- biogeochem/EDPatchDynamicsMod.F90 | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index c0f6ade5e3..9c5034c647 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -398,6 +398,12 @@ subroutine disturbance_rates( site_in, bc_in) (currentPatch%area - currentPatch%total_canopy_area) * harvest_rate / currentPatch%area endif + ! For nocomp mode, we need to prevent producing too small patches, which may produce small patches + if ((hlm_use_nocomp .eq. itrue) .and. & + (currentPatch%disturbance_rates(dtype_ilog)*currentPatch%area .lt. min_patch_area_forced)) then + currentPatch%disturbance_rates(dtype_ilog) = 0._r8 + end if + ! fraction of the logging disturbance rate that is non-harvested if (currentPatch%disturbance_rates(dtype_ilog) .gt. nearzero) then currentPatch%fract_ldist_not_harvested = dist_rate_ldist_notharvested / & From 23ee93f0651c06eea7dc1c4c7899b9bbc61b92f0 Mon Sep 17 00:00:00 2001 From: Shijie Shu Date: Tue, 20 Dec 2022 13:30:53 -0800 Subject: [PATCH 16/20] Create subroutine to encapsulate the calculation of harvest debt. --- biogeochem/EDCanopyStructureMod.F90 | 2 +- biogeochem/EDLoggingMortalityMod.F90 | 65 ++++++++++++++++++++++++++++ biogeochem/EDPatchDynamicsMod.F90 | 46 +------------------- 3 files changed, 68 insertions(+), 45 deletions(-) diff --git a/biogeochem/EDCanopyStructureMod.F90 b/biogeochem/EDCanopyStructureMod.F90 index a9c8740b6c..05c86c02f2 100644 --- a/biogeochem/EDCanopyStructureMod.F90 +++ b/biogeochem/EDCanopyStructureMod.F90 @@ -1784,7 +1784,7 @@ subroutine update_hlm_dynamics(nsites,sites,fcolumn,bc_out) use EDTypesMod , only : ed_patch_type, ed_cohort_type, & ed_site_type, AREA - use FatesInterfaceTypesMod , only : bc_in_type, bc_out_type + use FatesInterfaceTypesMod , only : bc_out_type ! ! !ARGUMENTS diff --git a/biogeochem/EDLoggingMortalityMod.F90 b/biogeochem/EDLoggingMortalityMod.F90 index c70d880a2f..c695bc4f2e 100644 --- a/biogeochem/EDLoggingMortalityMod.F90 +++ b/biogeochem/EDLoggingMortalityMod.F90 @@ -97,6 +97,7 @@ module EDLoggingMortalityMod public :: get_harvest_rate_area public :: get_harvestable_carbon public :: get_harvest_rate_carbon + public :: get_harvest_debt public :: UpdateHarvestC contains @@ -1116,6 +1117,70 @@ subroutine UpdateHarvestC(currentSite,bc_out) AREA_INV * (1._r8 - pprodharv10_forest_mean) * unit_trans_factor return + end subroutine UpdateHarvestC + subroutine get_harvest_debt(site_in, bc_in, harvest_tag) + + ! + ! !DESCRIPTION: + ! + ! Calculate if we have harvest debt for primary and secondary land + ! Harvest debt is the accumulated total carbon + ! deficiency once the carbon amount available for harvest + ! is smaller than the harvest rate of forcing data. + ! Harvest debt is calculated on site level + ! TODO: we can define harvest debt as a fraction of the + ! harvest rate in the future + ! Note: Non-forest harvest is accounted for under forest + ! harvest, thus the harvest tag for non-forest is not applicable (= 2) + ! + ! !ARGUMENTS: + type(ed_site_type) , intent(inout), target :: site_in + type(bc_in_type), intent(in) :: bc_in + integer :: harvest_tag(hlm_num_lu_harvest_cats) + + ! !LOCAL VARIABLES: + integer :: h_index + real(r8) :: harvest_debt_pri + real(r8) :: harvest_debt_sec_mature + real(r8) :: harvest_debt_sec_young + + if(logging_time) then + ! First we need to get harvest rate for all three categories + do h_index = 1, hlm_num_lu_harvest_cats + ! Primary forest harvest rate + if(bc_in%hlm_harvest_catnames(h_index) .eq. "HARVEST_VH1" .or. & + bc_in%hlm_harvest_catnames(h_index) .eq. "HARVEST_VH2" ) then + harvest_debt_pri = harvest_debt_pri + bc_in%hlm_harvest_rates(h_index) + else if(bc_in%hlm_harvest_catnames(h_index) .eq. "HARVEST_SH1") then + harvest_debt_sec_mature = harvest_debt_sec_mature + bc_in%hlm_harvest_rates(h_index) + else if(bc_in%hlm_harvest_catnames(h_index) .eq. "HARVEST_SH2" .or. & + bc_in%hlm_harvest_catnames(h_index) .eq. "HARVEST_SH3") then + harvest_debt_sec_young = harvest_debt_sec_young + bc_in%hlm_harvest_rates(h_index) + end if + end do + ! Next we get the harvest debt through the harvest tag + do h_index = 1, hlm_num_lu_harvest_cats + if (harvest_tag(h_index) .eq. 1) then + if(bc_in%hlm_harvest_catnames(h_index) .eq. "HARVEST_VH1") then + site_in%resources_management%harvest_debt = site_in%resources_management%harvest_debt + & + harvest_debt_pri + else if(bc_in%hlm_harvest_catnames(h_index) .eq. "HARVEST_SH1") then + site_in%resources_management%harvest_debt = site_in%resources_management%harvest_debt + & + harvest_debt_sec_mature + site_in%resources_management%harvest_debt_sec = site_in%resources_management%harvest_debt_sec + & + harvest_debt_sec_mature + else if(bc_in%hlm_harvest_catnames(h_index) .eq. "HARVEST_SH2") then + site_in%resources_management%harvest_debt = site_in%resources_management%harvest_debt + & + harvest_debt_sec_young + site_in%resources_management%harvest_debt_sec = site_in%resources_management%harvest_debt_sec + & + harvest_debt_sec_young + end if + end if + end do + end if + + end subroutine get_harvest_debt + end module EDLoggingMortalityMod diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index e42a1ff9ae..0875151f51 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -60,6 +60,7 @@ module EDPatchDynamicsMod use EDLoggingMortalityMod, only : get_harvest_rate_area use EDLoggingMortalityMod, only : get_harvest_rate_carbon use EDLoggingMortalityMod, only : get_harvestable_carbon + use EDLoggingMortalityMod, only : get_harvest_debt use EDParamsMod , only : fates_mortality_disturbance_fraction use FatesAllometryMod , only : carea_allom use FatesAllometryMod , only : set_root_fraction @@ -268,50 +269,7 @@ subroutine disturbance_rates( site_in, bc_in) currentPatch => currentPatch%younger end do - ! Calculate if we have harvest debt for primary and secondary land - ! Harvest debt is the accumulated total carbon - ! deficiency once the carbon amount available for harvest - ! is smaller than the harvest rate of forcing data. - ! Harvest debt is calculated on site level - ! TODO: we can define harvest debt as a fraction of the - ! harvest rate in the future - ! Note: Non-forest harvest is accounted for under forest - ! harvest, thus the harvest tag for non-forest is not applicable (= 2) - - if(logging_time) then - ! First we need to get harvest rate for all three categories - do h_index = 1, hlm_num_lu_harvest_cats - ! Primary forest harvest rate - if(bc_in%hlm_harvest_catnames(h_index) .eq. "HARVEST_VH1" .or. & - bc_in%hlm_harvest_catnames(h_index) .eq. "HARVEST_VH2" ) then - harvest_debt_pri = harvest_debt_pri + bc_in%hlm_harvest_rates(h_index) - else if(bc_in%hlm_harvest_catnames(h_index) .eq. "HARVEST_SH1") then - harvest_debt_sec_mature = harvest_debt_sec_mature + bc_in%hlm_harvest_rates(h_index) - else if(bc_in%hlm_harvest_catnames(h_index) .eq. "HARVEST_SH2" .or. & - bc_in%hlm_harvest_catnames(h_index) .eq. "HARVEST_SH3") then - harvest_debt_sec_mature = harvest_debt_sec_mature + bc_in%hlm_harvest_rates(h_index) - end if - end do - ! Next we get the harvest debt through the harvest tag - do h_index = 1, hlm_num_lu_harvest_cats - if (harvest_tag(h_index) .eq. 1) then - if(bc_in%hlm_harvest_catnames(h_index) .eq. "HARVEST_VH1") then - site_in%resources_management%harvest_debt = site_in%resources_management%harvest_debt + & - harvest_debt_pri - else if(bc_in%hlm_harvest_catnames(h_index) .eq. "HARVEST_SH1") then - site_in%resources_management%harvest_debt = site_in%resources_management%harvest_debt + & - harvest_debt_sec_mature - site_in%resources_management%harvest_debt_sec = site_in%resources_management%harvest_debt_sec + & - harvest_debt_sec_mature - else if(bc_in%hlm_harvest_catnames(h_index) .eq. "HARVEST_SH2") then - site_in%resources_management%harvest_debt = site_in%resources_management%harvest_debt + & - harvest_debt_sec_young - site_in%resources_management%harvest_debt_sec = site_in%resources_management%harvest_debt_sec + & - harvest_debt_sec_young - end if - end if - end do - end if + call get_harvest_debt(site_in, bc_in, harvest_tag) ! --------------------------------------------------------------------------------------------- ! Calculate Disturbance Rates based on the mortality rates just calculated From eb609b595a1f5bb83f0e174fa80a19dac64d151a Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Fri, 6 Jan 2023 16:36:48 -0500 Subject: [PATCH 17/20] all_carbon to carbon12 --- biogeochem/EDLoggingMortalityMod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/biogeochem/EDLoggingMortalityMod.F90 b/biogeochem/EDLoggingMortalityMod.F90 index b42b90ddc9..f711f3bcef 100644 --- a/biogeochem/EDLoggingMortalityMod.F90 +++ b/biogeochem/EDLoggingMortalityMod.F90 @@ -480,8 +480,8 @@ subroutine get_harvestable_carbon (csite, site_area, hlm_harvest_catnames, harve ! only account for cohorts matching the following conditions if(int(prt_params%woody(pft)) == 1)then ! only set logging rates for trees - sapw_m = currentCohort%prt%GetState(sapw_organ, all_carbon_elements) - struct_m = currentCohort%prt%GetState(struct_organ, all_carbon_elements) + sapw_m = currentCohort%prt%GetState(sapw_organ, carbon12_element) + struct_m = currentCohort%prt%GetState(struct_organ, carbon12_element) ! logging_direct_frac shall be 1 for LUH2 driven simulation and global simulation ! in site level study logging_direct_frac shall be surveyed ! unit: [kgC ] = [kgC/plant] * [plant/ha] * [ha/ 10k m2] * [ m2 area ] From f1f855d7e0ecdab32625f3b5cca15628c4507b86 Mon Sep 17 00:00:00 2001 From: Shijie Shu <92333861+sshu88@users.noreply.github.com> Date: Wed, 18 Jan 2023 11:33:41 -0800 Subject: [PATCH 18/20] Update EDPatchDynamicsMod.F90 --- biogeochem/EDPatchDynamicsMod.F90 | 15 --------------- 1 file changed, 15 deletions(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 31557c1cf3..387ed5760c 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -195,12 +195,8 @@ subroutine disturbance_rates( site_in, bc_in) real(r8) :: frac_site_primary real(r8) :: harvest_rate real(r8) :: tempsum - real(r8) :: harvest_debt_pri - real(r8) :: harvest_debt_sec_mature - real(r8) :: harvest_debt_sec_young real(r8) :: harvestable_forest_c(hlm_num_lu_harvest_cats) integer :: harvest_tag(hlm_num_lu_harvest_cats) - integer :: patch_no_secondary !---------------------------------------------------------------------------------------------- ! Calculate Mortality Rates (these were previously calculated during growth derivatives) @@ -213,12 +209,6 @@ subroutine disturbance_rates( site_in, bc_in) ! get available biomass for harvest for all patches call get_harvestable_carbon(site_in, bc_in%site_area, bc_in%hlm_harvest_catnames, harvestable_forest_c) - ! Initialize local variables - patch_no_secondary = 0 - harvest_debt_pri = 0._r8 - harvest_debt_sec_mature = 0._r8 - harvest_debt_sec_young = 0._r8 - currentPatch => site_in%oldest_patch do while (associated(currentPatch)) @@ -260,11 +250,6 @@ subroutine disturbance_rates( site_in, bc_in) currentCohort => currentCohort%taller end do - ! ! Counter of secondary patch used in logging debt calculation - ! if ( currentPatch%anthro_disturbance_label .eq. secondaryforest ) then - ! patch_no_secondary = patch_no_secondary + 1 - ! end if - currentPatch => currentPatch%younger end do From 25047167fddd3708b407c775f2660890ea25487e Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 26 Jan 2023 10:31:52 -0800 Subject: [PATCH 19/20] manually reinstate tveg history variable --- main/FatesHistoryInterfaceMod.F90 | 28 ++++++++++++++-------------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 4380ef63bc..54be8b6e98 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -331,7 +331,7 @@ module FatesHistoryInterfaceMod ! Indices to (site) variables integer :: ih_tveg24_si - !integer :: ih_tveg_si + integer :: ih_tveg_si integer :: ih_nep_si integer :: ih_hr_si @@ -4370,8 +4370,8 @@ subroutine update_history_hifrq(this,nc,nsites,sites,bc_in,dt_tstep) hio_fabi_sun_top_si_can => this%hvars(ih_fabi_sun_top_si_can)%r82d, & hio_fabi_sha_top_si_can => this%hvars(ih_fabi_sha_top_si_can)%r82d, & hio_parsun_top_si_can => this%hvars(ih_parsun_top_si_can)%r82d, & - hio_parsha_top_si_can => this%hvars(ih_parsha_top_si_can)%r82d)!, & - !hio_tveg => this%hvars(ih_tveg_si)%r81d) + hio_parsha_top_si_can => this%hvars(ih_parsha_top_si_can)%r82d, & + hio_tveg => this%hvars(ih_tveg_si)%r81d) ! Flush the relevant history variables call this%flush_hvars(nc,upfreq_in=2) @@ -4425,12 +4425,12 @@ subroutine update_history_hifrq(this,nc,nsites,sites,bc_in,dt_tstep) hio_rad_error_si(io_si) = hio_rad_error_si(io_si) + & cpatch%radiation_error * cpatch%area * AREA_INV - ! ! Only accumulate the instantaneous vegetation temperature for vegetated patches - ! if (cpatch%patchno .ne. 0) then - ! hio_tveg(io_si) = hio_tveg(io_si) + & - ! (bc_in(s)%t_veg_pa(cpatch%patchno) - t_water_freeze_k_1atm) * & - ! cpatch%area / site_area_veg - ! end if + ! Only accumulate the instantaneous vegetation temperature for vegetated patches + if (cpatch%patchno .ne. 0) then + hio_tveg(io_si) = hio_tveg(io_si) + & + (bc_in(s)%t_veg_pa(cpatch%patchno) - t_water_freeze_k_1atm) * & + cpatch%area / site_area_veg + end if ccohort => cpatch%shortest do while(associated(ccohort)) @@ -6223,11 +6223,11 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=site_r8, hlms='CLM:ALM', upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_tveg24_si ) - ! call this%set_history_var(vname='FATES_TVEG', units='degree_Celsius', & - ! long='fates instantaneous mean vegetation temperature by site', & - ! use_default='active', & - ! avgflag='A', vtype=site_r8, hlms='CLM:ALM', upfreq=2, & - ! ivar=ivar, initialize=initialize_variables, index = ih_tveg_si ) + call this%set_history_var(vname='FATES_TVEG', units='degree_Celsius', & + long='fates instantaneous mean vegetation temperature by site', & + use_default='active', & + avgflag='A', vtype=site_r8, hlms='CLM:ALM', upfreq=2, & + ivar=ivar, initialize=initialize_variables, index = ih_tveg_si ) ! radiation error From d80ef2083419929ced7e1fa151238bd45bd258c8 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 26 Jan 2023 13:10:01 -0700 Subject: [PATCH 20/20] add local variable initialization for get_harvest_debt --- biogeochem/EDLoggingMortalityMod.F90 | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/biogeochem/EDLoggingMortalityMod.F90 b/biogeochem/EDLoggingMortalityMod.F90 index f711f3bcef..73ea7231e7 100644 --- a/biogeochem/EDLoggingMortalityMod.F90 +++ b/biogeochem/EDLoggingMortalityMod.F90 @@ -1147,6 +1147,12 @@ subroutine get_harvest_debt(site_in, bc_in, harvest_tag) real(r8) :: harvest_debt_sec_young if(logging_time) then + + ! Initialize the local variables + harvest_debt_pri = 0._r8 + harvest_debt_sec_mature = 0._r8 + harvest_debt_sec_young = 0._r8 + ! First we need to get harvest rate for all three categories do h_index = 1, hlm_num_lu_harvest_cats ! Primary forest harvest rate