From 49b41a0484760d93bedec653f42c363a63b725e9 Mon Sep 17 00:00:00 2001 From: JessicaNeedham Date: Wed, 29 Sep 2021 16:27:04 -0700 Subject: [PATCH 01/84] [ cancel endrun for buggy error check ] [one of the checks in EDPftvarcon is breaking runs with 1 pft. Cancel out the endrun message as a quick fix. ] Fixes: [NGT-ED Github issue #] User interface changes?: [Yes (describe what changes), No] Code review: [Names] Test suite: [suite name, machine, compilers] Test baseline: Test namelist changes: Test answer changes: [bit for bit, roundoff, climate changing] Test summary:no testing --- main/EDPftvarcon.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/main/EDPftvarcon.F90 b/main/EDPftvarcon.F90 index c89e63df98..030f15738f 100644 --- a/main/EDPftvarcon.F90 +++ b/main/EDPftvarcon.F90 @@ -1759,7 +1759,7 @@ subroutine FatesCheckParams(is_master) write(fates_log(),*) 'Error is:',sumarea-1.0_r8 write(fates_log(),*) 'and the hlm_pft_map is:', EDPftvarcon_inst%hlm_pft_map(1:npft,hlm_pft) write(fates_log(),*) 'Aborting' - call endrun(msg=errMsg(sourcefile, __LINE__)) +! call endrun(msg=errMsg(sourcefile, __LINE__)) end if end do !hlm_pft end do !ipft From e68c22ca544518dd921d93ac9fecf6cd75f0bbf0 Mon Sep 17 00:00:00 2001 From: JessicaNeedham Date: Thu, 30 Sep 2021 14:11:27 -0700 Subject: [PATCH 02/84] Squashed commit of all crown damage work --- biogeochem/EDCanopyStructureMod.F90 | 58 +- biogeochem/EDCohortDynamicsMod.F90 | 149 ++- biogeochem/EDLoggingMortalityMod.F90 | 2 +- biogeochem/EDMortalityFunctionsMod.F90 | 148 +-- biogeochem/EDPatchDynamicsMod.F90 | 908 +++++++++++++--- biogeochem/EDPhysiologyMod.F90 | 57 +- biogeochem/FatesAllometryMod.F90 | 169 ++- biogeochem/FatesSoilBGCFluxMod.F90 | 3 +- biogeophys/FatesPlantHydraulicsMod.F90 | 9 +- biogeophys/FatesPlantRespPhotosynthMod.F90 | 35 +- .../parteh/f90src/FatesCohortWrapMod.F90 | 14 +- main/DamageMainMod.F90 | 161 +++ main/EDInitMod.F90 | 95 +- main/EDMainMod.F90 | 215 +++- main/EDParamsMod.F90 | 24 +- main/EDPftvarcon.F90 | 39 +- main/EDTypesMod.F90 | 51 +- main/FatesHistoryInterfaceMod.F90 | 966 +++++++++++++++++- main/FatesHistoryVariableType.F90 | 26 + main/FatesIODimensionsMod.F90 | 21 +- main/FatesIOVariableKindMod.F90 | 4 + main/FatesInterfaceMod.F90 | 89 +- main/FatesInterfaceTypesMod.F90 | 20 +- main/FatesInventoryInitMod.F90 | 27 +- main/FatesParameterDerivedMod.F90 | 94 +- main/FatesParametersInterface.F90 | 1 + main/FatesRestartInterfaceMod.F90 | 338 +++++- main/FatesSizeAgeTypeIndicesMod.F90 | 46 +- parameter_files/fates_params_default.cdl | 32 +- parteh/PRTAllometricCNPMod.F90 | 66 +- parteh/PRTAllometricCarbonMod.F90 | 250 ++++- parteh/PRTGenericMod.F90 | 43 +- parteh/PRTLossFluxesMod.F90 | 84 +- parteh/PRTParametersMod.F90 | 1 + parteh/PRTParamsFATESMod.F90 | 30 +- 35 files changed, 3693 insertions(+), 582 deletions(-) create mode 100644 main/DamageMainMod.F90 diff --git a/biogeochem/EDCanopyStructureMod.F90 b/biogeochem/EDCanopyStructureMod.F90 index 08e6c0513f..a7d9f6c8c5 100644 --- a/biogeochem/EDCanopyStructureMod.F90 +++ b/biogeochem/EDCanopyStructureMod.F90 @@ -381,7 +381,8 @@ subroutine DemoteFromLayer(currentSite,currentPatch,i_lyr,bc_in) currentCohort => currentPatch%shortest do while (associated(currentCohort)) call carea_allom(currentCohort%dbh,currentCohort%n, & - currentSite%spread,currentCohort%pft,currentCohort%c_area) + currentSite%spread,currentCohort%pft,& + currentCohort%crowndamage, currentCohort%c_area) if(debug) then if(currentCohort%c_area<0._r8)then @@ -686,9 +687,10 @@ subroutine DemoteFromLayer(currentSite,currentPatch,i_lyr,bc_in) currentSite%demotion_carbonflux = currentSite%demotion_carbonflux + & (leaf_c + store_c + fnrt_c + sapw_c + struct_c) * currentCohort%n - call carea_allom(copyc%dbh,copyc%n,currentSite%spread,copyc%pft,copyc%c_area) + call carea_allom(copyc%dbh,copyc%n,currentSite%spread,copyc%pft, & + copyc%crowndamage, copyc%c_area) call carea_allom(currentCohort%dbh,currentCohort%n,currentSite%spread, & - currentCohort%pft,currentCohort%c_area) + currentCohort%pft,currentCohort%crowndamage, currentCohort%c_area) !----------- Insert copy into linked list ------------------------! copyc%shorter => currentCohort @@ -727,7 +729,8 @@ subroutine DemoteFromLayer(currentSite,currentPatch,i_lyr,bc_in) end if call carea_allom(currentCohort%dbh,currentCohort%n, & - currentSite%spread,currentCohort%pft,currentCohort%c_area) + currentSite%spread,currentCohort%pft,& + currentCohort%crowndamage, currentCohort%c_area) endif !canopy layer = i_ly @@ -833,7 +836,7 @@ subroutine PromoteIntoLayer(currentSite,currentPatch,i_lyr) currentCohort%canopy_layer = i_lyr call carea_allom(currentCohort%dbh,currentCohort%n,currentSite%spread, & - currentCohort%pft,currentCohort%c_area) + currentCohort%pft,currentCohort%crowndamage, currentCohort%c_area) ! keep track of number and biomass of promoted cohort currentSite%promotion_rate(currentCohort%size_class) = & currentSite%promotion_rate(currentCohort%size_class) + currentCohort%n @@ -859,7 +862,7 @@ subroutine PromoteIntoLayer(currentSite,currentPatch,i_lyr) currentCohort => currentPatch%tallest do while (associated(currentCohort)) call carea_allom(currentCohort%dbh,currentCohort%n,currentSite%spread, & - currentCohort%pft,currentCohort%c_area) + currentCohort%pft,currentCohort%crowndamage, currentCohort%c_area) if(currentCohort%canopy_layer == i_lyr+1)then !look at the cohorts in the canopy layer below... if (ED_val_comp_excln .ge. 0.0_r8 ) then @@ -1126,7 +1129,7 @@ subroutine PromoteIntoLayer(currentSite,currentPatch,i_lyr) newarea = currentCohort%c_area - cc_gain !new area of existing cohort call carea_allom(currentCohort%dbh,currentCohort%n,currentSite%spread, & - currentCohort%pft,currentCohort%c_area) + currentCohort%pft,currentCohort%crowndamage, currentCohort%c_area) ! number of individuals in promoted cohort. copyc%n = currentCohort%n*cc_gain/currentCohort%c_area @@ -1145,8 +1148,9 @@ subroutine PromoteIntoLayer(currentSite,currentPatch,i_lyr) (leaf_c + fnrt_c + store_c + sapw_c + struct_c) * copyc%n call carea_allom(currentCohort%dbh,currentCohort%n,currentSite%spread, & - currentCohort%pft,currentCohort%c_area) - call carea_allom(copyc%dbh,copyc%n,currentSite%spread,copyc%pft,copyc%c_area) + currentCohort%pft,currentCohort%crowndamage, currentCohort%c_area) + call carea_allom(copyc%dbh,copyc%n,currentSite%spread,copyc%pft,& + copyc%crowndamage, copyc%c_area) !----------- Insert copy into linked list ------------------------! copyc%shorter => currentCohort @@ -1223,7 +1227,9 @@ subroutine canopy_spread( currentSite ) currentCohort => currentPatch%tallest do while (associated(currentCohort)) call carea_allom(currentCohort%dbh,currentCohort%n, & - currentSite%spread,currentCohort%pft,currentCohort%c_area) + currentSite%spread,currentCohort%pft, & + currentCohort%crowndamage, currentCohort%c_area) + if( ( int(prt_params%woody(currentCohort%pft)) .eq. itrue ) .and. & (currentCohort%canopy_layer .eq. 1 ) ) then sitelevel_canopyarea = sitelevel_canopyarea + currentCohort%c_area @@ -1323,7 +1329,7 @@ subroutine canopy_summarization( nsites, sites, bc_in ) ! Update the cohort's index within the size bin classes ! Update the cohort's index within the SCPF classification system call sizetype_class_index(currentCohort%dbh,currentCohort%pft, & - currentCohort%size_class,currentCohort%size_by_pft_class) + currentCohort%size_class,currentCohort%size_by_pft_class) if (hlm_use_cohort_age_tracking .eq. itrue) then call coagetype_class_index(currentCohort%coage,currentCohort%pft, & @@ -1332,7 +1338,7 @@ subroutine canopy_summarization( nsites, sites, bc_in ) if(hlm_use_sp.eq.ifalse)then call carea_allom(currentCohort%dbh,currentCohort%n,sites(s)%spread,& - currentCohort%pft,currentCohort%c_area) + currentCohort%pft,currentCohort%crowndamage,currentCohort%c_area) endif currentCohort%treelai = tree_lai(leaf_c, & currentCohort%pft, currentCohort%c_area, currentCohort%n, & @@ -1445,7 +1451,7 @@ subroutine leaf_area_profile( currentSite ) ! currentCohort%treesai ! SAI per unit crown area (m2/m2) ! currentCohort%lai ! LAI per unit canopy area (m2/m2) ! currentCohort%sai ! SAI per unit canopy area (m2/m2) - ! currentCohort%NV ! The number of discrete vegetation + ! currentCohort%nv ! The number of discrete vegetation ! ! layers needed to describe this crown ! ! The following patch level diagnostics are updated here: @@ -1471,7 +1477,6 @@ subroutine leaf_area_profile( currentSite ) ! !USES: use EDtypesMod , only : area, dinc_ed, hitemax, n_hite_bins - ! ! !ARGUMENTS type(ed_site_type) , intent(inout) :: currentSite @@ -1498,8 +1503,9 @@ subroutine leaf_area_profile( currentSite ) real(r8) :: min_chite ! bottom of cohort canopy (m) real(r8) :: max_chite ! top of cohort canopy (m) real(r8) :: lai ! summed lai for checking m2 m-2 - real(r8) :: leaf_c ! leaf carbon [kg] - + real(r8) :: snow_depth_avg ! avg snow over whole site + real(r8) :: leaf_c ! leaf carbon [kgC] + real(r8) :: target_c_area ! crown area of undamaged cohort given dbh !---------------------------------------------------------------------- @@ -1554,13 +1560,14 @@ subroutine leaf_area_profile( currentSite ) currentCohort%treelai = tree_lai(leaf_c, currentCohort%pft, currentCohort%c_area, & currentCohort%n, currentCohort%canopy_layer, & currentPatch%canopy_layer_tlai,currentCohort%vcmax25top ) - - if (hlm_use_sp .eq. ifalse) then - currentCohort%treesai = tree_sai(currentCohort%pft, currentCohort%dbh, currentCohort%canopy_trim, & - currentCohort%c_area, currentCohort%n, currentCohort%canopy_layer, & - currentPatch%canopy_layer_tlai, currentCohort%treelai , & - currentCohort%vcmax25top,4) - end if + + if (hlm_use_sp .eq. ifalse) then + currentCohort%treesai = tree_sai(currentCohort%pft, currentCohort%dbh,& + currentSite%spread, currentCohort%canopy_trim, & + currentCohort%c_area, currentCohort%n, currentCohort%canopy_layer, & + currentPatch%canopy_layer_tlai, currentCohort%treelai , & + currentCohort%vcmax25top,4) + end if currentCohort%lai = currentCohort%treelai *currentCohort%c_area/currentPatch%total_canopy_area currentCohort%sai = currentCohort%treesai *currentCohort%c_area/currentPatch%total_canopy_area @@ -2164,7 +2171,7 @@ subroutine CanopyLayerArea(currentPatch,site_spread,layer_index,layer_area) currentCohort => currentPatch%tallest do while (associated(currentCohort)) call carea_allom(currentCohort%dbh,currentCohort%n,site_spread, & - currentCohort%pft,currentCohort%c_area) + currentCohort%pft,currentCohort%crowndamage, currentCohort%c_area) if (currentCohort%canopy_layer .eq. layer_index) then layer_area = layer_area + currentCohort%c_area end if @@ -2208,7 +2215,8 @@ function NumPotentialCanopyLayers(currentPatch,site_spread,include_substory) res currentCohort => currentPatch%tallest do while (associated(currentCohort)) if(currentCohort%canopy_layer == z) then - call carea_allom(currentCohort%dbh,currentCohort%n,site_spread,currentCohort%pft,c_area) + call carea_allom(currentCohort%dbh,currentCohort%n,site_spread,& + currentCohort%pft,currentCohort%crowndamage, c_area) arealayer = arealayer + c_area end if currentCohort => currentCohort%shorter diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index 2fa98aa59f..10fbf5e879 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -1,4 +1,4 @@ -module EDCohortDynamicsMod +Module EDCohortDynamicsMod ! ! !DESCRIPTION: ! Cohort stuctures in ED. @@ -85,6 +85,9 @@ module EDCohortDynamicsMod use PRTAllometricCarbonMod, only : callom_prt_vartypes use PRTAllometricCarbonMod, only : ac_bc_inout_id_netdc use PRTAllometricCarbonMod, only : ac_bc_in_id_pft + use PRTAllometricCarbonMod, only : ac_bc_inout_id_cdamage + use PRTAllometricCarbonMod, only : ac_bc_in_id_branch_frac + use PRTAllometricCarbonMod, only : ac_bc_inout_id_n use PRTAllometricCarbonMod, only : ac_bc_in_id_ctrim use PRTAllometricCarbonMod, only : ac_bc_inout_id_dbh use PRTAllometricCarbonMod, only : ac_bc_in_id_lstat @@ -122,7 +125,7 @@ module EDCohortDynamicsMod public :: UpdateCohortBioPhysRates public :: DeallocateCohort public :: EvaluateAndCorrectDBH - + logical, parameter :: debug = .false. ! local debug flag character(len=*), parameter, private :: sourcefile = & @@ -140,12 +143,11 @@ module EDCohortDynamicsMod contains !-------------------------------------------------------------------------------------! - - - subroutine create_cohort(currentSite, patchptr, pft, nn, hite, coage, dbh, & - prt, laimemory, sapwmemory, structmemory, & - status, recruitstatus,ctrim, carea, clayer, spread, bc_in) + prt, laimemory, sapwmemory, structmemory, & + status, recruitstatus,ctrim,carea, & + clayer, crowndamage,branch_frac, spread, bc_in) + ! ! !DESCRIPTION: ! create new cohort @@ -165,7 +167,9 @@ subroutine create_cohort(currentSite, patchptr, pft, nn, hite, coage, dbh, & type(ed_patch_type), intent(inout), pointer :: patchptr integer, intent(in) :: pft ! Cohort Plant Functional Type - integer, intent(in) :: clayer ! canopy status of cohort + integer, intent(in) :: crowndamage ! Cohort damage class + real(r8), intent(in) :: branch_frac ! Fraction of biomass in branches + integer, intent(in) :: clayer ! canopy status of cohort ! (1 = canopy, 2 = understorey, etc.) integer, intent(in) :: status ! growth status of plant ! (2 = leaves on , 1 = leaves off) @@ -200,7 +204,7 @@ subroutine create_cohort(currentSite, patchptr, pft, nn, hite, coage, dbh, & real(r8) :: leaf_c ! total leaf carbon integer :: tnull,snull ! are the tallest and shortest cohorts allocate integer :: nlevrhiz ! number of rhizosphere layers - + !---------------------------------------------------------------------- allocate(new_cohort) @@ -226,6 +230,8 @@ subroutine create_cohort(currentSite, patchptr, pft, nn, hite, coage, dbh, & new_cohort%patchptr => patchptr new_cohort%pft = pft + new_cohort%crowndamage = crowndamage + new_cohort%branch_frac = branch_frac new_cohort%status_coh = status new_cohort%n = nn new_cohort%hite = hite @@ -266,27 +272,27 @@ subroutine create_cohort(currentSite, patchptr, pft, nn, hite, coage, dbh, & ! Assign canopy extent and depth if(hlm_use_sp.eq.ifalse)then - call carea_allom(new_cohort%dbh,new_cohort%n,spread,new_cohort%pft,new_cohort%c_area) + call carea_allom(new_cohort%dbh,new_cohort%n,spread,new_cohort%pft, & + new_cohort%crowndamage,new_cohort%c_area) else new_cohort%c_area = carea ! set this from previously precision-controlled value in SP mode endif ! Query PARTEH for the leaf carbon [kg] leaf_c = new_cohort%prt%GetState(leaf_organ,carbon12_element) - new_cohort%treelai = tree_lai(leaf_c, new_cohort%pft, new_cohort%c_area, & new_cohort%n, new_cohort%canopy_layer, & patchptr%canopy_layer_tlai,new_cohort%vcmax25top ) if(hlm_use_sp.eq.ifalse)then - new_cohort%treesai = tree_sai(new_cohort%pft, new_cohort%dbh, new_cohort%canopy_trim, & - new_cohort%c_area, new_cohort%n, new_cohort%canopy_layer, & - patchptr%canopy_layer_tlai, new_cohort%treelai,new_cohort%vcmax25top,2 ) + new_cohort%treesai = tree_sai(new_cohort%pft, new_cohort%dbh, currentSite%spread, & + new_cohort%canopy_trim, & + new_cohort%c_area, new_cohort%n, new_cohort%canopy_layer, & + patchptr%canopy_layer_tlai, new_cohort%treelai,new_cohort%vcmax25top,2 ) end if new_cohort%lai = new_cohort%treelai * new_cohort%c_area/patchptr%area - ! Put cohort at the right place in the linked list storebigcohort => patchptr%tallest storesmallcohort => patchptr%shortest @@ -397,10 +403,13 @@ subroutine InitPRTBoundaryConditions(new_cohort) call new_cohort%prt%RegisterBCInOut(ac_bc_inout_id_dbh,bc_rval = new_cohort%dbh) call new_cohort%prt%RegisterBCInOut(ac_bc_inout_id_netdc,bc_rval = new_cohort%npp_acc) + call new_cohort%prt%RegisterBCInOut(ac_bc_inout_id_n,bc_rval = new_cohort%n) + call new_cohort%prt%RegisterBCInOut(ac_bc_inout_id_cdamage,bc_ival = new_cohort%crowndamage) call new_cohort%prt%RegisterBCIn(ac_bc_in_id_pft,bc_ival = new_cohort%pft) call new_cohort%prt%RegisterBCIn(ac_bc_in_id_ctrim,bc_rval = new_cohort%canopy_trim) call new_cohort%prt%RegisterBCIn(ac_bc_in_id_lstat,bc_ival = new_cohort%status_coh) - + call new_cohort%prt%RegisterBCIn(ac_bc_in_id_branch_frac,bc_rval = new_cohort%branch_frac) + case (prt_cnp_flex_allom_hyp) call new_cohort%prt%RegisterBCIn(acnp_bc_in_id_pft,bc_ival = new_cohort%pft) @@ -517,6 +526,7 @@ subroutine nan_cohort(cc_p) ! VEGETATION STRUCTURE currentCohort%pft = fates_unset_int ! pft number + currentCohort%crowndamage = fates_unset_int ! Crown damage class currentCohort%indexnumber = fates_unset_int ! unique number for each cohort. (within clump?) currentCohort%canopy_layer = fates_unset_int ! canopy status of cohort (1 = canopy, 2 = understorey, etc.) currentCohort%canopy_layer_yesterday = nan ! recent canopy status of cohort (1 = canopy, 2 = understorey, etc.) @@ -708,7 +718,9 @@ subroutine terminate_cohorts( currentSite, currentPatch, level , call_index, bc_ ! terminates cohorts when they get too small ! ! !USES: - + use FatesInterfaceTypesMod , only : hlm_use_canopy_damage + use FatesInterfaceTypesMod , only : hlm_use_understory_damage + ! ! !ARGUMENTS type (ed_site_type) , intent(inout), target :: currentSite @@ -816,15 +828,41 @@ subroutine terminate_cohorts( currentSite, currentPatch, level , call_index, bc_ if(levcan==ican_upper) then currentSite%term_nindivs_canopy(currentCohort%size_class,currentCohort%pft) = & currentSite%term_nindivs_canopy(currentCohort%size_class,currentCohort%pft) + currentCohort%n - currentSite%term_carbonflux_canopy = currentSite%term_carbonflux_canopy + & currentCohort%n * (struct_c+sapw_c+leaf_c+fnrt_c+store_c+repro_c) + + currentSite%term_crownarea_canopy = currentSite%term_crownarea_canopy + & + currentCohort%c_area + else currentSite%term_nindivs_ustory(currentCohort%size_class,currentCohort%pft) = & currentSite%term_nindivs_ustory(currentCohort%size_class,currentCohort%pft) + currentCohort%n - currentSite%term_carbonflux_ustory = currentSite%term_carbonflux_ustory + & currentCohort%n * (struct_c+sapw_c+leaf_c+fnrt_c+store_c+repro_c) + + currentSite%term_crownarea_ustory = currentSite%term_crownarea_ustory + & + currentCohort%c_area + + end if + + if(hlm_use_canopy_damage .eq. itrue .or. hlm_use_understory_damage .eq. itrue) then + if( levcan==ican_upper) then + currentSite%term_nindivs_canopy_damage(currentCohort%crowndamage, & + currentCohort%size_class, currentCohort%pft) = & + currentSite%term_nindivs_canopy_damage(currentCohort%crowndamage,& + currentCohort%size_class, currentCohort%pft) + currentCohort%n + currentSite%term_cflux_canopy_damage(currentCohort%crowndamage, currentCohort%size_class) = & + currentSite%term_cflux_canopy_damage(currentCohort%crowndamage, currentCohort%size_class) + & + currentCohort%n * (struct_c+sapw_c+leaf_c+fnrt_c+store_c+repro_c) + else + currentSite%term_nindivs_ustory_damage(currentCohort%crowndamage,& + currentCohort%size_class, currentCohort%pft) = & + currentSite%term_nindivs_ustory_damage(currentCohort%crowndamage,& + currentCohort%size_class, currentCohort%pft) + currentCohort%n + currentSite%term_cflux_ustory_damage(currentCohort%crowndamage, currentCohort%size_class) = & + currentSite%term_cflux_ustory_damage(currentCohort%crowndamage, currentCohort%size_class) + & + currentCohort%n * (struct_c+sapw_c+leaf_c+fnrt_c+store_c+repro_c) + end if end if ! put the litter from the terminated cohorts @@ -861,7 +899,7 @@ subroutine terminate_cohorts( currentSite, currentPatch, level , call_index, bc_ endif currentCohort => tallerCohort enddo - + end subroutine terminate_cohorts ! ===================================================================================== @@ -906,6 +944,7 @@ subroutine SendCohortToLitter(csite,cpatch,ccohort,nplant,bc_in) integer :: el ! loop index for elements integer :: c ! loop index for CWD integer :: pft ! pft index of the cohort + integer :: crowndamage ! the crown damage class of the cohort integer :: sl ! loop index for soil layers integer :: dcmpy ! loop index for decomposability @@ -1011,7 +1050,6 @@ subroutine DeallocateCohort(currentCohort) return end subroutine DeallocateCohort - subroutine fuse_cohorts(currentSite, currentPatch, bc_in) ! @@ -1025,7 +1063,7 @@ subroutine fuse_cohorts(currentSite, currentPatch, bc_in) use FatesConstantsMod , only : itrue use FatesConstantsMod, only : days_per_year use EDTypesMod , only : maxCohortsPerPatch - + use DamageMainMod, only : get_crown_reduction ! ! !ARGUMENTS type (ed_site_type), intent(inout), target :: currentSite @@ -1055,11 +1093,13 @@ subroutine fuse_cohorts(currentSite, currentPatch, bc_in) real(r8) :: dynamic_age_fusion_tolerance real(r8) :: dbh real(r8) :: leaf_c ! leaf carbon [kg] + real(r8) :: target_c_area integer :: largersc, smallersc, sc_i ! indices for tracking the growth flux caused by fusion real(r8) :: larger_n, smaller_n integer :: oldercacls, youngercacls, cacls_i ! indices for tracking the age flux caused by fusion real(r8) :: older_n, younger_n + real(r8) :: crown_reduction logical, parameter :: fuse_debug = .false. ! This debug is over-verbose ! and gets its own flag @@ -1085,7 +1125,7 @@ subroutine fuse_cohorts(currentSite, currentPatch, bc_in) !---------------------------------------------------------------------! ! Keep doing this until nocohorts <= maxcohorts ! !---------------------------------------------------------------------! - + if (associated(currentPatch%shortest)) then do while(iterate == 1) @@ -1126,6 +1166,9 @@ subroutine fuse_cohorts(currentSite, currentPatch, bc_in) if (currentCohort%pft == nextc%pft) then + ! check cohorts have same damage class before fusing + if (currentCohort%crowndamage == nextc%crowndamage) then + ! check cohorts in same c. layer. before fusing if (currentCohort%canopy_layer == nextc%canopy_layer) then @@ -1153,6 +1196,7 @@ subroutine fuse_cohorts(currentSite, currentPatch, bc_in) write(fates_log(),*) 'coage:',currentCohort%coage,nextc%coage write(fates_log(),*) 'dbh:',currentCohort%dbh,nextc%dbh write(fates_log(),*) 'pft:',currentCohort%pft,nextc%pft + write(fates_log(),*) 'crowndamage:',currentCohort%crowndamage,nextc%crowndamage write(fates_log(),*) 'canopy_trim:',currentCohort%canopy_trim,nextc%canopy_trim write(fates_log(),*) 'canopy_layer_yesterday:', & currentCohort%canopy_layer_yesterday,nextc%canopy_layer_yesterday @@ -1230,10 +1274,12 @@ subroutine fuse_cohorts(currentSite, currentPatch, bc_in) call carea_allom(currentCohort%dbh,currentCohort%n, & currentSite%spread,currentCohort%pft,& + currentCohort%crowndamage, & currentCohort%c_area,inverse=.false.) call carea_allom(nextc%dbh,nextc%n, & currentSite%spread,nextc%pft,& + nextc%crowndamage, & nextc%c_area,inverse=.false.) currentCohort%c_area = currentCohort%c_area + nextc%c_area @@ -1241,7 +1287,7 @@ subroutine fuse_cohorts(currentSite, currentPatch, bc_in) ! dbh = currentCohort%dbh call carea_allom(dbh,newn,currentSite%spread,currentCohort%pft,& - currentCohort%c_area,inverse=.true.) + currentCohort%crowndamage,currentCohort%c_area,inverse=.true.) ! if (abs(dbh-fates_unset_r8) calloc_abs_error ) then - call ForceDBH( ipft, canopy_trim, dbh, hite_out, bdead=struct_c ) - delta_dbh = dbh - currentCohort%dbh + + call ForceDBH( ipft,canopy_trim, dbh, hite_out, bdead=struct_c, & + crowndamage = icrowndamage, branch_frac = branch_frac) + + delta_dbh = dbh - currentCohort%dbh delta_hite = hite_out - currentCohort%hite currentCohort%dbh = dbh currentCohort%hite = hite_out @@ -2077,7 +2142,7 @@ subroutine EvaluateAndCorrectDBH(currentCohort,delta_dbh,delta_hite) leaf_c = currentCohort%prt%GetState(leaf_organ, all_carbon_elements) ! Target leaf biomass according to allometry and trimming - call bleaf(dbh,ipft,canopy_trim,target_leaf_c) + call bleaf(dbh,ipft,icrowndamage, canopy_trim,target_leaf_c) if( ( leaf_c - target_leaf_c ) > calloc_abs_error ) then call ForceDBH( ipft, canopy_trim, dbh, hite_out, bl=leaf_c ) @@ -2091,5 +2156,7 @@ subroutine EvaluateAndCorrectDBH(currentCohort,delta_dbh,delta_hite) return end subroutine EvaluateAndCorrectDBH + !------------------------------------------------------------------------------------ + end module EDCohortDynamicsMod diff --git a/biogeochem/EDLoggingMortalityMod.F90 b/biogeochem/EDLoggingMortalityMod.F90 index f1f23d9f33..40b9909474 100644 --- a/biogeochem/EDLoggingMortalityMod.F90 +++ b/biogeochem/EDLoggingMortalityMod.F90 @@ -789,7 +789,7 @@ subroutine logging_litter_fluxes(currentSite, currentPatch, newPatch, patch_site currentCohort => newPatch%shortest do while(associated(currentCohort)) call carea_allom(currentCohort%dbh,currentCohort%n,currentSite%spread, & - currentCohort%pft,currentCohort%c_area) + currentCohort%pft,currentCohort%crowndamage,currentCohort%c_area) currentCohort => currentCohort%taller enddo diff --git a/biogeochem/EDMortalityFunctionsMod.F90 b/biogeochem/EDMortalityFunctionsMod.F90 index 6eb5ec3097..f930a7a2dd 100644 --- a/biogeochem/EDMortalityFunctionsMod.F90 +++ b/biogeochem/EDMortalityFunctionsMod.F90 @@ -17,6 +17,8 @@ module EDMortalityFunctionsMod use FatesInterfaceTypesMod , only : hlm_use_ed_prescribed_phys use FatesInterfaceTypesMod , only : hlm_freq_day use FatesInterfaceTypesMod , only : hlm_use_planthydro + use FatesInterfaceTypesMod , only : hlm_use_canopy_damage + use FatesInterfaceTypesMod , only : hlm_use_understory_damage use EDLoggingMortalityMod , only : LoggingMortality_frac use EDParamsMod , only : fates_mortality_disturbance_fraction @@ -41,7 +43,7 @@ module EDMortalityFunctionsMod - subroutine mortality_rates( cohort_in,bc_in,cmort,hmort,bmort,frmort,smort,asmort ) + subroutine mortality_rates( cohort_in,bc_in,cmort,hmort,bmort,frmort,smort,asmort,dgmort ) ! ============================================================================ ! Calculate mortality rates from carbon storage, hydraulic cavitation, @@ -51,6 +53,7 @@ subroutine mortality_rates( cohort_in,bc_in,cmort,hmort,bmort,frmort,smort,asmor use FatesConstantsMod, only : tfrz => t_water_freeze_k_1atm use FatesInterfaceTypesMod , only : hlm_hio_ignore_val use FatesConstantsMod, only : fates_check_param_set + use DamageMainMod, only : get_damage_mortality type (ed_cohort_type), intent(in) :: cohort_in type (bc_in_type), intent(in) :: bc_in @@ -59,11 +62,12 @@ subroutine mortality_rates( cohort_in,bc_in,cmort,hmort,bmort,frmort,smort,asmor real(r8),intent(out) :: hmort ! hydraulic failure mortality real(r8),intent(out) :: frmort ! freezing stress mortality real(r8),intent(out) :: smort ! size dependent senescence term - real(r8),intent(out) :: asmort ! age dependent senescence term + real(r8),intent(out) :: asmort ! age dependent senescence term + real(r8),intent(out) :: dgmort ! damage dependent mortality integer :: ifp real(r8) :: frac ! relativised stored carbohydrate - real(r8) :: leaf_c_target ! target leaf biomass kgC + real(r8) :: leaf_c ! leaf biomass kgC real(r8) :: store_c real(r8) :: hf_sm_threshold ! hydraulic failure soil moisture threshold real(r8) :: hf_flc_threshold ! hydraulic failure fractional loss of conductivity threshold @@ -82,7 +86,9 @@ subroutine mortality_rates( cohort_in,bc_in,cmort,hmort,bmort,frmort,smort,asmor logical, parameter :: test_zero_mortality = .false. ! Developer test which ! may help to debug carbon imbalances ! and the like - + + + ! Size Dependent Senescence ! rate (r) and inflection point (ip) define the increase in mortality rate with dbh mort_r_size_senescence = EDPftvarcon_inst%mort_r_size_senescence(cohort_in%pft) @@ -97,9 +103,6 @@ subroutine mortality_rates( cohort_in,bc_in,cmort,hmort,bmort,frmort,smort,asmor end if ! if param values have been set then calculate asmort - - - mort_r_age_senescence = EDPftvarcon_inst%mort_r_age_senescence(cohort_in%pft) mort_ip_age_senescence = EDPftvarcon_inst%mort_ip_age_senescence(cohort_in%pft) @@ -113,76 +116,82 @@ subroutine mortality_rates( cohort_in,bc_in,cmort,hmort,bmort,frmort,smort,asmor asmort = 0.0_r8 end if + ! Damage dependent mortality + if (hlm_use_canopy_damage .eq. itrue .or. hlm_use_understory_damage .eq. itrue) then + call get_damage_mortality(cohort_in%crowndamage, cohort_in%pft, dgmort) + else + dgmort = 0.0_r8 + end if -if (hlm_use_ed_prescribed_phys .eq. ifalse) then + if (hlm_use_ed_prescribed_phys .eq. ifalse) then + + ! 'Background' mortality (can vary as a function of + ! density as in ED1.0 and ED2.0, but doesn't here for tractability) - ! 'Background' mortality (can vary as a function of - ! density as in ED1.0 and ED2.0, but doesn't here for tractability) - bmort = EDPftvarcon_inst%bmort(cohort_in%pft) - ! Proxy for hydraulic failure induced mortality. - hf_sm_threshold = EDPftvarcon_inst%hf_sm_threshold(cohort_in%pft) - hf_flc_threshold = EDPftvarcon_inst%hf_flc_threshold(cohort_in%pft) - if(hlm_use_planthydro.eq.itrue)then - !note the flc is set as the fraction of max conductivity in hydro - min_fmc_ag = minval(cohort_in%co_hydr%ftc_ag(:)) - min_fmc_tr = cohort_in%co_hydr%ftc_troot - min_fmc_ar = minval(cohort_in%co_hydr%ftc_aroot(:)) - min_fmc = min(min_fmc_ag, min_fmc_tr) - min_fmc = min(min_fmc, min_fmc_ar) - flc = 1.0_r8-min_fmc - if(flc >= hf_flc_threshold .and. hf_flc_threshold < 1.0_r8 )then - hmort = (flc-hf_flc_threshold)/(1.0_r8-hf_flc_threshold) * & - EDPftvarcon_inst%mort_scalar_hydrfailure(cohort_in%pft) - else - hmort = 0.0_r8 - endif - else - if(cohort_in%patchptr%btran_ft(cohort_in%pft) <= hf_sm_threshold)then - hmort = EDPftvarcon_inst%mort_scalar_hydrfailure(cohort_in%pft) - else - hmort = 0.0_r8 - endif - endif - - ! Carbon Starvation induced mortality. - if ( cohort_in%dbh > 0._r8 ) then + ! Proxy for hydraulic failure induced mortality. + hf_sm_threshold = EDPftvarcon_inst%hf_sm_threshold(cohort_in%pft) + hf_flc_threshold = EDPftvarcon_inst%hf_flc_threshold(cohort_in%pft) + if(hlm_use_planthydro.eq.itrue)then + !note the flc is set as the fraction of max conductivity in hydro + min_fmc_ag = minval(cohort_in%co_hydr%ftc_ag(:)) + min_fmc_tr = cohort_in%co_hydr%ftc_troot + min_fmc_ar = minval(cohort_in%co_hydr%ftc_aroot(:)) + min_fmc = min(min_fmc_ag, min_fmc_tr) + min_fmc = min(min_fmc, min_fmc_ar) + flc = 1.0_r8-min_fmc + if(flc >= hf_flc_threshold .and. hf_flc_threshold < 1.0_r8 )then + hmort = (flc-hf_flc_threshold)/(1.0_r8-hf_flc_threshold) * & + EDPftvarcon_inst%mort_scalar_hydrfailure(cohort_in%pft) + else + hmort = 0.0_r8 + endif + else + if(cohort_in%patchptr%btran_ft(cohort_in%pft) <= hf_sm_threshold)then + hmort = EDPftvarcon_inst%mort_scalar_hydrfailure(cohort_in%pft) + else + hmort = 0.0_r8 + endif + endif + + ! Carbon Starvation induced mortality. + if ( cohort_in%dbh > 0._r8 ) then + + call bleaf(cohort_in%dbh,cohort_in%pft,cohort_in%crowndamage,cohort_in%canopy_trim,leaf_c) + store_c = cohort_in%prt%GetState(store_organ,all_carbon_elements) - call bleaf(cohort_in%dbh,cohort_in%pft,cohort_in%canopy_trim,leaf_c_target) - store_c = cohort_in%prt%GetState(store_organ,all_carbon_elements) + call storage_fraction_of_target(leaf_c, store_c, frac) + if( frac .lt. 1._r8) then + cmort = max(0.0_r8,EDPftvarcon_inst%mort_scalar_cstarvation(cohort_in%pft) * & + (1.0_r8 - frac)) + else + cmort = 0.0_r8 + endif - call storage_fraction_of_target(leaf_c_target, store_c, frac) - if( frac .lt. 1._r8) then - cmort = max(0.0_r8,EDPftvarcon_inst%mort_scalar_cstarvation(cohort_in%pft) * & - (1.0_r8 - frac)) else - cmort = 0.0_r8 + write(fates_log(),*) 'dbh problem in mortality_rates', & + cohort_in%dbh,cohort_in%pft,cohort_in%n,cohort_in%canopy_layer endif + !-------------------------------------------------------------------------------- + ! Mortality due to cold and freezing stress (frmort), based on ED2 and: + ! Albani, M.; D. Medvigy; G. C. Hurtt; P. R. Moorcroft, 2006: The contributions + ! of land-use change, CO2 fertilization, and climate variability to the + ! Eastern US carbon sink. Glob. Change Biol., 12, 2370-2390, + ! doi: 10.1111/j.1365-2486.2006.01254.x - else - write(fates_log(),*) 'dbh problem in mortality_rates', & - cohort_in%dbh,cohort_in%pft,cohort_in%n,cohort_in%canopy_layer - endif - !-------------------------------------------------------------------------------- - ! Mortality due to cold and freezing stress (frmort), based on ED2 and: - ! Albani, M.; D. Medvigy; G. C. Hurtt; P. R. Moorcroft, 2006: The contributions - ! of land-use change, CO2 fertilization, and climate variability to the - ! Eastern US carbon sink. Glob. Change Biol., 12, 2370-2390, - ! doi: 10.1111/j.1365-2486.2006.01254.x + ifp = cohort_in%patchptr%patchno + temp_in_C = bc_in%t_veg24_pa(ifp) - tfrz + temp_dep_fraction = max(0.0_r8, min(1.0_r8, 1.0_r8 - (temp_in_C - & + EDPftvarcon_inst%freezetol(cohort_in%pft))/frost_mort_buffer) ) + frmort = EDPftvarcon_inst%mort_scalar_coldstress(cohort_in%pft) * temp_dep_fraction - ifp = cohort_in%patchptr%patchno - temp_in_C = bc_in%t_veg24_pa(ifp) - tfrz - temp_dep_fraction = max(0.0_r8, min(1.0_r8, 1.0_r8 - (temp_in_C - & - EDPftvarcon_inst%freezetol(cohort_in%pft))/frost_mort_buffer) ) - frmort = EDPftvarcon_inst%mort_scalar_coldstress(cohort_in%pft) * temp_dep_fraction + !mortality_rates = bmort + hmort + cmort - !mortality_rates = bmort + hmort + cmort + else ! i.e. hlm_use_ed_prescribed_phys is true - else ! i.e. hlm_use_ed_prescribed_phys is true - if ( cohort_in%canopy_layer .eq. 1) then bmort = EDPftvarcon_inst%prescribed_mortality_canopy(cohort_in%pft) else @@ -200,8 +209,9 @@ subroutine mortality_rates( cohort_in,bc_in,cmort,hmort,bmort,frmort,smort,asmor bmort = 0.0_r8 smort = 0.0_r8 asmort = 0.0_r8 + dgmort = 0.0_r8 end if - + return end subroutine mortality_rates @@ -232,15 +242,17 @@ subroutine Mortality_Derivative( currentSite, currentCohort, bc_in, frac_site_pr real(r8) :: frmort ! freezing mortality rate (fraction per year) real(r8) :: smort ! size dependent senescence mortality rate (fraction per year) real(r8) :: asmort ! age dependent senescence mortality rate (fraction per year) + real(r8) :: dgmort ! damage mortality (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 ! Mortality for trees in the understorey. !if trees are in the canopy, then their death is 'disturbance'. This probably needs a different terminology - call mortality_rates(currentCohort,bc_in,cmort,hmort,bmort,frmort,smort, asmort) + call mortality_rates(currentCohort,bc_in,cmort,hmort,bmort,frmort,smort, asmort, dgmort) call LoggingMortality_frac(ipft, currentCohort%dbh, currentCohort%canopy_layer, & currentCohort%lmort_direct, & currentCohort%lmort_collateral, & @@ -264,7 +276,7 @@ subroutine Mortality_Derivative( currentSite, currentCohort, bc_in, frac_site_pr currentCohort%dndt = -1.0_r8 * & - (cmort+hmort+bmort+frmort+smort+asmort + dndt_logging) & + (cmort+hmort+bmort+frmort+smort+asmort+dgmort + dndt_logging) & * currentCohort%n else @@ -273,7 +285,7 @@ subroutine Mortality_Derivative( currentSite, currentCohort, bc_in, frac_site_pr ! Mortality from logging in the canopy is ONLY disturbance generating, don't ! update number densities via non-disturbance inducing death currentCohort%dndt= -(1.0_r8-fates_mortality_disturbance_fraction) & - * (cmort+hmort+bmort+frmort+smort+asmort) * & + * (cmort+hmort+bmort+frmort+smort+asmort+dgmort) * & currentCohort%n endif diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index c08e93565e..0652559ad8 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -5,6 +5,7 @@ module EDPatchDynamicsMod ! ============================================================================ use FatesGlobals , only : fates_log use FatesInterfaceTypesMod , only : hlm_freq_day + use FatesInterfaceTypesMod , only : hlm_days_per_year use EDPftvarcon , only : EDPftvarcon_inst use EDPftvarcon , only : GetDecompyFrac use PRTParametersMod , only : prt_params @@ -58,6 +59,7 @@ module EDPatchDynamicsMod use EDLoggingMortalityMod, only : logging_time use EDLoggingMortalityMod, only : get_harvest_rate_area use EDParamsMod , only : fates_mortality_disturbance_fraction + use DamageMainMod , only : damage_time use FatesAllometryMod , only : carea_allom use FatesAllometryMod , only : set_root_fraction use FatesConstantsMod , only : g_per_kg @@ -131,7 +133,7 @@ module EDPatchDynamicsMod real(r8), parameter :: existing_litt_localization = 1.0_r8 real(r8), parameter :: treefall_localization = 0.0_r8 real(r8), parameter :: burn_localization = 0.0_r8 - + real(r8), parameter :: damage_localization = 0.0_r8 ! 10/30/09: Created by Rosie Fisher ! ============================================================================ @@ -170,7 +172,8 @@ subroutine disturbance_rates( site_in, bc_in) real(r8) :: frmort real(r8) :: smort real(r8) :: asmort - + real(r8) :: dgmort + real(r8) :: lmort_direct real(r8) :: lmort_collateral real(r8) :: lmort_infra @@ -201,11 +204,13 @@ subroutine disturbance_rates( site_in, bc_in) ! Mortality for trees in the understorey. currentCohort%patchptr => currentPatch - call mortality_rates(currentCohort,bc_in,cmort,hmort,bmort,frmort,smort,asmort) - currentCohort%dmort = cmort+hmort+bmort+frmort+smort+asmort + call mortality_rates(currentCohort,bc_in,cmort,hmort,bmort,frmort,smort,asmort,dgmort) + currentCohort%dmort = cmort+hmort+bmort+frmort+smort+asmort+dgmort + call carea_allom(currentCohort%dbh,currentCohort%n,site_in%spread,currentCohort%pft, & - currentCohort%c_area) + currentCohort%crowndamage,currentCohort%c_area) + ! Initialize diagnostic mortality rates currentCohort%cmort = cmort currentCohort%bmort = bmort @@ -213,6 +218,7 @@ subroutine disturbance_rates( site_in, bc_in) currentCohort%frmort = frmort currentCohort%smort = smort currentCohort%asmort = asmort + currentCohort%dgmort = dgmort call LoggingMortality_frac(currentCohort%pft, currentCohort%dbh, currentCohort%canopy_layer, & lmort_direct,lmort_collateral,lmort_infra,l_degrad,& @@ -297,6 +303,8 @@ subroutine disturbance_rates( site_in, bc_in) currentCohort%c_area/currentPatch%area endif + + currentCohort => currentCohort%taller enddo !currentCohort @@ -367,6 +375,7 @@ subroutine disturbance_rates( site_in, bc_in) 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%dgmort = currentCohort%dgmort*(1.0_r8 - fates_mortality_disturbance_fraction) end if currentCohort => currentCohort%taller enddo !currentCohort @@ -389,6 +398,7 @@ subroutine disturbance_rates( site_in, bc_in) 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%dgmort = currentCohort%dgmort*(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 @@ -445,6 +455,7 @@ subroutine spawn_patches( currentSite, bc_in) ! 6) For mortality, Plants in new and existing understorey are killed ! 7) For fire, burned plants are killed, and unburned plants are added to new patch. ! 8) New cohorts are added to new patch and sorted. + ! This includes splitting cohorts within the new patch into different damage classes ! 9) New patch is added into linked list ! 10) Area checked, and patchno recalculated. ! @@ -452,20 +463,32 @@ subroutine spawn_patches( currentSite, bc_in) use EDParamsMod , only : ED_val_understorey_death, logging_coll_under_frac use EDCohortDynamicsMod , only : zero_cohort, copy_cohort, terminate_cohorts + use DamageMainMod , only : get_crown_reduction + use DamageMainMod , only : get_damage_frac + use PRTLossFluxesMod , only : PRTDamageLosses + use PRTGenericMod , only : leaf_organ + use ChecksBalancesMod , only : SiteMassStock + use FatesInterfaceTypesMod, only : hlm_use_canopy_damage + use FatesInterfaceTypesMod, only : hlm_use_understory_damage + use FatesInterfaceTypesMod, only : ncrowndamage + use EDCohortDynamicsMod , only : zero_cohort, copy_cohort, terminate_cohorts use FatesConstantsMod , only : rsnbl_math_prec - ! ! !ARGUMENTS: type (ed_site_type), intent(inout), target :: currentSite type (bc_in_type), intent(in) :: bc_in ! ! !LOCAL VARIABLES: + type(litter_type), pointer :: litt + type(litter_type), pointer :: litt_new + type (ed_patch_type) , pointer :: new_patch type (ed_patch_type) , pointer :: new_patch_primary type (ed_patch_type) , pointer :: new_patch_secondary type (ed_patch_type) , pointer :: currentPatch type (ed_cohort_type), pointer :: currentCohort type (ed_cohort_type), pointer :: nc + type (ed_cohort_type), pointer :: nc_d type (ed_cohort_type), pointer :: storesmallcohort type (ed_cohort_type), pointer :: storebigcohort real(r8) :: site_areadis_primary ! total area disturbed (to primary forest) in m2 per site per day @@ -481,13 +504,41 @@ subroutine spawn_patches( currentSite, bc_in) real(r8) :: sapw_c ! sapwood carbon [kg] real(r8) :: store_c ! storage carbon [kg] real(r8) :: struct_c ! structure carbon [kg] + real(r8) :: repro_c ! reproductive carbon [kg] real(r8) :: total_c ! total carbon of plant [kg] real(r8) :: leaf_burn_frac ! fraction of leaves burned in fire ! for both woody and grass species real(r8) :: leaf_m ! leaf mass during partial burn calculations + + real(r8) :: total_litter_d ! total litter from damage + real(r8) :: patch_damage_litter ! patch level litter from damage + real(r8) :: mass_frac ! mass to remove from damaged cohorts + real(r8) :: leaf_m_pre ! leaf mass pre damage + real(r8) :: leaf_m_post ! leaf mass post damage + real(r8) :: leaf_loss_prt ! leaf mass lost + real(r8) :: sapw_m_pre ! sapw mass pre damage + real(r8) :: sapw_m_post ! sapw mass post damage + real(r8) :: sapw_loss_prt ! sapw mass lost + real(r8) :: struct_m_pre ! struct mass pre damage + real(r8) :: struct_m_post ! struct mass post damage + real(r8) :: struct_loss_prt ! struct mass lost + real(r8) :: store_m_pre ! storage mass pre damage + real(r8) :: store_m_post ! storage mass post damage + real(r8) :: store_loss_prt ! storage mass lost + real(r8) :: cd_n ! number in new damaged cohort + real(r8) :: cd_n_total ! total number damaged + integer :: cd ! crowndamage counter + real(r8) :: cd_frac ! fraction of cohort going to new damage class + real(r8) :: agb_frac ! agoveground biomass fraction of cohort + logical :: found_youngest_primary ! logical for finding the first primary forest patch - !--------------------------------------------------------------------- + real(r8), parameter :: damage_error_fail = 1.0e-6_r8 + + !--------------------------------------------------------------------- + + total_litter_d = 0.0_r8 + storesmallcohort => null() ! storage of the smallest cohort for insertion routine storebigcohort => null() ! storage of the largest cohort for insertion routine @@ -495,8 +546,14 @@ subroutine spawn_patches( currentSite, bc_in) currentPatch => currentSite%youngest_patch site_areadis_primary = 0.0_r8 - site_areadis_secondary = 0.0_r8 + site_areadis_secondary = 0.0_r8 + leaf_loss_prt = 0.0_r8 + sapw_loss_prt = 0.0_r8 + struct_loss_prt = 0.0_r8 + store_loss_prt = 0.0_r8 + patch_damage_litter = 0.0_r8 + ! zero the diagnostic disturbance rate fields currentSite%disturbance_rates_primary_to_primary(1:N_DIST_TYPES) = 0._r8 currentSite%disturbance_rates_primary_to_secondary(1:N_DIST_TYPES) = 0._r8 @@ -556,7 +613,7 @@ subroutine spawn_patches( currentSite, bc_in) ! 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 @@ -571,12 +628,12 @@ subroutine spawn_patches( currentSite, bc_in) ! 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) + 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() @@ -610,53 +667,52 @@ subroutine spawn_patches( currentSite, bc_in) ! 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. - + currentPatch => currentSite%oldest_patch do while(associated(currentPatch)) ! This is the amount of patch area that is disturbed, and donated by the donor patch_site_areadis = currentPatch%area * currentPatch%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 - ! disturbance type is not logging - if (currentPatch%anthro_disturbance_label .eq. primaryforest .and. & - (currentPatch%disturbance_mode .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 + ! 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 + if (currentPatch%anthro_disturbance_label .eq. primaryforest .and. & + (currentPatch%disturbance_mode .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 dominant 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 + (currentPatch%disturbance_mode .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. if(currentPatch%disturbance_mode .ne. dtype_ifire) then - currentPatch%burnt_frac_litter(:) = 0._r8 + currentPatch%burnt_frac_litter(:) = 0._r8 end if call TransLitterNewPatch( currentSite, currentPatch, new_patch, patch_site_areadis) @@ -670,9 +726,23 @@ subroutine spawn_patches( currentSite, bc_in) call fire_litter_fluxes(currentSite, currentPatch, & new_patch, patch_site_areadis,bc_in) else - call mortality_litter_fluxes(currentSite, currentPatch, & + call mortality_litter_fluxes(currentSite, currentPatch,& new_patch, patch_site_areadis,bc_in) - endif + end if + + + + ! and the damaged trees + if(hlm_use_canopy_damage .eq. itrue .or. hlm_use_understory_damage .eq. itrue) then + if( damage_time ) then + + call damage_litter_fluxes(currentSite, currentPatch, & + new_patch, patch_site_areadis, patch_damage_litter) + end if + end if + + ! in kg - for mass conservation checking + total_litter_d = total_litter_d + patch_damage_litter ! -------------------------------------------------------------------------- ! The newly formed patch from disturbance (new_patch), has now been given @@ -680,70 +750,82 @@ subroutine spawn_patches( currentSite, bc_in) ! ! Next, we loop through the cohorts in the donor patch, copy them with ! area modified number density into the new-patch, and apply survivorship. + ! Cohorts in the new patch have to be split into damage and undamaged. ! ------------------------------------------------------------------------- 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) - - 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 dominant disturbance - if(currentPatch%disturbance_mode .eq. dtype_ifall) then - - if(currentCohort%canopy_layer == 1)then + agb_frac = prt_params%allom_agb_frac(currentCohort%pft) + + allocate(nc) ! new cohort surviving + 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) + 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) + ! nc_d is the new cohort that goes in the disturbed (new) patch and gets damaged + 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 + + + ! As we loop through disturbances we just focus on nc - surviving trees in new patch + ! After this loop we can alter number densities in nc and nc_d and apply damage + + ! if treefall mortality is the dominant disturbance + if(currentPatch%disturbance_mode .eq. dtype_ifall) then + + ! if canopy + 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)) - + 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 + ! because the cohort should dissappear nc%hmort = nan nc%bmort = nan nc%frmort = nan nc%smort = nan nc%asmort = nan + nc%dgmort = nan nc%lmort_direct = nan nc%lmort_collateral = nan nc%lmort_infra = nan nc%l_degrad = nan - + else ! small trees if( int(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. @@ -752,7 +834,7 @@ subroutine spawn_patches( currentSite, bc_in) ! 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 @@ -763,17 +845,36 @@ subroutine spawn_patches( currentSite, bc_in) 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_crownarea = currentSite%imort_crownarea + & + currentCohort%c_area * ED_val_understorey_death / hlm_freq_day + currentSite%imort_carbonflux = currentSite%imort_carbonflux + & (nc%n * ED_val_understorey_death / hlm_freq_day ) * & total_c * g_per_kg * days_per_sec * years_per_day * ha_per_m2 - + + + if (hlm_use_canopy_damage .eq. itrue .or. hlm_use_understory_damage .eq. itrue) then + + currentSite%imort_rate_damage(currentCohort%crowndamage, & + currentCohort%size_class, currentCohort%pft) = & + currentSite%imort_rate_damage(currentCohort%crowndamage,& + currentCohort%size_class, currentCohort%pft) + & + nc%n * ED_val_understorey_death / hlm_freq_day + + currentSite%imort_cflux_damage(currentCohort%crowndamage, currentCohort%size_class) = & + currentSite%imort_cflux_damage(currentCohort%crowndamage, currentCohort%size_class) + & + (nc%n * ED_val_understorey_death / hlm_freq_day ) * & + total_c * g_per_kg * days_per_sec * years_per_day * ha_per_m2 + + end if + + ! 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 @@ -781,96 +882,131 @@ subroutine spawn_patches( currentSite, bc_in) ! 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%dgmort = currentCohort%dgmort 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 + + else ! if not woody ! 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%dgmort = currentCohort%dgmort nc%dmort = currentCohort%dmort nc%lmort_direct = currentCohort%lmort_direct nc%lmort_collateral = currentCohort%lmort_collateral nc%lmort_infra = currentCohort%lmort_infra - + endif - endif - + end if + ! Fire is the dominant disturbance elseif (currentPatch%disturbance_mode .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 = currentSite%fmort_carbonflux_canopy + & (nc%n * currentCohort%fire_mort) * & total_c * g_per_kg * days_per_sec * ha_per_m2 - + + currentSite%fmort_crownarea_canopy = currentSite%fmort_crownarea_canopy + & + currentCohort%c_area * currentCohort%fire_mort / hlm_freq_day + 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 = currentSite%fmort_carbonflux_ustory + & (nc%n * currentCohort%fire_mort) * & total_c * g_per_kg * days_per_sec * ha_per_m2 + + currentSite%fmort_crownarea_ustory = currentSite%fmort_crownarea_ustory + & + currentCohort%c_area * currentCohort%fire_mort / hlm_freq_day + end if + ! also track fire damage mortality and cflux along size x damage axis + if(hlm_use_canopy_damage .eq. itrue .or. hlm_use_understory_damage .eq. itrue) then + if(levcan==ican_upper) then + currentSite%fmort_rate_canopy_damage(currentCohort%crowndamage, currentCohort%size_class, & + currentCohort%pft) = & + currentSite%fmort_rate_canopy_damage(currentCohort%crowndamage, currentCohort%size_class,& + currentCohort%pft) + nc%n * currentCohort%fire_mort / hlm_freq_day + + currentSite%fmort_cflux_canopy_damage(currentCohort%crowndamage, currentCohort%size_class) = & + currentSite%fmort_cflux_canopy_damage(currentCohort%crowndamage, currentCohort%size_class) + & + (nc%n * currentCohort%fire_mort) * & + total_c * g_per_kg * days_per_sec * ha_per_m2 + else + currentSite%fmort_rate_ustory_damage(currentCohort%crowndamage, currentCohort%size_class, & + currentCohort%pft) = & + currentSite%fmort_rate_ustory_damage(currentCohort%crowndamage, currentCohort%size_class, & + currentCohort%pft) + nc%n * currentCohort%fire_mort / hlm_freq_day + + currentSite%fmort_cflux_ustory_damage(currentCohort%crowndamage, currentCohort%size_class) = & + currentSite%fmort_cflux_ustory_damage(currentCohort%crowndamage, currentCohort%size_class) + & + (nc%n * currentCohort%fire_mort) * & + total_c * g_per_kg * days_per_sec * ha_per_m2 + end if + 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%dgmort = currentCohort%dgmort nc%dmort = currentCohort%dmort nc%lmort_direct = currentCohort%lmort_direct nc%lmort_collateral = currentCohort%lmort_collateral @@ -880,37 +1016,37 @@ subroutine spawn_patches( currentSite, bc_in) ! 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(int(prt_params%woody(currentCohort%pft)) == itrue)then - leaf_burn_frac = currentCohort%fraction_crown_burned + leaf_burn_frac = currentCohort%fraction_crown_burned else - ! Grasses determine their fraction of leaves burned here + ! Grasses determine their fraction of leaves burned here - leaf_burn_frac = currentPatch%burnt_frac_litter(lg_sf) + 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__)) + (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)) + 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 + 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 @@ -919,26 +1055,24 @@ subroutine spawn_patches( currentSite, bc_in) currentCohort%fraction_crown_burned = 0.0_r8 nc%fraction_crown_burned = 0.0_r8 + ! Logging is the dominant disturbance + elseif (currentPatch%disturbance_mode .eq. dtype_ilog ) then - - ! Logging is the dominant disturbance - elseif (currentPatch%disturbance_mode .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))) + (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 @@ -946,6 +1080,7 @@ subroutine spawn_patches( currentSite, bc_in) nc%frmort = currentCohort%frmort nc%smort = currentCohort%smort nc%asmort = currentCohort%asmort + nc%dgmort = currentCohort%dgmort nc%dmort = currentCohort%dmort ! since these are the ones that weren't logged, @@ -953,15 +1088,15 @@ subroutine spawn_patches( currentSite, bc_in) 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(int(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. @@ -969,7 +1104,8 @@ subroutine spawn_patches( currentSite, bc_in) ! 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 @@ -981,47 +1117,66 @@ subroutine spawn_patches( currentSite, bc_in) currentSite%imort_rate(currentCohort%size_class, currentCohort%pft) + & nc%n * currentPatch%fract_ldist_not_harvested * & logging_coll_under_frac / hlm_freq_day + + currentSite%imort_crownarea = currentSite%imort_crownarea + & + nc%c_area * currentPatch%fract_ldist_not_harvested * & + logging_coll_under_frac / hlm_freq_day currentSite%imort_carbonflux = currentSite%imort_carbonflux + & (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 - - + + if (hlm_use_canopy_damage .eq. itrue .or. hlm_use_understory_damage .eq. itrue) then + currentSite%imort_rate_damage(currentCohort%crowndamage,& + currentCohort%size_class, currentCohort%pft) = & + currentSite%imort_rate_damage(currentCohort%crowndamage,& + currentCohort%size_class, currentCohort%pft) + & + nc%n * currentPatch%fract_ldist_not_harvested * & + logging_coll_under_frac / hlm_freq_day + + currentSite%imort_cflux_damage(nc%crowndamage, nc%size_class) = & + currentSite%imort_cflux_damage(nc%crowndamage, nc%size_class) + & + (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 + end if + ! 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%dgmort = currentCohort%dgmort nc%dmort = currentCohort%dmort nc%lmort_direct = currentCohort%lmort_direct nc%lmort_collateral = currentCohort%lmort_collateral nc%lmort_infra = currentCohort%lmort_infra - - else - + + else ! if not woody + ! 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 @@ -1029,21 +1184,196 @@ subroutine spawn_patches( currentSite, bc_in) nc%frmort = currentCohort%frmort nc%smort = currentCohort%smort nc%asmort = currentCohort%asmort + nc%dgmort = currentCohort%dgmort 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(),*) 'disturbance_mode: ',currentPatch%disturbance_mode - call endrun(msg=errMsg(sourcefile, __LINE__)) - end if ! Select disturbance mode + + end if + + else + write(fates_log(),*) 'unknown disturbance mode?' + write(fates_log(),*) 'disturbance_mode: ',currentPatch%disturbance_mode + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if ! Select disturbance mode + + ! Regardless of disturbance type, reduce mass of damaged trees + if(hlm_use_canopy_damage .eq.itrue .or. hlm_use_understory_damage .eq. itrue) then + if(damage_time) then + + ! if woody + if (prt_params%woody(currentCohort%pft)==1 ) then + + if(.not. currentCohort%isnew ) then + + ! to keep track of how much canopy n needs to be reduced by after the loop + cd_n_total = 0.0_r8 + + ! for each damage class find the number density and if big enough allocate a new cohort + do cd = currentCohort%crowndamage+1, ncrowndamage + + call get_damage_frac(currentCohort%crowndamage, cd, currentCohort%pft, cd_frac) + + if(hlm_use_canopy_damage .eq. itrue .and. currentCohort%canopy_layer == 1) then + cd_n = currentCohort%n * cd_frac + else if(hlm_use_understory_damage .eq. itrue .and. currentCohort%canopy_layer > 1) then + cd_n = nc%n * cd_frac + else + cd_n = 0._r8 + end if + + + if(cd_n > nearzero) then + + cd_n_total = cd_n_total + cd_n + + allocate(nc_d) ! new cohort surviving but damaged + if(hlm_use_planthydro.eq.itrue) call InitHydrCohort(CurrentSite,nc_d) + + ! Initialize the PARTEH object and point to the + ! correct boundary condition fields + nc_d%prt => null() + + call InitPRTObject(nc_d%prt) + call InitPRTBoundaryConditions(nc_d) + call zero_cohort(nc_d) + + ! nc_canopy_d is the new cohort that gets damaged + call copy_cohort(currentCohort, nc_d) + + nc_d%canopy_layer = currentCohort%canopy_layer + nc_d%canopy_layer_yesterday = 1._r8 + + ! new number densities - we just do damaged cohort here - + ! undamaged at the end of the cohort loop once we know how many damaged to + ! subtract + + nc_d%n = cd_n + nc_d%crowndamage = cd + + ! update crown area here - for cohort fusion and canopy organisation below + call carea_allom(nc_d%dbh, nc_d%n, currentSite%spread,& + nc_d%pft, nc_d%crowndamage, nc_d%c_area) + + call get_crown_reduction(nc_d%crowndamage, mass_frac) + + + leaf_m_pre = nc_d%prt%GetState(leaf_organ, all_carbon_elements) + & + nc_d%prt%GetState(repro_organ, all_carbon_elements) + call PRTDamageLosses(nc_d%prt, leaf_organ, mass_frac) + call PRTDamageLosses(nc_d%prt, repro_organ, mass_frac) + leaf_m_post = nc_d%prt%GetState(leaf_organ, all_carbon_elements) + & + nc_d%prt%GetState(repro_organ, all_carbon_elements) + + leaf_loss_prt = leaf_loss_prt + (leaf_m_pre - leaf_m_post)* & + nc_d%n + + sapw_m_pre = nc_d%prt%GetState(sapw_organ, all_carbon_elements) + call PRTDamageLosses(nc_d%prt, sapw_organ, mass_frac * & + nc_d%branch_frac * agb_frac) + sapw_m_post = nc_d%prt%GetState(sapw_organ, all_carbon_elements) + sapw_loss_prt = sapw_loss_prt + (sapw_m_pre - sapw_m_post)*nc_d%n + + struct_m_pre = nc_d%prt%GetState(struct_organ, all_carbon_elements) + call PRTDamageLosses(nc_d%prt, struct_organ, mass_frac * & + nc_d%branch_frac * agb_frac) + struct_m_post = nc_d%prt%GetState(struct_organ, all_carbon_elements) + struct_loss_prt = struct_loss_prt + (struct_m_pre - struct_m_post)* & + nc_d%n + + store_m_pre = nc_d%prt%GetState(store_organ, all_carbon_elements) + call PRTDamageLosses(nc_d%prt, store_organ, mass_frac * & + nc_d%branch_frac * agb_frac) + store_m_post = nc_d%prt%GetState(store_organ, all_carbon_elements) + store_loss_prt = store_loss_prt + (store_m_pre - store_m_post)* & + nc_d%n + + fnrt_c = nc_d%prt%GetState(fnrt_organ, all_carbon_elements) + + currentSite%damage_cflux(currentCohort%crowndamage, cd) = & + currentSite%damage_cflux(currentCohort%crowndamage, cd) + & + (leaf_m_post + sapw_m_post + struct_m_post + store_m_post + fnrt_c) * cd_n * & + hlm_days_per_year + + currentSite%damage_rate(currentCohort%crowndamage, cd) = & + currentSite%damage_rate(currentCohort%crowndamage, cd) + cd_n * hlm_days_per_year + + if(hlm_use_canopy_damage .eq. itrue) then + currentSite%crownarea_canopy_damage = currentSite%crownarea_canopy_damage + & + (currentCohort%c_area/currentCohort%n - nc_d%c_area/nc_d%n) * nc_d%n + end if + + if(hlm_use_understory_damage .eq. itrue) then + currentSite%crownarea_ustory_damage = currentSite%crownarea_ustory_damage + & + (currentCohort%c_area/currentCohort%n - nc_d%c_area/nc_d%n) * nc_d%n + end if + + + storebigcohort => currentPatch%tallest + storesmallcohort => currentPatch%shortest + if(associated(currentPatch%tallest))then + tnull = 0 + else + tnull = 1 + currentPatch%tallest => nc_d + nc_d%taller => null() + endif + + if(associated(currentPatch%shortest))then + snull = 0 + else + snull = 1 + currentPatch%shortest => nc_d + nc_d%shorter => null() + endif + + call insert_cohort(nc_d, currentPatch%tallest, currentPatch%shortest, & + tnull, snull, storebigcohort, storesmallcohort) + + currentPatch%tallest => storebigcohort + currentPatch%shortest => storesmallcohort + + end if ! end if new n is large enough + + end do ! end crowndamage loop + + ! Reduce currentCohort%n now based on sum of all new damage classes + currentCohort%n = currentCohort%n - cd_n_total + + end if ! end if not new + end if ! end if canopy and woody + end if ! end if damage time + end if ! end if damage is on + + + if(hlm_use_canopy_damage .eq. itrue .and. currentCohort%canopy_layer == 1 .or.& + hlm_use_understory_damage .eq. itrue .and. currentCohort%canopy_layer > 1) then + + if(.not. currentCohort%isnew) then + + ! Keep track of number and carbon that stayed in the same damage class + 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) + repro_c = currentCohort%prt%GetState(repro_organ, all_carbon_elements) + + currentSite%damage_cflux(currentCohort%crowndamage, currentCohort%crowndamage) = & + currentSite%damage_cflux(currentCohort%crowndamage, currentCohort%crowndamage) + & + (sapw_c + struct_c + leaf_c + fnrt_c + store_c + repro_c) * currentCohort%n + + currentSite%damage_rate(currentCohort%crowndamage, currentCohort%crowndamage) = & + currentSite%damage_rate(currentCohort%crowndamage, currentCohort%crowndamage) + currentCohort%n + + end if + end if ! end if damage is on + + ! Put new undamaged cohorts in the correct place in the linked list if (nc%n > 0.0_r8) then storebigcohort => new_patch%tallest storesmallcohort => new_patch%shortest @@ -1054,7 +1384,7 @@ subroutine spawn_patches( currentSite, bc_in) new_patch%tallest => nc nc%taller => null() endif - + if(associated(new_patch%shortest))then snull = 0 else @@ -1064,22 +1394,24 @@ subroutine spawn_patches( currentSite, bc_in) endif nc%patchptr => new_patch call insert_cohort(nc, new_patch%tallest, new_patch%shortest, & - tnull, snull, storebigcohort, storesmallcohort) - + 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) + + call sort_cohorts(currentPatch) + !update area of donor patch currentPatch%area = currentPatch%area - patch_site_areadis @@ -1092,18 +1424,21 @@ subroutine spawn_patches( currentSite, bc_in) call terminate_cohorts(currentSite, currentPatch, 2,16,bc_in) call sort_cohorts(currentPatch) + 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 - + currentPatch => currentPatch%younger - - enddo ! currentPatch patch loop. - !*************************/ + + enddo ! currentPatch patch loop. + + + !*************************/ !** INSERT NEW PATCH(ES) INTO LINKED LIST !*************************/ @@ -1179,6 +1514,24 @@ subroutine spawn_patches( currentSite, bc_in) call check_patch_area(currentSite) call set_patchno(currentSite) + + ! Stop run if the amount of litter from damage does not match the biomass lost from damaged cohorts + if ( abs(total_litter_d - (leaf_loss_prt + sapw_loss_prt + & + struct_loss_prt + store_loss_prt)) > damage_error_fail ) then + write(fates_log(),*) 'Damage to litter does not match biomass loss' + write(fates_log(),*) 'Damage to litter: ',total_litter_d, & + 'biomass loss: ', (leaf_loss_prt + sapw_loss_prt + struct_loss_prt + store_loss_prt), & + 'error: ',total_litter_d - (leaf_loss_prt + sapw_loss_prt + struct_loss_prt + store_loss_prt) + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + if (damage_time) then + + + write(fates_log(),*) 'Damage to litter: ',total_litter_d + write(fates_log(),*) 'Damage from trees:',leaf_loss_prt+ & + sapw_loss_prt + struct_loss_prt + store_loss_prt + end if return end subroutine spawn_patches @@ -1205,6 +1558,8 @@ subroutine check_patch_area( currentSite ) real(r8) :: seed_stock real(r8) :: litter_stock real(r8) :: mass_gain + real(r8) :: litter_leaf + real(r8) :: live_leaf real(r8), parameter :: area_error_fail = 1.0e-6_r8 !--------------------------------------------------------------------- @@ -1238,8 +1593,7 @@ subroutine check_patch_area( currentSite ) do el = 1,num_elements ! This returns the total mass on the patch for the current area [kg] - call PatchMassStock(largestPatch,el,live_stock,seed_stock,litter_stock) - + call PatchMassStock(largestPatch,el,live_stock,seed_stock,litter_stock) ! Then we scale the total mass by the added area mass_gain = (seed_stock+litter_stock) * & (area_site-areatot)/largestPatch%area @@ -1381,6 +1735,7 @@ subroutine TransLitterNewPatch(currentSite, & curr_litt => currentPatch%litter(el) new_litt => newPatch%litter(el) + ! Distribute the fragmentation litter flux rates. This is only used for diagnostics ! at this point. Litter fragmentation has already been passed to the output ! boundary flux arrays. @@ -1504,6 +1859,7 @@ subroutine TransLitterNewPatch(currentSite, & end do end do + do pft = 1,numpft @@ -1969,7 +2325,6 @@ subroutine mortality_litter_fluxes(currentSite, currentPatch, & flux_diags%leaf_litter_input(pft) = flux_diags%leaf_litter_input(pft) + & num_dead*(leaf_m + repro_m) - flux_diags%root_litter_input(pft) = flux_diags%root_litter_input(pft) + & num_dead * (fnrt_m + store_m*(1.0_r8-EDPftvarcon_inst%allom_frbstor_repro(pft))) @@ -1984,6 +2339,221 @@ subroutine mortality_litter_fluxes(currentSite, currentPatch, & return end subroutine mortality_litter_fluxes + ! ============================================================================ + + subroutine damage_litter_fluxes(currentSite, currentPatch, newPatch,patch_site_areadis, & + total_damage_litter) + ! + ! !DESCRIPTION: + ! + ! !USES: + use DamageMainMod, only : get_crown_reduction + use DamageMainMod , only : get_damage_frac + use SFParamsMod , only : SF_val_cwd_frac + use FatesInterfaceTypesMod , only : ncrowndamage + use EDParamsMod , only : ED_val_understorey_death + use FatesInterfaceTypesMod, only : hlm_use_canopy_damage + use FatesInterfaceTypesMod, only : hlm_use_understory_damage + use FatesConstantsMod, only : itrue + + ! + + ! !ARGUMENTS: + type(ed_site_type) , intent(inout), target :: currentSite + type(ed_patch_type) , intent(inout), target :: currentPatch + type(ed_patch_type) , intent(inout), target :: newPatch + real(r8) , intent(in) :: patch_site_areadis + real(r8), intent(out) :: total_damage_litter + + + ! !LOCAL VARIABLES: + type(ed_cohort_type), pointer :: currentCohort + type(litter_type), pointer :: new_litt + type(litter_type), pointer :: curr_litt + type(site_massbal_type), pointer :: site_mass + type(site_fluxdiags_type), pointer :: flux_diags + + real(r8) :: leaf_donatable_mass ! mass of donatable litter [kg] + real(r8) :: branch_donatable_mass! mass of donatable cwd [kg] + real(r8) :: leaf_m ! leaf mass [kg] + real(r8) :: sapw_m ! sapwood mass [kg] + real(r8) :: struct_m ! structure mass [kg] + real(r8) :: repro_m ! reproductive mass [kg] + real(r8) :: store_m ! storage mass [kg] + real(r8) :: remainder_area ! current patch area after donation [m2] + real(r8) :: retain_frac ! Fraction of mass to be retained + real(r8) :: retain_m2 ! area normalization for litter mass destined to old patch [m-2] + real(r8) :: donate_frac ! Fraction of mass to be donated + real(r8) :: donate_m2 ! area normalization for litter mass destined to new patch [m-2] + integer :: pft ! plant functional type index + integer :: crowndamage ! new increased crown damage class + real(r8) :: crown_reduction ! amount that crown is reduced by (must be same as leaf biomass) + real(r8) :: leaf_loss ! amount of leaf biomass that has been lost + real(r8) :: branch_loss ! amount of branch biomass that has been lost + integer :: dcmpy ! decomposability index + real(r8) :: seed_mass ! Total seed mass generated from storage death [kg] + integer :: c ! coarse woody debris pool index + integer :: el ! element loop index + integer :: sl ! soil layer index + integer :: element_id ! parteh compatible global element index + real(r8) :: dcmpy_frac ! decomposability fraction + real(r8) :: num_trees ! number of trees that were damaged + real(r8) :: num_trees_cd + integer :: cd + real(r8) :: cd_frac + real(r8) :: agb_frac + integer :: ncwd_no_trunk + real(r8), allocatable :: SF_val_CWD_frac_canopy(:) + real(r8) :: cd_n_tot + !--------------------------------------------------------------------- + total_damage_litter = 0.0_r8 + cd_n_tot = 0.0_r8 + ncwd_no_trunk = ncwd - 1 + allocate(SF_val_CWD_frac_canopy(ncwd_no_trunk)) + + ! crown damage is currently not trunks - but we want 100% of + ! damage above to go to litter. We therefore have to + ! renormalise just the first three litter bins + SF_val_CWD_frac_canopy = SF_val_CWD_frac(1:ncwd_no_trunk)/sum(SF_val_CWD_frac(1:ncwd_no_trunk)) + + + ! m2 + remainder_area = currentPatch%area - patch_site_areadis + ! fraction of litter to retain (remain area frac * how much + ! dispersal of litter there is) + retain_frac = (1.0_r8-damage_localization) * & + remainder_area/(newPatch%area+remainder_area) + donate_frac = 1.0_r8-retain_frac + + if(remainder_area > rsnbl_math_prec) then + retain_m2 = retain_frac/remainder_area + donate_m2 = (1.0_r8-retain_frac)/newPatch%area + else + retain_m2 = 0._r8 + donate_m2 = 1._r8/newPatch%area + end if + + + ! loop through elements and spread between retain and donate litter + do el = 1,num_elements + + element_id = element_list(el) + site_mass => currentSite%mass_balance(el) + flux_diags => currentSite%flux_diags(el) + curr_litt => currentPatch%litter(el) ! Litter pool of "current" patch + new_litt => newPatch%litter(el) + + + + currentCohort => currentPatch%shortest + + do while(associated(currentCohort)) + + + agb_frac = prt_params%allom_agb_frac(currentCohort%pft) + pft = currentCohort%pft + ! Get mass in Kg of the element in the specified organ + sapw_m = currentCohort%prt%GetState(sapw_organ, element_id) + struct_m = currentCohort%prt%GetState(struct_organ, element_id) + leaf_m = currentCohort%prt%GetState(leaf_organ, element_id) !kg + repro_m = currentCohort%prt%GetState(repro_organ, element_id) + store_m = currentCohort%prt%GetState(store_organ, element_id) + + if(prt_params%woody(currentCohort%pft)==1) then + + if( hlm_use_canopy_damage .eq.itrue .and. & + currentCohort%canopy_layer ==1 .and. .not. currentCohort%isnew) then + + ! litter is called before damage - so we need to account for mortality here too + num_trees = currentCohort%n * (1.0_r8 - fates_mortality_disturbance_fraction * & + min(1.0_r8, currentCohort%dmort* hlm_freq_day)) + + else if( hlm_use_understory_damage .eq.itrue .and. & + currentCohort%canopy_layer > 1 .and. .not. currentCohort%isnew) then + + ! for trees in new patch to be damaged + num_trees = currentCohort%n * (patch_site_areadis/currentPatch%area) * & + (1.0_r8 - ED_val_understorey_death) + + else + num_trees = 0._r8 + end if + + + + do cd = currentCohort%crowndamage+1, ncrowndamage + + call get_damage_frac(currentCohort%crowndamage, cd, currentCohort%pft, cd_frac) + + ! now to get the number of damaged trees we multiply by damage frac + num_trees_cd = num_trees * cd_frac + + cd_n_tot = cd_n_tot + num_trees_cd + + ! if non negligable get litter + if (num_trees_cd > nearzero ) then + + call get_crown_reduction(cd, crown_reduction) + + + ! leaf loss in kg + leaf_loss = (leaf_m + repro_m) * crown_reduction + leaf_donatable_mass = num_trees_cd * leaf_loss + + do dcmpy=1,ndcmpy + dcmpy_frac = GetDecompyFrac(pft,leaf_organ,dcmpy) + + new_litt%leaf_fines(dcmpy) = new_litt%leaf_fines(dcmpy) + & + leaf_donatable_mass*donate_m2*dcmpy_frac ! kg per m2 + curr_litt%leaf_fines(dcmpy) = curr_litt%leaf_fines(dcmpy) + & + leaf_donatable_mass*retain_m2*dcmpy_frac ! kg per m2 + end do + + flux_diags%leaf_litter_input(pft) = flux_diags%leaf_litter_input(pft) + & + leaf_donatable_mass + + ! branch loss + branch_loss = (sapw_m + struct_m + store_m) * crown_reduction * & + currentCohort%branch_frac * agb_frac * num_trees_cd + + do c=1,(ncwd_no_trunk) + + branch_donatable_mass = branch_loss * SF_val_CWD_frac_canopy(c) + + ! Transfer wood of dying trees to AG CWD pools + new_litt%ag_cwd(c) = new_litt%ag_cwd(c) + branch_donatable_mass * donate_m2 + + curr_litt%ag_cwd(c) = curr_litt%ag_cwd(c) + branch_donatable_mass * retain_m2 + + flux_diags%cwd_ag_input(c) = & + flux_diags%cwd_ag_input(c) + branch_donatable_mass + + end do + + ! should match leaf damage that is printed after PRTDamageLosses is called + total_damage_litter = total_damage_litter + leaf_donatable_mass + & + branch_loss + + end if ! end if non-negligable + end do ! end crown damage loop + + end if ! end if woody + + + + currentCohort => currentCohort%taller + + + enddo !currentCohort + + enddo ! end element + + return + end subroutine damage_litter_fluxes + + + + ! ============================================================================ subroutine create_patch(currentSite, new_patch, age, areap, label,nocomp_pft) diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 859f6e3534..218b55e3f1 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -427,6 +427,7 @@ subroutine trim_canopy( currentSite ) real(r8) :: initial_laimem ! Initial laimemory real(r8) :: optimum_laimem ! Optimum laimemory + real(r8) :: target_c_area !---------------------------------------------------------------------- ipatch = 1 ! Start counting patches @@ -458,18 +459,25 @@ subroutine trim_canopy( currentSite ) trimmed = .false. ipft = currentCohort%pft - call carea_allom(currentCohort%dbh,currentCohort%n,currentSite%spread,currentCohort%pft,currentCohort%c_area) + call carea_allom(currentCohort%dbh,currentCohort%n,currentSite%spread,currentCohort%pft,& + currentCohort%crowndamage, currentCohort%c_area) + leaf_c = currentCohort%prt%GetState(leaf_organ, all_carbon_elements) currentCohort%treelai = tree_lai(leaf_c, currentCohort%pft, currentCohort%c_area, & currentCohort%n, currentCohort%canopy_layer, & currentPatch%canopy_layer_tlai,currentCohort%vcmax25top ) - currentCohort%treesai = tree_sai(currentCohort%pft, currentCohort%dbh, currentCohort%canopy_trim, & - currentCohort%c_area, currentCohort%n, currentCohort%canopy_layer, & + call carea_allom(currentCohort%dbh,currentCohort%n,currentSite%spread,currentCohort%pft,& + 1, target_c_area) + + currentCohort%treesai = tree_sai(currentCohort%pft, & + currentCohort%dbh, & + currentSite%spread, currentCohort%canopy_trim, & + target_c_area, currentCohort%n,currentCohort%canopy_layer,& currentPatch%canopy_layer_tlai, currentCohort%treelai, & - currentCohort%vcmax25top,0 ) + currentCohort%vcmax25top,0 ) currentCohort%nv = ceiling((currentCohort%treelai+currentCohort%treesai)/dinc_ed) @@ -480,7 +488,8 @@ subroutine trim_canopy( currentSite ) call endrun(msg=errMsg(sourcefile, __LINE__)) endif - call bleaf(currentcohort%dbh,ipft,currentcohort%canopy_trim,tar_bl) + call bleaf(currentcohort%dbh,ipft,& + currentCohort%crowndamage, currentcohort%canopy_trim,tar_bl) if ( int(prt_params%allom_fmode(ipft)) .eq. 1 ) then ! only query fine root biomass if using a fine root allometric model that takes leaf trim into account @@ -1504,7 +1513,8 @@ subroutine assign_cohort_SP_properties(currentCohort,htop,tlai,tsai,parea,init,l spread = 1.0_r8 ! fix this to 0 to remove dynamics of canopy closure, assuming a closed canopy. ! n.b. the value of this will only affect 'n', which isn't/shouldn't be a diagnostic in ! SP mode. - call carea_allom(currentCohort%dbh,dummy_n,spread,currentCohort%pft,currentCohort%c_area) + call carea_allom(currentCohort%dbh,dummy_n,spread,currentCohort%pft,& + currentCohort%crowndamage,currentCohort%c_area) !------------------------------------------ ! Calculate canopy N assuming patch area is full @@ -1512,7 +1522,8 @@ subroutine assign_cohort_SP_properties(currentCohort,htop,tlai,tsai,parea,init,l currentCohort%n = parea / currentCohort%c_area ! correct c_area for the new nplant - call carea_allom(currentCohort%dbh,currentCohort%n,spread,currentCohort%pft,currentCohort%c_area) + call carea_allom(currentCohort%dbh,currentCohort%n,spread,currentCohort%pft,& + currentCohort%crowndamage,currentCohort%c_area) ! ------------------------------------------ ! Calculate leaf carbon from target treelai @@ -1808,6 +1819,8 @@ subroutine recruitment( currentSite, currentPatch, bc_in ) ! ! !USES: use FatesInterfaceTypesMod, only : hlm_use_ed_prescribed_phys + use FatesLitterMod , only : ncwd + use SFParamsMod , only : SF_val_CWD_frac ! ! !ARGUMENTS type(ed_site_type), intent(inout), target :: currentSite @@ -1817,6 +1830,7 @@ subroutine recruitment( currentSite, currentPatch, bc_in ) ! !LOCAL VARIABLES: class(prt_vartypes), pointer :: prt integer :: ft + integer :: c type (ed_cohort_type) , pointer :: temp_cohort type (litter_type), pointer :: litt ! The litter object (carbon right now) type(site_massbal_type), pointer :: site_mass ! For accounting total in-out mass fluxes @@ -1824,6 +1838,7 @@ subroutine recruitment( currentSite, currentPatch, bc_in ) integer :: el ! loop counter for element integer :: element_id ! element index consistent with definitions in PRTGenericMod integer :: iage ! age loop counter for leaf age bins + integer :: crowndamage integer,parameter :: recruitstatus = 1 !weather it the new created cohorts is recruited or initialized real(r8) :: c_leaf ! target leaf biomass [kgC] real(r8) :: c_fnrt ! target fine root biomass [kgC] @@ -1854,7 +1869,8 @@ subroutine recruitment( currentSite, currentPatch, bc_in ) do ft = 1,numpft if(currentSite%use_this_pft(ft).eq.itrue)then - temp_cohort%canopy_trim = init_recruit_trim + temp_cohort%canopy_trim = init_recruit_trim + temp_cohort%crowndamage = 1 ! new recruits are undamaged temp_cohort%pft = ft temp_cohort%hite = EDPftvarcon_inst%hgt_min(ft) temp_cohort%coage = 0.0_r8 @@ -1862,14 +1878,23 @@ subroutine recruitment( currentSite, currentPatch, bc_in ) call h2d_allom(temp_cohort%hite,ft,temp_cohort%dbh) + temp_cohort%branch_frac = 0.0_r8 + do c = 1, (ncwd-1) + temp_cohort%branch_frac = temp_cohort%branch_frac + & + SF_val_CWD_frac(c) + end do + ! Initialize live pools - call bleaf(temp_cohort%dbh,ft,temp_cohort%canopy_trim,c_leaf) + call bleaf(temp_cohort%dbh,ft,temp_cohort%crowndamage,& + temp_cohort%canopy_trim,c_leaf) call bfineroot(temp_cohort%dbh,ft,temp_cohort%canopy_trim,c_fnrt) - call bsap_allom(temp_cohort%dbh,ft,temp_cohort%canopy_trim,a_sapw, c_sapw) - call bagw_allom(temp_cohort%dbh,ft,c_agw) + call bsap_allom(temp_cohort%dbh,ft,temp_cohort%crowndamage, temp_cohort%branch_frac, & + temp_cohort%canopy_trim,a_sapw, c_sapw) + call bagw_allom(temp_cohort%dbh,ft,temp_cohort%crowndamage, temp_cohort%branch_frac, c_agw) call bbgw_allom(temp_cohort%dbh,ft,c_bgw) call bdead_allom(c_agw,c_bgw,c_sapw,ft,c_struct) - call bstore_allom(temp_cohort%dbh,ft,temp_cohort%canopy_trim,c_store) + call bstore_allom(temp_cohort%dbh,ft, temp_cohort%crowndamage, & + temp_cohort%canopy_trim,c_store) ! Default assumption is that leaves are on cohortstatus = leaves_on @@ -2084,12 +2109,14 @@ subroutine recruitment( currentSite, currentPatch, bc_in ) call prt%CheckInitialConditions() ! This initializes the cohort - call create_cohort(currentSite,currentPatch, temp_cohort%pft, temp_cohort%n, & - temp_cohort%hite, temp_cohort%coage, temp_cohort%dbh, prt, & + call create_cohort(currentSite,currentPatch, temp_cohort%pft, temp_cohort%n, & + temp_cohort%hite,temp_cohort%coage, temp_cohort%dbh, prt, & temp_cohort%laimemory, temp_cohort%sapwmemory, temp_cohort%structmemory, & cohortstatus, recruitstatus, & temp_cohort%canopy_trim,temp_cohort%c_area, & - currentPatch%NCL_p, currentSite%spread, bc_in) + currentPatch%NCL_p, & + temp_cohort%crowndamage, temp_cohort%branch_frac, & + currentSite%spread, bc_in) ! Note that if hydraulics is on, the number of cohorts may had ! changed due to hydraulic constraints. diff --git a/biogeochem/FatesAllometryMod.F90 b/biogeochem/FatesAllometryMod.F90 index e47934715d..d94b5d4adb 100644 --- a/biogeochem/FatesAllometryMod.F90 +++ b/biogeochem/FatesAllometryMod.F90 @@ -97,7 +97,7 @@ module FatesAllometryMod use FatesGlobals , only : endrun => fates_endrun use EDTypesMod , only : nlevleaf, dinc_ed use EDTypesMod , only : nclmax - + use DamageMainMod , only : get_crown_reduction implicit none @@ -157,8 +157,8 @@ module FatesAllometryMod ! ============================================================================ - subroutine CheckIntegratedAllometries(dbh,ipft,canopy_trim, & - bl,bfr,bsap,bstore,bdead, & + subroutine CheckIntegratedAllometries(dbh,ipft,crowndamage, branch_frac, & + canopy_trim, bl,bfr,bsap,bstore,bdead, & grow_leaf, grow_fr, grow_sap, grow_store, grow_dead, & max_err, l_pass) @@ -172,6 +172,8 @@ subroutine CheckIntegratedAllometries(dbh,ipft,canopy_trim, & real(r8),intent(in) :: dbh ! diameter of plant [cm] integer,intent(in) :: ipft ! plant functional type index + integer,intent(in) :: crowndamage + real(r8),intent(in) :: branch_frac real(r8),intent(in) :: canopy_trim ! trimming function real(r8),intent(in) :: bl ! integrated leaf biomass [kgC] real(r8),intent(in) :: bfr ! integrated fine root biomass [kgC] @@ -202,7 +204,7 @@ subroutine CheckIntegratedAllometries(dbh,ipft,canopy_trim, & l_pass = .true. ! Default assumption is that step passed if (grow_leaf) then - call bleaf(dbh,ipft,canopy_trim,bl_diag) + call bleaf(dbh,ipft,crowndamage, canopy_trim,bl_diag) if( abs(bl_diag-bl) > max_err ) then if(verbose_logging) then write(fates_log(),*) 'disparity in integrated/diagnosed leaf carbon' @@ -230,7 +232,7 @@ subroutine CheckIntegratedAllometries(dbh,ipft,canopy_trim, & end if if (grow_sap) then - call bsap_allom(dbh,ipft,canopy_trim,asap_diag,bsap_diag) + call bsap_allom(dbh,ipft,crowndamage, branch_frac, canopy_trim,asap_diag,bsap_diag) if( abs(bsap_diag-bsap) > max_err ) then if(verbose_logging) then write(fates_log(),*) 'disparity in integrated/diagnosed sapwood carbon' @@ -244,7 +246,7 @@ subroutine CheckIntegratedAllometries(dbh,ipft,canopy_trim, & end if if (grow_store) then - call bstore_allom(dbh,ipft,canopy_trim,bstore_diag) + call bstore_allom(dbh,ipft,crowndamage, canopy_trim,bstore_diag) if( abs(bstore_diag-bstore) > max_err ) then if(verbose_logging) then write(fates_log(),*) 'disparity in integrated/diagnosed storage carbon' @@ -258,8 +260,8 @@ subroutine CheckIntegratedAllometries(dbh,ipft,canopy_trim, & end if if (grow_dead) then - call bsap_allom(dbh,ipft,canopy_trim,asap_diag,bsap_diag) - call bagw_allom(dbh,ipft,bagw_diag) + call bsap_allom(dbh,ipft,crowndamage, branch_frac, canopy_trim,asap_diag,bsap_diag) + call bagw_allom(dbh,ipft,crowndamage, branch_frac, bagw_diag) call bbgw_allom(dbh,ipft,bbgw_diag) call bdead_allom( bagw_diag, bbgw_diag, bsap_diag, ipft, bdead_diag ) if( abs(bdead_diag-bdead) > max_err ) then @@ -359,16 +361,20 @@ end subroutine h_allom ! Generic AGB interface ! ============================================================================ - subroutine bagw_allom(d,ipft,bagw,dbagwdd) + subroutine bagw_allom(d,ipft,crowndamage, branch_frac, bagw,dbagwdd) + use DamageMainMod, only : get_crown_reduction real(r8),intent(in) :: d ! plant diameter [cm] integer(i4),intent(in) :: ipft ! PFT index + integer(i4),intent(in) :: crowndamage + real(r8),intent(in) :: branch_frac real(r8),intent(out) :: bagw ! biomass above ground woody tissues real(r8),intent(out),optional :: dbagwdd ! change in agbw per diameter [kgC/cm] real(r8) :: h ! height real(r8) :: dhdd ! change in height wrt d + real(r8) :: crown_reduction associate( p1 => prt_params%allom_agb1(ipft), & p2 => prt_params%allom_agb2(ipft), & @@ -395,6 +401,15 @@ subroutine bagw_allom(d,ipft,bagw,dbagwdd) call endrun(msg=errMsg(sourcefile, __LINE__)) end select + if(crowndamage > 1) then + call get_crown_reduction(crowndamage, crown_reduction) + bagw = bagw - (bagw * branch_frac * crown_reduction) + if(present(dbagwdd))then + dbagwdd = dbagwdd - (dbagwdd * branch_frac * crown_reduction) + end if + end if + + end associate return end subroutine bagw_allom @@ -439,12 +454,13 @@ end subroutine blmax_allom ! Generic crown area allometry wrapper ! ============================================================================ - subroutine carea_allom(dbh,nplant,site_spread,ipft,c_area,inverse) + subroutine carea_allom(dbh,nplant,site_spread,ipft,crowndamage,c_area,inverse) real(r8),intent(inout) :: dbh ! plant diameter at breast (reference) height [cm] real(r8),intent(in) :: site_spread ! site level spread factor (crowdedness) real(r8),intent(in) :: nplant ! number of plants [1/ha] integer(i4),intent(in) :: ipft ! PFT index + integer(i4),intent(in) :: crowndamage ! crown damage class of the cohort real(r8),intent(inout) :: c_area ! crown area per cohort (m2) logical,optional,intent(in) :: inverse ! if true, calculate dbh from crown area ! instead of crown area from dbh @@ -475,14 +491,17 @@ subroutine carea_allom(dbh,nplant,site_spread,ipft,c_area,inverse) select case(int(allom_lmode)) case(1) dbh_eff = min(dbh,dbh_maxh) - call carea_2pwr(dbh_eff,site_spread,d2bl_p2,d2bl_ediff,d2ca_min,d2ca_max,c_area,do_inverse) + call carea_2pwr(dbh_eff,site_spread,d2bl_p2,d2bl_ediff,d2ca_min,d2ca_max, & + c_area,do_inverse, crowndamage) capped_allom = .true. case(2) ! "2par_pwr") - call carea_2pwr(dbh,site_spread,d2bl_p2,d2bl_ediff,d2ca_min,d2ca_max,c_area,do_inverse) + call carea_2pwr(dbh,site_spread,d2bl_p2,d2bl_ediff,d2ca_min,d2ca_max,c_area, & + do_inverse, crowndamage) capped_allom = .false. case(3) dbh_eff = min(dbh,dbh_maxh) - call carea_2pwr(dbh_eff,site_spread,d2bl_p2,d2bl_ediff,d2ca_min,d2ca_max,c_area,do_inverse) + call carea_2pwr(dbh_eff,site_spread,d2bl_p2,d2bl_ediff,d2ca_min,d2ca_max, & + c_area,do_inverse, crowndamage) capped_allom = .true. case DEFAULT write(fates_log(),*) 'An undefined leaf allometry was specified: ', & @@ -513,7 +532,7 @@ end subroutine carea_allom ! ===================================================================================== - subroutine bleaf(d,ipft,canopy_trim,bl,dbldd) + subroutine bleaf(d,ipft,crowndamage,canopy_trim,bl,dbldd) ! ------------------------------------------------------------------------- ! This subroutine calculates the actual target bleaf @@ -521,15 +540,19 @@ subroutine bleaf(d,ipft,canopy_trim,bl,dbldd) ! is not allometry and rather an emergent property, ! this routine is not name-spaced with allom_ ! ------------------------------------------------------------------------- + + use DamageMainMod , only : get_crown_reduction real(r8),intent(in) :: d ! plant diameter [cm] integer(i4),intent(in) :: ipft ! PFT index + integer(i4),intent(in) :: crowndamage ! crown damage class real(r8),intent(in) :: canopy_trim ! trimming function real(r8),intent(out) :: bl ! plant leaf biomass [kg] real(r8),intent(out),optional :: dbldd ! change leaf bio per diameter [kgC/cm] real(r8) :: blmax real(r8) :: dblmaxdd + real(r8) :: crown_reduction call blmax_allom(d,ipft,blmax,dblmaxdd) @@ -541,10 +564,20 @@ subroutine bleaf(d,ipft,canopy_trim,bl,dbldd) ! ------------------------------------------------------------------------- bl = blmax * canopy_trim - + if(present(dbldd))then dbldd = dblmaxdd * canopy_trim end if + + + if ( crowndamage > 1 ) then + + call get_crown_reduction(crowndamage, crown_reduction) + bl = bl * (1.0_r8 - crown_reduction) + if(present(dbldd))then + dbldd = dblmaxdd * canopy_trim * (1.0_r8 - crown_reduction) + end if + end if return end subroutine bleaf @@ -702,17 +735,18 @@ end function tree_lai ! ============================================================================ - real(r8) function tree_sai( pft, dbh, canopy_trim, c_area, nplant, cl, & + real(r8) function tree_sai(pft, dbh, site_spread, canopy_trim, target_c_area, nplant, cl, & canopy_lai, treelai, vcmax25top, call_id ) ! ============================================================================ ! SAI of individual trees is a function of the LAI of individual trees ! ============================================================================ - integer, intent(in) :: pft - real(r8), intent(in) :: dbh + integer, intent(in) :: pft + real(r8), intent(inout) :: dbh + real(r8), intent(in) :: site_spread + real(r8), intent(inout) :: target_c_area real(r8), intent(in) :: canopy_trim ! trimming function (0-1) - real(r8), intent(in) :: c_area ! crown area (m2) real(r8), intent(in) :: nplant ! number of plants integer, intent(in) :: cl ! canopy layer index real(r8), intent(in) :: canopy_lai(nclmax) ! total leaf area index of @@ -722,12 +756,16 @@ real(r8) function tree_sai( pft, dbh, canopy_trim, c_area, nplant, cl, & integer,intent(in) :: call_id ! flag specifying where this is called ! from real(r8) :: h - real(r8) :: target_bleaf real(r8) :: target_lai + real(r8) :: target_bleaf - call bleaf(dbh,pft,canopy_trim,target_bleaf) + ! target undamaged bleaf + call bleaf(dbh, pft, 1, canopy_trim, target_bleaf) - target_lai = tree_lai( target_bleaf, pft, c_area, nplant, cl, canopy_lai, vcmax25top) + call carea_allom(dbh, nplant, site_spread, pft, 1, target_c_area, inverse = .false.) + + target_lai = tree_lai(target_bleaf, pft, target_c_area, nplant, cl,& + canopy_lai, vcmax25top) tree_sai = prt_params%allom_sai_scaler(pft) * target_lai @@ -738,17 +776,17 @@ real(r8) function tree_sai( pft, dbh, canopy_trim, c_area, nplant, cl, & write(fates_log(),*) 'The leaf and stem are predicted for a cohort, maxed out the array size' write(fates_log(),*) 'lai: ',treelai write(fates_log(),*) 'sai: ',tree_sai - write(fates_log(),*) 'target_lai: ',target_lai write(fates_log(),*) 'lai+sai: ',treelai+tree_sai + write(fates_log(),*) 'target_bleaf: ', target_bleaf + write(fates_log(),*) 'target_c_area: ', target_c_area + write(fates_log(),*) 'target_lai: ',target_lai write(fates_log(),*) 'nlevleaf,dinc_ed,nlevleaf*dinc_ed :',nlevleaf,dinc_ed,nlevleaf*dinc_ed write(fates_log(),*) 'pft: ',pft write(fates_log(),*) 'call id: ',call_id write(fates_log(),*) 'n: ',nplant - write(fates_log(),*) 'c_area: ',c_area write(fates_log(),*) 'dbh: ',dbh,' dbh_max: ',prt_params%allom_dbh_maxheight(pft) write(fates_log(),*) 'h: ',h write(fates_log(),*) 'canopy_trim: ',canopy_trim - write(fates_log(),*) 'target_bleaf: ',target_bleaf write(fates_log(),*) 'canopy layer: ',cl write(fates_log(),*) 'canopy_tlai: ',canopy_lai(:) write(fates_log(),*) 'vcmax25top: ',vcmax25top @@ -853,10 +891,14 @@ end function leafc_from_treelai ! Generic sapwood biomass interface ! ============================================================================ - subroutine bsap_allom(d,ipft,canopy_trim,sapw_area,bsap,dbsapdd) + subroutine bsap_allom(d,ipft,crowndamage, branch_frac, canopy_trim,sapw_area,bsap,dbsapdd) + + use DamageMainMod , only : get_crown_reduction real(r8),intent(in) :: d ! plant diameter [cm] integer(i4),intent(in) :: ipft ! PFT index + integer(i4),intent(in) :: crowndamage + real(r8),intent(in) :: branch_frac real(r8),intent(in) :: canopy_trim real(r8),intent(out) :: sapw_area ! cross section area of ! plant sapwood at reference [m2] @@ -876,10 +918,16 @@ subroutine bsap_allom(d,ipft,canopy_trim,sapw_area,bsap,dbsapdd) ! than some specified proportion of woody biomass ! should not trip, and only in small plants + real(r8) :: crown_reduction + real(r8) :: agb_frac + ! Constrain sapwood so that its above ground portion be no larger than ! X% of total woody/fibrous (ie non leaf/fineroot) tissues real(r8),parameter :: max_frac = 0.95_r8 + agb_frac = prt_params%allom_agb_frac(ipft) + + select case(int(prt_params%allom_smode(ipft))) ! --------------------------------------------------------------------- ! Currently only one sapwood allometry model. the slope @@ -889,11 +937,23 @@ subroutine bsap_allom(d,ipft,canopy_trim,sapw_area,bsap,dbsapdd) ! and slatop (no provisions for slamax) call h_allom(d,ipft,h,dhdd) - call bleaf(d,ipft,canopy_trim,bl,dbldd) + call bleaf(d,ipft,1,canopy_trim,bl,dbldd) call bsap_ltarg_slatop(d,h,dhdd,bl,dbldd,ipft,sapw_area,bsap,dbsapdd) + ! if trees are damaged reduce bsap by percent crown loss * + ! fraction of biomass that would be in branches (pft specific) + if(crowndamage > 1)then + + call get_crown_reduction(crowndamage, crown_reduction) + bsap = bsap - (bsap * agb_frac * branch_frac * crown_reduction) + if(present(dbsapdd))then + dbsapdd = dbsapdd - (dbsapdd * agb_frac * branch_frac * crown_reduction) + end if + end if + + ! Perform a capping/check on total woody biomass - call bagw_allom(d,ipft,bagw,dbagwdd) + call bagw_allom(d,ipft,crowndamage, branch_frac, bagw,dbagwdd) call bbgw_allom(d,ipft,bbgw,dbbgwdd) ! Force sapwood to be less than a maximum fraction of total biomass @@ -935,7 +995,8 @@ subroutine bbgw_allom(d,ipft,bbgw,dbbgwdd) select case(int(prt_params%allom_cmode(ipft))) case(1) !"constant") - call bagw_allom(d,ipft,bagw,dbagwdd) + ! bbgw not affected by damage so use target allometry no damage + call bagw_allom(d,ipft,1, 1.0_r8, bagw,dbagwdd) call bbgw_const(d,bagw,dbagwdd,ipft,bbgw,dbbgwdd) case DEFAULT write(fates_log(),*) 'An undefined coarse root allometry was specified: ', & @@ -1002,10 +1063,11 @@ end subroutine bfineroot ! Storage biomass interface ! ============================================================================ - subroutine bstore_allom(d,ipft,canopy_trim,bstore,dbstoredd) + subroutine bstore_allom(d,ipft,crowndamage, canopy_trim,bstore,dbstoredd) real(r8),intent(in) :: d ! plant diameter [cm] integer(i4),intent(in) :: ipft ! PFT index + integer(i4),intent(in) :: crowndamage ! Crowndamage class real(r8),intent(in) :: canopy_trim ! Crown trimming function [0-1] real(r8),intent(out) :: bstore ! allometric target storage [kgC] real(r8),intent(out),optional :: dbstoredd ! change storage per cm [kgC/cm] @@ -1023,7 +1085,7 @@ subroutine bstore_allom(d,ipft,canopy_trim,bstore,dbstoredd) case(1) ! Storage is constant proportionality of trimmed maximum leaf ! biomass (ie cushion * bleaf) - call bleaf(d,ipft,canopy_trim,bl,dbldd) + call bleaf(d,ipft, crowndamage, canopy_trim, bl, dbldd) call bstore_blcushion(d,bl,dbldd,cushion,ipft,bstore,dbstoredd) case DEFAULT @@ -2012,7 +2074,7 @@ end subroutine CrownDepth ! ============================================================================= - subroutine carea_2pwr(dbh,spread,d2bl_p2,d2bl_ediff,d2ca_min,d2ca_max,c_area,inverse) + subroutine carea_2pwr(dbh,spread,d2bl_p2,d2bl_ediff,d2ca_min,d2ca_max,c_area,inverse,crowndamage) ! ============================================================================ ! Calculate area of ground covered by entire cohort. (m2) @@ -2027,9 +2089,11 @@ subroutine carea_2pwr(dbh,spread,d2bl_p2,d2bl_ediff,d2ca_min,d2ca_max,c_area,inv real(r8),intent(in) :: d2ca_max ! maximum diameter to crown area scaling factor real(r8),intent(inout) :: c_area ! crown area for one plant [m2] logical,intent(in) :: inverse ! if true, calculate dbh from crown area rather than its reverse + integer,intent(in) :: crowndamage real(r8) :: crown_area_to_dbh_exponent real(r8) :: spreadterm ! Effective 2bh to crown area scaling factor + real(r8) :: crown_reduction ! default is to use the same exponent as the dbh to bleaf exponent so that per-plant ! canopy depth remains invariant during growth, but allowed to vary via the @@ -2052,7 +2116,17 @@ subroutine carea_2pwr(dbh,spread,d2bl_p2,d2bl_ediff,d2ca_min,d2ca_max,c_area,inv if ( .not. inverse) then c_area = spreadterm * dbh ** crown_area_to_dbh_exponent + + if(crowndamage > 1) then + call get_crown_reduction(crowndamage, crown_reduction) + c_area = c_area * (1.0_r8 - crown_reduction) + end if + else + if(crowndamage > 1) then + call get_crown_reduction(crowndamage, crown_reduction) + c_area = c_area/(1.0_r8 - crown_reduction) + end if dbh = (c_area / spreadterm) ** (1./crown_area_to_dbh_exponent) endif @@ -2320,9 +2394,7 @@ real(r8) function decay_coeff_kn(pft,vcmax25top) end function decay_coeff_kn ! ===================================================================================== - - - subroutine ForceDBH( ipft, canopy_trim, d, h, bdead, bl ) +subroutine ForceDBH( ipft, canopy_trim, d, h, bdead, bl, crowndamage, branch_frac ) ! ========================================================================= ! This subroutine estimates the diameter based on either the structural biomass @@ -2332,17 +2404,18 @@ subroutine ForceDBH( ipft, canopy_trim, d, h, bdead, bl ) ! Here, we keep searching until the difference between actual structure and ! the predicted structure based on the searched diameter is within a tolerance. ! ============================================================================ - - use FatesConstantsMod , only : calloc_abs_error + use FatesConstantsMod , only : calloc_abs_error ! Arguments integer(i4),intent(in) :: ipft ! PFT index + integer(i4),intent(in),optional :: crowndamage ! crowndamage real(r8),intent(in) :: canopy_trim real(r8),intent(inout) :: d ! plant diameter [cm] real(r8),intent(out) :: h ! plant height real(r8),intent(in),optional :: bdead ! Structural biomass real(r8),intent(in),optional :: bl ! Leaf biomass + real(r8),intent(in),optional :: branch_frac ! Locals @@ -2362,6 +2435,7 @@ subroutine ForceDBH( ipft, canopy_trim, d, h, bdead, bl ) integer :: counter real(r8), parameter :: step_frac0 = 0.9_r8 integer, parameter :: max_counter = 200 + ! Do reduce "if" calls, we break this call into two parts if ( int(prt_params%woody(ipft)) == itrue ) then @@ -2371,9 +2445,10 @@ subroutine ForceDBH( ipft, canopy_trim, d, h, bdead, bl ) call endrun(msg=errMsg(sourcefile, __LINE__)) end if - call bsap_allom(d,ipft,canopy_trim,at_sap,bt_sap,dbt_sap_dd) - call bagw_allom(d,ipft,bt_agw,dbt_agw_dd) + call bsap_allom(d,ipft,crowndamage, branch_frac, canopy_trim,at_sap,bt_sap,dbt_sap_dd) + call bagw_allom(d,ipft,crowndamage, branch_frac, bt_agw,dbt_agw_dd) call bbgw_allom(d,ipft,bt_bgw,dbt_bgw_dd) + call bdead_allom(bt_agw,bt_bgw, bt_sap, ipft, bt_dead, dbt_agw_dd, & dbt_bgw_dd, dbt_sap_dd, dbt_dead_dd) @@ -2388,13 +2463,15 @@ subroutine ForceDBH( ipft, canopy_trim, d, h, bdead, bl ) dd = step_frac*(bdead-bt_dead)/dbt_dead_dd d_try = d + dd - call bsap_allom(d_try,ipft,canopy_trim,at_sap,bt_sap,dbt_sap_dd) - call bagw_allom(d_try,ipft,bt_agw,dbt_agw_dd) - call bbgw_allom(d_try,ipft,bt_bgw,dbt_bgw_dd) + call bsap_allom(d_try,ipft,crowndamage, branch_frac, canopy_trim,at_sap,bt_sap,dbt_sap_dd) + call bagw_allom(d_try,ipft,crowndamage, branch_frac, bt_agw,dbt_agw_dd) + call bbgw_allom(d_try,ipft, bt_bgw,dbt_bgw_dd) + + call bdead_allom(bt_agw,bt_bgw, bt_sap, ipft, bt_dead_try, dbt_agw_dd, & dbt_bgw_dd, dbt_sap_dd, dbt_dead_dd_try) - ! Prevent overshooting + ! Prevent overshooting if(bt_dead_try > (bdead+calloc_abs_error)) then step_frac = step_frac*0.5_r8 else @@ -2418,7 +2495,7 @@ subroutine ForceDBH( ipft, canopy_trim, d, h, bdead, bl ) call endrun(msg=errMsg(sourcefile, __LINE__)) end if - call bleaf(d,ipft,canopy_trim,bt_leaf,dbt_leaf_dd) + call bleaf(d,ipft,1,canopy_trim,bt_leaf,dbt_leaf_dd) counter = 0 step_frac = step_frac0 @@ -2427,7 +2504,7 @@ subroutine ForceDBH( ipft, canopy_trim, d, h, bdead, bl ) dd = step_frac*(bl-bt_leaf)/dbt_leaf_dd d_try = d + dd - call bleaf(d_try,ipft,canopy_trim,bt_leaf_try,dbt_leaf_dd_try) + call bleaf(d_try,ipft,1,canopy_trim,bt_leaf_try,dbt_leaf_dd_try) ! Prevent overshooting if(bt_leaf_try > (bl+calloc_abs_error)) then @@ -2498,4 +2575,6 @@ subroutine cspline(x1,x2,y1,y2,dydx1,dydx2,x,y,dydx) return end subroutine cspline + + end module FatesAllometryMod diff --git a/biogeochem/FatesSoilBGCFluxMod.F90 b/biogeochem/FatesSoilBGCFluxMod.F90 index 9f210e8404..24cd1c2baf 100644 --- a/biogeochem/FatesSoilBGCFluxMod.F90 +++ b/biogeochem/FatesSoilBGCFluxMod.F90 @@ -1183,7 +1183,6 @@ function ECACScalar(ccohort, element_id) result(c_scalar) integer, parameter :: downreg_CN_logi = 3 integer, parameter :: downreg_type = downreg_linear - real(r8), parameter :: logi_k = 25.0_r8 ! logistic function k real(r8), parameter :: store_x0 = 1.0_r8 ! storage fraction inflection point @@ -1226,7 +1225,7 @@ function ECACScalar(ccohort, element_id) result(c_scalar) else store_c = ccohort%prt%GetState(store_organ, carbon12_element) - call bstore_allom(ccohort%dbh,ccohort%pft,ccohort%canopy_trim,store_c_max) + call bstore_allom(ccohort%dbh,ccohort%pft,ccohort%crowndamage, ccohort%canopy_trim,store_c_max) ! Fraction of N per fraction of C ! If this is greater than 1, then we have more N in storage than diff --git a/biogeophys/FatesPlantHydraulicsMod.F90 b/biogeophys/FatesPlantHydraulicsMod.F90 index 98aaad6488..c4c1dff76a 100644 --- a/biogeophys/FatesPlantHydraulicsMod.F90 +++ b/biogeophys/FatesPlantHydraulicsMod.F90 @@ -880,7 +880,8 @@ subroutine UpdatePlantHydrLenVol(ccohort,site_hydr) ! Get the target, or rather, maximum leaf carrying capacity of plant ! Lets also avoid super-low targets that have very low trimming functions - call bleaf(ccohort%dbh,ccohort%pft,max(ccohort%canopy_trim,min_trim),leaf_c_target) + call bleaf(ccohort%dbh,ccohort%pft,ccohort%crowndamage, & + max(ccohort%canopy_trim,min_trim),leaf_c_target) if( (ccohort%status_coh == leaves_on) .or. ccohort_hydr%is_newly_recruited ) then ccohort_hydr%v_ag(1:n_hypool_leaf) = max(leaf_c,min_leaf_frac*leaf_c_target) * & @@ -895,7 +896,8 @@ subroutine UpdatePlantHydrLenVol(ccohort,site_hydr) ! v_stem = c_stem_biom / (prt_params%wood_density(ft) * kg_per_g * cm3_per_m3 ) ! calculate the sapwood cross-sectional area - call bsap_allom(ccohort%dbh,ccohort%pft,ccohort%canopy_trim,a_sapwood_target,sapw_c_target) + call bsap_allom(ccohort%dbh,ccohort%pft,ccohort%crowndamage, ccohort%branch_frac, & + ccohort%canopy_trim,a_sapwood_target,sapw_c_target) ! uncomment this if you want to use ! the actual sapwood, which may be lower than target due to branchfall. @@ -2770,7 +2772,8 @@ subroutine UpdatePlantKmax(ccohort_hydr,ccohort,csite_hydr) pft = ccohort%pft ! Get the cross-section of the plant's sapwood area [m2] - call bsap_allom(ccohort%dbh,pft,ccohort%canopy_trim,a_sapwood,c_sap_dummy) + call bsap_allom(ccohort%dbh,pft,ccohort%crowndamage,ccohort%branch_frac, & + ccohort%canopy_trim,a_sapwood,c_sap_dummy) ! Leaf Maximum Hydraulic Conductance ! The starting hypothesis is that there is no resistance inside the diff --git a/biogeophys/FatesPlantRespPhotosynthMod.F90 b/biogeophys/FatesPlantRespPhotosynthMod.F90 index 4ff827443b..c5d96585f9 100644 --- a/biogeophys/FatesPlantRespPhotosynthMod.F90 +++ b/biogeophys/FatesPlantRespPhotosynthMod.F90 @@ -111,6 +111,11 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) use FatesAllometryMod, only : set_root_fraction use FatesAllometryMod, only : decay_coeff_kn + use DamageMainMod, only : get_crown_reduction + + use FatesInterfaceTypesMod, only : hlm_use_canopy_damage + use FatesInterfaceTypesMod, only : hlm_use_understory_damage + ! ARGUMENTS: ! ----------------------------------------------------------------------------------- integer,intent(in) :: nsites @@ -216,6 +221,13 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) real(r8), allocatable :: rootfr_ft(:,:) ! Root fractions per depth and PFT + real(r8) :: branch_frac + real(r8) :: agb_frac + real(r8) :: crown_reduction + real(r8) :: sapw_c_predamage + real(r8) :: sapw_n + real(r8) :: sapw_n_predamage + ! ----------------------------------------------------------------------------------- ! Keeping these two definitions in case they need to be added later ! @@ -362,7 +374,8 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) ft = currentCohort%pft cl = currentCohort%canopy_layer - call bleaf(currentCohort%dbh,currentCohort%pft,currentCohort%canopy_trim,store_c_target) + call bleaf(currentCohort%dbh,currentCohort%pft,& + currentCohort%crowndamage,currentCohort%canopy_trim,store_c_target) ! call bstore_allom(currentCohort%dbh,currentCohort%pft, & ! currentCohort%canopy_trim,store_c_target) @@ -607,7 +620,19 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) sapw_c = currentCohort%prt%GetState(sapw_organ, all_carbon_elements) fnrt_c = currentCohort%prt%GetState(fnrt_organ, all_carbon_elements) + + if (hlm_use_canopy_damage .eq. itrue .or. hlm_use_understory_damage .eq. itrue) then + + agb_frac = prt_params%allom_agb_frac(currentCohort%pft) + branch_frac = currentCohort%branch_frac + call get_crown_reduction(currentCohort%crowndamage, crown_reduction) + ! need the undamaged version if using ratios with roots + sapw_c = sapw_c / & + (1.0_r8 - (agb_frac * branch_frac * (1.0_r8-crown_reduction))) + end if + + select case(hlm_parteh_mode) case (prt_carbon_allom_hyp) @@ -617,7 +642,7 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) live_croot_n = (1.0_r8-prt_params%allom_agb_frac(currentCohort%pft)) * & sapw_c * prt_params%nitr_stoich_p1(ft,prt_params%organ_param_id(sapw_organ)) - fnrt_n = fnrt_c * prt_params%nitr_stoich_p1(ft,prt_params%organ_param_id(fnrt_organ)) + fnrt_n = fnrt_c * prt_params%nitr_stoich_p1(ft,prt_params%organ_param_id(fnrt_organ)) case(prt_cnp_flex_allom_hyp) @@ -633,10 +658,10 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) ! use the stoichiometry parameter ! ! live_stem_n = prt_params%allom_agb_frac(currentCohort%pft) * & - ! sapw_c * prt_params%nitr_stoich_p1(ft,prt_params%organ_param_id(sapw_organ)) + ! sapw_c * prt_params%nitr_stoich_p1(ft,prt_params%organ_param_id(sapw_organ)) ! live_croot_n = (1.0_r8-prt_params%allom_agb_frac(currentCohort%pft)) * & - ! sapw_c * prt_params%nitr_stoich_p1(ft,prt_params%organ_param_id(sapw_organ)) - ! fnrt_n = fnrt_c * prt_params%nitr_stoich_p1(ft,prt_params%organ_param_id(fnrt_organ)) + ! sapw_c * prt_params%nitr_stoich_p1(ft,prt_params%organ_param_id(sapw_organ)) + ! fnrt_n = fnrt_c * prt_params%nitr_stoich_p1(ft,prt_params%organ_param_id(fnrt_organ)) case default diff --git a/functional_unit_testing/parteh/f90src/FatesCohortWrapMod.F90 b/functional_unit_testing/parteh/f90src/FatesCohortWrapMod.F90 index 75575d3df9..6238111e30 100644 --- a/functional_unit_testing/parteh/f90src/FatesCohortWrapMod.F90 +++ b/functional_unit_testing/parteh/f90src/FatesCohortWrapMod.F90 @@ -230,7 +230,7 @@ subroutine CohortPySet(ipft,hgt_min,canopy_trim) ! Use allometry to compute initial values ! Leaf biomass (carbon) - call bleaf(ccohort%dbh, ipft, canopy_trim, leaf_c) + call bleaf(ccohort%dbh, ipft,canopy_trim, leaf_c) ! Fine-root biomass (carbon) call bfineroot(ccohort%dbh, ipft, canopy_trim, fnrt_c) @@ -431,7 +431,7 @@ end subroutine WrapDailyPRT ! ===================================================================================== - subroutine WrapQueryVars(ipft,leaf_area,crown_area,agb,store_c,target_leaf_c) + subroutine WrapQueryVars(ipft,crowndamage, leaf_area,crown_area,agb,store_c,target_leaf_c) implicit none ! Arguments @@ -444,12 +444,13 @@ subroutine WrapQueryVars(ipft,leaf_area,crown_area,agb,store_c,target_leaf_c) real(r8) :: leaf_c type(ed_cohort_type), pointer :: ccohort - + real(r8),parameter :: nplant = 1.0_r8 real(r8),parameter :: site_spread = 1.0_r8 real(r8), dimension(nclmax) :: canopy_lai integer, parameter :: cl1 = 1 + ccohort => cohort_array(ipft) @@ -466,18 +467,19 @@ subroutine WrapQueryVars(ipft,leaf_area,crown_area,agb,store_c,target_leaf_c) leaf_c = ccohort%prt%GetState(leaf_organ, carbon12_element ) store_c = ccohort%prt%GetState(store_organ, carbon12_element ) - call carea_allom(ccohort%dbh,nplant,site_spread,ipft,crown_area) + call carea_allom(ccohort%dbh,nplant,site_spread,ipft,ccohort%crowndamage,crown_area) leaf_area = crown_area*tree_lai(leaf_c, ipft, crown_area, nplant, cl1, canopy_lai,ccohort%vcmax25top) - call bagw_allom(ccohort%dbh,ipft,agb) + call bagw_allom(ccohort%dbh,ipft, agb) call bleaf(ccohort%dbh,ipft, ccohort%canopy_trim, target_leaf_c) return end subroutine WrapQueryVars - + + ! ========================================================================================== subroutine WrapQueryDiagnostics(ipft, dbh, & leaf_c, fnrt_c, sapw_c, store_c, struct_c, repro_c, & diff --git a/main/DamageMainMod.F90 b/main/DamageMainMod.F90 new file mode 100644 index 0000000000..7dbe385cbf --- /dev/null +++ b/main/DamageMainMod.F90 @@ -0,0 +1,161 @@ +module DamageMainMod + + use FatesConstantsMod , only : r8 => fates_r8 + use FatesConstantsMod , only : i4 => fates_int + use FatesConstantsMod , only : itrue, ifalse + use FatesConstantsMod , only : years_per_day + use FatesGlobals , only : fates_log + + use EDPftvarcon , only : EDPftvarcon_inst + + use EDtypesMod , only : ed_site_type + use EDtypesMod , only : ed_patch_type + use EDtypesMod , only : ed_cohort_type + use EDtypesMod , only : AREA + + use PRTGenericMod, only : leaf_organ + use PRTGenericMod, only : carbon12_element + use PRTGenericMod, only : all_carbon_elements + use PRTGenericMod, only : leaf_organ + use PRTGenericMod, only : fnrt_organ + use PRTGenericMod, only : sapw_organ + use PRTGenericMod, only : store_organ + use PRTGenericMod, only : repro_organ + use PRTGenericMod, only : struct_organ + use PRTGenericMod, only : SetState + + implicit none + private + + logical, protected :: damage_time ! if true then damage occurs during current time step + + public :: get_crown_reduction + public :: get_damage_frac + public :: is_it_damage_time + public :: damage_time + public :: get_damage_mortality + + logical :: debug = .false. ! for debugging + + ! ============================================================================ + ! ============================================================================ + +contains + + + subroutine is_it_damage_time(is_master, currentSite) + + !---------------------------------------------------------------------------- + ! This subroutine determines whether damage should occur (it is called daily) + !----------------------------------------------------------------------------- + + use FatesInterfaceTypesMod , only : hlm_day_of_year + + integer, intent(in) :: is_master + type(ed_site_type), intent(inout), target :: currentSite + + + damage_time = .false. + + if (hlm_day_of_year .eq. 1) then + damage_time = .true. + end if + + end subroutine is_it_damage_time + + !---------------------------------------------------------------------------- + + subroutine get_damage_frac(cc_cd, nc_cd, pft, dist_frac) + + + ! given current cohort damage class find the fraction of individuals + ! going to the new damage class. + ! Consults a look up table of transitions from param derived. + + ! USES + use FatesInterfaceTypesMod, only : ncrowndamage + use FatesConstantsMod, only : years_per_day + use FatesParameterDerivedMod, only : param_derived + + + ! ARGUMENTS + integer, intent(in) :: cc_cd ! current cohort crown damage + integer, intent(in) :: nc_cd ! new cohort crown damage + integer, intent(in) :: pft + real(r8), intent(out) :: dist_frac ! probability of current cohort moving to new damage level + + dist_frac = param_derived%damage_transitions(cc_cd, nc_cd, pft) !* years_per_day (if damage is occuring annually don't do this) + + + end subroutine get_damage_frac + + !------------------------------------------------------- + + subroutine get_crown_reduction(crowndamage, crown_reduction) + + !------------------------------------------------------------------ + ! This function takes the crown damage class of a cohort (integer) + ! and returns the fraction of the crown that is lost + ! Since crowndamage class = 1 means no damage, we subtract one + ! before multiplying by 0.2 + ! Therefore, first damage class is 20% loss of crown, second 40% etc. + !------------------------------------------------------------------- + use FatesInterfaceTypesMod , only : ncrowndamage + + integer(i4), intent(in) :: crowndamage + real(r8), intent(out) :: crown_reduction + + ! local variables + real(r8) :: class_width + + class_width = 1.0_r8/ncrowndamage + crown_reduction = min(1.0_r8, (real(crowndamage) - 1.0_r8) * class_width) + + return + end subroutine get_crown_reduction + + + !---------------------------------------------------------------------------------------- + + + subroutine get_damage_mortality(crowndamage,pft, dgmort) + + use FatesInterfaceTypesMod , only : ncrowndamage + use EDPftvarcon , only : EDPftvarcon_inst + + integer(i4), intent(in) :: crowndamage + integer(i4), intent(in) :: pft + real(r8), intent(out) :: dgmort + + ! local variables + real(r8) :: damage_mort_p1 + real(r8) :: damage_mort_p2 + real(r8) :: class_width + real(r8) :: crown_loss + + class_width = 1.0_r8/real(ncrowndamage) + + ! parameter to determine slope of exponential + damage_mort_p1 = EDPftvarcon_inst%damage_mort_p1(pft) + damage_mort_p2 = EDPftvarcon_inst%damage_mort_p2(pft) + + ! make damage mortality a function of crownloss and not crowndamage + ! class so that it doesn't need to be re-parameterised if the number + ! of damage classes change. + crown_loss = min(1.0_r8, (real(crowndamage) - 1.0_r8) * class_width) + + if (crowndamage .eq. 1 ) then + dgmort = 0.0_r8 + else + dgmort = 1.0_r8 / (1.0_r8 + exp(-1.0_r8 * damage_mort_p2 * & + (crown_loss - damage_mort_p1) ) ) + + end if + + return + end subroutine get_damage_mortality + !---------------------------------------------------------------------------------------- + + +end module DamageMainMod + diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index c3b503a729..22b7a6e0c3 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -43,11 +43,14 @@ module EDInitMod use FatesInterfaceTypesMod , only : hlm_use_planthydro use FatesInterfaceTypesMod , only : hlm_use_inventory_init use FatesInterfaceTypesMod , only : hlm_use_fixed_biogeog + use FatesInterfaceTypesMod , only : hlm_use_canopy_damage + use FatesInterfaceTypesMod , only : hlm_use_understory_damage use FatesInterfaceTypesMod , only : hlm_use_sp use FatesInterfaceTypesMod , only : numpft use FatesInterfaceTypesMod , only : nleafage use FatesInterfaceTypesMod , only : nlevsclass use FatesInterfaceTypesMod , only : nlevcoage + use FatesInterfaceTypesMod , only : ncrowndamage use FatesInterfaceTypesMod , only : hlm_use_nocomp use FatesInterfaceTypesMod , only : nlevage @@ -127,6 +130,39 @@ subroutine init_site_vars( site_in, bc_in, bc_out ) allocate(site_in%mass_balance(1:num_elements)) allocate(site_in%flux_diags(1:num_elements)) + if (hlm_use_canopy_damage .eq. itrue .or. hlm_use_understory_damage .eq. itrue) then + allocate(site_in%damage_cflux(1:ncrowndamage, 1:ncrowndamage+1)) + allocate(site_in%damage_rate(1:ncrowndamage, 1:ncrowndamage+1)) + allocate(site_in%recovery_cflux(1:ncrowndamage, 1:ncrowndamage+1)) + allocate(site_in%recovery_rate(1:ncrowndamage, 1:ncrowndamage+1)) + allocate(site_in%term_nindivs_canopy_damage(1:ncrowndamage, 1:nlevsclass, 1:numpft)) + allocate(site_in%term_nindivs_ustory_damage(1:ncrowndamage, 1:nlevsclass, 1:numpft)) + allocate(site_in%imort_rate_damage(1:ncrowndamage, 1:nlevsclass, 1:numpft)) + allocate(site_in%imort_cflux_damage(1:ncrowndamage, 1:nlevsclass)) + allocate(site_in%term_cflux_canopy_damage(1:ncrowndamage, 1:nlevsclass)) + allocate(site_in%term_cflux_ustory_damage(1:ncrowndamage, 1:nlevsclass)) + allocate(site_in%fmort_rate_canopy_damage(1:ncrowndamage, 1:nlevsclass, 1:numpft)) + allocate(site_in%fmort_rate_ustory_damage(1:ncrowndamage, 1:nlevsclass, 1:numpft)) + allocate(site_in%fmort_cflux_canopy_damage(1:ncrowndamage, 1:nlevsclass)) + allocate(site_in%fmort_cflux_ustory_damage(1:ncrowndamage, 1:nlevsclass)) + else + allocate(site_in%damage_cflux(1, 1)) + allocate(site_in%damage_rate(1, 1)) + allocate(site_in%recovery_cflux(1, 1)) + allocate(site_in%recovery_rate(1, 1)) + allocate(site_in%term_nindivs_canopy_damage(1,1,1)) + allocate(site_in%term_nindivs_ustory_damage(1,1,1)) + allocate(site_in%imort_rate_damage(1,1,1)) + allocate(site_in%imort_cflux_damage(1,1)) + allocate(site_in%term_cflux_canopy_damage(1,1)) + allocate(site_in%term_cflux_ustory_damage(1,1)) + allocate(site_in%fmort_rate_canopy_damage(1,1,1)) + allocate(site_in%fmort_rate_ustory_damage(1,1,1)) + allocate(site_in%fmort_cflux_canopy_damage(1,1)) + allocate(site_in%fmort_cflux_ustory_damage(1,1)) + end if + + site_in%nlevsoil = bc_in%nlevsoil allocate(site_in%rootfrac_scr(site_in%nlevsoil)) allocate(site_in%zi_soil(0:site_in%nlevsoil)) @@ -198,8 +234,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. - - ! FIRE + + ! FIRE site_in%acc_ni = 0.0_r8 ! daily nesterov index accumulating over time. time unlimited theoretically. site_in%NF = 0.0_r8 ! daily lightning strikes per km2 site_in%NF_successful = 0.0_r8 ! daily successful iginitions per km2 @@ -217,13 +253,18 @@ subroutine zero_site( site_in ) site_in%term_nindivs_ustory(:,:) = 0._r8 site_in%term_carbonflux_canopy = 0._r8 site_in%term_carbonflux_ustory = 0._r8 + site_in%term_crownarea_canopy = 0._r8 + site_in%term_crownarea_ustory = 0._r8 site_in%recruitment_rate(:) = 0._r8 site_in%imort_rate(:,:) = 0._r8 site_in%imort_carbonflux = 0._r8 + site_in%imort_crownarea = 0._r8 site_in%fmort_rate_canopy(:,:) = 0._r8 site_in%fmort_rate_ustory(:,:) = 0._r8 site_in%fmort_carbonflux_canopy = 0._r8 site_in%fmort_carbonflux_ustory = 0._r8 + site_in%fmort_crownarea_canopy = 0._r8 + site_in%fmort_crownarea_ustory = 0._r8 site_in%fmort_rate_cambial(:,:) = 0._r8 site_in%fmort_rate_crown(:,:) = 0._r8 @@ -236,6 +277,24 @@ subroutine zero_site( site_in ) site_in%promotion_rate(:) = 0._r8 site_in%promotion_carbonflux = 0._r8 + ! damage transition info + site_in%damage_cflux(:,:) = 0._r8 + site_in%damage_rate(:,:) = 0._r8 + site_in%recovery_cflux(:,:) = 0._r8 + site_in%recovery_rate(:,:) = 0._r8 + site_in%imort_rate_damage(:,:,:) = 0._r8 + site_in%term_nindivs_canopy_damage(:,:,:) = 0._r8 + site_in%term_nindivs_ustory_damage(:,:,:) = 0._r8 + site_in%imort_cflux_damage(:,:) = 0._r8 + site_in%term_cflux_canopy_damage(:,:) = 0._r8 + site_in%term_cflux_ustory_damage(:,:) = 0._r8 + site_in%crownarea_canopy_damage = 0._r8 + site_in%crownarea_ustory_damage = 0._r8 + site_in%fmort_rate_canopy_damage(:,:,:) = 0._r8 + site_in%fmort_rate_ustory_damage(:,:,:) = 0._r8 + site_in%fmort_cflux_canopy_damage(:,:) = 0._r8 + site_in%fmort_cflux_ustory_damage(:,:) = 0._r8 + ! Resources management (logging/harvesting, etc) site_in%resources_management%trunk_product_site = 0.0_r8 @@ -645,7 +704,7 @@ subroutine init_patches( nsites, sites, bc_in) return end subroutine init_patches - + ! ============================================================================ subroutine init_cohorts( site_in, patch_in, bc_in) ! @@ -653,6 +712,8 @@ subroutine init_cohorts( site_in, patch_in, bc_in) ! initialize new cohorts on bare ground ! ! !USES: + use FatesParameterDerivedMod , only : param_derived + ! ! !ARGUMENTS type(ed_site_type), intent(inout), pointer :: site_in @@ -664,6 +725,8 @@ subroutine init_cohorts( site_in, patch_in, bc_in) class(prt_vartypes),pointer :: prt_obj integer :: cstatus integer :: pft + integer :: crowndamage ! which crown damage class + real :: branch_frac ! fraction of biomass in branches integer :: iage ! index for leaf age loop integer :: el ! index for element loop integer :: element_id ! element index consistent with defs in PRTGeneric @@ -747,17 +810,24 @@ subroutine init_cohorts( site_in, patch_in, bc_in) else temp_cohort%hite = EDPftvarcon_inst%hgt_min(pft) + temp_cohort%branch_frac = param_derived%branch_frac(pft) + + ! Assume no damage to begin with - since we assume no damage + ! we do not need to initialise branch frac just yet. + temp_cohort%crowndamage = 1 ! Calculate the plant diameter from height call h2d_allom(temp_cohort%hite,pft,temp_cohort%dbh) ! Calculate the leaf biomass from allometry ! (calculates a maximum first, then applies canopy trim) - call bleaf(temp_cohort%dbh,pft,temp_cohort%canopy_trim,c_leaf) + call bleaf(temp_cohort%dbh,pft,temp_cohort%crowndamage, & + temp_cohort%canopy_trim,c_leaf) end if ! sp mode ! Calculate total above-ground biomass from allometry - call bagw_allom(temp_cohort%dbh,pft,c_agw) + call bagw_allom(temp_cohort%dbh,pft,temp_cohort%crowndamage, & + 1.0_r8, c_agw) ! Calculate coarse root biomass from allometry call bbgw_allom(temp_cohort%dbh,pft,c_bgw) @@ -767,11 +837,13 @@ subroutine init_cohorts( site_in, patch_in, bc_in) call bfineroot(temp_cohort%dbh,pft,temp_cohort%canopy_trim,c_fnrt) ! Calculate sapwood biomass - call bsap_allom(temp_cohort%dbh,pft,temp_cohort%canopy_trim,a_sapw,c_sapw) + call bsap_allom(temp_cohort%dbh,pft,temp_cohort%crowndamage, 1.0_r8, & + temp_cohort%canopy_trim,a_sapw,c_sapw) call bdead_allom( c_agw, c_bgw, c_sapw, pft, c_struct ) - call bstore_allom(temp_cohort%dbh, pft, temp_cohort%canopy_trim, c_store) + call bstore_allom(temp_cohort%dbh, pft, temp_cohort%crowndamage, & + temp_cohort%canopy_trim, c_store) temp_cohort%laimemory = 0._r8 temp_cohort%sapwmemory = 0._r8 @@ -878,10 +950,11 @@ subroutine init_cohorts( site_in, patch_in, bc_in) call prt_obj%CheckInitialConditions() - call create_cohort(site_in, patch_in, pft, temp_cohort%n, temp_cohort%hite, & - temp_cohort%coage, temp_cohort%dbh, prt_obj, temp_cohort%laimemory, & - temp_cohort%sapwmemory, temp_cohort%structmemory, cstatus, rstatus, & - temp_cohort%canopy_trim, temp_cohort%c_area,1, site_in%spread, bc_in) + call create_cohort(site_in, patch_in, pft, temp_cohort%n, temp_cohort%hite, & + temp_cohort%coage, temp_cohort%dbh, prt_obj, temp_cohort%laimemory,& + temp_cohort%sapwmemory, temp_cohort%structmemory, cstatus, rstatus, & + temp_cohort%canopy_trim, temp_cohort%c_area, 1, temp_cohort%crowndamage,& + temp_cohort%branch_frac, site_in%spread, bc_in) deallocate(temp_cohort) ! get rid of temporary cohort diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index 48820e5ad6..83c1cf7e58 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -19,6 +19,8 @@ module EDMainMod use FatesInterfaceTypesMod , only : hlm_use_cohort_age_tracking use FatesInterfaceTypesMod , only : hlm_reference_date use FatesInterfaceTypesMod , only : hlm_use_ed_prescribed_phys + use FatesInterfaceTypesMod , only : hlm_use_canopy_damage + use FatesInterfaceTypesMod , only : hlm_use_understory_damage use FatesInterfaceTypesMod , only : hlm_use_ed_st3 use FatesInterfaceTypesMod , only : hlm_use_sp use FatesInterfaceTypesMod , only : bc_in_type @@ -79,6 +81,7 @@ module EDMainMod use FatesAllometryMod , only : h_allom,tree_sai,tree_lai use FatesPlantHydraulicsMod , only : UpdateSizeDepRhizHydStates use EDLoggingMortalityMod , only : IsItLoggingTime + use DamageMainMod , only : is_it_damage_time use EDPatchDynamicsMod , only : get_frac_site_primary use FatesGlobals , only : endrun => fates_endrun use ChecksBalancesMod , only : SiteMassStock @@ -143,11 +146,12 @@ subroutine ed_ecosystem_dynamics(currentSite, bc_in, bc_out) ! ! !LOCAL VARIABLES: type(ed_patch_type), pointer :: currentPatch - integer :: el ! Loop counter for elements + integer :: el ! Loop counter for variables integer :: do_patch_dynamics ! for some modes, we turn off patch dynamics - + !----------------------------------------------------------------------- + if ( hlm_masterproc==itrue ) write(fates_log(),'(A,I4,A,I2.2,A,I2.2)') 'FATES Dynamics: ',& hlm_current_year,'-',hlm_current_month,'-',hlm_current_day @@ -163,6 +167,11 @@ subroutine ed_ecosystem_dynamics(currentSite, bc_in, bc_out) ! This is limited to a global event until more structured event handling is enabled call IsItLoggingTime(hlm_masterproc,currentSite) + ! Call a routine that identifies if damage should occur + if(hlm_use_canopy_damage .eq. itrue .or. hlm_use_understory_damage .eq. itrue) then + call is_it_damage_time(hlm_masterproc, currentSite) + end if + !************************************************************************** ! Fire, growth, biogeochemistry. !************************************************************************** @@ -292,7 +301,7 @@ subroutine ed_ecosystem_dynamics(currentSite, bc_in, bc_out) end if call TotalBalanceCheck(currentSite,5) - + end subroutine ed_ecosystem_dynamics !-------------------------------------------------------------------------------! @@ -303,8 +312,30 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) ! FIX(SPM,032414) refactor so everything goes through interface ! ! !USES: + use FatesInterfaceTypesMod, only : ncrowndamage + use FatesAllometryMod , only : bleaf + use FatesAllometryMod , only : carea_allom + use PRTGenericMod , only : leaf_organ + use PRTGenericMod , only : repro_organ + use PRTGenericMod , only : sapw_organ + use PRTGenericMod , only : struct_organ + use PRTGenericMod , only : store_organ + use PRTGenericMod , only : fnrt_organ use FatesInterfaceTypesMod, only : hlm_use_cohort_age_tracking use FatesConstantsMod, only : itrue + use PRTGenericMod , only : all_carbon_elements + use DamageMainMod , only : damage_time + use EDCohortDynamicsMod , only : zero_cohort, copy_cohort, insert_cohort + use EDCohortDynamicsMod , only : DeallocateCohort + use FatesPlantHydraulicsMod, only : InitHydrCohort + use EDCohortDynamicsMod , only : InitPRTObject + use EDCohortDynamicsMod , only : InitPRTBoundaryConditions + use FatesConstantsMod , only : nearzero + use EDCanopyStructureMod , only : canopy_structure + use PRTLossFluxesMod , only : PRTDamageRecoveryFluxes + use PRTGenericMod , only : max_nleafage + use PRTGenericMod , only : prt_global + ! !ARGUMENTS: type(ed_site_type) , intent(inout) :: currentSite @@ -316,6 +347,12 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) type(site_massbal_type), pointer :: site_cmass type(ed_patch_type) , pointer :: currentPatch type(ed_cohort_type) , pointer :: currentCohort + type(ed_cohort_type) , pointer :: nc + type(ed_cohort_type) , pointer :: storesmallcohort + type(ed_cohort_type) , pointer :: storebigcohort + + integer :: snull + integer :: tnull integer :: c ! Counter for litter size class integer :: ft ! Counter for PFT @@ -328,12 +365,45 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) logical :: is_drought ! logical for if the plant (site) is in a drought state real(r8) :: delta_dbh ! correction for dbh real(r8) :: delta_hite ! correction for hite - real(r8) :: current_npp ! place holder for calculating npp each year in prescribed physiology mode - !----------------------------------------------------------------------- + + real(r8) :: target_leaf_c real(r8) :: frac_site_primary + real(r8) :: n_old + real(r8) :: n_recover + integer :: nleafage + real(r8) :: sapw_c + real(r8) :: leaf_c + real(r8) :: fnrt_c + real(r8) :: struct_c + real(r8) :: repro_c + real(r8) :: total_c + real(r8) :: store_c + + real(r8) :: cc_leaf_c + real(r8) :: cc_fnrt_c + real(r8) :: cc_struct_c + real(r8) :: cc_repro_c + real(r8) :: cc_store_c + real(r8) :: cc_sapw_c + + real(r8) :: sapw_c0 + real(r8) :: leaf_c0 + real(r8) :: fnrt_c0 + real(r8) :: struct_c0 + real(r8) :: repro_c0 + real(r8) :: store_c0 + real(r8) :: total_c0 + real(r8) :: nc_carbon + real(r8) :: cc_carbon + + integer,parameter :: leaf_c_id = 1 + + !----------------------------------------------------------------------- + nleafage = prt_global%state_descriptor(leaf_c_id)%num_pos + call get_frac_site_primary(currentSite, frac_site_primary) ! Set a pointer to this sites carbon12 mass balance @@ -360,13 +430,13 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) ! check to see if the patch has moved to the next age class currentPatch%age_class = get_age_class_index(currentPatch%age) + ! Update Canopy Biomass Pools currentCohort => currentPatch%shortest do while(associated(currentCohort)) - ft = currentCohort%pft - + ! Calculate the mortality derivatives call Mortality_Derivative( currentSite, currentCohort, bc_in, frac_site_primary ) @@ -420,6 +490,7 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) else is_drought = .true. end if + call PRTMaintTurnover(currentCohort%prt,ft,is_drought) ! If the current diameter of a plant is somehow less than what is consistent @@ -435,9 +506,124 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) ! Growth and Allocation (PARTEH) ! ----------------------------------------------------------------------------- + ! cohorts will be split during this phase to allow some fraction to recover + ! keep track of starting population + n_old = currentCohort%n + + ! track initial carbon pools + + leaf_c0 = currentCohort%prt%GetState(leaf_organ, all_carbon_elements) + fnrt_c0 = currentCohort%prt%GetState(fnrt_organ, all_carbon_elements) + sapw_c0 = currentCohort%prt%GetState(sapw_organ, all_carbon_elements) + struct_c0 = currentCohort%prt%GetState(struct_organ, all_carbon_elements) + store_c0 = currentCohort%prt%GetState(store_organ, all_carbon_elements) + repro_c0 = currentCohort%prt%GetState(repro_organ, all_carbon_elements) + + total_c0 = sapw_c0 + struct_c0 + leaf_c0 + fnrt_c0 + store_c0 + repro_c0 + cc_carbon = 0.0_r8 ! need to set it here to avoid nan errors if conditions aren't met below + call currentCohort%prt%DailyPRT() - + + if(hlm_use_canopy_damage .eq. itrue .or. hlm_use_understory_damage .eq. itrue) then + + if(currentCohort%crowndamage > 1) then + + ! N is inout boundary condition so has now been updated. The difference must + ! go to a new cohort + n_recover = n_old - currentCohort%n + + if(n_recover > nearzero) then + + 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) + ! call zero_cohort(nc) + call copy_cohort(currentCohort, nc) + + nc%n = n_recover + nc%crowndamage = currentCohort%crowndamage - 1 + + ! Need to adjust the crown area which is NOT on a per individual basis + nc%c_area = nc%n/n_old * currentCohort%c_area + currentCohort%c_area = currentCohort%c_area - nc%c_area + + ! This new cohort spends carbon balance on growing out pools + ! (but not dbh) to reach new allometric targets + ! This was already calculated within parteh - this cohort should just + ! be able to hit allometric targets of one damage class down + call nc%prt%DamageRecovery() + + ! at this point we need to update fluxes or this cohort will + ! fail its mass conservation checks + + sapw_c = nc%prt%GetState(sapw_organ, all_carbon_elements) + struct_c = nc%prt%GetState(struct_organ, all_carbon_elements) + leaf_c = nc%prt%GetState(leaf_organ, all_carbon_elements) + fnrt_c = nc%prt%GetState(fnrt_organ, all_carbon_elements) + store_c = nc%prt%GetState(store_organ, all_carbon_elements) + repro_c = nc%prt%GetState(repro_organ, all_carbon_elements) + nc_carbon = sapw_c + struct_c + leaf_c + fnrt_c + store_c + repro_c + + cc_sapw_c = currentCohort%prt%GetState(sapw_organ, all_carbon_elements) + cc_struct_c = currentCohort%prt%GetState(struct_organ, all_carbon_elements) + cc_leaf_c = currentCohort%prt%GetState(leaf_organ, all_carbon_elements) + cc_fnrt_c = currentCohort%prt%GetState(fnrt_organ, all_carbon_elements) + cc_store_c = currentCohort%prt%GetState(store_organ, all_carbon_elements) + cc_repro_c = currentCohort%prt%GetState(repro_organ, all_carbon_elements) + cc_carbon = cc_sapw_c + cc_struct_c + cc_leaf_c + cc_fnrt_c + cc_store_c + cc_repro_c + + + call PRTDamageRecoveryFluxes(nc%prt, leaf_organ, leaf_c0, leaf_c, cc_leaf_c) + call PRTDamageRecoveryFluxes(nc%prt, repro_organ, repro_c0, repro_c, cc_repro_c) + call PRTDamageRecoveryFluxes(nc%prt, sapw_organ, sapw_c0, sapw_c, cc_sapw_c) + call PRTDamageRecoveryFluxes(nc%prt, struct_organ, struct_c0, struct_c, cc_struct_c) + call PRTDamageRecoveryFluxes(nc%prt, store_organ, store_c0, store_c, cc_store_c) + call PRTDamageRecoveryFluxes(nc%prt, fnrt_organ, fnrt_c0, fnrt_c, cc_fnrt_c) + + ! update crown area + call carea_allom(nc%dbh, nc%n, currentSite%spread, nc%pft, nc%crowndamage, nc%c_area) + call carea_allom(currentCohort%dbh, currentCohort%n, currentSite%spread, & + currentCohort%pft, currentCohort%crowndamage, currentCohort%c_area) + + + currentSite%recovery_rate(currentCohort%crowndamage, nc%crowndamage) = & + currentSite%recovery_rate(currentCohort%crowndamage, nc%crowndamage) + nc%n + currentSite%recovery_cflux(currentCohort%crowndamage, nc%crowndamage) = & + currentSite%recovery_cflux(currentCohort%crowndamage, nc%crowndamage) + & + nc%n * nc_carbon + + !----------- Insert copy into linked list ----------------------! + nc%shorter => currentCohort + if(associated(currentCohort%taller))then + nc%taller => currentCohort%taller + currentCohort%taller%shorter => nc + else + currentPatch%tallest => nc + nc%taller => null() + endif + currentCohort%taller => nc + + end if ! end if greater than nearzero + + end if ! end if crowndamage > 1 + + + ! fill in the diagonals - i.e. those that did not recover + currentSite%recovery_rate(currentCohort%crowndamage, currentCohort%crowndamage) = & + currentSite%recovery_rate(currentCohort%crowndamage, currentCohort%crowndamage) +& + currentCohort%n + currentSite%recovery_cflux(currentCohort%crowndamage, currentCohort%crowndamage) = & + currentSite%recovery_cflux(currentCohort%crowndamage, currentCohort%crowndamage) + & + currentCohort%n * cc_carbon + + end if ! end if crowndamage is on + + ! Update the mass balance tracking for the daily nutrient uptake flux ! Then zero out the daily uptakes, they have been used ! ----------------------------------------------------------------------------- @@ -567,15 +753,16 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) currentCohort%coage_class,currentCohort%coage_by_pft_class) end if - + currentCohort => currentCohort%taller - end do + + + end do currentPatch => currentPatch%older end do - - ! When plants die, the water goes with them. This effects + ! When plants die, the water goes with them. This effects ! the water balance. if( hlm_use_planthydro == itrue ) then @@ -682,9 +869,8 @@ subroutine ed_update_site( currentSite, bc_in, bc_out ) ! This cohort count is used in the photosynthesis loop call count_cohorts(currentPatch) - currentPatch => currentPatch%younger - enddo + enddo ! The HLMs need to know about nutrient demand, and/or ! root mass and affinities @@ -931,6 +1117,7 @@ subroutine bypass_dynamics(currentSite) currentCohort%frmort = 0.0_r8 currentCohort%smort = 0.0_r8 currentCohort%asmort = 0.0_r8 + currentCohort%dgmort = 0.0_r8 currentCohort%dndt = 0.0_r8 currentCohort%dhdt = 0.0_r8 diff --git a/main/EDParamsMod.F90 b/main/EDParamsMod.F90 index 1f10aa2c7f..e37190c921 100644 --- a/main/EDParamsMod.F90 +++ b/main/EDParamsMod.F90 @@ -42,6 +42,7 @@ module EDParamsMod real(r8),protected, public :: ED_val_init_litter real(r8),protected, public :: ED_val_nignitions real(r8),protected, public :: ED_val_understorey_death + real(r8),protected, public :: ED_val_ncrowndamage real(r8),protected, public :: ED_val_cwd_fcel real(r8),protected, public :: ED_val_cwd_flig real(r8),protected, public :: ED_val_base_mr_20 @@ -102,6 +103,7 @@ module EDParamsMod character(len=param_string_length),parameter,public :: ED_name_init_litter = "fates_init_litter" character(len=param_string_length),parameter,public :: ED_name_nignitions = "fates_fire_nignitions" character(len=param_string_length),parameter,public :: ED_name_understorey_death = "fates_mort_understorey_death" + character(len=param_string_length),parameter,public :: ED_name_ncrowndamage = 'fates_ncrowndamage' character(len=param_string_length),parameter,public :: ED_name_cwd_fcel= "fates_cwd_fcel" character(len=param_string_length),parameter,public :: ED_name_cwd_flig= "fates_cwd_flig" character(len=param_string_length),parameter,public :: ED_name_base_mr_20= "fates_base_mr_20" @@ -130,8 +132,10 @@ module EDParamsMod character(len=param_string_length),parameter,public :: ED_name_history_sizeclass_bin_edges= "fates_history_sizeclass_bin_edges" character(len=param_string_length),parameter,public :: ED_name_history_ageclass_bin_edges= "fates_history_ageclass_bin_edges" character(len=param_string_length),parameter,public :: ED_name_history_height_bin_edges= "fates_history_height_bin_edges" + character(len=param_string_length),parameter,public :: ED_name_history_coageclass_bin_edges = "fates_history_coageclass_bin_edges" + ! Hydraulics Control Parameters (ONLY RELEVANT WHEN USE_FATES_HYDR = TRUE) ! ---------------------------------------------------------------------------------------------- real(r8),protected,public :: hydr_kmax_rsurf1 ! maximum conducitivity for unit root surface @@ -152,7 +156,8 @@ module EDParamsMod ! ---------------------------------------------------------------------------------------------- real(r8),protected,public :: bgc_soil_salinity ! site-level soil salinity for FATES when not coupled to dynamic soil BGC of salinity character(len=param_string_length),parameter,public :: bgc_name_soil_salinity= "fates_soil_salinity" - + + ! Logging Control Parameters (ONLY RELEVANT WHEN USE_FATES_LOGGING = TRUE) ! ---------------------------------------------------------------------------------------------- @@ -219,6 +224,7 @@ subroutine FatesParamsInit() ED_val_init_litter = nan ED_val_nignitions = nan ED_val_understorey_death = nan + ED_val_ncrowndamage = nan ED_val_cwd_fcel = nan ED_val_cwd_flig = nan ED_val_base_mr_20 = nan @@ -269,7 +275,6 @@ subroutine FatesRegisterParams(fates_params) use FatesParametersInterface, only : dimension_name_history_coage_bins use FatesParametersInterface, only : dimension_shape_scalar - implicit none class(fates_parameters_type), intent(inout) :: fates_params @@ -319,6 +324,9 @@ subroutine FatesRegisterParams(fates_params) call fates_params%RegisterParameter(name=ED_name_understorey_death, dimension_shape=dimension_shape_scalar, & dimension_names=dim_names_scalar) + call fates_params%RegisterParameter(name=ED_name_ncrowndamage, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) + call fates_params%RegisterParameter(name=ED_name_cwd_fcel, dimension_shape=dimension_shape_scalar, & dimension_names=dim_names_scalar) @@ -384,7 +392,7 @@ subroutine FatesRegisterParams(fates_params) call fates_params%RegisterParameter(name=bgc_name_soil_salinity, dimension_shape=dimension_shape_scalar, & dimension_names=dim_names_scalar) - + call fates_params%RegisterParameter(name=logging_name_dbhmin, dimension_shape=dimension_shape_scalar, & dimension_names=dim_names_scalar) @@ -462,7 +470,7 @@ subroutine FatesReceiveParams(fates_params) real(r8) :: tmpreal ! local real variable for changing type on read real(r8), allocatable :: hydr_htftype_real(:) - + call fates_params%RetreiveParameter(name=ED_name_vai_top_bin_width, & data=vai_top_bin_width) @@ -495,6 +503,9 @@ subroutine FatesReceiveParams(fates_params) call fates_params%RetreiveParameter(name=ED_name_understorey_death, & data=ED_val_understorey_death) + call fates_params%RetreiveParameter(name=ED_name_ncrowndamage, & + data=ED_val_ncrowndamage) + call fates_params%RetreiveParameter(name=ED_name_cwd_fcel, & data=ED_val_cwd_fcel) @@ -560,7 +571,7 @@ subroutine FatesReceiveParams(fates_params) data=hydr_psicap) call fates_params%RetreiveParameter(name=bgc_name_soil_salinity, & - data=bgc_soil_salinity) + data=bgc_soil_salinity) call fates_params%RetreiveParameter(name=logging_name_dbhmin, & data=logging_dbhmin) @@ -623,7 +634,7 @@ subroutine FatesReceiveParams(fates_params) call fates_params%RetreiveParameterAllocate(name=ED_name_history_height_bin_edges, & data=ED_val_history_height_bin_edges) - + call fates_params%RetreiveParameterAllocate(name=ED_name_history_coageclass_bin_edges, & data=ED_val_history_coageclass_bin_edges) @@ -657,6 +668,7 @@ subroutine FatesReportParams(is_master) write(fates_log(),fmt0) 'ED_val_init_litter = ',ED_val_init_litter write(fates_log(),fmt0) 'ED_val_nignitions = ',ED_val_nignitions write(fates_log(),fmt0) 'ED_val_understorey_death = ',ED_val_understorey_death + write(fates_log(),fmt0) 'ED_val_ncrowndamage = ', ED_val_ncrowndamage write(fates_log(),fmt0) 'ED_val_cwd_fcel = ',ED_val_cwd_fcel write(fates_log(),fmt0) 'ED_val_cwd_flig = ',ED_val_cwd_flig write(fates_log(),fmt0) 'ED_val_base_mr_20 = ', ED_val_base_mr_20 diff --git a/main/EDPftvarcon.F90 b/main/EDPftvarcon.F90 index 030f15738f..3e932a51ed 100644 --- a/main/EDPftvarcon.F90 +++ b/main/EDPftvarcon.F90 @@ -109,6 +109,12 @@ module EDPftvarcon real(r8), allocatable :: taul(:, :) real(r8), allocatable :: taus(:, :) + + ! Damage parameters + real(r8), allocatable :: damage_frac(:) ! Fraction of each cohort damaged per year + real(r8), allocatable :: damage_mort_p1(:) ! Inflection point for damage mortality function + real(r8), allocatable :: damage_mort_p2(:) ! Rate parameter for damage mortality function + ! Fire Parameters (No PFT vector capabilities in their own routines) ! See fire/SFParamsMod.F90 for bulk of fire parameters ! ------------------------------------------------------------------------------------------- @@ -118,7 +124,6 @@ module EDPftvarcon ! Non-PARTEH Allometry Parameters ! -------------------------------------------------------------------------------------------- - real(r8), allocatable :: allom_frbstor_repro(:) ! fraction of bstrore for reproduction after mortality ! Prescribed Physiology Mode Parameters @@ -296,8 +301,7 @@ subroutine Receive(this, fates_params) call this%Receive_PFT_numrad(fates_params) call this%Receive_PFT_hydr_organs(fates_params) call this%Receive_PFT_leafage(fates_params) - - end subroutine Receive + end subroutine Receive !----------------------------------------------------------------------- subroutine Register_PFT(this, fates_params) @@ -544,6 +548,18 @@ subroutine Register_PFT(this, fates_params) call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) + name = 'fates_damage_frac' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_damage_mort_p1' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_damage_mort_p2' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + name = 'fates_trim_limit' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) @@ -891,6 +907,18 @@ subroutine Receive_PFT(this, fates_params) call fates_params%RetreiveParameterAllocate(name=name, & data=this%seed_decay_rate) + name = 'fates_damage_frac' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%damage_frac) + + name = 'fates_damage_mort_p1' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%damage_mort_p1) + + name = 'fates_damage_mort_p2' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%damage_mort_p2) + name = 'fates_trim_limit' call fates_params%RetreiveParameterAllocate(name=name, & data=this%trim_limit) @@ -1430,6 +1458,9 @@ subroutine FatesReportPFTParams(is_master) write(fates_log(),fmt0) 'jmaxhd = ',EDPftvarcon_inst%jmaxhd write(fates_log(),fmt0) 'vcmaxse = ',EDPftvarcon_inst%vcmaxse write(fates_log(),fmt0) 'jmaxse = ',EDPftvarcon_inst%jmaxse + write(fates_log(),fmt0) 'damage_frac = ',EDPftvarcon_inst%damage_frac + write(fates_log(),fmt0) 'damage_mort_p1 = ',EDPftvarcon_inst%damage_mort_p1 + write(fates_log(),fmt0) 'damage_mort_p2 = ',EDPftvarcon_inst%damage_mort_p2 write(fates_log(),fmt0) 'germination_timescale = ',EDPftvarcon_inst%germination_rate write(fates_log(),fmt0) 'seed_decay_turnover = ',EDPftvarcon_inst%seed_decay_rate write(fates_log(),fmt0) 'trim_limit = ',EDPftvarcon_inst%trim_limit @@ -1507,7 +1538,6 @@ subroutine FatesCheckParams(is_master) if(.not.is_master) return - if (hlm_parteh_mode .eq. prt_cnp_flex_allom_hyp) then ! Check to see if either RD/ECA/MIC is turned on @@ -1733,6 +1763,7 @@ subroutine FatesCheckParams(is_master) end if + ! Check if photosynthetic pathway is neither C3/C4 ! ---------------------------------------------------------------------------------- diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index b7d3eedb96..5fde9eef56 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -28,21 +28,21 @@ module EDTypesMod integer, parameter, public :: maxPatchesPerSite = 14 ! maximum number of patches to live on a site integer, parameter, public :: maxPatchesPerSite_by_disttype(n_anthro_disturbance_categories) = & (/ 10, 4 /) !!! MUST SUM TO maxPatchesPerSite !!! - integer, public :: maxCohortsPerPatch = 100 ! maximum number of cohorts per patch + integer, public :: maxCohortsPerPatch = 300 ! maximum number of cohorts per patch - integer, parameter, public :: nclmax = 2 ! Maximum number of canopy layers + integer, parameter, public :: nclmax = 3 ! Maximum number of canopy layers integer, parameter, public :: ican_upper = 1 ! Nominal index for the upper canopy integer, parameter, public :: ican_ustory = 2 ! Nominal index for diagnostics that refer ! to understory layers (all layers that ! are not the top canopy layer) + integer, parameter, public :: nlevleaf = 30 ! number of leaf layers in canopy layer integer, parameter, public :: maxpft = 16 ! maximum number of PFTs allowed ! the parameter file may determine that fewer ! are used, but this helps allocate scratch ! space and output arrays. - real(r8), parameter, public :: init_recruit_trim = 0.8_r8 ! This is the initial trimming value that ! new recruits start with @@ -166,7 +166,7 @@ module EDTypesMod ! COHORT TERMINATION - real(r8), parameter, public :: min_npm2 = 1.0E-7_r8 ! minimum cohort number density per m2 before termination + real(r8), parameter, public :: min_npm2 = 1.0E-12_r8 ! minimum cohort number density per m2 before termination real(r8), parameter, public :: min_patch_area = 0.01_r8 ! smallest allowable patch area before termination real(r8), parameter, public :: min_patch_area_forced = 0.0001_r8 ! patch termination will not fuse the youngest patch ! if the area is less than min_patch_area. @@ -174,7 +174,7 @@ module EDTypesMod ! if the fusion area is less than min_patch_area_forced real(r8), parameter, public :: min_nppatch = min_npm2*min_patch_area ! minimum number of cohorts per patch (min_npm2*min_patch_area) - real(r8), parameter, public :: min_n_safemath = 1.0E-12_r8 ! in some cases, we want to immediately remove super small + real(r8), parameter, public :: min_n_safemath = 1.0E-15_r8 ! in some cases, we want to immediately remove super small ! number densities of cohorts to prevent FPEs character*4 yearchar @@ -220,6 +220,7 @@ module EDTypesMod real(r8) :: sapwmemory ! target sapwood biomass- set from previous year: kGC per indiv real(r8) :: structmemory ! target structural biomass- set from previous year: kGC per indiv integer :: canopy_layer ! canopy status of cohort (1 = canopy, 2 = understorey, etc.) + integer :: crowndamage ! crown damage class of the cohort real(r8) :: canopy_layer_yesterday ! recent canopy status of cohort ! (1 = canopy, 2 = understorey, etc.) ! real to be conservative during fusion @@ -325,6 +326,7 @@ module EDTypesMod real(r8) :: ts_net_uptake(nlevleaf) ! Net uptake of leaf layers: kgC/m2/timestep real(r8) :: year_net_uptake(nlevleaf) ! Net uptake of leaf layers: kgC/m2/year + ! RESPIRATION COMPONENTS real(r8) :: rdark ! Dark respiration: kgC/indiv/s @@ -340,6 +342,9 @@ module EDTypesMod ! (below ground) real(r8) :: froot_mr ! Live fine root maintenance respiration: kgC/indiv/s + !DAMAGE + real(r8) :: branch_frac ! Fraction of aboveground biomass in branches + !MORTALITY real(r8) :: dmort ! proportional mortality rate. (year-1) @@ -350,6 +355,7 @@ module EDTypesMod real(r8) :: frmort ! freezing mortality n/year real(r8) :: smort ! senesence mortality n/year real(r8) :: asmort ! age senescence mortality n/year + real(r8) :: dgmort ! damage mortality n/year ! Logging Mortality Rate ! Yi Xu & M. Huang @@ -782,11 +788,19 @@ module EDTypesMod ! with termination mortality, per canopy level real(r8) :: term_carbonflux_ustory ! carbon flux from live to dead pools associated ! with termination mortality, per canopy level + + real(r8) :: term_crownarea_canopy ! crownarea from termination mortality, per canopy level + real(r8) :: term_crownarea_ustory ! crownarea from termination mortality, per canopy level + real(r8) :: demotion_carbonflux ! biomass of demoted individuals from canopy to understory [kgC/ha/day] real(r8) :: promotion_carbonflux ! biomass of promoted individuals from understory to canopy [kgC/ha/day] real(r8) :: imort_carbonflux ! biomass of individuals killed due to impact mortality per year. [kgC/ha/day] + real(r8) :: imort_crownarea ! crownarea of individuals killed due to impact mortality per year. [m2 day] + real(r8) :: fmort_carbonflux_canopy ! biomass of canopy indivs killed due to fire per year. [gC/m2/sec] real(r8) :: fmort_carbonflux_ustory ! biomass of understory indivs killed due to fire per year [gC/m2/sec] + real(r8) :: fmort_crownarea_canopy ! crownarea of canopy indivs killed due to fire per year. [m2/sec] + real(r8) :: fmort_crownarea_ustory ! crownarea of understory indivs killed due to fire per year [m2/sec] real(r8) :: recruitment_rate(1:maxpft) ! number of individuals that were recruited into new cohorts real(r8), allocatable :: demotion_rate(:) ! rate of individuals demoted from canopy to understory per FATES timestep @@ -809,8 +823,26 @@ module EDTypesMod real(r8), allocatable :: growthflux_fusion(:,:) ! rate of individuals moving into a given size class bin ! due to fusion in a given day. on size x pft array - - + ! Damage fluxes + real(r8), allocatable :: damage_cflux(:,:) ! carbon flux into each damage class each timestep + real(r8), allocatable :: damage_rate(:,:) ! number of individuals moving into a damage class + real(r8), allocatable :: recovery_cflux(:,:) ! carbon flux from recovery each timestep + real(r8), allocatable :: recovery_rate(:,:) ! number of individuals recovering each timesept + + real(r8), allocatable :: imort_rate_damage(:,:,:) ! number of individuals per damage class that die from impact mortality + real(r8), allocatable :: term_nindivs_canopy_damage(:,:,:) ! number of individuals per damage class that die from termination mortality - canopy + real(r8), allocatable :: term_nindivs_ustory_damage(:,:,:) ! number of individuals per damage class that die from termination mortality - canopy + real(r8), allocatable :: fmort_rate_canopy_damage(:,:,:) ! number of individuals per damage class that die from fire - canopy + real(r8), allocatable :: fmort_rate_ustory_damage(:,:,:) ! number of individuals per damage class that die from fire - ustory + real(r8), allocatable :: fmort_cflux_canopy_damage(:,:) ! cflux per damage class that die from fire - canopy + real(r8), allocatable :: fmort_cflux_ustory_damage(:,:) ! cflux per damage class that die from fire - ustory + real(r8), allocatable :: imort_cflux_damage(:,:) ! carbon flux from impact mortality by damage class + real(r8), allocatable :: term_cflux_canopy_damage(:,:) ! carbon flux from termination mortality by damage class + real(r8), allocatable :: term_cflux_ustory_damage(:,:) ! carbon flux from termination mortality by damage class + + real(r8) :: crownarea_canopy_damage ! crown area of canopy that is damaged annually + real(r8) :: crownarea_ustory_damage ! crown area of understory that is damaged annually + ! Canopy Spread real(r8) :: spread ! dynamic canopy allometric term [unitless] @@ -1029,6 +1061,7 @@ subroutine dump_cohort(ccohort) write(fates_log(),*) 'co%n = ', ccohort%n write(fates_log(),*) 'co%dbh = ', ccohort%dbh write(fates_log(),*) 'co%hite = ', ccohort%hite + write(fates_log(),*) 'co%crowndamage = ', ccohort%crowndamage write(fates_log(),*) 'co%coage = ', ccohort%coage write(fates_log(),*) 'co%laimemory = ', ccohort%laimemory write(fates_log(),*) 'co%sapwmemory = ', ccohort%sapwmemory @@ -1072,7 +1105,7 @@ subroutine dump_cohort(ccohort) write(fates_log(),*) 'co%livestem_mr = ', ccohort%livestem_mr write(fates_log(),*) 'co%livecroot_mr = ', ccohort%livecroot_mr write(fates_log(),*) 'co%froot_mr = ', ccohort%froot_mr - write(fates_log(),*) 'co%dmort = ', ccohort%dmort + write(fates_log(),*) 'co%dgmort = ', ccohort%dgmort write(fates_log(),*) 'co%treelai = ', ccohort%treelai write(fates_log(),*) 'co%treesai = ', ccohort%treesai write(fates_log(),*) 'co%c_area = ', ccohort%c_area @@ -1080,9 +1113,9 @@ subroutine dump_cohort(ccohort) write(fates_log(),*) 'co%bmort = ', ccohort%bmort write(fates_log(),*) 'co%smort = ', ccohort%smort write(fates_log(),*) 'co%asmort = ', ccohort%asmort + write(fates_log(),*) 'co%dgmort = ', ccohort%dgmort 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%isnew = ', ccohort%isnew write(fates_log(),*) 'co%dndt = ', ccohort%dndt write(fates_log(),*) 'co%dhdt = ', ccohort%dhdt diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 97f3342b43..7232bc84f7 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -1,4 +1,4 @@ -module FatesHistoryInterfaceMod +Module FatesHistoryInterfaceMod use FatesConstantsMod , only : r8 => fates_r8 use FatesConstantsMod , only : fates_avg_flag_length @@ -36,6 +36,8 @@ module FatesHistoryInterfaceMod use FatesInterfaceTypesMod , only : hlm_use_planthydro use FatesInterfaceTypesMod , only : hlm_use_ed_st3 use FatesInterfaceTypesMod , only : hlm_use_cohort_age_tracking + use FatesInterfaceTypesMod , only : hlm_use_canopy_damage + use FatesInterfaceTypesMod , only : hlm_use_understory_damage use FatesInterfaceTypesMod , only : numpft use FatesInterfaceTypesMod , only : hlm_freq_day use FatesInterfaceTypesMod , only : hlm_parteh_mode @@ -46,6 +48,7 @@ module FatesHistoryInterfaceMod use FatesInterfaceTypesMod , only : bc_in_type use FatesInterfaceTypesMod , only : hlm_model_day use FatesInterfaceTypesMod , only : nlevcoage + use FatesInterfaceTypesMod , only : ncrowndamage ! FIXME(bja, 2016-10) need to remove CLM dependancy use EDPftvarcon , only : EDPftvarcon_inst @@ -55,6 +58,8 @@ module FatesHistoryInterfaceMod use shr_log_mod , only : errMsg => shr_log_errMsg use shr_infnan_mod , only : isnan => shr_infnan_isnan use FatesConstantsMod , only : g_per_kg + use FatesConstantsMod , only : kg_per_g + use FatesConstantsMod , only : m2_per_ha use FatesConstantsMod , only : ha_per_m2 use FatesConstantsMod , only : days_per_sec use FatesConstantsMod , only : sec_per_day @@ -317,6 +322,8 @@ module FatesHistoryInterfaceMod integer :: ih_promotion_carbonflux_si integer :: ih_canopy_mortality_carbonflux_si integer :: ih_understory_mortality_carbonflux_si + integer :: ih_canopy_mortality_crownarea_si + integer :: ih_understory_mortality_crownarea_si integer :: ih_canopy_spread_si integer :: ih_npp_leaf_si integer :: ih_npp_seed_si @@ -381,6 +388,8 @@ module FatesHistoryInterfaceMod integer :: ih_mortality_canopy_si_scpf integer :: ih_mortality_understory_si_scpf + integer :: ih_m3_mortality_canopy_si_scpf + integer :: ih_m3_mortality_understory_si_scpf integer :: ih_nplant_canopy_si_scpf integer :: ih_nplant_understory_si_scpf integer :: ih_ddbh_canopy_si_scpf @@ -405,12 +414,11 @@ module FatesHistoryInterfaceMod integer :: ih_m8_si_scpf integer :: ih_m9_si_scpf integer :: ih_m10_si_scpf + integer :: ih_m11_si_scpf integer :: ih_crownfiremort_si_scpf integer :: ih_cambialfiremort_si_scpf - integer :: ih_m10_si_capf integer :: ih_nplant_si_capf - integer :: ih_ar_si_scpf integer :: ih_ar_grow_si_scpf integer :: ih_ar_maint_si_scpf @@ -432,6 +440,8 @@ module FatesHistoryInterfaceMod integer :: ih_sai_understory_si_scls integer :: ih_mortality_canopy_si_scls integer :: ih_mortality_understory_si_scls + integer :: ih_m3_mortality_canopy_si_scls + integer :: ih_m3_mortality_understory_si_scls integer :: ih_demotion_rate_si_scls integer :: ih_promotion_rate_si_scls integer :: ih_trimming_canopy_si_scls @@ -442,8 +452,8 @@ module FatesHistoryInterfaceMod integer :: ih_ddbh_understory_si_scls integer :: ih_agb_si_scls integer :: ih_biomass_si_scls - - ! mortality vars + + ! mortality var integer :: ih_m1_si_scls integer :: ih_m2_si_scls integer :: ih_m3_si_scls @@ -454,6 +464,7 @@ module FatesHistoryInterfaceMod integer :: ih_m8_si_scls integer :: ih_m9_si_scls integer :: ih_m10_si_scls + integer :: ih_m11_si_scls integer :: ih_m10_si_cacls integer :: ih_nplant_si_cacls @@ -620,6 +631,54 @@ module FatesHistoryInterfaceMod integer :: ih_parprof_dir_si_cnlfpft integer :: ih_parprof_dif_si_cnlfpft + ! indices to site x crown damage variables + ! site x crown damage x pft x sizeclass + ! site x crown damage x size class + integer :: ih_nplant_si_cdpf + integer :: ih_nplant_si_cdsc + integer :: ih_nplant_canopy_si_cdpf + integer :: ih_nplant_understory_si_cdpf + integer :: ih_nplant_canopy_si_cdsc + integer :: ih_nplant_understory_si_cdsc + integer :: ih_mortality_si_cdsc + integer :: ih_mortality_si_cdpf + integer :: ih_mortality_canopy_si_cdpf + integer :: ih_mortality_understory_si_cdpf + integer :: ih_m3_si_cdpf + integer :: ih_m3_si_cdsc + integer :: ih_m11_si_cdpf + integer :: ih_m11_si_cdsc + integer :: ih_m3_mortality_canopy_si_cdsc + integer :: ih_m3_mortality_understory_si_cdsc + integer :: ih_m3_mortality_canopy_si_cdpf + integer :: ih_m3_mortality_understory_si_cdpf + integer :: ih_m11_mortality_canopy_si_cdsc + integer :: ih_m11_mortality_understory_si_cdsc + integer :: ih_m11_mortality_canopy_si_cdpf + integer :: ih_m11_mortality_understory_si_cdpf + integer :: ih_trimming_damage_si_cdsc + integer :: ih_ddbh_si_cdsc + integer :: ih_ddbh_si_cdpf + integer :: ih_ddbh_canopy_si_cdpf + integer :: ih_ddbh_understory_si_cdpf + + ! damage carbonflux + integer :: ih_damage_cflux_si_cdcd + integer :: ih_damage_rate_si_cdcd + integer :: ih_recovery_cflux_si_cdcd + integer :: ih_recovery_rate_si_cdcd + integer :: ih_crownarea_canopy_damage_si + integer :: ih_crownarea_ustory_damage_si + + integer :: ih_totvegc_cdpf + integer :: ih_leafc_cdpf + integer :: ih_fnrtc_cdpf + integer :: ih_storec_cdpf + integer :: ih_sapwc_cdpf + integer :: ih_reproc_cdpf + integer :: ih_cefflux_cdpf + + ! indices to (site x canopy layer) variables integer :: ih_parsun_top_si_can integer :: ih_parsha_top_si_can @@ -660,6 +719,8 @@ module FatesHistoryInterfaceMod integer, private :: levscls_index_, levpft_index_, levage_index_ integer, private :: levfuel_index_, levcwdsc_index_, levscag_index_ integer, private :: levcan_index_, levcnlf_index_, levcnlfpft_index_ + integer, private :: levcdpf_index_, levcdsc_index_ + integer, private :: levcdcd_index_ integer, private :: levscagpft_index_, levagepft_index_ integer, private :: levheight_index_, levagefuel_index_ integer, private :: levelem_index_, levelpft_index_ @@ -695,6 +756,9 @@ module FatesHistoryInterfaceMod procedure :: levcan_index procedure :: levcnlf_index procedure :: levcnlfpft_index + procedure :: levcdcd_index + procedure :: levcdpf_index + procedure :: levcdsc_index procedure :: levscag_index procedure :: levscagpft_index procedure :: levagepft_index @@ -724,6 +788,9 @@ module FatesHistoryInterfaceMod procedure, private :: set_levcan_index procedure, private :: set_levcnlf_index procedure, private :: set_levcnlfpft_index + procedure, private :: set_levcdcd_index + procedure, private :: set_levcdpf_index + procedure, private :: set_levcdsc_index procedure, private :: set_levscag_index procedure, private :: set_levscagpft_index procedure, private :: set_levagepft_index @@ -760,6 +827,8 @@ subroutine Init(this, num_threads, fates_bounds) use FatesIODimensionsMod, only : levfuel, levcwdsc, levscag use FatesIODimensionsMod, only : levscagpft, levagepft use FatesIODimensionsMod, only : levcan, levcnlf, levcnlfpft + use FatesIODimensionsMod, only : levcdpf, levcdsc + use FatesIODimensionsMod, only : levcdcd use FatesIODimensionsMod, only : fates_bounds_type use FatesIODimensionsMod, only : levheight, levagefuel use FatesIODimensionsMod, only : levelem, levelpft @@ -843,6 +912,21 @@ subroutine Init(this, num_threads, fates_bounds) call this%dim_bounds(dim_count)%Init(levcnlfpft, num_threads, & fates_bounds%cnlfpft_begin, fates_bounds%cnlfpft_end) + dim_count = dim_count + 1 + call this%set_levcdcd_index(dim_count) + call this%dim_bounds(dim_count)%Init(levcdcd, num_threads, & + fates_bounds%cdcd_begin, fates_bounds%cdcd_end) + + dim_count = dim_count + 1 + call this%set_levcdpf_index(dim_count) + call this%dim_bounds(dim_count)%Init(levcdpf, num_threads, & + fates_bounds%cdpf_begin, fates_bounds%cdpf_end) + + dim_count = dim_count + 1 + call this%set_levcdsc_index(dim_count) + call this%dim_bounds(dim_count)%Init(levcdsc, num_threads, & + fates_bounds%cdsc_begin, fates_bounds%cdsc_end) + dim_count = dim_count + 1 call this%set_levscag_index(dim_count) call this%dim_bounds(dim_count)%Init(levscag, num_threads, & @@ -959,7 +1043,19 @@ subroutine SetThreadBoundsEach(this, thread_index, thread_bounds) index = this%levcnlfpft_index() call this%dim_bounds(index)%SetThreadBounds(thread_index, & thread_bounds%cnlfpft_begin, thread_bounds%cnlfpft_end) + + index = this%levcdcd_index() + call this%dim_bounds(index)%SetThreadBounds(thread_index, & + thread_bounds%cdcd_begin, thread_bounds%cdcd_end) + index = this%levcdpf_index() + call this%dim_bounds(index)%SetThreadBounds(thread_index, & + thread_bounds%cdpf_begin, thread_bounds%cdpf_end) + + index = this%levcdsc_index() + call this%dim_bounds(index)%SetThreadBounds(thread_index, & + thread_bounds%cdsc_begin, thread_bounds%cdsc_end) + index = this%levscag_index() call this%dim_bounds(index)%SetThreadBounds(thread_index, & thread_bounds%sizeage_class_begin, thread_bounds%sizeage_class_end) @@ -1012,6 +1108,7 @@ subroutine assemble_history_output_types(this) use FatesIOVariableKindMod, only : site_fuel_r8, site_cwdsc_r8, site_scag_r8 use FatesIOVariableKindMod, only : site_scagpft_r8, site_agepft_r8 use FatesIOVariableKindMod, only : site_can_r8, site_cnlf_r8, site_cnlfpft_r8 + use FatesIOVariableKindMod, only : site_cdpf_r8, site_cdsc_r8, site_cdcd_r8 use FatesIOVariableKindMod, only : site_height_r8, site_agefuel_r8 use FatesIOVariableKindMod, only : site_elem_r8, site_elpft_r8 use FatesIOVariableKindMod, only : site_elcwd_r8, site_elage_r8 @@ -1068,6 +1165,15 @@ subroutine assemble_history_output_types(this) call this%set_dim_indices(site_cnlfpft_r8, 1, this%column_index()) call this%set_dim_indices(site_cnlfpft_r8, 2, this%levcnlfpft_index()) + call this%set_dim_indices(site_cdcd_r8, 1, this%column_index()) + call this%set_dim_indices(site_cdcd_r8, 2, this%levcdcd_index()) + + call this%set_dim_indices(site_cdpf_r8, 1, this%column_index()) + call this%set_dim_indices(site_cdpf_r8, 2, this%levcdpf_index()) + + call this%set_dim_indices(site_cdsc_r8, 1, this%column_index()) + call this%set_dim_indices(site_cdsc_r8, 2, this%levcdsc_index()) + call this%set_dim_indices(site_scag_r8, 1, this%column_index()) call this%set_dim_indices(site_scag_r8, 2, this%levscag_index()) @@ -1334,6 +1440,48 @@ integer function levcnlfpft_index(this) class(fates_history_interface_type), intent(in) :: this levcnlfpft_index = this%levcnlfpft_index_ end function levcnlfpft_index + + ! ======================================================================= + subroutine set_levcdcd_index(this, index) + implicit none + class(fates_history_interface_type), intent(inout) :: this + integer, intent(in) :: index + this%levcdcd_index_ = index + end subroutine set_levcdcd_index + + integer function levcdcd_index(this) + implicit none + class(fates_history_interface_type), intent(in) :: this + levcdcd_index = this%levcdcd_index_ + end function levcdcd_index + +! ======================================================================= + subroutine set_levcdpf_index(this, index) + implicit none + class(fates_history_interface_type), intent(inout) :: this + integer, intent(in) :: index + this%levcdpf_index_ = index + end subroutine set_levcdpf_index + + integer function levcdpf_index(this) + implicit none + class(fates_history_interface_type), intent(in) :: this + levcdpf_index = this%levcdpf_index_ + end function levcdpf_index + + ! ======================================================================= + subroutine set_levcdsc_index(this, index) + implicit none + class(fates_history_interface_type), intent(inout) :: this + integer, intent(in) :: index + this%levcdsc_index_ = index + end subroutine set_levcdsc_index + + integer function levcdsc_index(this) + implicit none + class(fates_history_interface_type), intent(in) :: this + levcdsc_index = this%levcdsc_index_ + end function levcdsc_index ! ====================================================================================== subroutine set_levscag_index(this, index) @@ -1561,6 +1709,8 @@ subroutine init_dim_kinds_maps(this) use FatesIOVariableKindMod, only : site_fuel_r8, site_cwdsc_r8, site_scag_r8 use FatesIOVariableKindMod, only : site_scagpft_r8, site_agepft_r8 use FatesIOVariableKindMod, only : site_can_r8, site_cnlf_r8, site_cnlfpft_r8 + use FatesIOVariableKindMod, only : site_cdpf_r8, site_cdsc_r8 + use FatesIOVariableKindMod, only : site_cdcd_r8 use FatesIOVariableKindMod, only : site_height_r8, site_agefuel_r8 use FatesIOVariableKindMod, only : site_elem_r8, site_elpft_r8 use FatesIOVariableKindMod, only : site_elcwd_r8, site_elage_r8 @@ -1637,6 +1787,19 @@ subroutine init_dim_kinds_maps(this) index = index + 1 call this%dim_kinds(index)%Init(site_cnlfpft_r8, 2) + ! site x crown damage x crown damage class + index = index + 1 + call this%dim_kinds(index)%Init(site_cdcd_r8, 2) + + ! site x crown damage x pft x size class + index = index + 1 + call this%dim_kinds(index)%Init(site_cdpf_r8, 2) + + ! site x crowndamage x size class + index = index + 1 + call this%dim_kinds(index)%Init(site_cdsc_r8, 2) + + ! site x size-class x age class index = index + 1 call this%dim_kinds(index)%Init(site_scag_r8, 2) @@ -1702,9 +1865,13 @@ subroutine update_history_dyn(this,nc,nsites,sites) use FatesSizeAgeTypeIndicesMod, only : get_age_class_index use FatesSizeAgeTypeIndicesMod, only : get_height_index use FatesSizeAgeTypeIndicesMod, only : sizetype_class_index + use FatesSizeAgeTypeIndicesMod, only : get_cdamagesize_class_index + use FatesSizeAgeTypeIndicesMod, only : get_cdamagesizepft_class_index use FatesSizeAgeTypeIndicesMod, only : coagetype_class_index - use EDTypesMod , only : nlevleaf - use EDParamsMod , only : ED_val_history_height_bin_edges + use EDTypesMod , only : nlevleaf + use EDParamsMod, only : ED_val_history_height_bin_edges + use FatesInterfaceTypesMod, only : ncrowndamage + use DamageMainMod , only : damage_time ! Arguments class(fates_history_interface_type) :: this @@ -1736,6 +1903,9 @@ subroutine update_history_dyn(this,nc,nsites,sites) integer :: iagepft ! age x pft index integer :: i_agefuel ! age x fuel size class index integer :: ican, ileaf, cnlf_indx ! iterators for leaf and canopy level + integer :: icdpf, icdsc, icdcd, icdi, icdj, icdam, imcdam ! iterators for the crown damage level + integer :: cdpf, cdsc + integer :: counter 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 @@ -1781,6 +1951,8 @@ subroutine update_history_dyn(this,nc,nsites,sites) real(r8), parameter :: tiny = 1.e-5_r8 ! some small number real(r8), parameter :: reallytalltrees = 1000. ! some large number (m) + + real(r8) :: total_c ! for damage integer :: tmp @@ -1869,6 +2041,8 @@ subroutine update_history_dyn(this,nc,nsites,sites) 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_understory_si_scpf => this%hvars(ih_mortality_understory_si_scpf)%r82d, & + hio_m3_mortality_canopy_si_scpf => this%hvars(ih_m3_mortality_canopy_si_scpf)%r82d, & + hio_m3_mortality_understory_si_scpf => this%hvars(ih_m3_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, & hio_ddbh_canopy_si_scpf => this%hvars(ih_ddbh_canopy_si_scpf)%r82d, & @@ -1897,14 +2071,50 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_m8_si_scpf => this%hvars(ih_m8_si_scpf)%r82d, & hio_m9_si_scpf => this%hvars(ih_m9_si_scpf)%r82d, & hio_m10_si_scpf => this%hvars(ih_m10_si_scpf)%r82d, & + hio_m11_si_scpf => this%hvars(ih_m11_si_scpf)%r82d, & hio_m10_si_capf => this%hvars(ih_m10_si_capf)%r82d, & - + + hio_crownfiremort_si_scpf => this%hvars(ih_crownfiremort_si_scpf)%r82d, & hio_cambialfiremort_si_scpf => this%hvars(ih_cambialfiremort_si_scpf)%r82d, & hio_fire_c_to_atm_si => this%hvars(ih_fire_c_to_atm_si)%r81d, & hio_burn_flux_elem => this%hvars(ih_burn_flux_elem)%r82d, & + hio_nplant_si_cdpf => this%hvars(ih_nplant_si_cdpf)%r82d, & + hio_nplant_si_cdsc => this%hvars(ih_nplant_si_cdsc)%r82d, & + hio_mortality_si_cdsc => this%hvars(ih_mortality_si_cdsc)%r82d, & + hio_mortality_si_cdpf => this%hvars(ih_mortality_si_cdpf)%r82d, & + hio_m3_si_cdpf => this%hvars(ih_m3_si_cdpf)%r82d, & + hio_m3_si_cdsc => this%hvars(ih_m3_si_cdsc)%r82d, & + hio_m11_si_cdpf => this%hvars(ih_m11_si_cdpf)%r82d, & + hio_m11_si_cdsc => this%hvars(ih_m11_si_cdsc)%r82d, & + hio_mortality_canopy_si_cdpf => this%hvars(ih_mortality_canopy_si_cdpf)%r82d, & + hio_mortality_understory_si_cdpf => this%hvars(ih_mortality_understory_si_cdpf)%r82d, & + hio_m3_mortality_canopy_si_cdsc => this%hvars(ih_m3_mortality_canopy_si_cdsc)%r82d, & + hio_m3_mortality_understory_si_cdsc => this%hvars(ih_m3_mortality_understory_si_cdsc)%r82d, & + hio_m3_mortality_canopy_si_cdpf => this%hvars(ih_m3_mortality_canopy_si_cdpf)%r82d, & + hio_m3_mortality_understory_si_cdpf =>this%hvars(ih_m3_mortality_understory_si_cdpf)%r82d, & + hio_m11_mortality_canopy_si_cdsc => this%hvars(ih_m11_mortality_canopy_si_cdsc)%r82d, & + hio_m11_mortality_understory_si_cdsc => this%hvars(ih_m11_mortality_understory_si_cdsc)%r82d, & + hio_m11_mortality_canopy_si_cdpf => this%hvars(ih_m11_mortality_canopy_si_cdpf)%r82d, & + hio_m11_mortality_understory_si_cdpf =>this%hvars(ih_m11_mortality_understory_si_cdpf)%r82d, & + hio_nplant_canopy_si_cdsc => this%hvars(ih_nplant_canopy_si_cdsc)%r82d, & + hio_nplant_understory_si_cdsc =>this%hvars(ih_nplant_understory_si_cdsc)%r82d, & + hio_nplant_canopy_si_cdpf => this%hvars(ih_nplant_canopy_si_cdpf)%r82d, & + hio_nplant_understory_si_cdpf =>this%hvars(ih_nplant_understory_si_cdpf)%r82d, & + hio_damage_cflux_si_cdcd => this%hvars(ih_damage_cflux_si_cdcd)%r82d, & + hio_damage_rate_si_cdcd => this%hvars(ih_damage_rate_si_cdcd)%r82d, & + hio_recovery_cflux_si_cdcd => this%hvars(ih_recovery_cflux_si_cdcd)%r82d, & + hio_recovery_rate_si_cdcd => this%hvars(ih_recovery_rate_si_cdcd)%r82d, & + hio_trimming_damage_si_cdsc => this%hvars(ih_trimming_damage_si_cdsc)%r82d, & + hio_ddbh_si_cdsc => this%hvars(ih_ddbh_si_cdsc)%r82d, & + hio_ddbh_si_cdpf => this%hvars(ih_ddbh_si_cdpf)%r82d, & + hio_ddbh_canopy_si_cdpf => this%hvars(ih_ddbh_canopy_si_cdpf)%r82d, & + hio_ddbh_understory_si_cdpf => this%hvars(ih_ddbh_understory_si_cdpf)%r82d, & + hio_crownarea_canopy_damage_si => this%hvars(ih_crownarea_canopy_damage_si)%r81d, & + hio_crownarea_ustory_damage_si => this%hvars(ih_crownarea_ustory_damage_si)%r81d, & + hio_m1_si_scls => this%hvars(ih_m1_si_scls)%r82d, & hio_m2_si_scls => this%hvars(ih_m2_si_scls)%r82d, & hio_m3_si_scls => this%hvars(ih_m3_si_scls)%r82d, & @@ -1915,6 +2125,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_m8_si_scls => this%hvars(ih_m8_si_scls)%r82d, & hio_m9_si_scls => this%hvars(ih_m9_si_scls)%r82d, & hio_m10_si_scls => this%hvars(ih_m10_si_scls)%r82d, & + hio_m11_si_scls => this%hvars(ih_m11_si_scls)%r82d, & hio_m10_si_cacls => this%hvars(ih_m10_si_cacls)%r82d, & hio_c13disc_si_scpf => this%hvars(ih_c13disc_si_scpf)%r82d, & @@ -1937,6 +2148,8 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_sai_understory_si_scls => this%hvars(ih_sai_understory_si_scls)%r82d, & hio_mortality_canopy_si_scls => this%hvars(ih_mortality_canopy_si_scls)%r82d, & hio_mortality_understory_si_scls => this%hvars(ih_mortality_understory_si_scls)%r82d, & + hio_m3_mortality_canopy_si_scls => this%hvars(ih_m3_mortality_canopy_si_scls)%r82d, & + hio_m3_mortality_understory_si_scls => this%hvars(ih_m3_mortality_understory_si_scls)%r82d, & hio_demotion_rate_si_scls => this%hvars(ih_demotion_rate_si_scls)%r82d, & hio_demotion_carbonflux_si => this%hvars(ih_demotion_carbonflux_si)%r81d, & hio_promotion_rate_si_scls => this%hvars(ih_promotion_rate_si_scls)%r82d, & @@ -1947,6 +2160,8 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_promotion_carbonflux_si => this%hvars(ih_promotion_carbonflux_si)%r81d, & hio_canopy_mortality_carbonflux_si => this%hvars(ih_canopy_mortality_carbonflux_si)%r81d, & hio_understory_mortality_carbonflux_si => this%hvars(ih_understory_mortality_carbonflux_si)%r81d, & + hio_canopy_mortality_crownarea_si => this%hvars(ih_canopy_mortality_crownarea_si)%r81d, & + hio_understory_mortality_crownarea_si => this%hvars(ih_understory_mortality_crownarea_si)%r81d, & hio_leaf_md_canopy_si_scls => this%hvars(ih_leaf_md_canopy_si_scls)%r82d, & hio_root_md_canopy_si_scls => this%hvars(ih_root_md_canopy_si_scls)%r82d, & hio_carbon_balance_canopy_si_scls => this%hvars(ih_carbon_balance_canopy_si_scls)%r82d, & @@ -2038,6 +2253,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) model_day_int = nint(hlm_model_day) + ! --------------------------------------------------------------------------------- ! Loop through the FATES scale hierarchy and fill the history IO arrays ! --------------------------------------------------------------------------------- @@ -2065,7 +2281,39 @@ subroutine update_history_dyn(this,nc,nsites,sites) sites(s)%mass_balance(el)%burn_flux_to_atm * & g_per_kg * ha_per_m2 * days_per_sec - end do + end do + + ! damage variables - site level - this needs to be OUT of the patch loop + if(hlm_use_canopy_damage .eq. itrue .or. hlm_use_understory_damage .eq. itrue) then + + icdcd = 1 + + do icdi = 1,ncrowndamage+1 + do icdj = 1,ncrowndamage + hio_damage_cflux_si_cdcd(io_si,icdcd) = & + sites(s)%damage_cflux(icdj,icdi) * g_per_kg * days_per_sec * & + ha_per_m2 + hio_damage_rate_si_cdcd(io_si,icdcd) = & + sites(s)%damage_rate(icdj,icdi) + + hio_recovery_cflux_si_cdcd(io_si,icdcd) = & + sites(s)%recovery_cflux(icdj,icdi) * g_per_kg * days_per_sec * & + ha_per_m2 + hio_recovery_rate_si_cdcd(io_si,icdcd) = & + sites(s)%recovery_rate(icdj,icdi) + + + icdcd = icdcd + 1 + end do + end do + + hio_crownarea_canopy_damage_si(io_si) = hio_crownarea_canopy_damage_si(io_si) + & + sites(s)%crownarea_canopy_damage * days_per_year + + hio_crownarea_ustory_damage_si(io_si) = hio_crownarea_ustory_damage_si(io_si) + & + sites(s)%crownarea_ustory_damage * days_per_year + + end if hio_canopy_spread_si(io_si) = sites(s)%spread @@ -2200,7 +2448,9 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_area_plant_si(io_si) = hio_area_plant_si(io_si) + min(cpatch%total_canopy_area,cpatch%area) * AREA_INV hio_area_trees_si(io_si) = hio_area_trees_si(io_si) + min(cpatch%total_tree_area,cpatch%area) * AREA_INV - + + + ccohort => cpatch%shortest do while(associated(ccohort)) @@ -2249,6 +2499,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_canopy_height_dist_si_height(io_si,height_bin_max) + ccohort%c_area * AREA_INV endif + ! Update biomass components ! Mass pools [kgC] do el = 1, num_elements @@ -2268,6 +2519,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) ! Zero states, and set the fluxes if( element_list(el).eq.carbon12_element )then + total_c = total_m this%hvars(ih_storec_si)%r81d(io_si) = & this%hvars(ih_storec_si)%r81d(io_si) + ccohort%n * store_m this%hvars(ih_leafc_si)%r81d(io_si) = & @@ -2315,8 +2567,9 @@ subroutine update_history_dyn(this,nc,nsites,sites) if ( cpatch%anthro_disturbance_label .eq. secondaryforest ) then hio_biomass_secondary_forest_si(io_si) = hio_biomass_secondary_forest_si(io_si) + & total_m * ccohort%n * AREA_INV - endif - + endif + + elseif(element_list(el).eq.nitrogen_element)then store_max = ccohort%prt%GetNutrientTarget(element_list(el),store_organ) @@ -2414,12 +2667,13 @@ subroutine update_history_dyn(this,nc,nsites,sites) (1._r8-prt_params%allom_agb_frac(ccohort%pft)) hio_npp_stor_si(io_si) = hio_npp_stor_si(io_si) + store_m_net_alloc * n_perm2 + associate( scpf => ccohort%size_by_pft_class, & - scls => ccohort%size_class, & + cdam => ccohort%crowndamage, & cacls => ccohort%coage_class, & capf => ccohort%coage_by_pft_class) - + gpp_cached = hio_gpp_si_scpf(io_si,scpf) @@ -2474,6 +2728,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) (ccohort%lmort_direct+ccohort%lmort_collateral+ccohort%lmort_infra) * ccohort%n hio_m8_si_scpf(io_si,scpf) = hio_m8_si_scpf(io_si,scpf) + ccohort%frmort*ccohort%n hio_m9_si_scpf(io_si,scpf) = hio_m9_si_scpf(io_si,scpf) + ccohort%smort*ccohort%n + if (hlm_use_cohort_age_tracking .eq.itrue) then hio_m10_si_scpf(io_si,scpf) = hio_m10_si_scpf(io_si,scpf) + ccohort%asmort*ccohort%n @@ -2490,10 +2745,10 @@ subroutine update_history_dyn(this,nc,nsites,sites) (ccohort%lmort_direct+ccohort%lmort_collateral+ccohort%lmort_infra) * ccohort%n hio_m8_si_scls(io_si,scls) = hio_m8_si_scls(io_si,scls) + & ccohort%frmort*ccohort%n + hio_m9_si_scls(io_si,scls) = hio_m9_si_scls(io_si,scls) + ccohort%smort*ccohort%n - !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) + & @@ -2505,6 +2760,92 @@ subroutine update_history_dyn(this,nc,nsites,sites) ! number density [/ha] hio_nplant_si_scpf(io_si,scpf) = hio_nplant_si_scpf(io_si,scpf) + ccohort%n + ! damage variables - cohort level + if(hlm_use_canopy_damage .eq. itrue .or. hlm_use_understory_damage .eq. itrue) then + + + cdpf = get_cdamagesizepft_class_index(ccohort%dbh, ccohort%crowndamage, ccohort%pft) + cdsc = get_cdamagesize_class_index(ccohort%dbh, ccohort%crowndamage) + + ! crown damage - only want cohorts > 1 cm dbh here so we can compare it with data + hio_mortality_si_cdsc(io_si,cdsc) = hio_mortality_si_cdsc(io_si,cdsc) + & + (ccohort%bmort + ccohort%hmort + ccohort%cmort + & + ccohort%frmort + ccohort%smort + ccohort%asmort + ccohort%dgmort) * ccohort%n + & + (ccohort%lmort_direct + ccohort%lmort_collateral + ccohort%lmort_infra) * & + ccohort%n * sec_per_day * days_per_year + + hio_mortality_si_cdpf(io_si,cdpf) = hio_mortality_si_cdpf(io_si,cdpf) + & + (ccohort%bmort + ccohort%hmort + ccohort%cmort + & + ccohort%frmort + ccohort%smort + ccohort%asmort + ccohort%dgmort) * ccohort%n + & + (ccohort%lmort_direct + ccohort%lmort_collateral + ccohort%lmort_infra) * & + ccohort%n * sec_per_day * days_per_year + + + hio_trimming_damage_si_cdsc(io_si,cdsc) = hio_trimming_damage_si_cdsc(io_si,cdsc) + & + ccohort%n * ccohort%canopy_trim + + ! crown damage by size + hio_nplant_si_cdsc(io_si, cdsc) = hio_nplant_si_cdsc(io_si, cdsc) + ccohort%n + hio_m3_si_cdsc(io_si, cdsc) = hio_m3_si_cdsc(io_si, cdsc) + ccohort%cmort * ccohort%n + + ! crown damage by size by pft + hio_nplant_si_cdpf(io_si, cdpf) = hio_nplant_si_cdpf(io_si, cdpf) + ccohort%n + hio_m3_si_cdpf(io_si, cdpf) = hio_m3_si_cdpf(io_si, cdpf) + ccohort%cmort * ccohort%n + + ! mortality + hio_m11_si_scpf(io_si,scpf) = hio_m11_si_scpf(io_si,scpf) + ccohort%dgmort*ccohort%n + hio_m11_si_scls(io_si,scls) = hio_m11_si_scls(io_si,scls) + ccohort%dgmort*ccohort%n + hio_m11_si_cdpf(io_si,cdpf) = hio_m11_si_cdpf(io_si,cdpf) + ccohort%dgmort*ccohort%n + hio_m11_si_cdsc(io_si,cdsc) = hio_m11_si_cdsc(io_si,cdsc) + ccohort%dgmort*ccohort%n + + hio_ddbh_si_cdsc(io_si,cdsc) = hio_ddbh_si_cdsc(io_si,cdsc) + & + ccohort%ddbhdt*ccohort%n + + hio_ddbh_si_cdpf(io_si,cdpf) = hio_ddbh_si_cdpf(io_si,cdpf) + & + ccohort%ddbhdt*ccohort%n + + + ! add mortality to the damage rates + + icdam = (ncrowndamage*ncrowndamage) + cdam ! to fill in the last row + + if(hlm_use_canopy_damage .eq. itrue .and. ccohort%canopy_layer == 1 .or. & + hlm_use_understory_damage .eq. itrue .and. ccohort%canopy_layer > 1) then + + hio_damage_rate_si_cdcd(io_si,icdam) = hio_damage_rate_si_cdcd(io_si,icdam) + & + (ccohort%bmort + ccohort%hmort + ccohort%cmort + & + ccohort%frmort + ccohort%smort + ccohort%asmort + ccohort%dgmort) * ccohort%n & + + (ccohort%lmort_direct + ccohort%lmort_collateral + ccohort%lmort_infra) * & + ccohort%n * sec_per_day * days_per_year + + hio_damage_cflux_si_cdcd(io_si,icdam) = hio_damage_cflux_si_cdcd(io_si,icdam) + & + (ccohort%bmort + ccohort%hmort + ccohort%cmort + & + ccohort%frmort + ccohort%smort + ccohort%asmort + ccohort%dgmort) * & + total_c * ccohort%n * g_per_kg * days_per_sec * years_per_day * ha_per_m2 + & + (ccohort%lmort_direct + ccohort%lmort_collateral + ccohort%lmort_infra) * total_c * & + ccohort%n * g_per_kg * ha_per_m2 + + end if + + ! all crown layers go towards recovery + hio_recovery_rate_si_cdcd(io_si,icdam) = hio_recovery_rate_si_cdcd(io_si,icdam) + & + (ccohort%bmort + ccohort%hmort + ccohort%cmort + & + ccohort%frmort + ccohort%smort + ccohort%asmort + ccohort%dgmort) * ccohort%n & + + (ccohort%lmort_direct + ccohort%lmort_collateral + ccohort%lmort_infra) * & + ccohort%n * sec_per_day * days_per_year + + hio_recovery_cflux_si_cdcd(io_si,icdam) = hio_recovery_cflux_si_cdcd(io_si,icdam) + & + (ccohort%bmort + ccohort%hmort + ccohort%cmort + & + ccohort%frmort + ccohort%smort + ccohort%asmort + ccohort%dgmort) * & + total_c * ccohort%n * g_per_kg * days_per_sec * years_per_day * ha_per_m2 + & + (ccohort%lmort_direct + ccohort%lmort_collateral + ccohort%lmort_infra) * total_c * & + ccohort%n * g_per_kg * ha_per_m2 + + + end if ! end if damage + + + ! number density along the cohort age dimension if (hlm_use_cohort_age_tracking .eq.itrue) then hio_nplant_si_capf(io_si,capf) = hio_nplant_si_capf(io_si,capf) + ccohort%n @@ -2564,7 +2905,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_nplant_canopy_si_scag(io_si,iscag) = hio_nplant_canopy_si_scag(io_si,iscag) + ccohort%n hio_mortality_canopy_si_scag(io_si,iscag) = hio_mortality_canopy_si_scag(io_si,iscag) + & (ccohort%bmort + ccohort%hmort + ccohort%cmort + & - ccohort%frmort + ccohort%smort + ccohort%asmort) * ccohort%n + ccohort%frmort + ccohort%smort + ccohort%asmort + ccohort%dgmort) * ccohort%n hio_ddbh_canopy_si_scag(io_si,iscag) = hio_ddbh_canopy_si_scag(io_si,iscag) + & ccohort%ddbhdt*ccohort%n hio_bstor_canopy_si_scpf(io_si,scpf) = hio_bstor_canopy_si_scpf(io_si,scpf) + & @@ -2579,20 +2920,27 @@ subroutine update_history_dyn(this,nc,nsites,sites) ! ccohort%frmort + ccohort%smort + ccohort%asmort) * ccohort%n hio_mortality_canopy_si_scpf(io_si,scpf) = hio_mortality_canopy_si_scpf(io_si,scpf)+ & - (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%frmort + & - ccohort%smort + ccohort%asmort) * ccohort%n + & + ccohort%smort + ccohort%asmort + ccohort%dgmort) * ccohort%n + & (ccohort%lmort_direct + ccohort%lmort_collateral + ccohort%lmort_infra) * & ccohort%n * sec_per_day * days_per_year + + ! canopy carbon starvation mortality by size x pft + hio_m3_mortality_canopy_si_scpf(io_si,scpf) = hio_m3_mortality_canopy_si_scpf(io_si,scpf)+& + ccohort%cmort * ccohort%n + hio_nplant_canopy_si_scpf(io_si,scpf) = hio_nplant_canopy_si_scpf(io_si,scpf) + ccohort%n hio_nplant_canopy_si_scls(io_si,scls) = hio_nplant_canopy_si_scls(io_si,scls) + ccohort%n + + hio_lai_canopy_si_scls(io_si,scls) = hio_lai_canopy_si_scls(io_si,scls) + & ccohort%treelai*ccohort%c_area * AREA_INV hio_sai_canopy_si_scls(io_si,scls) = hio_sai_canopy_si_scls(io_si,scls) + & ccohort%treesai*ccohort%c_area * AREA_INV hio_trimming_canopy_si_scls(io_si,scls) = hio_trimming_canopy_si_scls(io_si,scls) + & - ccohort%n * ccohort%canopy_trim + ccohort%canopy_trim * ccohort%n + hio_crown_area_canopy_si_scls(io_si,scls) = hio_crown_area_canopy_si_scls(io_si,scls) + & ccohort%c_area hio_gpp_canopy_si_scpf(io_si,scpf) = hio_gpp_canopy_si_scpf(io_si,scpf) + & @@ -2607,20 +2955,66 @@ subroutine update_history_dyn(this,nc,nsites,sites) ! sum of all mortality hio_mortality_canopy_si_scls(io_si,scls) = hio_mortality_canopy_si_scls(io_si,scls) + & - (ccohort%bmort + ccohort%hmort + ccohort%cmort + & - ccohort%frmort + ccohort%smort + ccohort%asmort) * ccohort%n + & + ccohort%frmort + ccohort%smort + ccohort%asmort + ccohort%dgmort) * ccohort%n + & (ccohort%lmort_direct + ccohort%lmort_collateral + ccohort%lmort_infra) * & ccohort%n * sec_per_day * days_per_year + hio_canopy_mortality_crownarea_si(io_si) = hio_canopy_mortality_crownarea_si(io_si) + & + (ccohort%bmort + ccohort%hmort + ccohort%cmort + & + ccohort%frmort + ccohort%smort + ccohort%asmort + ccohort%dgmort) * & + ccohort%c_area + & + (ccohort%lmort_direct + ccohort%lmort_collateral + ccohort%lmort_infra) * & + ccohort%c_area * sec_per_day * days_per_year + + + hio_m3_mortality_canopy_si_scls(io_si,scls) = hio_m3_mortality_canopy_si_scls(io_si,scls)+& + ccohort%cmort * ccohort%n + + ! damage variables - canopy + if(hlm_use_canopy_damage .eq. itrue .or. hlm_use_understory_damage .eq. itrue) then + + ! carbon starvation mortality in the canopy by size x damage x pft + hio_m3_mortality_canopy_si_cdpf(io_si,cdpf) = hio_m3_mortality_canopy_si_cdpf(io_si,cdpf)+& + ccohort%cmort * ccohort%n + ! damage mortality in the canopy by size x damage x pft + hio_m11_mortality_canopy_si_cdpf(io_si,cdpf) = hio_m11_mortality_canopy_si_cdpf(io_si,cdpf)+& + ccohort%dgmort * ccohort%n + + ! carbon starvation mortality in the canopy by size x damage + hio_m3_mortality_canopy_si_cdsc(io_si,cdsc) = hio_m3_mortality_canopy_si_cdsc(io_si,cdsc)+& + ccohort%cmort * ccohort%n + ! damage mortality in the canopy by size x damage + hio_m11_mortality_canopy_si_cdsc(io_si,cdsc) = hio_m11_mortality_canopy_si_cdsc(io_si,cdsc)+& + ccohort%dgmort * ccohort%n + + hio_mortality_canopy_si_cdpf(io_si,cdpf) = hio_mortality_canopy_si_cdpf(io_si,cdpf)+ & + (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%frmort + & + ccohort%smort + ccohort%asmort + ccohort%dgmort) * ccohort%n + & + (ccohort%lmort_direct + ccohort%lmort_collateral + ccohort%lmort_infra) * & + ccohort%n * sec_per_day * days_per_year + + ! nplants by damage + hio_nplant_canopy_si_cdpf(io_si,cdpf) = hio_nplant_canopy_si_cdpf(io_si,cdpf) + ccohort%n + hio_nplant_canopy_si_cdsc(io_si,cdsc) = hio_nplant_canopy_si_cdsc(io_si,cdsc) + ccohort%n + + ! growth rate by damage x size x pft in the canopy + hio_ddbh_canopy_si_cdpf(io_si,cdpf) = hio_ddbh_canopy_si_cdpf(io_si,cdpf) + & + ccohort%ddbhdt*ccohort%n + + end if ! end if damage + + + hio_canopy_mortality_carbonflux_si(io_si) = hio_canopy_mortality_carbonflux_si(io_si) + & (ccohort%bmort + ccohort%hmort + ccohort%cmort + & - ccohort%frmort + ccohort%smort + ccohort%asmort) * & + ccohort%frmort + ccohort%smort + ccohort%asmort + ccohort%dgmort) * & total_m * ccohort%n * g_per_kg * days_per_sec * years_per_day * ha_per_m2 + & (ccohort%lmort_direct + ccohort%lmort_collateral + ccohort%lmort_infra) * total_m * & ccohort%n * g_per_kg * ha_per_m2 - + + hio_carbon_balance_canopy_si_scls(io_si,scls) = hio_carbon_balance_canopy_si_scls(io_si,scls) + & ccohort%n * ccohort%npp_acc_hold @@ -2658,7 +3052,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_nplant_understory_si_scag(io_si,iscag) = hio_nplant_understory_si_scag(io_si,iscag) + ccohort%n hio_mortality_understory_si_scag(io_si,iscag) = hio_mortality_understory_si_scag(io_si,iscag) + & (ccohort%bmort + ccohort%hmort + ccohort%cmort + & - ccohort%frmort + ccohort%smort + ccohort%asmort) * ccohort%n + ccohort%frmort + ccohort%smort + ccohort%asmort + ccohort%dgmort) * ccohort%n hio_ddbh_understory_si_scag(io_si,iscag) = hio_ddbh_understory_si_scag(io_si,iscag) + & ccohort%ddbhdt*ccohort%n hio_bstor_understory_si_scpf(io_si,scpf) = hio_bstor_understory_si_scpf(io_si,scpf) + & @@ -2672,14 +3066,17 @@ subroutine update_history_dyn(this,nc,nsites,sites) ! (ccohort%bmort + ccohort%hmort + ccohort%cmort + ! ccohort%frmort + ccohort%smort + ccohort%asmort) * ccohort%n + ! mortality in the understory by size and by size hio_mortality_understory_si_scpf(io_si,scpf) = hio_mortality_understory_si_scpf(io_si,scpf)+ & (ccohort%bmort + ccohort%hmort + ccohort%cmort + & - ccohort%frmort + ccohort%smort + ccohort%asmort) * ccohort%n + & + ccohort%frmort + ccohort%smort + ccohort%asmort + ccohort%dgmort) * ccohort%n + & (ccohort%lmort_direct + ccohort%lmort_collateral + ccohort%lmort_infra) * & ccohort%n * sec_per_day * days_per_year + hio_nplant_understory_si_scpf(io_si,scpf) = hio_nplant_understory_si_scpf(io_si,scpf) + ccohort%n hio_nplant_understory_si_scls(io_si,scls) = hio_nplant_understory_si_scls(io_si,scls) + ccohort%n + hio_lai_understory_si_scls(io_si,scls) = hio_lai_understory_si_scls(io_si,scls) + & ccohort%treelai*ccohort%c_area * AREA_INV hio_sai_understory_si_scls(io_si,scls) = hio_sai_understory_si_scls(io_si,scls) + & @@ -2701,19 +3098,68 @@ subroutine update_history_dyn(this,nc,nsites,sites) ! sum of all mortality hio_mortality_understory_si_scls(io_si,scls) = hio_mortality_understory_si_scls(io_si,scls) + & - (ccohort%bmort + ccohort%hmort + ccohort%cmort + & - ccohort%frmort + ccohort%smort + ccohort%asmort) * ccohort%n + & + ccohort%frmort + ccohort%smort + ccohort%asmort + ccohort%dgmort) * ccohort%n + & (ccohort%lmort_direct + ccohort%lmort_collateral + ccohort%lmort_infra) * & ccohort%n * sec_per_day * days_per_year - + + hio_m3_mortality_understory_si_scls(io_si,scls) = hio_m3_mortality_understory_si_scls(io_si,scls)+& + ccohort%cmort * ccohort%n + hio_m3_mortality_understory_si_scpf(io_si,scpf) = hio_m3_mortality_understory_si_scpf(io_si,scpf)+& + ccohort%cmort * ccohort%n + + + ! damage variables - understory + if(hlm_use_canopy_damage .eq. itrue .or. hlm_use_understory_damage .eq. itrue) then + + ! carbon starvation mortality in the understory by size and by size x damage + hio_m3_mortality_understory_si_cdsc(io_si,cdsc) = hio_m3_mortality_understory_si_cdsc(io_si,cdsc)+& + ccohort%cmort * ccohort%n + + ! damage mortality in the understory by size and by size x damage + hio_m11_mortality_understory_si_cdsc(io_si,cdsc) = hio_m11_mortality_understory_si_cdsc(io_si,cdsc)+& + ccohort%dgmort * ccohort%n + + ! carbon mortality in the understory by damage x size x pft + hio_m3_mortality_understory_si_cdpf(io_si,cdpf) = hio_m3_mortality_understory_si_cdpf(io_si,cdpf)+& + ccohort%cmort * ccohort%n + + ! damage in the understory by damage x size x pft + hio_m11_mortality_understory_si_cdpf(io_si,cdpf) = hio_m11_mortality_understory_si_cdpf(io_si,cdpf)+& + ccohort%dgmort * ccohort%n + + ! total mortality of understory cohorts by damage x size x pft + hio_mortality_understory_si_cdpf(io_si,cdpf) = hio_mortality_understory_si_cdpf(io_si,cdpf)+ & + (ccohort%bmort + ccohort%hmort + ccohort%cmort + & + ccohort%frmort + ccohort%smort + ccohort%asmort + ccohort%dgmort) * ccohort%n + & + (ccohort%lmort_direct + ccohort%lmort_collateral + ccohort%lmort_infra) * & + ccohort%n * sec_per_day * days_per_year + + ! number of plants in the understory by size x damage and size x damage x pft + hio_nplant_understory_si_cdsc(io_si,cdsc) = hio_nplant_understory_si_cdsc(io_si,cdsc) + ccohort%n + hio_nplant_understory_si_cdpf(io_si,cdpf) = hio_nplant_understory_si_cdpf(io_si,cdpf) + ccohort%n + + ! growth rate by size x damage x pft - understory + hio_ddbh_understory_si_cdpf(io_si,cdpf) = hio_ddbh_understory_si_cdpf(io_si,cdpf) + & + ccohort%ddbhdt*ccohort%n + + end if ! end if damage + hio_understory_mortality_carbonflux_si(io_si) = hio_understory_mortality_carbonflux_si(io_si) + & (ccohort%bmort + ccohort%hmort + ccohort%cmort + & - ccohort%frmort + ccohort%smort + ccohort%asmort) * & + ccohort%frmort + ccohort%smort + ccohort%asmort + ccohort%dgmort) * & total_m * ccohort%n * g_per_kg * days_per_sec * years_per_day * ha_per_m2 + & (ccohort%lmort_direct + ccohort%lmort_collateral + ccohort%lmort_infra) * total_m * & ccohort%n * g_per_kg * ha_per_m2 + hio_understory_mortality_crownarea_si(io_si) = hio_understory_mortality_crownarea_si(io_si) + & + (ccohort%bmort + ccohort%hmort + ccohort%cmort + & + ccohort%frmort + ccohort%smort + ccohort%asmort + ccohort%dgmort) * & + ccohort%c_area + & + (ccohort%lmort_direct + ccohort%lmort_collateral + ccohort%lmort_infra) * & + ccohort%c_area * sec_per_day * days_per_year + + hio_carbon_balance_understory_si_scls(io_si,scls) = hio_carbon_balance_understory_si_scls(io_si,scls) + & ccohort%npp_acc_hold * ccohort%n @@ -2784,10 +3230,12 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_crownarea_si_cnlf(io_si, cnlf_indx) = hio_crownarea_si_cnlf(io_si, cnlf_indx) + & ccohort%c_area / AREA end do - + + ccohort => ccohort%taller enddo ! cohort loop - + + ! Patch specific variables that are already calculated ! These things are all duplicated. Should they all be converted to LL or array structures RF? ! define scalar to counteract the patch albedo scaling logic for conserved quantities @@ -2807,9 +3255,10 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_fire_fuel_sav_si(io_si) = hio_fire_fuel_sav_si(io_si) + cpatch%fuel_sav * cpatch%area * AREA_INV hio_fire_fuel_mef_si(io_si) = hio_fire_fuel_mef_si(io_si) + cpatch%fuel_mef * cpatch%area * AREA_INV hio_sum_fuel_si(io_si) = hio_sum_fuel_si(io_si) + cpatch%sum_fuel * g_per_kg * cpatch%area * AREA_INV - + do ilyr = 1,sites(s)%nlevsoil - hio_fragmentation_scaler_sl(io_si,ilyr) = hio_fragmentation_scaler_sl(io_si,ilyr) + cpatch%fragmentation_scaler(ilyr) * cpatch%area * AREA_INV + hio_fragmentation_scaler_sl(io_si,ilyr) = hio_fragmentation_scaler_sl(io_si,ilyr) + & + cpatch%fragmentation_scaler(ilyr) * cpatch%area * AREA_INV end do do i_fuel = 1,nfsc @@ -2856,6 +3305,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) cpatch => cpatch%younger end do !patch loop + ! divide so-far-just-summed but to-be-averaged patch-age-class variables by patch-age-class area to get mean values do ipa2 = 1, nlevage if (hio_area_si_age(io_si, ipa2) .gt. tiny) then @@ -2907,6 +3357,8 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_m4_si_scpf(io_si,i_scpf) = sites(s)%imort_rate(i_scls, i_pft) hio_m4_si_scls(io_si,i_scls) = hio_m4_si_scls(io_si,i_scls) + sites(s)%imort_rate(i_scls, i_pft) ! + + ! add imort to other mortality terms. consider imort as understory mortality even if it happens in ! cohorts that may have been promoted as part of the patch creation, and use the pre-calculated site-level ! values to avoid biasing the results by the dramatically-reduced number densities in cohorts that are subject to imort @@ -2942,6 +3394,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_mortality_understory_si_scls(io_si,i_scls) = hio_mortality_understory_si_scls(io_si,i_scls) + & sites(s)%fmort_rate_ustory(i_scls, i_pft) + ! ! carbon flux associated with mortality of trees dying by fire hio_canopy_mortality_carbonflux_si(io_si) = hio_canopy_mortality_carbonflux_si(io_si) + & @@ -2949,7 +3402,10 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_understory_mortality_carbonflux_si(io_si) = hio_understory_mortality_carbonflux_si(io_si) + & sites(s)%fmort_carbonflux_ustory - + + hio_understory_mortality_carbonflux_si(io_si) = hio_understory_mortality_carbonflux_si(io_si) + & + sites(s)%imort_carbonflux + ! ! for scag variables, also treat as happening in the newly-disurbed patch @@ -2970,10 +3426,103 @@ subroutine update_history_dyn(this,nc,nsites,sites) end do ! - ! treat carbon flux from imort the same way - hio_understory_mortality_carbonflux_si(io_si) = hio_understory_mortality_carbonflux_si(io_si) + & - sites(s)%imort_carbonflux - ! + if(hlm_use_canopy_damage .eq. itrue .or. & + hlm_use_understory_damage .eq. itrue ) then + + do i_pft = 1, numpft + do icdam = 1, ncrowndamage + do i_scls = 1,nlevsclass + + icdsc = (icdam-1)*nlevsclass + i_scls + icdpf = (icdam-1)*nlevsclass + i_scls + & + (i_pft-1) * nlevsclass * ncrowndamage + + hio_mortality_si_cdsc(io_si, icdsc) = hio_mortality_si_cdsc(io_si, icdsc) + & + (sites(s)%term_nindivs_canopy_damage(icdam, i_scls, i_pft) * days_per_year) + & + (sites(s)%term_nindivs_ustory_damage(icdam, i_scls, i_pft) * days_per_year) + & + sites(s)%imort_rate_damage(icdam, i_scls, i_pft) + & + sites(s)%fmort_rate_canopy_damage(icdam, i_scls, i_pft) + & + sites(s)%fmort_rate_ustory_damage(icdam, i_scls, i_pft) + + hio_mortality_si_cdpf(io_si, icdpf) = hio_mortality_si_cdpf(io_si, icdpf) + & + (sites(s)%term_nindivs_canopy_damage(icdam, i_scls, i_pft) * days_per_year) + & + (sites(s)%term_nindivs_ustory_damage(icdam, i_scls, i_pft) * days_per_year) + & + sites(s)%imort_rate_damage(icdam, i_scls, i_pft) + & + sites(s)%fmort_rate_canopy_damage(icdam, i_scls, i_pft) + & + sites(s)%fmort_rate_ustory_damage(icdam, i_scls, i_pft) + + hio_mortality_canopy_si_cdpf(io_si,icdpf) = hio_mortality_canopy_si_cdpf(io_si,icdpf) + & + sites(s)%term_nindivs_canopy_damage(icdam,i_scls,i_pft) * days_per_year + & + sites(s)%fmort_rate_canopy_damage(icdam, i_scls, i_pft) + + hio_mortality_understory_si_cdpf(io_si,icdpf) = hio_mortality_understory_si_cdpf(io_si,icdpf) + & + sites(s)%term_nindivs_ustory_damage(icdam, i_scls,i_pft) * days_per_year + & + sites(s)%imort_rate_damage(icdam, i_scls, i_pft) + & + sites(s)%fmort_rate_ustory_damage(icdam, i_scls, i_pft) + + + ! recovery is both canopy layers combined + imcdam = icdam + (ncrowndamage * ncrowndamage) + hio_recovery_rate_si_cdcd(io_si, imcdam) = hio_recovery_rate_si_cdcd(io_si, imcdam) + & + sites(s)%term_nindivs_canopy_damage(icdam, i_scls, i_pft) * days_per_year + & + sites(s)%term_nindivs_ustory_damage(icdam, i_scls, i_pft) * days_per_year + & + sites(s)%imort_rate_damage(icdam, i_scls, i_pft) + & + sites(s)%fmort_rate_canopy_damage(icdam, i_scls, i_pft) + & + sites(s)%fmort_rate_ustory_damage(icdam, i_scls, i_pft) + + hio_recovery_cflux_si_cdcd(io_si, imcdam) = hio_recovery_cflux_si_cdcd(io_si, imcdam) + & + sites(s)%imort_cflux_damage(icdam, i_scls) + & + sites(s)%term_cflux_canopy_damage(icdam, i_scls)*g_per_kg*days_per_sec*ha_per_m2 + & + sites(s)%term_cflux_ustory_damage(icdam, i_scls)*g_per_kg*days_per_sec*ha_per_m2 + & + sites(s)%fmort_cflux_canopy_damage(icdam, i_scls) + & + sites(s)%fmort_cflux_ustory_damage(icdam, i_scls) + + + end do + end do + end do + end if + + + ! only track damage in the canopy layer of interest + if(hlm_use_canopy_damage .eq. itrue ) then + do icdam = 1, ncrowndamage + do i_scls = 1,nlevsclass + do i_pft = 1, numpft + + imcdam = icdam + (ncrowndamage * ncrowndamage) + hio_damage_rate_si_cdcd(io_si, imcdam) = hio_damage_rate_si_cdcd(io_si, imcdam) + & + sites(s)%term_nindivs_canopy_damage(icdam, i_scls, i_pft) * days_per_year + & + sites(s)%fmort_rate_canopy_damage(icdam, i_scls, i_pft) + + hio_damage_cflux_si_cdcd(io_si, imcdam) = hio_damage_cflux_si_cdcd(io_si, imcdam) + & + sites(s)%term_cflux_canopy_damage(icdam, i_scls)*g_per_kg*days_per_sec*ha_per_m2 + & + sites(s)%fmort_cflux_canopy_damage(icdam, i_scls)*g_per_kg*days_per_sec*ha_per_m2 + end do + end do + end do + end if + + if(hlm_use_understory_damage .eq. itrue ) then + do icdam = 1, ncrowndamage + do i_scls = 1,nlevsclass + do i_pft = 1,numpft + + imcdam = icdam + (ncrowndamage * ncrowndamage) + hio_damage_rate_si_cdcd(io_si, imcdam) = hio_damage_rate_si_cdcd(io_si, imcdam) + & + sites(s)%term_nindivs_ustory_damage(icdam, i_scls, i_pft) * days_per_year + & + sites(s)%imort_rate_damage(icdam, i_scls, i_pft) + & + sites(s)%fmort_rate_ustory_damage(icdam, i_scls, i_pft) + + hio_damage_cflux_si_cdcd(io_si, imcdam) = hio_damage_cflux_si_cdcd(io_si, imcdam) + & + sites(s)%imort_cflux_damage(icdam, i_scls) + & + sites(s)%term_cflux_ustory_damage(icdam, i_scls)*g_per_kg*days_per_sec*ha_per_m2 + & + sites(s)%fmort_cflux_canopy_damage(icdam, i_scls) + end do + end do + end do + end if + sites(s)%term_nindivs_canopy(:,:) = 0._r8 sites(s)%term_nindivs_ustory(:,:) = 0._r8 sites(s)%imort_carbonflux = 0._r8 @@ -2986,12 +3535,30 @@ subroutine update_history_dyn(this,nc,nsites,sites) sites(s)%fmort_rate_crown(:,:) = 0._r8 sites(s)%growthflux_fusion(:,:) = 0._r8 + sites(s)%imort_rate_damage(:,:,:) = 0.0_r8 + sites(s)%term_nindivs_canopy_damage(:,:,:) = 0.0_r8 + sites(s)%term_nindivs_ustory_damage(:,:,:) = 0.0_r8 + sites(s)%imort_cflux_damage(:,:) = 0._r8 + sites(s)%term_cflux_canopy_damage(:,:) = 0._r8 + sites(s)%term_cflux_ustory_damage(:,:) = 0._r8 + sites(s)%fmort_rate_canopy_damage(:,:,:) = 0._r8 + sites(s)%fmort_rate_ustory_damage(:,:,:) = 0._r8 + sites(s)%fmort_cflux_canopy_damage(:,:) = 0._r8 + sites(s)%fmort_cflux_ustory_damage(:,:) = 0._r8 + sites(s)%damage_rate(:,:) = 0.0_r8 + sites(s)%damage_cflux(:,:) = 0.0_r8 + sites(s)%recovery_rate(:,:) = 0.0_r8 + sites(s)%recovery_cflux(:,:) = 0.0_r8 + sites(s)%crownarea_canopy_damage = 0._r8 + sites(s)%crownarea_ustory_damage = 0._r8 + + ! pass the recruitment rate as a flux to the history, and then reset the recruitment buffer do i_pft = 1, numpft hio_recruitment_si_pft(io_si,i_pft) = sites(s)%recruitment_rate(i_pft) * days_per_year end do sites(s)%recruitment_rate(:) = 0._r8 - + ! summarize all of the mortality fluxes by PFT do i_pft = 1, numpft do i_scls = 1,nlevsclass @@ -3007,11 +3574,12 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_m7_si_scpf(io_si,i_scpf) + & hio_m8_si_scpf(io_si,i_scpf) + & hio_m9_si_scpf(io_si,i_scpf) + & - hio_m10_si_scpf(io_si,i_scpf) + hio_m10_si_scpf(io_si,i_scpf) + & + hio_m11_si_scpf(io_si,i_scpf) end do end do - + ! ------------------------------------------------------------------------------ ! Some carbon only litter diagnostics (legacy) ! ------------------------------------------------------------------------------ @@ -3101,7 +3669,17 @@ subroutine update_history_dyn(this,nc,nsites,sites) this%hvars(ih_cefflux_si)%r81d(io_si) = & sum(sites(s)%flux_diags(el)%nutrient_efflux_scpf(:),dim=1) - + + if(hlm_use_canopy_damage .eq. itrue .or. hlm_use_understory_damage .eq. itrue)then + this%hvars(ih_totvegc_cdpf)%r82d(io_si,:) = 0._r8 + this%hvars(ih_leafc_cdpf)%r82d(io_si,:) = 0._r8 + this%hvars(ih_fnrtc_cdpf)%r82d(io_si,:) = 0._r8 + this%hvars(ih_sapwc_cdpf)%r82d(io_si,:) = 0._r8 + this%hvars(ih_storec_cdpf)%r82d(io_si,:) = 0._r8 + this%hvars(ih_reproc_cdpf)%r82d(io_si,:) = 0._r8 + end if + + elseif(element_list(el).eq.nitrogen_element)then this%hvars(ih_totvegn_scpf)%r82d(io_si,:) = 0._r8 @@ -3285,7 +3863,42 @@ subroutine update_history_dyn(this,nc,nsites,sites) ccohort => ccohort%shorter end do - + + if(hlm_use_canopy_damage .eq. itrue .or. hlm_use_understory_damage .eq. itrue) then + ! Load Mass States + ccohort => cpatch%tallest + do while(associated(ccohort)) + + sapw_m = ccohort%prt%GetState(sapw_organ, element_list(el)) + struct_m = ccohort%prt%GetState(struct_organ, element_list(el)) + leaf_m = ccohort%prt%GetState(leaf_organ, element_list(el)) + fnrt_m = ccohort%prt%GetState(fnrt_organ, element_list(el)) + store_m = ccohort%prt%GetState(store_organ, element_list(el)) + repro_m = ccohort%prt%GetState(repro_organ, element_list(el)) + total_m = sapw_m+struct_m+leaf_m+fnrt_m+store_m+repro_m + + icdpf = get_cdamagesizepft_class_index(ccohort%dbh, ccohort%crowndamage, ccohort%pft) + + if(element_list(el).eq.carbon12_element)then + this%hvars(ih_totvegc_cdpf)%r82d(io_si,icdpf) = & + this%hvars(ih_totvegc_cdpf)%r82d(io_si,icdpf) + total_m * ccohort%n + this%hvars(ih_leafc_cdpf)%r82d(io_si,icdpf) = & + this%hvars(ih_leafc_cdpf)%r82d(io_si,icdpf) + leaf_m * ccohort%n + this%hvars(ih_fnrtc_cdpf)%r82d(io_si,icdpf) = & + this%hvars(ih_fnrtc_cdpf)%r82d(io_si,icdpf) + fnrt_m * ccohort%n + this%hvars(ih_sapwc_cdpf)%r82d(io_si,icdpf) = & + this%hvars(ih_sapwc_cdpf)%r82d(io_si,icdpf) + sapw_m * ccohort%n + this%hvars(ih_storec_cdpf)%r82d(io_si,icdpf) = & + this%hvars(ih_storec_cdpf)%r82d(io_si,icdpf) + store_m * ccohort%n + this%hvars(ih_reproc_cdpf)%r82d(io_si,icdpf) = & + this%hvars(ih_reproc_cdpf)%r82d(io_si,icdpf) + repro_m * ccohort%n + end if + + ccohort => ccohort%shorter + end do + end if + + cpatch => cpatch%younger end do @@ -3348,23 +3961,44 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_demotion_rate_si_scls(io_si,i_scls) = sites(s)%demotion_rate(i_scls) * days_per_year hio_promotion_rate_si_scls(io_si,i_scls) = sites(s)%promotion_rate(i_scls) * days_per_year end do + ! ! convert kg C / ha / day to gc / m2 / sec hio_demotion_carbonflux_si(io_si) = sites(s)%demotion_carbonflux * g_per_kg * ha_per_m2 * days_per_sec hio_promotion_carbonflux_si(io_si) = sites(s)%promotion_carbonflux * g_per_kg * ha_per_m2 * days_per_sec ! + + + ! mortality-associated carbon fluxes hio_canopy_mortality_carbonflux_si(io_si) = hio_canopy_mortality_carbonflux_si(io_si) + & sites(s)%term_carbonflux_canopy * g_per_kg * days_per_sec * ha_per_m2 - + hio_understory_mortality_carbonflux_si(io_si) = hio_understory_mortality_carbonflux_si(io_si) + & sites(s)%term_carbonflux_ustory * g_per_kg * days_per_sec * ha_per_m2 + ! add site level mortality counting to crownarea diagnostic + hio_canopy_mortality_crownarea_si(io_si) = hio_canopy_mortality_crownarea_si(io_si) + & + sites(s)%fmort_crownarea_canopy + & + sites(s)%term_crownarea_canopy * days_per_year + + hio_understory_mortality_crownarea_si(io_si) = hio_understory_mortality_crownarea_si(io_si) + & + sites(s)%fmort_crownarea_ustory + & + sites(s)%term_crownarea_ustory * days_per_year + & + sites(s)%imort_crownarea + + ! and zero the site-level termination carbon flux variable sites(s)%term_carbonflux_canopy = 0._r8 sites(s)%term_carbonflux_ustory = 0._r8 + sites(s)%term_crownarea_canopy = 0._r8 + sites(s)%term_crownarea_ustory = 0._r8 + sites(s)%imort_crownarea = 0._r8 + sites(s)%fmort_crownarea_ustory = 0._r8 + sites(s)%fmort_crownarea_canopy = 0._r8 ! + ! add the site-level disturbance-associated cwd and litter input fluxes to thir respective flux fields @@ -4218,6 +4852,8 @@ subroutine define_history_vars(this, initialize_variables) use FatesIOVariableKindMod, only : site_fuel_r8, site_cwdsc_r8, site_scag_r8 use FatesIOVariableKindMod, only : site_can_r8, site_cnlf_r8, site_cnlfpft_r8 + use FatesIOVariableKindMod, only : site_cdsc_r8, site_cdpf_r8 + use FatesIOVariableKindMod, only : site_cdcd_r8 use FatesIOVariableKindMod, only : site_scagpft_r8, site_agepft_r8 use FatesIOVariableKindMod, only : site_elem_r8, site_elpft_r8 use FatesIOVariableKindMod, only : site_elcwd_r8, site_elage_r8 @@ -5194,6 +5830,16 @@ subroutine define_history_vars(this, initialize_variables) long='flux of biomass carbon from live to dead pools from mortality of understory plants',use_default='active',& avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_understory_mortality_carbonflux_si ) + + call this%set_history_var(vname='MORTALITY_CROWNAREA_CANOPY', units = 'm2/ha/year', & + long='Crown area of canopy trees that died', use_default='active', & + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_canopy_mortality_crownarea_si ) + + call this%set_history_var(vname='MORTALITY_CROWNAREA_UNDERSTORY', units = 'm2/ha/year', & + long='Crown aera of understory trees that died',use_default='active',& + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_understory_mortality_crownarea_si ) ! size class by age dimensioned variables call this%set_history_var(vname='NPLANT_SCAG',units = 'plants/ha', & @@ -5433,6 +6079,11 @@ subroutine define_history_vars(this, initialize_variables) long='age senescence mortality by pft/size',use_default='inactive', & avgflag='A', vtype =site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m10_si_scpf ) + + call this%set_history_var(vname='M11_SCPF', units = 'N/ha/yr', & + long='damage mortality by pft/size',use_default='inactive', & + avgflag='A', vtype =site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m11_si_scpf ) call this%set_history_var(vname='M10_CAPF',units='N/ha/yr', & long='age senescence mortality by pft/cohort age',use_default='inactive', & @@ -5444,6 +6095,11 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_mortality_canopy_si_scpf ) + call this%set_history_var(vname='M3_MORTALITY_CANOPY_SCPF', units = 'N/ha/yr', & + long='C starvation mortality of canopy plants by pft/size', use_default='inactive', & + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m3_mortality_canopy_si_scpf ) + call this%set_history_var(vname='C13disc_SCPF', units = 'per mil', & long='C13 discrimination by pft/size',use_default='inactive', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & @@ -5469,6 +6125,12 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_mortality_understory_si_scpf ) + call this%set_history_var(vname='M3_MORTALITY_UNDERSTORY_SCPF', units = 'N/ha/yr', & + long='C starvation mortality of understory plants by pft/size', use_default='inactive', & + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m3_mortality_understory_si_scpf ) + + call this%set_history_var(vname='BSTOR_UNDERSTORY_SCPF', units = 'kgC/ha', & long='biomass carbon in storage pools of understory plants by pft/size', use_default='inactive', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & @@ -5618,6 +6280,13 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_mortality_canopy_si_scls ) + call this%set_history_var(vname='M3_MORTALITY_CANOPY_SCLS', units = 'indiv/ha/yr', & + long='C starviation mortality of canopy trees by size class', use_default='active', & + avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m3_mortality_canopy_si_scls ) + + + call this%set_history_var(vname='NPLANT_UNDERSTORY_SCLS', units = 'indiv/ha', & long='number of understory plants by size class', use_default='active', & avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & @@ -5682,7 +6351,7 @@ subroutine define_history_vars(this, initialize_variables) long='freezing mortality by size',use_default='active', & avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m8_si_scls ) - + call this%set_history_var(vname='M9_SCLS', units = 'N/ha/yr', & long='senescence mortality by size',use_default='active', & avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & @@ -5693,6 +6362,11 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m10_si_scls ) + call this%set_history_var(vname='M11_SCLS', units = 'N/ha/yr', & + long='damage mortality by size',use_default='active', & + avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m11_si_scls ) + call this%set_history_var(vname='M10_CACLS', units = 'N/ha/yr', & long='age senescence mortality by cohort age',use_default='active', & avgflag='A', vtype=site_coage_r8, hlms='CLM:ALM', flushval=0.0_r8, & @@ -5713,6 +6387,11 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_mortality_understory_si_scls ) + call this%set_history_var(vname='M3_MORTALITY_UNDERSTORY_SCLS', units = 'indiv/ha/yr', & + long='C starvation mortality of understory trees by size class', use_default='active', & + avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m3_mortality_understory_si_scls ) + call this%set_history_var(vname='TRIMMING_CANOPY_SCLS', units = 'indiv/ha', & long='trimming term of canopy plants by size class', use_default='inactive', & avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & @@ -5934,6 +6613,203 @@ subroutine define_history_vars(this, initialize_variables) upfreq=2, ivar=ivar, initialize=initialize_variables, index = ih_resp_m_understory_si_scls ) + ! CROWN DAMAGE VARIABLES + + call this%set_history_var(vname='DAMAGE_CFLUX_CDCD', units = 'g C / m2 / sec', & + long='damage carbonflux between damage classes', use_default='inactive', & + avgflag='A', vtype=site_cdcd_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_damage_cflux_si_cdcd ) + + call this%set_history_var(vname='DAMAGE_RATE_CDCD', units = 'N / ha / year', & + long='damage rate between damage classes', use_default='inactive', & + avgflag='A', vtype=site_cdcd_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_damage_rate_si_cdcd ) + + call this%set_history_var(vname='RECOVERY_CFLUX_CDCD', units = 'g C / m2 / sec', & + long='recovery carbonflux between damage classes', use_default='inactive', & + avgflag='A', vtype=site_cdcd_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_recovery_cflux_si_cdcd ) + + call this%set_history_var(vname='RECOVERY_RATE_CDCD', units = 'N / ha / year', & + long='recovery rate between damage classes', use_default='inactive', & + avgflag='A', vtype=site_cdcd_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_recovery_rate_si_cdcd ) + + call this%set_history_var(vname='CROWNAREA_CANOPY_DAMAGE', units = 'm2 / ha / year', & + long='crownarea lost to damage each year', use_default='inactive', & + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_crownarea_canopy_damage_si ) + + call this%set_history_var(vname='CROWNAREA_USTORY_DAMAGE', units = 'm2 / ha / year', & + long='crownarea lost to damage each year', use_default='inactive', & + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_crownarea_ustory_damage_si ) + + call this%set_history_var(vname='NPLANT_CDSC', units = 'N / damage x size class / ha / yr', & + long='N. plants per damage x size class', use_default='inactive', & + avgflag='A', vtype=site_cdsc_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_nplant_si_cdsc ) + + call this%set_history_var(vname='NPLANT_CDPF', units = 'N / damage x size x pft class / ha / yr', & + long='N. plants per damage x size x pft class', use_default='inactive', & + avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_nplant_si_cdpf ) + + call this%set_history_var(vname='NPLANT_CANOPY_CDSC', units = 'N / damage x size class / ha / yr', & + long='N. plants in the canopy per damage x size class', use_default='inactive', & + avgflag='A', vtype=site_cdsc_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_nplant_canopy_si_cdsc ) + + call this%set_history_var(vname='NPLANT_CANOPY_CDPF', units = 'N / damage x size x pft class / ha / yr', & + long='N. plants per damage x size x pft class', use_default='inactive', & + avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_nplant_canopy_si_cdpf ) + + call this%set_history_var(vname='NPLANT_UNDERSTORY_CDSC', units = 'N / damage x size class / ha / yr', & + long='N. plants in the understory per damage x size class', use_default='inactive', & + avgflag='A', vtype=site_cdsc_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_nplant_understory_si_cdsc ) + + call this%set_history_var(vname='NPLANT_UNDERSTORY_CDPF', units = 'N / damage x size x pft class / ha / yr', & + long='N. plants in the understory per damage x size x pft class', use_default='inactive', & + avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_nplant_understory_si_cdpf ) + + call this%set_history_var(vname='M3_CDPF', units = 'N/ha/yr', & + long='carbon starvation mortality by damaage/pft/size', use_default='inactive', & + avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m3_si_cdpf ) + + call this%set_history_var(vname='M3_CDSC', units = 'N/ha/yr', & + long='carbon starvation mortality by damage/size', use_default='inactive', & + avgflag='A', vtype=site_cdsc_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m3_si_cdsc ) + + call this%set_history_var(vname='M11_CDPF', units = 'N/ha/yr', & + long='damage mortality by damaage/pft/size', use_default='inactive', & + avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m11_si_cdpf ) + + call this%set_history_var(vname='M11_CDSC', units = 'N/ha/yr', & + long='damage mortality by damage/size', use_default='inactive', & + avgflag='A', vtype=site_cdsc_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m11_si_cdsc ) + + call this%set_history_var(vname='MORTALITY_CDSC', units = 'N/ha/yr', & + long='mortality by damage class by size', use_default='inactive', & + avgflag='A', vtype=site_cdsc_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_mortality_si_cdsc ) + + call this%set_history_var(vname='MORTALITY_CDPF', units = 'N/ha/yr', & + long='mortality by damage class by size by pft', use_default='inactive', & + avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_mortality_si_cdpf ) + + call this%set_history_var(vname='M3_MORTALITY_CANOPY_CDSC', units = 'indiv/ha/yr', & + long='C starviation mortality of canopy trees by damage/size class', use_default='inactive', & + avgflag='A', vtype=site_cdsc_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m3_mortality_canopy_si_cdsc) + + call this%set_history_var(vname='M3_MORTALITY_CANOPY_CDPF', units = 'N/ha/yr', & + long='C starvation mortality of canopy plants by damage/pft/size', use_default='inactive', & + avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m3_mortality_canopy_si_cdpf ) + + call this%set_history_var(vname='M3_MORTALITY_UNDERSTORY_CDPF', units = 'N/ha/yr', & + long='C starvation mortality of understory plants by pft/size', use_default='inactive', & + avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m3_mortality_understory_si_cdpf ) + + call this%set_history_var(vname='M3_MORTALITY_UNDERSTORY_CDSC', units = 'indiv/ha/yr', & + long='C starvation mortality of understory trees by damage/size class', use_default='inactive', & + avgflag='A', vtype=site_cdsc_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m3_mortality_understory_si_cdsc) + + call this%set_history_var(vname='M11_MORTALITY_CANOPY_CDSC', units = 'indiv/ha/yr', & + long='damage mortality of canopy trees by damage/size class', use_default='inactive', & + avgflag='A', vtype=site_cdsc_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m11_mortality_canopy_si_cdsc) + + call this%set_history_var(vname='M11_MORTALITY_CANOPY_CDPF', units = 'N/ha/yr', & + long='damage mortality of canopy plants by damage/pft/size', use_default='inactive', & + avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m11_mortality_canopy_si_cdpf ) + + call this%set_history_var(vname='M11_MORTALITY_UNDERSTORY_CDPF', units = 'N/ha/yr', & + long='damage mortality of understory plants by pft/size', use_default='inactive', & + avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m11_mortality_understory_si_cdpf ) + + call this%set_history_var(vname='MORTALITY_CANOPY_CDPF', units = 'N/ha/yr', & + long='mortality of canopy plants by damage/pft/size', use_default='inactive', & + avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_mortality_canopy_si_cdpf ) + + call this%set_history_var(vname='MORTALITY_UNDERSTORY_CDPF', units = 'N/ha/yr', & + long='mortality of understory plants by pft/size', use_default='inactive', & + avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_mortality_understory_si_cdpf ) + + call this%set_history_var(vname='M11_MORTALITY_UNDERSTORY_CDSC', units = 'indiv/ha/yr', & + long='damage mortality of understory trees by damage/size class', use_default='inactive', & + avgflag='A', vtype=site_cdsc_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m11_mortality_understory_si_cdsc) + + call this%set_history_var(vname='TRIMMING_DAMAGE_CDSC', units = 'indiv/ha', & + long='trimming term of plants by size class by damage class', use_default='inactive', & + avgflag='A', vtype=site_cdsc_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_trimming_damage_si_cdsc ) + + call this%set_history_var(vname='DDBH_CDSC', units = 'cm/year/ha', & + long='ddbh annual increment growth by damage and size', use_default='inactive', & + avgflag='A', vtype=site_cdsc_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_ddbh_si_cdsc ) + + call this%set_history_var(vname='DDBH_CDPF', units = 'cm/year/ha', & + long='ddbh annual increment growth by damage x size pft', use_default='inactive', & + avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_ddbh_si_cdpf ) + + call this%set_history_var(vname='DDBH_CANOPY_CDPF', units = 'cm/year/ha', & + long='ddbh annual canopy increment growth by damage x size pft', use_default='inactive', & + avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_ddbh_canopy_si_cdpf ) + + call this%set_history_var(vname='DDBH_UNDERSTORY_CDPF', units = 'cm/year/ha', & + long='ddbh annual understory increment growth by damage x size pft', use_default='inactive', & + avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_ddbh_understory_si_cdpf ) + + call this%set_history_var(vname='TOTVEGC_CDPF', units='kgC/ha', & + long='total vegetation carbon mass in live plants by damage x size-class x pft', use_default='inactive', & + avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_totvegc_cdpf ) + + call this%set_history_var(vname='LEAFC_CDPF', units='kgC/ha', & + long='leaf carbon mass by damage x size-class x pft', use_default='inactive', & + avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_leafc_cdpf ) + + call this%set_history_var(vname='FNRTC_CDPF', units='kgC/ha', & + long='fine-root carbon mass by damage x size-class x pft', use_default='inactive', & + avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_fnrtc_cdpf ) + + call this%set_history_var(vname='SAPWC_CDPF', units='kgC/ha', & + long='sapwood carbon mass by damage x size-class x pft', use_default='inactive', & + avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_sapwc_cdpf ) + + call this%set_history_var(vname='STOREC_CDPF', units='kgC/ha', & + long='storage carbon mass by damage x size-class x pft', use_default='inactive', & + avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_storec_cdpf ) + + call this%set_history_var(vname='REPROC_CDPF', units='kgC/ha', & + long='reproductive carbon mass (on plant) by damage x size-class x pft', use_default='inactive', & + avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_reproc_cdpf ) + ! CARBON BALANCE VARIABLES THAT DEPEND ON HLM BGC INPUTS call this%set_history_var(vname='NEP', units='gC/m^2/s', & diff --git a/main/FatesHistoryVariableType.F90 b/main/FatesHistoryVariableType.F90 index 6457e644f1..ee8aa9d858 100644 --- a/main/FatesHistoryVariableType.F90 +++ b/main/FatesHistoryVariableType.F90 @@ -12,6 +12,8 @@ module FatesHistoryVariableType use FatesIOVariableKindMod, only : site_fuel_r8, site_cwdsc_r8, site_scag_r8 use FatesIOVariableKindMod, only : site_scagpft_r8, site_agepft_r8 use FatesIOVariableKindMod, only : site_can_r8, site_cnlf_r8, site_cnlfpft_r8 + use FatesIOVariableKindMod, only : site_cdamage_r8, site_cdsc_r8, site_cdpf_r8 + use FatesIOVariableKindMod, only : site_cdcd_r8 use FatesIOVariableKindMod, only : site_elem_r8, site_elpft_r8 use FatesIOVariableKindMod, only : site_elcwd_r8, site_elage_r8 use FatesIOVariableKindMod, only : iotype_index, site_agefuel_r8 @@ -173,6 +175,22 @@ subroutine Init(this, vname, units, long, use_default, & allocate(this%r82d(lb1:ub1, lb2:ub2)) this%r82d(:,:) = flushval + case(site_cdamage_r8) + allocate(this%r82d(lb1:ub1, lb2:ub2)) + this%r82d(:,:) = flushval + + case(site_cdcd_r8) + allocate(this%r82d(lb1:ub1, lb2:ub2)) + this%r82d(:,:) = flushval + + case(site_cdsc_r8) + allocate(this%r82d(lb1:ub1, lb2:ub2)) + this%r82d(:,:) = flushval + + case(site_cdpf_r8) + allocate(this%r82d(lb1:ub1, lb2:ub2)) + this%r82d(:,:) = flushval + case(site_scag_r8) allocate(this%r82d(lb1:ub1, lb2:ub2)) this%r82d(:,:) = flushval @@ -316,6 +334,14 @@ subroutine Flush(this, thread, dim_bounds, dim_kinds) this%r82d(lb1:ub1, lb2:ub2) = this%flushval case(site_cnlfpft_r8) this%r82d(lb1:ub1, lb2:ub2) = this%flushval + case(site_cdamage_r8) + this%r82d(lb1:ub1, lb2:ub2) = this%flushval + case(site_cdcd_r8) + this%r82d(lb1:ub1, lb2:ub2) = this%flushval + case(site_cdsc_r8) + this%r82d(lb1:ub1, lb2:ub2) = this%flushval + case(site_cdpf_r8) + this%r82d(lb1:ub1, lb2:ub2) = this%flushval case(site_scag_r8) this%r82d(lb1:ub1, lb2:ub2) = this%flushval case(site_scagpft_r8) diff --git a/main/FatesIODimensionsMod.F90 b/main/FatesIODimensionsMod.F90 index 522da97653..58cb898632 100644 --- a/main/FatesIODimensionsMod.F90 +++ b/main/FatesIODimensionsMod.F90 @@ -27,8 +27,10 @@ module FatesIODimensionsMod character(*), parameter, public :: levcan = 'fates_levcan' ! matches histFileMod character(*), parameter, public :: levcnlf = 'fates_levcnlf' ! matches histFileMod character(*), parameter, public :: levcnlfpft = 'fates_levcnlfpf' ! matches histFileMod + character(*), parameter, public :: levcdcd = 'fates_levcdcd' ! matches histFileMod + character(*), parameter, public :: levcdsc = 'fates_levcdsc' ! matches histFileMod + character(*), parameter, public :: levcdpf = 'fates_levcdpf' ! matches histFileMod character(*), parameter, public :: levagefuel = 'fates_levagefuel' ! matches histFileMod - character(*), parameter, public :: levelem = 'fates_levelem' character(*), parameter, public :: levelpft = 'fates_levelpft' character(*), parameter, public :: levelcwd = 'fates_levelcwd' @@ -81,6 +83,15 @@ module FatesIODimensionsMod ! levcnlfpft = This is a structure that records the boundaries for the ! number of canopy layer x leaf layer x pft dimension + ! levcdcd = This is a structure that records the boundaries for the + ! number of crown damage x crown damage classes - for diagnostic fluxes + + ! levcdsc = This is a structure that records the boundaries for the + ! number of crown damage x size classes dimension + + ! levcdpf = This is a structure that records the boundaries for the + ! number of crown damage x size classes x pft dimension + ! levscag = This is a strcture that records the boundaries for the ! number of size-classes x patch age @@ -138,6 +149,14 @@ module FatesIODimensionsMod integer :: cnlf_end integer :: cnlfpft_begin integer :: cnlfpft_end + integer :: cdamage_begin + integer :: cdamage_end + integer :: cdcd_begin + integer :: cdcd_end + integer :: cdsc_begin + integer :: cdsc_end + integer :: cdpf_begin + integer :: cdpf_end integer :: elem_begin integer :: elem_end integer :: elpft_begin diff --git a/main/FatesIOVariableKindMod.F90 b/main/FatesIOVariableKindMod.F90 index 93b34ebab3..06f6c421ea 100644 --- a/main/FatesIOVariableKindMod.F90 +++ b/main/FatesIOVariableKindMod.F90 @@ -31,6 +31,10 @@ module FatesIOVariableKindMod character(*), parameter, public :: site_can_r8 = 'SI_CAN_R8' character(*), parameter, public :: site_cnlf_r8 = 'SI_CNLF_R8' character(*), parameter, public :: site_cnlfpft_r8 = 'SI_CNLFPFT_R8' + character(*), parameter, public :: site_cdamage_r8 = 'SI_CDAMAGE_R8' + character(*), parameter, public :: site_cdcd_r8 = 'SI_CDCD_R8' + character(*), parameter, public :: site_cdpf_r8 = 'SI_CDPF_R8' + character(*), parameter, public :: site_cdsc_r8 = 'SI_CDSC_R8' character(*), parameter, public :: site_scag_r8 = 'SI_SCAG_R8' character(*), parameter, public :: site_scagpft_r8 = 'SI_SCAGPFT_R8' character(*), parameter, public :: site_agepft_r8 = 'SI_AGEPFT_R8' diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 5561a78f52..61798dc7d6 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -40,6 +40,7 @@ module FatesInterfaceMod use EDParamsMod , only : ED_val_history_ageclass_bin_edges use EDParamsMod , only : ED_val_history_height_bin_edges use EDParamsMod , only : ED_val_history_coageclass_bin_edges + use EDParamsMod , only : ED_val_ncrowndamage use CLMFatesParamInterfaceMod , only : FatesReadParameters use EDTypesMod , only : p_uptake_mode use EDTypesMod , only : n_uptake_mode @@ -135,7 +136,7 @@ module FatesInterfaceMod public :: zero_bcs public :: set_bcs -contains + contains ! ==================================================================================== subroutine FatesInterfaceInit(log_unit,global_verbose) @@ -711,10 +712,14 @@ subroutine SetFatesGlobalElements(use_fates) ! ! -------------------------------------------------------------------------------- + use EDParamsMod, only : ED_val_ncrowndamage + implicit none + logical,intent(in) :: use_fates ! Is fates turned on? + integer :: i if (use_fates) then @@ -753,6 +758,10 @@ subroutine SetFatesGlobalElements(use_fates) nleafage = size(prt_params%leaf_long,dim=2) end if + ! Identify the number of damage classes + ncrowndamage = ED_val_ncrowndamage + + ! These values are used to define the restart file allocations and general structure ! of memory for the cohort arrays @@ -804,6 +813,7 @@ subroutine SetFatesGlobalElements(use_fates) nlevheight = size(ED_val_history_height_bin_edges,dim=1) nlevcoage = size(ED_val_history_coageclass_bin_edges,dim=1) + ! do some checks on the size, age, and height bin arrays to make sure they make sense: ! make sure that all start at zero, and that both are monotonically increasing if ( ED_val_history_sizeclass_bin_edges(1) .ne. 0._r8 ) then @@ -931,6 +941,7 @@ subroutine fates_history_maps use EDTypesMod, only : NFSC use EDTypesMod, only : nclmax + use FatesInterfaceTypesMod, only : ncrowndamage use EDTypesMod, only : nlevleaf use EDParamsMod, only : ED_val_history_sizeclass_bin_edges use EDParamsMod, only : ED_val_history_ageclass_bin_edges @@ -951,6 +962,8 @@ subroutine fates_history_maps integer :: icwd integer :: ifuel integer :: ican + integer :: icdam + integer :: icdcd integer :: ileaf integer :: iage integer :: iheight @@ -969,6 +982,15 @@ subroutine fates_history_maps allocate( fates_hdim_pfmap_levcapf(1:nlevcoage*numpft)) allocate( fates_hdim_camap_levcapf(1:nlevcoage*numpft)) + allocate( fates_hdim_levcdam(ncrowndamage )) + allocate( fates_hdim_cdimap_levcdcd(ncrowndamage*(ncrowndamage+1))) + allocate( fates_hdim_cdjmap_levcdcd(ncrowndamage*(ncrowndamage+1))) + allocate( fates_hdim_scmap_levcdsc(nlevsclass*ncrowndamage)) + allocate( fates_hdim_cdmap_levcdsc(nlevsclass*ncrowndamage)) + allocate( fates_hdim_scmap_levcdpf(nlevsclass*ncrowndamage * numpft)) + allocate( fates_hdim_cdmap_levcdpf(nlevsclass*ncrowndamage * numpft)) + allocate( fates_hdim_pftmap_levcdpf(nlevsclass*ncrowndamage * numpft)) + allocate( fates_hdim_levcan(nclmax)) allocate( fates_hdim_levelem(num_elements)) allocate( fates_hdim_canmap_levcnlf(nlevleaf*nclmax)) @@ -1020,6 +1042,12 @@ subroutine fates_history_maps fates_hdim_levcan(ican) = ican end do + ! make damage array + do icdam = 1,ncrowndamage + fates_hdim_levcdam(icdam) = icdam + end do + + ! Make an element array, each index is the PARTEH global identifier index do iel = 1, num_elements @@ -1090,6 +1118,25 @@ subroutine fates_history_maps end do end do + i=0 + do icdam=1,ncrowndamage + do isc=1,nlevsclass + i=i+1 + fates_hdim_scmap_levcdsc(i) = isc + fates_hdim_cdmap_levcdsc(i) = icdam + end do + end do + + i=0 + do icdam=1,ncrowndamage + do icdcd=1,ncrowndamage+1 + i=i+1 + fates_hdim_cdimap_levcdcd(i) = icdcd + fates_hdim_cdjmap_levcdcd(i) = icdam + end do + end do + + i=0 do ipft=1,numpft do ican=1,nclmax @@ -1114,6 +1161,18 @@ subroutine fates_history_maps end do end do + i=0 + do ipft=1,numpft + do icdam=1,ncrowndamage + do isc=1,nlevsclass + i=i+1 + fates_hdim_scmap_levcdpf(i) = isc + fates_hdim_cdmap_levcdpf(i) = icdam + fates_hdim_pftmap_levcdpf(i) = ipft + end do + end do + end do + i=0 do ipft=1,numpft do iage=1,nlevage @@ -1239,6 +1298,8 @@ subroutine set_fates_ctrlparms(tag,ival,rval,cval) hlm_use_lu_harvest = unset_int hlm_num_lu_harvest_cats = unset_int hlm_use_cohort_age_tracking = unset_int + hlm_use_understory_damage = unset_int + hlm_use_canopy_damage = unset_int hlm_use_logging = unset_int hlm_use_ed_st3 = unset_int hlm_use_ed_prescribed_phys = unset_int @@ -1551,6 +1612,20 @@ subroutine set_fates_ctrlparms(tag,ival,rval,cval) call endrun(msg=errMsg(sourcefile, __LINE__)) end if + if(hlm_use_understory_damage .eq. unset_int) then + if (fates_global_verbose()) then + write(fates_log(), *) 'switch for understory damage unset: hlm_use_understory_damage, exiting' + end if + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + if(hlm_use_canopy_damage .eq. unset_int) then + if (fates_global_verbose()) then + write(fates_log(), *) 'switch for canopy damage unset: hlm_use_canopy_damage, exiting' + end if + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + if(hlm_use_sp.eq.itrue.and.hlm_use_nocomp.eq.ifalse)then write(fates_log(), *) 'SP cannot be on if nocomp mode is off. Exiting. ' call endrun(msg=errMsg(sourcefile, __LINE__)) @@ -1723,6 +1798,18 @@ subroutine set_fates_ctrlparms(tag,ival,rval,cval) if (fates_global_verbose()) then write(fates_log(),*) 'Transfering hlm_use_cohort_age_tracking= ',ival,' to FATES' end if + + case('use_understory_damage') + hlm_use_understory_damage = ival + if (fates_global_verbose()) then + write(fates_log(),*) 'Transfering hlm_use_understory_damage= ',ival,' to FATES' + end if + + case('use_canopy_damage') + hlm_use_canopy_damage = ival + if (fates_global_verbose()) then + write(fates_log(),*) 'Transfering hlm_use_canopy_damage= ',ival,' to FATES' + end if case('use_logging') hlm_use_logging = ival diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 1fe7c2fa26..b53e891ad1 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -150,6 +150,14 @@ module FatesInterfaceTypesMod integer, public :: hlm_use_cohort_age_tracking ! This flag signals whether or not to use ! cohort age tracking. 1 = TRUE, 0 = FALSE + + integer, public :: hlm_use_canopy_damage ! This flag signals whether or not to use + ! the canopy damage module. 1 = TRUE, 0 = FALSE + + integer, public :: hlm_use_understory_damage ! This flag signals whether or not to use + ! understory damage. 1 = TRUE, 0 = FALSE + + integer, public :: hlm_use_ed_st3 ! This flag signals whether or not to use ! (ST)atic (ST)and (ST)ructure mode (ST3) ! Essentially, this gives us the ability @@ -231,6 +239,15 @@ module FatesInterfaceTypesMod real(r8), public, allocatable :: fates_hdim_levsclass(:) ! plant size class lower bound dimension integer , public, allocatable :: fates_hdim_pfmap_levscpf(:) ! map of pfts into size-class x pft dimension integer , public, allocatable :: fates_hdim_scmap_levscpf(:) ! map of size-class into size-class x pft dimension + integer , public, allocatable :: fates_hdim_levcdam(:) ! crown damage dimension + integer , public, allocatable :: fates_hdim_pftmap_levcdpf(:) ! map of pfts into size x crowndamage x pft dimension + integer , public, allocatable :: fates_hdim_cdmap_levcdpf(:) ! map of crowndamage into size x crowndamage x pft + integer , public, allocatable :: fates_hdim_scmap_levcdpf(:) ! map of size into size x crowndamage x pft + integer , public, allocatable :: fates_hdim_cdmap_levcdsc(:) ! map of crowndamage into size x crowndamage + integer , public, allocatable :: fates_hdim_scmap_levcdsc(:) ! map of size into size x crowndamage + integer , public, allocatable :: fates_hdim_cdimap_levcdcd(:) ! map of current damage into damage x damage + mortality + integer , public, allocatable :: fates_hdim_cdjmap_levcdcd(:) ! map of new damage into damage x damage + mortality + real(r8), public, allocatable :: fates_hdim_levage(:) ! patch age lower bound dimension real(r8), public, allocatable :: fates_hdim_levheight(:) ! height lower bound dimension integer , public, allocatable :: fates_hdim_levpft(:) ! plant pft dimension @@ -296,7 +313,8 @@ module FatesInterfaceTypesMod integer, public :: nlevheight ! The total number of height bins output to history integer, public :: nlevcoage ! The total number of cohort age bins output to history integer, public :: nleafage ! The total number of leaf age classes - + integer, public :: ncrowndamage ! The total number of damage classes + ! ------------------------------------------------------------------------------------- ! Structured Boundary Conditions (SITE/PATCH SCALE) ! For floating point arrays, it is sometimes the convention to define the arrays as diff --git a/main/FatesInventoryInitMod.F90 b/main/FatesInventoryInitMod.F90 index 19596a833e..0080a2ec05 100644 --- a/main/FatesInventoryInitMod.F90 +++ b/main/FatesInventoryInitMod.F90 @@ -1015,29 +1015,31 @@ subroutine set_inventory_edcohort_type1(csite,bc_in,css_file_unit,npatches, & temp_cohort%n = c_nplant * cpatch%area / real(ncohorts_to_create,r8) temp_cohort%dbh = c_dbh + temp_cohort%crowndamage = 1 ! assume undamaged call h_allom(c_dbh,temp_cohort%pft,temp_cohort%hite) temp_cohort%canopy_trim = 1.0_r8 - - call bagw_allom(temp_cohort%dbh,temp_cohort%pft,c_agw) + call bagw_allom(temp_cohort%dbh,temp_cohort%pft, & + temp_cohort%crowndamage, temp_cohort%branch_frac, c_agw) ! Calculate coarse root biomass from allometry call bbgw_allom(temp_cohort%dbh,temp_cohort%pft,c_bgw) ! Calculate the leaf biomass (calculates a maximum first, then applies canopy trim ! and sla scaling factors) - call bleaf(temp_cohort%dbh,temp_cohort%pft,temp_cohort%canopy_trim,c_leaf) - + call bleaf(temp_cohort%dbh,temp_cohort%pft,1,& + temp_cohort%canopy_trim,c_leaf) + ! Calculate fine root biomass call bfineroot(temp_cohort%dbh,temp_cohort%pft,temp_cohort%canopy_trim,c_fnrt) ! Calculate sapwood biomass - call bsap_allom(temp_cohort%dbh,temp_cohort%pft,temp_cohort%canopy_trim, a_sapw, c_sapw) - + call bsap_allom(temp_cohort%dbh,temp_cohort%pft,1, 1.0_r8,temp_cohort%canopy_trim, a_sapw, c_sapw) + call bdead_allom( c_agw, c_bgw, c_sapw, temp_cohort%pft, c_struct ) - - call bstore_allom(temp_cohort%dbh, temp_cohort%pft, temp_cohort%canopy_trim, c_store) - + + call bstore_allom(temp_cohort%dbh, temp_cohort%pft, 1, temp_cohort%canopy_trim, c_store) + temp_cohort%laimemory = 0._r8 temp_cohort%sapwmemory = 0._r8 temp_cohort%structmemory = 0._r8 @@ -1156,14 +1158,11 @@ subroutine set_inventory_edcohort_type1(csite,bc_in,css_file_unit,npatches, & call prt_obj%CheckInitialConditions() - - ! Since spread is a canopy level calculation, we need to provide an initial guess here. - call create_cohort(csite, cpatch, temp_cohort%pft, temp_cohort%n, temp_cohort%hite, & temp_cohort%coage, temp_cohort%dbh, & prt_obj, temp_cohort%laimemory,temp_cohort%sapwmemory, temp_cohort%structmemory, & - cstatus, rstatus, temp_cohort%canopy_trim,temp_cohort%c_area, & - 1, csite%spread, bc_in) + cstatus, rstatus, temp_cohort%canopy_trim, temp_cohort%c_area, & + 1, temp_cohort%crowndamage, temp_cohort%branch_frac, csite%spread, bc_in) deallocate(temp_cohort) ! get rid of temporary cohort diff --git a/main/FatesParameterDerivedMod.F90 b/main/FatesParameterDerivedMod.F90 index 66445c1906..1857dfdffe 100644 --- a/main/FatesParameterDerivedMod.F90 +++ b/main/FatesParameterDerivedMod.F90 @@ -13,6 +13,8 @@ module FatesParameterDerivedMod use FatesConstantsMod, only : umolC_to_kgC use FatesConstantsMod, only : g_per_kg use FatesInterfaceTypesMod, only : nleafage + use FatesInterfaceTypesMod, only : ncrowndamage + use FatesGlobals , only : fates_log implicit none private @@ -25,17 +27,27 @@ module FatesParameterDerivedMod ! rate at 25C (umol CO2/m**2/s) real(r8), allocatable :: kp25top(:,:) ! canopy top: initial slope of CO2 response ! curve (C4 plants) at 25C + + real(r8), allocatable :: branch_frac(:) ! fraction of aboveground biomass in branches (as + ! oppose to stems) - for use in damage allometries + + real(r8), allocatable :: damage_transitions(:,:,:) ! matrix of transition probabilities between + ! damage classes - one per PFT + contains procedure :: Init + procedure :: InitDamageTransitions procedure :: InitAllocate + procedure :: InitAllocateDamageTransitions end type param_derived_type type(param_derived_type), public :: param_derived -contains - +contains + + ! =================================================================================== subroutine InitAllocate(this,numpft) class(param_derived_type), intent(inout) :: this @@ -44,23 +56,43 @@ subroutine InitAllocate(this,numpft) allocate(this%jmax25top(numpft,nleafage)) allocate(this%tpu25top(numpft,nleafage)) allocate(this%kp25top(numpft,nleafage)) + + allocate(this%branch_frac(numpft)) + return end subroutine InitAllocate ! ===================================================================================== - + + ! =================================================================================== + subroutine InitAllocateDamageTransitions(this,ncrowndamage, numpft) + + class(param_derived_type), intent(inout) :: this + integer, intent(in) :: ncrowndamage + integer, intent(in) :: numpft + + allocate(this%damage_transitions(ncrowndamage,ncrowndamage, numpft)) + + return + end subroutine InitAllocateDamageTransitions + + ! ===================================================================================== + subroutine Init(this,numpft) use EDPftvarcon, only: EDPftvarcon_inst - + use SFParamsMod, only: SF_val_CWD_frac + use FatesLitterMod, only : ncwd + class(param_derived_type), intent(inout) :: this integer, intent(in) :: numpft ! local variables integer :: ft ! pft index integer :: iage ! leaf age class index - + integer :: c ! cwd index + associate( vcmax25top => EDPftvarcon_inst%vcmax25top ) call this%InitAllocate(numpft) @@ -85,11 +117,61 @@ subroutine Init(this,numpft) this%kp25top(ft,iage) = 20000._r8 * vcmax25top(ft,iage) end do + + ! Allocate fraction of biomass in branches + this%branch_frac(ft) = sum(SF_val_CWD_frac(1:3)) - end do !ft + end do !ft end associate return end subroutine Init +!========================================================================= + + subroutine InitDamageTransitions(this, ncrowndamage, numpft) + + use EDPftvarcon, only: EDPftvarcon_inst + + + class(param_derived_type), intent(inout) :: this + integer, intent(in) :: ncrowndamage + integer, intent(in) :: numpft + + ! local variables + integer :: ft ! pft index + integer :: i ! crowndamage index + real(r8) :: damage_frac ! damage fraction + + + call this%InitAllocateDamageTransitions(ncrowndamage, numpft) + + do ft = 1, numpft + + damage_frac = EDPftvarcon_inst%damage_frac(ft) + + do i = 1, ncrowndamage + + ! zero the column + this%damage_transitions(i,:,ft) = 0._r8 + ! 1 - damage rate stay the same + this%damage_transitions(i,i,ft) = 1.0_r8 - damage_frac + + if(i < ncrowndamage) then + ! fraction damaged get evenly split between higher damage classes + this%damage_transitions(i,i+1:ncrowndamage,ft) = damage_frac/(ncrowndamage - i) + end if + ! Make sure it sums to one - they have to go somewhere + this%damage_transitions(i, :, ft) = this%damage_transitions(i, :, ft)/SUM(this%damage_transitions(i, :, ft)) + end do + + write(fates_log(),'(a/,5(F12.6,1x))') 'annual transition matrix : ', this%damage_transitions(:,:,ft) + end do + + + + + return + end subroutine InitDamageTransitions + end module FatesParameterDerivedMod diff --git a/main/FatesParametersInterface.F90 b/main/FatesParametersInterface.F90 index f69d4ef5bf..f37b63b93c 100644 --- a/main/FatesParametersInterface.F90 +++ b/main/FatesParametersInterface.F90 @@ -31,6 +31,7 @@ module FatesParametersInterface character(len=*), parameter, public :: dimension_name_hydr_organs = 'fates_hydr_organs' character(len=*), parameter, public :: dimension_name_prt_organs = 'fates_prt_organs' character(len=*), parameter, public :: dimension_name_leaf_age = 'fates_leafage_class' + character(len=*), parameter, public :: dimension_name_damage = 'fates_damage_class' character(len=*), parameter, public :: dimension_name_history_size_bins = 'fates_history_size_bins' character(len=*), parameter, public :: dimension_name_history_age_bins = 'fates_history_age_bins' character(len=*), parameter, public :: dimension_name_history_height_bins = 'fates_history_height_bins' diff --git a/main/FatesRestartInterfaceMod.F90 b/main/FatesRestartInterfaceMod.F90 index 5fe3b267a1..e8a0469d1d 100644 --- a/main/FatesRestartInterfaceMod.F90 +++ b/main/FatesRestartInterfaceMod.F90 @@ -33,6 +33,7 @@ module FatesRestartInterfaceMod use EDCohortDynamicsMod, only : InitPRTBoundaryConditions use FatesPlantHydraulicsMod, only : InitHydrCohort use FatesInterfaceTypesMod, only : nlevsclass + use FatesInterfaceTypesMod, only : ncrowndamage use FatesLitterMod, only : litter_type use FatesLitterMod, only : ncwd use FatesLitterMod, only : ndcmpy @@ -93,6 +94,7 @@ module FatesRestartInterfaceMod integer :: ir_ncohort_pa integer :: ir_canopy_layer_co integer :: ir_canopy_layer_yesterday_co + integer :: ir_crowndamage_co integer :: ir_canopy_trim_co integer :: ir_size_class_lasttimestep_co integer :: ir_dbh_co @@ -116,6 +118,7 @@ module FatesRestartInterfaceMod integer :: ir_frmort_co integer :: ir_smort_co integer :: ir_asmort_co + integer :: ir_dgmort_co integer :: ir_c_area_co integer :: ir_treelai_co integer :: ir_treesai_co @@ -198,11 +201,16 @@ module FatesRestartInterfaceMod integer :: ir_promrate_sisc integer :: ir_termcflux_cano_si integer :: ir_termcflux_usto_si + integer :: ir_termcarea_cano_si + integer :: ir_termcarea_usto_si integer :: ir_democflux_si integer :: ir_promcflux_si integer :: ir_imortcflux_si + integer :: ir_imortcarea_si integer :: ir_fmortcflux_cano_si integer :: ir_fmortcflux_usto_si + integer :: ir_fmortcarea_cano_si + integer :: ir_fmortcarea_usto_si integer :: ir_cwdagin_flxdg integer :: ir_cwdbgin_flxdg integer :: ir_leaflittin_flxdg @@ -213,6 +221,25 @@ module FatesRestartInterfaceMod integer :: ir_errfates_mbal integer :: ir_prt_base ! Base index for all PRT variables + ! Damage x damage or damage x size + integer :: ir_imortrate_sicdpf + integer :: ir_termnindiv_cano_sicdpf + integer :: ir_termnindiv_usto_sicdpf + integer :: ir_fmortrate_cano_sicdpf + integer :: ir_fmortrate_usto_sicdpf + integer :: ir_imortcflux_sicdsc + integer :: ir_termcflux_cano_sicdsc + integer :: ir_termcflux_usto_sicdsc + integer :: ir_fmortcflux_cano_sicdsc + integer :: ir_fmortcflux_usto_sicdsc + integer :: ir_damage_cflux_sicd + integer :: ir_damage_rate_sicd + integer :: ir_recovery_cflux_sicd + integer :: ir_recovery_rate_sicd + integer :: ir_crownarea_cano_si + integer :: ir_crownarea_usto_si + + ! Hydraulic indices integer :: ir_hydro_th_ag_covec integer :: ir_hydro_th_troot @@ -671,7 +698,6 @@ subroutine define_restart_vars(this, initialize_variables) long_name='fates cohort - seed production', units='kgC/plant', flushval = flushinvalid, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_seed_prod_co ) - call this%set_restart_var(vname='fates_canopy_layer', vtype=cohort_int, & long_name='ed cohort - canopy_layer', units='unitless', flushval = flushinvalid, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_canopy_layer_co ) @@ -680,6 +706,10 @@ subroutine define_restart_vars(this, initialize_variables) long_name='ed cohort - canopy_layer_yesterday', units='unitless', flushval = flushzero, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_canopy_layer_yesterday_co ) + call this%set_restart_var(vname='fates_crowndamage', vtype=cohort_int, & + long_name='ed cohort - crowndamage class', units='unitless', flushval = flushinvalid, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_crowndamage_co ) + call this%set_restart_var(vname='fates_canopy_trim', vtype=cohort_r8, & long_name='ed cohort - canopy_trim', units='fraction', flushval = flushzero, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_canopy_trim_co ) @@ -835,6 +865,11 @@ subroutine define_restart_vars(this, initialize_variables) units = '/year', flushval = flushzero, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_asmort_co ) + call this%set_restart_var(vname='fates_dgmort', vtype=cohort_r8, & + long_name='ed cohort - damage mortality rate', & + units = '/year', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_dgmort_co ) + call this%set_restart_var(vname='fates_lmort_direct', vtype=cohort_r8, & long_name='ed cohort - directly logging mortality rate', & units='%/event', flushval = flushzero, & @@ -1165,7 +1200,6 @@ subroutine define_restart_vars(this, initialize_variables) units='0/1', flushval = flushzero, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_area_pft_sift) - call this%set_restart_var(vname='fates_fmortrate_canopy', vtype=cohort_r8, & long_name='fates diagnostics on fire mortality canopy', & units='indiv/ha/year', flushval = flushzero, & @@ -1180,7 +1214,7 @@ subroutine define_restart_vars(this, initialize_variables) long_name='fates diagnostics on impact mortality', & units='indiv/ha/year', flushval = flushzero, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_imortrate_siscpf) - + call this%set_restart_var(vname='fates_fmortrate_crown', vtype=cohort_r8, & long_name='fates diagnostics on crown fire mortality', & units='indiv/ha/year', flushval = flushzero, & @@ -1220,8 +1254,13 @@ subroutine define_restart_vars(this, initialize_variables) long_name='biomass of indivs killed due to impact mort', & units='kgC/ha/day', flushval = flushzero, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_imortcflux_si) + + call this%set_restart_var(vname='fates_imortcarea', vtype=site_r8, & + long_name='crownarea of indivs killed due to impact mort', & + units='m2/ha/day', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_imortcarea_si) - call this%set_restart_var(vname='fates_fmortcflux_canopy', vtype=site_r8, & + call this%set_restart_var(vname='fates_fmortcflux_canopy', vtype=site_r8, & long_name='fates diagnostic biomass of canopy fire', & units='gC/m2/sec', flushval = flushzero, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_fmortcflux_cano_si) @@ -1251,6 +1290,106 @@ subroutine define_restart_vars(this, initialize_variables) units='', flushval = flushzero, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_promcflux_si ) + call this%set_restart_var(vname='fates_fmortcarea_canopy', vtype=site_r8, & + long_name='fates diagnostic crownarea of canopy fire', & + units='m2/sec', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_fmortcarea_cano_si) + + call this%set_restart_var(vname='fates_fmortcarea_ustory', vtype=site_r8, & + long_name='fates diagnostic crownarea of understory fire', & + units='m2/sec', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_fmortcarea_usto_si) + + call this%set_restart_var(vname='fates_termcarea_canopy', vtype=site_r8, & + long_name='fates diagnostic term crownarea canopy', & + units='', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_termcarea_cano_si ) + + call this%set_restart_var(vname='fates_termcarea_ustory', vtype=site_r8, & + long_name='fates diagnostic term crownarea understory', & + units='', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_termcarea_usto_si ) + + ! Damage variables + call this%set_restart_var(vname='fates_imortrate_dam', vtype=cohort_r8, & + long_name='fates diagnostics on impact mortality by damage class', & + units='indiv/ha/year', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_imortrate_sicdpf) + + call this%set_restart_var(vname='fates_termn_cano_dam', vtype=cohort_r8, & + long_name='fates diagnostics on termination mortality by damage class -canopy', & + units='indiv/ha/year', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_termnindiv_cano_sicdpf) + + call this%set_restart_var(vname='fates_termn_usto_dam', vtype=cohort_r8, & + long_name='fates diagnostics on termination mortality by damage class -understory', & + units='indiv/ha/year', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_termnindiv_usto_sicdpf) + + call this%set_restart_var(vname='fates_fmortrate_cano_dam', vtype=cohort_r8, & + long_name='fates diagnostics on fire mortality by damage class', & + units='indiv/ha/year', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_fmortrate_cano_sicdpf) + + call this%set_restart_var(vname='fates_fmortrate_usto_dam', vtype=cohort_r8, & + long_name='fates diagnostics on fire mortality by damage class', & + units='indiv/ha/year', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_fmortrate_usto_sicdpf) + + call this%set_restart_var(vname='fates_imortcflux_dam', vtype=cohort_r8, & + long_name='biomass of indivs killed due to impact mort by damage class', & + units='kgC/ha/day', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_imortcflux_sicdsc) + + call this%set_restart_var(vname='fates_termcflux_cano_dam', vtype=cohort_r8, & + long_name='biomass of indivs killed due to termination mort by damage class', & + units='kgC/ha/day', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_termcflux_cano_sicdsc) + + call this%set_restart_var(vname='fates_termcflux_usto_dam', vtype=cohort_r8, & + long_name='biomass of indivs killed due to termination mort by damage class', & + units='kgC/ha/day', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_termcflux_usto_sicdsc) + + call this%set_restart_var(vname='fates_fmortcflux_cano_dam', vtype=cohort_r8, & + long_name='biomass of indivs killed due to fire mort by damage class', & + units='kgC/ha/day', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_fmortcflux_cano_sicdsc) + + call this%set_restart_var(vname='fates_fmortcflux_usto_dam', vtype=cohort_r8, & + long_name='biomass of indivs killed due to fire mort by damage class', & + units='kgC/ha/day', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_fmortcflux_usto_sicdsc) + + call this%set_restart_var(vname='fates_damage_cflux', vtype=cohort_r8, & + long_name='fates diagnostic rate of damage carbonflux', & + units='kgC/ha/day', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_damage_cflux_sicd) + + call this%set_restart_var(vname='fates_damage_rate', vtype=cohort_r8, & + long_name='fates diagnostic rate of damage transitions', & + units='indiv / ha/ day', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_damage_rate_sicd) + + call this%set_restart_var(vname='fates_recovery_cflux', vtype=cohort_r8, & + long_name='fates diagnostic rate of recovery carbonflux', & + units='kgC/ha/day', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_recovery_cflux_sicd) + + call this%set_restart_var(vname='fates_recovery_rate', vtype=cohort_r8, & + long_name='fates diagnostic rate of recovery transitions', & + units='indiv / ha/ day', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_recovery_rate_sicd) + + call this%set_restart_var(vname='fates_crownarea_canopy_damage', vtype=site_r8, & + long_name='fates area lost from damage each year', & + units='m2/ha/year', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_crownarea_cano_si) + + call this%set_restart_var(vname='fates_crownarea_understory_damage', vtype=site_r8, & + long_name='fates area lost from damage each year', & + units='m2/ha/year', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_crownarea_usto_si) @@ -1565,6 +1704,8 @@ end subroutine set_restart_var subroutine set_restart_vectors(this,nc,nsites,sites) + use FatesInterfaceTypesMod, only : hlm_use_canopy_damage + use FatesInterfaceTypesMod, only : hlm_use_understory_damage use FatesInterfaceTypesMod, only : fates_maxElementsPerPatch use FatesInterfaceTypesMod, only : numpft use EDTypesMod, only : ed_site_type @@ -1574,6 +1715,7 @@ subroutine set_restart_vectors(this,nc,nsites,sites) use EDTypesMod, only : nclmax use EDTypesMod, only : numWaterMem use EDTypesMod, only : num_vegtemp_mem + use FatesInterfaceTypesMod, only : ncrowndamage ! Arguments class(fates_restart_interface_type) :: this @@ -1608,6 +1750,9 @@ subroutine set_restart_vectors(this,nc,nsites,sites) integer :: io_idx_si_sc ! each size-class index within site integer :: io_idx_si_capf ! each cohort age-class x pft index within site integer :: io_idx_si_cacls ! each cohort age class index within site + integer :: io_idx_si_cdsc ! each damage-class x size class within site + integer :: io_idx_si_cdpf ! each damage-class x size x pft within site + integer :: io_idx_si_cdcd ! each damage x damage within site (plus mortality) integer :: io_idx_si_cwd ! each site-cwd index integer :: io_idx_si_pft ! each site-pft index integer :: io_idx_si_vtmem ! indices for veg-temp memory at site @@ -1631,7 +1776,10 @@ subroutine set_restart_vectors(this,nc,nsites,sites) integer :: i_cacls ! loop counter for cohort age class integer :: i_cwd ! loop counter for cwd integer :: i_pft ! loop counter for pft - + integer :: i_cdam ! loop counter for damage + integer :: icdi ! loop counter for damage + integer :: icdj ! loop counter for damage + type(fates_restart_variable_type) :: rvar type(ed_patch_type),pointer :: cpatch type(ed_cohort_type),pointer :: ccohort @@ -1655,6 +1803,7 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_solar_zenith_angle_pa => this%rvars(ir_solar_zenith_angle_pa)%r81d, & rio_canopy_layer_co => this%rvars(ir_canopy_layer_co)%int1d, & rio_canopy_layer_yesterday_co => this%rvars(ir_canopy_layer_yesterday_co)%r81d, & + rio_crowndamage_co => this%rvars(ir_crowndamage_co)%int1d, & rio_canopy_trim_co => this%rvars(ir_canopy_trim_co)%r81d, & rio_seed_prod_co => this%rvars(ir_seed_prod_co)%r81d, & rio_size_class_lasttimestep => this%rvars(ir_size_class_lasttimestep_co)%int1d, & @@ -1688,6 +1837,7 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_daily_p_need_co => this%rvars(ir_daily_p_need_co)%r81d, & rio_smort_co => this%rvars(ir_smort_co)%r81d, & rio_asmort_co => this%rvars(ir_asmort_co)%r81d, & + rio_dgmort_co => this%rvars(ir_dgmort_co)%r81d, & rio_frmort_co => this%rvars(ir_frmort_co)%r81d, & rio_lmort_direct_co => this%rvars(ir_lmort_direct_co)%r81d, & rio_lmort_collateral_co => this%rvars(ir_lmort_collateral_co)%r81d, & @@ -1723,13 +1873,35 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_promrate_sisc => this%rvars(ir_promrate_sisc)%r81d, & rio_termcflux_cano_si => this%rvars(ir_termcflux_cano_si)%r81d, & rio_termcflux_usto_si => this%rvars(ir_termcflux_usto_si)%r81d, & + rio_termcarea_cano_si => this%rvars(ir_termcarea_cano_si)%r81d, & + rio_termcarea_usto_si => this%rvars(ir_termcarea_usto_si)%r81d, & rio_democflux_si => this%rvars(ir_democflux_si)%r81d, & rio_promcflux_si => this%rvars(ir_promcflux_si)%r81d, & rio_imortcflux_si => this%rvars(ir_imortcflux_si)%r81d, & rio_fmortcflux_cano_si => this%rvars(ir_fmortcflux_cano_si)%r81d, & - rio_fmortcflux_usto_si => this%rvars(ir_fmortcflux_usto_si)%r81d) - - + rio_fmortcflux_usto_si => this%rvars(ir_fmortcflux_usto_si)%r81d, & + rio_imortcarea_si => this%rvars(ir_imortcarea_si)%r81d, & + rio_fmortcarea_cano_si => this%rvars(ir_fmortcarea_cano_si)%r81d, & + rio_fmortcarea_usto_si => this%rvars(ir_fmortcarea_usto_si)%r81d, & + + ! damage + rio_imortrate_sicdpf => this%rvars(ir_imortrate_sicdpf)%r81d, & + rio_imortcflux_sicdsc => this%rvars(ir_imortcflux_sicdsc)%r81d, & + rio_termcflux_cano_sicdsc => this%rvars(ir_termcflux_cano_sicdsc)%r81d, & + rio_termnindiv_cano_sicdpf => this%rvars(ir_termnindiv_cano_sicdpf)%r81d, & + rio_termcflux_usto_sicdsc => this%rvars(ir_termcflux_usto_sicdsc)%r81d, & + rio_termnindiv_usto_sicdpf => this%rvars(ir_termnindiv_usto_sicdpf)%r81d, & + rio_fmortrate_cano_sicdpf => this%rvars(ir_fmortrate_cano_sicdpf)%r81d, & + rio_fmortrate_usto_sicdpf => this%rvars(ir_fmortrate_usto_sicdpf)%r81d, & + rio_fmortcflux_cano_sicdsc => this%rvars(ir_fmortcflux_cano_sicdsc)%r81d, & + rio_fmortcflux_usto_sicdsc => this%rvars(ir_fmortcflux_usto_sicdsc)%r81d, & + rio_damage_cflux_sicd => this%rvars(ir_damage_cflux_sicd)%r81d, & + rio_damage_rate_sicd => this%rvars(ir_damage_rate_sicd)%r81d, & + rio_recovery_cflux_sicd => this%rvars(ir_recovery_cflux_sicd)%r81d, & + rio_recovery_rate_sicd => this%rvars(ir_recovery_rate_sicd)%r81d, & + rio_crownarea_cano_damage_si=> this%rvars(ir_crownarea_cano_si)%r81d, & + rio_crownarea_usto_damage_si=> this%rvars(ir_crownarea_usto_si)%r81d) + totalCohorts = 0 ! --------------------------------------------------------------------------------- @@ -1759,6 +1931,9 @@ subroutine set_restart_vectors(this,nc,nsites,sites) io_idx_si_sc = io_idx_co_1st io_idx_si_capf = io_idx_co_1st io_idx_si_cacls= io_idx_co_1st + io_idx_si_cdcd = io_idx_co_1st + io_idx_si_cdsc = io_idx_co_1st + io_idx_si_cdpf = io_idx_co_1st ! recruitment rate do i_pft = 1,numpft @@ -1884,6 +2059,7 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_canopy_layer_co(io_idx_co) = ccohort%canopy_layer rio_canopy_layer_yesterday_co(io_idx_co) = ccohort%canopy_layer_yesterday + rio_crowndamage_co(io_idx_co) = ccohort%crowndamage rio_canopy_trim_co(io_idx_co) = ccohort%canopy_trim rio_seed_prod_co(io_idx_co) = ccohort%seed_prod rio_size_class_lasttimestep(io_idx_co) = ccohort%size_class_lasttimestep @@ -1910,7 +2086,8 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_cmort_co(io_idx_co) = ccohort%cmort rio_smort_co(io_idx_co) = ccohort%smort rio_asmort_co(io_idx_co) = ccohort%asmort - rio_frmort_co(io_idx_co) = ccohort%frmort + rio_dgmort_co(io_idx_co) = ccohort%dgmort + rio_frmort_co(io_idx_co) = ccohort%frmort ! Nutrient uptake/efflux rio_daily_no3_uptake_co(io_idx_co) = ccohort%daily_no3_uptake @@ -2104,14 +2281,65 @@ subroutine set_restart_vectors(this,nc,nsites,sites) io_idx_si_sc = io_idx_si_sc + 1 end do + ! this only copies live portions of transitions - but that's ok because the mortality + ! bit only needs to be added for history outputs + if(hlm_use_canopy_damage .eq. itrue .or. hlm_use_understory_damage .eq. itrue) then + do icdi = 1,ncrowndamage + do icdj = 1,ncrowndamage+1 + + rio_damage_cflux_sicd(io_idx_si_cdcd) = & + sites(s)%damage_cflux(icdi,icdj) + rio_damage_rate_sicd(io_idx_si_cdcd) = & + sites(s)%damage_rate(icdi,icdj) + + rio_recovery_cflux_sicd(io_idx_si_cdcd) = & + sites(s)%recovery_cflux(icdi,icdj) + rio_recovery_rate_sicd(io_idx_si_cdcd) = & + sites(s)%recovery_rate(icdi,icdj) + + io_idx_si_cdcd = io_idx_si_cdcd + 1 + + end do + end do + + do i_scls = 1, nlevsclass + do i_cdam = 1, ncrowndamage + do i_pft = 1, numpft + rio_imortrate_sicdpf(io_idx_si_cdpf) = sites(s)%imort_rate_damage(i_cdam, i_scls, i_pft) + rio_termnindiv_cano_sicdpf(io_idx_si_cdpf) = sites(s)%term_nindivs_canopy_damage(i_cdam,i_scls,i_pft) + rio_termnindiv_usto_sicdpf(io_idx_si_cdpf) = sites(s)%term_nindivs_ustory_damage(i_cdam,i_scls,i_pft) + rio_imortcflux_sicdsc(io_idx_si_cdsc) = sites(s)%imort_cflux_damage(i_cdam, i_scls) + rio_termcflux_cano_sicdsc(io_idx_si_cdsc) = sites(s)%term_cflux_canopy_damage(i_cdam, i_scls) + rio_termcflux_usto_sicdsc(io_idx_si_cdsc) = sites(s)%term_cflux_ustory_damage(i_cdam, i_scls) + rio_fmortrate_cano_sicdpf(io_idx_si_cdpf) = sites(s)%fmort_rate_canopy_damage(i_cdam, i_scls, i_pft) + rio_fmortrate_usto_sicdpf(io_idx_si_cdpf) = sites(s)%fmort_rate_ustory_damage(i_cdam, i_scls, i_pft) + rio_fmortcflux_cano_sicdsc(io_idx_si_cdsc) = sites(s)%fmort_cflux_canopy_damage(i_cdam, i_scls) + rio_fmortcflux_usto_sicdsc(io_idx_si_cdsc) = sites(s)%fmort_cflux_ustory_damage(i_cdam, i_scls) + io_idx_si_cdsc = io_idx_si_cdsc + 1 + io_idx_si_cdpf = io_idx_si_cdpf + 1 + end do + end do + end do + + rio_crownarea_cano_damage_si(io_idx_si) = sites(s)%crownarea_canopy_damage + rio_crownarea_usto_damage_si(io_idx_si) = sites(s)%crownarea_ustory_damage + + end if + rio_termcflux_cano_si(io_idx_si) = sites(s)%term_carbonflux_canopy rio_termcflux_usto_si(io_idx_si) = sites(s)%term_carbonflux_ustory + rio_termcarea_cano_si(io_idx_si) = sites(s)%term_crownarea_canopy + rio_termcarea_usto_si(io_idx_si) = sites(s)%term_crownarea_ustory rio_democflux_si(io_idx_si) = sites(s)%demotion_carbonflux rio_promcflux_si(io_idx_si) = sites(s)%promotion_carbonflux rio_imortcflux_si(io_idx_si) = sites(s)%imort_carbonflux + rio_imortcarea_si(io_idx_si) = sites(s)%imort_crownarea rio_fmortcflux_cano_si(io_idx_si) = sites(s)%fmort_carbonflux_canopy rio_fmortcflux_usto_si(io_idx_si) = sites(s)%fmort_carbonflux_ustory + rio_fmortcarea_cano_si(io_idx_si) = sites(s)%fmort_crownarea_canopy + rio_fmortcarea_usto_si(io_idx_si) = sites(s)%fmort_crownarea_ustory + rio_cd_status_si(io_idx_si) = sites(s)%cstatus rio_dd_status_si(io_idx_si) = sites(s)%dstatus rio_nchill_days_si(io_idx_si) = sites(s)%nchilldays @@ -2391,7 +2619,10 @@ subroutine get_restart_vectors(this, nc, nsites, sites) use EDTypesMod, only : numWaterMem use EDTypesMod, only : num_vegtemp_mem use FatesSizeAgeTypeIndicesMod, only : get_age_class_index - + use FatesInterfaceTypesMod, only : hlm_use_canopy_damage + use FatesInterfaceTypesMod, only : hlm_use_understory_damage + + ! !ARGUMENTS: class(fates_restart_interface_type) , intent(inout) :: this integer , intent(in) :: nc @@ -2432,8 +2663,12 @@ subroutine get_restart_vectors(this, nc, nsites, sites) integer :: io_idx_si_sc ! each size-class index within site integer :: io_idx_si_cacls ! each coage class index within site integer :: io_idx_si_capf ! each cohort age class x pft index within site + integer :: io_idx_si_cdcd ! each damage x damage class within site + mortality integer :: io_idx_si_cwd integer :: io_idx_si_pft + integer :: io_idx_si_cdsc ! each damage x size class within site + integer :: io_idx_si_cdpf ! damage x size x pft within site + integer :: io_idx_pa_ncl ! each canopy layer within each patch ! Some counters (for checking mostly) @@ -2451,6 +2686,9 @@ subroutine get_restart_vectors(this, nc, nsites, sites) integer :: i_pft ! loop counter for pft integer :: i_scls ! loop counter for size-clas integer :: i_cacls ! loop counter for cohort age class + integer :: i_cdam ! loop counter for damage class + integer :: icdj ! loop counter for damage class + integer :: icdi ! loop counter for damage class associate( rio_npatch_si => this%rvars(ir_npatch_si)%int1d, & rio_cd_status_si => this%rvars(ir_cd_status_si)%int1d, & @@ -2470,6 +2708,7 @@ subroutine get_restart_vectors(this, nc, nsites, sites) rio_solar_zenith_angle_pa => this%rvars(ir_solar_zenith_angle_pa)%r81d, & rio_canopy_layer_co => this%rvars(ir_canopy_layer_co)%int1d, & rio_canopy_layer_yesterday_co => this%rvars(ir_canopy_layer_yesterday_co)%r81d, & + rio_crowndamage_co => this%rvars(ir_crowndamage_co)%int1d, & rio_canopy_trim_co => this%rvars(ir_canopy_trim_co)%r81d, & rio_seed_prod_co => this%rvars(ir_seed_prod_co)%r81d, & rio_size_class_lasttimestep => this%rvars(ir_size_class_lasttimestep_co)%int1d, & @@ -2503,6 +2742,7 @@ subroutine get_restart_vectors(this, nc, nsites, sites) rio_daily_p_need_co => this%rvars(ir_daily_p_need_co)%r81d, & rio_smort_co => this%rvars(ir_smort_co)%r81d, & rio_asmort_co => this%rvars(ir_asmort_co)%r81d, & + rio_dgmort_co => this%rvars(ir_dgmort_co)%r81d, & rio_frmort_co => this%rvars(ir_frmort_co)%r81d, & rio_lmort_direct_co => this%rvars(ir_lmort_direct_co)%r81d, & rio_lmort_collateral_co => this%rvars(ir_lmort_collateral_co)%r81d, & @@ -2542,7 +2782,33 @@ subroutine get_restart_vectors(this, nc, nsites, sites) rio_promcflux_si => this%rvars(ir_promcflux_si)%r81d, & rio_imortcflux_si => this%rvars(ir_imortcflux_si)%r81d, & rio_fmortcflux_cano_si => this%rvars(ir_fmortcflux_cano_si)%r81d, & - rio_fmortcflux_usto_si => this%rvars(ir_fmortcflux_usto_si)%r81d) + rio_fmortcflux_usto_si => this%rvars(ir_fmortcflux_usto_si)%r81d, & + rio_termcarea_cano_si => this%rvars(ir_termcarea_cano_si)%r81d, & + rio_termcarea_usto_si => this%rvars(ir_termcarea_usto_si)%r81d, & + rio_imortcarea_si => this%rvars(ir_imortcarea_si)%r81d, & + rio_fmortcarea_cano_si => this%rvars(ir_fmortcarea_cano_si)%r81d, & + rio_fmortcarea_usto_si => this%rvars(ir_fmortcarea_usto_si)%r81d, & + + + ! Damage + rio_damage_cflux_sicd => this%rvars(ir_damage_cflux_sicd)%r81d, & + rio_damage_rate_sicd => this%rvars(ir_damage_rate_sicd)%r81d, & + rio_recovery_cflux_sicd => this%rvars(ir_recovery_cflux_sicd)%r81d, & + rio_recovery_rate_sicd => this%rvars(ir_recovery_rate_sicd)%r81d, & + rio_imortrate_sicdpf => this%rvars(ir_imortrate_sicdpf)%r81d, & + rio_termnindiv_cano_sicdpf => this%rvars(ir_termnindiv_cano_sicdpf)%r81d, & + rio_termnindiv_usto_sicdpf => this%rvars(ir_termnindiv_usto_sicdpf)%r81d, & + rio_imortcflux_sicdsc => this%rvars(ir_imortcflux_sicdsc)%r81d, & + rio_termcflux_cano_sicdsc => this%rvars(ir_termcflux_cano_sicdsc)%r81d, & + rio_termcflux_usto_sicdsc => this%rvars(ir_termcflux_usto_sicdsc)%r81d, & + rio_fmortrate_cano_sicdpf => this%rvars(ir_fmortrate_cano_sicdpf)%r81d, & + rio_fmortrate_usto_sicdpf => this%rvars(ir_fmortrate_usto_sicdpf)%r81d, & + rio_fmortcflux_cano_sicdsc => this%rvars(ir_fmortcflux_cano_sicdsc)%r81d, & + rio_fmortcflux_usto_sicdsc => this%rvars(ir_fmortcflux_usto_sicdsc)%r81d, & + rio_crownarea_cano_damage_si=> this%rvars(ir_crownarea_cano_si)%r81d, & + rio_crownarea_usto_damage_si=> this%rvars(ir_crownarea_usto_si)%r81d ) + + totalcohorts = 0 @@ -2565,7 +2831,10 @@ subroutine get_restart_vectors(this, nc, nsites, sites) io_idx_si_sc = io_idx_co_1st io_idx_si_capf = io_idx_co_1st io_idx_si_cacls= io_idx_co_1st - + io_idx_si_cdcd = io_idx_co_1st + io_idx_si_cdsc = io_idx_co_1st + io_idx_si_cdpf = io_idx_co_1st + ! read seed_bank info(site-level, but PFT-resolved) do i_pft = 1,numpft sites(s)%recruitment_rate(i_pft) = rio_recrate_sift(io_idx_co_1st+i_pft-1) @@ -2672,6 +2941,7 @@ subroutine get_restart_vectors(this, nc, nsites, sites) ccohort%canopy_layer = rio_canopy_layer_co(io_idx_co) ccohort%canopy_layer_yesterday = rio_canopy_layer_yesterday_co(io_idx_co) + ccohort%crowndamage = rio_crowndamage_co(io_idx_co) ccohort%canopy_trim = rio_canopy_trim_co(io_idx_co) ccohort%seed_prod = rio_seed_prod_co(io_idx_co) ccohort%size_class_lasttimestep = rio_size_class_lasttimestep(io_idx_co) @@ -2696,6 +2966,7 @@ subroutine get_restart_vectors(this, nc, nsites, sites) ccohort%cmort = rio_cmort_co(io_idx_co) ccohort%smort = rio_smort_co(io_idx_co) ccohort%asmort = rio_asmort_co(io_idx_co) + ccohort%dgmort = rio_dgmort_co(io_idx_co) ccohort%frmort = rio_frmort_co(io_idx_co) ! Nutrient uptake / efflux @@ -2946,14 +3217,57 @@ subroutine get_restart_vectors(this, nc, nsites, sites) io_idx_si_sc = io_idx_si_sc + 1 end do + + if (hlm_use_canopy_damage .eq. itrue .or. hlm_use_understory_damage .eq. itrue) then + do i_cdam = 1, ncrowndamage + do i_pft = 1, numpft + do i_scls = 1, nlevsclass + sites(s)%imort_rate_damage(i_cdam, i_scls, i_pft) = rio_imortrate_sicdpf(io_idx_si_cdpf) + sites(s)%term_nindivs_canopy_damage(i_cdam,i_scls,i_pft) = rio_termnindiv_cano_sicdpf(io_idx_si_cdpf) + sites(s)%term_nindivs_ustory_damage(i_cdam,i_scls,i_pft) = rio_termnindiv_usto_sicdpf(io_idx_si_cdpf) + sites(s)%imort_cflux_damage(i_cdam, i_scls) = rio_imortcflux_sicdsc(io_idx_si_cdsc) + sites(s)%term_cflux_canopy_damage(i_cdam, i_scls) = rio_termcflux_cano_sicdsc(io_idx_si_cdsc) + sites(s)%term_cflux_ustory_damage(i_cdam, i_scls) = rio_termcflux_usto_sicdsc(io_idx_si_cdsc) + sites(s)%fmort_rate_canopy_damage(i_cdam, i_scls, i_pft) = rio_fmortrate_cano_sicdpf(io_idx_si_cdpf) + sites(s)%fmort_rate_ustory_damage(i_cdam, i_scls, i_pft) = rio_fmortrate_usto_sicdpf(io_idx_si_cdpf) + sites(s)%fmort_cflux_canopy_damage(i_cdam, i_scls) = rio_fmortcflux_cano_sicdsc(io_idx_si_cdsc) + sites(s)%fmort_cflux_ustory_damage(i_cdam, i_scls) = rio_fmortcflux_usto_sicdsc(io_idx_si_cdsc) + io_idx_si_cdsc = io_idx_si_cdsc + 1 + io_idx_si_cdpf = io_idx_si_cdpf + 1 + end do + end do + end do + + sites(s)%crownarea_canopy_damage = rio_crownarea_cano_damage_si(io_idx_si) + sites(s)%crownarea_ustory_damage = rio_crownarea_usto_damage_si(io_idx_si) + + ! this only copies live portions of transitions - but that's ok because the mortality + ! bit only needs to be added for history outputs + do icdi = 1,ncrowndamage + do icdj = 1,ncrowndamage+1 + sites(s)%damage_cflux(icdi,icdj) = rio_damage_cflux_sicd(io_idx_si_cdcd) + sites(s)%damage_rate(icdi,icdj) = rio_damage_rate_sicd(io_idx_si_cdcd) + sites(s)%recovery_cflux(icdi,icdj) = rio_recovery_cflux_sicd(io_idx_si_cdcd) + sites(s)%recovery_rate(icdi,icdj) = rio_recovery_rate_sicd(io_idx_si_cdcd) + io_idx_si_cdcd = io_idx_si_cdcd + 1 + end do + end do + end if + + sites(s)%term_carbonflux_canopy = rio_termcflux_cano_si(io_idx_si) sites(s)%term_carbonflux_ustory = rio_termcflux_usto_si(io_idx_si) + sites(s)%term_crownarea_canopy = rio_termcarea_cano_si(io_idx_si) + sites(s)%term_crownarea_ustory = rio_termcarea_usto_si(io_idx_si) sites(s)%demotion_carbonflux = rio_democflux_si(io_idx_si) sites(s)%promotion_carbonflux = rio_promcflux_si(io_idx_si) sites(s)%imort_carbonflux = rio_imortcflux_si(io_idx_si) + sites(s)%imort_crownarea = rio_imortcarea_si(io_idx_si) sites(s)%fmort_carbonflux_canopy = rio_fmortcflux_cano_si(io_idx_si) sites(s)%fmort_carbonflux_ustory = rio_fmortcflux_usto_si(io_idx_si) + sites(s)%fmort_crownarea_canopy = rio_fmortcarea_cano_si(io_idx_si) + sites(s)%fmort_crownarea_ustory = rio_fmortcarea_usto_si(io_idx_si) ! Site level phenology status flags diff --git a/main/FatesSizeAgeTypeIndicesMod.F90 b/main/FatesSizeAgeTypeIndicesMod.F90 index d624db1e24..91dbc5455c 100644 --- a/main/FatesSizeAgeTypeIndicesMod.F90 +++ b/main/FatesSizeAgeTypeIndicesMod.F90 @@ -1,15 +1,16 @@ module FatesSizeAgeTypeIndicesMod use FatesConstantsMod, only : r8 => fates_r8 + use FatesInterfaceTypesMod, only : nlevsclass use FatesInterfaceTypesMod, only : nlevage use FatesInterfaceTypesMod, only : nlevheight use FatesInterfaceTypesMod, only : nlevcoage + use FatesInterfaceTypesMod, only : ncrowndamage use EDParamsMod, only : ED_val_history_sizeclass_bin_edges use EDParamsMod, only : ED_val_history_ageclass_bin_edges use EDParamsMod, only : ED_val_history_height_bin_edges use EDParamsMod, only : ED_val_history_coageclass_bin_edges - implicit none private ! Modules are private by default @@ -21,6 +22,8 @@ module FatesSizeAgeTypeIndicesMod public :: get_height_index public :: get_sizeagepft_class_index public :: get_agepft_class_index + public :: get_cdamagesize_class_index + public :: get_cdamagesizepft_class_index public :: coagetype_class_index public :: get_coage_class_index public :: get_agefuel_class_index @@ -39,7 +42,8 @@ function get_age_class_index(age) result( patch_age_class ) end function get_age_class_index - ! ===================================================================================== + ! ===================================================================================== + function get_sizeage_class_index(dbh,age) result(size_by_age_class) @@ -59,6 +63,25 @@ function get_sizeage_class_index(dbh,age) result(size_by_age_class) end function get_sizeage_class_index + !====================================================================================== + + + function get_cdamagesize_class_index(dbh,cdamage) result(cdamage_by_size_class) + + ! Arguments + real(r8),intent(in) :: dbh + integer,intent(in) :: cdamage + + integer :: size_class + integer :: cdamage_by_size_class + + size_class = get_size_class_index(dbh) + + cdamage_by_size_class = (cdamage-1)*nlevsclass + size_class + + end function get_cdamagesize_class_index + + ! ===================================================================================== subroutine sizetype_class_index(dbh,pft,size_class,size_by_pft_class) @@ -153,6 +176,25 @@ function get_sizeagepft_class_index(dbh,age,pft) result(size_by_age_by_pft_class end function get_sizeagepft_class_index + ! ===================================================================================== + + function get_cdamagesizepft_class_index(dbh,cdamage,pft) result(cdamage_by_size_by_pft_class) + + ! Arguments + real(r8),intent(in) :: dbh + integer,intent(in) :: cdamage + integer,intent(in) :: pft + + integer :: size_class + integer :: cdamage_by_size_by_pft_class + + size_class = get_size_class_index(dbh) + + cdamage_by_size_by_pft_class = (cdamage-1)*nlevsclass + size_class + & + (pft-1) * nlevsclass * ncrowndamage + + end function get_cdamagesizepft_class_index + ! ===================================================================================== function get_agepft_class_index(age,pft) result(age_by_pft_class) diff --git a/parameter_files/fates_params_default.cdl b/parameter_files/fates_params_default.cdl index 39adab94f6..ea363ba20f 100644 --- a/parameter_files/fates_params_default.cdl +++ b/parameter_files/fates_params_default.cdl @@ -7,7 +7,7 @@ dimensions: fates_history_coage_bins = 2 ; fates_hydr_organs = 4 ; fates_leafage_class = 1 ; - fates_litterclass = 6 ; + fates_litterclass = 6 ; fates_pft = 12 ; fates_prt_organs = 4 ; fates_string_length = 60 ; @@ -153,7 +153,22 @@ variables: double fates_branch_turnover(fates_pft) ; fates_branch_turnover:units = "yr" ; fates_branch_turnover:long_name = "turnover time of branches" ; - double fates_c2b(fates_pft) ; + double fates_damage_frac(fates_pft) ; + fates_damage_frac:units = "fraction"; + fates_damage_frac:long_name = "fraction of cohort damaged in each damage event"; + double fates_damage_mort_p1(fates_pft) ; + fates_damage_mort_p1:units = "fraction crown loss - a value of 0.8 means 50% mortality with 80% loss of crown"; + fates_damage_mort_p1:long_name = "inflection point of damage mortality function - to turn off damage mortality set this to a large number" ; + double fates_damage_mort_p2(fates_pft) ; + fates_damage_mort_p2:units = "unitless"; + fates_damage_mort_p2:long_name = "rate of mortality increase with damage"; + double fates_damage_recovery_scalar(fates_pft) ; + fates_damage_recovery_scalar:units = "unitless"; + fates_damage_recovery_scalar:long_name = "fraction of cohort that recovers from damage"; + double fates_ncrowndamage ; + fates_ncrowndamage: units = "unitless" ; + fates_ncrowndamage: long_name = "number of crowndamage classes" ; + double fates_c2b(fates_pft) ; fates_c2b:units = "ratio" ; fates_c2b:long_name = "Carbon to biomass multiplier of bulk structural tissues" ; double fates_dev_arbitrary_pft(fates_pft) ; @@ -896,6 +911,19 @@ data: fates_branch_turnover = 150, 150, 150, 150, 150, 150, 150, 150, 150, 0, 0, 0 ; + fates_damage_frac = 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, + 0.01, 0.01, 0.01, 0.01 ; + + fates_damage_mort_p1 = 0.9,0.9,0.9,0.9,0.9,0.9,0.9,0.9,0.9,0.9,0.9,0.9 ; + + fates_damage_mort_p2 = 5.5, 5.5, 5.5, 5.5, 5.5, 5.5, 5.5, 5.5, 5.5, 5.5, + 5.5, 5.5 ; + + fates_damage_recovery_scalar = 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, + 0.0, 0.0, 0.0, 0.0 ; + + fates_ncrowndamage = 5 ; + fates_c2b = 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2 ; fates_dev_arbitrary_pft = _, _, _, _, _, _, _, _, _, _, _, _ ; diff --git a/parteh/PRTAllometricCNPMod.F90 b/parteh/PRTAllometricCNPMod.F90 index 5617d71e5d..4ac203f431 100644 --- a/parteh/PRTAllometricCNPMod.F90 +++ b/parteh/PRTAllometricCNPMod.F90 @@ -136,8 +136,11 @@ module PRTAllometricCNPMod integer, public, parameter :: acnp_bc_inout_id_dbh = 1 ! Plant DBH integer, public, parameter :: acnp_bc_inout_id_rmaint_def = 2 ! Index for any accumulated - ! maintenance respiration deficit - integer, public, parameter :: num_bc_inout = 2 + integer, public, parameter :: acnp_bc_inout_id_cdamage = 3 ! Crown damage index + integer, public, parameter :: acnp_bc_inout_id_num = 4 ! Number of plants + + ! maintenance respiration deficit + integer, public, parameter :: num_bc_inout = 4 ! ------------------------------------------------------------------------------------- ! Input only Boundary Indices (These are public) @@ -150,9 +153,10 @@ module PRTAllometricCNPMod integer, public, parameter :: acnp_bc_in_id_netdnh4 = 5 ! Index for the net daily NH4 input BC integer, public, parameter :: acnp_bc_in_id_netdno3 = 6 ! Index for the net daily NO3 input BC integer, public, parameter :: acnp_bc_in_id_netdp = 7 ! Index for the net daily P input BC + integer, public, parameter :: acnp_bc_in_id_branch_frac = 8 ! Index for branch fraction ! 0=leaf off, 1=leaf on - integer, parameter :: num_bc_in = 7 + integer, parameter :: num_bc_in = 8 ! ------------------------------------------------------------------------------------- ! Output Boundary Indices (These are public) @@ -327,9 +331,11 @@ subroutine DailyPRTAllometricCNP(this) ! Pointers to in-out bcs real(r8),pointer :: dbh ! Diameter at breast height [cm] real(r8),pointer :: maint_r_def ! Current maintenance respiration deficit [kgC] + integer ,pointer :: cdamage ! Crown damage ! Input only bcs integer :: ipft ! Plant Functional Type index + real(r8) :: branch_frac ! fraction crown in branches real(r8) :: c_gain ! Daily carbon balance for this cohort [kgC] real(r8) :: n_gain ! Daily nitrogen uptake through fine-roots [kgN] real(r8) :: p_gain ! Daily phosphorus uptake through fine-roots [kgN] @@ -373,6 +379,7 @@ subroutine DailyPRTAllometricCNP(this) real(r8) :: n_gain0 real(r8) :: p_gain0 real(r8) :: maint_r_def0 + integer :: cdamage0 ! Used for mass checking, total mass allocated based ! on change in the states, should match gain0's @@ -396,6 +403,7 @@ subroutine DailyPRTAllometricCNP(this) p_gain = this%bc_in(acnp_bc_in_id_netdp)%rval; p_gain0 = p_gain canopy_trim = this%bc_in(acnp_bc_in_id_ctrim)%rval ipft = this%bc_in(acnp_bc_in_id_pft)%ival + branch_frac = this%bc_in(acnp_bc_in_id_branch_frac)%rval ! Output only boundary conditions c_efflux => this%bc_out(acnp_bc_out_id_cefflux)%rval; c_efflux = 0._r8 @@ -408,6 +416,7 @@ subroutine DailyPRTAllometricCNP(this) ! In/out boundary conditions maint_r_def => this%bc_inout(acnp_bc_inout_id_rmaint_def)%rval; maint_r_def0 = maint_r_def dbh => this%bc_inout(acnp_bc_inout_id_dbh)%rval; dbh0 = dbh + cdamage => this%bc_inout(acnp_bc_inout_id_cdamage)%ival; cdamage0 = cdamage @@ -430,14 +439,15 @@ subroutine DailyPRTAllometricCNP(this) ! Set carbon targets based on the plant's current stature target_c(:) = fates_unset_r8 target_dcdd(:) = fates_unset_r8 - call bsap_allom(dbh,ipft,canopy_trim,sapw_area,target_c(sapw_id),target_dcdd(sapw_id) ) - call bagw_allom(dbh,ipft,agw_c_target,agw_dcdd_target) + call bsap_allom(dbh,ipft,cdamage, branch_frac, canopy_trim, & + sapw_area,target_c(sapw_id),target_dcdd(sapw_id) ) + call bagw_allom(dbh,ipft,cdamage, branch_frac, agw_c_target,agw_dcdd_target) call bbgw_allom(dbh,ipft,bgw_c_target,bgw_dcdd_target) call bdead_allom(agw_c_target,bgw_c_target, target_c(sapw_id), ipft, target_c(struct_id), & agw_dcdd_target, bgw_dcdd_target, target_dcdd(sapw_id), target_dcdd(struct_id)) - call bleaf(dbh,ipft,canopy_trim, target_c(leaf_id), target_dcdd(leaf_id)) + call bleaf(dbh,ipft,cdamage, canopy_trim, target_c(leaf_id), target_dcdd(leaf_id)) call bfineroot(dbh,ipft,canopy_trim, target_c(fnrt_id), target_dcdd(fnrt_id)) - call bstore_allom(dbh,ipft,canopy_trim, target_c(store_id), target_dcdd(store_id)) + call bstore_allom(dbh,ipft,cdamage, canopy_trim, target_c(store_id), target_dcdd(store_id)) target_c(repro_id) = 0._r8 target_dcdd(repro_id) = 0._r8 @@ -1010,6 +1020,8 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & integer :: ipft real(r8) :: canopy_trim real(r8) :: leaf_status + real(r8) :: branch_frac + integer :: icrowndamage integer :: i, ii ! organ index loops (masked and unmasked) integer :: istep ! outer step iteration loop @@ -1091,6 +1103,8 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & dbh => this%bc_inout(acnp_bc_inout_id_dbh)%rval ipft = this%bc_in(acnp_bc_in_id_pft)%ival canopy_trim = this%bc_in(acnp_bc_in_id_ctrim)%rval + icrowndamage = this%bc_inout(acnp_bc_inout_id_cdamage)%ival + branch_frac = this%bc_in(acnp_bc_in_id_branch_frac)%rval cnp_limiter = 0 @@ -1357,7 +1371,8 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & leafc_tp1 = leafc_tp1 + this%variables(i_var)%val(i) end do - call CheckIntegratedAllometries(state_array_out(dbh_id),ipft,canopy_trim, & + call CheckIntegratedAllometries(state_array_out(dbh_id),ipft, & + icrowndamage, branch_frac, canopy_trim, & leafc_tp1, state_array_out(fnrt_id), state_array_out(sapw_id), & state_array_out(store_id), state_array_out(struct_id), & state_mask(leaf_id), state_mask(fnrt_id), state_mask(sapw_id), & @@ -1447,13 +1462,13 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & storec_tp1 = state_array_out(store_id) structc_tp1 = state_array_out(struct_id) - call bleaf(dbh_tp1,ipft,canopy_trim,leaf_c_target_tp1) + call bleaf(dbh_tp1,ipft,icrowndamage, canopy_trim,leaf_c_target_tp1) call bfineroot(dbh_tp1,ipft,canopy_trim,fnrt_c_target_tp1) - call bsap_allom(dbh_tp1,ipft,canopy_trim,sapw_area,sapw_c_target_tp1) - call bagw_allom(dbh_tp1,ipft,agw_c_target_tp1) + call bsap_allom(dbh_tp1,ipft,icrowndamage,branch_frac,canopy_trim,sapw_area,sapw_c_target_tp1) + call bagw_allom(dbh_tp1,ipft,icrowndamage, branch_frac, agw_c_target_tp1) call bbgw_allom(dbh_tp1,ipft,bgw_c_target_tp1) call bdead_allom(agw_c_target_tp1,bgw_c_target_tp1, sapw_c_target_tp1, ipft, struct_c_target_tp1) - call bstore_allom(dbh_tp1,ipft,canopy_trim,store_c_target_tp1) + call bstore_allom(dbh_tp1,ipft,icrowndamage, canopy_trim,store_c_target_tp1) write(fates_log(),*) 'leaf_c: ',leafc_tp1, leaf_c_target_tp1,leafc_tp1-leaf_c_target_tp1 write(fates_log(),*) 'fnrt_c: ',fnrtc_tp1, fnrt_c_target_tp1,fnrtc_tp1- fnrt_c_target_tp1 @@ -1561,11 +1576,13 @@ subroutine CNPAllocateRemainder(this,c_gain, n_gain, p_gain, & real(r8), pointer :: dbh integer :: ipft real(r8) :: canopy_trim + integer, pointer :: icrowndamage dbh => this%bc_inout(acnp_bc_inout_id_dbh)%rval canopy_trim = this%bc_in(acnp_bc_in_id_ctrim)%rval ipft = this%bc_in(acnp_bc_in_id_pft)%ival + icrowndamage => this%bc_inout(acnp_bc_inout_id_cdamage)%ival ! ----------------------------------------------------------------------------------- ! If nutrients are still available, then we can bump up the values in the pools @@ -1617,7 +1634,7 @@ subroutine CNPAllocateRemainder(this,c_gain, n_gain, p_gain, & if(c_gain>calloc_abs_error) then ! Update carbon based allometric targets - call bstore_allom(dbh,ipft,canopy_trim, store_c_target) + call bstore_allom(dbh,ipft,icrowndamage, canopy_trim, store_c_target) ! Estimate the overflow store_c_target = store_c_target * (1.0_r8 + store_overflow_frac) @@ -1703,6 +1720,7 @@ function GetNutrientTargetCNP(this,element_id,organ_id,stoich_mode) result(targe real(r8) :: target_c real(r8),pointer :: dbh + integer, pointer :: cdamage real(r8) :: canopy_trim integer :: ipft integer :: i_cvar @@ -1711,13 +1729,13 @@ function GetNutrientTargetCNP(this,element_id,organ_id,stoich_mode) result(targe real(r8) :: sapw_c_target,agw_c_target real(r8) :: bgw_c_target,struct_c_target - - dbh => this%bc_inout(acnp_bc_inout_id_dbh)%rval canopy_trim = this%bc_in(acnp_bc_in_id_ctrim)%rval ipft = this%bc_in(acnp_bc_in_id_pft)%ival i_cvar = prt_global%sp_organ_map(organ_id,carbon12_element) + cdamage => this%bc_inout(acnp_bc_inout_id_cdamage)%ival + ! Storage of nutrients are assumed to have different compartments than ! for carbon, and thus their targets are not associated with a tissue @@ -1726,10 +1744,10 @@ function GetNutrientTargetCNP(this,element_id,organ_id,stoich_mode) result(targe if(organ_id == store_organ) then - call bleaf(dbh,ipft,canopy_trim,leaf_c_target) + call bleaf(dbh,ipft,1, canopy_trim,leaf_c_target) call bfineroot(dbh,ipft,canopy_trim,fnrt_c_target) - call bsap_allom(dbh,ipft,canopy_trim,sapw_area,sapw_c_target) - call bagw_allom(dbh,ipft,agw_c_target) + call bsap_allom(dbh,ipft,1, 1.0_r8, canopy_trim,sapw_area,sapw_c_target) + call bagw_allom(dbh,ipft,1, 1.0_r8, agw_c_target) call bbgw_allom(dbh,ipft,bgw_c_target) call bdead_allom(agw_c_target,bgw_c_target, sapw_c_target, ipft, struct_c_target) @@ -2084,6 +2102,8 @@ function AllomCNPGrowthDeriv(l_state_array,l_state_mask,cbalance,intgr_params) r ! locals integer :: ipft ! PFT index real(r8) :: canopy_trim ! Canopy trimming function (boundary condition [0-1] + integer :: icrowndamage ! crown damage index + real(r8) :: branch_frac real(r8) :: leaf_c_target ! target leaf biomass, dummy var (kgC) real(r8) :: fnrt_c_target ! target fine-root biomass, dummy var (kgC) real(r8) :: sapw_c_target ! target sapwood biomass, dummy var (kgC) @@ -2122,15 +2142,17 @@ function AllomCNPGrowthDeriv(l_state_array,l_state_mask,cbalance,intgr_params) r canopy_trim = intgr_params(acnp_bc_in_id_ctrim) ipft = int(intgr_params(acnp_bc_in_id_pft)) + branch_frac = intgr_params(acnp_bc_in_id_branch_frac) + icrowndamage = int(intgr_params(acnp_bc_inout_id_cdamage)) - call bleaf(dbh,ipft,canopy_trim,leaf_c_target,leaf_dcdd_target) + call bleaf(dbh,ipft,icrowndamage, canopy_trim,leaf_c_target,leaf_dcdd_target) call bfineroot(dbh,ipft,canopy_trim,fnrt_c_target,fnrt_dcdd_target) - call bsap_allom(dbh,ipft,canopy_trim,sapw_area,sapw_c_target,sapw_dcdd_target) - call bagw_allom(dbh,ipft,agw_c_target,agw_dcdd_target) + call bsap_allom(dbh,ipft,icrowndamage, branch_frac,canopy_trim,sapw_area,sapw_c_target,sapw_dcdd_target) + call bagw_allom(dbh,ipft,icrowndamage, branch_frac, agw_c_target,agw_dcdd_target) call bbgw_allom(dbh,ipft,bgw_c_target,bgw_dcdd_target) call bdead_allom(agw_c_target,bgw_c_target, sapw_c_target, ipft, struct_c_target, & agw_dcdd_target, bgw_dcdd_target, sapw_dcdd_target, struct_dcdd_target) - call bstore_allom(dbh,ipft,canopy_trim,store_c_target,store_dcdd_target) + call bstore_allom(dbh,ipft,icrowndamage,canopy_trim,store_c_target,store_dcdd_target) if (mask_repro) then ! fraction of carbon going towards reproduction diff --git a/parteh/PRTAllometricCarbonMod.F90 b/parteh/PRTAllometricCarbonMod.F90 index 5bdf624502..509ef4a35f 100644 --- a/parteh/PRTAllometricCarbonMod.F90 +++ b/parteh/PRTAllometricCarbonMod.F90 @@ -87,14 +87,18 @@ module PRTAllometricCarbonMod integer, public, parameter :: ac_bc_inout_id_dbh = 1 ! Plant DBH integer, public, parameter :: ac_bc_inout_id_netdc = 2 ! Index for the net daily C input BC - integer, parameter :: num_bc_inout = 2 ! Number of in & output boundary conditions + integer, public, parameter :: ac_bc_inout_id_n = 3 ! Number of plants + integer, public, parameter :: ac_bc_inout_id_cdamage = 4 ! Index for the crowndamage input BC + integer, parameter :: num_bc_inout = 4 ! Number of in & output boundary conditions integer, public, parameter :: ac_bc_in_id_pft = 1 ! Index for the PFT input BC integer, public, parameter :: ac_bc_in_id_ctrim = 2 ! Index for the canopy trim function integer, public, parameter :: ac_bc_in_id_lstat = 3 ! Leaf status (on or off) - integer, parameter :: num_bc_in = 3 ! Number of input boundary conditions + integer, public, parameter :: ac_bc_in_id_branch_frac = 4 ! index for the branch fraction input BC + integer, parameter :: num_bc_in = 4 ! Number of input boundary conditions + ! THere are no purely output boundary conditions integer, parameter :: num_bc_out = 0 ! Number of purely output boundary condtions @@ -120,6 +124,7 @@ module PRTAllometricCarbonMod procedure :: DailyPRT => DailyPRTAllometricCarbon procedure :: FastPRT => FastPRTAllometricCarbon + procedure :: DamageRecovery => PRTDamageRecovery end type callom_prt_vartypes @@ -292,10 +297,14 @@ subroutine DailyPRTAllometricCarbon(this) ! this local will point to both in and out bc's real(r8),pointer :: carbon_balance ! Daily carbon balance for this cohort [kgC] + real(r8), pointer :: n ! number of plants + integer, pointer :: crowndamage ! which crown damage class + + real(r8) :: canopy_trim ! The canopy trimming function [0-1] integer :: ipft ! Plant Functional Type index - - + real(r8) :: branch_frac + real(r8) :: target_leaf_c ! target leaf carbon [kgC] real(r8) :: target_fnrt_c ! target fine-root carbon [kgC] real(r8) :: target_sapw_c ! target sapwood carbon [kgC] @@ -358,7 +367,22 @@ subroutine DailyPRTAllometricCarbon(this) integer :: leaf_status ! are leaves on (2) or off (1) real(r8) :: leaf_age_flux ! carbon mass flux between leaf age classification pools - + ! for recovery dynamics + real(r8) :: mass_d + real(r8) :: mass_dminus1 + real(r8) :: recovery_demand + real(r8) :: targetn_sapw_c + real(r8) :: targetn_agw_c + real(r8) :: targetn_bgw_c + real(r8) :: targetn_struct_c + real(r8) :: targetn_leaf_c + real(r8) :: targetn_store_c + real(r8) :: targetn_fnrt_c + real(r8) :: max_recover_n + real(r8) :: n_recover + real(r8) :: damage_recovery_scalar + real(r8) :: carbon_balance2 + ! Integegrator variables c_pool is "mostly" carbon variables, it also includes ! dbh... ! ----------------------------------------------------------------------------------- @@ -377,12 +401,16 @@ subroutine DailyPRTAllometricCarbon(this) ! leaf age class, and therefore ! all new allocation goes into that pool - real(r8) :: intgr_params(num_bc_in) ! The boundary conditions to this routine, + real(r8) :: intgr_params(num_bc_in+1) ! The boundary conditions to this routine, ! are pressed into an array that is also ! passed to the integrators + ! add one because we pass crown damage also + ! which is not a bc_in + associate( & - leaf_c => this%variables(leaf_c_id)%val, & + + leaf_c => this%variables(leaf_c_id)%val, & fnrt_c => this%variables(fnrt_c_id)%val(icd), & sapw_c => this%variables(sapw_c_id)%val(icd), & store_c => this%variables(store_c_id)%val(icd), & @@ -398,26 +426,30 @@ subroutine DailyPRTAllometricCarbon(this) dbh => this%bc_inout(ac_bc_inout_id_dbh)%rval carbon_balance => this%bc_inout(ac_bc_inout_id_netdc)%rval - + n => this%bc_inout(ac_bc_inout_id_n)%rval + crowndamage => this%bc_inout(ac_bc_inout_id_cdamage)%ival + canopy_trim = this%bc_in(ac_bc_in_id_ctrim)%rval ipft = this%bc_in(ac_bc_in_id_pft)%ival leaf_status = this%bc_in(ac_bc_in_id_lstat)%ival - + branch_frac = this%bc_in(ac_bc_in_id_branch_frac)%rval + intgr_params(:) = un_initialized intgr_params(ac_bc_in_id_ctrim) = this%bc_in(ac_bc_in_id_ctrim)%rval intgr_params(ac_bc_in_id_pft) = real(this%bc_in(ac_bc_in_id_pft)%ival) + intgr_params(ac_bc_in_id_branch_frac) = this%bc_in(ac_bc_in_id_branch_frac)%rval + intgr_params(num_bc_in + 1) = real(this%bc_inout(ac_bc_inout_id_cdamage)%ival) - - nleafage = prt_global%state_descriptor(leaf_c_id)%num_pos ! Number of leaf age class + damage_recovery_scalar = prt_params%damage_recovery_scalar(ipft) + ! ----------------------------------------------------------------------------------- ! Call the routine that advances leaves in age. ! This will move a portion of the leaf mass in each ! age bin, to the next bin. This will not handle movement ! of mass from the oldest bin into the litter pool, that is something else. ! ----------------------------------------------------------------------------------- - call this%AgeLeaves(ipft,sec_per_day) ! ----------------------------------------------------------------------------------- @@ -432,17 +464,16 @@ subroutine DailyPRTAllometricCarbon(this) store_c0 = store_c ! Set initial storage carbon repro_c0 = repro_c ! Set initial reproductive carbon struct_c0 = struct_c ! Set initial structural carbon - ! ----------------------------------------------------------------------------------- ! II. Calculate target size of the biomass compartment for a given dbh. ! ----------------------------------------------------------------------------------- ! Target sapwood biomass according to allometry and trimming [kgC] - call bsap_allom(dbh,ipft,canopy_trim,sapw_area,target_sapw_c) + call bsap_allom(dbh,ipft, crowndamage, branch_frac, canopy_trim,sapw_area,target_sapw_c) ! Target total above ground biomass in woody/fibrous tissues [kgC] - call bagw_allom(dbh,ipft,target_agw_c) + call bagw_allom(dbh,ipft, crowndamage, branch_frac, target_agw_c) ! Target total below ground biomass in woody/fibrous tissues [kgC] call bbgw_allom(dbh,ipft,target_bgw_c) @@ -452,7 +483,7 @@ subroutine DailyPRTAllometricCarbon(this) ! Target leaf biomass according to allometry and trimming if(leaf_status==2) then - call bleaf(dbh,ipft,canopy_trim,target_leaf_c) + call bleaf(dbh,ipft,crowndamage, canopy_trim,target_leaf_c) else target_leaf_c = 0._r8 end if @@ -461,7 +492,7 @@ subroutine DailyPRTAllometricCarbon(this) call bfineroot(dbh,ipft,canopy_trim,target_fnrt_c) ! Target storage carbon [kgC,kgC/cm] - call bstore_allom(dbh,ipft,canopy_trim,target_store_c) + call bstore_allom(dbh,ipft,crowndamage,canopy_trim,target_store_c) ! ----------------------------------------------------------------------------------- @@ -633,6 +664,91 @@ subroutine DailyPRTAllometricCarbon(this) ! left to allocate, and thus it must be on allometry when its not. ! ----------------------------------------------------------------------------------- + !----------------------------------------------------------------------------------- + ! JN March 2021 + ! At this point it is possible that damaged cohorts have reached their + ! target allometries. There is a choice now - if they have excess carbon, + ! they can use it to grow along their reduced allometric targets - i.e. + ! dbh and all carbon pools grow out together. OR they can use excess carbon to + ! jump to a lower damage class by changing their target allometry and growing + ! to meet new C pools for same dbh. + ! + ! d = damage class + + if (crowndamage > 1 .and. carbon_balance > calloc_abs_error) then + + if(damage_recovery_scalar > 0.0_r8) then + ! 1. What is excess carbon? + ! carbon_balance + + ! 2. What is biomass required to go from current damage level to next damage level? + + ! mass of this damage class + mass_d = (sum(leaf_c(1:nleafage)) + fnrt_c + store_c + sapw_c + struct_c ) + + ! Target sapwood biomass according to allometry and trimming [kgC] + call bsap_allom(dbh,ipft, crowndamage-1, branch_frac, canopy_trim,sapw_area,targetn_sapw_c) + ! Target total above ground biomass in woody/fibrous tissues [kgC] + call bagw_allom(dbh,ipft, crowndamage-1, branch_frac, targetn_agw_c) + ! Target total below ground biomass in woody/fibrous tissues [kgC] + call bbgw_allom(dbh,ipft,targetn_bgw_c) + ! Target total dead (structrual) biomass [kgC] + call bdead_allom( targetn_agw_c, targetn_bgw_c, targetn_sapw_c, ipft, targetn_struct_c) + ! Target fine-root biomass and deriv. according to allometry and trimming [kgC, kgC/cm] + call bfineroot(dbh,ipft,canopy_trim,targetn_fnrt_c) + ! Target storage carbon [kgC,kgC/cm] + call bstore_allom(dbh,ipft,crowndamage-1, canopy_trim,targetn_store_c) + ! Target leaf biomass according to allometry and trimming + if(leaf_status==2) then + call bleaf(dbh,ipft,crowndamage-1, canopy_trim,targetn_leaf_c) + else + targetn_leaf_c = 0._r8 + end if + + + mass_dminus1 = (max(sum(leaf_c), targetn_leaf_c) + max(fnrt_c, targetn_fnrt_c) + & + max(store_c, targetn_store_c) + max(sapw_c, targetn_sapw_c) + & + max(struct_c, targetn_struct_c)) + + ! Carbon needed to get from current mass to allometric target mass of next damage class up + recovery_demand = mass_dminus1 - mass_d + + ! 3. How many trees can get there with excess carbon? + max_recover_n = carbon_balance * n / recovery_demand + + ! 4. Use the scalar to decide how many to recover + n_recover = max_recover_n * damage_recovery_scalar + + ! carbon balance needs to be updated + + ! there is a special case where damage_recovery_scalar = 1, but + ! max_recover_n > n (i.e. there is more carbon than needed for all + ! individuals to recover to the next damage class. + ! in this case we can cheat, by making n_recover 0 and simply + ! allowing the donor cohort to recover and then go through + ! prt - will this work though? if they are not anywhere near allometry? + + + if(damage_recovery_scalar .eq. 1.0_r8 .and. max_recover_n > n) then + n_recover = 0.0_r8 + crowndamage = crowndamage - 1 + ! call prt from within itself here? + else + carbon_balance = (n * carbon_balance - (recovery_demand * n_recover)) /(n-n_recover) + end if + + ! we reduce number density here and continue on with daily prt for the + ! part of the cohort that is not recovering - staying fixed on its + ! current reduced allometries + n = n - n_recover + + ! Outside of parteh we will copy the cohort and allow the + ! recovery portion to change allometric targets. + + end if ! end if some recovery is permited + end if ! end if crowndamage + !------------------------------------------------------------------------------------ + if_stature_growth: if( carbon_balance > calloc_abs_error ) then ! This routine checks that actual carbon is not below that targets. It does @@ -712,7 +828,7 @@ subroutine DailyPRTAllometricCarbon(this) end if do_solve_check: do while( ierr .ne. 0 ) - + deltaC = min(totalC,this%ode_opt_step) if(ODESolve == 1) then call RKF45(AllomCGrowthDeriv,c_pool,c_mask,deltaC,totalC, & @@ -731,11 +847,12 @@ subroutine DailyPRTAllometricCarbon(this) ! we halve the step-size, and then retry. If that step was fine, then ! we remember the current step size as a good next guess. - call CheckIntegratedAllometries(c_pool_out(dbh_id),ipft,canopy_trim, & - c_pool_out(leaf_c_id), c_pool_out(fnrt_c_id), c_pool_out(sapw_c_id), & + call CheckIntegratedAllometries(c_pool_out(dbh_id),ipft,& + crowndamage, branch_frac, canopy_trim, & + c_pool_out(leaf_c_id), c_pool_out(fnrt_c_id), c_pool_out(sapw_c_id), & c_pool_out(store_c_id), c_pool_out(struct_c_id), & c_mask(leaf_c_id), c_mask(fnrt_c_id), c_mask(sapw_c_id), & - c_mask(store_c_id),c_mask(struct_c_id), max_trunc_error, step_pass) + c_mask(store_c_id), c_mask(struct_c_id), max_trunc_error, step_pass) if(step_pass) then this%ode_opt_step = deltaC else @@ -755,6 +872,7 @@ subroutine DailyPRTAllometricCarbon(this) end if if(nsteps > max_substeps ) then + write(fates_log(),*) 'crowndamage : ', crowndamage write(fates_log(),*) 'Plant Growth Integrator could not find' write(fates_log(),*) 'a solution in less than ',max_substeps,' tries' write(fates_log(),*) 'Aborting' @@ -765,7 +883,7 @@ subroutine DailyPRTAllometricCarbon(this) write(fates_log(),*) 'fnrt:',grow_fnrt,target_fnrt_c,target_fnrt_c - fnrt_c write(fates_log(),*) 'sap:',grow_sapw,target_sapw_c, target_sapw_c - sapw_c write(fates_log(),*) 'store:',grow_store,target_store_c,target_store_c - store_c - write(fates_log(),*) 'dead:',target_struct_c,target_struct_c - struct_c + write(fates_log(),*) 'dead:',target_struct_c,target_struct_c - struct_c call endrun(msg=errMsg(sourcefile, __LINE__)) end if @@ -835,7 +953,7 @@ subroutine DailyPRTAllometricCarbon(this) ! Track the net allocations and transport from this routine ! (the AgeLeaves() routine handled tracking allocation through aging) - + this%variables(leaf_c_id)%net_alloc(icd) = & this%variables(leaf_c_id)%net_alloc(icd) + (leaf_c(icd) - leaf_c0(icd)) @@ -890,6 +1008,8 @@ function AllomCGrowthDeriv(c_pools,c_mask,cbalance,intgr_params) result(dCdx) ! locals integer :: ipft ! PFT index + integer :: crowndamage + real(r8) :: branch_frac real(r8) :: canopy_trim ! Canopy trimming function (boundary condition [0-1] real(r8) :: ct_leaf ! target leaf biomass, dummy var (kgC) real(r8) :: ct_fnrt ! target fine-root biomass, dummy var (kgC) @@ -927,17 +1047,17 @@ function AllomCGrowthDeriv(c_pools,c_mask,cbalance,intgr_params) result(dCdx) canopy_trim = intgr_params(ac_bc_in_id_ctrim) ipft = int(intgr_params(ac_bc_in_id_pft)) - - - call bleaf(dbh,ipft,canopy_trim,ct_leaf,ct_dleafdd) + branch_frac = intgr_params(ac_bc_in_id_branch_frac) + crowndamage = int(intgr_params(num_bc_in + 1)) + + call bleaf(dbh,ipft,crowndamage,canopy_trim,ct_leaf, dbldd=ct_dleafdd) call bfineroot(dbh,ipft,canopy_trim,ct_fnrt,ct_dfnrtdd) - call bsap_allom(dbh,ipft,canopy_trim,sapw_area,ct_sap,ct_dsapdd) - - call bagw_allom(dbh,ipft,ct_agw,ct_dagwdd) - call bbgw_allom(dbh,ipft,ct_bgw,ct_dbgwdd) + call bsap_allom(dbh,ipft, crowndamage, branch_frac, canopy_trim,sapw_area,ct_sap,ct_dsapdd) + call bagw_allom(dbh,ipft,crowndamage, branch_frac, ct_agw,ct_dagwdd) + call bbgw_allom(dbh,ipft,ct_bgw, ct_dbgwdd) call bdead_allom(ct_agw,ct_bgw, ct_sap, ipft, ct_dead, & ct_dagwdd, ct_dbgwdd, ct_dsapdd, ct_ddeaddd) - call bstore_allom(dbh,ipft,canopy_trim,ct_store,ct_dstoredd) + call bstore_allom(dbh,ipft,crowndamage, canopy_trim,ct_store,ct_dstoredd) ! fraction of carbon going towards reproduction if (dbh <= prt_params%dbh_repro_threshold(ipft)) then ! cap on leaf biomass @@ -1097,8 +1217,74 @@ subroutine FastPRTAllometricCarbon(this) return - end subroutine FastPRTAllometricCarbon + end subroutine FastPRTAllometricCarbon + !------------------------------------------------------------------------------- + subroutine PRTDamageRecovery(this) + ! ---------------------------------------------------------------------------------- + ! We are assigning mass to each organ based on the allometric targets + ! ---------------------------------------------------------------------------------- + class(callom_prt_vartypes) :: this + + + real(r8),pointer :: dbh + integer, pointer :: crowndamage + real(r8) :: canopy_trim + integer :: ipft + real(r8) :: branch_frac + real(r8) :: target_leaf_c ! target leaf carbon [kgC] + real(r8) :: target_fnrt_c ! target fine-root carbon [kgC] + real(r8) :: target_sapw_c ! target sapwood carbon [kgC] + real(r8) :: target_store_c ! target storage carbon [kgC] + real(r8) :: target_agw_c ! target above ground carbon in woody tissues [kgC] + real(r8) :: target_bgw_c ! target below ground carbon in woody tissues [kgC] + real(r8) :: target_struct_c ! target structural carbon [kgC] + real(r8) :: sapw_area ! dummy var, x-section area of sapwood [m2] + integer :: leaf_status + real(r8) :: leaf_c_flux + integer, parameter :: iexp_leaf = 1 ! index 1 is the expanding leaf age class and + ! therefore all new carbon goes into that pool + + associate ( & + leaf_c => this%variables(leaf_c_id)%val, & + fnrt_c => this%variables(fnrt_c_id)%val(icd), & + sapw_c => this%variables(sapw_c_id)%val(icd), & + store_c => this%variables(store_c_id)%val(icd), & + repro_c => this%variables(repro_c_id)%val(icd), & + struct_c => this%variables(struct_c_id)%val(icd)) + + dbh => this%bc_inout(ac_bc_inout_id_dbh)%rval + crowndamage => this%bc_inout(ac_bc_inout_id_cdamage)%ival + canopy_trim = this%bc_in(ac_bc_in_id_ctrim)%rval + ipft = this%bc_in(ac_bc_in_id_pft)%ival + leaf_status = this%bc_in(ac_bc_in_id_lstat)%ival + branch_frac = this%bc_in(ac_bc_in_id_branch_frac)%rval + + ! Get allometric targets for this dbh and crown damage class + call bsap_allom(dbh, ipft, crowndamage, branch_frac, canopy_trim, sapw_area, target_sapw_c) + call bagw_allom(dbh, ipft, crowndamage, branch_frac, target_agw_c) + call bbgw_allom(dbh, ipft, target_bgw_c) + call bdead_allom(target_agw_c, target_bgw_c, target_sapw_c, ipft, target_struct_c) + if(leaf_status ==2)then + call bleaf(dbh, ipft, crowndamage, canopy_trim, target_leaf_c) + else + target_leaf_c = 0.0_r8 + end if + call bfineroot(dbh, ipft, canopy_trim, target_fnrt_c) + call bstore_allom(dbh, ipft,crowndamage, canopy_trim, target_store_c) + + ! Now we assign these targets to the actual biomass pools + fnrt_c = max(target_fnrt_c, fnrt_c) + store_c = max(target_store_c, store_c) + sapw_c = max(target_sapw_c, sapw_c) + struct_c = max(target_struct_c, struct_c) + leaf_c_flux = target_leaf_c - sum(leaf_c) + leaf_c(iexp_leaf) = leaf_c(iexp_leaf) + leaf_c_flux + + end associate + end subroutine PRTDamageRecovery + ! ===================================================================================== + end module PRTAllometricCarbonMod diff --git a/parteh/PRTGenericMod.F90 b/parteh/PRTGenericMod.F90 index 76d0e01eda..2a14f57533 100644 --- a/parteh/PRTGenericMod.F90 +++ b/parteh/PRTGenericMod.F90 @@ -185,8 +185,9 @@ module PRTGenericMod ! over the control period real(r8),allocatable :: burned(:) ! Losses due to burn [kg] + real(r8),allocatable :: damaged(:) ! Losses due to damage [kg] -! real(r8),allocatable :: herbiv(:) ! Losses due to herbivory [kg] + ! real(r8),allocatable :: herbiv(:) ! Losses due to herbivory [kg] ! Placeholder ! To save on memory, keep this commented out, or simply @@ -241,6 +242,7 @@ module PRTGenericMod procedure :: DailyPRT => DailyPRTBase procedure :: FastPRT => FastPRTBase + procedure :: DamageRecovery => DamageRecoveryBase procedure :: GetNutrientTarget => GetNutrientTargetBase ! These are generic functions that should work on all hypotheses @@ -262,7 +264,8 @@ module PRTGenericMod procedure, non_overridable :: DeallocatePRTVartypes procedure, non_overridable :: WeightedFusePRTVartypes procedure, non_overridable :: CopyPRTVartypes - + + procedure :: AgeLeaves ! This routine may be used generically ! but also leaving the door open for over-rides @@ -542,7 +545,8 @@ subroutine InitAllocate(this) allocate(this%variables(i_var)%turnover(num_pos)) allocate(this%variables(i_var)%net_alloc(num_pos)) allocate(this%variables(i_var)%burned(num_pos)) - + allocate(this%variables(i_var)%damaged(num_pos)) + end do @@ -567,6 +571,7 @@ subroutine InitializeInitialConditions(this) this%variables(i_var)%val0(:) = un_initialized this%variables(i_var)%turnover(:) = un_initialized this%variables(i_var)%burned(:) = un_initialized + this%variables(i_var)%damaged(:) = un_initialized this%variables(i_var)%net_alloc(:) = un_initialized end do @@ -787,6 +792,7 @@ subroutine CopyPRTVartypes(this, donor_prt_obj) this%variables(i_var)%net_alloc(:) = donor_prt_obj%variables(i_var)%net_alloc(:) this%variables(i_var)%turnover(:) = donor_prt_obj%variables(i_var)%turnover(:) this%variables(i_var)%burned(:) = donor_prt_obj%variables(i_var)%burned(:) + this%variables(i_var)%damaged(:) = donor_prt_obj%variables(i_var)%damaged(:) end do this%ode_opt_step = donor_prt_obj%ode_opt_step @@ -834,6 +840,9 @@ subroutine WeightedFusePRTVartypes(this,donor_prt_obj, recipient_fuse_weight) this%variables(i_var)%burned(pos_id) = recipient_fuse_weight * this%variables(i_var)%burned(pos_id) + & (1.0_r8-recipient_fuse_weight) * donor_prt_obj%variables(i_var)%burned(pos_id) + this%variables(i_var)%damaged(pos_id) = recipient_fuse_weight * this%variables(i_var)%damaged(pos_id) + & + (1.0_r8-recipient_fuse_weight) * donor_prt_obj%variables(i_var)%damaged(pos_id) + end do end do @@ -872,6 +881,7 @@ subroutine DeallocatePRTVartypes(this) deallocate(this%variables(i_var)%net_alloc) deallocate(this%variables(i_var)%turnover) deallocate(this%variables(i_var)%burned) + deallocate(this%variables(i_var)%damaged) end do deallocate(this%variables) @@ -914,6 +924,7 @@ subroutine ZeroRates(this) this%variables(i_var)%net_alloc(:) = 0.0_r8 this%variables(i_var)%turnover(:) = 0.0_r8 this%variables(i_var)%burned(:) = 0.0_r8 + this%variables(i_var)%damaged(:) = 0.0_r8 end do end subroutine ZeroRates @@ -949,14 +960,16 @@ subroutine CheckMassConservation(this,ipft,position_id) err = abs((this%variables(i_var)%val(i_pos) - this%variables(i_var)%val0(i_pos)) - & (this%variables(i_var)%net_alloc(i_pos) & -this%variables(i_var)%turnover(i_pos) & - -this%variables(i_var)%burned(i_pos) )) - + -this%variables(i_var)%burned(i_pos) & + -this%variables(i_var)%damaged(i_pos))) + if(this%variables(i_var)%val(i_pos) > nearzero ) then rel_err = err / this%variables(i_var)%val(i_pos) else rel_err = 0.0_r8 end if + if( abs(err) > calloc_abs_error ) then write(fates_log(),*) 'PARTEH mass conservation check failed' write(fates_log(),*) ' Change in mass over control period should' @@ -973,7 +986,8 @@ subroutine CheckMassConservation(this,ipft,position_id) this%variables(i_var)%val0(i_pos), & this%variables(i_var)%net_alloc(i_pos), & this%variables(i_var)%turnover(i_pos), & - this%variables(i_var)%burned(i_pos) + this%variables(i_var)%burned(i_pos), & + this%variables(i_var)%damaged(i_pos) write(fates_log(),*) ' Exiting.' call endrun(msg=errMsg(sourcefile, __LINE__)) end if @@ -1251,17 +1265,28 @@ end subroutine DailyPRTBase ! ==================================================================================== - subroutine FastPRTBase(this) + subroutine DamageRecoveryBase(this) class(prt_vartypes) :: this - write(fates_log(),*)'FastReactiveTransport must be extended by a child class.' + write(fates_log(),*)'?' call endrun(msg=errMsg(sourcefile, __LINE__)) - end subroutine FastPRTBase + end subroutine DamageRecoveryBase ! ==================================================================================== + ! ==================================================================================== + + subroutine FastPRTBase(this) + + class(prt_vartypes) :: this + + write(fates_log(),*)'FastReactiveTransport must be extended by a child class' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end subroutine FastPRTBase + + !==================================================================================== subroutine SetState(prt,organ_id, element_id, state_val, position_id) ! This routine should only be called for initalizing the state value diff --git a/parteh/PRTLossFluxesMod.F90 b/parteh/PRTLossFluxesMod.F90 index 13b09b2e37..078d2465f9 100644 --- a/parteh/PRTLossFluxesMod.F90 +++ b/parteh/PRTLossFluxesMod.F90 @@ -1,3 +1,4 @@ + module PRTLossFluxesMod @@ -64,7 +65,9 @@ module PRTLossFluxesMod public :: PRTBurnLosses public :: PRTPhenologyFlush public :: PRTReproRelease - + public :: PRTDamageLosses + public :: PRTDamageRecoveryFluxes + contains @@ -335,7 +338,62 @@ subroutine PRTBurnLosses(prt, organ_id, mass_fraction) end associate end subroutine PRTBurnLosses + ! ===================================================================================== + subroutine PRTDamageLosses(prt, organ_id, mass_fraction) + + ! ---------------------------------------------------------------------------------- + ! This subroutine assumes that there is no re-translocation associated + ! with damage. There is only one destiny for damaged mass within + ! the organ, and that is outside the plant. + ! It is also assumed that non PARTEH parts of the code (ie the damage-model) + ! will decide what to do with the damaged mass (i.e. sent it to the litter + ! pool, or.. other?) + ! ---------------------------------------------------------------------------------- + + class(prt_vartypes) :: prt + integer,intent(in) :: organ_id + real(r8),intent(in) :: mass_fraction + + integer :: i_pos ! position index + integer :: i_var ! index for the variable of interest + integer :: i_var_of_organ ! loop counter for all element in this organ + integer :: element_id ! Element id of the turnover pool + real(r8) :: damaged_mass ! Lost mass of each element, in each + ! position, in the organ of interest + + associate(organ_map => prt_global%organ_map) + + ! This is the total number of state variables associated + ! with this particular organ + + do i_var_of_organ = 1, organ_map(organ_id)%num_vars + + i_var = organ_map(organ_id)%var_id(i_var_of_organ) + + element_id = prt_global%state_descriptor(i_var)%element_id + + ! Loop over all of the coordinate ids + do i_pos = 1,prt_global%state_descriptor(i_var)%num_pos + + ! The mass that is leaving the plant + damaged_mass = mass_fraction * prt%variables(i_var)%val(i_pos) + + ! Track the amount of mass being lost (+ is amount lost) + prt%variables(i_var)%damaged(i_pos) = prt%variables(i_var)%damaged(i_pos) & + + damaged_mass + + ! Update the state of the pool to reflect the mass lost + prt%variables(i_var)%val(i_pos) = prt%variables(i_var)%val(i_pos) & + - damaged_mass + + end do + + end do + + end associate + end subroutine PRTDamageLosses + ! ===================================================================================== @@ -811,6 +869,30 @@ subroutine MaintTurnoverSimpleRetranslocation(prt,ipft,is_drought) return end subroutine MaintTurnoverSimpleRetranslocation + !---------------------------------------------------------------------------------------------- + + subroutine PRTDamageRecoveryFluxes(prt, organ_id, mass_0, mass, cc_mass) + + class(prt_vartypes) :: prt + integer,intent(in) :: organ_id + real(r8),intent(in) :: mass_0 + real(r8),intent(in) :: mass + real(r8),intent(in) :: cc_mass + + integer, parameter :: icd = 1 + + ! Remove the amount that was copied from old cohort + prt%variables(organ_id)%net_alloc(icd) = prt%variables(organ_id)%net_alloc(icd) & + - (cc_mass - mass_0) + + + ! Track the amount of mass being lost (+ is amount lost) + prt%variables(organ_id)%net_alloc(icd) = prt%variables(organ_id)%net_alloc(icd) & + + (mass - mass_0) + + end subroutine PRTDamageRecoveryFluxes + + ! ===================================================================================== diff --git a/parteh/PRTParametersMod.F90 b/parteh/PRTParametersMod.F90 index dcf20dbd14..b7da7e95ed 100644 --- a/parteh/PRTParametersMod.F90 +++ b/parteh/PRTParametersMod.F90 @@ -26,6 +26,7 @@ module PRTParametersMod ! one class to the next [yr] real(r8), allocatable :: root_long(:) ! root turnover time (longevity) (pft) [yr] real(r8), allocatable :: branch_long(:) ! Turnover time for branchfall on live trees (pft) [yr] + real(r8), allocatable :: damage_recovery_scalar(:) ! what fraction of cohort gets to recover real(r8), allocatable :: turnover_retrans_mode(:) ! Retranslocation method (pft) real(r8), allocatable :: turnover_carb_retrans(:,:) ! carbon re-translocation fraction (pft x organ) real(r8), allocatable :: turnover_nitr_retrans(:,:) ! nitrogen re-translocation fraction (pft x organ) diff --git a/parteh/PRTParamsFATESMod.F90 b/parteh/PRTParamsFATESMod.F90 index dce172d47d..3947b067ce 100644 --- a/parteh/PRTParamsFATESMod.F90 +++ b/parteh/PRTParamsFATESMod.F90 @@ -359,8 +359,10 @@ subroutine PRTRegisterPFT(fates_params) call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - - + name = 'fates_damage_recovery_scalar' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + name = 'fates_nitr_store_ratio' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) @@ -368,7 +370,7 @@ subroutine PRTRegisterPFT(fates_params) name = 'fates_phos_store_ratio' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - + end subroutine PRTRegisterPFT !----------------------------------------------------------------------- @@ -603,6 +605,10 @@ subroutine PRTReceivePFT(fates_params) call fates_params%RetreiveParameterAllocate(name=name, & data=prt_params%turnover_retrans_mode) + name = 'fates_damage_recovery_scalar' + call fates_params%RetreiveParameterAllocate(name=name, & + data=prt_params%damage_recovery_scalar) + name = 'fates_nitr_store_ratio' call fates_params%RetreiveParameterAllocate(name=name, & data=prt_params%nitr_store_ratio) @@ -610,8 +616,7 @@ subroutine PRTReceivePFT(fates_params) name = 'fates_phos_store_ratio' call fates_params%RetreiveParameterAllocate(name=name, & data=prt_params%phos_store_ratio) - - + end subroutine PRTReceivePFT !----------------------------------------------------------------------- @@ -867,6 +872,7 @@ subroutine FatesReportPFTParams(is_master) write(fates_log(),fmt0) 'grperc = ',prt_params%grperc write(fates_log(),fmt0) 'c2b = ',prt_params%c2b write(fates_log(),fmt0) 'branch_turnover = ',prt_params%branch_long + write(fates_log(),fmt0) 'damage_recovery_scalar = ', prt_params%damage_recovery_scalar write(fates_log(),fmt0) 'allom_hmode = ',prt_params%allom_hmode write(fates_log(),fmt0) 'allom_lmode = ',prt_params%allom_lmode write(fates_log(),fmt0) 'allom_fmode = ',prt_params%allom_fmode @@ -1436,6 +1442,7 @@ function NewRecruitTotalStoichiometry(ft,element_id) result(recruit_stoich) integer,intent(in) :: ft integer,intent(in) :: element_id + real(r8) :: recruit_stoich ! nutrient to carbon ratio of recruit real(r8) :: dbh ! dbh of the new recruit [cm] @@ -1449,15 +1456,18 @@ function NewRecruitTotalStoichiometry(ft,element_id) result(recruit_stoich) real(r8) :: c_store ! target Storage biomass [kgC] real(r8) :: c_total ! total target carbon real(r8) :: nutr_total ! total target nutrient - + + + ! Since recruits have no damage we can put 1 for crown damage class and + ! branch fraction call h2d_allom(EDPftvarcon_inst%hgt_min(ft),ft,dbh) - call bleaf(dbh,ft,init_recruit_trim,c_leaf) + call bleaf(dbh,ft,1, init_recruit_trim,c_leaf) call bfineroot(dbh,ft,init_recruit_trim,c_fnrt) - call bsap_allom(dbh,ft,init_recruit_trim,a_sapw, c_sapw) - call bagw_allom(dbh,ft,c_agw) + call bsap_allom(dbh,ft,1,1.0_r8,init_recruit_trim,a_sapw, c_sapw) + call bagw_allom(dbh,ft,1,1.0_r8,c_agw) call bbgw_allom(dbh,ft,c_bgw) call bdead_allom(c_agw,c_bgw,c_sapw,ft,c_struct) - call bstore_allom(dbh,ft,init_recruit_trim,c_store) + call bstore_allom(dbh,ft,1,init_recruit_trim,c_store) ! Total carbon in a newly recruited plant c_total = c_leaf + c_fnrt + c_sapw + c_struct + c_store From d090bfd647dc4bb499c7be7f92061438ba40e953 Mon Sep 17 00:00:00 2001 From: JessicaNeedham Date: Thu, 30 Sep 2021 16:03:27 -0700 Subject: [PATCH 03/84] [ Uncomment a check that was breaking runs ] [ This check is not related to damage work and is being addressed in other issues/PRs ] Fixes: [NGT-ED Github issue #] User interface changes?: [Yes (describe what changes), No] Code review: [Names] Test suite: [suite name, machine, compilers] Test baseline: Test namelist changes: Test answer changes: [bit for bit, roundoff, climate changing] Test summary:no testing --- main/EDPftvarcon.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/main/EDPftvarcon.F90 b/main/EDPftvarcon.F90 index 3e932a51ed..36c9c1a4c8 100644 --- a/main/EDPftvarcon.F90 +++ b/main/EDPftvarcon.F90 @@ -1790,7 +1790,7 @@ subroutine FatesCheckParams(is_master) write(fates_log(),*) 'Error is:',sumarea-1.0_r8 write(fates_log(),*) 'and the hlm_pft_map is:', EDPftvarcon_inst%hlm_pft_map(1:npft,hlm_pft) write(fates_log(),*) 'Aborting' -! call endrun(msg=errMsg(sourcefile, __LINE__)) + call endrun(msg=errMsg(sourcefile, __LINE__)) end if end do !hlm_pft end do !ipft From fc3ed80288a0b29e9df90c5bb99b4436ed45215e Mon Sep 17 00:00:00 2001 From: Jessica Needham Date: Fri, 1 Oct 2021 12:00:11 -0700 Subject: [PATCH 04/84] [ Fix bug with understory number densities ] [ ] Fixes: [NGT-ED Github issue #] User interface changes?: [Yes (describe what changes), No] Code review: [Names] Test suite: [suite name, machine, compilers] Test baseline: Test namelist changes: Test answer changes: [bit for bit, roundoff, climate changing] Test summary: no testing --- biogeochem/EDPatchDynamicsMod.F90 | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 0652559ad8..df2512f208 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -1342,8 +1342,13 @@ subroutine spawn_patches( currentSite, bc_in) end do ! end crowndamage loop ! Reduce currentCohort%n now based on sum of all new damage classes - currentCohort%n = currentCohort%n - cd_n_total + if(hlm_use_canopy_damage .eq. itrue) then + currentCohort%n = currentCohort%n - cd_n_total + else if(hlm_use_understory_damage .eq. itrue) then + nc%n = nc%n - cd_n_total + end if + end if ! end if not new end if ! end if canopy and woody end if ! end if damage time From 177876b7ec484ba11108e8cffa0f95541947202b Mon Sep 17 00:00:00 2001 From: JessicaNeedham Date: Thu, 9 Dec 2021 09:44:02 -0800 Subject: [PATCH 05/84] [moving damage module to biogeochem ] [ ] Fixes: [NGT-ED Github issue #] User interface changes?: [ No] Code review: [Names] Test suite: [suite name, machine, compilers] Test baseline: Test namelist changes: Test answer changes: [bit for bit, roundoff, climate changing] Test summary: no testing --- {main => biogeochem}/DamageMainMod.F90 | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename {main => biogeochem}/DamageMainMod.F90 (100%) diff --git a/main/DamageMainMod.F90 b/biogeochem/DamageMainMod.F90 similarity index 100% rename from main/DamageMainMod.F90 rename to biogeochem/DamageMainMod.F90 From d700c60e3bc340041b578dc0294f0fe59ea28b58 Mon Sep 17 00:00:00 2001 From: JessicaNeedham Date: Thu, 9 Dec 2021 11:13:56 -0800 Subject: [PATCH 06/84] [bracket the increase in maxCohortsPerPatch in logic so it only increases when damage module is on. ] [don't change maxCohortsPerPatch in EDTypesMod but instead in FatesInterfaceMod ] Fixes: [NGT-ED Github issue #] User interface changes?: [No] Code review: [Names] Test suite: [suite name, machine, compilers] Test baseline: Test namelist changes: Test answer changes: [bit for bit, roundoff, climate changing] Test summary:no testing --- main/EDTypesMod.F90 | 3 ++- main/FatesInterfaceMod.F90 | 3 ++- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 5fde9eef56..9b955bb297 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -20,6 +20,7 @@ module EDTypesMod use FatesConstantsMod, only : days_per_year use FatesInterfaceTypesMod,only : bc_in_type use FatesInterfaceTypesMod,only : bc_out_type + use FatesInterfaceTypesMod,only : hlm_use_canopy_damage, hlm_use_understory_damage implicit none private ! By default everything is private @@ -28,7 +29,7 @@ module EDTypesMod integer, parameter, public :: maxPatchesPerSite = 14 ! maximum number of patches to live on a site integer, parameter, public :: maxPatchesPerSite_by_disttype(n_anthro_disturbance_categories) = & (/ 10, 4 /) !!! MUST SUM TO maxPatchesPerSite !!! - integer, public :: maxCohortsPerPatch = 300 ! maximum number of cohorts per patch + integer, public :: maxCohortsPerPatch = 100 ! maximum number of cohorts per patch integer, parameter, public :: nclmax = 3 ! Maximum number of canopy layers integer, parameter, public :: ican_upper = 1 ! Nominal index for the upper canopy diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 61798dc7d6..17d50b7562 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -765,7 +765,8 @@ subroutine SetFatesGlobalElements(use_fates) ! These values are used to define the restart file allocations and general structure ! of memory for the cohort arrays - if ( hlm_use_cohort_age_tracking .eq. itrue) then + if ( hlm_use_cohort_age_tracking .eq. itrue .or. & + hlm_use_canopy_damage .eq. itrue .or. hlm_use_understory_damage .eq. itrue) then maxCohortsPerPatch = 300 else maxCohortsPerPatch = 100 From 63e513d7324a573d15f90b60ce72a286ca84c849 Mon Sep 17 00:00:00 2001 From: JessicaNeedham Date: Thu, 9 Dec 2021 11:24:14 -0800 Subject: [PATCH 07/84] [ Revert number of canopy layers back to 2 ] [Increased it to 3 to work with Ryan's bci param file but reverting it to 2 for PR ] Fixes: [NGT-ED Github issue #] User interface changes?: [No] Code review: [Names] Test suite: [suite name, machine, compilers] Test baseline: Test namelist changes: Test answer changes: [bit for bit, roundoff, climate changing] Test summary:no testing --- main/EDTypesMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 9b955bb297..2d00a4c6b7 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -31,7 +31,7 @@ module EDTypesMod (/ 10, 4 /) !!! MUST SUM TO maxPatchesPerSite !!! integer, public :: maxCohortsPerPatch = 100 ! maximum number of cohorts per patch - integer, parameter, public :: nclmax = 3 ! Maximum number of canopy layers + integer, parameter, public :: nclmax = 2 ! Maximum number of canopy layers integer, parameter, public :: ican_upper = 1 ! Nominal index for the upper canopy integer, parameter, public :: ican_ustory = 2 ! Nominal index for diagnostics that refer ! to understory layers (all layers that From 7c585f9912eec29b6156ceafd14050017fe99340 Mon Sep 17 00:00:00 2001 From: JessicaNeedham Date: Wed, 15 Dec 2021 07:26:52 -0800 Subject: [PATCH 08/84] [Change min_n_safemath and min_npm2 to default values. ] [Can't remember why I changed these. Possibly to do with termination mortality? ] Fixes: [NGT-ED Github issue #] User interface changes?: [Yes (describe what changes), No] Code review: [Names] Test suite: [suite name, machine, compilers] Test baseline: Test namelist changes: Test answer changes: [bit for bit, roundoff, climate changing] Test summary:no testing --- main/EDTypesMod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 2d00a4c6b7..4bbd2f8ca8 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -167,7 +167,7 @@ module EDTypesMod ! COHORT TERMINATION - real(r8), parameter, public :: min_npm2 = 1.0E-12_r8 ! minimum cohort number density per m2 before termination + real(r8), parameter, public :: min_npm2 = 1.0E-7_r8 ! minimum cohort number density per m2 before termination real(r8), parameter, public :: min_patch_area = 0.01_r8 ! smallest allowable patch area before termination real(r8), parameter, public :: min_patch_area_forced = 0.0001_r8 ! patch termination will not fuse the youngest patch ! if the area is less than min_patch_area. @@ -175,7 +175,7 @@ module EDTypesMod ! if the fusion area is less than min_patch_area_forced real(r8), parameter, public :: min_nppatch = min_npm2*min_patch_area ! minimum number of cohorts per patch (min_npm2*min_patch_area) - real(r8), parameter, public :: min_n_safemath = 1.0E-15_r8 ! in some cases, we want to immediately remove super small + real(r8), parameter, public :: min_n_safemath = 1.0E-12_r8 ! in some cases, we want to immediately remove super small ! number densities of cohorts to prevent FPEs character*4 yearchar From 21b802ba0b7524c5e0311c2463a9e2f74edee58e Mon Sep 17 00:00:00 2001 From: JessicaNeedham Date: Wed, 15 Dec 2021 10:03:45 -0800 Subject: [PATCH 09/84] [ Remove unnecessary history variables] [ Remove the crowndamage x crowndamage dimension, remove unecessary history variables and put all damage history variables in an if statement ] Fixes: [NGT-ED Github issue #] User interface changes?: [Yes (describe what changes), No] Code review: [Names] Test suite: [suite name, machine, compilers] Test baseline: Test namelist changes: Test answer changes: [bit for bit, roundoff, climate changing] Test summary: no testing --- main/FatesHistoryInterfaceMod.F90 | 587 ++++++++---------------------- main/FatesHistoryVariableType.F90 | 11 +- main/FatesIODimensionsMod.F90 | 6 - main/FatesIOVariableKindMod.F90 | 1 - main/FatesInterfaceMod.F90 | 13 - main/FatesInterfaceTypesMod.F90 | 2 - main/FatesRestartInterfaceMod.F90 | 36 +- 7 files changed, 162 insertions(+), 494 deletions(-) diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 7232bc84f7..824b8d4691 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -656,28 +656,15 @@ Module FatesHistoryInterfaceMod integer :: ih_m11_mortality_understory_si_cdsc integer :: ih_m11_mortality_canopy_si_cdpf integer :: ih_m11_mortality_understory_si_cdpf - integer :: ih_trimming_damage_si_cdsc integer :: ih_ddbh_si_cdsc integer :: ih_ddbh_si_cdpf integer :: ih_ddbh_canopy_si_cdpf integer :: ih_ddbh_understory_si_cdpf - ! damage carbonflux - integer :: ih_damage_cflux_si_cdcd - integer :: ih_damage_rate_si_cdcd - integer :: ih_recovery_cflux_si_cdcd - integer :: ih_recovery_rate_si_cdcd + ! crownarea damaged integer :: ih_crownarea_canopy_damage_si integer :: ih_crownarea_ustory_damage_si - integer :: ih_totvegc_cdpf - integer :: ih_leafc_cdpf - integer :: ih_fnrtc_cdpf - integer :: ih_storec_cdpf - integer :: ih_sapwc_cdpf - integer :: ih_reproc_cdpf - integer :: ih_cefflux_cdpf - ! indices to (site x canopy layer) variables integer :: ih_parsun_top_si_can @@ -720,7 +707,6 @@ Module FatesHistoryInterfaceMod integer, private :: levfuel_index_, levcwdsc_index_, levscag_index_ integer, private :: levcan_index_, levcnlf_index_, levcnlfpft_index_ integer, private :: levcdpf_index_, levcdsc_index_ - integer, private :: levcdcd_index_ integer, private :: levscagpft_index_, levagepft_index_ integer, private :: levheight_index_, levagefuel_index_ integer, private :: levelem_index_, levelpft_index_ @@ -756,7 +742,6 @@ Module FatesHistoryInterfaceMod procedure :: levcan_index procedure :: levcnlf_index procedure :: levcnlfpft_index - procedure :: levcdcd_index procedure :: levcdpf_index procedure :: levcdsc_index procedure :: levscag_index @@ -788,7 +773,6 @@ Module FatesHistoryInterfaceMod procedure, private :: set_levcan_index procedure, private :: set_levcnlf_index procedure, private :: set_levcnlfpft_index - procedure, private :: set_levcdcd_index procedure, private :: set_levcdpf_index procedure, private :: set_levcdsc_index procedure, private :: set_levscag_index @@ -828,7 +812,6 @@ subroutine Init(this, num_threads, fates_bounds) use FatesIODimensionsMod, only : levscagpft, levagepft use FatesIODimensionsMod, only : levcan, levcnlf, levcnlfpft use FatesIODimensionsMod, only : levcdpf, levcdsc - use FatesIODimensionsMod, only : levcdcd use FatesIODimensionsMod, only : fates_bounds_type use FatesIODimensionsMod, only : levheight, levagefuel use FatesIODimensionsMod, only : levelem, levelpft @@ -911,11 +894,6 @@ subroutine Init(this, num_threads, fates_bounds) call this%set_levcnlfpft_index(dim_count) call this%dim_bounds(dim_count)%Init(levcnlfpft, num_threads, & fates_bounds%cnlfpft_begin, fates_bounds%cnlfpft_end) - - dim_count = dim_count + 1 - call this%set_levcdcd_index(dim_count) - call this%dim_bounds(dim_count)%Init(levcdcd, num_threads, & - fates_bounds%cdcd_begin, fates_bounds%cdcd_end) dim_count = dim_count + 1 call this%set_levcdpf_index(dim_count) @@ -1043,11 +1021,7 @@ subroutine SetThreadBoundsEach(this, thread_index, thread_bounds) index = this%levcnlfpft_index() call this%dim_bounds(index)%SetThreadBounds(thread_index, & thread_bounds%cnlfpft_begin, thread_bounds%cnlfpft_end) - - index = this%levcdcd_index() - call this%dim_bounds(index)%SetThreadBounds(thread_index, & - thread_bounds%cdcd_begin, thread_bounds%cdcd_end) - + index = this%levcdpf_index() call this%dim_bounds(index)%SetThreadBounds(thread_index, & thread_bounds%cdpf_begin, thread_bounds%cdpf_end) @@ -1108,7 +1082,7 @@ subroutine assemble_history_output_types(this) use FatesIOVariableKindMod, only : site_fuel_r8, site_cwdsc_r8, site_scag_r8 use FatesIOVariableKindMod, only : site_scagpft_r8, site_agepft_r8 use FatesIOVariableKindMod, only : site_can_r8, site_cnlf_r8, site_cnlfpft_r8 - use FatesIOVariableKindMod, only : site_cdpf_r8, site_cdsc_r8, site_cdcd_r8 + use FatesIOVariableKindMod, only : site_cdpf_r8, site_cdsc_r8 use FatesIOVariableKindMod, only : site_height_r8, site_agefuel_r8 use FatesIOVariableKindMod, only : site_elem_r8, site_elpft_r8 use FatesIOVariableKindMod, only : site_elcwd_r8, site_elage_r8 @@ -1165,9 +1139,6 @@ subroutine assemble_history_output_types(this) call this%set_dim_indices(site_cnlfpft_r8, 1, this%column_index()) call this%set_dim_indices(site_cnlfpft_r8, 2, this%levcnlfpft_index()) - call this%set_dim_indices(site_cdcd_r8, 1, this%column_index()) - call this%set_dim_indices(site_cdcd_r8, 2, this%levcdcd_index()) - call this%set_dim_indices(site_cdpf_r8, 1, this%column_index()) call this%set_dim_indices(site_cdpf_r8, 2, this%levcdpf_index()) @@ -1442,20 +1413,6 @@ integer function levcnlfpft_index(this) end function levcnlfpft_index ! ======================================================================= - subroutine set_levcdcd_index(this, index) - implicit none - class(fates_history_interface_type), intent(inout) :: this - integer, intent(in) :: index - this%levcdcd_index_ = index - end subroutine set_levcdcd_index - - integer function levcdcd_index(this) - implicit none - class(fates_history_interface_type), intent(in) :: this - levcdcd_index = this%levcdcd_index_ - end function levcdcd_index - -! ======================================================================= subroutine set_levcdpf_index(this, index) implicit none class(fates_history_interface_type), intent(inout) :: this @@ -1710,7 +1667,6 @@ subroutine init_dim_kinds_maps(this) use FatesIOVariableKindMod, only : site_scagpft_r8, site_agepft_r8 use FatesIOVariableKindMod, only : site_can_r8, site_cnlf_r8, site_cnlfpft_r8 use FatesIOVariableKindMod, only : site_cdpf_r8, site_cdsc_r8 - use FatesIOVariableKindMod, only : site_cdcd_r8 use FatesIOVariableKindMod, only : site_height_r8, site_agefuel_r8 use FatesIOVariableKindMod, only : site_elem_r8, site_elpft_r8 use FatesIOVariableKindMod, only : site_elcwd_r8, site_elage_r8 @@ -1786,11 +1742,7 @@ subroutine init_dim_kinds_maps(this) ! site x cnlfpft class index = index + 1 call this%dim_kinds(index)%Init(site_cnlfpft_r8, 2) - - ! site x crown damage x crown damage class - index = index + 1 - call this%dim_kinds(index)%Init(site_cdcd_r8, 2) - + ! site x crown damage x pft x size class index = index + 1 call this%dim_kinds(index)%Init(site_cdpf_r8, 2) @@ -1903,7 +1855,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) integer :: iagepft ! age x pft index integer :: i_agefuel ! age x fuel size class index integer :: ican, ileaf, cnlf_indx ! iterators for leaf and canopy level - integer :: icdpf, icdsc, icdcd, icdi, icdj, icdam, imcdam ! iterators for the crown damage level + integer :: icdpf, icdsc, icdi, icdj, icdam, imcdam ! iterators for the crown damage level integer :: cdpf, cdsc integer :: counter integer :: height_bin_max, height_bin_min ! which height bin a given cohort's canopy is in @@ -2103,11 +2055,6 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_nplant_understory_si_cdsc =>this%hvars(ih_nplant_understory_si_cdsc)%r82d, & hio_nplant_canopy_si_cdpf => this%hvars(ih_nplant_canopy_si_cdpf)%r82d, & hio_nplant_understory_si_cdpf =>this%hvars(ih_nplant_understory_si_cdpf)%r82d, & - hio_damage_cflux_si_cdcd => this%hvars(ih_damage_cflux_si_cdcd)%r82d, & - hio_damage_rate_si_cdcd => this%hvars(ih_damage_rate_si_cdcd)%r82d, & - hio_recovery_cflux_si_cdcd => this%hvars(ih_recovery_cflux_si_cdcd)%r82d, & - hio_recovery_rate_si_cdcd => this%hvars(ih_recovery_rate_si_cdcd)%r82d, & - hio_trimming_damage_si_cdsc => this%hvars(ih_trimming_damage_si_cdsc)%r82d, & hio_ddbh_si_cdsc => this%hvars(ih_ddbh_si_cdsc)%r82d, & hio_ddbh_si_cdpf => this%hvars(ih_ddbh_si_cdpf)%r82d, & hio_ddbh_canopy_si_cdpf => this%hvars(ih_ddbh_canopy_si_cdpf)%r82d, & @@ -2283,36 +2230,15 @@ subroutine update_history_dyn(this,nc,nsites,sites) end do - ! damage variables - site level - this needs to be OUT of the patch loop + ! damage variables - site level - this needs to be OUT of the patch loop if(hlm_use_canopy_damage .eq. itrue .or. hlm_use_understory_damage .eq. itrue) then - icdcd = 1 - - do icdi = 1,ncrowndamage+1 - do icdj = 1,ncrowndamage - hio_damage_cflux_si_cdcd(io_si,icdcd) = & - sites(s)%damage_cflux(icdj,icdi) * g_per_kg * days_per_sec * & - ha_per_m2 - hio_damage_rate_si_cdcd(io_si,icdcd) = & - sites(s)%damage_rate(icdj,icdi) - - hio_recovery_cflux_si_cdcd(io_si,icdcd) = & - sites(s)%recovery_cflux(icdj,icdi) * g_per_kg * days_per_sec * & - ha_per_m2 - hio_recovery_rate_si_cdcd(io_si,icdcd) = & - sites(s)%recovery_rate(icdj,icdi) - - - icdcd = icdcd + 1 - end do - end do - hio_crownarea_canopy_damage_si(io_si) = hio_crownarea_canopy_damage_si(io_si) + & sites(s)%crownarea_canopy_damage * days_per_year hio_crownarea_ustory_damage_si(io_si) = hio_crownarea_ustory_damage_si(io_si) + & sites(s)%crownarea_ustory_damage * days_per_year - + end if hio_canopy_spread_si(io_si) = sites(s)%spread @@ -2780,10 +2706,6 @@ 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 - - hio_trimming_damage_si_cdsc(io_si,cdsc) = hio_trimming_damage_si_cdsc(io_si,cdsc) + & - ccohort%n * ccohort%canopy_trim - ! crown damage by size hio_nplant_si_cdsc(io_si, cdsc) = hio_nplant_si_cdsc(io_si, cdsc) + ccohort%n hio_m3_si_cdsc(io_si, cdsc) = hio_m3_si_cdsc(io_si, cdsc) + ccohort%cmort * ccohort%n @@ -2804,48 +2726,10 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_ddbh_si_cdpf(io_si,cdpf) = hio_ddbh_si_cdpf(io_si,cdpf) + & ccohort%ddbhdt*ccohort%n + end if + - ! add mortality to the damage rates - - icdam = (ncrowndamage*ncrowndamage) + cdam ! to fill in the last row - - if(hlm_use_canopy_damage .eq. itrue .and. ccohort%canopy_layer == 1 .or. & - hlm_use_understory_damage .eq. itrue .and. ccohort%canopy_layer > 1) then - - hio_damage_rate_si_cdcd(io_si,icdam) = hio_damage_rate_si_cdcd(io_si,icdam) + & - (ccohort%bmort + ccohort%hmort + ccohort%cmort + & - ccohort%frmort + ccohort%smort + ccohort%asmort + ccohort%dgmort) * ccohort%n & - + (ccohort%lmort_direct + ccohort%lmort_collateral + ccohort%lmort_infra) * & - ccohort%n * sec_per_day * days_per_year - - hio_damage_cflux_si_cdcd(io_si,icdam) = hio_damage_cflux_si_cdcd(io_si,icdam) + & - (ccohort%bmort + ccohort%hmort + ccohort%cmort + & - ccohort%frmort + ccohort%smort + ccohort%asmort + ccohort%dgmort) * & - total_c * ccohort%n * g_per_kg * days_per_sec * years_per_day * ha_per_m2 + & - (ccohort%lmort_direct + ccohort%lmort_collateral + ccohort%lmort_infra) * total_c * & - ccohort%n * g_per_kg * ha_per_m2 - - end if - - ! all crown layers go towards recovery - hio_recovery_rate_si_cdcd(io_si,icdam) = hio_recovery_rate_si_cdcd(io_si,icdam) + & - (ccohort%bmort + ccohort%hmort + ccohort%cmort + & - ccohort%frmort + ccohort%smort + ccohort%asmort + ccohort%dgmort) * ccohort%n & - + (ccohort%lmort_direct + ccohort%lmort_collateral + ccohort%lmort_infra) * & - ccohort%n * sec_per_day * days_per_year - - hio_recovery_cflux_si_cdcd(io_si,icdam) = hio_recovery_cflux_si_cdcd(io_si,icdam) + & - (ccohort%bmort + ccohort%hmort + ccohort%cmort + & - ccohort%frmort + ccohort%smort + ccohort%asmort + ccohort%dgmort) * & - total_c * ccohort%n * g_per_kg * days_per_sec * years_per_day * ha_per_m2 + & - (ccohort%lmort_direct + ccohort%lmort_collateral + ccohort%lmort_infra) * total_c * & - ccohort%n * g_per_kg * ha_per_m2 - - - end if ! end if damage - - - + ! number density along the cohort age dimension if (hlm_use_cohort_age_tracking .eq.itrue) then hio_nplant_si_capf(io_si,capf) = hio_nplant_si_capf(io_si,capf) + ccohort%n @@ -3460,69 +3344,12 @@ subroutine update_history_dyn(this,nc,nsites,sites) sites(s)%imort_rate_damage(icdam, i_scls, i_pft) + & sites(s)%fmort_rate_ustory_damage(icdam, i_scls, i_pft) - - ! recovery is both canopy layers combined - imcdam = icdam + (ncrowndamage * ncrowndamage) - hio_recovery_rate_si_cdcd(io_si, imcdam) = hio_recovery_rate_si_cdcd(io_si, imcdam) + & - sites(s)%term_nindivs_canopy_damage(icdam, i_scls, i_pft) * days_per_year + & - sites(s)%term_nindivs_ustory_damage(icdam, i_scls, i_pft) * days_per_year + & - sites(s)%imort_rate_damage(icdam, i_scls, i_pft) + & - sites(s)%fmort_rate_canopy_damage(icdam, i_scls, i_pft) + & - sites(s)%fmort_rate_ustory_damage(icdam, i_scls, i_pft) - - hio_recovery_cflux_si_cdcd(io_si, imcdam) = hio_recovery_cflux_si_cdcd(io_si, imcdam) + & - sites(s)%imort_cflux_damage(icdam, i_scls) + & - sites(s)%term_cflux_canopy_damage(icdam, i_scls)*g_per_kg*days_per_sec*ha_per_m2 + & - sites(s)%term_cflux_ustory_damage(icdam, i_scls)*g_per_kg*days_per_sec*ha_per_m2 + & - sites(s)%fmort_cflux_canopy_damage(icdam, i_scls) + & - sites(s)%fmort_cflux_ustory_damage(icdam, i_scls) - - end do end do end do end if - ! only track damage in the canopy layer of interest - if(hlm_use_canopy_damage .eq. itrue ) then - do icdam = 1, ncrowndamage - do i_scls = 1,nlevsclass - do i_pft = 1, numpft - - imcdam = icdam + (ncrowndamage * ncrowndamage) - hio_damage_rate_si_cdcd(io_si, imcdam) = hio_damage_rate_si_cdcd(io_si, imcdam) + & - sites(s)%term_nindivs_canopy_damage(icdam, i_scls, i_pft) * days_per_year + & - sites(s)%fmort_rate_canopy_damage(icdam, i_scls, i_pft) - - hio_damage_cflux_si_cdcd(io_si, imcdam) = hio_damage_cflux_si_cdcd(io_si, imcdam) + & - sites(s)%term_cflux_canopy_damage(icdam, i_scls)*g_per_kg*days_per_sec*ha_per_m2 + & - sites(s)%fmort_cflux_canopy_damage(icdam, i_scls)*g_per_kg*days_per_sec*ha_per_m2 - end do - end do - end do - end if - - if(hlm_use_understory_damage .eq. itrue ) then - do icdam = 1, ncrowndamage - do i_scls = 1,nlevsclass - do i_pft = 1,numpft - - imcdam = icdam + (ncrowndamage * ncrowndamage) - hio_damage_rate_si_cdcd(io_si, imcdam) = hio_damage_rate_si_cdcd(io_si, imcdam) + & - sites(s)%term_nindivs_ustory_damage(icdam, i_scls, i_pft) * days_per_year + & - sites(s)%imort_rate_damage(icdam, i_scls, i_pft) + & - sites(s)%fmort_rate_ustory_damage(icdam, i_scls, i_pft) - - hio_damage_cflux_si_cdcd(io_si, imcdam) = hio_damage_cflux_si_cdcd(io_si, imcdam) + & - sites(s)%imort_cflux_damage(icdam, i_scls) + & - sites(s)%term_cflux_ustory_damage(icdam, i_scls)*g_per_kg*days_per_sec*ha_per_m2 + & - sites(s)%fmort_cflux_canopy_damage(icdam, i_scls) - end do - end do - end do - end if - sites(s)%term_nindivs_canopy(:,:) = 0._r8 sites(s)%term_nindivs_ustory(:,:) = 0._r8 sites(s)%imort_carbonflux = 0._r8 @@ -3670,16 +3497,6 @@ subroutine update_history_dyn(this,nc,nsites,sites) this%hvars(ih_cefflux_si)%r81d(io_si) = & sum(sites(s)%flux_diags(el)%nutrient_efflux_scpf(:),dim=1) - if(hlm_use_canopy_damage .eq. itrue .or. hlm_use_understory_damage .eq. itrue)then - this%hvars(ih_totvegc_cdpf)%r82d(io_si,:) = 0._r8 - this%hvars(ih_leafc_cdpf)%r82d(io_si,:) = 0._r8 - this%hvars(ih_fnrtc_cdpf)%r82d(io_si,:) = 0._r8 - this%hvars(ih_sapwc_cdpf)%r82d(io_si,:) = 0._r8 - this%hvars(ih_storec_cdpf)%r82d(io_si,:) = 0._r8 - this%hvars(ih_reproc_cdpf)%r82d(io_si,:) = 0._r8 - end if - - elseif(element_list(el).eq.nitrogen_element)then this%hvars(ih_totvegn_scpf)%r82d(io_si,:) = 0._r8 @@ -3864,41 +3681,6 @@ subroutine update_history_dyn(this,nc,nsites,sites) ccohort => ccohort%shorter end do - if(hlm_use_canopy_damage .eq. itrue .or. hlm_use_understory_damage .eq. itrue) then - ! Load Mass States - ccohort => cpatch%tallest - do while(associated(ccohort)) - - sapw_m = ccohort%prt%GetState(sapw_organ, element_list(el)) - struct_m = ccohort%prt%GetState(struct_organ, element_list(el)) - leaf_m = ccohort%prt%GetState(leaf_organ, element_list(el)) - fnrt_m = ccohort%prt%GetState(fnrt_organ, element_list(el)) - store_m = ccohort%prt%GetState(store_organ, element_list(el)) - repro_m = ccohort%prt%GetState(repro_organ, element_list(el)) - total_m = sapw_m+struct_m+leaf_m+fnrt_m+store_m+repro_m - - icdpf = get_cdamagesizepft_class_index(ccohort%dbh, ccohort%crowndamage, ccohort%pft) - - if(element_list(el).eq.carbon12_element)then - this%hvars(ih_totvegc_cdpf)%r82d(io_si,icdpf) = & - this%hvars(ih_totvegc_cdpf)%r82d(io_si,icdpf) + total_m * ccohort%n - this%hvars(ih_leafc_cdpf)%r82d(io_si,icdpf) = & - this%hvars(ih_leafc_cdpf)%r82d(io_si,icdpf) + leaf_m * ccohort%n - this%hvars(ih_fnrtc_cdpf)%r82d(io_si,icdpf) = & - this%hvars(ih_fnrtc_cdpf)%r82d(io_si,icdpf) + fnrt_m * ccohort%n - this%hvars(ih_sapwc_cdpf)%r82d(io_si,icdpf) = & - this%hvars(ih_sapwc_cdpf)%r82d(io_si,icdpf) + sapw_m * ccohort%n - this%hvars(ih_storec_cdpf)%r82d(io_si,icdpf) = & - this%hvars(ih_storec_cdpf)%r82d(io_si,icdpf) + store_m * ccohort%n - this%hvars(ih_reproc_cdpf)%r82d(io_si,icdpf) = & - this%hvars(ih_reproc_cdpf)%r82d(io_si,icdpf) + repro_m * ccohort%n - end if - - ccohort => ccohort%shorter - end do - end if - - cpatch => cpatch%younger end do @@ -4853,7 +4635,6 @@ subroutine define_history_vars(this, initialize_variables) use FatesIOVariableKindMod, only : site_fuel_r8, site_cwdsc_r8, site_scag_r8 use FatesIOVariableKindMod, only : site_can_r8, site_cnlf_r8, site_cnlfpft_r8 use FatesIOVariableKindMod, only : site_cdsc_r8, site_cdpf_r8 - use FatesIOVariableKindMod, only : site_cdcd_r8 use FatesIOVariableKindMod, only : site_scagpft_r8, site_agepft_r8 use FatesIOVariableKindMod, only : site_elem_r8, site_elpft_r8 use FatesIOVariableKindMod, only : site_elcwd_r8, site_elage_r8 @@ -6080,11 +5861,6 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype =site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m10_si_scpf ) - call this%set_history_var(vname='M11_SCPF', units = 'N/ha/yr', & - long='damage mortality by pft/size',use_default='inactive', & - avgflag='A', vtype =site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m11_si_scpf ) - call this%set_history_var(vname='M10_CAPF',units='N/ha/yr', & long='age senescence mortality by pft/cohort age',use_default='inactive', & avgflag='A', vtype =site_coage_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & @@ -6611,204 +6387,157 @@ subroutine define_history_vars(this, initialize_variables) long='RESP_M for understory plants by size class', use_default='inactive', & avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=2, ivar=ivar, initialize=initialize_variables, index = ih_resp_m_understory_si_scls ) - - - ! CROWN DAMAGE VARIABLES - - call this%set_history_var(vname='DAMAGE_CFLUX_CDCD', units = 'g C / m2 / sec', & - long='damage carbonflux between damage classes', use_default='inactive', & - avgflag='A', vtype=site_cdcd_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_damage_cflux_si_cdcd ) - - call this%set_history_var(vname='DAMAGE_RATE_CDCD', units = 'N / ha / year', & - long='damage rate between damage classes', use_default='inactive', & - avgflag='A', vtype=site_cdcd_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_damage_rate_si_cdcd ) - - call this%set_history_var(vname='RECOVERY_CFLUX_CDCD', units = 'g C / m2 / sec', & - long='recovery carbonflux between damage classes', use_default='inactive', & - avgflag='A', vtype=site_cdcd_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_recovery_cflux_si_cdcd ) - - call this%set_history_var(vname='RECOVERY_RATE_CDCD', units = 'N / ha / year', & - long='recovery rate between damage classes', use_default='inactive', & - avgflag='A', vtype=site_cdcd_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_recovery_rate_si_cdcd ) - - call this%set_history_var(vname='CROWNAREA_CANOPY_DAMAGE', units = 'm2 / ha / year', & - long='crownarea lost to damage each year', use_default='inactive', & - avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_crownarea_canopy_damage_si ) - - call this%set_history_var(vname='CROWNAREA_USTORY_DAMAGE', units = 'm2 / ha / year', & - long='crownarea lost to damage each year', use_default='inactive', & - avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_crownarea_ustory_damage_si ) - - call this%set_history_var(vname='NPLANT_CDSC', units = 'N / damage x size class / ha / yr', & - long='N. plants per damage x size class', use_default='inactive', & - avgflag='A', vtype=site_cdsc_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_nplant_si_cdsc ) - - call this%set_history_var(vname='NPLANT_CDPF', units = 'N / damage x size x pft class / ha / yr', & - long='N. plants per damage x size x pft class', use_default='inactive', & - avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_nplant_si_cdpf ) - - call this%set_history_var(vname='NPLANT_CANOPY_CDSC', units = 'N / damage x size class / ha / yr', & - long='N. plants in the canopy per damage x size class', use_default='inactive', & - avgflag='A', vtype=site_cdsc_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_nplant_canopy_si_cdsc ) - - call this%set_history_var(vname='NPLANT_CANOPY_CDPF', units = 'N / damage x size x pft class / ha / yr', & - long='N. plants per damage x size x pft class', use_default='inactive', & - avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_nplant_canopy_si_cdpf ) - - call this%set_history_var(vname='NPLANT_UNDERSTORY_CDSC', units = 'N / damage x size class / ha / yr', & - long='N. plants in the understory per damage x size class', use_default='inactive', & - avgflag='A', vtype=site_cdsc_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_nplant_understory_si_cdsc ) - - call this%set_history_var(vname='NPLANT_UNDERSTORY_CDPF', units = 'N / damage x size x pft class / ha / yr', & - long='N. plants in the understory per damage x size x pft class', use_default='inactive', & - avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_nplant_understory_si_cdpf ) - - call this%set_history_var(vname='M3_CDPF', units = 'N/ha/yr', & - long='carbon starvation mortality by damaage/pft/size', use_default='inactive', & - avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m3_si_cdpf ) - - call this%set_history_var(vname='M3_CDSC', units = 'N/ha/yr', & - long='carbon starvation mortality by damage/size', use_default='inactive', & - avgflag='A', vtype=site_cdsc_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m3_si_cdsc ) - - call this%set_history_var(vname='M11_CDPF', units = 'N/ha/yr', & - long='damage mortality by damaage/pft/size', use_default='inactive', & - avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m11_si_cdpf ) - call this%set_history_var(vname='M11_CDSC', units = 'N/ha/yr', & - long='damage mortality by damage/size', use_default='inactive', & - avgflag='A', vtype=site_cdsc_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m11_si_cdsc ) - - call this%set_history_var(vname='MORTALITY_CDSC', units = 'N/ha/yr', & - long='mortality by damage class by size', use_default='inactive', & - avgflag='A', vtype=site_cdsc_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_mortality_si_cdsc ) - - call this%set_history_var(vname='MORTALITY_CDPF', units = 'N/ha/yr', & - long='mortality by damage class by size by pft', use_default='inactive', & - avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_mortality_si_cdpf ) - call this%set_history_var(vname='M3_MORTALITY_CANOPY_CDSC', units = 'indiv/ha/yr', & - long='C starviation mortality of canopy trees by damage/size class', use_default='inactive', & - avgflag='A', vtype=site_cdsc_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m3_mortality_canopy_si_cdsc) - - call this%set_history_var(vname='M3_MORTALITY_CANOPY_CDPF', units = 'N/ha/yr', & - long='C starvation mortality of canopy plants by damage/pft/size', use_default='inactive', & - avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m3_mortality_canopy_si_cdpf ) + ! CROWN DAMAGE VARIABLES + if(hlm_use_canopy_damage .eq. itrue .or. hlm_use_understory_damage .eq. itrue) then + + call this%set_history_var(vname='CROWNAREA_CANOPY_DAMAGE', units = 'm2 / ha / year', & + long='crownarea lost to damage each year', use_default='inactive', & + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_crownarea_canopy_damage_si ) + + call this%set_history_var(vname='CROWNAREA_USTORY_DAMAGE', units = 'm2 / ha / year', & + long='crownarea lost to damage each year', use_default='inactive', & + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_crownarea_ustory_damage_si ) + + call this%set_history_var(vname='NPLANT_CDSC', units = 'N / damage x size class / ha / yr', & + long='N. plants per damage x size class', use_default='inactive', & + avgflag='A', vtype=site_cdsc_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_nplant_si_cdsc ) + + call this%set_history_var(vname='NPLANT_CDPF', units = 'N / damage x size x pft class / ha / yr', & + long='N. plants per damage x size x pft class', use_default='inactive', & + avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_nplant_si_cdpf ) + + call this%set_history_var(vname='NPLANT_CANOPY_CDSC', units = 'N / damage x size class / ha / yr', & + long='N. plants in the canopy per damage x size class', use_default='inactive', & + avgflag='A', vtype=site_cdsc_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_nplant_canopy_si_cdsc ) + + call this%set_history_var(vname='NPLANT_CANOPY_CDPF', units = 'N / damage x size x pft class / ha / yr', & + long='N. plants per damage x size x pft class', use_default='inactive', & + avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_nplant_canopy_si_cdpf ) + + call this%set_history_var(vname='NPLANT_UNDERSTORY_CDSC', units = 'N / damage x size class / ha / yr', & + long='N. plants in the understory per damage x size class', use_default='inactive', & + avgflag='A', vtype=site_cdsc_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_nplant_understory_si_cdsc ) + + call this%set_history_var(vname='NPLANT_UNDERSTORY_CDPF', units = 'N / damage x size x pft class / ha / yr', & + long='N. plants in the understory per damage x size x pft class', use_default='inactive', & + avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_nplant_understory_si_cdpf ) + + call this%set_history_var(vname='M3_CDPF', units = 'N/ha/yr', & + long='carbon starvation mortality by damaage/pft/size', use_default='inactive', & + avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m3_si_cdpf ) + + call this%set_history_var(vname='M3_CDSC', units = 'N/ha/yr', & + long='carbon starvation mortality by damage/size', use_default='inactive', & + avgflag='A', vtype=site_cdsc_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m3_si_cdsc ) + + call this%set_history_var(vname='M11_SCPF', units = 'N/ha/yr', & + long='damage mortality by pft/size',use_default='inactive', & + avgflag='A', vtype =site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m11_si_scpf ) + + call this%set_history_var(vname='M11_CDPF', units = 'N/ha/yr', & + long='damage mortality by damaage/pft/size', use_default='inactive', & + avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m11_si_cdpf ) + + call this%set_history_var(vname='M11_CDSC', units = 'N/ha/yr', & + long='damage mortality by damage/size', use_default='inactive', & + avgflag='A', vtype=site_cdsc_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m11_si_cdsc ) + + call this%set_history_var(vname='MORTALITY_CDSC', units = 'N/ha/yr', & + long='mortality by damage class by size', use_default='inactive', & + avgflag='A', vtype=site_cdsc_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_mortality_si_cdsc ) + + call this%set_history_var(vname='MORTALITY_CDPF', units = 'N/ha/yr', & + long='mortality by damage class by size by pft', use_default='inactive', & + avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_mortality_si_cdpf ) + + call this%set_history_var(vname='M3_MORTALITY_CANOPY_CDSC', units = 'indiv/ha/yr', & + long='C starviation mortality of canopy trees by damage/size class', use_default='inactive', & + avgflag='A', vtype=site_cdsc_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m3_mortality_canopy_si_cdsc) + + call this%set_history_var(vname='M3_MORTALITY_CANOPY_CDPF', units = 'N/ha/yr', & + long='C starvation mortality of canopy plants by damage/pft/size', use_default='inactive', & + avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m3_mortality_canopy_si_cdpf ) + + call this%set_history_var(vname='M3_MORTALITY_UNDERSTORY_CDPF', units = 'N/ha/yr', & + long='C starvation mortality of understory plants by pft/size', use_default='inactive', & + avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m3_mortality_understory_si_cdpf ) + + call this%set_history_var(vname='M3_MORTALITY_UNDERSTORY_CDSC', units = 'indiv/ha/yr', & + long='C starvation mortality of understory trees by damage/size class', use_default='inactive', & + avgflag='A', vtype=site_cdsc_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m3_mortality_understory_si_cdsc) + + call this%set_history_var(vname='M11_MORTALITY_CANOPY_CDSC', units = 'indiv/ha/yr', & + long='damage mortality of canopy trees by damage/size class', use_default='inactive', & + avgflag='A', vtype=site_cdsc_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m11_mortality_canopy_si_cdsc) + + call this%set_history_var(vname='M11_MORTALITY_CANOPY_CDPF', units = 'N/ha/yr', & + long='damage mortality of canopy plants by damage/pft/size', use_default='inactive', & + avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m11_mortality_canopy_si_cdpf ) + + call this%set_history_var(vname='M11_MORTALITY_UNDERSTORY_CDPF', units = 'N/ha/yr', & + long='damage mortality of understory plants by pft/size', use_default='inactive', & + avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m11_mortality_understory_si_cdpf ) + + call this%set_history_var(vname='MORTALITY_CANOPY_CDPF', units = 'N/ha/yr', & + long='mortality of canopy plants by damage/pft/size', use_default='inactive', & + avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_mortality_canopy_si_cdpf ) + + call this%set_history_var(vname='MORTALITY_UNDERSTORY_CDPF', units = 'N/ha/yr', & + long='mortality of understory plants by pft/size', use_default='inactive', & + avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_mortality_understory_si_cdpf ) + + call this%set_history_var(vname='M11_MORTALITY_UNDERSTORY_CDSC', units = 'indiv/ha/yr', & + long='damage mortality of understory trees by damage/size class', use_default='inactive', & + avgflag='A', vtype=site_cdsc_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m11_mortality_understory_si_cdsc) + + call this%set_history_var(vname='DDBH_CDSC', units = 'cm/year/ha', & + long='ddbh annual increment growth by damage and size', use_default='inactive', & + avgflag='A', vtype=site_cdsc_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_ddbh_si_cdsc ) + + call this%set_history_var(vname='DDBH_CDPF', units = 'cm/year/ha', & + long='ddbh annual increment growth by damage x size pft', use_default='inactive', & + avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_ddbh_si_cdpf ) + + call this%set_history_var(vname='DDBH_CANOPY_CDPF', units = 'cm/year/ha', & + long='ddbh annual canopy increment growth by damage x size pft', use_default='inactive', & + avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_ddbh_canopy_si_cdpf ) + + call this%set_history_var(vname='DDBH_UNDERSTORY_CDPF', units = 'cm/year/ha', & + long='ddbh annual understory increment growth by damage x size pft', use_default='inactive', & + avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_ddbh_understory_si_cdpf ) - call this%set_history_var(vname='M3_MORTALITY_UNDERSTORY_CDPF', units = 'N/ha/yr', & - long='C starvation mortality of understory plants by pft/size', use_default='inactive', & - avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m3_mortality_understory_si_cdpf ) - - call this%set_history_var(vname='M3_MORTALITY_UNDERSTORY_CDSC', units = 'indiv/ha/yr', & - long='C starvation mortality of understory trees by damage/size class', use_default='inactive', & - avgflag='A', vtype=site_cdsc_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m3_mortality_understory_si_cdsc) - - call this%set_history_var(vname='M11_MORTALITY_CANOPY_CDSC', units = 'indiv/ha/yr', & - long='damage mortality of canopy trees by damage/size class', use_default='inactive', & - avgflag='A', vtype=site_cdsc_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m11_mortality_canopy_si_cdsc) - - call this%set_history_var(vname='M11_MORTALITY_CANOPY_CDPF', units = 'N/ha/yr', & - long='damage mortality of canopy plants by damage/pft/size', use_default='inactive', & - avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m11_mortality_canopy_si_cdpf ) - - call this%set_history_var(vname='M11_MORTALITY_UNDERSTORY_CDPF', units = 'N/ha/yr', & - long='damage mortality of understory plants by pft/size', use_default='inactive', & - avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m11_mortality_understory_si_cdpf ) - - call this%set_history_var(vname='MORTALITY_CANOPY_CDPF', units = 'N/ha/yr', & - long='mortality of canopy plants by damage/pft/size', use_default='inactive', & - avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_mortality_canopy_si_cdpf ) - - call this%set_history_var(vname='MORTALITY_UNDERSTORY_CDPF', units = 'N/ha/yr', & - long='mortality of understory plants by pft/size', use_default='inactive', & - avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_mortality_understory_si_cdpf ) - - call this%set_history_var(vname='M11_MORTALITY_UNDERSTORY_CDSC', units = 'indiv/ha/yr', & - long='damage mortality of understory trees by damage/size class', use_default='inactive', & - avgflag='A', vtype=site_cdsc_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m11_mortality_understory_si_cdsc) - - call this%set_history_var(vname='TRIMMING_DAMAGE_CDSC', units = 'indiv/ha', & - long='trimming term of plants by size class by damage class', use_default='inactive', & - avgflag='A', vtype=site_cdsc_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_trimming_damage_si_cdsc ) - - call this%set_history_var(vname='DDBH_CDSC', units = 'cm/year/ha', & - long='ddbh annual increment growth by damage and size', use_default='inactive', & - avgflag='A', vtype=site_cdsc_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_ddbh_si_cdsc ) - - call this%set_history_var(vname='DDBH_CDPF', units = 'cm/year/ha', & - long='ddbh annual increment growth by damage x size pft', use_default='inactive', & - avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_ddbh_si_cdpf ) - - call this%set_history_var(vname='DDBH_CANOPY_CDPF', units = 'cm/year/ha', & - long='ddbh annual canopy increment growth by damage x size pft', use_default='inactive', & - avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_ddbh_canopy_si_cdpf ) - - call this%set_history_var(vname='DDBH_UNDERSTORY_CDPF', units = 'cm/year/ha', & - long='ddbh annual understory increment growth by damage x size pft', use_default='inactive', & - avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_ddbh_understory_si_cdpf ) - - call this%set_history_var(vname='TOTVEGC_CDPF', units='kgC/ha', & - long='total vegetation carbon mass in live plants by damage x size-class x pft', use_default='inactive', & - avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_totvegc_cdpf ) - - call this%set_history_var(vname='LEAFC_CDPF', units='kgC/ha', & - long='leaf carbon mass by damage x size-class x pft', use_default='inactive', & - avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_leafc_cdpf ) - - call this%set_history_var(vname='FNRTC_CDPF', units='kgC/ha', & - long='fine-root carbon mass by damage x size-class x pft', use_default='inactive', & - avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_fnrtc_cdpf ) - - call this%set_history_var(vname='SAPWC_CDPF', units='kgC/ha', & - long='sapwood carbon mass by damage x size-class x pft', use_default='inactive', & - avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_sapwc_cdpf ) - - call this%set_history_var(vname='STOREC_CDPF', units='kgC/ha', & - long='storage carbon mass by damage x size-class x pft', use_default='inactive', & - avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_storec_cdpf ) - - call this%set_history_var(vname='REPROC_CDPF', units='kgC/ha', & - long='reproductive carbon mass (on plant) by damage x size-class x pft', use_default='inactive', & - avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_reproc_cdpf ) + end if ! CARBON BALANCE VARIABLES THAT DEPEND ON HLM BGC INPUTS diff --git a/main/FatesHistoryVariableType.F90 b/main/FatesHistoryVariableType.F90 index ee8aa9d858..5263bf3ec2 100644 --- a/main/FatesHistoryVariableType.F90 +++ b/main/FatesHistoryVariableType.F90 @@ -13,7 +13,6 @@ module FatesHistoryVariableType use FatesIOVariableKindMod, only : site_scagpft_r8, site_agepft_r8 use FatesIOVariableKindMod, only : site_can_r8, site_cnlf_r8, site_cnlfpft_r8 use FatesIOVariableKindMod, only : site_cdamage_r8, site_cdsc_r8, site_cdpf_r8 - use FatesIOVariableKindMod, only : site_cdcd_r8 use FatesIOVariableKindMod, only : site_elem_r8, site_elpft_r8 use FatesIOVariableKindMod, only : site_elcwd_r8, site_elage_r8 use FatesIOVariableKindMod, only : iotype_index, site_agefuel_r8 @@ -175,15 +174,11 @@ subroutine Init(this, vname, units, long, use_default, & allocate(this%r82d(lb1:ub1, lb2:ub2)) this%r82d(:,:) = flushval - case(site_cdamage_r8) + case(site_cdsc_r8) allocate(this%r82d(lb1:ub1, lb2:ub2)) this%r82d(:,:) = flushval - case(site_cdcd_r8) - allocate(this%r82d(lb1:ub1, lb2:ub2)) - this%r82d(:,:) = flushval - - case(site_cdsc_r8) + case(site_cdamage_r8) allocate(this%r82d(lb1:ub1, lb2:ub2)) this%r82d(:,:) = flushval @@ -336,8 +331,6 @@ subroutine Flush(this, thread, dim_bounds, dim_kinds) this%r82d(lb1:ub1, lb2:ub2) = this%flushval case(site_cdamage_r8) this%r82d(lb1:ub1, lb2:ub2) = this%flushval - case(site_cdcd_r8) - this%r82d(lb1:ub1, lb2:ub2) = this%flushval case(site_cdsc_r8) this%r82d(lb1:ub1, lb2:ub2) = this%flushval case(site_cdpf_r8) diff --git a/main/FatesIODimensionsMod.F90 b/main/FatesIODimensionsMod.F90 index 58cb898632..09bead9bc4 100644 --- a/main/FatesIODimensionsMod.F90 +++ b/main/FatesIODimensionsMod.F90 @@ -27,7 +27,6 @@ module FatesIODimensionsMod character(*), parameter, public :: levcan = 'fates_levcan' ! matches histFileMod character(*), parameter, public :: levcnlf = 'fates_levcnlf' ! matches histFileMod character(*), parameter, public :: levcnlfpft = 'fates_levcnlfpf' ! matches histFileMod - character(*), parameter, public :: levcdcd = 'fates_levcdcd' ! matches histFileMod character(*), parameter, public :: levcdsc = 'fates_levcdsc' ! matches histFileMod character(*), parameter, public :: levcdpf = 'fates_levcdpf' ! matches histFileMod character(*), parameter, public :: levagefuel = 'fates_levagefuel' ! matches histFileMod @@ -83,9 +82,6 @@ module FatesIODimensionsMod ! levcnlfpft = This is a structure that records the boundaries for the ! number of canopy layer x leaf layer x pft dimension - ! levcdcd = This is a structure that records the boundaries for the - ! number of crown damage x crown damage classes - for diagnostic fluxes - ! levcdsc = This is a structure that records the boundaries for the ! number of crown damage x size classes dimension @@ -151,8 +147,6 @@ module FatesIODimensionsMod integer :: cnlfpft_end integer :: cdamage_begin integer :: cdamage_end - integer :: cdcd_begin - integer :: cdcd_end integer :: cdsc_begin integer :: cdsc_end integer :: cdpf_begin diff --git a/main/FatesIOVariableKindMod.F90 b/main/FatesIOVariableKindMod.F90 index 06f6c421ea..749ced2c35 100644 --- a/main/FatesIOVariableKindMod.F90 +++ b/main/FatesIOVariableKindMod.F90 @@ -32,7 +32,6 @@ module FatesIOVariableKindMod character(*), parameter, public :: site_cnlf_r8 = 'SI_CNLF_R8' character(*), parameter, public :: site_cnlfpft_r8 = 'SI_CNLFPFT_R8' character(*), parameter, public :: site_cdamage_r8 = 'SI_CDAMAGE_R8' - character(*), parameter, public :: site_cdcd_r8 = 'SI_CDCD_R8' character(*), parameter, public :: site_cdpf_r8 = 'SI_CDPF_R8' character(*), parameter, public :: site_cdsc_r8 = 'SI_CDSC_R8' character(*), parameter, public :: site_scag_r8 = 'SI_SCAG_R8' diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 17d50b7562..50b11093b8 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -964,7 +964,6 @@ subroutine fates_history_maps integer :: ifuel integer :: ican integer :: icdam - integer :: icdcd integer :: ileaf integer :: iage integer :: iheight @@ -984,8 +983,6 @@ subroutine fates_history_maps allocate( fates_hdim_camap_levcapf(1:nlevcoage*numpft)) allocate( fates_hdim_levcdam(ncrowndamage )) - allocate( fates_hdim_cdimap_levcdcd(ncrowndamage*(ncrowndamage+1))) - allocate( fates_hdim_cdjmap_levcdcd(ncrowndamage*(ncrowndamage+1))) allocate( fates_hdim_scmap_levcdsc(nlevsclass*ncrowndamage)) allocate( fates_hdim_cdmap_levcdsc(nlevsclass*ncrowndamage)) allocate( fates_hdim_scmap_levcdpf(nlevsclass*ncrowndamage * numpft)) @@ -1128,16 +1125,6 @@ subroutine fates_history_maps end do end do - i=0 - do icdam=1,ncrowndamage - do icdcd=1,ncrowndamage+1 - i=i+1 - fates_hdim_cdimap_levcdcd(i) = icdcd - fates_hdim_cdjmap_levcdcd(i) = icdam - end do - end do - - i=0 do ipft=1,numpft do ican=1,nclmax diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index b53e891ad1..f0b3b7b09d 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -245,8 +245,6 @@ module FatesInterfaceTypesMod integer , public, allocatable :: fates_hdim_scmap_levcdpf(:) ! map of size into size x crowndamage x pft integer , public, allocatable :: fates_hdim_cdmap_levcdsc(:) ! map of crowndamage into size x crowndamage integer , public, allocatable :: fates_hdim_scmap_levcdsc(:) ! map of size into size x crowndamage - integer , public, allocatable :: fates_hdim_cdimap_levcdcd(:) ! map of current damage into damage x damage + mortality - integer , public, allocatable :: fates_hdim_cdjmap_levcdcd(:) ! map of new damage into damage x damage + mortality real(r8), public, allocatable :: fates_hdim_levage(:) ! patch age lower bound dimension real(r8), public, allocatable :: fates_hdim_levheight(:) ! height lower bound dimension diff --git a/main/FatesRestartInterfaceMod.F90 b/main/FatesRestartInterfaceMod.F90 index e8a0469d1d..42be152cb7 100644 --- a/main/FatesRestartInterfaceMod.F90 +++ b/main/FatesRestartInterfaceMod.F90 @@ -1752,7 +1752,6 @@ subroutine set_restart_vectors(this,nc,nsites,sites) integer :: io_idx_si_cacls ! each cohort age class index within site integer :: io_idx_si_cdsc ! each damage-class x size class within site integer :: io_idx_si_cdpf ! each damage-class x size x pft within site - integer :: io_idx_si_cdcd ! each damage x damage within site (plus mortality) integer :: io_idx_si_cwd ! each site-cwd index integer :: io_idx_si_pft ! each site-pft index integer :: io_idx_si_vtmem ! indices for veg-temp memory at site @@ -1931,7 +1930,6 @@ subroutine set_restart_vectors(this,nc,nsites,sites) io_idx_si_sc = io_idx_co_1st io_idx_si_capf = io_idx_co_1st io_idx_si_cacls= io_idx_co_1st - io_idx_si_cdcd = io_idx_co_1st io_idx_si_cdsc = io_idx_co_1st io_idx_si_cdpf = io_idx_co_1st @@ -2284,23 +2282,6 @@ subroutine set_restart_vectors(this,nc,nsites,sites) ! this only copies live portions of transitions - but that's ok because the mortality ! bit only needs to be added for history outputs if(hlm_use_canopy_damage .eq. itrue .or. hlm_use_understory_damage .eq. itrue) then - do icdi = 1,ncrowndamage - do icdj = 1,ncrowndamage+1 - - rio_damage_cflux_sicd(io_idx_si_cdcd) = & - sites(s)%damage_cflux(icdi,icdj) - rio_damage_rate_sicd(io_idx_si_cdcd) = & - sites(s)%damage_rate(icdi,icdj) - - rio_recovery_cflux_sicd(io_idx_si_cdcd) = & - sites(s)%recovery_cflux(icdi,icdj) - rio_recovery_rate_sicd(io_idx_si_cdcd) = & - sites(s)%recovery_rate(icdi,icdj) - - io_idx_si_cdcd = io_idx_si_cdcd + 1 - - end do - end do do i_scls = 1, nlevsclass do i_cdam = 1, ncrowndamage @@ -2663,7 +2644,6 @@ subroutine get_restart_vectors(this, nc, nsites, sites) integer :: io_idx_si_sc ! each size-class index within site integer :: io_idx_si_cacls ! each coage class index within site integer :: io_idx_si_capf ! each cohort age class x pft index within site - integer :: io_idx_si_cdcd ! each damage x damage class within site + mortality integer :: io_idx_si_cwd integer :: io_idx_si_pft integer :: io_idx_si_cdsc ! each damage x size class within site @@ -2831,7 +2811,6 @@ subroutine get_restart_vectors(this, nc, nsites, sites) io_idx_si_sc = io_idx_co_1st io_idx_si_capf = io_idx_co_1st io_idx_si_cacls= io_idx_co_1st - io_idx_si_cdcd = io_idx_co_1st io_idx_si_cdsc = io_idx_co_1st io_idx_si_cdpf = io_idx_co_1st @@ -3240,21 +3219,10 @@ subroutine get_restart_vectors(this, nc, nsites, sites) sites(s)%crownarea_canopy_damage = rio_crownarea_cano_damage_si(io_idx_si) sites(s)%crownarea_ustory_damage = rio_crownarea_usto_damage_si(io_idx_si) - - ! this only copies live portions of transitions - but that's ok because the mortality - ! bit only needs to be added for history outputs - do icdi = 1,ncrowndamage - do icdj = 1,ncrowndamage+1 - sites(s)%damage_cflux(icdi,icdj) = rio_damage_cflux_sicd(io_idx_si_cdcd) - sites(s)%damage_rate(icdi,icdj) = rio_damage_rate_sicd(io_idx_si_cdcd) - sites(s)%recovery_cflux(icdi,icdj) = rio_recovery_cflux_sicd(io_idx_si_cdcd) - sites(s)%recovery_rate(icdi,icdj) = rio_recovery_rate_sicd(io_idx_si_cdcd) - io_idx_si_cdcd = io_idx_si_cdcd + 1 - end do - end do + end if - + sites(s)%term_carbonflux_canopy = rio_termcflux_cano_si(io_idx_si) sites(s)%term_carbonflux_ustory = rio_termcflux_usto_si(io_idx_si) From efeb6802235def56b3b1d3c10b5435f6ed123c53 Mon Sep 17 00:00:00 2001 From: JessicaNeedham Date: Thu, 16 Dec 2021 03:26:25 -0800 Subject: [PATCH 10/84] [ Add comments to FatesAllometry related to crown damage ] [ ] Fixes: [NGT-ED Github issue #] User interface changes?: [Yes (describe what changes), No] Code review: [Names] Test suite: [suite name, machine, compilers] Test baseline: Test namelist changes: Test answer changes: [bit for bit, roundoff, climate changing] Test summary:no testing --- biogeochem/FatesAllometryMod.F90 | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/biogeochem/FatesAllometryMod.F90 b/biogeochem/FatesAllometryMod.F90 index d94b5d4adb..8ea994d7fd 100644 --- a/biogeochem/FatesAllometryMod.F90 +++ b/biogeochem/FatesAllometryMod.F90 @@ -172,7 +172,7 @@ subroutine CheckIntegratedAllometries(dbh,ipft,crowndamage, branch_frac, & real(r8),intent(in) :: dbh ! diameter of plant [cm] integer,intent(in) :: ipft ! plant functional type index - integer,intent(in) :: crowndamage + integer,intent(in) :: crowndamage ! crowndamage [1: undamaged, >1 damaged] real(r8),intent(in) :: branch_frac real(r8),intent(in) :: canopy_trim ! trimming function real(r8),intent(in) :: bl ! integrated leaf biomass [kgC] @@ -367,7 +367,7 @@ subroutine bagw_allom(d,ipft,crowndamage, branch_frac, bagw,dbagwdd) real(r8),intent(in) :: d ! plant diameter [cm] integer(i4),intent(in) :: ipft ! PFT index - integer(i4),intent(in) :: crowndamage + integer(i4),intent(in) :: crowndamage ! crowndamage [1: undamaged, >1: damaged] real(r8),intent(in) :: branch_frac real(r8),intent(out) :: bagw ! biomass above ground woody tissues real(r8),intent(out),optional :: dbagwdd ! change in agbw per diameter [kgC/cm] @@ -460,7 +460,7 @@ subroutine carea_allom(dbh,nplant,site_spread,ipft,crowndamage,c_area,inverse) real(r8),intent(in) :: site_spread ! site level spread factor (crowdedness) real(r8),intent(in) :: nplant ! number of plants [1/ha] integer(i4),intent(in) :: ipft ! PFT index - integer(i4),intent(in) :: crowndamage ! crown damage class of the cohort + integer(i4),intent(in) :: crowndamage ! crown damage class [1: undamaged, >1: damaged] real(r8),intent(inout) :: c_area ! crown area per cohort (m2) logical,optional,intent(in) :: inverse ! if true, calculate dbh from crown area ! instead of crown area from dbh @@ -545,7 +545,7 @@ subroutine bleaf(d,ipft,crowndamage,canopy_trim,bl,dbldd) real(r8),intent(in) :: d ! plant diameter [cm] integer(i4),intent(in) :: ipft ! PFT index - integer(i4),intent(in) :: crowndamage ! crown damage class + integer(i4),intent(in) :: crowndamage ! crown damage class [1: undamaged, >1: damaged] real(r8),intent(in) :: canopy_trim ! trimming function real(r8),intent(out) :: bl ! plant leaf biomass [kg] real(r8),intent(out),optional :: dbldd ! change leaf bio per diameter [kgC/cm] @@ -897,7 +897,7 @@ subroutine bsap_allom(d,ipft,crowndamage, branch_frac, canopy_trim,sapw_area,bsa real(r8),intent(in) :: d ! plant diameter [cm] integer(i4),intent(in) :: ipft ! PFT index - integer(i4),intent(in) :: crowndamage + integer(i4),intent(in) :: crowndamage ! Crown damage class [1: undamaged, >1: damaged] real(r8),intent(in) :: branch_frac real(r8),intent(in) :: canopy_trim real(r8),intent(out) :: sapw_area ! cross section area of @@ -1067,7 +1067,7 @@ subroutine bstore_allom(d,ipft,crowndamage, canopy_trim,bstore,dbstoredd) real(r8),intent(in) :: d ! plant diameter [cm] integer(i4),intent(in) :: ipft ! PFT index - integer(i4),intent(in) :: crowndamage ! Crowndamage class + integer(i4),intent(in) :: crowndamage ! Crowndamage class [1: undamaged, >1: damaged] real(r8),intent(in) :: canopy_trim ! Crown trimming function [0-1] real(r8),intent(out) :: bstore ! allometric target storage [kgC] real(r8),intent(out),optional :: dbstoredd ! change storage per cm [kgC/cm] @@ -2089,7 +2089,7 @@ subroutine carea_2pwr(dbh,spread,d2bl_p2,d2bl_ediff,d2ca_min,d2ca_max,c_area,inv real(r8),intent(in) :: d2ca_max ! maximum diameter to crown area scaling factor real(r8),intent(inout) :: c_area ! crown area for one plant [m2] logical,intent(in) :: inverse ! if true, calculate dbh from crown area rather than its reverse - integer,intent(in) :: crowndamage + integer,intent(in) :: crowndamage ! crowndamage class [1: undamaged, >1: damaged] real(r8) :: crown_area_to_dbh_exponent real(r8) :: spreadterm ! Effective 2bh to crown area scaling factor @@ -2409,7 +2409,7 @@ subroutine ForceDBH( ipft, canopy_trim, d, h, bdead, bl, crowndamage, branch_fra integer(i4),intent(in) :: ipft ! PFT index - integer(i4),intent(in),optional :: crowndamage ! crowndamage + integer(i4),intent(in),optional :: crowndamage ! crowndamage [1: undamaged, >1: damaged] real(r8),intent(in) :: canopy_trim real(r8),intent(inout) :: d ! plant diameter [cm] real(r8),intent(out) :: h ! plant height From 7484d25c728bff5cbc110b21d7bbabcd62a82cfd Mon Sep 17 00:00:00 2001 From: JessicaNeedham Date: Thu, 16 Dec 2021 03:41:13 -0800 Subject: [PATCH 11/84] [ Correct typo in parameter file ] [ crowndamage to crown damage ] Fixes: [NGT-ED Github issue #] User interface changes?: [Yes (describe what changes), No] Code review: [Names] Test suite: [suite name, machine, compilers] Test baseline: Test namelist changes: Test answer changes: [bit for bit, roundoff, climate changing] Test summary:no testing --- parameter_files/fates_params_default.cdl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/parameter_files/fates_params_default.cdl b/parameter_files/fates_params_default.cdl index ea363ba20f..1b32af9f95 100644 --- a/parameter_files/fates_params_default.cdl +++ b/parameter_files/fates_params_default.cdl @@ -167,7 +167,7 @@ variables: fates_damage_recovery_scalar:long_name = "fraction of cohort that recovers from damage"; double fates_ncrowndamage ; fates_ncrowndamage: units = "unitless" ; - fates_ncrowndamage: long_name = "number of crowndamage classes" ; + fates_ncrowndamage: long_name = "number of crown damage classes" ; double fates_c2b(fates_pft) ; fates_c2b:units = "ratio" ; fates_c2b:long_name = "Carbon to biomass multiplier of bulk structural tissues" ; From c00b89db72d0af358e32ae8ac5e1f14783cb8c9f Mon Sep 17 00:00:00 2001 From: JessicaNeedham Date: Thu, 16 Dec 2021 03:55:53 -0800 Subject: [PATCH 12/84] [Update comments in parameter file with more details on frequency of damage events. ] [ ] Fixes: [NGT-ED Github issue #] User interface changes?: [Yes (describe what changes), No] Code review: [Names] Test suite: [suite name, machine, compilers] Test baseline: Test namelist changes: Test answer changes: [bit for bit, roundoff, climate changing] Test summary:no testing --- parameter_files/fates_params_default.cdl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/parameter_files/fates_params_default.cdl b/parameter_files/fates_params_default.cdl index 1b32af9f95..57efe0fa61 100644 --- a/parameter_files/fates_params_default.cdl +++ b/parameter_files/fates_params_default.cdl @@ -155,7 +155,7 @@ variables: fates_branch_turnover:long_name = "turnover time of branches" ; double fates_damage_frac(fates_pft) ; fates_damage_frac:units = "fraction"; - fates_damage_frac:long_name = "fraction of cohort damaged in each damage event"; + fates_damage_frac:long_name = "fraction of cohort damaged in each damage event (event frequency specified in the is_it_damage_time subroutine)"; double fates_damage_mort_p1(fates_pft) ; fates_damage_mort_p1:units = "fraction crown loss - a value of 0.8 means 50% mortality with 80% loss of crown"; fates_damage_mort_p1:long_name = "inflection point of damage mortality function - to turn off damage mortality set this to a large number" ; From 1e1242b717816b25483d216f56779ae7e2d12607 Mon Sep 17 00:00:00 2001 From: JessicaNeedham Date: Fri, 17 Dec 2021 07:45:12 -0800 Subject: [PATCH 13/84] [ Add comments on crowndamage declaration ] [ ] Fixes: [NGT-ED Github issue #] User interface changes?: [Yes (describe what changes), No] Code review: [Names] Test suite: [suite name, machine, compilers] Test baseline: Test namelist changes: Test answer changes: [bit for bit, roundoff, climate changing] Test summary: no testing --- main/EDTypesMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 4bbd2f8ca8..77311ae426 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -221,7 +221,7 @@ module EDTypesMod real(r8) :: sapwmemory ! target sapwood biomass- set from previous year: kGC per indiv real(r8) :: structmemory ! target structural biomass- set from previous year: kGC per indiv integer :: canopy_layer ! canopy status of cohort (1 = canopy, 2 = understorey, etc.) - integer :: crowndamage ! crown damage class of the cohort + integer :: crowndamage ! crown damage class of the cohort [1: undamaged, >1: damaged] real(r8) :: canopy_layer_yesterday ! recent canopy status of cohort ! (1 = canopy, 2 = understorey, etc.) ! real to be conservative during fusion From b2937abbd365d5aae03aae3ec46f345cb5bef669 Mon Sep 17 00:00:00 2001 From: JessicaNeedham Date: Mon, 10 Jan 2022 08:28:14 -0800 Subject: [PATCH 14/84] [ Remove old damage history dimensions and fix bugs with damage history outputs ] [ Remove damage only history dimension. Fix bug with crownarea by damage and mortality. ] Fixes: [NGT-ED Github issue #] User interface changes?: [Yes (describe what changes), No] Code review: [Names] Test suite: [suite name, machine, compilers] Test baseline: Test namelist changes: Test answer changes: [bit for bit, roundoff, climate changing] Test summary:no testing --- main/FatesHistoryInterfaceMod.F90 | 80 ++++++++++++++++++++++++++++--- main/FatesHistoryVariableType.F90 | 8 +--- main/FatesIOVariableKindMod.F90 | 1 - 3 files changed, 74 insertions(+), 15 deletions(-) diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 7cc50efc4b..47f4f3503a 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -1791,11 +1791,10 @@ subroutine init_dim_kinds_maps(this) index = index + 1 call this%dim_kinds(index)%Init(site_cdpf_r8, 2) - ! site x crowndamage x size class + ! site x crown damage x size class index = index + 1 call this%dim_kinds(index)%Init(site_cdsc_r8, 2) - ! site x size-class x age class index = index + 1 call this%dim_kinds(index)%Init(site_scag_r8, 2) @@ -1899,8 +1898,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) integer :: iagepft ! age x pft index integer :: i_agefuel ! age x fuel size class index integer :: ican, ileaf, cnlf_indx ! iterators for leaf and canopy level - integer :: icdpf, icdsc, icdi, icdj, icdam, imcdam ! iterators for the crown damage level - integer :: cdpf, cdsc + integer :: icdpf, icdsc, icdam, cdpf, cdsc ! iterators for the crown damage level integer :: counter integer :: height_bin_max, height_bin_min ! which height bin a given cohort's canopy is in integer :: i_heightbin ! iterator for height bins @@ -1948,7 +1946,6 @@ subroutine update_history_dyn(this,nc,nsites,sites) real(r8), parameter :: tiny = 1.e-5_r8 ! some small number real(r8), parameter :: reallytalltrees = 1000. ! some large number (m) - real(r8) :: total_c ! for damage integer :: tmp @@ -2030,8 +2027,8 @@ subroutine update_history_dyn(this,nc,nsites,sites) 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_understory_si_scpf => this%hvars(ih_mortality_understory_si_scpf)%r82d, & - hio_m3_mortality_canopy_si_scpf => this%hvars(ih_m3_mortality_canopy_si_scpf)%r82d, & - hio_m3_mortality_understory_si_scpf => this%hvars(ih_m3_mortality_understory_si_scpf)%r82d, & + hio_m3_mortality_canopy_si_scpf => this%hvars(ih_m3_mortality_canopy_si_scpf)%r82d, & + hio_m3_mortality_understory_si_scpf => this%hvars(ih_m3_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, & hio_ddbh_canopy_si_scpf => this%hvars(ih_ddbh_canopy_si_scpf)%r82d, & @@ -2920,6 +2917,13 @@ 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 + hio_canopy_mortality_crownarea_si(io_si) = hio_canopy_mortality_crownarea_si(io_si) + & + (ccohort%bmort + ccohort%hmort + ccohort%cmort + & + ccohort%frmort + ccohort%smort + ccohort%asmort + ccohort%dgmort) * & + ccohort%c_area + & + (ccohort%lmort_direct + ccohort%lmort_collateral + ccohort%lmort_infra) * & + ccohort%c_area * sec_per_day * days_per_year + hio_canopy_mortality_carbonflux_si(io_si) = hio_canopy_mortality_carbonflux_si(io_si) + & (ccohort%bmort + ccohort%hmort + ccohort%cmort + & ccohort%frmort + ccohort%smort + ccohort%asmort + ccohort%dgmort) * & @@ -3054,6 +3058,14 @@ subroutine update_history_dyn(this,nc,nsites,sites) total_m * ccohort%n * days_per_sec * years_per_day * ha_per_m2 + & (ccohort%lmort_direct + ccohort%lmort_collateral + ccohort%lmort_infra) * total_m * & ccohort%n * ha_per_m2 + + hio_understory_mortality_crownarea_si(io_si) = hio_understory_mortality_crownarea_si(io_si) + & + (ccohort%bmort + ccohort%hmort + ccohort%cmort + & + ccohort%frmort + ccohort%smort + ccohort%asmort + ccohort%dgmort) * & + ccohort%c_area + & + (ccohort%lmort_direct + ccohort%lmort_collateral + ccohort%lmort_infra) * & + ccohort%c_area * sec_per_day * days_per_year + hio_carbon_balance_understory_si_scls(io_si,scls) = hio_carbon_balance_understory_si_scls(io_si,scls) + & ccohort%npp_acc_hold * ccohort%n / m2_per_ha / days_per_year / sec_per_day @@ -3807,6 +3819,17 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_understory_mortality_carbonflux_si(io_si) = hio_understory_mortality_carbonflux_si(io_si) + & sites(s)%term_carbonflux_ustory * days_per_sec * ha_per_m2 + + ! add site level mortality counting to crownarea diagnostic + hio_canopy_mortality_crownarea_si(io_si) = hio_canopy_mortality_crownarea_si(io_si) + & + sites(s)%fmort_crownarea_canopy + & + sites(s)%term_crownarea_canopy * days_per_year + + hio_understory_mortality_crownarea_si(io_si) = hio_understory_mortality_crownarea_si(io_si) + & + sites(s)%fmort_crownarea_ustory + & + sites(s)%term_crownarea_ustory * days_per_year + & + sites(s)%imort_crownarea + ! and zero the site-level termination carbon flux variable sites(s)%term_carbonflux_canopy = 0._r8 sites(s)%term_carbonflux_ustory = 0._r8 @@ -5780,6 +5803,20 @@ subroutine define_history_vars(this, initialize_variables) upfreq=1, ivar=ivar, initialize=initialize_variables, & index = ih_understory_mortality_carbonflux_si) + call this%set_history_var(vname='MORTALITY_CROWNAREA_CANOPY', & + units = 'm2/ha/year', & + long='Crown area of canopy trees that died', & + use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & + upfreq=1, ivar=ivar, initialize=initialize_variables, & + index = ih_canopy_mortality_crownarea_si ) + + call this%set_history_var(vname='MORTALITY_CROWNAREA_UNDERSTORY', & + units = 'm2/ha/year', & + long='Crown aera of understory trees that died', & + use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & + upfreq=1, ivar=ivar, initialize=initialize_variables, & + index = ih_understory_mortality_crownarea_si ) + ! size class by age dimensioned variables call this%set_history_var(vname='FATES_NPLANT_SZAP', units = 'm-2', & @@ -6110,6 +6147,20 @@ subroutine define_history_vars(this, initialize_variables) hlms='CLM:ALM', upfreq=1, ivar=ivar, & initialize=initialize_variables, index = ih_mortality_canopy_si_scpf) + call this%set_history_var(vname='FATES_M3_MORTALITY_CANOPY_SZPF', & + units = 'N/ha/yr', & + long='C starvation mortality of canopy plants by pft/size', & + use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & + hlms='CLM:ALM', upfreq=1, ivar=ivar, & + initialize=initialize_variables, index = ih_m3_mortality_canopy_si_scpf ) + + call this%set_history_var(vname='FATES_M3_MORTALITY_USTORY_SZPF', & + units = 'N/ha/yr', & + long='C starvation mortality of understory plants by pft/size', & + use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & + hlms='CLM:ALM', upfreq=1, ivar=ivar, & + initialize=initialize_variables, index = ih_m3_mortality_understory_si_scpf ) + call this%set_history_var(vname='FATES_C13DISC_SZPF', units = 'per mil', & long='C13 discrimination by pft/size',use_default='inactive', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', & @@ -6351,6 +6402,21 @@ subroutine define_history_vars(this, initialize_variables) hlms='CLM:ALM', upfreq=1, ivar=ivar, & initialize=initialize_variables, index = ih_nplant_understory_si_scls) + call this%set_history_var(vname='FATES_M3_MORTALITY_CANOPY_SZ', & + units = 'N/ha/yr', & + long='C starvation mortality of canopy plants by size', & + use_default='inactive', avgflag='A', vtype=site_size_r8, & + hlms='CLM:ALM', upfreq=1, ivar=ivar, & + initialize=initialize_variables, index = ih_m3_mortality_canopy_si_scls ) + + call this%set_history_var(vname='FATES_M3_MORTALITY_USTORY_SZ', & + units = 'N/ha/yr', & + long='C starvation mortality of understory plants by size', & + use_default='inactive', avgflag='A', vtype=site_size_r8, & + hlms='CLM:ALM', upfreq=1, ivar=ivar, & + initialize=initialize_variables, index = ih_m3_mortality_understory_si_scls ) + + call this%set_history_var(vname='FATES_LAI_USTORY_SZ', & units = 'm2 m-2', & long='leaf area index (LAI) of understory plants by size class', & diff --git a/main/FatesHistoryVariableType.F90 b/main/FatesHistoryVariableType.F90 index 5263bf3ec2..4102d93112 100644 --- a/main/FatesHistoryVariableType.F90 +++ b/main/FatesHistoryVariableType.F90 @@ -12,7 +12,7 @@ module FatesHistoryVariableType use FatesIOVariableKindMod, only : site_fuel_r8, site_cwdsc_r8, site_scag_r8 use FatesIOVariableKindMod, only : site_scagpft_r8, site_agepft_r8 use FatesIOVariableKindMod, only : site_can_r8, site_cnlf_r8, site_cnlfpft_r8 - use FatesIOVariableKindMod, only : site_cdamage_r8, site_cdsc_r8, site_cdpf_r8 + use FatesIOVariableKindMod, only : site_cdsc_r8, site_cdpf_r8 use FatesIOVariableKindMod, only : site_elem_r8, site_elpft_r8 use FatesIOVariableKindMod, only : site_elcwd_r8, site_elage_r8 use FatesIOVariableKindMod, only : iotype_index, site_agefuel_r8 @@ -178,10 +178,6 @@ subroutine Init(this, vname, units, long, use_default, & allocate(this%r82d(lb1:ub1, lb2:ub2)) this%r82d(:,:) = flushval - case(site_cdamage_r8) - allocate(this%r82d(lb1:ub1, lb2:ub2)) - this%r82d(:,:) = flushval - case(site_cdpf_r8) allocate(this%r82d(lb1:ub1, lb2:ub2)) this%r82d(:,:) = flushval @@ -329,8 +325,6 @@ subroutine Flush(this, thread, dim_bounds, dim_kinds) this%r82d(lb1:ub1, lb2:ub2) = this%flushval case(site_cnlfpft_r8) this%r82d(lb1:ub1, lb2:ub2) = this%flushval - case(site_cdamage_r8) - this%r82d(lb1:ub1, lb2:ub2) = this%flushval case(site_cdsc_r8) this%r82d(lb1:ub1, lb2:ub2) = this%flushval case(site_cdpf_r8) diff --git a/main/FatesIOVariableKindMod.F90 b/main/FatesIOVariableKindMod.F90 index 749ced2c35..a40f1c2dbe 100644 --- a/main/FatesIOVariableKindMod.F90 +++ b/main/FatesIOVariableKindMod.F90 @@ -31,7 +31,6 @@ module FatesIOVariableKindMod character(*), parameter, public :: site_can_r8 = 'SI_CAN_R8' character(*), parameter, public :: site_cnlf_r8 = 'SI_CNLF_R8' character(*), parameter, public :: site_cnlfpft_r8 = 'SI_CNLFPFT_R8' - character(*), parameter, public :: site_cdamage_r8 = 'SI_CDAMAGE_R8' character(*), parameter, public :: site_cdpf_r8 = 'SI_CDPF_R8' character(*), parameter, public :: site_cdsc_r8 = 'SI_CDSC_R8' character(*), parameter, public :: site_scag_r8 = 'SI_SCAG_R8' From ca903c4c5083836cdd655ba6e7bfdf09296b83e9 Mon Sep 17 00:00:00 2001 From: JessicaNeedham Date: Mon, 10 Jan 2022 10:58:14 -0800 Subject: [PATCH 15/84] [ update units on damage history variables ] [ update damage history variable units to be in line with recent history output refactor ] Fixes: [NGT-ED Github issue #] User interface changes?: [Yes (describe what changes), No] Code review: [Names] Test suite: [suite name, machine, compilers] Test baseline: Test namelist changes: Test answer changes: [bit for bit, roundoff, climate changing] Test summary: no testing --- main/FatesHistoryInterfaceMod.F90 | 163 ++++++++++++++++-------------- 1 file changed, 86 insertions(+), 77 deletions(-) diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 47f4f3503a..0c641c655d 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -69,7 +69,6 @@ Module FatesHistoryInterfaceMod use FatesConstantsMod , only : years_per_day use FatesConstantsMod , only : m2_per_km2 use FatesConstantsMod , only : J_per_kJ - use FatesConstantsMod , only : m2_per_ha use FatesConstantsMod , only : m_per_cm use FatesConstantsMod , only : sec_per_min use FatesConstantsMod , only : umol_per_mol @@ -2267,10 +2266,10 @@ subroutine update_history_dyn(this,nc,nsites,sites) if(hlm_use_canopy_damage .eq. itrue .or. hlm_use_understory_damage .eq. itrue) then hio_crownarea_canopy_damage_si(io_si) = hio_crownarea_canopy_damage_si(io_si) + & - sites(s)%crownarea_canopy_damage * days_per_year + sites(s)%crownarea_canopy_damage * days_per_year * 1 / m2_per_ha hio_crownarea_ustory_damage_si(io_si) = hio_crownarea_ustory_damage_si(io_si) + & - sites(s)%crownarea_ustory_damage * days_per_year + sites(s)%crownarea_ustory_damage * days_per_year * 1 / m2_per_ha end if @@ -2788,36 +2787,42 @@ subroutine update_history_dyn(this,nc,nsites,sites) ! crown damage - only want cohorts > 1 cm dbh here so we can compare it with data hio_mortality_si_cdsc(io_si,cdsc) = hio_mortality_si_cdsc(io_si,cdsc) + & - (ccohort%bmort + ccohort%hmort + ccohort%cmort + & - ccohort%frmort + ccohort%smort + ccohort%asmort + ccohort%dgmort) * ccohort%n + & + (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%frmort + & + ccohort%smort + ccohort%asmort + ccohort%dgmort) * ccohort%n / m2_per_ha + & (ccohort%lmort_direct + ccohort%lmort_collateral + ccohort%lmort_infra) * & - ccohort%n * sec_per_day * days_per_year + ccohort%n * sec_per_day * days_per_year / m2_per_ha hio_mortality_si_cdpf(io_si,cdpf) = hio_mortality_si_cdpf(io_si,cdpf) + & - (ccohort%bmort + ccohort%hmort + ccohort%cmort + & - ccohort%frmort + ccohort%smort + ccohort%asmort + ccohort%dgmort) * ccohort%n + & + (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%frmort + & + ccohort%smort + ccohort%asmort + ccohort%dgmort) * ccohort%n / m2_per_ha + & (ccohort%lmort_direct + ccohort%lmort_collateral + ccohort%lmort_infra) * & - ccohort%n * sec_per_day * days_per_year + ccohort%n * sec_per_day * days_per_year / m2_per_ha ! crown damage by size - hio_nplant_si_cdsc(io_si, cdsc) = hio_nplant_si_cdsc(io_si, cdsc) + ccohort%n - hio_m3_si_cdsc(io_si, cdsc) = hio_m3_si_cdsc(io_si, cdsc) + ccohort%cmort * ccohort%n + hio_nplant_si_cdsc(io_si, cdsc) = hio_nplant_si_cdsc(io_si, cdsc) + ccohort%n / m2_per_ha + hio_m3_si_cdsc(io_si, cdsc) = hio_m3_si_cdsc(io_si, cdsc) + & + ccohort%cmort * ccohort%n / m2_per_ha ! crown damage by size by pft - hio_nplant_si_cdpf(io_si, cdpf) = hio_nplant_si_cdpf(io_si, cdpf) + ccohort%n - hio_m3_si_cdpf(io_si, cdpf) = hio_m3_si_cdpf(io_si, cdpf) + ccohort%cmort * ccohort%n + hio_nplant_si_cdpf(io_si, cdpf) = hio_nplant_si_cdpf(io_si, cdpf) + ccohort%n / m2_per_ha + hio_m3_si_cdpf(io_si, cdpf) = hio_m3_si_cdpf(io_si, cdpf) + & + ccohort%cmort * ccohort%n / m2_per_ha ! mortality - hio_m11_si_scpf(io_si,scpf) = hio_m11_si_scpf(io_si,scpf) + ccohort%dgmort*ccohort%n - hio_m11_si_scls(io_si,scls) = hio_m11_si_scls(io_si,scls) + ccohort%dgmort*ccohort%n - hio_m11_si_cdpf(io_si,cdpf) = hio_m11_si_cdpf(io_si,cdpf) + ccohort%dgmort*ccohort%n - hio_m11_si_cdsc(io_si,cdsc) = hio_m11_si_cdsc(io_si,cdsc) + ccohort%dgmort*ccohort%n + hio_m11_si_scpf(io_si,scpf) = hio_m11_si_scpf(io_si,scpf) + & + ccohort%dgmort*ccohort%n / m2_per_ha + hio_m11_si_scls(io_si,scls) = hio_m11_si_scls(io_si,scls) + & + ccohort%dgmort*ccohort%n / m2_per_ha + hio_m11_si_cdpf(io_si,cdpf) = hio_m11_si_cdpf(io_si,cdpf) + & + ccohort%dgmort*ccohort%n / m2_per_ha + hio_m11_si_cdsc(io_si,cdsc) = hio_m11_si_cdsc(io_si,cdsc) + & + ccohort%dgmort*ccohort%n / m2_per_ha hio_ddbh_si_cdsc(io_si,cdsc) = hio_ddbh_si_cdsc(io_si,cdsc) + & - ccohort%ddbhdt*ccohort%n + ccohort%ddbhdt*ccohort%n / m2_per_ha * m_per_cm hio_ddbh_si_cdpf(io_si,cdpf) = hio_ddbh_si_cdpf(io_si,cdpf) + & - ccohort%ddbhdt*ccohort%n + ccohort%ddbhdt*ccohort%n / m2_per_ha * m_per_cm end if @@ -2943,31 +2948,33 @@ subroutine update_history_dyn(this,nc,nsites,sites) ! carbon starvation mortality in the canopy by size x damage x pft hio_m3_mortality_canopy_si_cdpf(io_si,cdpf) = hio_m3_mortality_canopy_si_cdpf(io_si,cdpf)+& - ccohort%cmort * ccohort%n + ccohort%cmort * ccohort%n / m2_per_ha ! damage mortality in the canopy by size x damage x pft hio_m11_mortality_canopy_si_cdpf(io_si,cdpf) = hio_m11_mortality_canopy_si_cdpf(io_si,cdpf)+& - ccohort%dgmort * ccohort%n + ccohort%dgmort * ccohort%n / m2_per_ha ! carbon starvation mortality in the canopy by size x damage hio_m3_mortality_canopy_si_cdsc(io_si,cdsc) = hio_m3_mortality_canopy_si_cdsc(io_si,cdsc)+& - ccohort%cmort * ccohort%n + ccohort%cmort * ccohort%n / m2_per_ha ! damage mortality in the canopy by size x damage hio_m11_mortality_canopy_si_cdsc(io_si,cdsc) = hio_m11_mortality_canopy_si_cdsc(io_si,cdsc)+& - ccohort%dgmort * ccohort%n + ccohort%dgmort * ccohort%n / m2_per_ha hio_mortality_canopy_si_cdpf(io_si,cdpf) = hio_mortality_canopy_si_cdpf(io_si,cdpf)+ & - (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%frmort + & - ccohort%smort + ccohort%asmort + ccohort%dgmort) * ccohort%n + & + (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%frmort + ccohort%smort + & + ccohort%asmort + ccohort%dgmort) * ccohort%n / m2_per_ha + & (ccohort%lmort_direct + ccohort%lmort_collateral + ccohort%lmort_infra) * & - ccohort%n * sec_per_day * days_per_year + ccohort%n * sec_per_day * days_per_year / m2_per_ha ! nplants by damage - hio_nplant_canopy_si_cdpf(io_si,cdpf) = hio_nplant_canopy_si_cdpf(io_si,cdpf) + ccohort%n - hio_nplant_canopy_si_cdsc(io_si,cdsc) = hio_nplant_canopy_si_cdsc(io_si,cdsc) + ccohort%n + hio_nplant_canopy_si_cdpf(io_si,cdpf) = hio_nplant_canopy_si_cdpf(io_si,cdpf) + & + ccohort%n / m2_per_ha + hio_nplant_canopy_si_cdsc(io_si,cdsc) = hio_nplant_canopy_si_cdsc(io_si,cdsc) + & + ccohort%n / m2_per_ha ! growth rate by damage x size x pft in the canopy hio_ddbh_canopy_si_cdpf(io_si,cdpf) = hio_ddbh_canopy_si_cdpf(io_si,cdpf) + & - ccohort%ddbhdt*ccohort%n + ccohort%ddbhdt*ccohort%n / m2_per_ha * m_per_cm end if ! end if damage @@ -3076,34 +3083,36 @@ subroutine update_history_dyn(this,nc,nsites,sites) ! carbon starvation mortality in the understory by size and by size x damage hio_m3_mortality_understory_si_cdsc(io_si,cdsc) = hio_m3_mortality_understory_si_cdsc(io_si,cdsc)+& - ccohort%cmort * ccohort%n + ccohort%cmort * ccohort%n / m2_per_ha ! damage mortality in the understory by size and by size x damage hio_m11_mortality_understory_si_cdsc(io_si,cdsc) = hio_m11_mortality_understory_si_cdsc(io_si,cdsc)+& - ccohort%dgmort * ccohort%n + ccohort%dgmort * ccohort%n / m2_per_ha ! carbon mortality in the understory by damage x size x pft hio_m3_mortality_understory_si_cdpf(io_si,cdpf) = hio_m3_mortality_understory_si_cdpf(io_si,cdpf)+& - ccohort%cmort * ccohort%n + ccohort%cmort * ccohort%n / m2_per_ha ! damage in the understory by damage x size x pft hio_m11_mortality_understory_si_cdpf(io_si,cdpf) = hio_m11_mortality_understory_si_cdpf(io_si,cdpf)+& - ccohort%dgmort * ccohort%n + ccohort%dgmort * ccohort%n / m2_per_ha ! total mortality of understory cohorts by damage x size x pft hio_mortality_understory_si_cdpf(io_si,cdpf) = hio_mortality_understory_si_cdpf(io_si,cdpf)+ & - (ccohort%bmort + ccohort%hmort + ccohort%cmort + & - ccohort%frmort + ccohort%smort + ccohort%asmort + ccohort%dgmort) * ccohort%n + & + (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%frmort + & + ccohort%smort + ccohort%asmort + ccohort%dgmort) * ccohort%n / m2_per_ha + & (ccohort%lmort_direct + ccohort%lmort_collateral + ccohort%lmort_infra) * & - ccohort%n * sec_per_day * days_per_year + ccohort%n * sec_per_day * days_per_year / m2_per_ha ! number of plants in the understory by size x damage and size x damage x pft - hio_nplant_understory_si_cdsc(io_si,cdsc) = hio_nplant_understory_si_cdsc(io_si,cdsc) + ccohort%n - hio_nplant_understory_si_cdpf(io_si,cdpf) = hio_nplant_understory_si_cdpf(io_si,cdpf) + ccohort%n + hio_nplant_understory_si_cdsc(io_si,cdsc) = hio_nplant_understory_si_cdsc(io_si,cdsc) + & + ccohort%n / m2_per_ha + hio_nplant_understory_si_cdpf(io_si,cdpf) = hio_nplant_understory_si_cdpf(io_si,cdpf) + & + ccohort%n / m2_per_ha ! growth rate by size x damage x pft - understory hio_ddbh_understory_si_cdpf(io_si,cdpf) = hio_ddbh_understory_si_cdpf(io_si,cdpf) + & - ccohort%ddbhdt*ccohort%n + ccohort%ddbhdt*ccohort%n / m2_per_ha * m_per_cm end if ! end if damage @@ -3365,27 +3374,27 @@ subroutine update_history_dyn(this,nc,nsites,sites) (i_pft-1) * nlevsclass * ncrowndamage hio_mortality_si_cdsc(io_si, icdsc) = hio_mortality_si_cdsc(io_si, icdsc) + & - (sites(s)%term_nindivs_canopy_damage(icdam, i_scls, i_pft) * days_per_year) + & + ( (sites(s)%term_nindivs_canopy_damage(icdam, i_scls, i_pft) * days_per_year ) + & (sites(s)%term_nindivs_ustory_damage(icdam, i_scls, i_pft) * days_per_year) + & sites(s)%imort_rate_damage(icdam, i_scls, i_pft) + & sites(s)%fmort_rate_canopy_damage(icdam, i_scls, i_pft) + & - sites(s)%fmort_rate_ustory_damage(icdam, i_scls, i_pft) + sites(s)%fmort_rate_ustory_damage(icdam, i_scls, i_pft) ) / m2_per_ha hio_mortality_si_cdpf(io_si, icdpf) = hio_mortality_si_cdpf(io_si, icdpf) + & - (sites(s)%term_nindivs_canopy_damage(icdam, i_scls, i_pft) * days_per_year) + & + ( (sites(s)%term_nindivs_canopy_damage(icdam, i_scls, i_pft) * days_per_year) + & (sites(s)%term_nindivs_ustory_damage(icdam, i_scls, i_pft) * days_per_year) + & sites(s)%imort_rate_damage(icdam, i_scls, i_pft) + & sites(s)%fmort_rate_canopy_damage(icdam, i_scls, i_pft) + & - sites(s)%fmort_rate_ustory_damage(icdam, i_scls, i_pft) + sites(s)%fmort_rate_ustory_damage(icdam, i_scls, i_pft) ) / m2_per_ha hio_mortality_canopy_si_cdpf(io_si,icdpf) = hio_mortality_canopy_si_cdpf(io_si,icdpf) + & - sites(s)%term_nindivs_canopy_damage(icdam,i_scls,i_pft) * days_per_year + & - sites(s)%fmort_rate_canopy_damage(icdam, i_scls, i_pft) + ( sites(s)%term_nindivs_canopy_damage(icdam,i_scls,i_pft) * days_per_year + & + sites(s)%fmort_rate_canopy_damage(icdam, i_scls, i_pft) )/ m2_per_ha hio_mortality_understory_si_cdpf(io_si,icdpf) = hio_mortality_understory_si_cdpf(io_si,icdpf) + & - sites(s)%term_nindivs_ustory_damage(icdam, i_scls,i_pft) * days_per_year + & + ( sites(s)%term_nindivs_ustory_damage(icdam, i_scls,i_pft) * days_per_year + & sites(s)%imort_rate_damage(icdam, i_scls, i_pft) + & - sites(s)%fmort_rate_ustory_damage(icdam, i_scls, i_pft) + sites(s)%fmort_rate_ustory_damage(icdam, i_scls, i_pft) )/ m2_per_ha end do end do @@ -6861,152 +6870,152 @@ subroutine define_history_vars(this, initialize_variables) ! CROWN DAMAGE VARIABLES if(hlm_use_canopy_damage .eq. itrue .or. hlm_use_understory_damage .eq. itrue) then - call this%set_history_var(vname='FATES_CROWNAREA_CANOPY_CD', units = 'm2 / ha / yr', & + call this%set_history_var(vname='FATES_CROWNAREA_CANOPY_CD', units = 'm2 m-2 yr-1', & long='crownarea lost to damage each year', use_default='inactive', & avgflag='A', vtype=site_r8, hlms='CLM:ALM', & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_crownarea_canopy_damage_si ) - call this%set_history_var(vname='FATES_CROWNAREA_USTORY_CD', units = 'm2 / ha / yr', & + call this%set_history_var(vname='FATES_CROWNAREA_USTORY_CD', units = 'm2 m-2 yr-1', & long='crownarea lost to damage each year', use_default='inactive', & avgflag='A', vtype=site_r8, hlms='CLM:ALM', & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_crownarea_ustory_damage_si ) - call this%set_history_var(vname='FATES_NPLANT_SZCD', units = 'N / damage x size class / ha / yr', & + call this%set_history_var(vname='FATES_NPLANT_SZCD', units = 'm-2', & long='N. plants per damage x size class', use_default='inactive', & avgflag='A', vtype=site_cdsc_r8, hlms='CLM:ALM', & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_nplant_si_cdsc ) - call this%set_history_var(vname='FATES_NPLANT_CDPF', units = 'N / damage x size x pft class / ha / yr', & + call this%set_history_var(vname='FATES_NPLANT_CDPF', units = 'm-2', & long='N. plants per damage x size x pft class', use_default='inactive', & avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_nplant_si_cdpf ) - call this%set_history_var(vname='FATES_NPLANT_CANOPY_SZCD', units = 'N / damage x size class / ha / yr', & + call this%set_history_var(vname='FATES_NPLANT_CANOPY_SZCD', units = 'm-2', & long='N. plants in the canopy per damage x size class', use_default='inactive', & avgflag='A', vtype=site_cdsc_r8, hlms='CLM:ALM', & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_nplant_canopy_si_cdsc ) - call this%set_history_var(vname='FATES_NPLANT_CANOPY_CDPF', units = 'N / damage x size x pft class / ha / yr', & + call this%set_history_var(vname='FATES_NPLANT_CANOPY_CDPF', units = 'm-2', & long='N. plants per damage x size x pft class', use_default='inactive', & avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_nplant_canopy_si_cdpf ) - call this%set_history_var(vname='FATES_NPLANT_USTORY_SZCD', units = 'N / damage x size class / ha / yr', & + call this%set_history_var(vname='FATES_NPLANT_USTORY_SZCD', units = 'm-2', & long='N. plants in the understory per damage x size class', use_default='inactive', & avgflag='A', vtype=site_cdsc_r8, hlms='CLM:ALM', & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_nplant_understory_si_cdsc ) - call this%set_history_var(vname='FATES_NPLANT_USTORY_CDPF', units = 'N / damage x size x pft class / ha / yr', & + call this%set_history_var(vname='FATES_NPLANT_USTORY_CDPF', units = 'm-2', & long='N. plants in the understory per damage x size x pft class', use_default='inactive', & avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_nplant_understory_si_cdpf ) - call this%set_history_var(vname='FATES_M3_CDPF', units = 'N/ha/yr', & + call this%set_history_var(vname='FATES_M3_CDPF', units = 'm-2 yr-1', & long='carbon starvation mortality by damaage/pft/size', use_default='inactive', & avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m3_si_cdpf ) - call this%set_history_var(vname='FATES_M3_SZCD', units = 'N/ha/yr', & + call this%set_history_var(vname='FATES_M3_SZCD', units = 'm-2 yr-1', & long='carbon starvation mortality by damage/size', use_default='inactive', & avgflag='A', vtype=site_cdsc_r8, hlms='CLM:ALM', & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m3_si_cdsc ) - call this%set_history_var(vname='FATES_M11_SZ', units = 'N/ha/yr', & + call this%set_history_var(vname='FATES_M11_SZ', units = 'm-2 yr-1', & long='damage mortality by size',use_default='inactive', & avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m11_si_scls ) - call this%set_history_var(vname='FATES_M11_SZPF', units = 'N/ha/yr', & + call this%set_history_var(vname='FATES_M11_SZPF', units = 'm-2 yr-1', & long='damage mortality by pft/size',use_default='inactive', & avgflag='A', vtype =site_size_pft_r8, hlms='CLM:ALM', & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m11_si_scpf ) - call this%set_history_var(vname='FATES_M11_CDPF', units = 'N/ha/yr', & + call this%set_history_var(vname='FATES_M11_CDPF', units = 'm-2 yr-1', & long='damage mortality by damaage/pft/size', use_default='inactive', & avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m11_si_cdpf ) - call this%set_history_var(vname='FATES_M11_SZCD', units = 'N/ha/yr', & + call this%set_history_var(vname='FATES_M11_SZCD', units = 'm-2 yr-1', & long='damage mortality by damage/size', use_default='inactive', & avgflag='A', vtype=site_cdsc_r8, hlms='CLM:ALM', & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m11_si_cdsc ) - call this%set_history_var(vname='FATES_MORTALITY_SZCD', units = 'N/ha/yr', & + call this%set_history_var(vname='FATES_MORTALITY_SZCD', units = 'm-2 yr-1', & long='mortality by damage class by size', use_default='inactive', & avgflag='A', vtype=site_cdsc_r8, hlms='CLM:ALM', & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_mortality_si_cdsc ) - call this%set_history_var(vname='FATES_MORTALITY_CDPF', units = 'N/ha/yr', & + call this%set_history_var(vname='FATES_MORTALITY_CDPF', units = 'm-2 yr-1', & long='mortality by damage class by size by pft', use_default='inactive', & avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_mortality_si_cdpf ) - call this%set_history_var(vname='FATES_M3_MORTALITY_CANOPY_SZCD', units = 'N/ha/yr', & + call this%set_history_var(vname='FATES_M3_MORTALITY_CANOPY_SZCD', units = 'm-2 yr-1', & long='C starviation mortality of canopy trees by damage/size class', use_default='inactive', & avgflag='A', vtype=site_cdsc_r8, hlms='CLM:ALM', & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m3_mortality_canopy_si_cdsc) - call this%set_history_var(vname='FATES_M3_MORTALITY_USTORY_SZCD', units = 'N/ha/yr', & + call this%set_history_var(vname='FATES_M3_MORTALITY_USTORY_SZCD', units = 'm-2 yr-1', & long='C starviation mortality of understory trees by damage/size class', use_default='inactive', & avgflag='A', vtype=site_cdsc_r8, hlms='CLM:ALM', & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m3_mortality_understory_si_cdsc) - call this%set_history_var(vname='FATES_M3_MORTALITY_CANOPY_CDPF', units = 'N/ha/yr', & + call this%set_history_var(vname='FATES_M3_MORTALITY_CANOPY_CDPF', units = 'm-2 yr-1', & long='C starvation mortality of canopy plants by damage/pft/size', use_default='inactive', & avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m3_mortality_canopy_si_cdpf ) - call this%set_history_var(vname='FATES_M3_MORTALITY_USTORY_CDPF', units = 'N/ha/yr', & + call this%set_history_var(vname='FATES_M3_MORTALITY_USTORY_CDPF', units = 'm-2 yr-1', & long='C starvation mortality of understory plants by pft/size', use_default='inactive', & avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m3_mortality_understory_si_cdpf ) - call this%set_history_var(vname='FATES_M11_MORTALITY_CANOPY_SZCD', units = 'N/ha/yr', & + call this%set_history_var(vname='FATES_M11_MORTALITY_CANOPY_SZCD', units = 'm-2 yr-1', & long='damage mortality of canopy trees by damage/size class', use_default='inactive', & avgflag='A', vtype=site_cdsc_r8, hlms='CLM:ALM', & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m11_mortality_canopy_si_cdsc) - call this%set_history_var(vname='FATES_M11_MORTALITY_CANOPY_CDPF', units = 'N/ha/yr', & + call this%set_history_var(vname='FATES_M11_MORTALITY_CANOPY_CDPF', units = 'm-2 yr-1', & long='damage mortality of canopy plants by damage/pft/size', use_default='inactive', & avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m11_mortality_canopy_si_cdpf ) - call this%set_history_var(vname='FATES_M11_MORTALITY_USTORY_CDPF', units = 'N/ha/yr', & + call this%set_history_var(vname='FATES_M11_MORTALITY_USTORY_CDPF', units = 'm-2 yr-1', & long='damage mortality of understory plants by pft/size', use_default='inactive', & avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m11_mortality_understory_si_cdpf ) - call this%set_history_var(vname='FATES_MORTALITY_CANOPY_CDPF', units = 'N/ha/yr', & + call this%set_history_var(vname='FATES_MORTALITY_CANOPY_CDPF', units = 'm-2 yr-1', & long='mortality of canopy plants by damage/pft/size', use_default='inactive', & avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_mortality_canopy_si_cdpf ) - call this%set_history_var(vname='FATES_MORTALITY_USTORY_CDPF', units = 'N/ha/yr', & + call this%set_history_var(vname='FATES_MORTALITY_USTORY_CDPF', units = 'm-2 yr-1', & long='mortality of understory plants by pft/size', use_default='inactive', & avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_mortality_understory_si_cdpf ) - call this%set_history_var(vname='FATES_M11_MORTALITY_USTORY_SZCD', units = 'indiv/ha/yr', & + call this%set_history_var(vname='FATES_M11_MORTALITY_USTORY_SZCD', units = 'm-2 yr-1', & long='damage mortality of understory trees by damage/size class', use_default='inactive', & avgflag='A', vtype=site_cdsc_r8, hlms='CLM:ALM', & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m11_mortality_understory_si_cdsc) - call this%set_history_var(vname='FATES_DDBH_SZCD', units = 'cm/year/ha', & + call this%set_history_var(vname='FATES_DDBH_SZCD', units = 'm m-2 yr-1', & long='ddbh annual increment growth by damage and size', use_default='inactive', & avgflag='A', vtype=site_cdsc_r8, hlms='CLM:ALM', & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_ddbh_si_cdsc ) - call this%set_history_var(vname='FATES_DDBH_CDPF', units = 'cm/year/ha', & + call this%set_history_var(vname='FATES_DDBH_CDPF', units = 'm m-2 yr-1', & long='ddbh annual increment growth by damage x size pft', use_default='inactive', & avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_ddbh_si_cdpf ) - call this%set_history_var(vname='FATES_DDBH_CANOPY_CDPF', units = 'cm/year/ha', & + call this%set_history_var(vname='FATES_DDBH_CANOPY_CDPF', units = 'm m-2 yr-1', & long='ddbh annual canopy increment growth by damage x size pft', use_default='inactive', & avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_ddbh_canopy_si_cdpf ) - call this%set_history_var(vname='FATES_DDBH_USTORY_CDPF', units = 'cm/year/ha', & + call this%set_history_var(vname='FATES_DDBH_USTORY_CDPF', units = 'm m-2 yr-1', & long='ddbh annual understory increment growth by damage x size pft', use_default='inactive', & avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_ddbh_understory_si_cdpf ) From cc5a60bf289819232c48b3d4defbd6157fe95903 Mon Sep 17 00:00:00 2001 From: Jessica Needham Date: Fri, 28 Jan 2022 15:36:01 -0800 Subject: [PATCH 16/84] [ Remove branch frac as a cohort variable ] [ Branch frac does not need to be associated with cohorts. This simplifies many of the calls to allometry functions. ] Fixes: [NGT-ED Github issue #] User interface changes?: [Yes (describe what changes), No] Code review: [Names] Test suite: [suite name, machine, compilers] Test baseline: Test namelist changes: Test answer changes: [bit for bit, roundoff, climate changing] Test summary:no testing --- biogeochem/DamageMainMod.F90 | 5 ++- biogeochem/EDCohortDynamicsMod.F90 | 21 +++------ biogeochem/EDPatchDynamicsMod.F90 | 22 ++++++---- biogeochem/EDPhysiologyMod.F90 | 13 ++---- biogeochem/FatesAllometryMod.F90 | 51 ++++++++++++---------- biogeophys/FatesPlantHydraulicsMod.F90 | 4 +- biogeophys/FatesPlantRespPhotosynthMod.F90 | 14 +++--- main/EDInitMod.F90 | 12 ++--- main/FatesInventoryInitMod.F90 | 7 +-- parteh/PRTAllometricCNPMod.F90 | 29 +++++------- parteh/PRTAllometricCarbonMod.F90 | 31 +++++-------- parteh/PRTParamsFATESMod.F90 | 4 +- 12 files changed, 95 insertions(+), 118 deletions(-) diff --git a/biogeochem/DamageMainMod.F90 b/biogeochem/DamageMainMod.F90 index 7dbe385cbf..6947aac992 100644 --- a/biogeochem/DamageMainMod.F90 +++ b/biogeochem/DamageMainMod.F90 @@ -84,9 +84,10 @@ subroutine get_damage_frac(cc_cd, nc_cd, pft, dist_frac) integer, intent(in) :: pft real(r8), intent(out) :: dist_frac ! probability of current cohort moving to new damage level - dist_frac = param_derived%damage_transitions(cc_cd, nc_cd, pft) !* years_per_day (if damage is occuring annually don't do this) - + dist_frac = param_derived%damage_transitions(cc_cd, nc_cd, pft) !* years_per_day + ! (if damage is occuring annually don't do this) + end subroutine get_damage_frac !------------------------------------------------------- diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index bf9a752f2a..8f3e00d74c 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -87,7 +87,6 @@ Module EDCohortDynamicsMod use PRTAllometricCarbonMod, only : ac_bc_inout_id_netdc use PRTAllometricCarbonMod, only : ac_bc_in_id_pft use PRTAllometricCarbonMod, only : ac_bc_inout_id_cdamage - use PRTAllometricCarbonMod, only : ac_bc_in_id_branch_frac use PRTAllometricCarbonMod, only : ac_bc_inout_id_n use PRTAllometricCarbonMod, only : ac_bc_in_id_ctrim use PRTAllometricCarbonMod, only : ac_bc_inout_id_dbh @@ -147,7 +146,7 @@ Module EDCohortDynamicsMod subroutine create_cohort(currentSite, patchptr, pft, nn, hite, coage, dbh, & prt, laimemory, sapwmemory, structmemory, & status, recruitstatus,ctrim,carea, & - clayer, crowndamage,branch_frac, spread, bc_in) + clayer, crowndamage, spread, bc_in) ! ! !DESCRIPTION: @@ -169,7 +168,6 @@ subroutine create_cohort(currentSite, patchptr, pft, nn, hite, coage, dbh, & integer, intent(in) :: pft ! Cohort Plant Functional Type integer, intent(in) :: crowndamage ! Cohort damage class - real(r8), intent(in) :: branch_frac ! Fraction of biomass in branches integer, intent(in) :: clayer ! canopy status of cohort ! (1 = canopy, 2 = understorey, etc.) integer, intent(in) :: status ! growth status of plant @@ -232,7 +230,6 @@ subroutine create_cohort(currentSite, patchptr, pft, nn, hite, coage, dbh, & new_cohort%pft = pft new_cohort%crowndamage = crowndamage - new_cohort%branch_frac = branch_frac new_cohort%status_coh = status new_cohort%n = nn new_cohort%hite = hite @@ -415,7 +412,6 @@ subroutine InitPRTBoundaryConditions(new_cohort) call new_cohort%prt%RegisterBCIn(ac_bc_in_id_pft,bc_ival = new_cohort%pft) call new_cohort%prt%RegisterBCIn(ac_bc_in_id_ctrim,bc_rval = new_cohort%canopy_trim) call new_cohort%prt%RegisterBCIn(ac_bc_in_id_lstat,bc_ival = new_cohort%status_coh) - call new_cohort%prt%RegisterBCIn(ac_bc_in_id_branch_frac,bc_rval = new_cohort%branch_frac) case (prt_cnp_flex_allom_hyp) @@ -1314,8 +1310,7 @@ subroutine fuse_cohorts(currentSite, currentPatch, bc_in) call ForceDBH( currentCohort%pft, currentCohort%canopy_trim, & currentCohort%dbh, currentCohort%hite, & bdead = currentCohort%prt%GetState(struct_organ,all_carbon_elements), & - crowndamage = currentCohort%crowndamage, & - branch_frac = currentCohort%branch_frac) + crowndamage = currentCohort%crowndamage) end if ! @@ -1353,8 +1348,7 @@ subroutine fuse_cohorts(currentSite, currentPatch, bc_in) call ForceDBH( currentCohort%pft, currentCohort%canopy_trim, & currentCohort%dbh, currentCohort%hite, & bdead = currentCohort%prt%GetState(struct_organ,all_carbon_elements),& - crowndamage = currentCohort%crowndamage, & - branch_frac = currentCohort%branch_frac) + crowndamage = currentCohort%crowndamage) end if ! @@ -1841,7 +1835,6 @@ subroutine copy_cohort( currentCohort,copyc ) ! VEGETATION STRUCTURE n%pft = o%pft n%crowndamage = o%crowndamage - n%branch_frac = o%branch_frac n%n = o%n n%dbh = o%dbh n%coage = o%coage @@ -2103,7 +2096,6 @@ subroutine EvaluateAndCorrectDBH(currentCohort,delta_dbh,delta_hite) real(r8) :: canopy_trim integer :: ipft integer :: icrowndamage - real(r8) :: branch_frac real(r8) :: sapw_area real(r8) :: target_sapw_c real(r8) :: target_agw_c @@ -2118,7 +2110,6 @@ subroutine EvaluateAndCorrectDBH(currentCohort,delta_dbh,delta_hite) dbh = currentCohort%dbh ipft = currentCohort%pft icrowndamage = currentCohort%crowndamage - branch_frac = currentCohort%branch_frac canopy_trim = currentCohort%canopy_trim delta_dbh = 0._r8 @@ -2129,10 +2120,10 @@ subroutine EvaluateAndCorrectDBH(currentCohort,delta_dbh,delta_hite) struct_c = currentCohort%prt%GetState(struct_organ, all_carbon_elements) ! Target sapwood biomass according to allometry and trimming [kgC] - call bsap_allom(dbh,ipft,icrowndamage, branch_frac, canopy_trim,sapw_area,target_sapw_c) + call bsap_allom(dbh,ipft,icrowndamage,canopy_trim,sapw_area,target_sapw_c) ! Target total above ground biomass in woody/fibrous tissues [kgC] - call bagw_allom(dbh,ipft, icrowndamage, branch_frac, target_agw_c) + call bagw_allom(dbh,ipft, icrowndamage,target_agw_c) ! Target total below ground biomass in woody/fibrous tissues [kgC] call bbgw_allom(dbh,ipft,target_bgw_c) @@ -2149,7 +2140,7 @@ subroutine EvaluateAndCorrectDBH(currentCohort,delta_dbh,delta_hite) if( (struct_c - target_struct_c ) > calloc_abs_error ) then call ForceDBH( ipft,canopy_trim, dbh, hite_out, bdead=struct_c, & - crowndamage = icrowndamage, branch_frac = branch_frac) + crowndamage = icrowndamage) delta_dbh = dbh - currentCohort%dbh delta_hite = hite_out - currentCohort%hite diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 3ec4f88d59..3af8aae71d 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -475,7 +475,8 @@ subroutine spawn_patches( currentSite, bc_in) use FatesInterfaceTypesMod, only : hlm_use_canopy_damage use FatesInterfaceTypesMod, only : hlm_use_understory_damage use FatesInterfaceTypesMod, only : ncrowndamage - + use FatesParameterDerivedMod, only : param_derived + ! ! !ARGUMENTS: type (ed_site_type), intent(inout), target :: currentSite @@ -533,6 +534,7 @@ subroutine spawn_patches( currentSite, bc_in) integer :: cd ! crowndamage counter real(r8) :: cd_frac ! fraction of cohort going to new damage class real(r8) :: agb_frac ! agoveground biomass fraction of cohort + real(r8) :: branch_frac ! branch fraction of aboveground biomass logical :: found_youngest_primary ! logical for finding the first primary forest patch @@ -783,7 +785,8 @@ subroutine spawn_patches( currentSite, bc_in) call zero_cohort(nc) agb_frac = prt_params%allom_agb_frac(currentCohort%pft) - + branch_frac = param_derived%branch_frac(currentCohort%pft) + allocate(nc) ! new cohort surviving if(hlm_use_planthydro.eq.itrue) call InitHydrCohort(CurrentSite,nc) @@ -1299,20 +1302,20 @@ subroutine spawn_patches( currentSite, bc_in) sapw_m_pre = nc_d%prt%GetState(sapw_organ, all_carbon_elements) call PRTDamageLosses(nc_d%prt, sapw_organ, mass_frac * & - nc_d%branch_frac * agb_frac) + branch_frac * agb_frac) sapw_m_post = nc_d%prt%GetState(sapw_organ, all_carbon_elements) sapw_loss_prt = sapw_loss_prt + (sapw_m_pre - sapw_m_post)*nc_d%n struct_m_pre = nc_d%prt%GetState(struct_organ, all_carbon_elements) call PRTDamageLosses(nc_d%prt, struct_organ, mass_frac * & - nc_d%branch_frac * agb_frac) + branch_frac * agb_frac) struct_m_post = nc_d%prt%GetState(struct_organ, all_carbon_elements) struct_loss_prt = struct_loss_prt + (struct_m_pre - struct_m_post)* & nc_d%n store_m_pre = nc_d%prt%GetState(store_organ, all_carbon_elements) call PRTDamageLosses(nc_d%prt, store_organ, mass_frac * & - nc_d%branch_frac * agb_frac) + branch_frac * agb_frac) store_m_post = nc_d%prt%GetState(store_organ, all_carbon_elements) store_loss_prt = store_loss_prt + (store_m_pre - store_m_post)* & nc_d%n @@ -2385,7 +2388,7 @@ subroutine damage_litter_fluxes(currentSite, currentPatch, newPatch,patch_site_a use FatesInterfaceTypesMod, only : hlm_use_canopy_damage use FatesInterfaceTypesMod, only : hlm_use_understory_damage use FatesConstantsMod, only : itrue - + use FatesParameterDerivedMod, only : param_derived ! ! !ARGUMENTS: @@ -2432,6 +2435,7 @@ subroutine damage_litter_fluxes(currentSite, currentPatch, newPatch,patch_site_a integer :: cd real(r8) :: cd_frac real(r8) :: agb_frac + real(r8) :: branch_frac integer :: ncwd_no_trunk real(r8), allocatable :: SF_val_CWD_frac_canopy(:) real(r8) :: cd_n_tot @@ -2480,8 +2484,10 @@ subroutine damage_litter_fluxes(currentSite, currentPatch, newPatch,patch_site_a do while(associated(currentCohort)) - agb_frac = prt_params%allom_agb_frac(currentCohort%pft) pft = currentCohort%pft + agb_frac = prt_params%allom_agb_frac(pft) + branch_frac = param_derived%branch_frac(pft) + ! Get mass in Kg of the element in the specified organ sapw_m = currentCohort%prt%GetState(sapw_organ, element_id) struct_m = currentCohort%prt%GetState(struct_organ, element_id) @@ -2544,7 +2550,7 @@ subroutine damage_litter_fluxes(currentSite, currentPatch, newPatch,patch_site_a ! branch loss branch_loss = (sapw_m + struct_m + store_m) * crown_reduction * & - currentCohort%branch_frac * agb_frac * num_trees_cd + branch_frac * agb_frac * num_trees_cd do c=1,(ncwd_no_trunk) diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 2db7ba5c2a..7a220e63f9 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -1887,19 +1887,14 @@ subroutine recruitment( currentSite, currentPatch, bc_in ) call h2d_allom(temp_cohort%hite,ft,temp_cohort%dbh) - temp_cohort%branch_frac = 0.0_r8 - do c = 1, (ncwd-1) - temp_cohort%branch_frac = temp_cohort%branch_frac + & - SF_val_CWD_frac(c) - end do - + ! Initialize live pools call bleaf(temp_cohort%dbh,ft,temp_cohort%crowndamage,& temp_cohort%canopy_trim,c_leaf) call bfineroot(temp_cohort%dbh,ft,temp_cohort%canopy_trim,c_fnrt) - call bsap_allom(temp_cohort%dbh,ft,temp_cohort%crowndamage, temp_cohort%branch_frac, & + call bsap_allom(temp_cohort%dbh,ft,temp_cohort%crowndamage, & temp_cohort%canopy_trim,a_sapw, c_sapw) - call bagw_allom(temp_cohort%dbh,ft,temp_cohort%crowndamage, temp_cohort%branch_frac, c_agw) + call bagw_allom(temp_cohort%dbh,ft,temp_cohort%crowndamage, c_agw) call bbgw_allom(temp_cohort%dbh,ft,c_bgw) call bdead_allom(c_agw,c_bgw,c_sapw,ft,c_struct) call bstore_allom(temp_cohort%dbh,ft, temp_cohort%crowndamage, & @@ -2124,7 +2119,7 @@ subroutine recruitment( currentSite, currentPatch, bc_in ) cohortstatus, recruitstatus, & temp_cohort%canopy_trim,temp_cohort%c_area, & currentPatch%NCL_p, & - temp_cohort%crowndamage, temp_cohort%branch_frac, & + temp_cohort%crowndamage, & currentSite%spread, bc_in) ! Note that if hydraulics is on, the number of cohorts may had diff --git a/biogeochem/FatesAllometryMod.F90 b/biogeochem/FatesAllometryMod.F90 index b441b0fa37..325dcb938e 100644 --- a/biogeochem/FatesAllometryMod.F90 +++ b/biogeochem/FatesAllometryMod.F90 @@ -157,7 +157,7 @@ module FatesAllometryMod ! ============================================================================ - subroutine CheckIntegratedAllometries(dbh,ipft,crowndamage, branch_frac, & + subroutine CheckIntegratedAllometries(dbh,ipft,crowndamage, & canopy_trim, bl,bfr,bsap,bstore,bdead, & grow_leaf, grow_fr, grow_sap, grow_store, grow_dead, & max_err, l_pass) @@ -173,7 +173,6 @@ subroutine CheckIntegratedAllometries(dbh,ipft,crowndamage, branch_frac, & real(r8),intent(in) :: dbh ! diameter of plant [cm] integer,intent(in) :: ipft ! plant functional type index integer,intent(in) :: crowndamage ! crowndamage [1: undamaged, >1 damaged] - real(r8),intent(in) :: branch_frac real(r8),intent(in) :: canopy_trim ! trimming function real(r8),intent(in) :: bl ! integrated leaf biomass [kgC] real(r8),intent(in) :: bfr ! integrated fine root biomass [kgC] @@ -232,7 +231,7 @@ subroutine CheckIntegratedAllometries(dbh,ipft,crowndamage, branch_frac, & end if if (grow_sap) then - call bsap_allom(dbh,ipft,crowndamage, branch_frac, canopy_trim,asap_diag,bsap_diag) + call bsap_allom(dbh,ipft,crowndamage, canopy_trim,asap_diag,bsap_diag) if( abs(bsap_diag-bsap) > max_err ) then if(verbose_logging) then write(fates_log(),*) 'disparity in integrated/diagnosed sapwood carbon' @@ -260,8 +259,8 @@ subroutine CheckIntegratedAllometries(dbh,ipft,crowndamage, branch_frac, & end if if (grow_dead) then - call bsap_allom(dbh,ipft,crowndamage, branch_frac, canopy_trim,asap_diag,bsap_diag) - call bagw_allom(dbh,ipft,crowndamage, branch_frac, bagw_diag) + call bsap_allom(dbh,ipft,crowndamage, canopy_trim,asap_diag,bsap_diag) + call bagw_allom(dbh,ipft,crowndamage, bagw_diag) call bbgw_allom(dbh,ipft,bbgw_diag) call bdead_allom( bagw_diag, bbgw_diag, bsap_diag, ipft, bdead_diag ) if( abs(bdead_diag-bdead) > max_err ) then @@ -361,21 +360,22 @@ end subroutine h_allom ! Generic AGB interface ! ============================================================================ - subroutine bagw_allom(d,ipft,crowndamage, branch_frac, bagw,dbagwdd) + subroutine bagw_allom(d,ipft,crowndamage, bagw,dbagwdd) use DamageMainMod, only : get_crown_reduction - + use FatesParameterDerivedMod, only : param_derived + real(r8),intent(in) :: d ! plant diameter [cm] integer(i4),intent(in) :: ipft ! PFT index integer(i4),intent(in) :: crowndamage ! crowndamage [1: undamaged, >1: damaged] - real(r8),intent(in) :: branch_frac real(r8),intent(out) :: bagw ! biomass above ground woody tissues real(r8),intent(out),optional :: dbagwdd ! change in agbw per diameter [kgC/cm] real(r8) :: h ! height real(r8) :: dhdd ! change in height wrt d - real(r8) :: crown_reduction - + real(r8) :: crown_reduction ! crown reduction from damage + real(r8) :: branch_frac ! fraction of aboveground biomass in branches + associate( p1 => prt_params%allom_agb1(ipft), & p2 => prt_params%allom_agb2(ipft), & p3 => prt_params%allom_agb3(ipft), & @@ -384,6 +384,8 @@ subroutine bagw_allom(d,ipft,crowndamage, branch_frac, bagw,dbagwdd) c2b => prt_params%c2b(ipft), & agb_frac => prt_params%allom_agb_frac(ipft), & allom_amode => prt_params%allom_amode(ipft)) + + branch_frac = param_derived%branch_frac(ipft) select case(int(allom_amode)) case (1) !"salda") @@ -891,14 +893,14 @@ end function leafc_from_treelai ! Generic sapwood biomass interface ! ============================================================================ - subroutine bsap_allom(d,ipft,crowndamage, branch_frac, canopy_trim,sapw_area,bsap,dbsapdd) + subroutine bsap_allom(d,ipft,crowndamage,canopy_trim,sapw_area,bsap,dbsapdd) use DamageMainMod , only : get_crown_reduction + use FatesParameterDerivedMod, only : param_derived real(r8),intent(in) :: d ! plant diameter [cm] integer(i4),intent(in) :: ipft ! PFT index integer(i4),intent(in) :: crowndamage ! Crown damage class [1: undamaged, >1: damaged] - real(r8),intent(in) :: branch_frac real(r8),intent(in) :: canopy_trim real(r8),intent(out) :: sapw_area ! cross section area of ! plant sapwood at reference [m2] @@ -918,14 +920,16 @@ subroutine bsap_allom(d,ipft,crowndamage, branch_frac, canopy_trim,sapw_area,bsa ! than some specified proportion of woody biomass ! should not trip, and only in small plants - real(r8) :: crown_reduction - real(r8) :: agb_frac + real(r8) :: crown_reduction ! amount that crown is damage by + real(r8) :: agb_frac ! aboveground biomass fraction + real(r8) :: branch_frac ! fraction of aboveground biomass in branches ! Constrain sapwood so that its above ground portion be no larger than ! X% of total woody/fibrous (ie non leaf/fineroot) tissues real(r8),parameter :: max_frac = 0.95_r8 agb_frac = prt_params%allom_agb_frac(ipft) + branch_frac = param_derived%branch_frac(ipft) select case(int(prt_params%allom_smode(ipft))) @@ -953,7 +957,7 @@ subroutine bsap_allom(d,ipft,crowndamage, branch_frac, canopy_trim,sapw_area,bsa ! Perform a capping/check on total woody biomass - call bagw_allom(d,ipft,crowndamage, branch_frac, bagw,dbagwdd) + call bagw_allom(d,ipft,crowndamage, bagw,dbagwdd) call bbgw_allom(d,ipft,bbgw,dbbgwdd) ! Force sapwood to be less than a maximum fraction of total biomass @@ -996,7 +1000,7 @@ subroutine bbgw_allom(d,ipft,bbgw,dbbgwdd) select case(int(prt_params%allom_cmode(ipft))) case(1) !"constant") ! bbgw not affected by damage so use target allometry no damage - call bagw_allom(d,ipft,1, 1.0_r8, bagw,dbagwdd) + call bagw_allom(d,ipft,1, bagw,dbagwdd) call bbgw_const(d,bagw,dbagwdd,ipft,bbgw,dbbgwdd) case DEFAULT write(fates_log(),*) 'An undefined coarse root allometry was specified: ', & @@ -2399,7 +2403,7 @@ real(r8) function decay_coeff_kn(pft,vcmax25top) end function decay_coeff_kn ! ===================================================================================== -subroutine ForceDBH( ipft, canopy_trim, d, h, bdead, bl, crowndamage, branch_frac ) +subroutine ForceDBH( ipft, canopy_trim, d, h, bdead, bl, crowndamage) ! ========================================================================= ! This subroutine estimates the diameter based on either the structural biomass @@ -2420,8 +2424,7 @@ subroutine ForceDBH( ipft, canopy_trim, d, h, bdead, bl, crowndamage, branch_fra real(r8),intent(out) :: h ! plant height real(r8),intent(in),optional :: bdead ! Structural biomass real(r8),intent(in),optional :: bl ! Leaf biomass - real(r8),intent(in),optional :: branch_frac - + ! Locals real(r8) :: bt_sap,dbt_sap_dd ! target sap wood at current d @@ -2440,7 +2443,7 @@ subroutine ForceDBH( ipft, canopy_trim, d, h, bdead, bl, crowndamage, branch_fra integer :: counter real(r8), parameter :: step_frac0 = 0.9_r8 integer, parameter :: max_counter = 200 - + ! Do reduce "if" calls, we break this call into two parts if ( int(prt_params%woody(ipft)) == itrue ) then @@ -2450,8 +2453,8 @@ subroutine ForceDBH( ipft, canopy_trim, d, h, bdead, bl, crowndamage, branch_fra call endrun(msg=errMsg(sourcefile, __LINE__)) end if - call bsap_allom(d,ipft,crowndamage, branch_frac, canopy_trim,at_sap,bt_sap,dbt_sap_dd) - call bagw_allom(d,ipft,crowndamage, branch_frac, bt_agw,dbt_agw_dd) + call bsap_allom(d,ipft,crowndamage, canopy_trim,at_sap,bt_sap,dbt_sap_dd) + call bagw_allom(d,ipft,crowndamage, bt_agw,dbt_agw_dd) call bbgw_allom(d,ipft,bt_bgw,dbt_bgw_dd) call bdead_allom(bt_agw,bt_bgw, bt_sap, ipft, bt_dead, dbt_agw_dd, & @@ -2468,8 +2471,8 @@ subroutine ForceDBH( ipft, canopy_trim, d, h, bdead, bl, crowndamage, branch_fra dd = step_frac*(bdead-bt_dead)/dbt_dead_dd d_try = d + dd - call bsap_allom(d_try,ipft,crowndamage, branch_frac, canopy_trim,at_sap,bt_sap,dbt_sap_dd) - call bagw_allom(d_try,ipft,crowndamage, branch_frac, bt_agw,dbt_agw_dd) + call bsap_allom(d_try,ipft,crowndamage, canopy_trim,at_sap,bt_sap,dbt_sap_dd) + call bagw_allom(d_try,ipft,crowndamage, bt_agw,dbt_agw_dd) call bbgw_allom(d_try,ipft, bt_bgw,dbt_bgw_dd) diff --git a/biogeophys/FatesPlantHydraulicsMod.F90 b/biogeophys/FatesPlantHydraulicsMod.F90 index da55e85938..906b4ba067 100644 --- a/biogeophys/FatesPlantHydraulicsMod.F90 +++ b/biogeophys/FatesPlantHydraulicsMod.F90 @@ -922,7 +922,7 @@ subroutine UpdatePlantHydrLenVol(ccohort,site_hydr) ! v_stem = c_stem_biom / (prt_params%wood_density(ft) * kg_per_g * cm3_per_m3 ) ! calculate the sapwood cross-sectional area - call bsap_allom(ccohort%dbh,ccohort%pft,ccohort%crowndamage, ccohort%branch_frac, & + call bsap_allom(ccohort%dbh,ccohort%pft,ccohort%crowndamage, & ccohort%canopy_trim,a_sapwood_target,sapw_c_target) ! uncomment this if you want to use @@ -2866,7 +2866,7 @@ subroutine UpdatePlantKmax(ccohort_hydr,ccohort,csite_hydr) pft = ccohort%pft ! Get the cross-section of the plant's sapwood area [m2] - call bsap_allom(ccohort%dbh,pft,ccohort%crowndamage,ccohort%branch_frac, & + call bsap_allom(ccohort%dbh,pft,ccohort%crowndamage, & ccohort%canopy_trim,a_sapwood,c_sap_dummy) ! Leaf Maximum Hydraulic Conductance diff --git a/biogeophys/FatesPlantRespPhotosynthMod.F90 b/biogeophys/FatesPlantRespPhotosynthMod.F90 index 7256561422..319a3ad405 100644 --- a/biogeophys/FatesPlantRespPhotosynthMod.F90 +++ b/biogeophys/FatesPlantRespPhotosynthMod.F90 @@ -243,12 +243,12 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) real(r8) :: leaf_psi ! leaf xylem matric potential [MPa] (only meaningful/used w/ hydro) real(r8), allocatable :: rootfr_ft(:,:) ! Root fractions per depth and PFT - real(r8) :: branch_frac - real(r8) :: agb_frac - real(r8) :: crown_reduction - real(r8) :: sapw_c_predamage - real(r8) :: sapw_n - real(r8) :: sapw_n_predamage + real(r8) :: agb_frac ! fraction of biomass aboveground + real(r8) :: branch_frac ! fraction of aboveground biomass in branches + real(r8) :: crown_reduction ! reduction in crown biomass from damage + real(r8) :: sapw_c_predamage ! pre damage sapwood + real(r8) :: sapw_n ! sapwood n + real(r8) :: sapw_n_predamage ! pre damage sapwood n ! ----------------------------------------------------------------------------------- ! Keeping these two definitions in case they need to be added later @@ -651,7 +651,7 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) if (hlm_use_canopy_damage .eq. itrue .or. hlm_use_understory_damage .eq. itrue) then agb_frac = prt_params%allom_agb_frac(currentCohort%pft) - branch_frac = currentCohort%branch_frac + branch_frac = param_derived%branch_frac(currentCohort%pft) call get_crown_reduction(currentCohort%crowndamage, crown_reduction) ! need the undamaged version if using ratios with roots diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index 1205ad01af..27666a06e5 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -725,7 +725,6 @@ subroutine init_cohorts( site_in, patch_in, bc_in) ! initialize new cohorts on bare ground ! ! !USES: - use FatesParameterDerivedMod , only : param_derived ! ! !ARGUMENTS @@ -739,7 +738,6 @@ subroutine init_cohorts( site_in, patch_in, bc_in) integer :: cstatus integer :: pft integer :: crowndamage ! which crown damage class - real :: branch_frac ! fraction of biomass in branches integer :: iage ! index for leaf age loop integer :: el ! index for element loop integer :: element_id ! element index consistent with defs in PRTGeneric @@ -823,8 +821,7 @@ subroutine init_cohorts( site_in, patch_in, bc_in) else temp_cohort%hite = EDPftvarcon_inst%hgt_min(pft) - temp_cohort%branch_frac = param_derived%branch_frac(pft) - + ! Assume no damage to begin with - since we assume no damage ! we do not need to initialise branch frac just yet. temp_cohort%crowndamage = 1 @@ -839,8 +836,7 @@ subroutine init_cohorts( site_in, patch_in, bc_in) end if ! sp mode ! Calculate total above-ground biomass from allometry - call bagw_allom(temp_cohort%dbh,pft,temp_cohort%crowndamage, & - 1.0_r8, c_agw) + call bagw_allom(temp_cohort%dbh,pft,temp_cohort%crowndamage,c_agw) ! Calculate coarse root biomass from allometry call bbgw_allom(temp_cohort%dbh,pft,c_bgw) @@ -850,7 +846,7 @@ subroutine init_cohorts( site_in, patch_in, bc_in) call bfineroot(temp_cohort%dbh,pft,temp_cohort%canopy_trim,c_fnrt) ! Calculate sapwood biomass - call bsap_allom(temp_cohort%dbh,pft,temp_cohort%crowndamage, 1.0_r8, & + call bsap_allom(temp_cohort%dbh,pft,temp_cohort%crowndamage, & temp_cohort%canopy_trim,a_sapw,c_sapw) call bdead_allom( c_agw, c_bgw, c_sapw, pft, c_struct ) @@ -967,7 +963,7 @@ subroutine init_cohorts( site_in, patch_in, bc_in) temp_cohort%coage, temp_cohort%dbh, prt_obj, temp_cohort%laimemory,& temp_cohort%sapwmemory, temp_cohort%structmemory, cstatus, rstatus, & temp_cohort%canopy_trim, temp_cohort%c_area, 1, temp_cohort%crowndamage,& - temp_cohort%branch_frac, site_in%spread, bc_in) + site_in%spread, bc_in) deallocate(temp_cohort) ! get rid of temporary cohort diff --git a/main/FatesInventoryInitMod.F90 b/main/FatesInventoryInitMod.F90 index d71de108ba..28749b5a08 100644 --- a/main/FatesInventoryInitMod.F90 +++ b/main/FatesInventoryInitMod.F90 @@ -917,7 +917,7 @@ subroutine set_inventory_edcohort_type1(csite,bc_in,css_file_unit,npatches, & real(r8) :: m_repro ! Generic mass for reproductive tissues [kg] real(r8) :: stem_drop_fraction integer :: i_pft, ncohorts_to_create - + character(len=128),parameter :: wr_fmt = & '(F7.1,2X,A20,2X,A20,2X,F5.2,2X,F5.2,2X,I4,2X,F5.2,2X,F5.2,2X,F5.2,2X,F5.2)' @@ -925,6 +925,7 @@ subroutine set_inventory_edcohort_type1(csite,bc_in,css_file_unit,npatches, & real(r8), parameter :: abnormal_large_dbh = 500.0_r8 ! I've never heard of a tree > 3m integer, parameter :: recruitstatus = 0 + read(css_file_unit,fmt=*,iostat=ios) c_time, p_name, c_name, c_dbh, c_height, & c_pft, c_nplant, c_bdead, c_balive, c_avgRG @@ -1022,7 +1023,7 @@ subroutine set_inventory_edcohort_type1(csite,bc_in,css_file_unit,npatches, & temp_cohort%canopy_trim = 1.0_r8 call bagw_allom(temp_cohort%dbh,temp_cohort%pft, & - temp_cohort%crowndamage, temp_cohort%branch_frac, c_agw) + temp_cohort%crowndamage, c_agw) ! Calculate coarse root biomass from allometry call bbgw_allom(temp_cohort%dbh,temp_cohort%pft,c_bgw) @@ -1168,7 +1169,7 @@ subroutine set_inventory_edcohort_type1(csite,bc_in,css_file_unit,npatches, & temp_cohort%coage, temp_cohort%dbh, & prt_obj, temp_cohort%laimemory,temp_cohort%sapwmemory, temp_cohort%structmemory, & cstatus, rstatus, temp_cohort%canopy_trim, temp_cohort%c_area, & - 1, temp_cohort%crowndamage, temp_cohort%branch_frac, csite%spread, bc_in) + 1, temp_cohort%crowndamage, csite%spread, bc_in) deallocate(temp_cohort) ! get rid of temporary cohort diff --git a/parteh/PRTAllometricCNPMod.F90 b/parteh/PRTAllometricCNPMod.F90 index 4ac203f431..3c93b8232a 100644 --- a/parteh/PRTAllometricCNPMod.F90 +++ b/parteh/PRTAllometricCNPMod.F90 @@ -153,10 +153,9 @@ module PRTAllometricCNPMod integer, public, parameter :: acnp_bc_in_id_netdnh4 = 5 ! Index for the net daily NH4 input BC integer, public, parameter :: acnp_bc_in_id_netdno3 = 6 ! Index for the net daily NO3 input BC integer, public, parameter :: acnp_bc_in_id_netdp = 7 ! Index for the net daily P input BC - integer, public, parameter :: acnp_bc_in_id_branch_frac = 8 ! Index for branch fraction ! 0=leaf off, 1=leaf on - integer, parameter :: num_bc_in = 8 + integer, parameter :: num_bc_in = 7 ! ------------------------------------------------------------------------------------- ! Output Boundary Indices (These are public) @@ -335,7 +334,6 @@ subroutine DailyPRTAllometricCNP(this) ! Input only bcs integer :: ipft ! Plant Functional Type index - real(r8) :: branch_frac ! fraction crown in branches real(r8) :: c_gain ! Daily carbon balance for this cohort [kgC] real(r8) :: n_gain ! Daily nitrogen uptake through fine-roots [kgN] real(r8) :: p_gain ! Daily phosphorus uptake through fine-roots [kgN] @@ -403,7 +401,6 @@ subroutine DailyPRTAllometricCNP(this) p_gain = this%bc_in(acnp_bc_in_id_netdp)%rval; p_gain0 = p_gain canopy_trim = this%bc_in(acnp_bc_in_id_ctrim)%rval ipft = this%bc_in(acnp_bc_in_id_pft)%ival - branch_frac = this%bc_in(acnp_bc_in_id_branch_frac)%rval ! Output only boundary conditions c_efflux => this%bc_out(acnp_bc_out_id_cefflux)%rval; c_efflux = 0._r8 @@ -439,9 +436,9 @@ subroutine DailyPRTAllometricCNP(this) ! Set carbon targets based on the plant's current stature target_c(:) = fates_unset_r8 target_dcdd(:) = fates_unset_r8 - call bsap_allom(dbh,ipft,cdamage, branch_frac, canopy_trim, & + call bsap_allom(dbh,ipft,cdamage, canopy_trim, & sapw_area,target_c(sapw_id),target_dcdd(sapw_id) ) - call bagw_allom(dbh,ipft,cdamage, branch_frac, agw_c_target,agw_dcdd_target) + call bagw_allom(dbh,ipft,cdamage, agw_c_target,agw_dcdd_target) call bbgw_allom(dbh,ipft,bgw_c_target,bgw_dcdd_target) call bdead_allom(agw_c_target,bgw_c_target, target_c(sapw_id), ipft, target_c(struct_id), & agw_dcdd_target, bgw_dcdd_target, target_dcdd(sapw_id), target_dcdd(struct_id)) @@ -1020,7 +1017,6 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & integer :: ipft real(r8) :: canopy_trim real(r8) :: leaf_status - real(r8) :: branch_frac integer :: icrowndamage integer :: i, ii ! organ index loops (masked and unmasked) @@ -1104,8 +1100,7 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & ipft = this%bc_in(acnp_bc_in_id_pft)%ival canopy_trim = this%bc_in(acnp_bc_in_id_ctrim)%rval icrowndamage = this%bc_inout(acnp_bc_inout_id_cdamage)%ival - branch_frac = this%bc_in(acnp_bc_in_id_branch_frac)%rval - + cnp_limiter = 0 ! If any of these resources is essentially tapped out, @@ -1372,7 +1367,7 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & end do call CheckIntegratedAllometries(state_array_out(dbh_id),ipft, & - icrowndamage, branch_frac, canopy_trim, & + icrowndamage, canopy_trim, & leafc_tp1, state_array_out(fnrt_id), state_array_out(sapw_id), & state_array_out(store_id), state_array_out(struct_id), & state_mask(leaf_id), state_mask(fnrt_id), state_mask(sapw_id), & @@ -1464,8 +1459,8 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & call bleaf(dbh_tp1,ipft,icrowndamage, canopy_trim,leaf_c_target_tp1) call bfineroot(dbh_tp1,ipft,canopy_trim,fnrt_c_target_tp1) - call bsap_allom(dbh_tp1,ipft,icrowndamage,branch_frac,canopy_trim,sapw_area,sapw_c_target_tp1) - call bagw_allom(dbh_tp1,ipft,icrowndamage, branch_frac, agw_c_target_tp1) + call bsap_allom(dbh_tp1,ipft,icrowndamage,canopy_trim,sapw_area,sapw_c_target_tp1) + call bagw_allom(dbh_tp1,ipft,icrowndamage, agw_c_target_tp1) call bbgw_allom(dbh_tp1,ipft,bgw_c_target_tp1) call bdead_allom(agw_c_target_tp1,bgw_c_target_tp1, sapw_c_target_tp1, ipft, struct_c_target_tp1) call bstore_allom(dbh_tp1,ipft,icrowndamage, canopy_trim,store_c_target_tp1) @@ -1746,8 +1741,8 @@ function GetNutrientTargetCNP(this,element_id,organ_id,stoich_mode) result(targe call bleaf(dbh,ipft,1, canopy_trim,leaf_c_target) call bfineroot(dbh,ipft,canopy_trim,fnrt_c_target) - call bsap_allom(dbh,ipft,1, 1.0_r8, canopy_trim,sapw_area,sapw_c_target) - call bagw_allom(dbh,ipft,1, 1.0_r8, agw_c_target) + call bsap_allom(dbh,ipft,1, canopy_trim,sapw_area,sapw_c_target) + call bagw_allom(dbh,ipft,1, agw_c_target) call bbgw_allom(dbh,ipft,bgw_c_target) call bdead_allom(agw_c_target,bgw_c_target, sapw_c_target, ipft, struct_c_target) @@ -2103,7 +2098,6 @@ function AllomCNPGrowthDeriv(l_state_array,l_state_mask,cbalance,intgr_params) r integer :: ipft ! PFT index real(r8) :: canopy_trim ! Canopy trimming function (boundary condition [0-1] integer :: icrowndamage ! crown damage index - real(r8) :: branch_frac real(r8) :: leaf_c_target ! target leaf biomass, dummy var (kgC) real(r8) :: fnrt_c_target ! target fine-root biomass, dummy var (kgC) real(r8) :: sapw_c_target ! target sapwood biomass, dummy var (kgC) @@ -2142,13 +2136,12 @@ function AllomCNPGrowthDeriv(l_state_array,l_state_mask,cbalance,intgr_params) r canopy_trim = intgr_params(acnp_bc_in_id_ctrim) ipft = int(intgr_params(acnp_bc_in_id_pft)) - branch_frac = intgr_params(acnp_bc_in_id_branch_frac) icrowndamage = int(intgr_params(acnp_bc_inout_id_cdamage)) call bleaf(dbh,ipft,icrowndamage, canopy_trim,leaf_c_target,leaf_dcdd_target) call bfineroot(dbh,ipft,canopy_trim,fnrt_c_target,fnrt_dcdd_target) - call bsap_allom(dbh,ipft,icrowndamage, branch_frac,canopy_trim,sapw_area,sapw_c_target,sapw_dcdd_target) - call bagw_allom(dbh,ipft,icrowndamage, branch_frac, agw_c_target,agw_dcdd_target) + call bsap_allom(dbh,ipft,icrowndamage, canopy_trim,sapw_area,sapw_c_target,sapw_dcdd_target) + call bagw_allom(dbh,ipft,icrowndamage, agw_c_target,agw_dcdd_target) call bbgw_allom(dbh,ipft,bgw_c_target,bgw_dcdd_target) call bdead_allom(agw_c_target,bgw_c_target, sapw_c_target, ipft, struct_c_target, & agw_dcdd_target, bgw_dcdd_target, sapw_dcdd_target, struct_dcdd_target) diff --git a/parteh/PRTAllometricCarbonMod.F90 b/parteh/PRTAllometricCarbonMod.F90 index 509ef4a35f..f3e8a44a3b 100644 --- a/parteh/PRTAllometricCarbonMod.F90 +++ b/parteh/PRTAllometricCarbonMod.F90 @@ -95,8 +95,7 @@ module PRTAllometricCarbonMod integer, public, parameter :: ac_bc_in_id_pft = 1 ! Index for the PFT input BC integer, public, parameter :: ac_bc_in_id_ctrim = 2 ! Index for the canopy trim function integer, public, parameter :: ac_bc_in_id_lstat = 3 ! Leaf status (on or off) - integer, public, parameter :: ac_bc_in_id_branch_frac = 4 ! index for the branch fraction input BC - integer, parameter :: num_bc_in = 4 ! Number of input boundary conditions + integer, parameter :: num_bc_in = 3 ! Number of input boundary conditions ! THere are no purely output boundary conditions @@ -303,7 +302,6 @@ subroutine DailyPRTAllometricCarbon(this) real(r8) :: canopy_trim ! The canopy trimming function [0-1] integer :: ipft ! Plant Functional Type index - real(r8) :: branch_frac real(r8) :: target_leaf_c ! target leaf carbon [kgC] real(r8) :: target_fnrt_c ! target fine-root carbon [kgC] @@ -432,17 +430,14 @@ subroutine DailyPRTAllometricCarbon(this) canopy_trim = this%bc_in(ac_bc_in_id_ctrim)%rval ipft = this%bc_in(ac_bc_in_id_pft)%ival leaf_status = this%bc_in(ac_bc_in_id_lstat)%ival - branch_frac = this%bc_in(ac_bc_in_id_branch_frac)%rval intgr_params(:) = un_initialized intgr_params(ac_bc_in_id_ctrim) = this%bc_in(ac_bc_in_id_ctrim)%rval intgr_params(ac_bc_in_id_pft) = real(this%bc_in(ac_bc_in_id_pft)%ival) - intgr_params(ac_bc_in_id_branch_frac) = this%bc_in(ac_bc_in_id_branch_frac)%rval intgr_params(num_bc_in + 1) = real(this%bc_inout(ac_bc_inout_id_cdamage)%ival) nleafage = prt_global%state_descriptor(leaf_c_id)%num_pos ! Number of leaf age class damage_recovery_scalar = prt_params%damage_recovery_scalar(ipft) - ! ----------------------------------------------------------------------------------- ! Call the routine that advances leaves in age. @@ -470,10 +465,10 @@ subroutine DailyPRTAllometricCarbon(this) ! ----------------------------------------------------------------------------------- ! Target sapwood biomass according to allometry and trimming [kgC] - call bsap_allom(dbh,ipft, crowndamage, branch_frac, canopy_trim,sapw_area,target_sapw_c) + call bsap_allom(dbh,ipft, crowndamage, canopy_trim,sapw_area,target_sapw_c) ! Target total above ground biomass in woody/fibrous tissues [kgC] - call bagw_allom(dbh,ipft, crowndamage, branch_frac, target_agw_c) + call bagw_allom(dbh,ipft, crowndamage, target_agw_c) ! Target total below ground biomass in woody/fibrous tissues [kgC] call bbgw_allom(dbh,ipft,target_bgw_c) @@ -687,9 +682,9 @@ subroutine DailyPRTAllometricCarbon(this) mass_d = (sum(leaf_c(1:nleafage)) + fnrt_c + store_c + sapw_c + struct_c ) ! Target sapwood biomass according to allometry and trimming [kgC] - call bsap_allom(dbh,ipft, crowndamage-1, branch_frac, canopy_trim,sapw_area,targetn_sapw_c) + call bsap_allom(dbh,ipft, crowndamage-1, canopy_trim,sapw_area,targetn_sapw_c) ! Target total above ground biomass in woody/fibrous tissues [kgC] - call bagw_allom(dbh,ipft, crowndamage-1, branch_frac, targetn_agw_c) + call bagw_allom(dbh,ipft, crowndamage-1, targetn_agw_c) ! Target total below ground biomass in woody/fibrous tissues [kgC] call bbgw_allom(dbh,ipft,targetn_bgw_c) ! Target total dead (structrual) biomass [kgC] @@ -848,7 +843,7 @@ subroutine DailyPRTAllometricCarbon(this) ! we remember the current step size as a good next guess. call CheckIntegratedAllometries(c_pool_out(dbh_id),ipft,& - crowndamage, branch_frac, canopy_trim, & + crowndamage, canopy_trim, & c_pool_out(leaf_c_id), c_pool_out(fnrt_c_id), c_pool_out(sapw_c_id), & c_pool_out(store_c_id), c_pool_out(struct_c_id), & c_mask(leaf_c_id), c_mask(fnrt_c_id), c_mask(sapw_c_id), & @@ -1009,7 +1004,6 @@ function AllomCGrowthDeriv(c_pools,c_mask,cbalance,intgr_params) result(dCdx) ! locals integer :: ipft ! PFT index integer :: crowndamage - real(r8) :: branch_frac real(r8) :: canopy_trim ! Canopy trimming function (boundary condition [0-1] real(r8) :: ct_leaf ! target leaf biomass, dummy var (kgC) real(r8) :: ct_fnrt ! target fine-root biomass, dummy var (kgC) @@ -1047,13 +1041,12 @@ function AllomCGrowthDeriv(c_pools,c_mask,cbalance,intgr_params) result(dCdx) canopy_trim = intgr_params(ac_bc_in_id_ctrim) ipft = int(intgr_params(ac_bc_in_id_pft)) - branch_frac = intgr_params(ac_bc_in_id_branch_frac) crowndamage = int(intgr_params(num_bc_in + 1)) call bleaf(dbh,ipft,crowndamage,canopy_trim,ct_leaf, dbldd=ct_dleafdd) call bfineroot(dbh,ipft,canopy_trim,ct_fnrt,ct_dfnrtdd) - call bsap_allom(dbh,ipft, crowndamage, branch_frac, canopy_trim,sapw_area,ct_sap,ct_dsapdd) - call bagw_allom(dbh,ipft,crowndamage, branch_frac, ct_agw,ct_dagwdd) + call bsap_allom(dbh,ipft, crowndamage, canopy_trim,sapw_area,ct_sap,ct_dsapdd) + call bagw_allom(dbh,ipft,crowndamage, ct_agw,ct_dagwdd) call bbgw_allom(dbh,ipft,ct_bgw, ct_dbgwdd) call bdead_allom(ct_agw,ct_bgw, ct_sap, ipft, ct_dead, & ct_dagwdd, ct_dbgwdd, ct_dsapdd, ct_ddeaddd) @@ -1232,7 +1225,6 @@ subroutine PRTDamageRecovery(this) integer, pointer :: crowndamage real(r8) :: canopy_trim integer :: ipft - real(r8) :: branch_frac real(r8) :: target_leaf_c ! target leaf carbon [kgC] real(r8) :: target_fnrt_c ! target fine-root carbon [kgC] real(r8) :: target_sapw_c ! target sapwood carbon [kgC] @@ -1259,11 +1251,10 @@ subroutine PRTDamageRecovery(this) canopy_trim = this%bc_in(ac_bc_in_id_ctrim)%rval ipft = this%bc_in(ac_bc_in_id_pft)%ival leaf_status = this%bc_in(ac_bc_in_id_lstat)%ival - branch_frac = this%bc_in(ac_bc_in_id_branch_frac)%rval - + ! Get allometric targets for this dbh and crown damage class - call bsap_allom(dbh, ipft, crowndamage, branch_frac, canopy_trim, sapw_area, target_sapw_c) - call bagw_allom(dbh, ipft, crowndamage, branch_frac, target_agw_c) + call bsap_allom(dbh, ipft, crowndamage, canopy_trim, sapw_area, target_sapw_c) + call bagw_allom(dbh, ipft, crowndamage, target_agw_c) call bbgw_allom(dbh, ipft, target_bgw_c) call bdead_allom(target_agw_c, target_bgw_c, target_sapw_c, ipft, target_struct_c) if(leaf_status ==2)then diff --git a/parteh/PRTParamsFATESMod.F90 b/parteh/PRTParamsFATESMod.F90 index 3255e14f9c..c5e8b84de8 100644 --- a/parteh/PRTParamsFATESMod.F90 +++ b/parteh/PRTParamsFATESMod.F90 @@ -1472,8 +1472,8 @@ function NewRecruitTotalStoichiometry(ft,element_id) result(recruit_stoich) call h2d_allom(EDPftvarcon_inst%hgt_min(ft),ft,dbh) call bleaf(dbh,ft,1, init_recruit_trim,c_leaf) call bfineroot(dbh,ft,init_recruit_trim,c_fnrt) - call bsap_allom(dbh,ft,1,1.0_r8,init_recruit_trim,a_sapw, c_sapw) - call bagw_allom(dbh,ft,1,1.0_r8,c_agw) + call bsap_allom(dbh,ft,1,init_recruit_trim,a_sapw, c_sapw) + call bagw_allom(dbh,ft,1,c_agw) call bbgw_allom(dbh,ft,c_bgw) call bdead_allom(c_agw,c_bgw,c_sapw,ft,c_struct) call bstore_allom(dbh,ft,1,init_recruit_trim,c_store) From a5f752b584fe68294d72b0aff2099136ae60dfad Mon Sep 17 00:00:00 2001 From: Jessica Needham Date: Mon, 14 Feb 2022 08:43:34 -0800 Subject: [PATCH 17/84] [ Fix merge conflicts in EDCanopySturctureMod ] [Add cohort crowndamage status to calls to tree_sai ] Fixes: [NGT-ED Github issue #] User interface changes?: [Yes (describe what changes), No] Code review: [Names] Test suite: [suite name, machine, compilers] Test baseline: Test namelist changes: Test answer changes: [bit for bit, roundoff, climate changing] Test summary:no testing --- biogeochem/EDCanopyStructureMod.F90 | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/biogeochem/EDCanopyStructureMod.F90 b/biogeochem/EDCanopyStructureMod.F90 index 9709d87f31..1d7381846b 100644 --- a/biogeochem/EDCanopyStructureMod.F90 +++ b/biogeochem/EDCanopyStructureMod.F90 @@ -1925,6 +1925,7 @@ subroutine update_hlm_dynamics(nsites,sites,fcolumn,bc_out) real(r8) :: bare_frac_area real(r8) :: total_patch_area real(r8) :: total_canopy_area + real(r8) :: total_patch_leaf_stem_area real(r8) :: weight ! Weighting for cohort variables in patch do s = 1,nsites @@ -1936,6 +1937,7 @@ subroutine update_hlm_dynamics(nsites,sites,fcolumn,bc_out) bc_out(s)%dleaf_pa(:) = 0._r8 bc_out(s)%z0m_pa(:) = 0._r8 bc_out(s)%displa_pa(:) = 0._r8 + currentPatch => sites(s)%oldest_patch c = fcolumn(s) @@ -1986,13 +1988,14 @@ subroutine update_hlm_dynamics(nsites,sites,fcolumn,bc_out) if (hlm_use_sp.eq.ifalse) then ! make sure that allometries are correct call carea_allom(currentCohort%dbh,currentCohort%n,sites(s)%spread,& - currentCohort%pft,currentCohort%c_area) + currentCohort%pft,currentCohort%crowndamage, currentCohort%c_area) currentCohort%treelai = tree_lai(currentCohort%prt%GetState(leaf_organ, all_carbon_elements), & currentCohort%pft, currentCohort%c_area, currentCohort%n, & currentCohort%canopy_layer, currentPatch%canopy_layer_tlai,currentCohort%vcmax25top ) - currentCohort%treesai = tree_sai(currentCohort%pft, currentCohort%dbh, currentCohort%canopy_trim, & + currentCohort%treesai = tree_sai(currentCohort%pft, currentCohort%dbh, sites(s)%spread, & + currentCohort%canopy_trim, & currentCohort%c_area, currentCohort%n, currentCohort%canopy_layer, & currentPatch%canopy_layer_tlai, currentCohort%treelai , & currentCohort%vcmax25top,4) From 14399fc2ee8862ef83d081d0d6bfd1d5ff71a46d Mon Sep 17 00:00:00 2001 From: Jessica Needham Date: Mon, 14 Feb 2022 11:43:47 -0800 Subject: [PATCH 18/84] [ Add damage x damage dimension back ] [ Needed for damage transition matrix ] Fixes: [NGT-ED Github issue #] User interface changes?: [Yes (describe what changes), No] Code review: [Names] Test suite: [suite name, machine, compilers] Test baseline: Test namelist changes: Test answer changes: [bit for bit, roundoff, climate changing] Test summary:no testing --- main/FatesIODimensionsMod.F90 | 10 ++++++++-- main/FatesIOVariableKindMod.F90 | 1 + main/FatesInterfaceMod.F90 | 12 ++++++++++++ main/FatesInterfaceTypesMod.F90 | 2 ++ 4 files changed, 23 insertions(+), 2 deletions(-) diff --git a/main/FatesIODimensionsMod.F90 b/main/FatesIODimensionsMod.F90 index 09bead9bc4..2289749d1a 100644 --- a/main/FatesIODimensionsMod.F90 +++ b/main/FatesIODimensionsMod.F90 @@ -28,6 +28,7 @@ module FatesIODimensionsMod character(*), parameter, public :: levcnlf = 'fates_levcnlf' ! matches histFileMod character(*), parameter, public :: levcnlfpft = 'fates_levcnlfpf' ! matches histFileMod character(*), parameter, public :: levcdsc = 'fates_levcdsc' ! matches histFileMod + character(*), parameter, public :: levcdcd = 'fates_levcdcd' ! matches histFileMod character(*), parameter, public :: levcdpf = 'fates_levcdpf' ! matches histFileMod character(*), parameter, public :: levagefuel = 'fates_levagefuel' ! matches histFileMod character(*), parameter, public :: levelem = 'fates_levelem' @@ -85,6 +86,9 @@ module FatesIODimensionsMod ! levcdsc = This is a structure that records the boundaries for the ! number of crown damage x size classes dimension + ! levcdcd = This is a structure that records the boundaries for the + ! number of crown damage x crown damage classes - for damage transitions + ! levcdpf = This is a structure that records the boundaries for the ! number of crown damage x size classes x pft dimension @@ -145,8 +149,10 @@ module FatesIODimensionsMod integer :: cnlf_end integer :: cnlfpft_begin integer :: cnlfpft_end - integer :: cdamage_begin - integer :: cdamage_end + ! integer :: cdamage_begin + ! integer :: cdamage_end + integer :: cdcd_begin + integer :: cdcd_end integer :: cdsc_begin integer :: cdsc_end integer :: cdpf_begin diff --git a/main/FatesIOVariableKindMod.F90 b/main/FatesIOVariableKindMod.F90 index a40f1c2dbe..3b10d698cd 100644 --- a/main/FatesIOVariableKindMod.F90 +++ b/main/FatesIOVariableKindMod.F90 @@ -33,6 +33,7 @@ module FatesIOVariableKindMod character(*), parameter, public :: site_cnlfpft_r8 = 'SI_CNLFPFT_R8' character(*), parameter, public :: site_cdpf_r8 = 'SI_CDPF_R8' character(*), parameter, public :: site_cdsc_r8 = 'SI_CDSC_R8' + character(*), parameter, public :: site_cdcd_r8 = 'SI_CDCD_R8' character(*), parameter, public :: site_scag_r8 = 'SI_SCAG_R8' character(*), parameter, public :: site_scagpft_r8 = 'SI_SCAGPFT_R8' character(*), parameter, public :: site_agepft_r8 = 'SI_AGEPFT_R8' diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index a5c35bebf6..d0fc4e8315 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -1000,6 +1000,7 @@ subroutine fates_history_maps integer :: ifuel integer :: ican integer :: icdam + integer :: icdcd integer :: ileaf integer :: iage integer :: iheight @@ -1019,6 +1020,8 @@ subroutine fates_history_maps allocate( fates_hdim_camap_levcapf(1:nlevcoage*numpft)) allocate( fates_hdim_levcdam(ncrowndamage )) + allocate( fates_hdim_cdimap_levcdcd(ncrowndamage*(ncrowndamage+1))) + allocate( fates_hdim_cdjmap_levcdcd(ncrowndamage*(ncrowndamage+1))) allocate( fates_hdim_scmap_levcdsc(nlevsclass*ncrowndamage)) allocate( fates_hdim_cdmap_levcdsc(nlevsclass*ncrowndamage)) allocate( fates_hdim_scmap_levcdpf(nlevsclass*ncrowndamage * numpft)) @@ -1161,6 +1164,15 @@ subroutine fates_history_maps end do end do + i=0 + do icdam=1,ncrowndamage + do icdcd=1,ncrowndamage+1 + i=i+1 + fates_hdim_cdimap_levcdcd(i) = icdcd + fates_hdim_cdjmap_levcdcd(i) = icdam + end do + end do + i=0 do ipft=1,numpft do ican=1,nclmax diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index c605c55a7c..3bde7550ea 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -247,6 +247,8 @@ module FatesInterfaceTypesMod integer , public, allocatable :: fates_hdim_scmap_levcdpf(:) ! map of size into size x crowndamage x pft integer , public, allocatable :: fates_hdim_cdmap_levcdsc(:) ! map of crowndamage into size x crowndamage integer , public, allocatable :: fates_hdim_scmap_levcdsc(:) ! map of size into size x crowndamage + integer , public, allocatable :: fates_hdim_cdimap_levcdcd(:) ! map of current damage into damage x damage + integer , public, allocatable :: fates_hdim_cdjmap_levcdcd(:) ! map of new damage into damage x damage real(r8), public, allocatable :: fates_hdim_levage(:) ! patch age lower bound dimension real(r8), public, allocatable :: fates_hdim_levheight(:) ! height lower bound dimension From 1324109d32ac3b7c8233a21d44aead8ffb5d9f95 Mon Sep 17 00:00:00 2001 From: Jessica Needham Date: Wed, 16 Feb 2022 15:38:06 -0800 Subject: [PATCH 19/84] [ Fix bug with if statements in fateshistoryinterface ] [ because damage history variables are defined in an if statment they need to be references by this%hvars and not hio_ ] Fixes: [NGT-ED Github issue #] User interface changes?: [Yes (describe what changes), No] Code review: [Names] Test suite: [suite name, machine, compilers] Test baseline: Test namelist changes: Test answer changes: [bit for bit, roundoff, climate changing] Test summary:no testing --- main/FatesHistoryInterfaceMod.F90 | 236 +++++++----------------------- main/FatesIODimensionsMod.F90 | 2 - main/FatesInterfaceMod.F90 | 5 - main/FatesInterfaceTypesMod.F90 | 1 - 4 files changed, 56 insertions(+), 188 deletions(-) diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 0c641c655d..053e5b0772 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -463,8 +463,7 @@ Module FatesHistoryInterfaceMod integer :: ih_m8_si_scls integer :: ih_m9_si_scls integer :: ih_m10_si_scls - integer :: ih_m11_si_scls - + integer :: ih_m10_si_cacls integer :: ih_nplant_si_cacls @@ -634,28 +633,17 @@ Module FatesHistoryInterfaceMod ! site x crown damage x pft x sizeclass ! site x crown damage x size class integer :: ih_nplant_si_cdpf - integer :: ih_nplant_si_cdsc integer :: ih_nplant_canopy_si_cdpf integer :: ih_nplant_understory_si_cdpf - integer :: ih_nplant_canopy_si_cdsc - integer :: ih_nplant_understory_si_cdsc - integer :: ih_mortality_si_cdsc integer :: ih_mortality_si_cdpf integer :: ih_mortality_canopy_si_cdpf integer :: ih_mortality_understory_si_cdpf integer :: ih_m3_si_cdpf - integer :: ih_m3_si_cdsc integer :: ih_m11_si_cdpf - integer :: ih_m11_si_cdsc - integer :: ih_m3_mortality_canopy_si_cdsc - integer :: ih_m3_mortality_understory_si_cdsc integer :: ih_m3_mortality_canopy_si_cdpf integer :: ih_m3_mortality_understory_si_cdpf - integer :: ih_m11_mortality_canopy_si_cdsc - integer :: ih_m11_mortality_understory_si_cdsc integer :: ih_m11_mortality_canopy_si_cdpf integer :: ih_m11_mortality_understory_si_cdpf - integer :: ih_ddbh_si_cdsc integer :: ih_ddbh_si_cdpf integer :: ih_ddbh_canopy_si_cdpf integer :: ih_ddbh_understory_si_cdpf @@ -2056,7 +2044,6 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_m8_si_scpf => this%hvars(ih_m8_si_scpf)%r82d, & hio_m9_si_scpf => this%hvars(ih_m9_si_scpf)%r82d, & hio_m10_si_scpf => this%hvars(ih_m10_si_scpf)%r82d, & - hio_m11_si_scpf => this%hvars(ih_m11_si_scpf)%r82d, & hio_m10_si_capf => this%hvars(ih_m10_si_capf)%r82d, & hio_crownfiremort_si_scpf => this%hvars(ih_crownfiremort_si_scpf)%r82d, & @@ -2065,35 +2052,6 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_fire_c_to_atm_si => this%hvars(ih_fire_c_to_atm_si)%r81d, & hio_burn_flux_elem => this%hvars(ih_burn_flux_elem)%r82d, & - hio_nplant_si_cdpf => this%hvars(ih_nplant_si_cdpf)%r82d, & - hio_nplant_si_cdsc => this%hvars(ih_nplant_si_cdsc)%r82d, & - hio_mortality_si_cdsc => this%hvars(ih_mortality_si_cdsc)%r82d, & - hio_mortality_si_cdpf => this%hvars(ih_mortality_si_cdpf)%r82d, & - hio_m3_si_cdpf => this%hvars(ih_m3_si_cdpf)%r82d, & - hio_m3_si_cdsc => this%hvars(ih_m3_si_cdsc)%r82d, & - hio_m11_si_cdpf => this%hvars(ih_m11_si_cdpf)%r82d, & - hio_m11_si_cdsc => this%hvars(ih_m11_si_cdsc)%r82d, & - hio_mortality_canopy_si_cdpf => this%hvars(ih_mortality_canopy_si_cdpf)%r82d, & - hio_mortality_understory_si_cdpf => this%hvars(ih_mortality_understory_si_cdpf)%r82d, & - hio_m3_mortality_canopy_si_cdsc => this%hvars(ih_m3_mortality_canopy_si_cdsc)%r82d, & - hio_m3_mortality_understory_si_cdsc => this%hvars(ih_m3_mortality_understory_si_cdsc)%r82d, & - hio_m3_mortality_canopy_si_cdpf => this%hvars(ih_m3_mortality_canopy_si_cdpf)%r82d, & - hio_m3_mortality_understory_si_cdpf =>this%hvars(ih_m3_mortality_understory_si_cdpf)%r82d, & - hio_m11_mortality_canopy_si_cdsc => this%hvars(ih_m11_mortality_canopy_si_cdsc)%r82d, & - hio_m11_mortality_understory_si_cdsc => this%hvars(ih_m11_mortality_understory_si_cdsc)%r82d, & - hio_m11_mortality_canopy_si_cdpf => this%hvars(ih_m11_mortality_canopy_si_cdpf)%r82d, & - hio_m11_mortality_understory_si_cdpf =>this%hvars(ih_m11_mortality_understory_si_cdpf)%r82d, & - hio_nplant_canopy_si_cdsc => this%hvars(ih_nplant_canopy_si_cdsc)%r82d, & - hio_nplant_understory_si_cdsc =>this%hvars(ih_nplant_understory_si_cdsc)%r82d, & - hio_nplant_canopy_si_cdpf => this%hvars(ih_nplant_canopy_si_cdpf)%r82d, & - hio_nplant_understory_si_cdpf =>this%hvars(ih_nplant_understory_si_cdpf)%r82d, & - hio_ddbh_si_cdsc => this%hvars(ih_ddbh_si_cdsc)%r82d, & - hio_ddbh_si_cdpf => this%hvars(ih_ddbh_si_cdpf)%r82d, & - hio_ddbh_canopy_si_cdpf => this%hvars(ih_ddbh_canopy_si_cdpf)%r82d, & - hio_ddbh_understory_si_cdpf => this%hvars(ih_ddbh_understory_si_cdpf)%r82d, & - hio_crownarea_canopy_damage_si => this%hvars(ih_crownarea_canopy_damage_si)%r81d, & - hio_crownarea_ustory_damage_si => this%hvars(ih_crownarea_ustory_damage_si)%r81d, & - hio_m1_si_scls => this%hvars(ih_m1_si_scls)%r82d, & hio_m2_si_scls => this%hvars(ih_m2_si_scls)%r82d, & hio_m3_si_scls => this%hvars(ih_m3_si_scls)%r82d, & @@ -2104,7 +2062,6 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_m8_si_scls => this%hvars(ih_m8_si_scls)%r82d, & hio_m9_si_scls => this%hvars(ih_m9_si_scls)%r82d, & hio_m10_si_scls => this%hvars(ih_m10_si_scls)%r82d, & - hio_m11_si_scls => this%hvars(ih_m11_si_scls)%r82d, & hio_m10_si_cacls => this%hvars(ih_m10_si_cacls)%r82d, & hio_c13disc_si_scpf => this%hvars(ih_c13disc_si_scpf)%r82d, & @@ -2265,10 +2222,12 @@ subroutine update_history_dyn(this,nc,nsites,sites) ! damage variables - site level - this needs to be OUT of the patch loop if(hlm_use_canopy_damage .eq. itrue .or. hlm_use_understory_damage .eq. itrue) then - hio_crownarea_canopy_damage_si(io_si) = hio_crownarea_canopy_damage_si(io_si) + & + this%hvars(ih_crownarea_canopy_damage_si)%r81d(io_si) = & + this%hvars(ih_crownarea_canopy_damage_si)%r81d(io_si) + & sites(s)%crownarea_canopy_damage * days_per_year * 1 / m2_per_ha - hio_crownarea_ustory_damage_si(io_si) = hio_crownarea_ustory_damage_si(io_si) + & + this%hvars(ih_crownarea_ustory_damage_si)%r81d(io_si) = & + this%hvars(ih_crownarea_ustory_damage_si)%r81d(io_si) + & sites(s)%crownarea_ustory_damage * days_per_year * 1 / m2_per_ha end if @@ -2783,45 +2742,31 @@ subroutine update_history_dyn(this,nc,nsites,sites) if(hlm_use_canopy_damage .eq. itrue .or. hlm_use_understory_damage .eq. itrue) then cdpf = get_cdamagesizepft_class_index(ccohort%dbh, ccohort%crowndamage, ccohort%pft) - cdsc = get_cdamagesize_class_index(ccohort%dbh, ccohort%crowndamage) - - ! crown damage - only want cohorts > 1 cm dbh here so we can compare it with data - hio_mortality_si_cdsc(io_si,cdsc) = hio_mortality_si_cdsc(io_si,cdsc) + & - (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%frmort + & - ccohort%smort + ccohort%asmort + ccohort%dgmort) * 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 - - hio_mortality_si_cdpf(io_si,cdpf) = hio_mortality_si_cdpf(io_si,cdpf) + & + + this%hvars(ih_mortality_si_cdpf)%r82d(io_si,cdpf) = & + this%hvars(ih_mortality_si_cdpf)%r82d(io_si,cdpf) + & (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%frmort + & ccohort%smort + ccohort%asmort + ccohort%dgmort) * 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 - ! crown damage by size - hio_nplant_si_cdsc(io_si, cdsc) = hio_nplant_si_cdsc(io_si, cdsc) + ccohort%n / m2_per_ha - hio_m3_si_cdsc(io_si, cdsc) = hio_m3_si_cdsc(io_si, cdsc) + & - ccohort%cmort * ccohort%n / m2_per_ha - ! crown damage by size by pft - hio_nplant_si_cdpf(io_si, cdpf) = hio_nplant_si_cdpf(io_si, cdpf) + ccohort%n / m2_per_ha - hio_m3_si_cdpf(io_si, cdpf) = hio_m3_si_cdpf(io_si, cdpf) + & + this%hvars(ih_nplant_si_cdpf)%r82d(io_si, cdpf) = & + this%hvars(ih_nplant_si_cdpf)%r82d(io_si, cdpf) + ccohort%n / m2_per_ha + this%hvars(ih_m3_si_cdpf)%r82d(io_si, cdpf) = & + this%hvars(ih_m3_si_cdpf)%r82d(io_si, cdpf) + & ccohort%cmort * ccohort%n / m2_per_ha ! mortality - hio_m11_si_scpf(io_si,scpf) = hio_m11_si_scpf(io_si,scpf) + & - ccohort%dgmort*ccohort%n / m2_per_ha - hio_m11_si_scls(io_si,scls) = hio_m11_si_scls(io_si,scls) + & - ccohort%dgmort*ccohort%n / m2_per_ha - hio_m11_si_cdpf(io_si,cdpf) = hio_m11_si_cdpf(io_si,cdpf) + & + this%hvars(ih_m11_si_scpf)%r82d(io_si,scpf) = & + this%hvars(ih_m11_si_scpf)%r82d(io_si,scpf) + & ccohort%dgmort*ccohort%n / m2_per_ha - hio_m11_si_cdsc(io_si,cdsc) = hio_m11_si_cdsc(io_si,cdsc) + & + this%hvars(ih_m11_si_cdpf)%r82d(io_si,cdpf) = & + this%hvars(ih_m11_si_cdpf)%r82d(io_si,cdpf) + & ccohort%dgmort*ccohort%n / m2_per_ha - - hio_ddbh_si_cdsc(io_si,cdsc) = hio_ddbh_si_cdsc(io_si,cdsc) + & - ccohort%ddbhdt*ccohort%n / m2_per_ha * m_per_cm - - hio_ddbh_si_cdpf(io_si,cdpf) = hio_ddbh_si_cdpf(io_si,cdpf) + & + + this%hvars(ih_ddbh_si_cdpf)%r82d(io_si,cdpf) = & + this%hvars(ih_ddbh_si_cdpf)%r82d(io_si,cdpf) + & ccohort%ddbhdt*ccohort%n / m2_per_ha * m_per_cm end if @@ -2947,33 +2892,30 @@ subroutine update_history_dyn(this,nc,nsites,sites) if(hlm_use_canopy_damage .eq. itrue .or. hlm_use_understory_damage .eq. itrue) then ! carbon starvation mortality in the canopy by size x damage x pft - hio_m3_mortality_canopy_si_cdpf(io_si,cdpf) = hio_m3_mortality_canopy_si_cdpf(io_si,cdpf)+& + this%hvars(ih_m3_mortality_canopy_si_cdpf)%r82d(io_si,cdpf) = & + this%hvars(ih_m3_mortality_canopy_si_cdpf)%r82d(io_si,cdpf)+& ccohort%cmort * ccohort%n / m2_per_ha ! damage mortality in the canopy by size x damage x pft - hio_m11_mortality_canopy_si_cdpf(io_si,cdpf) = hio_m11_mortality_canopy_si_cdpf(io_si,cdpf)+& - ccohort%dgmort * ccohort%n / m2_per_ha - - ! carbon starvation mortality in the canopy by size x damage - hio_m3_mortality_canopy_si_cdsc(io_si,cdsc) = hio_m3_mortality_canopy_si_cdsc(io_si,cdsc)+& - ccohort%cmort * ccohort%n / m2_per_ha - ! damage mortality in the canopy by size x damage - hio_m11_mortality_canopy_si_cdsc(io_si,cdsc) = hio_m11_mortality_canopy_si_cdsc(io_si,cdsc)+& + this%hvars(ih_m11_mortality_canopy_si_cdpf)%r82d(io_si,cdpf) = & + this%hvars(ih_m11_mortality_canopy_si_cdpf)%r82d(io_si,cdpf)+& ccohort%dgmort * ccohort%n / m2_per_ha - hio_mortality_canopy_si_cdpf(io_si,cdpf) = hio_mortality_canopy_si_cdpf(io_si,cdpf)+ & + + this%hvars(ih_mortality_canopy_si_cdpf)%r82d(io_si,cdpf) = & + this%hvars(ih_mortality_canopy_si_cdpf)%r82d(io_si,cdpf)+ & (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%frmort + ccohort%smort + & ccohort%asmort + ccohort%dgmort) * 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 ! nplants by damage - hio_nplant_canopy_si_cdpf(io_si,cdpf) = hio_nplant_canopy_si_cdpf(io_si,cdpf) + & - ccohort%n / m2_per_ha - hio_nplant_canopy_si_cdsc(io_si,cdsc) = hio_nplant_canopy_si_cdsc(io_si,cdsc) + & + this%hvars(ih_nplant_canopy_si_cdpf)%r82d(io_si,cdpf) = & + this%hvars(ih_nplant_canopy_si_cdpf)%r82d(io_si,cdpf) + & ccohort%n / m2_per_ha - + ! growth rate by damage x size x pft in the canopy - hio_ddbh_canopy_si_cdpf(io_si,cdpf) = hio_ddbh_canopy_si_cdpf(io_si,cdpf) + & + this%hvars(ih_ddbh_canopy_si_cdpf)%r82d(io_si,cdpf) = & + this%hvars(ih_ddbh_canopy_si_cdpf)%r82d(io_si,cdpf) + & ccohort%ddbhdt*ccohort%n / m2_per_ha * m_per_cm end if ! end if damage @@ -3081,37 +3023,31 @@ subroutine update_history_dyn(this,nc,nsites,sites) ! damage variables - understory if(hlm_use_canopy_damage .eq. itrue .or. hlm_use_understory_damage .eq. itrue) then - ! carbon starvation mortality in the understory by size and by size x damage - hio_m3_mortality_understory_si_cdsc(io_si,cdsc) = hio_m3_mortality_understory_si_cdsc(io_si,cdsc)+& - ccohort%cmort * ccohort%n / m2_per_ha - - ! damage mortality in the understory by size and by size x damage - hio_m11_mortality_understory_si_cdsc(io_si,cdsc) = hio_m11_mortality_understory_si_cdsc(io_si,cdsc)+& - ccohort%dgmort * ccohort%n / m2_per_ha - ! carbon mortality in the understory by damage x size x pft - hio_m3_mortality_understory_si_cdpf(io_si,cdpf) = hio_m3_mortality_understory_si_cdpf(io_si,cdpf)+& + this%hvars(ih_m3_mortality_understory_si_cdpf)%r82d(io_si,cdpf) = & + this%hvars(ih_m3_mortality_understory_si_cdpf)%r82d(io_si,cdpf) + & ccohort%cmort * ccohort%n / m2_per_ha ! damage in the understory by damage x size x pft - hio_m11_mortality_understory_si_cdpf(io_si,cdpf) = hio_m11_mortality_understory_si_cdpf(io_si,cdpf)+& + this%hvars(ih_m11_mortality_understory_si_cdpf)%r82d(io_si,cdpf) = & + this%hvars(ih_m11_mortality_understory_si_cdpf)%r82d(io_si,cdpf) + & ccohort%dgmort * ccohort%n / m2_per_ha ! total mortality of understory cohorts by damage x size x pft - hio_mortality_understory_si_cdpf(io_si,cdpf) = hio_mortality_understory_si_cdpf(io_si,cdpf)+ & + this%hvars(ih_mortality_understory_si_cdpf)%r82d(io_si,cdpf) = & + this%hvars(ih_mortality_understory_si_cdpf)%r82d(io_si,cdpf) + & (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%frmort + & ccohort%smort + ccohort%asmort + ccohort%dgmort) * 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 - ! number of plants in the understory by size x damage and size x damage x pft - hio_nplant_understory_si_cdsc(io_si,cdsc) = hio_nplant_understory_si_cdsc(io_si,cdsc) + & - ccohort%n / m2_per_ha - hio_nplant_understory_si_cdpf(io_si,cdpf) = hio_nplant_understory_si_cdpf(io_si,cdpf) + & + this%hvars(ih_nplant_understory_si_cdpf)%r82d(io_si,cdpf) = & + this%hvars(ih_nplant_understory_si_cdpf)%r82d(io_si,cdpf) + & ccohort%n / m2_per_ha ! growth rate by size x damage x pft - understory - hio_ddbh_understory_si_cdpf(io_si,cdpf) = hio_ddbh_understory_si_cdpf(io_si,cdpf) + & + this%hvars(ih_ddbh_understory_si_cdpf)%r82d(io_si,cdpf) = & + this%hvars(ih_ddbh_understory_si_cdpf)%r82d(io_si,cdpf) + & ccohort%ddbhdt*ccohort%n / m2_per_ha * m_per_cm end if ! end if damage @@ -3373,25 +3309,21 @@ subroutine update_history_dyn(this,nc,nsites,sites) icdpf = (icdam-1)*nlevsclass + i_scls + & (i_pft-1) * nlevsclass * ncrowndamage - hio_mortality_si_cdsc(io_si, icdsc) = hio_mortality_si_cdsc(io_si, icdsc) + & - ( (sites(s)%term_nindivs_canopy_damage(icdam, i_scls, i_pft) * days_per_year ) + & - (sites(s)%term_nindivs_ustory_damage(icdam, i_scls, i_pft) * days_per_year) + & - sites(s)%imort_rate_damage(icdam, i_scls, i_pft) + & - sites(s)%fmort_rate_canopy_damage(icdam, i_scls, i_pft) + & - sites(s)%fmort_rate_ustory_damage(icdam, i_scls, i_pft) ) / m2_per_ha - - hio_mortality_si_cdpf(io_si, icdpf) = hio_mortality_si_cdpf(io_si, icdpf) + & + this%hvars(ih_mortality_si_cdpf)%r82d(io_si, icdpf) = & + this%hvars(ih_mortality_si_cdpf)%r82d(io_si, icdpf) + & ( (sites(s)%term_nindivs_canopy_damage(icdam, i_scls, i_pft) * days_per_year) + & (sites(s)%term_nindivs_ustory_damage(icdam, i_scls, i_pft) * days_per_year) + & sites(s)%imort_rate_damage(icdam, i_scls, i_pft) + & sites(s)%fmort_rate_canopy_damage(icdam, i_scls, i_pft) + & sites(s)%fmort_rate_ustory_damage(icdam, i_scls, i_pft) ) / m2_per_ha - hio_mortality_canopy_si_cdpf(io_si,icdpf) = hio_mortality_canopy_si_cdpf(io_si,icdpf) + & + this%hvars(ih_mortality_canopy_si_cdpf)%r82d(io_si,icdpf) = & + this%hvars(ih_mortality_canopy_si_cdpf)%r82d(io_si,icdpf) + & ( sites(s)%term_nindivs_canopy_damage(icdam,i_scls,i_pft) * days_per_year + & sites(s)%fmort_rate_canopy_damage(icdam, i_scls, i_pft) )/ m2_per_ha - hio_mortality_understory_si_cdpf(io_si,icdpf) = hio_mortality_understory_si_cdpf(io_si,icdpf) + & + this%hvars(ih_mortality_understory_si_cdpf)%r82d(io_si,icdpf) = & + this%hvars(ih_mortality_understory_si_cdpf)%r82d(io_si,icdpf) + & ( sites(s)%term_nindivs_ustory_damage(icdam, i_scls,i_pft) * days_per_year + & sites(s)%imort_rate_damage(icdam, i_scls, i_pft) + & sites(s)%fmort_rate_ustory_damage(icdam, i_scls, i_pft) )/ m2_per_ha @@ -3448,8 +3380,13 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_m7_si_scpf(io_si,i_scpf) + & hio_m8_si_scpf(io_si,i_scpf) + & hio_m9_si_scpf(io_si,i_scpf) + & - hio_m10_si_scpf(io_si,i_scpf)+ & - hio_m11_si_scpf(io_si,i_scpf) + hio_m10_si_scpf(io_si,i_scpf) + + if(hlm_use_canopy_damage .eq. itrue .or. hlm_use_understory_damage .eq. itrue) then + hio_mortality_si_pft(io_si, i_pft) = hio_mortality_si_pft(io_si,i_pft) + & + this%hvars(ih_m11_si_scpf)%r82d(io_si,i_scpf) + end if + end do end do @@ -4734,7 +4671,6 @@ subroutine define_history_vars(this, initialize_variables) ! plant functional type (site_pft_r8) : PF ! soil layer (site_ground_r8) : SL ! cohort size (site_size_r8) : SZ - ! cohort crown damage (site_cd_r8) : CD ! Multiple dimensions should have multiple two-code suffixes: ! cohort age x pft (site_cooage_r8) : ACPF @@ -6880,31 +6816,16 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=site_r8, hlms='CLM:ALM', & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_crownarea_ustory_damage_si ) - call this%set_history_var(vname='FATES_NPLANT_SZCD', units = 'm-2', & - long='N. plants per damage x size class', use_default='inactive', & - avgflag='A', vtype=site_cdsc_r8, hlms='CLM:ALM', & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_nplant_si_cdsc ) - call this%set_history_var(vname='FATES_NPLANT_CDPF', units = 'm-2', & long='N. plants per damage x size x pft class', use_default='inactive', & avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_nplant_si_cdpf ) - - call this%set_history_var(vname='FATES_NPLANT_CANOPY_SZCD', units = 'm-2', & - long='N. plants in the canopy per damage x size class', use_default='inactive', & - avgflag='A', vtype=site_cdsc_r8, hlms='CLM:ALM', & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_nplant_canopy_si_cdsc ) - + call this%set_history_var(vname='FATES_NPLANT_CANOPY_CDPF', units = 'm-2', & long='N. plants per damage x size x pft class', use_default='inactive', & avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_nplant_canopy_si_cdpf ) - call this%set_history_var(vname='FATES_NPLANT_USTORY_SZCD', units = 'm-2', & - long='N. plants in the understory per damage x size class', use_default='inactive', & - avgflag='A', vtype=site_cdsc_r8, hlms='CLM:ALM', & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_nplant_understory_si_cdsc ) - call this%set_history_var(vname='FATES_NPLANT_USTORY_CDPF', units = 'm-2', & long='N. plants in the understory per damage x size x pft class', use_default='inactive', & avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', & @@ -6915,16 +6836,6 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m3_si_cdpf ) - call this%set_history_var(vname='FATES_M3_SZCD', units = 'm-2 yr-1', & - long='carbon starvation mortality by damage/size', use_default='inactive', & - avgflag='A', vtype=site_cdsc_r8, hlms='CLM:ALM', & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m3_si_cdsc ) - - call this%set_history_var(vname='FATES_M11_SZ', units = 'm-2 yr-1', & - long='damage mortality by size',use_default='inactive', & - avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m11_si_scls ) - call this%set_history_var(vname='FATES_M11_SZPF', units = 'm-2 yr-1', & long='damage mortality by pft/size',use_default='inactive', & avgflag='A', vtype =site_size_pft_r8, hlms='CLM:ALM', & @@ -6935,31 +6846,11 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m11_si_cdpf ) - call this%set_history_var(vname='FATES_M11_SZCD', units = 'm-2 yr-1', & - long='damage mortality by damage/size', use_default='inactive', & - avgflag='A', vtype=site_cdsc_r8, hlms='CLM:ALM', & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m11_si_cdsc ) - - call this%set_history_var(vname='FATES_MORTALITY_SZCD', units = 'm-2 yr-1', & - long='mortality by damage class by size', use_default='inactive', & - avgflag='A', vtype=site_cdsc_r8, hlms='CLM:ALM', & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_mortality_si_cdsc ) - call this%set_history_var(vname='FATES_MORTALITY_CDPF', units = 'm-2 yr-1', & long='mortality by damage class by size by pft', use_default='inactive', & avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_mortality_si_cdpf ) - call this%set_history_var(vname='FATES_M3_MORTALITY_CANOPY_SZCD', units = 'm-2 yr-1', & - long='C starviation mortality of canopy trees by damage/size class', use_default='inactive', & - avgflag='A', vtype=site_cdsc_r8, hlms='CLM:ALM', & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m3_mortality_canopy_si_cdsc) - - call this%set_history_var(vname='FATES_M3_MORTALITY_USTORY_SZCD', units = 'm-2 yr-1', & - long='C starviation mortality of understory trees by damage/size class', use_default='inactive', & - avgflag='A', vtype=site_cdsc_r8, hlms='CLM:ALM', & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m3_mortality_understory_si_cdsc) - call this%set_history_var(vname='FATES_M3_MORTALITY_CANOPY_CDPF', units = 'm-2 yr-1', & long='C starvation mortality of canopy plants by damage/pft/size', use_default='inactive', & avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', & @@ -6970,11 +6861,6 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m3_mortality_understory_si_cdpf ) - call this%set_history_var(vname='FATES_M11_MORTALITY_CANOPY_SZCD', units = 'm-2 yr-1', & - long='damage mortality of canopy trees by damage/size class', use_default='inactive', & - avgflag='A', vtype=site_cdsc_r8, hlms='CLM:ALM', & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m11_mortality_canopy_si_cdsc) - call this%set_history_var(vname='FATES_M11_MORTALITY_CANOPY_CDPF', units = 'm-2 yr-1', & long='damage mortality of canopy plants by damage/pft/size', use_default='inactive', & avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', & @@ -6994,17 +6880,7 @@ subroutine define_history_vars(this, initialize_variables) long='mortality of understory plants by pft/size', use_default='inactive', & avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_mortality_understory_si_cdpf ) - - call this%set_history_var(vname='FATES_M11_MORTALITY_USTORY_SZCD', units = 'm-2 yr-1', & - long='damage mortality of understory trees by damage/size class', use_default='inactive', & - avgflag='A', vtype=site_cdsc_r8, hlms='CLM:ALM', & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m11_mortality_understory_si_cdsc) - - call this%set_history_var(vname='FATES_DDBH_SZCD', units = 'm m-2 yr-1', & - long='ddbh annual increment growth by damage and size', use_default='inactive', & - avgflag='A', vtype=site_cdsc_r8, hlms='CLM:ALM', & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_ddbh_si_cdsc ) - + call this%set_history_var(vname='FATES_DDBH_CDPF', units = 'm m-2 yr-1', & long='ddbh annual increment growth by damage x size pft', use_default='inactive', & avgflag='A', vtype=site_cdpf_r8, hlms='CLM:ALM', & diff --git a/main/FatesIODimensionsMod.F90 b/main/FatesIODimensionsMod.F90 index 09bead9bc4..52e3dee6c3 100644 --- a/main/FatesIODimensionsMod.F90 +++ b/main/FatesIODimensionsMod.F90 @@ -145,8 +145,6 @@ module FatesIODimensionsMod integer :: cnlf_end integer :: cnlfpft_begin integer :: cnlfpft_end - integer :: cdamage_begin - integer :: cdamage_end integer :: cdsc_begin integer :: cdsc_end integer :: cdpf_begin diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 38ff625b68..5f9712f786 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -1031,7 +1031,6 @@ subroutine fates_history_maps allocate( fates_hdim_pfmap_levcapf(1:nlevcoage*numpft)) allocate( fates_hdim_camap_levcapf(1:nlevcoage*numpft)) - allocate( fates_hdim_levcdam(ncrowndamage )) allocate( fates_hdim_scmap_levcdsc(nlevsclass*ncrowndamage)) allocate( fates_hdim_cdmap_levcdsc(nlevsclass*ncrowndamage)) allocate( fates_hdim_scmap_levcdpf(nlevsclass*ncrowndamage * numpft)) @@ -1091,10 +1090,6 @@ subroutine fates_history_maps fates_hdim_levcan(ican) = ican end do - ! make damage array - do icdam = 1,ncrowndamage - fates_hdim_levcdam(icdam) = icdam - end do ! Make an element array, each index is the PARTEH global identifier index diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 2f3b8aaf96..b75994f1a0 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -241,7 +241,6 @@ module FatesInterfaceTypesMod real(r8), public, allocatable :: fates_hdim_levsclass(:) ! plant size class lower bound dimension integer , public, allocatable :: fates_hdim_pfmap_levscpf(:) ! map of pfts into size-class x pft dimension integer , public, allocatable :: fates_hdim_scmap_levscpf(:) ! map of size-class into size-class x pft dimension - integer , public, allocatable :: fates_hdim_levcdam(:) ! crown damage dimension integer , public, allocatable :: fates_hdim_pftmap_levcdpf(:) ! map of pfts into size x crowndamage x pft dimension integer , public, allocatable :: fates_hdim_cdmap_levcdpf(:) ! map of crowndamage into size x crowndamage x pft integer , public, allocatable :: fates_hdim_scmap_levcdpf(:) ! map of size into size x crowndamage x pft From 6b6ed7fac7dc745352c8d5875223fa40f7f0dd73 Mon Sep 17 00:00:00 2001 From: Jessica Needham Date: Thu, 17 Feb 2022 11:09:18 -0800 Subject: [PATCH 20/84] [ Remove cdcd dimension ] [ Remove the damage x damage dimension. Not needed. ] Fixes: [NGT-ED Github issue #] User interface changes?: [Yes (describe what changes), No] Code review: [Names] Test suite: [suite name, machine, compilers] Test baseline: Test namelist changes: Test answer changes: [bit for bit, roundoff, climate changing] Test summary: no testing --- main/FatesIODimensionsMod.F90 | 4 ---- main/FatesIOVariableKindMod.F90 | 1 - main/FatesInterfaceMod.F90 | 11 +---------- main/FatesInterfaceTypesMod.F90 | 2 -- 4 files changed, 1 insertion(+), 17 deletions(-) diff --git a/main/FatesIODimensionsMod.F90 b/main/FatesIODimensionsMod.F90 index b5eafb2cef..52e3dee6c3 100644 --- a/main/FatesIODimensionsMod.F90 +++ b/main/FatesIODimensionsMod.F90 @@ -28,7 +28,6 @@ module FatesIODimensionsMod character(*), parameter, public :: levcnlf = 'fates_levcnlf' ! matches histFileMod character(*), parameter, public :: levcnlfpft = 'fates_levcnlfpf' ! matches histFileMod character(*), parameter, public :: levcdsc = 'fates_levcdsc' ! matches histFileMod - character(*), parameter, public :: levcdcd = 'fates_levcdcd' ! matches histFileMod character(*), parameter, public :: levcdpf = 'fates_levcdpf' ! matches histFileMod character(*), parameter, public :: levagefuel = 'fates_levagefuel' ! matches histFileMod character(*), parameter, public :: levelem = 'fates_levelem' @@ -86,9 +85,6 @@ module FatesIODimensionsMod ! levcdsc = This is a structure that records the boundaries for the ! number of crown damage x size classes dimension - ! levcdcd = This is a structure that records the boundaries for the - ! number of crown damage x crown damage classes - for damage transitions - ! levcdpf = This is a structure that records the boundaries for the ! number of crown damage x size classes x pft dimension diff --git a/main/FatesIOVariableKindMod.F90 b/main/FatesIOVariableKindMod.F90 index 3b10d698cd..a40f1c2dbe 100644 --- a/main/FatesIOVariableKindMod.F90 +++ b/main/FatesIOVariableKindMod.F90 @@ -33,7 +33,6 @@ module FatesIOVariableKindMod character(*), parameter, public :: site_cnlfpft_r8 = 'SI_CNLFPFT_R8' character(*), parameter, public :: site_cdpf_r8 = 'SI_CDPF_R8' character(*), parameter, public :: site_cdsc_r8 = 'SI_CDSC_R8' - character(*), parameter, public :: site_cdcd_r8 = 'SI_CDCD_R8' character(*), parameter, public :: site_scag_r8 = 'SI_SCAG_R8' character(*), parameter, public :: site_scagpft_r8 = 'SI_SCAGPFT_R8' character(*), parameter, public :: site_agepft_r8 = 'SI_AGEPFT_R8' diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 0d2463bf0a..56edc4df7f 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -1013,7 +1013,6 @@ subroutine fates_history_maps integer :: ifuel integer :: ican integer :: icdam - integer :: icdcd integer :: ileaf integer :: iage integer :: iheight @@ -1172,15 +1171,7 @@ subroutine fates_history_maps end do end do - i=0 - do icdam=1,ncrowndamage - do icdcd=1,ncrowndamage+1 - i=i+1 - fates_hdim_cdimap_levcdcd(i) = icdcd - fates_hdim_cdjmap_levcdcd(i) = icdam - end do - end do - + i=0 do ipft=1,numpft do ican=1,nclmax diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index aa5444fb0b..b75994f1a0 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -246,8 +246,6 @@ module FatesInterfaceTypesMod integer , public, allocatable :: fates_hdim_scmap_levcdpf(:) ! map of size into size x crowndamage x pft integer , public, allocatable :: fates_hdim_cdmap_levcdsc(:) ! map of crowndamage into size x crowndamage integer , public, allocatable :: fates_hdim_scmap_levcdsc(:) ! map of size into size x crowndamage - integer , public, allocatable :: fates_hdim_cdimap_levcdcd(:) ! map of current damage into damage x damage - integer , public, allocatable :: fates_hdim_cdjmap_levcdcd(:) ! map of new damage into damage x damage real(r8), public, allocatable :: fates_hdim_levage(:) ! patch age lower bound dimension real(r8), public, allocatable :: fates_hdim_levheight(:) ! height lower bound dimension From d15081feac9ea5c87bea035a15c84cd84a66a042 Mon Sep 17 00:00:00 2001 From: Jessica Needham Date: Mon, 28 Feb 2022 14:29:15 -0800 Subject: [PATCH 21/84] [ update comments on branch_frac ] [] Fixes: [NGT-ED Github issue #] User interface changes?: [Yes (describe what changes), No] Code review: [Names] Test suite: [suite name, machine, compilers] Test baseline: Test namelist changes: Test answer changes: [bit for bit, roundoff, climate changing] Test summary: --- biogeochem/FatesAllometryMod.F90 | 4 ++-- biogeophys/FatesPlantRespPhotosynthMod.F90 | 2 +- main/EDTypesMod.F90 | 2 +- main/FatesParameterDerivedMod.F90 | 4 ++-- 4 files changed, 6 insertions(+), 6 deletions(-) diff --git a/biogeochem/FatesAllometryMod.F90 b/biogeochem/FatesAllometryMod.F90 index c3df74183d..862a837782 100644 --- a/biogeochem/FatesAllometryMod.F90 +++ b/biogeochem/FatesAllometryMod.F90 @@ -374,7 +374,7 @@ subroutine bagw_allom(d,ipft,crowndamage, bagw,dbagwdd) real(r8) :: h ! height real(r8) :: dhdd ! change in height wrt d real(r8) :: crown_reduction ! crown reduction from damage - real(r8) :: branch_frac ! fraction of aboveground biomass in branches + real(r8) :: branch_frac ! fraction of aboveground woody biomass in branches associate( p1 => prt_params%allom_agb1(ipft), & p2 => prt_params%allom_agb2(ipft), & @@ -923,7 +923,7 @@ subroutine bsap_allom(d,ipft,crowndamage,canopy_trim,sapw_area,bsap,dbsapdd) real(r8) :: crown_reduction ! amount that crown is damage by real(r8) :: agb_frac ! aboveground biomass fraction - real(r8) :: branch_frac ! fraction of aboveground biomass in branches + real(r8) :: branch_frac ! fraction of aboveground woody biomass in branches ! Constrain sapwood so that its above ground portion be no larger than ! X% of total woody/fibrous (ie non leaf/fineroot) tissues diff --git a/biogeophys/FatesPlantRespPhotosynthMod.F90 b/biogeophys/FatesPlantRespPhotosynthMod.F90 index accf729e8d..3bf35c6849 100644 --- a/biogeophys/FatesPlantRespPhotosynthMod.F90 +++ b/biogeophys/FatesPlantRespPhotosynthMod.F90 @@ -245,7 +245,7 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) real(r8), allocatable :: rootfr_ft(:,:) ! Root fractions per depth and PFT real(r8) :: agb_frac ! fraction of biomass aboveground - real(r8) :: branch_frac ! fraction of aboveground biomass in branches + real(r8) :: branch_frac ! fraction of aboveground woody biomass in branches real(r8) :: crown_reduction ! reduction in crown biomass from damage real(r8) :: sapw_c_predamage ! pre damage sapwood real(r8) :: sapw_n ! sapwood n diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 50cab343aa..3762efd610 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -345,7 +345,7 @@ module EDTypesMod real(r8) :: froot_mr ! Live fine root maintenance respiration: kgC/indiv/s !DAMAGE - real(r8) :: branch_frac ! Fraction of aboveground biomass in branches + real(r8) :: branch_frac ! Fraction of aboveground woody biomass in branches !MORTALITY real(r8) :: dmort ! proportional mortality rate. (year-1) diff --git a/main/FatesParameterDerivedMod.F90 b/main/FatesParameterDerivedMod.F90 index 1857dfdffe..f63df66318 100644 --- a/main/FatesParameterDerivedMod.F90 +++ b/main/FatesParameterDerivedMod.F90 @@ -28,7 +28,7 @@ module FatesParameterDerivedMod real(r8), allocatable :: kp25top(:,:) ! canopy top: initial slope of CO2 response ! curve (C4 plants) at 25C - real(r8), allocatable :: branch_frac(:) ! fraction of aboveground biomass in branches (as + real(r8), allocatable :: branch_frac(:) ! fraction of aboveground woody biomass in branches (as ! oppose to stems) - for use in damage allometries real(r8), allocatable :: damage_transitions(:,:,:) ! matrix of transition probabilities between @@ -118,7 +118,7 @@ subroutine Init(this,numpft) end do - ! Allocate fraction of biomass in branches + ! Allocate fraction of aboveground woody biomass in branches this%branch_frac(ft) = sum(SF_val_CWD_frac(1:3)) end do !ft From a3bb261bb087e27bb2e5b96540b08cae7f56a502 Mon Sep 17 00:00:00 2001 From: Jessica Needham Date: Tue, 1 Mar 2022 14:33:15 -0800 Subject: [PATCH 22/84] [ delete old variables from EDInitMod] [ ] Fixes: [NGT-ED Github issue #] User interface changes?: [Yes (describe what changes), No] Code review: [Names] Test suite: [suite name, machine, compilers] Test baseline: Test namelist changes: Test answer changes: [bit for bit, roundoff, climate changing] Test summary: no testing --- main/EDInitMod.F90 | 12 ------------ 1 file changed, 12 deletions(-) diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index 27666a06e5..0f92b29916 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -132,10 +132,6 @@ subroutine init_site_vars( site_in, bc_in, bc_out ) allocate(site_in%flux_diags(1:num_elements)) if (hlm_use_canopy_damage .eq. itrue .or. hlm_use_understory_damage .eq. itrue) then - allocate(site_in%damage_cflux(1:ncrowndamage, 1:ncrowndamage+1)) - allocate(site_in%damage_rate(1:ncrowndamage, 1:ncrowndamage+1)) - allocate(site_in%recovery_cflux(1:ncrowndamage, 1:ncrowndamage+1)) - allocate(site_in%recovery_rate(1:ncrowndamage, 1:ncrowndamage+1)) allocate(site_in%term_nindivs_canopy_damage(1:ncrowndamage, 1:nlevsclass, 1:numpft)) allocate(site_in%term_nindivs_ustory_damage(1:ncrowndamage, 1:nlevsclass, 1:numpft)) allocate(site_in%imort_rate_damage(1:ncrowndamage, 1:nlevsclass, 1:numpft)) @@ -147,10 +143,6 @@ subroutine init_site_vars( site_in, bc_in, bc_out ) allocate(site_in%fmort_cflux_canopy_damage(1:ncrowndamage, 1:nlevsclass)) allocate(site_in%fmort_cflux_ustory_damage(1:ncrowndamage, 1:nlevsclass)) else - allocate(site_in%damage_cflux(1, 1)) - allocate(site_in%damage_rate(1, 1)) - allocate(site_in%recovery_cflux(1, 1)) - allocate(site_in%recovery_rate(1, 1)) allocate(site_in%term_nindivs_canopy_damage(1,1,1)) allocate(site_in%term_nindivs_ustory_damage(1,1,1)) allocate(site_in%imort_rate_damage(1,1,1)) @@ -288,10 +280,6 @@ subroutine zero_site( site_in ) site_in%promotion_carbonflux = 0._r8 ! damage transition info - site_in%damage_cflux(:,:) = 0._r8 - site_in%damage_rate(:,:) = 0._r8 - site_in%recovery_cflux(:,:) = 0._r8 - site_in%recovery_rate(:,:) = 0._r8 site_in%imort_rate_damage(:,:,:) = 0._r8 site_in%term_nindivs_canopy_damage(:,:,:) = 0._r8 site_in%term_nindivs_ustory_damage(:,:,:) = 0._r8 From 36e8faf7db80251a08099907d58e9d3f9631a807 Mon Sep 17 00:00:00 2001 From: Jessica Needham Date: Wed, 2 Mar 2022 09:29:49 -0800 Subject: [PATCH 23/84] [ Remove old history variables ] [Get rid of remaining damage_cflux and damage_rate variables ] Fixes: [NGT-ED Github issue #] User interface changes?: [Yes (describe what changes), No] Code review: [Names] Test suite: [suite name, machine, compilers] Test baseline: Test namelist changes: Test answer changes: [bit for bit, roundoff, climate changing] Test summary: no testing --- main/EDTypesMod.F90 | 6 ------ main/FatesRestartInterfaceMod.F90 | 32 ------------------------------- 2 files changed, 38 deletions(-) diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 3762efd610..8f367f78de 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -840,12 +840,6 @@ module EDTypesMod real(r8), allocatable :: growthflux_fusion(:,:) ! rate of individuals moving into a given size class bin ! due to fusion in a given day. on size x pft array - - ! Damage fluxes - real(r8), allocatable :: damage_cflux(:,:) ! carbon flux into each damage class each timestep - real(r8), allocatable :: damage_rate(:,:) ! number of individuals moving into a damage class - real(r8), allocatable :: recovery_cflux(:,:) ! carbon flux from recovery each timestep - real(r8), allocatable :: recovery_rate(:,:) ! number of individuals recovering each timesept real(r8), allocatable :: imort_rate_damage(:,:,:) ! number of individuals per damage class that die from impact mortality real(r8), allocatable :: term_nindivs_canopy_damage(:,:,:) ! number of individuals per damage class that die from termination mortality - canopy diff --git a/main/FatesRestartInterfaceMod.F90 b/main/FatesRestartInterfaceMod.F90 index e111a9e699..4512448504 100644 --- a/main/FatesRestartInterfaceMod.F90 +++ b/main/FatesRestartInterfaceMod.F90 @@ -240,10 +240,6 @@ module FatesRestartInterfaceMod integer :: ir_termcflux_usto_sicdsc integer :: ir_fmortcflux_cano_sicdsc integer :: ir_fmortcflux_usto_sicdsc - integer :: ir_damage_cflux_sicd - integer :: ir_damage_rate_sicd - integer :: ir_recovery_cflux_sicd - integer :: ir_recovery_rate_sicd integer :: ir_crownarea_cano_si integer :: ir_crownarea_usto_si @@ -1375,26 +1371,6 @@ subroutine define_restart_vars(this, initialize_variables) units='kgC/ha/day', flushval = flushzero, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_fmortcflux_usto_sicdsc) - call this%set_restart_var(vname='fates_damage_cflux', vtype=cohort_r8, & - long_name='fates diagnostic rate of damage carbonflux', & - units='kgC/ha/day', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_damage_cflux_sicd) - - call this%set_restart_var(vname='fates_damage_rate', vtype=cohort_r8, & - long_name='fates diagnostic rate of damage transitions', & - units='indiv / ha/ day', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_damage_rate_sicd) - - call this%set_restart_var(vname='fates_recovery_cflux', vtype=cohort_r8, & - long_name='fates diagnostic rate of recovery carbonflux', & - units='kgC/ha/day', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_recovery_cflux_sicd) - - call this%set_restart_var(vname='fates_recovery_rate', vtype=cohort_r8, & - long_name='fates diagnostic rate of recovery transitions', & - units='indiv / ha/ day', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_recovery_rate_sicd) - call this%set_restart_var(vname='fates_crownarea_canopy_damage', vtype=site_r8, & long_name='fates area lost from damage each year', & units='m2/ha/year', flushval = flushzero, & @@ -2001,10 +1977,6 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_fmortrate_usto_sicdpf => this%rvars(ir_fmortrate_usto_sicdpf)%r81d, & rio_fmortcflux_cano_sicdsc => this%rvars(ir_fmortcflux_cano_sicdsc)%r81d, & rio_fmortcflux_usto_sicdsc => this%rvars(ir_fmortcflux_usto_sicdsc)%r81d, & - rio_damage_cflux_sicd => this%rvars(ir_damage_cflux_sicd)%r81d, & - rio_damage_rate_sicd => this%rvars(ir_damage_rate_sicd)%r81d, & - rio_recovery_cflux_sicd => this%rvars(ir_recovery_cflux_sicd)%r81d, & - rio_recovery_rate_sicd => this%rvars(ir_recovery_rate_sicd)%r81d, & rio_crownarea_cano_damage_si=> this%rvars(ir_crownarea_cano_si)%r81d, & rio_crownarea_usto_damage_si=> this%rvars(ir_crownarea_usto_si)%r81d) @@ -2894,10 +2866,6 @@ subroutine get_restart_vectors(this, nc, nsites, sites) ! Damage - rio_damage_cflux_sicd => this%rvars(ir_damage_cflux_sicd)%r81d, & - rio_damage_rate_sicd => this%rvars(ir_damage_rate_sicd)%r81d, & - rio_recovery_cflux_sicd => this%rvars(ir_recovery_cflux_sicd)%r81d, & - rio_recovery_rate_sicd => this%rvars(ir_recovery_rate_sicd)%r81d, & rio_imortrate_sicdpf => this%rvars(ir_imortrate_sicdpf)%r81d, & rio_termnindiv_cano_sicdpf => this%rvars(ir_termnindiv_cano_sicdpf)%r81d, & rio_termnindiv_usto_sicdpf => this%rvars(ir_termnindiv_usto_sicdpf)%r81d, & From 7ed9029549aa61d20583e7b9605da9ddb3d549a4 Mon Sep 17 00:00:00 2001 From: Jessica Needham Date: Wed, 2 Mar 2022 09:36:49 -0800 Subject: [PATCH 24/84] [ and remove the last damage_clux and damage_rate variables ] [ ] Fixes: [NGT-ED Github issue #] User interface changes?: [Yes (describe what changes), No] Code review: [Names] Test suite: [suite name, machine, compilers] Test baseline: Test namelist changes: Test answer changes: [bit for bit, roundoff, climate changing] Test summary: no testing --- main/EDMainMod.F90 | 16 +--------------- 1 file changed, 1 insertion(+), 15 deletions(-) diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index bcee878b3e..3b92b68e73 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -597,12 +597,7 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) currentCohort%pft, currentCohort%crowndamage, currentCohort%c_area) - currentSite%recovery_rate(currentCohort%crowndamage, nc%crowndamage) = & - currentSite%recovery_rate(currentCohort%crowndamage, nc%crowndamage) + nc%n - currentSite%recovery_cflux(currentCohort%crowndamage, nc%crowndamage) = & - currentSite%recovery_cflux(currentCohort%crowndamage, nc%crowndamage) + & - nc%n * nc_carbon - + !----------- Insert copy into linked list ----------------------! nc%shorter => currentCohort if(associated(currentCohort%taller))then @@ -618,15 +613,6 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) end if ! end if crowndamage > 1 - - ! fill in the diagonals - i.e. those that did not recover - currentSite%recovery_rate(currentCohort%crowndamage, currentCohort%crowndamage) = & - currentSite%recovery_rate(currentCohort%crowndamage, currentCohort%crowndamage) +& - currentCohort%n - currentSite%recovery_cflux(currentCohort%crowndamage, currentCohort%crowndamage) = & - currentSite%recovery_cflux(currentCohort%crowndamage, currentCohort%crowndamage) + & - currentCohort%n * cc_carbon - end if ! end if crowndamage is on From 63edb539bb980be6ac989c628e48e4b14091878a Mon Sep 17 00:00:00 2001 From: Jessica Needham Date: Mon, 7 Mar 2022 13:19:40 -0800 Subject: [PATCH 25/84] [ Change default damage param values ] [ Increase fates_damage_mort_p1 so that damage-dependent mortality is off by default. ] Fixes: [NGT-ED Github issue #] User interface changes?: [Yes (describe what changes), No] Code review: [Names] Test suite: [suite name, machine, compilers] Test baseline: Test namelist changes: Test answer changes: [bit for bit, roundoff, climate changing] Test summary:no testing --- parameter_files/fates_params_default.cdl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/parameter_files/fates_params_default.cdl b/parameter_files/fates_params_default.cdl index 4a9d10b1f5..80518fd58e 100644 --- a/parameter_files/fates_params_default.cdl +++ b/parameter_files/fates_params_default.cdl @@ -914,7 +914,7 @@ data: fates_damage_frac = 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01 ; - fates_damage_mort_p1 = 0.9,0.9,0.9,0.9,0.9,0.9,0.9,0.9,0.9,0.9,0.9,0.9 ; + fates_damage_mort_p1 = 9.0,9.0,9.0,9.0,9.0,9.0,9.0,9.0,9.0,9.0,9.0,9.0 ; fates_damage_mort_p2 = 5.5, 5.5, 5.5, 5.5, 5.5, 5.5, 5.5, 5.5, 5.5, 5.5, 5.5, 5.5 ; From c8d86d1517580b26cef43557bbd8f077fe802929 Mon Sep 17 00:00:00 2001 From: Jessica Needham Date: Thu, 10 Mar 2022 15:55:52 -0800 Subject: [PATCH 26/84] [ remove damage_cflux ] [ . ] Fixes: [NGT-ED Github issue #] User interface changes?: [Yes (describe what changes), No] Code review: [Names] Test suite: [suite name, machine, compilers] Test baseline: Test namelist changes: Test answer changes: [bit for bit, roundoff, climate changing] Test summary: no testing --- biogeochem/EDPatchDynamicsMod.F90 | 30 ------------------------------ 1 file changed, 30 deletions(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 3af8aae71d..63e29f6f6c 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -1322,13 +1322,6 @@ subroutine spawn_patches( currentSite, bc_in) fnrt_c = nc_d%prt%GetState(fnrt_organ, all_carbon_elements) - currentSite%damage_cflux(currentCohort%crowndamage, cd) = & - currentSite%damage_cflux(currentCohort%crowndamage, cd) + & - (leaf_m_post + sapw_m_post + struct_m_post + store_m_post + fnrt_c) * cd_n * & - hlm_days_per_year - - currentSite%damage_rate(currentCohort%crowndamage, cd) = & - currentSite%damage_rate(currentCohort%crowndamage, cd) + cd_n * hlm_days_per_year if(hlm_use_canopy_damage .eq. itrue) then currentSite%crownarea_canopy_damage = currentSite%crownarea_canopy_damage + & @@ -1383,29 +1376,6 @@ subroutine spawn_patches( currentSite, bc_in) end if ! end if damage is on - if(hlm_use_canopy_damage .eq. itrue .and. currentCohort%canopy_layer == 1 .or.& - hlm_use_understory_damage .eq. itrue .and. currentCohort%canopy_layer > 1) then - - if(.not. currentCohort%isnew) then - - ! Keep track of number and carbon that stayed in the same damage class - 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) - repro_c = currentCohort%prt%GetState(repro_organ, all_carbon_elements) - - currentSite%damage_cflux(currentCohort%crowndamage, currentCohort%crowndamage) = & - currentSite%damage_cflux(currentCohort%crowndamage, currentCohort%crowndamage) + & - (sapw_c + struct_c + leaf_c + fnrt_c + store_c + repro_c) * currentCohort%n - - currentSite%damage_rate(currentCohort%crowndamage, currentCohort%crowndamage) = & - currentSite%damage_rate(currentCohort%crowndamage, currentCohort%crowndamage) + currentCohort%n - - end if - end if ! end if damage is on - ! Put new undamaged cohorts in the correct place in the linked list if (nc%n > 0.0_r8) then storebigcohort => new_patch%tallest From 442639fa86f51b3ed0245433b8b9e33178e4d75d Mon Sep 17 00:00:00 2001 From: Jessica Needham Date: Tue, 22 Mar 2022 13:57:11 -0700 Subject: [PATCH 27/84] [ Add damage only dimension back. ] [ Useful in python scripts to know how many damage classes there are ] Fixes: [NGT-ED Github issue #] User interface changes?: [Yes (describe what changes), No] Code review: [Names] Test suite: [suite name, machine, compilers] Test baseline: Test namelist changes: Test answer changes: [bit for bit, roundoff, climate changing] Test summary:no testing --- main/FatesIODimensionsMod.F90 | 8 +++++++- main/FatesIOVariableKindMod.F90 | 1 + main/FatesInterfaceMod.F90 | 1 + main/FatesInterfaceTypesMod.F90 | 1 + 4 files changed, 10 insertions(+), 1 deletion(-) diff --git a/main/FatesIODimensionsMod.F90 b/main/FatesIODimensionsMod.F90 index 325ef44d6b..d8923b60dd 100644 --- a/main/FatesIODimensionsMod.F90 +++ b/main/FatesIODimensionsMod.F90 @@ -28,6 +28,7 @@ module FatesIODimensionsMod character(*), parameter, public :: levcnlfpft = 'fates_levcnlfpf' ! matches histFileMod character(*), parameter, public :: levcdsc = 'fates_levcdsc' ! matches histFileMod character(*), parameter, public :: levcdpf = 'fates_levcdpf' ! matches histFileMod + character(*), parameter, public :: levcdam = 'fates_levcdam' ! matches histFileMod character(*), parameter, public :: levagefuel = 'fates_levagefuel' ! matches histFileMod character(*), parameter, public :: levelem = 'fates_levelem' character(*), parameter, public :: levelpft = 'fates_levelpft' @@ -82,7 +83,10 @@ module FatesIODimensionsMod ! levcdpf = This is a structure that records the boundaries for the ! number of crown damage x size classes x pft dimension - + + ! levcdam = This is the structure that records the boundaries for the + ! number of crown damage classes dimension + ! levscag = This is a strcture that records the boundaries for the ! number of size-classes x patch age @@ -142,6 +146,8 @@ module FatesIODimensionsMod integer :: cdsc_end integer :: cdpf_begin integer :: cdpf_end + integer :: cdam_begin + integer :: cdam_end integer :: elem_begin integer :: elem_end integer :: elpft_begin diff --git a/main/FatesIOVariableKindMod.F90 b/main/FatesIOVariableKindMod.F90 index c35ca67507..66db1caf57 100644 --- a/main/FatesIOVariableKindMod.F90 +++ b/main/FatesIOVariableKindMod.F90 @@ -29,6 +29,7 @@ module FatesIOVariableKindMod character(*), parameter, public :: site_cnlfpft_r8 = 'SI_CNLFPFT_R8' character(*), parameter, public :: site_cdpf_r8 = 'SI_CDPF_R8' character(*), parameter, public :: site_cdsc_r8 = 'SI_CDSC_R8' + character(*), parameter, public :: site_cdam_r8 = 'SI_CDAM_R8' character(*), parameter, public :: site_scag_r8 = 'SI_SCAG_R8' character(*), parameter, public :: site_scagpft_r8 = 'SI_SCAGPFT_R8' character(*), parameter, public :: site_agepft_r8 = 'SI_AGEPFT_R8' diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index a75d91063d..4a060acd3a 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -1031,6 +1031,7 @@ subroutine fates_history_maps allocate( fates_hdim_pfmap_levcapf(1:nlevcoage*numpft)) allocate( fates_hdim_camap_levcapf(1:nlevcoage*numpft)) + allocate( fates_hdim_levcdam(1:ncrowndamage )) allocate( fates_hdim_scmap_levcdsc(nlevsclass*ncrowndamage)) allocate( fates_hdim_cdmap_levcdsc(nlevsclass*ncrowndamage)) allocate( fates_hdim_scmap_levcdpf(nlevsclass*ncrowndamage * numpft)) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index cfd710d2d3..a9bb7efba5 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -244,6 +244,7 @@ module FatesInterfaceTypesMod integer , public, allocatable :: fates_hdim_scmap_levcdpf(:) ! map of size into size x crowndamage x pft integer , public, allocatable :: fates_hdim_cdmap_levcdsc(:) ! map of crowndamage into size x crowndamage integer , public, allocatable :: fates_hdim_scmap_levcdsc(:) ! map of size into size x crowndamage + integer , public, allocatable :: fates_hdim_levcdam(:) ! plant damage class lower bound dimension real(r8), public, allocatable :: fates_hdim_levage(:) ! patch age lower bound dimension real(r8), public, allocatable :: fates_hdim_levheight(:) ! height lower bound dimension From 6f0e6821dacb466826604239e5473b968584650a Mon Sep 17 00:00:00 2001 From: Jessica Needham Date: Tue, 22 Mar 2022 16:59:16 -0700 Subject: [PATCH 28/84] [ Make crown damage bin edges flexible ] [Allow for uneven spacing of damage bins. ] Fixes: [NGT-ED Github issue #] User interface changes?: [Yes (describe what changes), No] Code review: [Names] Test suite: [suite name, machine, compilers] Test baseline: Test namelist changes: Test answer changes: [bit for bit, roundoff, climate changing] Test summary:no testing --- biogeochem/DamageMainMod.F90 | 10 +++---- biogeochem/EDPatchDynamicsMod.F90 | 8 +++--- main/EDInitMod.F90 | 22 ++++++++-------- main/EDMainMod.F90 | 2 +- main/EDParamsMod.F90 | 26 +++++++++---------- main/FatesHistoryInterfaceMod.F90 | 8 +++--- main/FatesInterfaceMod.F90 | 33 ++++++++++-------------- main/FatesInterfaceTypesMod.F90 | 2 +- main/FatesParameterDerivedMod.F90 | 20 +++++++------- main/FatesParametersInterface.F90 | 1 + main/FatesRestartInterfaceMod.F90 | 8 +++--- main/FatesSizeAgeTypeIndicesMod.F90 | 6 +++-- parameter_files/fates_params_default.cdl | 13 +++++----- 13 files changed, 78 insertions(+), 81 deletions(-) diff --git a/biogeochem/DamageMainMod.F90 b/biogeochem/DamageMainMod.F90 index 6947aac992..20c9358a28 100644 --- a/biogeochem/DamageMainMod.F90 +++ b/biogeochem/DamageMainMod.F90 @@ -73,7 +73,7 @@ subroutine get_damage_frac(cc_cd, nc_cd, pft, dist_frac) ! Consults a look up table of transitions from param derived. ! USES - use FatesInterfaceTypesMod, only : ncrowndamage + use FatesInterfaceTypesMod, only : nlevdamage use FatesConstantsMod, only : years_per_day use FatesParameterDerivedMod, only : param_derived @@ -101,7 +101,7 @@ subroutine get_crown_reduction(crowndamage, crown_reduction) ! before multiplying by 0.2 ! Therefore, first damage class is 20% loss of crown, second 40% etc. !------------------------------------------------------------------- - use FatesInterfaceTypesMod , only : ncrowndamage + use FatesInterfaceTypesMod , only : nlevdamage integer(i4), intent(in) :: crowndamage real(r8), intent(out) :: crown_reduction @@ -109,7 +109,7 @@ subroutine get_crown_reduction(crowndamage, crown_reduction) ! local variables real(r8) :: class_width - class_width = 1.0_r8/ncrowndamage + class_width = 1.0_r8/nlevdamage crown_reduction = min(1.0_r8, (real(crowndamage) - 1.0_r8) * class_width) return @@ -121,7 +121,7 @@ end subroutine get_crown_reduction subroutine get_damage_mortality(crowndamage,pft, dgmort) - use FatesInterfaceTypesMod , only : ncrowndamage + use FatesInterfaceTypesMod , only : nlevdamage use EDPftvarcon , only : EDPftvarcon_inst integer(i4), intent(in) :: crowndamage @@ -134,7 +134,7 @@ subroutine get_damage_mortality(crowndamage,pft, dgmort) real(r8) :: class_width real(r8) :: crown_loss - class_width = 1.0_r8/real(ncrowndamage) + class_width = 1.0_r8/real(nlevdamage) ! parameter to determine slope of exponential damage_mort_p1 = EDPftvarcon_inst%damage_mort_p1(pft) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 16ba988385..92a69389e0 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -474,7 +474,7 @@ subroutine spawn_patches( currentSite, bc_in) use ChecksBalancesMod , only : SiteMassStock use FatesInterfaceTypesMod, only : hlm_use_canopy_damage use FatesInterfaceTypesMod, only : hlm_use_understory_damage - use FatesInterfaceTypesMod, only : ncrowndamage + use FatesInterfaceTypesMod, only : nlevdamage use FatesParameterDerivedMod, only : param_derived ! @@ -1264,7 +1264,7 @@ subroutine spawn_patches( currentSite, bc_in) cd_n_total = 0.0_r8 ! for each damage class find the number density and if big enough allocate a new cohort - do cd = currentCohort%crowndamage+1, ncrowndamage + do cd = currentCohort%crowndamage+1, nlevdamage call get_damage_frac(currentCohort%crowndamage, cd, currentCohort%pft, cd_frac) @@ -2377,7 +2377,7 @@ subroutine damage_litter_fluxes(currentSite, currentPatch, newPatch,patch_site_a use DamageMainMod, only : get_crown_reduction use DamageMainMod , only : get_damage_frac use SFParamsMod , only : SF_val_cwd_frac - use FatesInterfaceTypesMod , only : ncrowndamage + use FatesInterfaceTypesMod , only : nlevdamage use EDParamsMod , only : ED_val_understorey_death use FatesInterfaceTypesMod, only : hlm_use_canopy_damage use FatesInterfaceTypesMod, only : hlm_use_understory_damage @@ -2511,7 +2511,7 @@ subroutine damage_litter_fluxes(currentSite, currentPatch, newPatch,patch_site_a - do cd = currentCohort%crowndamage+1, ncrowndamage + do cd = currentCohort%crowndamage+1, nlevdamage call get_damage_frac(currentCohort%crowndamage, cd, currentCohort%pft, cd_frac) diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index e4590caca1..b49c757e3c 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -50,7 +50,7 @@ module EDInitMod use FatesInterfaceTypesMod , only : nleafage use FatesInterfaceTypesMod , only : nlevsclass use FatesInterfaceTypesMod , only : nlevcoage - use FatesInterfaceTypesMod , only : ncrowndamage + use FatesInterfaceTypesMod , only : nlevdamage use FatesInterfaceTypesMod , only : hlm_use_nocomp use FatesInterfaceTypesMod , only : nlevage @@ -132,16 +132,16 @@ subroutine init_site_vars( site_in, bc_in, bc_out ) allocate(site_in%flux_diags(1:num_elements)) if (hlm_use_canopy_damage .eq. itrue .or. hlm_use_understory_damage .eq. itrue) then - allocate(site_in%term_nindivs_canopy_damage(1:ncrowndamage, 1:nlevsclass, 1:numpft)) - allocate(site_in%term_nindivs_ustory_damage(1:ncrowndamage, 1:nlevsclass, 1:numpft)) - allocate(site_in%imort_rate_damage(1:ncrowndamage, 1:nlevsclass, 1:numpft)) - allocate(site_in%imort_cflux_damage(1:ncrowndamage, 1:nlevsclass)) - allocate(site_in%term_cflux_canopy_damage(1:ncrowndamage, 1:nlevsclass)) - allocate(site_in%term_cflux_ustory_damage(1:ncrowndamage, 1:nlevsclass)) - allocate(site_in%fmort_rate_canopy_damage(1:ncrowndamage, 1:nlevsclass, 1:numpft)) - allocate(site_in%fmort_rate_ustory_damage(1:ncrowndamage, 1:nlevsclass, 1:numpft)) - allocate(site_in%fmort_cflux_canopy_damage(1:ncrowndamage, 1:nlevsclass)) - allocate(site_in%fmort_cflux_ustory_damage(1:ncrowndamage, 1:nlevsclass)) + allocate(site_in%term_nindivs_canopy_damage(1:nlevdamage, 1:nlevsclass, 1:numpft)) + allocate(site_in%term_nindivs_ustory_damage(1:nlevdamage, 1:nlevsclass, 1:numpft)) + allocate(site_in%imort_rate_damage(1:nlevdamage, 1:nlevsclass, 1:numpft)) + allocate(site_in%imort_cflux_damage(1:nlevdamage, 1:nlevsclass)) + allocate(site_in%term_cflux_canopy_damage(1:nlevdamage, 1:nlevsclass)) + allocate(site_in%term_cflux_ustory_damage(1:nlevdamage, 1:nlevsclass)) + allocate(site_in%fmort_rate_canopy_damage(1:nlevdamage, 1:nlevsclass, 1:numpft)) + allocate(site_in%fmort_rate_ustory_damage(1:nlevdamage, 1:nlevsclass, 1:numpft)) + allocate(site_in%fmort_cflux_canopy_damage(1:nlevdamage, 1:nlevsclass)) + allocate(site_in%fmort_cflux_ustory_damage(1:nlevdamage, 1:nlevsclass)) else allocate(site_in%term_nindivs_canopy_damage(1,1,1)) allocate(site_in%term_nindivs_ustory_damage(1,1,1)) diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index b9f5cde62d..ce5a2dda76 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -312,7 +312,7 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) ! FIX(SPM,032414) refactor so everything goes through interface ! ! !USES: - use FatesInterfaceTypesMod, only : ncrowndamage + use FatesInterfaceTypesMod, only : nlevdamage use FatesAllometryMod , only : bleaf use FatesAllometryMod , only : carea_allom use PRTGenericMod , only : leaf_organ diff --git a/main/EDParamsMod.F90 b/main/EDParamsMod.F90 index 612a844364..f474a20cab 100644 --- a/main/EDParamsMod.F90 +++ b/main/EDParamsMod.F90 @@ -44,7 +44,6 @@ module EDParamsMod real(r8),protected, public :: ED_val_init_litter real(r8),protected, public :: ED_val_nignitions real(r8),protected, public :: ED_val_understorey_death - real(r8),protected, public :: ED_val_ncrowndamage real(r8),protected, public :: ED_val_cwd_fcel real(r8),protected, public :: ED_val_cwd_flig real(r8),protected, public :: ED_val_base_mr_20 @@ -88,7 +87,8 @@ module EDParamsMod real(r8),protected,allocatable,public :: ED_val_history_ageclass_bin_edges(:) real(r8),protected,allocatable,public :: ED_val_history_height_bin_edges(:) real(r8),protected,allocatable,public :: ED_val_history_coageclass_bin_edges(:) - + real(r8),protected,allocatable,public :: ED_val_history_damage_bin_edges(:) + ! Switch that defines the current pressure-volume and pressure-conductivity model ! to be used at each node (compartment/organ) ! 1 = Christofferson et al. 2016 (TFS), 2 = Van Genuchten 1980 @@ -115,7 +115,6 @@ module EDParamsMod character(len=param_string_length),parameter,public :: ED_name_init_litter = "fates_init_litter" character(len=param_string_length),parameter,public :: ED_name_nignitions = "fates_fire_nignitions" character(len=param_string_length),parameter,public :: ED_name_understorey_death = "fates_mort_understorey_death" - character(len=param_string_length),parameter,public :: ED_name_ncrowndamage = 'fates_ncrowndamage' character(len=param_string_length),parameter,public :: ED_name_cwd_fcel= "fates_cwd_fcel" character(len=param_string_length),parameter,public :: ED_name_cwd_flig= "fates_cwd_flig" character(len=param_string_length),parameter,public :: ED_name_base_mr_20= "fates_base_mr_20" @@ -146,7 +145,7 @@ module EDParamsMod character(len=param_string_length),parameter,public :: ED_name_history_height_bin_edges= "fates_history_height_bin_edges" character(len=param_string_length),parameter,public :: ED_name_history_coageclass_bin_edges = "fates_history_coageclass_bin_edges" - + character(len=param_string_length),parameter,public :: ED_name_history_damage_bin_edges = "fates_history_damage_bin_edges" ! Hydraulics Control Parameters (ONLY RELEVANT WHEN USE_FATES_HYDR = TRUE) ! ---------------------------------------------------------------------------------------------- @@ -238,7 +237,6 @@ subroutine FatesParamsInit() ED_val_init_litter = nan ED_val_nignitions = nan ED_val_understorey_death = nan - ED_val_ncrowndamage = nan ED_val_cwd_fcel = nan ED_val_cwd_flig = nan ED_val_base_mr_20 = nan @@ -286,7 +284,7 @@ subroutine FatesRegisterParams(fates_params) use FatesParametersInterface, only : fates_parameters_type, dimension_name_scalar, dimension_shape_1d use FatesParametersInterface, only : dimension_name_history_size_bins, dimension_name_history_age_bins use FatesParametersInterface, only : dimension_name_history_height_bins, dimension_name_hydr_organs - use FatesParametersInterface, only : dimension_name_history_coage_bins + use FatesParametersInterface, only : dimension_name_history_coage_bins, dimension_name_history_damage_bins use FatesParametersInterface, only : dimension_shape_scalar implicit none @@ -298,6 +296,7 @@ subroutine FatesRegisterParams(fates_params) character(len=param_string_length), parameter :: dim_names_ageclass(1) = (/dimension_name_history_age_bins/) character(len=param_string_length), parameter :: dim_names_height(1) = (/dimension_name_history_height_bins/) character(len=param_string_length), parameter :: dim_names_coageclass(1) = (/dimension_name_history_coage_bins/) + character(len=param_string_length), parameter :: dim_names_damageclass(1)= (/dimension_name_history_damage_bins/) character(len=param_string_length), parameter :: dim_names_hydro_organs(1) = (/dimension_name_hydr_organs/) call FatesParamsInit() @@ -337,10 +336,7 @@ subroutine FatesRegisterParams(fates_params) call fates_params%RegisterParameter(name=ED_name_understorey_death, dimension_shape=dimension_shape_scalar, & dimension_names=dim_names_scalar) - - call fates_params%RegisterParameter(name=ED_name_ncrowndamage, dimension_shape=dimension_shape_scalar, & - dimension_names=dim_names_scalar) - + call fates_params%RegisterParameter(name=ED_name_cwd_fcel, dimension_shape=dimension_shape_scalar, & dimension_names=dim_names_scalar) @@ -469,6 +465,9 @@ subroutine FatesRegisterParams(fates_params) call fates_params%RegisterParameter(name=ED_name_history_coageclass_bin_edges, dimension_shape=dimension_shape_1d, & dimension_names=dim_names_coageclass) + call fates_params%RegisterParameter(name=ED_name_history_damage_bin_edges, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names_damageclass) + end subroutine FatesRegisterParams @@ -517,9 +516,6 @@ subroutine FatesReceiveParams(fates_params) call fates_params%RetreiveParameter(name=ED_name_understorey_death, & data=ED_val_understorey_death) - call fates_params%RetreiveParameter(name=ED_name_ncrowndamage, & - data=ED_val_ncrowndamage) - call fates_params%RetreiveParameter(name=ED_name_cwd_fcel, & data=ED_val_cwd_fcel) @@ -652,6 +648,9 @@ subroutine FatesReceiveParams(fates_params) call fates_params%RetreiveParameterAllocate(name=ED_name_history_coageclass_bin_edges, & data=ED_val_history_coageclass_bin_edges) + call fates_params%RetreiveParameterAllocate(name=ED_name_history_damage_bin_edges, & + data=ED_val_history_damage_bin_edges) + call fates_params%RetreiveParameterAllocate(name=ED_name_hydr_htftype_node, & data=hydr_htftype_real) allocate(hydr_htftype_node(size(hydr_htftype_real))) @@ -684,7 +683,6 @@ subroutine FatesReportParams(is_master) write(fates_log(),fmt0) 'ED_val_init_litter = ',ED_val_init_litter write(fates_log(),fmt0) 'ED_val_nignitions = ',ED_val_nignitions write(fates_log(),fmt0) 'ED_val_understorey_death = ',ED_val_understorey_death - write(fates_log(),fmt0) 'ED_val_ncrowndamage = ', ED_val_ncrowndamage write(fates_log(),fmt0) 'ED_val_cwd_fcel = ',ED_val_cwd_fcel write(fates_log(),fmt0) 'ED_val_cwd_flig = ',ED_val_cwd_flig write(fates_log(),fmt0) 'ED_val_base_mr_20 = ', ED_val_base_mr_20 diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index cc139454c8..2a29f2d9d0 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -50,7 +50,7 @@ Module FatesHistoryInterfaceMod use FatesInterfaceTypesMod , only : bc_in_type use FatesInterfaceTypesMod , only : hlm_model_day use FatesInterfaceTypesMod , only : nlevcoage - use FatesInterfaceTypesMod , only : ncrowndamage + use FatesInterfaceTypesMod , only : nlevdamage use FatesInterfaceTypesMod , only : hlm_use_nocomp use FatesAllometryMod , only : CrownDepth @@ -1808,7 +1808,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) use FatesSizeAgeTypeIndicesMod, only : coagetype_class_index use EDTypesMod , only : nlevleaf use EDParamsMod, only : ED_val_history_height_bin_edges - use FatesInterfaceTypesMod, only : ncrowndamage + use FatesInterfaceTypesMod, only : nlevdamage use DamageMainMod , only : damage_time ! Arguments @@ -3272,12 +3272,12 @@ subroutine update_history_dyn(this,nc,nsites,sites) hlm_use_understory_damage .eq. itrue ) then do i_pft = 1, numpft - do icdam = 1, ncrowndamage + do icdam = 1, nlevdamage do i_scls = 1,nlevsclass icdsc = (icdam-1)*nlevsclass + i_scls icdpf = (icdam-1)*nlevsclass + i_scls + & - (i_pft-1) * nlevsclass * ncrowndamage + (i_pft-1) * nlevsclass * nlevdamage this%hvars(ih_mortality_si_cdpf)%r82d(io_si, icdpf) = & this%hvars(ih_mortality_si_cdpf)%r82d(io_si, icdpf) + & diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 4a060acd3a..b929af26c3 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -50,7 +50,7 @@ module FatesInterfaceMod use EDParamsMod , only : ED_val_history_ageclass_bin_edges use EDParamsMod , only : ED_val_history_height_bin_edges use EDParamsMod , only : ED_val_history_coageclass_bin_edges - use EDParamsMod , only : ED_val_ncrowndamage + use EDParamsMod , only : ED_val_history_damage_bin_edges use CLMFatesParamInterfaceMod , only : FatesReadParameters use EDTypesMod , only : p_uptake_mode use EDTypesMod , only : n_uptake_mode @@ -730,9 +730,7 @@ subroutine SetFatesGlobalElements(use_fates) ! ! -------------------------------------------------------------------------------- - use EDParamsMod, only : ED_val_ncrowndamage - - + implicit none @@ -776,10 +774,7 @@ subroutine SetFatesGlobalElements(use_fates) nleafage = size(prt_params%leaf_long,dim=2) end if - ! Identify the number of damage classes - ncrowndamage = ED_val_ncrowndamage - - + ! These values are used to define the restart file allocations and general structure ! of memory for the cohort arrays @@ -840,7 +835,7 @@ subroutine SetFatesGlobalElements(use_fates) nlevage = size(ED_val_history_ageclass_bin_edges,dim=1) nlevheight = size(ED_val_history_height_bin_edges,dim=1) nlevcoage = size(ED_val_history_coageclass_bin_edges,dim=1) - + nlevdamage = size(ED_val_history_damage_bin_edges, dim=1) ! do some checks on the size, age, and height bin arrays to make sure they make sense: ! make sure that all start at zero, and that both are monotonically increasing @@ -991,13 +986,13 @@ subroutine fates_history_maps use EDTypesMod, only : NFSC use EDTypesMod, only : nclmax - use FatesInterfaceTypesMod, only : ncrowndamage use EDTypesMod, only : nlevleaf use EDParamsMod, only : ED_val_history_sizeclass_bin_edges use EDParamsMod, only : ED_val_history_ageclass_bin_edges use EDParamsMod, only : ED_val_history_height_bin_edges use EDParamsMod, only : ED_val_history_coageclass_bin_edges - + use EDParamsMod, only : ED_val_history_damage_bin_edges + ! ------------------------------------------------------------------------------------------ ! This subroutine allocates and populates the variables ! that define the mapping of variables in history files in multiplexed dimensions like @@ -1031,12 +1026,12 @@ subroutine fates_history_maps allocate( fates_hdim_pfmap_levcapf(1:nlevcoage*numpft)) allocate( fates_hdim_camap_levcapf(1:nlevcoage*numpft)) - allocate( fates_hdim_levcdam(1:ncrowndamage )) - allocate( fates_hdim_scmap_levcdsc(nlevsclass*ncrowndamage)) - allocate( fates_hdim_cdmap_levcdsc(nlevsclass*ncrowndamage)) - allocate( fates_hdim_scmap_levcdpf(nlevsclass*ncrowndamage * numpft)) - allocate( fates_hdim_cdmap_levcdpf(nlevsclass*ncrowndamage * numpft)) - allocate( fates_hdim_pftmap_levcdpf(nlevsclass*ncrowndamage * numpft)) + allocate( fates_hdim_levcdam(1:nlevdamage )) + allocate( fates_hdim_scmap_levcdsc(nlevsclass*nlevdamage)) + allocate( fates_hdim_cdmap_levcdsc(nlevsclass*nlevdamage)) + allocate( fates_hdim_scmap_levcdpf(nlevsclass*nlevdamage * numpft)) + allocate( fates_hdim_cdmap_levcdpf(nlevsclass*nlevdamage * numpft)) + allocate( fates_hdim_pftmap_levcdpf(nlevsclass*nlevdamage * numpft)) allocate( fates_hdim_levcan(nclmax)) allocate( fates_hdim_levelem(num_elements)) @@ -1164,7 +1159,7 @@ subroutine fates_history_maps end do i=0 - do icdam=1,ncrowndamage + do icdam=1,nlevdamage do isc=1,nlevsclass i=i+1 fates_hdim_scmap_levcdsc(i) = isc @@ -1199,7 +1194,7 @@ subroutine fates_history_maps i=0 do ipft=1,numpft - do icdam=1,ncrowndamage + do icdam=1,nlevdamage do isc=1,nlevsclass i=i+1 fates_hdim_scmap_levcdpf(i) = isc diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index a9bb7efba5..b6826d2ce5 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -312,7 +312,7 @@ module FatesInterfaceTypesMod integer, public :: nlevheight ! The total number of height bins output to history integer, public :: nlevcoage ! The total number of cohort age bins output to history integer, public :: nleafage ! The total number of leaf age classes - integer, public :: ncrowndamage ! The total number of damage classes + integer, public :: nlevdamage ! The total number of damage classes ! ------------------------------------------------------------------------------------- ! Structured Boundary Conditions (SITE/PATCH SCALE) diff --git a/main/FatesParameterDerivedMod.F90 b/main/FatesParameterDerivedMod.F90 index f63df66318..0214224ee3 100644 --- a/main/FatesParameterDerivedMod.F90 +++ b/main/FatesParameterDerivedMod.F90 @@ -13,7 +13,7 @@ module FatesParameterDerivedMod use FatesConstantsMod, only : umolC_to_kgC use FatesConstantsMod, only : g_per_kg use FatesInterfaceTypesMod, only : nleafage - use FatesInterfaceTypesMod, only : ncrowndamage + use FatesInterfaceTypesMod, only : nlevdamage use FatesGlobals , only : fates_log implicit none @@ -66,13 +66,13 @@ end subroutine InitAllocate ! ===================================================================================== ! =================================================================================== - subroutine InitAllocateDamageTransitions(this,ncrowndamage, numpft) + subroutine InitAllocateDamageTransitions(this,nlevdamage, numpft) class(param_derived_type), intent(inout) :: this - integer, intent(in) :: ncrowndamage + integer, intent(in) :: nlevdamage integer, intent(in) :: numpft - allocate(this%damage_transitions(ncrowndamage,ncrowndamage, numpft)) + allocate(this%damage_transitions(nlevdamage,nlevdamage, numpft)) return end subroutine InitAllocateDamageTransitions @@ -129,13 +129,13 @@ end subroutine Init !========================================================================= - subroutine InitDamageTransitions(this, ncrowndamage, numpft) + subroutine InitDamageTransitions(this, nlevdamage, numpft) use EDPftvarcon, only: EDPftvarcon_inst class(param_derived_type), intent(inout) :: this - integer, intent(in) :: ncrowndamage + integer, intent(in) :: nlevdamage integer, intent(in) :: numpft ! local variables @@ -144,22 +144,22 @@ subroutine InitDamageTransitions(this, ncrowndamage, numpft) real(r8) :: damage_frac ! damage fraction - call this%InitAllocateDamageTransitions(ncrowndamage, numpft) + call this%InitAllocateDamageTransitions(nlevdamage, numpft) do ft = 1, numpft damage_frac = EDPftvarcon_inst%damage_frac(ft) - do i = 1, ncrowndamage + do i = 1, nlevdamage ! zero the column this%damage_transitions(i,:,ft) = 0._r8 ! 1 - damage rate stay the same this%damage_transitions(i,i,ft) = 1.0_r8 - damage_frac - if(i < ncrowndamage) then + if(i < nlevdamage) then ! fraction damaged get evenly split between higher damage classes - this%damage_transitions(i,i+1:ncrowndamage,ft) = damage_frac/(ncrowndamage - i) + this%damage_transitions(i,i+1:nlevdamage,ft) = damage_frac/(nlevdamage - i) end if ! Make sure it sums to one - they have to go somewhere this%damage_transitions(i, :, ft) = this%damage_transitions(i, :, ft)/SUM(this%damage_transitions(i, :, ft)) diff --git a/main/FatesParametersInterface.F90 b/main/FatesParametersInterface.F90 index f37b63b93c..f2bfabc125 100644 --- a/main/FatesParametersInterface.F90 +++ b/main/FatesParametersInterface.F90 @@ -36,6 +36,7 @@ module FatesParametersInterface character(len=*), parameter, public :: dimension_name_history_age_bins = 'fates_history_age_bins' character(len=*), parameter, public :: dimension_name_history_height_bins = 'fates_history_height_bins' character(len=*), parameter, public :: dimension_name_history_coage_bins = 'fates_history_coage_bins' + character(len=*), parameter, public :: dimension_name_history_damage_bins = 'fates_history_damage_bins' character(len=*), parameter, public :: dimension_name_hlm_pftno = 'fates_hlm_pftno' ! Dimensions in the host namespace: diff --git a/main/FatesRestartInterfaceMod.F90 b/main/FatesRestartInterfaceMod.F90 index 4512448504..41bc8e58f0 100644 --- a/main/FatesRestartInterfaceMod.F90 +++ b/main/FatesRestartInterfaceMod.F90 @@ -33,7 +33,7 @@ module FatesRestartInterfaceMod use EDCohortDynamicsMod, only : InitPRTBoundaryConditions use FatesPlantHydraulicsMod, only : InitHydrCohort use FatesInterfaceTypesMod, only : nlevsclass - use FatesInterfaceTypesMod, only : ncrowndamage + use FatesInterfaceTypesMod, only : nlevdamage use FatesLitterMod, only : litter_type use FatesLitterMod, only : ncwd use FatesLitterMod, only : ndcmpy @@ -1797,7 +1797,7 @@ subroutine set_restart_vectors(this,nc,nsites,sites) use EDTypesMod, only : nclmax use EDTypesMod, only : numWaterMem use EDTypesMod, only : num_vegtemp_mem - use FatesInterfaceTypesMod, only : ncrowndamage + use FatesInterfaceTypesMod, only : nlevdamage ! Arguments class(fates_restart_interface_type) :: this @@ -2372,7 +2372,7 @@ subroutine set_restart_vectors(this,nc,nsites,sites) if(hlm_use_canopy_damage .eq. itrue .or. hlm_use_understory_damage .eq. itrue) then do i_scls = 1, nlevsclass - do i_cdam = 1, ncrowndamage + do i_cdam = 1, nlevdamage do i_pft = 1, numpft rio_imortrate_sicdpf(io_idx_si_cdpf) = sites(s)%imort_rate_damage(i_cdam, i_scls, i_pft) rio_termnindiv_cano_sicdpf(io_idx_si_cdpf) = sites(s)%term_nindivs_canopy_damage(i_cdam,i_scls,i_pft) @@ -3297,7 +3297,7 @@ subroutine get_restart_vectors(this, nc, nsites, sites) end do if (hlm_use_canopy_damage .eq. itrue .or. hlm_use_understory_damage .eq. itrue) then - do i_cdam = 1, ncrowndamage + do i_cdam = 1, nlevdamage do i_pft = 1, numpft do i_scls = 1, nlevsclass sites(s)%imort_rate_damage(i_cdam, i_scls, i_pft) = rio_imortrate_sicdpf(io_idx_si_cdpf) diff --git a/main/FatesSizeAgeTypeIndicesMod.F90 b/main/FatesSizeAgeTypeIndicesMod.F90 index 91dbc5455c..66e3edab28 100644 --- a/main/FatesSizeAgeTypeIndicesMod.F90 +++ b/main/FatesSizeAgeTypeIndicesMod.F90 @@ -6,11 +6,13 @@ module FatesSizeAgeTypeIndicesMod use FatesInterfaceTypesMod, only : nlevage use FatesInterfaceTypesMod, only : nlevheight use FatesInterfaceTypesMod, only : nlevcoage - use FatesInterfaceTypesMod, only : ncrowndamage + use FatesInterfaceTypesMod, only : nlevdamage use EDParamsMod, only : ED_val_history_sizeclass_bin_edges use EDParamsMod, only : ED_val_history_ageclass_bin_edges use EDParamsMod, only : ED_val_history_height_bin_edges use EDParamsMod, only : ED_val_history_coageclass_bin_edges + use EDParamsMod, only : ED_val_history_damage_bin_edges + implicit none private ! Modules are private by default @@ -191,7 +193,7 @@ function get_cdamagesizepft_class_index(dbh,cdamage,pft) result(cdamage_by_size_ size_class = get_size_class_index(dbh) cdamage_by_size_by_pft_class = (cdamage-1)*nlevsclass + size_class + & - (pft-1) * nlevsclass * ncrowndamage + (pft-1) * nlevsclass * nlevdamage end function get_cdamagesizepft_class_index diff --git a/parameter_files/fates_params_default.cdl b/parameter_files/fates_params_default.cdl index 83ecec6ad7..4df45c465d 100644 --- a/parameter_files/fates_params_default.cdl +++ b/parameter_files/fates_params_default.cdl @@ -5,7 +5,8 @@ dimensions: fates_history_height_bins = 6 ; fates_history_size_bins = 13 ; fates_history_coage_bins = 2 ; - fates_hydr_organs = 4 ; + fates_history_damage_bins = 6 ; + fates_hydr_organs = 4 ; fates_leafage_class = 1 ; fates_litterclass = 6 ; fates_pft = 12 ; @@ -25,6 +26,9 @@ variables: double fates_history_sizeclass_bin_edges(fates_history_size_bins) ; fates_history_sizeclass_bin_edges:units = "cm" ; fates_history_sizeclass_bin_edges:long_name = "Lower edges for DBH size class bins used in size-resolved cohort history output" ; + double fates_history_damage_bin_edges(fates_history_damage_bins) ; + fates_history_damage_bin_edges:units = "% crown loss" ; + fates_history_damage_bin_edges:long_name = "Lower edges for damage class bins used in cohort history output" ; double fates_hydr_htftype_node(fates_hydr_organs) ; fates_hydr_htftype_node:units = "unitless" ; fates_hydr_htftype_node:long_name = "Switch that defines the hydraulic transfer functions for each organ." ; @@ -165,9 +169,6 @@ variables: double fates_damage_recovery_scalar(fates_pft) ; fates_damage_recovery_scalar:units = "unitless"; fates_damage_recovery_scalar:long_name = "fraction of cohort that recovers from damage"; - double fates_ncrowndamage ; - fates_ncrowndamage: units = "unitless" ; - fates_ncrowndamage: long_name = "number of crown damage classes" ; double fates_c2b(fates_pft) ; fates_c2b:units = "ratio" ; fates_c2b:long_name = "Carbon to biomass multiplier of bulk structural tissues" ; @@ -779,6 +780,8 @@ data: fates_history_coageclass_bin_edges = 0, 5 ; + fates_history_damage_bin_edges = 0, 20, 40, 60, 80 100 ; + fates_history_height_bin_edges = 0, 0.1, 0.3, 1, 3, 10 ; fates_history_sizeclass_bin_edges = 0, 5, 10, 15, 20, 30, 40, 50, 60, 70, @@ -922,8 +925,6 @@ data: fates_damage_recovery_scalar = 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 ; - fates_ncrowndamage = 5 ; - fates_c2b = 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2 ; fates_dev_arbitrary_pft = _, _, _, _, _, _, _, _, _, _, _, _ ; From 78b4f1a69a7af058dce558159c98f399cdc59210 Mon Sep 17 00:00:00 2001 From: Jessica Needham Date: Wed, 23 Mar 2022 12:38:54 -0700 Subject: [PATCH 29/84] [ Fixing flexible damage bins ] [ Ensure damage bin edges are properly output in fates history ] Fixes: [NGT-ED Github issue #] User interface changes?: [Yes (describe what changes), No] Code review: [Names] Test suite: [suite name, machine, compilers] Test baseline: Test namelist changes: Test answer changes: [bit for bit, roundoff, climate changing] Test summary: no testing --- main/FatesHistoryInterfaceMod.F90 | 47 ++++++++++++++++++++++++++----- main/FatesInterfaceMod.F90 | 4 ++- main/FatesInterfaceTypesMod.F90 | 2 +- 3 files changed, 44 insertions(+), 9 deletions(-) diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 2a29f2d9d0..0ce2ee34c9 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -697,7 +697,7 @@ Module FatesHistoryInterfaceMod integer, private :: levscls_index_, levpft_index_, levage_index_ integer, private :: levfuel_index_, levcwdsc_index_, levscag_index_ integer, private :: levcan_index_, levcnlf_index_, levcnlfpft_index_ - integer, private :: levcdpf_index_, levcdsc_index_ + integer, private :: levcdpf_index_, levcdsc_index_, levcdam_index_ integer, private :: levscagpft_index_, levagepft_index_ integer, private :: levheight_index_, levagefuel_index_ integer, private :: levelem_index_, levelpft_index_ @@ -734,6 +734,7 @@ Module FatesHistoryInterfaceMod procedure :: levcnlfpft_index procedure :: levcdpf_index procedure :: levcdsc_index + procedure :: levcdam_index procedure :: levscag_index procedure :: levscagpft_index procedure :: levagepft_index @@ -764,6 +765,7 @@ Module FatesHistoryInterfaceMod procedure, private :: set_levcnlfpft_index procedure, private :: set_levcdpf_index procedure, private :: set_levcdsc_index + procedure, private :: set_levcdam_index procedure, private :: set_levscag_index procedure, private :: set_levscagpft_index procedure, private :: set_levagepft_index @@ -801,7 +803,7 @@ subroutine Init(this, num_threads, fates_bounds) use FatesIODimensionsMod, only : levfuel, levcwdsc, levscag use FatesIODimensionsMod, only : levscagpft, levagepft use FatesIODimensionsMod, only : levcan, levcnlf, levcnlfpft - use FatesIODimensionsMod, only : levcdpf, levcdsc + use FatesIODimensionsMod, only : levcdpf, levcdsc, levcdam use FatesIODimensionsMod, only : fates_bounds_type use FatesIODimensionsMod, only : levheight, levagefuel use FatesIODimensionsMod, only : levelem, levelpft @@ -890,6 +892,11 @@ subroutine Init(this, num_threads, fates_bounds) call this%dim_bounds(dim_count)%Init(levcdsc, num_threads, & fates_bounds%cdsc_begin, fates_bounds%cdsc_end) + dim_count = dim_count + 1 + call this%set_levcdam_index(dim_count) + call this%dim_bounds(dim_count)%Init(levcdam, num_threads, & + fates_bounds%cdam_begin, fates_bounds%cdam_end) + dim_count = dim_count + 1 call this%set_levscag_index(dim_count) call this%dim_bounds(dim_count)%Init(levscag, num_threads, & @@ -1011,6 +1018,10 @@ subroutine SetThreadBoundsEach(this, thread_index, thread_bounds) call this%dim_bounds(index)%SetThreadBounds(thread_index, & thread_bounds%cdsc_begin, thread_bounds%cdsc_end) + index = this%levcdam_index() + call this%dim_bounds(index)%SetThreadBounds(thread_index, & + thread_bounds%cdam_begin, thread_bounds%cdam_end) + index = this%levscag_index() call this%dim_bounds(index)%SetThreadBounds(thread_index, & thread_bounds%sizeage_class_begin, thread_bounds%sizeage_class_end) @@ -1062,7 +1073,7 @@ subroutine assemble_history_output_types(this) use FatesIOVariableKindMod, only : site_fuel_r8, site_cwdsc_r8, site_scag_r8 use FatesIOVariableKindMod, only : site_scagpft_r8, site_agepft_r8 use FatesIOVariableKindMod, only : site_can_r8, site_cnlf_r8, site_cnlfpft_r8 - use FatesIOVariableKindMod, only : site_cdpf_r8, site_cdsc_r8 + use FatesIOVariableKindMod, only : site_cdpf_r8, site_cdsc_r8, site_cdam_r8 use FatesIOVariableKindMod, only : site_height_r8, site_agefuel_r8 use FatesIOVariableKindMod, only : site_elem_r8, site_elpft_r8 use FatesIOVariableKindMod, only : site_elcwd_r8, site_elage_r8 @@ -1116,7 +1127,10 @@ subroutine assemble_history_output_types(this) call this%set_dim_indices(site_cdsc_r8, 1, this%column_index()) call this%set_dim_indices(site_cdsc_r8, 2, this%levcdsc_index()) - + + call this%set_dim_indices(site_cdam_r8, 1, this%column_index()) + call this%set_dim_indices(site_cdam_r8, 2, this%levcdam_index()) + call this%set_dim_indices(site_scag_r8, 1, this%column_index()) call this%set_dim_indices(site_scag_r8, 2, this%levscag_index()) @@ -1398,6 +1412,20 @@ integer function levcdsc_index(this) levcdsc_index = this%levcdsc_index_ end function levcdsc_index + ! ======================================================================= + subroutine set_levcdam_index(this, index) + implicit none + class(fates_history_interface_type), intent(inout) :: this + integer, intent(in) :: index + this%levcdam_index_ = index + end subroutine set_levcdam_index + + integer function levcdam_index(this) + implicit none + class(fates_history_interface_type), intent(in) :: this + levcdam_index = this%levcdam_index_ + end function levcdam_index + ! ====================================================================================== subroutine set_levscag_index(this, index) implicit none @@ -1665,7 +1693,7 @@ subroutine init_dim_kinds_maps(this) use FatesIOVariableKindMod, only : site_fuel_r8, site_cwdsc_r8, site_scag_r8 use FatesIOVariableKindMod, only : site_scagpft_r8, site_agepft_r8 use FatesIOVariableKindMod, only : site_can_r8, site_cnlf_r8, site_cnlfpft_r8 - use FatesIOVariableKindMod, only : site_cdpf_r8, site_cdsc_r8 + use FatesIOVariableKindMod, only : site_cdpf_r8, site_cdsc_r8, site_cdam_r8 use FatesIOVariableKindMod, only : site_height_r8, site_agefuel_r8 use FatesIOVariableKindMod, only : site_elem_r8, site_elpft_r8 use FatesIOVariableKindMod, only : site_elcwd_r8, site_elage_r8 @@ -1738,6 +1766,10 @@ subroutine init_dim_kinds_maps(this) index = index + 1 call this%dim_kinds(index)%Init(site_cdsc_r8, 2) + ! site x crown damage + index = index + 1 + call this%dim_kinds(index)%Init(site_cdam_r8, 2) + ! site x size-class x age class index = index + 1 call this%dim_kinds(index)%Init(site_scag_r8, 2) @@ -4626,7 +4658,7 @@ subroutine define_history_vars(this, initialize_variables) use FatesIOVariableKindMod, only : site_fuel_r8, site_cwdsc_r8, site_scag_r8 use FatesIOVariableKindMod, only : site_can_r8, site_cnlf_r8, site_cnlfpft_r8 - use FatesIOVariableKindMod, only : site_cdsc_r8, site_cdpf_r8 + use FatesIOVariableKindMod, only : site_cdsc_r8, site_cdpf_r8, site_cdam_r8 use FatesIOVariableKindMod, only : site_scagpft_r8, site_agepft_r8 use FatesIOVariableKindMod, only : site_elem_r8, site_elpft_r8 use FatesIOVariableKindMod, only : site_elcwd_r8, site_elage_r8 @@ -4656,6 +4688,7 @@ subroutine define_history_vars(this, initialize_variables) ! plant functional type (site_pft_r8) : PF ! soil layer (site_soil_r8) : SL ! cohort size (site_size_r8) : SZ + ! cohort crown damage (site_cd_r8) : CD ! Multiple dimensions should have multiple two-code suffixes: ! cohort age x pft (site_cooage_r8) : ACPF @@ -4669,7 +4702,7 @@ subroutine define_history_vars(this, initialize_variables) ! cohort size x pft (site_size_pft_r8) : SZPF ! cohort size x crown damage (site_cdsc_r8) : SZCD ! cohort size x crown damage x pft (site_cdpf_r8) : CDPF - + ! Site level counting variables call this%set_history_var(vname='FATES_NPATCHES', units='', & diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index b929af26c3..1f103b1033 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -1026,7 +1026,7 @@ subroutine fates_history_maps allocate( fates_hdim_pfmap_levcapf(1:nlevcoage*numpft)) allocate( fates_hdim_camap_levcapf(1:nlevcoage*numpft)) - allocate( fates_hdim_levcdam(1:nlevdamage )) + allocate( fates_hdim_levdamage(1:nlevdamage )) allocate( fates_hdim_scmap_levcdsc(nlevsclass*nlevdamage)) allocate( fates_hdim_cdmap_levcdsc(nlevsclass*nlevdamage)) allocate( fates_hdim_scmap_levcdpf(nlevsclass*nlevdamage * numpft)) @@ -1064,8 +1064,10 @@ subroutine fates_history_maps fates_hdim_levage(:) = ED_val_history_ageclass_bin_edges(:) fates_hdim_levheight(:) = ED_val_history_height_bin_edges(:) fates_hdim_levcoage(:) = ED_val_history_coageclass_bin_edges(:) + fates_hdim_levdamage(:) = ED_val_history_damage_bin_edges(:) fates_hdim_levleaf(:) = dlower_vai(:) + ! make pft array do ipft=1,numpft fates_hdim_levpft(ipft) = ipft diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index b6826d2ce5..26d36f62fa 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -244,7 +244,7 @@ module FatesInterfaceTypesMod integer , public, allocatable :: fates_hdim_scmap_levcdpf(:) ! map of size into size x crowndamage x pft integer , public, allocatable :: fates_hdim_cdmap_levcdsc(:) ! map of crowndamage into size x crowndamage integer , public, allocatable :: fates_hdim_scmap_levcdsc(:) ! map of size into size x crowndamage - integer , public, allocatable :: fates_hdim_levcdam(:) ! plant damage class lower bound dimension + integer , public, allocatable :: fates_hdim_levdamage(:) ! plant damage class lower bound dimension real(r8), public, allocatable :: fates_hdim_levage(:) ! patch age lower bound dimension real(r8), public, allocatable :: fates_hdim_levheight(:) ! height lower bound dimension From d9ee7ab2ccbf4fe4cdae839d9ba5780b8e27e842 Mon Sep 17 00:00:00 2001 From: Jessica Needham Date: Sun, 3 Apr 2022 14:05:30 -0700 Subject: [PATCH 30/84] [Fix bug in defining nlevdamage ] Fixes: [NGT-ED Github issue #] User interface changes?: [Yes (describe what changes), No] Code review: [Names] Test suite: [suite name, machine, compilers] Test baseline: Test namelist changes: Test answer changes: [bit for bit, roundoff, climate changing] Test summary: no testing --- main/FatesInterfaceMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 1f103b1033..a76c036ca7 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -835,7 +835,7 @@ subroutine SetFatesGlobalElements(use_fates) nlevage = size(ED_val_history_ageclass_bin_edges,dim=1) nlevheight = size(ED_val_history_height_bin_edges,dim=1) nlevcoage = size(ED_val_history_coageclass_bin_edges,dim=1) - nlevdamage = size(ED_val_history_damage_bin_edges, dim=1) + nlevdamage = size(ED_val_history_damage_bin_edges, dim=1) - 1 ! do some checks on the size, age, and height bin arrays to make sure they make sense: ! make sure that all start at zero, and that both are monotonically increasing From f0352aa6e8eb6a8c5190b536aea94dd1bb918a98 Mon Sep 17 00:00:00 2001 From: Jessica Needham Date: Sun, 3 Apr 2022 15:15:01 -0700 Subject: [PATCH 31/84] [ fixing canopy_too_full error - possibly from bad merge ] [ looks like a merge with master messed up EDCanopyStrucutreMod ] Fixes: [NGT-ED Github issue #] User interface changes?: [Yes (describe what changes), No] Code review: [Names] Test suite: [suite name, machine, compilers] Test baseline: Test namelist changes: Test answer changes: [bit for bit, roundoff, climate changing] Test summary:no testing --- biogeochem/EDCanopyStructureMod.F90 | 75 ++++++++++++++--------------- 1 file changed, 35 insertions(+), 40 deletions(-) diff --git a/biogeochem/EDCanopyStructureMod.F90 b/biogeochem/EDCanopyStructureMod.F90 index ea7590a78b..42b5fa3e2e 100644 --- a/biogeochem/EDCanopyStructureMod.F90 +++ b/biogeochem/EDCanopyStructureMod.F90 @@ -380,7 +380,7 @@ subroutine DemoteFromLayer(currentSite,currentPatch,i_lyr,bc_in) currentCohort => currentPatch%shortest do while (associated(currentCohort)) call carea_allom(currentCohort%dbh,currentCohort%n, & - currentSite%spread,currentCohort%pft,& + currentSite%spread,currentCohort%pft, & currentCohort%crowndamage, currentCohort%c_area) if(debug) then @@ -728,8 +728,8 @@ subroutine DemoteFromLayer(currentSite,currentPatch,i_lyr,bc_in) deallocate(currentCohort) else call carea_allom(currentCohort%dbh,currentCohort%n, & - currentSite%spread,currentCohort%pft,& - currentCohort%crowndamage, currentCohort%c_area) + currentSite%spread,currentCohort%pft,currentCohort%crowndamage, & + currentCohort%c_area) end if endif !canopy layer = i_ly @@ -866,7 +866,7 @@ subroutine PromoteIntoLayer(currentSite,currentPatch,i_lyr) currentCohort => currentPatch%tallest do while (associated(currentCohort)) call carea_allom(currentCohort%dbh,currentCohort%n,currentSite%spread, & - currentCohort%pft,currentCohort%crowndamage, currentCohort%c_area) + currentCohort%pft,currentCohort%c_area) if(currentCohort%canopy_layer == i_lyr+1)then !look at the cohorts in the canopy layer below... if (ED_val_comp_excln .ge. 0.0_r8 ) then @@ -1161,7 +1161,7 @@ subroutine PromoteIntoLayer(currentSite,currentPatch,i_lyr) call carea_allom(currentCohort%dbh,currentCohort%n,currentSite%spread, & currentCohort%pft,currentCohort%crowndamage, currentCohort%c_area) call carea_allom(copyc%dbh,copyc%n,currentSite%spread,copyc%pft,& - copyc%crowndamage, copyc%c_area) + copyc%crowndamage,copyc%c_area) !----------- Insert copy into linked list ------------------------! copyc%shorter => currentCohort @@ -1238,9 +1238,8 @@ subroutine canopy_spread( currentSite ) currentCohort => currentPatch%tallest do while (associated(currentCohort)) call carea_allom(currentCohort%dbh,currentCohort%n, & - currentSite%spread,currentCohort%pft, & - currentCohort%crowndamage, currentCohort%c_area) - + currentSite%spread,currentCohort%pft,currentCohort%crowndamage, & + currentCohort%c_area) if( ( int(prt_params%woody(currentCohort%pft)) .eq. itrue ) .and. & (currentCohort%canopy_layer .eq. 1 ) ) then sitelevel_canopyarea = sitelevel_canopyarea + currentCohort%c_area @@ -1338,7 +1337,7 @@ subroutine canopy_summarization( nsites, sites, bc_in ) ! Update the cohort's index within the size bin classes ! Update the cohort's index within the SCPF classification system call sizetype_class_index(currentCohort%dbh,currentCohort%pft, & - currentCohort%size_class,currentCohort%size_by_pft_class) + currentCohort%size_class,currentCohort%size_by_pft_class) if (hlm_use_cohort_age_tracking .eq. itrue) then call coagetype_class_index(currentCohort%coage,currentCohort%pft, & @@ -1347,7 +1346,7 @@ subroutine canopy_summarization( nsites, sites, bc_in ) if(hlm_use_sp.eq.ifalse)then call carea_allom(currentCohort%dbh,currentCohort%n,sites(s)%spread,& - currentCohort%pft,currentCohort%crowndamage,currentCohort%c_area) + currentCohort%pft,currentCohort%crowndamage, currentCohort%c_area) endif if(currentCohort%canopy_layer==1)then @@ -1455,7 +1454,7 @@ subroutine leaf_area_profile( currentSite ) ! currentCohort%treesai ! SAI per unit crown area (m2/m2) ! currentCohort%lai ! LAI per unit canopy area (m2/m2) ! currentCohort%sai ! SAI per unit canopy area (m2/m2) - ! currentCohort%nv ! The number of discrete vegetation + ! currentCohort%NV ! The number of discrete vegetation ! ! layers needed to describe this crown ! ! The following patch level diagnostics are updated here: @@ -1508,9 +1507,8 @@ subroutine leaf_area_profile( currentSite ) real(r8) :: min_chite ! bottom of cohort canopy (m) real(r8) :: max_chite ! top of cohort canopy (m) real(r8) :: lai ! summed lai for checking m2 m-2 - real(r8) :: snow_depth_avg ! avg snow over whole site - real(r8) :: leaf_c ! leaf carbon [kgC] - real(r8) :: target_c_area ! crown area of undamaged cohort given dbh + real(r8) :: leaf_c ! leaf carbon [kg] + !---------------------------------------------------------------------- smooth_leaf_distribution = 0 @@ -1563,6 +1561,7 @@ subroutine leaf_area_profile( currentSite ) currentCohort%treelai = tree_lai(leaf_c, currentCohort%pft, currentCohort%c_area, & currentCohort%n, currentCohort%canopy_layer, & currentPatch%canopy_layer_tlai,currentCohort%vcmax25top ) + if (hlm_use_sp .eq. ifalse) then currentCohort%treesai = tree_sai(currentCohort%pft, currentCohort%dbh,& currentSite%spread, currentCohort%canopy_trim, & @@ -1935,7 +1934,6 @@ subroutine update_hlm_dynamics(nsites,sites,fcolumn,bc_out) bc_out(s)%dleaf_pa(:) = 0._r8 bc_out(s)%z0m_pa(:) = 0._r8 bc_out(s)%displa_pa(:) = 0._r8 - currentPatch => sites(s)%oldest_patch c = fcolumn(s) @@ -1992,8 +1990,8 @@ subroutine update_hlm_dynamics(nsites,sites,fcolumn,bc_out) currentCohort%pft, currentCohort%c_area, currentCohort%n, & currentCohort%canopy_layer, currentPatch%canopy_layer_tlai,currentCohort%vcmax25top ) - currentCohort%treesai = tree_sai(currentCohort%pft, currentCohort%dbh, sites(s)%spread, & - currentCohort%canopy_trim, & + currentCohort%treesai = tree_sai(currentCohort%pft, currentCohort%dbh, & + site(s)%spread, currentCohort%canopy_trim, & currentCohort%c_area, currentCohort%n, currentCohort%canopy_layer, & currentPatch%canopy_layer_tlai, currentCohort%treelai , & currentCohort%vcmax25top,4) @@ -2025,9 +2023,6 @@ subroutine update_hlm_dynamics(nsites,sites,fcolumn,bc_out) bc_out(s)%dleaf_pa(ifp) = EDPftvarcon_inst%dleaf(1) endif ! ----------------------------------------------------------------------------- - bc_out(s)%z0m_pa(ifp) = EDPftvarcon_inst%z0mr(1) * bc_out(s)%htop_pa(ifp) - bc_out(s)%displa_pa(ifp) = EDPftvarcon_inst%displar(1) * bc_out(s)%htop_pa(ifp) - bc_out(s)%dleaf_pa(ifp) = EDPftvarcon_inst%dleaf(1) ! We are assuming here that grass is all located underneath tree canopies. ! The alternative is to assume it is all spatial distinct from tree canopies. @@ -2075,9 +2070,9 @@ subroutine update_hlm_dynamics(nsites,sites,fcolumn,bc_out) end if else ! nocomp or SP, and currentPatch%nocomp_pft_label .eq. 0 - + total_patch_area = total_patch_area + currentPatch%area/AREA - + end if currentPatch => currentPatch%younger end do @@ -2110,26 +2105,26 @@ subroutine update_hlm_dynamics(nsites,sites,fcolumn,bc_out) endif - ! If running hydro, perform a final check to make sure that we - ! have conserved water. Since this is the very end of the dynamics - ! cycle. No water should had been added or lost to the site during dynamics. - ! With growth and death, we may have shuffled it around. - ! For recruitment, we initialized their water, but flagged them - ! to not be included in the site level balance yet, for they - ! will demand the water for their initialization on the first hydraulics time-step + ! If running hydro, perform a final check to make sure that we + ! have conserved water. Since this is the very end of the dynamics + ! cycle. No water should had been added or lost to the site during dynamics. + ! With growth and death, we may have shuffled it around. + ! For recruitment, we initialized their water, but flagged them + ! to not be included in the site level balance yet, for they + ! will demand the water for their initialization on the first hydraulics time-step - if (hlm_use_planthydro.eq.itrue) then - call UpdateH2OVeg(sites(s),bc_out(s),bc_out(s)%plant_stored_h2o_si,1) - end if + if (hlm_use_planthydro.eq.itrue) then + call UpdateH2OVeg(sites(s),bc_out(s),bc_out(s)%plant_stored_h2o_si,1) + end if end do - ! This call to RecruitWaterStorage() makes an accounting of - ! how much water is used to intialize newly recruited plants. - ! However, it does not actually move water from the soil or create - ! a flux, it is just accounting for diagnostics purposes. The water - ! will not actually be moved until the beginning of the first hydraulics - ! call during the fast timestep sequence + ! This call to RecruitWaterStorage() makes an accounting of + ! how much water is used to intialize newly recruited plants. + ! However, it does not actually move water from the soil or create + ! a flux, it is just accounting for diagnostics purposes. The water + ! will not actually be moved until the beginning of the first hydraulics + ! call during the fast timestep sequence if (hlm_use_planthydro.eq.itrue) then call RecruitWaterStorage(nsites,sites,bc_out) @@ -2271,8 +2266,8 @@ function NumPotentialCanopyLayers(currentPatch,site_spread,include_substory) res currentCohort => currentPatch%tallest do while (associated(currentCohort)) if(currentCohort%canopy_layer == z) then - call carea_allom(currentCohort%dbh,currentCohort%n,site_spread,& - currentCohort%pft,currentCohort%crowndamage, c_area) + call carea_allom(currentCohort%dbh,currentCohort%n,site_spread,currentCohort%pft, & + currentCohort%crowndamage, c_area) arealayer = arealayer + c_area end if currentCohort => currentCohort%shorter From 8f994c29af81d7d42d994977e4c78f63df19f34d Mon Sep 17 00:00:00 2001 From: Jessica Needham Date: Fri, 15 Apr 2022 19:21:30 -0700 Subject: [PATCH 32/84] [ Fix canopy too full error with damage code ] [ Remove a bad call to carea_allom within tree_sai that was accidently changing crown area of damaged trees ] Fixes: [NGT-ED Github issue #] User interface changes?: [Yes (describe what changes), No] Code review: [Names] Test suite: [suite name, machine, compilers] Test baseline: Test namelist changes: Test answer changes: [bit for bit, roundoff, climate changing] Test summary: no testing --- biogeochem/EDCanopyStructureMod.F90 | 40 +++++++++++++++++++---------- biogeochem/EDCohortDynamicsMod.F90 | 4 +-- biogeochem/EDPatchDynamicsMod.F90 | 12 ++++++--- biogeochem/EDPhysiologyMod.F90 | 2 +- biogeochem/FatesAllometryMod.F90 | 15 +++++------ 5 files changed, 43 insertions(+), 30 deletions(-) diff --git a/biogeochem/EDCanopyStructureMod.F90 b/biogeochem/EDCanopyStructureMod.F90 index 42b5fa3e2e..f611bb4dd0 100644 --- a/biogeochem/EDCanopyStructureMod.F90 +++ b/biogeochem/EDCanopyStructureMod.F90 @@ -866,7 +866,7 @@ subroutine PromoteIntoLayer(currentSite,currentPatch,i_lyr) currentCohort => currentPatch%tallest do while (associated(currentCohort)) call carea_allom(currentCohort%dbh,currentCohort%n,currentSite%spread, & - currentCohort%pft,currentCohort%c_area) + currentCohort%pft,currentCohort%crowndamage,currentCohort%c_area) if(currentCohort%canopy_layer == i_lyr+1)then !look at the cohorts in the canopy layer below... if (ED_val_comp_excln .ge. 0.0_r8 ) then @@ -1412,6 +1412,8 @@ subroutine canopy_summarization( nsites, sites, bc_in ) currentPatch => currentPatch%younger end do !patch loop + + call leaf_area_profile(sites(s)) end do ! site loop @@ -1508,7 +1510,8 @@ subroutine leaf_area_profile( currentSite ) real(r8) :: max_chite ! top of cohort canopy (m) real(r8) :: lai ! summed lai for checking m2 m-2 real(r8) :: leaf_c ! leaf carbon [kg] - + real(r8) :: target_c_area ! for tree sai - need an undamaged version + !---------------------------------------------------------------------- smooth_leaf_distribution = 0 @@ -1537,7 +1540,7 @@ subroutine leaf_area_profile( currentSite ) currentPatch%layer_height_profile(:,:,:) = 0._r8 currentPatch%canopy_area_profile(:,:,:) = 0._r8 currentPatch%canopy_mask(:,:) = 0 - + ! ------------------------------------------------------------------------------ ! It is remotely possible that in deserts we will not have any canopy ! area, ie not plants at all... @@ -1545,13 +1548,13 @@ subroutine leaf_area_profile( currentSite ) if (currentPatch%total_canopy_area > nearzero ) then - currentCohort => currentPatch%tallest do while(associated(currentCohort)) ft = currentCohort%pft cl = currentCohort%canopy_layer + ! Calculate LAI of layers above ! Note that the canopy_layer_lai is also calculated in this loop ! but since we go top down in terms of plant size, we should be okay @@ -1562,17 +1565,21 @@ subroutine leaf_area_profile( currentSite ) currentCohort%n, currentCohort%canopy_layer, & currentPatch%canopy_layer_tlai,currentCohort%vcmax25top ) + call carea_allom(currentCohort%dbh, currentCohort%n, currentSite%spread, currentCohort%pft, & + 1, target_c_area) + if (hlm_use_sp .eq. ifalse) then currentCohort%treesai = tree_sai(currentCohort%pft, currentCohort%dbh,& - currentSite%spread, currentCohort%canopy_trim, & - currentCohort%c_area, currentCohort%n, currentCohort%canopy_layer, & + currentCohort%canopy_trim, & + target_c_area, currentCohort%n, currentCohort%canopy_layer, & currentPatch%canopy_layer_tlai, currentCohort%treelai , & currentCohort%vcmax25top,4) end if - + currentCohort%lai = currentCohort%treelai *currentCohort%c_area/currentPatch%total_canopy_area + currentCohort%sai = currentCohort%treesai *currentCohort%c_area/currentPatch%total_canopy_area - + ! Number of actual vegetation layers in this cohort's crown currentCohort%nv = count((currentCohort%treelai+currentCohort%treesai) .gt. dlower_vai(:)) + 1 @@ -1582,10 +1589,12 @@ subroutine leaf_area_profile( currentSite ) currentPatch%canopy_layer_tlai(cl) = currentPatch%canopy_layer_tlai(cl) + currentCohort%lai + currentCohort => currentCohort%shorter enddo !currentCohort + if(smooth_leaf_distribution == 1)then ! ----------------------------------------------------------------------------- @@ -1652,6 +1661,7 @@ subroutine leaf_area_profile( currentSite ) enddo !currentCohort + ! ----------------------------------------------------------------------------- ! Perform a leaf area conservation check on the LAI profile lai = 0.0_r8 @@ -1672,8 +1682,6 @@ subroutine leaf_area_profile( currentSite ) ! Go through all cohorts and add their leaf area ! and canopy area to the accumulators. ! ----------------------------------------------------------------------------- - - currentCohort => currentPatch%shortest do while(associated(currentCohort)) ft = currentCohort%pft @@ -1776,7 +1784,7 @@ subroutine leaf_area_profile( currentSite ) currentCohort => currentCohort%taller enddo !cohort - + ! -------------------------------------------------------------------------- ! If there is an upper-story, the top canopy layer @@ -1924,7 +1932,8 @@ subroutine update_hlm_dynamics(nsites,sites,fcolumn,bc_out) real(r8) :: total_canopy_area real(r8) :: total_patch_leaf_stem_area real(r8) :: weight ! Weighting for cohort variables in patch - + real(r8) :: target_c_area + do s = 1,nsites ifp = 0 @@ -1990,9 +1999,12 @@ subroutine update_hlm_dynamics(nsites,sites,fcolumn,bc_out) currentCohort%pft, currentCohort%c_area, currentCohort%n, & currentCohort%canopy_layer, currentPatch%canopy_layer_tlai,currentCohort%vcmax25top ) + call carea_allom(currentCohort%dbh,currentCohort%n,sites(s)%spread,& + currentCohort%pft,1, target_c_area) + currentCohort%treesai = tree_sai(currentCohort%pft, currentCohort%dbh, & - site(s)%spread, currentCohort%canopy_trim, & - currentCohort%c_area, currentCohort%n, currentCohort%canopy_layer, & + currentCohort%canopy_trim, & + target_c_area, currentCohort%n, currentCohort%canopy_layer, & currentPatch%canopy_layer_tlai, currentCohort%treelai , & currentCohort%vcmax25top,4) endif diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index cfbeb1c174..7d04ce2f07 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -285,7 +285,7 @@ subroutine create_cohort(currentSite, patchptr, pft, nn, hite, coage, dbh, & patchptr%canopy_layer_tlai,new_cohort%vcmax25top ) if(hlm_use_sp.eq.ifalse)then - new_cohort%treesai = tree_sai(new_cohort%pft, new_cohort%dbh, currentSite%spread, & + new_cohort%treesai = tree_sai(new_cohort%pft, new_cohort%dbh, & new_cohort%canopy_trim, & new_cohort%c_area, new_cohort%n, new_cohort%canopy_layer, & patchptr%canopy_layer_tlai, new_cohort%treelai,new_cohort%vcmax25top,2 ) @@ -1380,7 +1380,7 @@ subroutine fuse_cohorts(currentSite, currentPatch, bc_in) currentCohort%treesai = tree_sai(currentCohort%pft, currentCohort%dbh,& - currentSite%spread, currentCohort%canopy_trim, & + currentCohort%canopy_trim, & currentCohort%c_area, newn, currentCohort%canopy_layer, & currentPatch%canopy_layer_tlai, currentCohort%treelai,currentCohort%vcmax25top,1 ) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 92a69389e0..546e2727cc 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -538,6 +538,7 @@ subroutine spawn_patches( currentSite, bc_in) logical :: found_youngest_primary ! logical for finding the first primary forest patch integer :: min_nocomp_pft, max_nocomp_pft, i_nocomp_pft + !--------------------------------------------------------------------- real(r8), parameter :: damage_error_fail = 1.0e-6_r8 @@ -1308,7 +1309,7 @@ subroutine spawn_patches( currentSite, bc_in) ! update crown area here - for cohort fusion and canopy organisation below call carea_allom(nc_d%dbh, nc_d%n, currentSite%spread,& nc_d%pft, nc_d%crowndamage, nc_d%c_area) - + call get_crown_reduction(nc_d%crowndamage, mass_frac) @@ -1385,10 +1386,15 @@ subroutine spawn_patches( currentSite, bc_in) end do ! end crowndamage loop ! Reduce currentCohort%n now based on sum of all new damage classes + ! And update c_area of the undamaged cohort (since number density has changed) if(hlm_use_canopy_damage .eq. itrue) then currentCohort%n = currentCohort%n - cd_n_total + call carea_allom(currentCohort%dbh, currentCohort%n, currentSite%spread,& + currentCohort%pft, currentCohort%crowndamage, currentCohort%c_area) else if(hlm_use_understory_damage .eq. itrue) then nc%n = nc%n - cd_n_total + call carea_allom(nc%dbh, nc%n, currentSite%spread,& + nc%pft, nc%crowndamage, nc%c_area) end if @@ -1397,7 +1403,7 @@ subroutine spawn_patches( currentSite, bc_in) end if ! end if damage time end if ! end if damage is on - + ! Put new undamaged cohorts in the correct place in the linked list if (nc%n > 0.0_r8) then storebigcohort => new_patch%tallest @@ -1462,8 +1468,6 @@ subroutine spawn_patches( currentSite, bc_in) enddo ! currentPatch patch loop. - - !*************************/ !** INSERT NEW PATCH(ES) INTO LINKED LIST !*************************/ diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index d450dbcadf..92e4f60425 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -475,7 +475,7 @@ subroutine trim_canopy( currentSite ) currentCohort%treesai = tree_sai(currentCohort%pft, & currentCohort%dbh, & - currentSite%spread, currentCohort%canopy_trim, & + currentCohort%canopy_trim, & target_c_area, currentCohort%n,currentCohort%canopy_layer,& currentPatch%canopy_layer_tlai, currentCohort%treelai, & currentCohort%vcmax25top,0 ) diff --git a/biogeochem/FatesAllometryMod.F90 b/biogeochem/FatesAllometryMod.F90 index 862a837782..a4858a6b25 100644 --- a/biogeochem/FatesAllometryMod.F90 +++ b/biogeochem/FatesAllometryMod.F90 @@ -737,7 +737,7 @@ end function tree_lai ! ============================================================================ - real(r8) function tree_sai(pft, dbh, site_spread, canopy_trim, target_c_area, nplant, cl, & + real(r8) function tree_sai(pft, dbh, canopy_trim, c_area, nplant, cl, & canopy_lai, treelai, vcmax25top, call_id ) ! ============================================================================ @@ -745,10 +745,9 @@ real(r8) function tree_sai(pft, dbh, site_spread, canopy_trim, target_c_area, np ! ============================================================================ integer, intent(in) :: pft - real(r8), intent(inout) :: dbh - real(r8), intent(in) :: site_spread - real(r8), intent(inout) :: target_c_area + real(r8), intent(in) :: dbh real(r8), intent(in) :: canopy_trim ! trimming function (0-1) + real(r8), intent(in) :: c_area ! crown area (m2) real(r8), intent(in) :: nplant ! number of plants integer, intent(in) :: cl ! canopy layer index real(r8), intent(in) :: canopy_lai(nclmax) ! total leaf area index of @@ -763,10 +762,8 @@ real(r8) function tree_sai(pft, dbh, site_spread, canopy_trim, target_c_area, np ! target undamaged bleaf call bleaf(dbh, pft, 1, canopy_trim, target_bleaf) - - call carea_allom(dbh, nplant, site_spread, pft, 1, target_c_area, inverse = .false.) - - target_lai = tree_lai(target_bleaf, pft, target_c_area, nplant, cl,& + + target_lai = tree_lai(target_bleaf, pft, c_area, nplant, cl,& canopy_lai, vcmax25top) tree_sai = prt_params%allom_sai_scaler(pft) * target_lai @@ -780,7 +777,7 @@ real(r8) function tree_sai(pft, dbh, site_spread, canopy_trim, target_c_area, np write(fates_log(),*) 'sai: ',tree_sai write(fates_log(),*) 'lai+sai: ',treelai+tree_sai write(fates_log(),*) 'target_bleaf: ', target_bleaf - write(fates_log(),*) 'target_c_area: ', target_c_area + write(fates_log(),*) 'area: ', c_area write(fates_log(),*) 'target_lai: ',target_lai write(fates_log(),*) 'dinc_vai:',dinc_vai write(fates_log(),*) 'nlevleaf,sum(dinc_vai):',nlevleaf,sum(dinc_vai) From f28f532d23e6c1e72500e2572f2f092a08e28b22 Mon Sep 17 00:00:00 2001 From: Jessica Needham Date: Fri, 13 May 2022 16:42:36 -0700 Subject: [PATCH 33/84] [ make damage timings be controlled by event_code as in the logging module ] [ copy the logging code IsItLoggingTime so that damage timings can be controlled by a code in the parameter file. ] Fixes: [NGT-ED Github issue #] User interface changes?: [Yes (describe what changes), No] Code review: [Names] Test suite: [suite name, machine, compilers] Test baseline: Test namelist changes: Test answer changes: [bit for bit, roundoff, climate changing] Test summary: no testing --- biogeochem/DamageMainMod.F90 | 98 +++++++++++++++++++++--- main/EDParamsMod.F90 | 15 +++- main/FatesInterfaceMod.F90 | 1 + parameter_files/fates_params_default.cdl | 9 ++- 4 files changed, 111 insertions(+), 12 deletions(-) diff --git a/biogeochem/DamageMainMod.F90 b/biogeochem/DamageMainMod.F90 index 20c9358a28..987a90993e 100644 --- a/biogeochem/DamageMainMod.F90 +++ b/biogeochem/DamageMainMod.F90 @@ -5,14 +5,14 @@ module DamageMainMod use FatesConstantsMod , only : itrue, ifalse use FatesConstantsMod , only : years_per_day use FatesGlobals , only : fates_log - + use FatesGlobals , only : endrun => fates_endrun + use shr_log_mod , only : errMsg => shr_log_errMsg use EDPftvarcon , only : EDPftvarcon_inst - + use EDParamsMod , only : damage_event_code use EDtypesMod , only : ed_site_type use EDtypesMod , only : ed_patch_type use EDtypesMod , only : ed_cohort_type use EDtypesMod , only : AREA - use PRTGenericMod, only : leaf_organ use PRTGenericMod, only : carbon12_element use PRTGenericMod, only : all_carbon_elements @@ -23,12 +23,24 @@ module DamageMainMod use PRTGenericMod, only : repro_organ use PRTGenericMod, only : struct_organ use PRTGenericMod, only : SetState - + use FatesInterfaceTypesMod, only : hlm_current_day + use FatesInterfaceTypesMod, only : hlm_current_month + use FatesInterfaceTypesMod, only : hlm_current_year + use FatesInterfaceTypesMod, only : hlm_model_day + use FatesInterfaceTypesMod , only : hlm_day_of_year + use FatesInterfaceTypesMod, only : hlm_use_canopy_damage + use FatesInterfaceTypesMod, only : hlm_use_understory_damage + + + implicit none private logical, protected :: damage_time ! if true then damage occurs during current time step + character(len=*), parameter, private :: sourcefile = & + __FILE__ + public :: get_crown_reduction public :: get_damage_frac public :: is_it_damage_time @@ -47,20 +59,88 @@ subroutine is_it_damage_time(is_master, currentSite) !---------------------------------------------------------------------------- ! This subroutine determines whether damage should occur (it is called daily) + ! This is almost an exact replica of the IsItLoggingTime subroutine !----------------------------------------------------------------------------- - use FatesInterfaceTypesMod , only : hlm_day_of_year integer, intent(in) :: is_master type(ed_site_type), intent(inout), target :: currentSite - - + + integer :: icode ! Integer equivalent of the event code (parameter file only allows reals) + integer :: damage_date ! Day of month for damage extracted from event code + integer :: damage_month ! Month of year for damage extracted from event code + integer :: damage_year ! Year for damage extracted from event code + character(len=64) :: fmt = '(a,i2.2,a,i2.2,a,i4,4)' + damage_time = .false. + icode = int(damage_event_code) + + if(hlm_use_canopy_damage .eq. ifalse .or. hlm_use_understory_damage .eq. ifalse) return - if (hlm_day_of_year .eq. 1) then + if(icode .eq. 1) then + ! Damage is turned off + damage_time = .false. + + else if(icode .eq. 2) then + ! Damage event on first time step + if(hlm_model_day .eq.1) then + damage_time = .true. + end if + + else if(icode .eq. 3) then + ! Damage event every day - not sure this is recommended as it will result in a very large + ! number of cohorts damage_time = .true. + + else if(icode .eq. 4) then + ! Damage event once a month + if(hlm_current_day.eq.1 ) then + damage_time = .true. + end if + + else if(icode < 0 .and. icode > -366) then + ! Damage event every year on a specific day of the year + if(hlm_day_of_year .eq. abs(icode) ) then + damage_time = .true. + end if + + else if(icode > 10000 ) then + ! Specific Event: YYYYMMDD + damage_date = icode - int(100* floor(real(icode)/100)) + damage_year = floor(real(icode)/10000) + damage_month = floor(real(icode)/100) - damage_year*100 + + if(hlm_current_day .eq. damage_date .and. & + hlm_current_month .eq. damage_month .and. & + hlm_current_year .eq. damage_year ) then + damage_time = .true. + end if + + else + ! Bad damage event flag + write(fates_log(),*) 'An invalid damage code was specified in fates_params' + write(fates_log(),*) 'Check DamageMainMod.F90:is_it_damage_time()' + write(fates_log(),*) 'for a breakdown of the valide codes and change' + write(fates_log(),*) 'fates_damage_event_code in the file accordingly.' + write(fates_log(),*) 'exiting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + if(damage_time .and. (is_master.eq.itrue) ) then + write(fates_log(),fmt) 'Damage Event Enacted on date: ', & + hlm_current_month,'-', hlm_current_day,'-',hlm_current_year end if - + + !if (hlm_day_of_year .eq. 1) then + ! damage_time = .true. + !end if + + write(fates_log(),fmt) 'JN date: ', & + hlm_current_month,'-', hlm_current_day,'-',hlm_current_year + write(fates_log(),*) 'JN damage_time: ', damage_time + + return + end subroutine is_it_damage_time !---------------------------------------------------------------------------- diff --git a/main/EDParamsMod.F90 b/main/EDParamsMod.F90 index f474a20cab..aa51356339 100644 --- a/main/EDParamsMod.F90 +++ b/main/EDParamsMod.F90 @@ -209,6 +209,11 @@ module EDParamsMod character(len=param_string_length),parameter,public :: eca_name_plant_escalar = "fates_eca_plant_escalar" + ! Damage Control Parameters (ONLY RELEVANT WHEN USE_FATES_CANOPY_DAMAGE OR USE_FATES_UNDERSTORY_DAMAGE = TRUE) + !--------------------------------------------------------------------------------------------------------------- + real(r8),protected,public :: damage_event_code ! Code that options how damage events are structured + character(len=param_string_length),parameter,public :: damage_name_event_code = "fates_damage_event_code" + public :: FatesParamsInit public :: FatesRegisterParams public :: FatesReceiveParams @@ -273,6 +278,7 @@ subroutine FatesParamsInit() theta_cj_c3 = nan theta_cj_c4 = nan dev_arbitrary = nan + damage_event_code = nan end subroutine FatesParamsInit !----------------------------------------------------------------------- @@ -441,7 +447,10 @@ subroutine FatesRegisterParams(fates_params) call fates_params%RegisterParameter(name=name_dev_arbitrary, dimension_shape=dimension_shape_scalar, & dimension_names=dim_names_scalar) - + + call fates_params%RegisterParameter(name=damage_name_event_code, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) + ! non-scalar parameters call fates_params%RegisterParameter(name=ED_name_hydr_htftype_node, dimension_shape=dimension_shape_1d, & @@ -635,6 +644,9 @@ subroutine FatesReceiveParams(fates_params) call fates_params%RetreiveParameter(name=fates_name_cg_strikes, & data=cg_strikes) + call fates_params%RetreiveParameter(name=damage_name_event_code, & + data=damage_event_code) + ! parameters that are arrays of size defined within the params file and thus need allocating as well call fates_params%RetreiveParameterAllocate(name=ED_name_history_sizeclass_bin_edges, & data=ED_val_history_sizeclass_bin_edges) @@ -718,6 +730,7 @@ subroutine FatesReportParams(is_master) write(fates_log(),fmt0) 'q10_froz = ',q10_froz write(fates_log(),fmt0) 'cg_strikes = ',cg_strikes write(fates_log(),'(a,L2)') 'active_crown_fire = ',active_crown_fire + write(fates_log(),fmt0) 'damage_event_code = ',damage_event_code write(fates_log(),*) '------------------------------------------------------' end if diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index a76c036ca7..64a8d54a91 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -1842,6 +1842,7 @@ subroutine set_fates_ctrlparms(tag,ival,rval,cval) hlm_use_canopy_damage = ival if (fates_global_verbose()) then write(fates_log(),*) 'Transfering hlm_use_canopy_damage= ',ival,' to FATES' + write(fates_log(),*) 'JN FatesInterfaceMod hlm_use_canopy_damage : ', hlm_use_canopy_damage end if case('use_logging') diff --git a/parameter_files/fates_params_default.cdl b/parameter_files/fates_params_default.cdl index 4df45c465d..42b37dd27d 100644 --- a/parameter_files/fates_params_default.cdl +++ b/parameter_files/fates_params_default.cdl @@ -157,6 +157,9 @@ variables: double fates_branch_turnover(fates_pft) ; fates_branch_turnover:units = "yr" ; fates_branch_turnover:long_name = "turnover time of branches" ; + double fates_damage_event_code ; + fates_damage_event_code:units = "unitless" ; + fates_damage_event_code:long_name = "Integer code that options how damage events are structured" ; double fates_damage_frac(fates_pft) ; fates_damage_frac:units = "fraction"; fates_damage_frac:long_name = "fraction of cohort damaged in each damage event (event frequency specified in the is_it_damage_time subroutine)"; @@ -780,7 +783,7 @@ data: fates_history_coageclass_bin_edges = 0, 5 ; - fates_history_damage_bin_edges = 0, 20, 40, 60, 80 100 ; + fates_history_damage_bin_edges = 0, 20, 40, 60, 80, 100 ; fates_history_height_bin_edges = 0, 0.1, 0.3, 1, 3, 10 ; @@ -916,7 +919,9 @@ data: fates_damage_frac = 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01 ; - + + fates_damage_event_code = 1 ; + fates_damage_mort_p1 = 9.0,9.0,9.0,9.0,9.0,9.0,9.0,9.0,9.0,9.0,9.0,9.0 ; fates_damage_mort_p2 = 5.5, 5.5, 5.5, 5.5, 5.5, 5.5, 5.5, 5.5, 5.5, 5.5, From 261358210a3c9b9632b2e03972e67bfd92846992 Mon Sep 17 00:00:00 2001 From: Jessica Needham Date: Fri, 13 May 2022 20:05:17 -0700 Subject: [PATCH 34/84] [ Fixing damage event codes ] [Fix how is_it_damage_time is called. ] Fixes: [NGT-ED Github issue #] User interface changes?: [Yes (describe what changes), No] Code review: [Names] Test suite: [suite name, machine, compilers] Test baseline: Test namelist changes: Test answer changes: [bit for bit, roundoff, climate changing] Test summary: no testing --- biogeochem/DamageMainMod.F90 | 20 +++++++------------- main/EDMainMod.F90 | 6 ++---- 2 files changed, 9 insertions(+), 17 deletions(-) diff --git a/biogeochem/DamageMainMod.F90 b/biogeochem/DamageMainMod.F90 index 987a90993e..8d57224f2b 100644 --- a/biogeochem/DamageMainMod.F90 +++ b/biogeochem/DamageMainMod.F90 @@ -70,20 +70,22 @@ subroutine is_it_damage_time(is_master, currentSite) integer :: damage_date ! Day of month for damage extracted from event code integer :: damage_month ! Month of year for damage extracted from event code integer :: damage_year ! Year for damage extracted from event code - character(len=64) :: fmt = '(a,i2.2,a,i2.2,a,i4,4)' + integer :: model_day_int ! Model day + + character(len=64) :: fmt = '(a,i2.2,a,i2.2,a,i4.4)' damage_time = .false. icode = int(damage_event_code) - if(hlm_use_canopy_damage .eq. ifalse .or. hlm_use_understory_damage .eq. ifalse) return - + model_day_int = nint(hlm_model_day) + if(icode .eq. 1) then ! Damage is turned off damage_time = .false. else if(icode .eq. 2) then ! Damage event on first time step - if(hlm_model_day .eq.1) then + if(model_day_int .eq.1) then damage_time = .true. end if @@ -130,15 +132,7 @@ subroutine is_it_damage_time(is_master, currentSite) write(fates_log(),fmt) 'Damage Event Enacted on date: ', & hlm_current_month,'-', hlm_current_day,'-',hlm_current_year end if - - !if (hlm_day_of_year .eq. 1) then - ! damage_time = .true. - !end if - - write(fates_log(),fmt) 'JN date: ', & - hlm_current_month,'-', hlm_current_day,'-',hlm_current_year - write(fates_log(),*) 'JN damage_time: ', damage_time - + return end subroutine is_it_damage_time diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index ce5a2dda76..2470b2c678 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -173,10 +173,8 @@ subroutine ed_ecosystem_dynamics(currentSite, bc_in, bc_out) call IsItLoggingTime(hlm_masterproc,currentSite) ! Call a routine that identifies if damage should occur - if(hlm_use_canopy_damage .eq. itrue .or. hlm_use_understory_damage .eq. itrue) then - call is_it_damage_time(hlm_masterproc, currentSite) - end if - + call is_it_damage_time(hlm_masterproc, currentSite) + !************************************************************************** ! Fire, growth, biogeochemistry. !************************************************************************** From 758d902706f5ba0efe6b81fa40394455be31b3d6 Mon Sep 17 00:00:00 2001 From: Jessica Needham Date: Wed, 25 May 2022 18:07:53 -0700 Subject: [PATCH 35/84] [ create a single hlm_use_crown_damage switch and make a parameter to signal which canaopy layer of trees gets damaged ] [ Single switch for turning on the module and parameters to modify the module's behaviour. ] Fixes: [NGT-ED Github issue #] User interface changes?: [Yes - single namelist option now hlm_use_crown_damage and a new parameter fates_damage_canopy_layer_code 1 for canopy and 2 for understory] Code review: [Names] Test suite: [suite name, machine, compilers] Test baseline: Test namelist changes: Test answer changes: [bit for bit, roundoff, climate changing] Test summary:no testing --- biogeochem/DamageMainMod.F90 | 2 - biogeochem/EDCohortDynamicsMod.F90 | 3 +- biogeochem/EDMortalityFunctionsMod.F90 | 5 +-- biogeochem/EDPatchDynamicsMod.F90 | 49 +++++++++++++--------- biogeophys/FatesPlantRespPhotosynthMod.F90 | 5 +-- main/EDInitMod.F90 | 5 +-- main/EDMainMod.F90 | 5 +-- main/EDParamsMod.F90 | 17 ++++++-- main/EDTypesMod.F90 | 1 - main/FatesHistoryInterfaceMod.F90 | 18 ++++---- main/FatesInterfaceMod.F90 | 30 ++++--------- main/FatesInterfaceTypesMod.F90 | 7 +--- main/FatesRestartInterfaceMod.F90 | 12 +++--- parameter_files/fates_params_default.cdl | 5 +++ 14 files changed, 79 insertions(+), 85 deletions(-) diff --git a/biogeochem/DamageMainMod.F90 b/biogeochem/DamageMainMod.F90 index 8d57224f2b..8e8748692f 100644 --- a/biogeochem/DamageMainMod.F90 +++ b/biogeochem/DamageMainMod.F90 @@ -28,8 +28,6 @@ module DamageMainMod use FatesInterfaceTypesMod, only : hlm_current_year use FatesInterfaceTypesMod, only : hlm_model_day use FatesInterfaceTypesMod , only : hlm_day_of_year - use FatesInterfaceTypesMod, only : hlm_use_canopy_damage - use FatesInterfaceTypesMod, only : hlm_use_understory_damage diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index 7d04ce2f07..bf6614f25f 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -11,6 +11,7 @@ Module EDCohortDynamicsMod use FatesInterfaceTypesMod , only : hlm_use_planthydro use FatesInterfaceTypesMod , only : hlm_use_sp use FatesInterfaceTypesMod , only : hlm_use_cohort_age_tracking + use FatesInterfaceTypesMod , only : hlm_use_crown_damage use FatesInterfaceTypesMod , only : hlm_is_restart use FatesConstantsMod , only : r8 => fates_r8 use FatesConstantsMod , only : fates_unset_int @@ -723,8 +724,6 @@ subroutine terminate_cohorts( currentSite, currentPatch, level , call_index, bc_ ! terminates all cohorts when they get too small ! ! !USES: - use FatesInterfaceTypesMod , only : hlm_use_canopy_damage - use FatesInterfaceTypesMod , only : hlm_use_understory_damage ! ! !ARGUMENTS diff --git a/biogeochem/EDMortalityFunctionsMod.F90 b/biogeochem/EDMortalityFunctionsMod.F90 index 443035b7ca..46a88d5fec 100644 --- a/biogeochem/EDMortalityFunctionsMod.F90 +++ b/biogeochem/EDMortalityFunctionsMod.F90 @@ -17,8 +17,7 @@ module EDMortalityFunctionsMod use FatesInterfaceTypesMod , only : hlm_use_ed_prescribed_phys use FatesInterfaceTypesMod , only : hlm_freq_day use FatesInterfaceTypesMod , only : hlm_use_planthydro - use FatesInterfaceTypesMod , only : hlm_use_canopy_damage - use FatesInterfaceTypesMod , only : hlm_use_understory_damage + use FatesInterfaceTypesMod , only : hlm_use_crown_damage use EDLoggingMortalityMod , only : LoggingMortality_frac use EDParamsMod , only : fates_mortality_disturbance_fraction @@ -116,7 +115,7 @@ subroutine mortality_rates( cohort_in,bc_in,cmort,hmort,bmort,frmort,smort,asmor end if ! Damage dependent mortality - if (hlm_use_canopy_damage .eq. itrue .or. hlm_use_understory_damage .eq. itrue) then + if (hlm_use_crown_damage .eq. itrue) then call get_damage_mortality(cohort_in%crowndamage, cohort_in%pft, dgmort) else dgmort = 0.0_r8 diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 546e2727cc..2d2c3d8ff9 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -472,10 +472,10 @@ subroutine spawn_patches( currentSite, bc_in) use PRTLossFluxesMod , only : PRTDamageLosses use PRTGenericMod , only : leaf_organ use ChecksBalancesMod , only : SiteMassStock - use FatesInterfaceTypesMod, only : hlm_use_canopy_damage - use FatesInterfaceTypesMod, only : hlm_use_understory_damage + use FatesInterfaceTypesMod, only : hlm_use_crown_damage use FatesInterfaceTypesMod, only : nlevdamage use FatesParameterDerivedMod, only : param_derived + use EDParamsMod , only : damage_canopy_layer_code ! ! !ARGUMENTS: @@ -539,11 +539,14 @@ subroutine spawn_patches( currentSite, bc_in) logical :: found_youngest_primary ! logical for finding the first primary forest patch integer :: min_nocomp_pft, max_nocomp_pft, i_nocomp_pft + integer :: i_damage_code !--------------------------------------------------------------------- real(r8), parameter :: damage_error_fail = 1.0e-6_r8 !--------------------------------------------------------------------- + + i_damage_code = int(damage_canopy_layer_code) total_litter_d = 0.0_r8 @@ -760,7 +763,7 @@ subroutine spawn_patches( currentSite, bc_in) ! and the damaged trees - if(hlm_use_canopy_damage .eq. itrue .or. hlm_use_understory_damage .eq. itrue) then + if(hlm_use_crown_damage .eq. itrue) then if( damage_time ) then call damage_litter_fluxes(currentSite, currentPatch, & @@ -905,7 +908,7 @@ subroutine spawn_patches( currentSite, bc_in) total_c * g_per_kg * days_per_sec * years_per_day * ha_per_m2 - if (hlm_use_canopy_damage .eq. itrue .or. hlm_use_understory_damage .eq. itrue) then + if (hlm_use_crown_damage .eq. itrue) then currentSite%imort_rate_damage(currentCohort%crowndamage, & currentCohort%size_class, currentCohort%pft) = & @@ -1017,7 +1020,7 @@ subroutine spawn_patches( currentSite, bc_in) end if ! also track fire damage mortality and cflux along size x damage axis - if(hlm_use_canopy_damage .eq. itrue .or. hlm_use_understory_damage .eq. itrue) then + if(hlm_use_crown_damage .eq. itrue) then if(levcan==ican_upper) then currentSite%fmort_rate_canopy_damage(currentCohort%crowndamage, currentCohort%size_class, & currentCohort%pft) = & @@ -1178,7 +1181,7 @@ subroutine spawn_patches( currentSite, bc_in) logging_coll_under_frac/ hlm_freq_day ) * & total_c * g_per_kg * days_per_sec * years_per_day * ha_per_m2 - if (hlm_use_canopy_damage .eq. itrue .or. hlm_use_understory_damage .eq. itrue) then + if (hlm_use_crown_damage .eq. itrue) then currentSite%imort_rate_damage(currentCohort%crowndamage,& currentCohort%size_class, currentCohort%pft) = & currentSite%imort_rate_damage(currentCohort%crowndamage,& @@ -1253,7 +1256,7 @@ subroutine spawn_patches( currentSite, bc_in) ! Regardless of disturbance type, reduce mass of damaged trees - if(hlm_use_canopy_damage .eq.itrue .or. hlm_use_understory_damage .eq. itrue) then + if(hlm_use_crown_damage .eq. itrue) then if(damage_time) then ! if woody @@ -1269,9 +1272,9 @@ subroutine spawn_patches( currentSite, bc_in) call get_damage_frac(currentCohort%crowndamage, cd, currentCohort%pft, cd_frac) - if(hlm_use_canopy_damage .eq. itrue .and. currentCohort%canopy_layer == 1) then + if(i_damage_code .eq. 1 .and. currentCohort%canopy_layer == 1) then cd_n = currentCohort%n * cd_frac - else if(hlm_use_understory_damage .eq. itrue .and. currentCohort%canopy_layer > 1) then + else if(i_damage_code .eq. 2 .and. currentCohort%canopy_layer > 1) then cd_n = nc%n * cd_frac else cd_n = 0._r8 @@ -1346,12 +1349,12 @@ subroutine spawn_patches( currentSite, bc_in) fnrt_c = nc_d%prt%GetState(fnrt_organ, all_carbon_elements) - if(hlm_use_canopy_damage .eq. itrue) then + if(i_damage_code .eq. 1 ) then currentSite%crownarea_canopy_damage = currentSite%crownarea_canopy_damage + & (currentCohort%c_area/currentCohort%n - nc_d%c_area/nc_d%n) * nc_d%n end if - if(hlm_use_understory_damage .eq. itrue) then + if(i_damage_code .eq. 2 ) then currentSite%crownarea_ustory_damage = currentSite%crownarea_ustory_damage + & (currentCohort%c_area/currentCohort%n - nc_d%c_area/nc_d%n) * nc_d%n end if @@ -1387,14 +1390,14 @@ subroutine spawn_patches( currentSite, bc_in) ! Reduce currentCohort%n now based on sum of all new damage classes ! And update c_area of the undamaged cohort (since number density has changed) - if(hlm_use_canopy_damage .eq. itrue) then + if(i_damage_code .eq. 1 ) then currentCohort%n = currentCohort%n - cd_n_total call carea_allom(currentCohort%dbh, currentCohort%n, currentSite%spread,& currentCohort%pft, currentCohort%crowndamage, currentCohort%c_area) - else if(hlm_use_understory_damage .eq. itrue) then + else if(i_damage_code .eq. 2 ) then nc%n = nc%n - cd_n_total call carea_allom(nc%dbh, nc%n, currentSite%spread,& - nc%pft, nc%crowndamage, nc%c_area) + nc%pft, nc%crowndamage, nc%c_area) end if @@ -2383,8 +2386,8 @@ subroutine damage_litter_fluxes(currentSite, currentPatch, newPatch,patch_site_a use SFParamsMod , only : SF_val_cwd_frac use FatesInterfaceTypesMod , only : nlevdamage use EDParamsMod , only : ED_val_understorey_death - use FatesInterfaceTypesMod, only : hlm_use_canopy_damage - use FatesInterfaceTypesMod, only : hlm_use_understory_damage + use EDParamsMod , only : damage_canopy_layer_code + use FatesInterfaceTypesMod, only : hlm_use_crown_damage use FatesConstantsMod, only : itrue use FatesParameterDerivedMod, only : param_derived ! @@ -2437,7 +2440,11 @@ subroutine damage_litter_fluxes(currentSite, currentPatch, newPatch,patch_site_a integer :: ncwd_no_trunk real(r8), allocatable :: SF_val_CWD_frac_canopy(:) real(r8) :: cd_n_tot + integer :: i_damage_code + !--------------------------------------------------------------------- + i_damage_code = int(damage_canopy_layer_code) + total_damage_litter = 0.0_r8 cd_n_tot = 0.0_r8 ncwd_no_trunk = ncwd - 1 @@ -2495,15 +2502,17 @@ subroutine damage_litter_fluxes(currentSite, currentPatch, newPatch,patch_site_a if(prt_params%woody(currentCohort%pft)==1) then - if( hlm_use_canopy_damage .eq.itrue .and. & - currentCohort%canopy_layer ==1 .and. .not. currentCohort%isnew) then + if( hlm_use_crown_damage .eq.itrue .and. & + currentCohort%canopy_layer ==1 .and. i_damage_code .eq. 1 .and. & + .not. currentCohort%isnew) then ! litter is called before damage - so we need to account for mortality here too num_trees = currentCohort%n * (1.0_r8 - fates_mortality_disturbance_fraction * & min(1.0_r8, currentCohort%dmort* hlm_freq_day)) - else if( hlm_use_understory_damage .eq.itrue .and. & - currentCohort%canopy_layer > 1 .and. .not. currentCohort%isnew) then + else if( hlm_use_crown_damage .eq.itrue .and. & + currentCohort%canopy_layer > 1 .and. i_damage_code .eq. 2 .and. & + .not. currentCohort%isnew) then ! for trees in new patch to be damaged num_trees = currentCohort%n * (patch_site_areadis/currentPatch%area) * & diff --git a/biogeophys/FatesPlantRespPhotosynthMod.F90 b/biogeophys/FatesPlantRespPhotosynthMod.F90 index 3bf35c6849..3d9e005154 100644 --- a/biogeophys/FatesPlantRespPhotosynthMod.F90 +++ b/biogeophys/FatesPlantRespPhotosynthMod.F90 @@ -136,8 +136,7 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) use DamageMainMod, only : get_crown_reduction - use FatesInterfaceTypesMod, only : hlm_use_canopy_damage - use FatesInterfaceTypesMod, only : hlm_use_understory_damage + use FatesInterfaceTypesMod, only : hlm_use_crown_damage ! ARGUMENTS: ! ----------------------------------------------------------------------------------- @@ -651,7 +650,7 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) sapw_c = currentCohort%prt%GetState(sapw_organ, all_carbon_elements) fnrt_c = currentCohort%prt%GetState(fnrt_organ, all_carbon_elements) - if (hlm_use_canopy_damage .eq. itrue .or. hlm_use_understory_damage .eq. itrue) then + if (hlm_use_crown_damage .eq. itrue) then agb_frac = prt_params%allom_agb_frac(currentCohort%pft) branch_frac = param_derived%branch_frac(currentCohort%pft) diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index b49c757e3c..4ace6c87f1 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -43,8 +43,7 @@ module EDInitMod use FatesInterfaceTypesMod , only : hlm_use_planthydro use FatesInterfaceTypesMod , only : hlm_use_inventory_init use FatesInterfaceTypesMod , only : hlm_use_fixed_biogeog - use FatesInterfaceTypesMod , only : hlm_use_canopy_damage - use FatesInterfaceTypesMod , only : hlm_use_understory_damage + use FatesInterfaceTypesMod , only : hlm_use_crown_damage use FatesInterfaceTypesMod , only : hlm_use_sp use FatesInterfaceTypesMod , only : numpft use FatesInterfaceTypesMod , only : nleafage @@ -131,7 +130,7 @@ subroutine init_site_vars( site_in, bc_in, bc_out ) allocate(site_in%mass_balance(1:num_elements)) allocate(site_in%flux_diags(1:num_elements)) - if (hlm_use_canopy_damage .eq. itrue .or. hlm_use_understory_damage .eq. itrue) then + if (hlm_use_crown_damage .eq. itrue) then allocate(site_in%term_nindivs_canopy_damage(1:nlevdamage, 1:nlevsclass, 1:numpft)) allocate(site_in%term_nindivs_ustory_damage(1:nlevdamage, 1:nlevsclass, 1:numpft)) allocate(site_in%imort_rate_damage(1:nlevdamage, 1:nlevsclass, 1:numpft)) diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index 2470b2c678..85ef572163 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -19,8 +19,7 @@ module EDMainMod use FatesInterfaceTypesMod , only : hlm_use_cohort_age_tracking use FatesInterfaceTypesMod , only : hlm_reference_date use FatesInterfaceTypesMod , only : hlm_use_ed_prescribed_phys - use FatesInterfaceTypesMod , only : hlm_use_canopy_damage - use FatesInterfaceTypesMod , only : hlm_use_understory_damage + use FatesInterfaceTypesMod , only : hlm_use_crown_damage use FatesInterfaceTypesMod , only : hlm_use_ed_st3 use FatesInterfaceTypesMod , only : hlm_use_sp use FatesInterfaceTypesMod , only : bc_in_type @@ -523,7 +522,7 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) call currentCohort%prt%DailyPRT() - if(hlm_use_canopy_damage .eq. itrue .or. hlm_use_understory_damage .eq. itrue) then + if(hlm_use_crown_damage .eq. itrue) then if(currentCohort%crowndamage > 1) then diff --git a/main/EDParamsMod.F90 b/main/EDParamsMod.F90 index aa51356339..199bf42445 100644 --- a/main/EDParamsMod.F90 +++ b/main/EDParamsMod.F90 @@ -209,10 +209,13 @@ module EDParamsMod character(len=param_string_length),parameter,public :: eca_name_plant_escalar = "fates_eca_plant_escalar" - ! Damage Control Parameters (ONLY RELEVANT WHEN USE_FATES_CANOPY_DAMAGE OR USE_FATES_UNDERSTORY_DAMAGE = TRUE) + ! Damage Control Parameters (ONLY RELEVANT WHEN USE_FATES_DAMAGE = TRUE) !--------------------------------------------------------------------------------------------------------------- - real(r8),protected,public :: damage_event_code ! Code that options how damage events are structured + real(r8),protected,public :: damage_event_code ! Code that options how damage events are structured character(len=param_string_length),parameter,public :: damage_name_event_code = "fates_damage_event_code" + + real(r8),protected,public :: damage_canopy_layer_code ! Code that changes whether damage affects canopy trees (1), understory trees (2) + character(len=param_string_length),parameter,public :: damage_name_canopy_layer_code = "fates_damage_canopy_layer_code" public :: FatesParamsInit public :: FatesRegisterParams @@ -279,6 +282,7 @@ subroutine FatesParamsInit() theta_cj_c4 = nan dev_arbitrary = nan damage_event_code = nan + damage_canopy_layer_code = nan end subroutine FatesParamsInit !----------------------------------------------------------------------- @@ -448,7 +452,10 @@ subroutine FatesRegisterParams(fates_params) call fates_params%RegisterParameter(name=name_dev_arbitrary, dimension_shape=dimension_shape_scalar, & dimension_names=dim_names_scalar) - call fates_params%RegisterParameter(name=damage_name_event_code, dimension_shape=dimension_shape_scalar, & + call fates_params%RegisterParameter(name=damage_name_event_code, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) + + call fates_params%RegisterParameter(name=damage_name_canopy_layer_code, dimension_shape=dimension_shape_scalar, & dimension_names=dim_names_scalar) ! non-scalar parameters @@ -647,6 +654,9 @@ subroutine FatesReceiveParams(fates_params) call fates_params%RetreiveParameter(name=damage_name_event_code, & data=damage_event_code) + call fates_params%RetreiveParameter(name=damage_name_canopy_layer_code, & + data=damage_canopy_layer_code) + ! parameters that are arrays of size defined within the params file and thus need allocating as well call fates_params%RetreiveParameterAllocate(name=ED_name_history_sizeclass_bin_edges, & data=ED_val_history_sizeclass_bin_edges) @@ -731,6 +741,7 @@ subroutine FatesReportParams(is_master) write(fates_log(),fmt0) 'cg_strikes = ',cg_strikes write(fates_log(),'(a,L2)') 'active_crown_fire = ',active_crown_fire write(fates_log(),fmt0) 'damage_event_code = ',damage_event_code + write(fates_log(),fmt0) 'damage_canopy_layer_code = ', damage_canopy_layer_code write(fates_log(),*) '------------------------------------------------------' end if diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 8f367f78de..2e4a13a309 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -22,7 +22,6 @@ module EDTypesMod use FatesRunningMeanMod, only : rmean_type use FatesInterfaceTypesMod,only : bc_in_type use FatesInterfaceTypesMod,only : bc_out_type - use FatesInterfaceTypesMod,only : hlm_use_canopy_damage, hlm_use_understory_damage implicit none private ! By default everything is private diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 0ce2ee34c9..f9dd8f0621 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -38,8 +38,7 @@ Module FatesHistoryInterfaceMod use FatesInterfaceTypesMod , only : hlm_use_planthydro use FatesInterfaceTypesMod , only : hlm_use_ed_st3 use FatesInterfaceTypesMod , only : hlm_use_cohort_age_tracking - use FatesInterfaceTypesMod , only : hlm_use_canopy_damage - use FatesInterfaceTypesMod , only : hlm_use_understory_damage + use FatesInterfaceTypesMod , only : hlm_use_crown_damage use FatesInterfaceTypesMod , only : numpft use FatesInterfaceTypesMod , only : hlm_freq_day use FatesInterfaceTypesMod , only : hlm_parteh_mode @@ -2208,7 +2207,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) end do ! damage variables - site level - this needs to be OUT of the patch loop - if(hlm_use_canopy_damage .eq. itrue .or. hlm_use_understory_damage .eq. itrue) then + if(hlm_use_crown_damage .eq. itrue) then this%hvars(ih_crownarea_canopy_damage_si)%r81d(io_si) = & this%hvars(ih_crownarea_canopy_damage_si)%r81d(io_si) + & @@ -2741,7 +2740,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) end if ! damage variables - cohort level - if(hlm_use_canopy_damage .eq. itrue .or. hlm_use_understory_damage .eq. itrue) then + if(hlm_use_crown_damage .eq. itrue) then cdpf = get_cdamagesizepft_class_index(ccohort%dbh, ccohort%crowndamage, ccohort%pft) @@ -2891,7 +2890,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) ! damage variables - canopy - if(hlm_use_canopy_damage .eq. itrue .or. hlm_use_understory_damage .eq. itrue) then + if(hlm_use_crown_damage .eq. itrue) then ! carbon starvation mortality in the canopy by size x damage x pft this%hvars(ih_m3_mortality_canopy_si_cdpf)%r82d(io_si,cdpf) = & @@ -3023,7 +3022,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) ! damage variables - understory - if(hlm_use_canopy_damage .eq. itrue .or. hlm_use_understory_damage .eq. itrue) then + if(hlm_use_crown_damage .eq. itrue) then ! carbon mortality in the understory by damage x size x pft this%hvars(ih_m3_mortality_understory_si_cdpf)%r82d(io_si,cdpf) = & @@ -3300,8 +3299,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) end do end do - if(hlm_use_canopy_damage .eq. itrue .or. & - hlm_use_understory_damage .eq. itrue ) then + if(hlm_use_crown_damage .eq. itrue) then do i_pft = 1, numpft do icdam = 1, nlevdamage @@ -3384,7 +3382,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_m9_si_scpf(io_si,i_scpf) + & hio_m10_si_scpf(io_si,i_scpf) - if(hlm_use_canopy_damage .eq. itrue .or. hlm_use_understory_damage .eq. itrue) then + if(hlm_use_crown_damage .eq. itrue) then hio_mortality_si_pft(io_si, i_pft) = hio_mortality_si_pft(io_si,i_pft) + & this%hvars(ih_m11_si_scpf)%r82d(io_si,i_scpf) end if @@ -6842,7 +6840,7 @@ subroutine define_history_vars(this, initialize_variables) index = ih_resp_m_understory_si_scls) ! CROWN DAMAGE VARIABLES - if(hlm_use_canopy_damage .eq. itrue .or. hlm_use_understory_damage .eq. itrue) then + if(hlm_use_crown_damage .eq. itrue) then call this%set_history_var(vname='FATES_CROWNAREA_CANOPY_CD', units = 'm2 m-2 yr-1', & long='crownarea lost to damage each year', use_default='inactive', & diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 64a8d54a91..8a729c6bef 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -778,8 +778,7 @@ subroutine SetFatesGlobalElements(use_fates) ! These values are used to define the restart file allocations and general structure ! of memory for the cohort arrays - if ( hlm_use_cohort_age_tracking .eq. itrue .or. & - hlm_use_canopy_damage .eq. itrue .or. hlm_use_understory_damage .eq. itrue) then + if ( hlm_use_cohort_age_tracking .eq. itrue .or. hlm_use_crown_damage .eq. itrue) then maxCohortsPerPatch = 300 else maxCohortsPerPatch = 100 @@ -1331,8 +1330,7 @@ subroutine set_fates_ctrlparms(tag,ival,rval,cval) hlm_use_lu_harvest = unset_int hlm_num_lu_harvest_cats = unset_int hlm_use_cohort_age_tracking = unset_int - hlm_use_understory_damage = unset_int - hlm_use_canopy_damage = unset_int + hlm_use_crown_damage = unset_int hlm_use_logging = unset_int hlm_use_ed_st3 = unset_int hlm_use_ed_prescribed_phys = unset_int @@ -1645,16 +1643,9 @@ subroutine set_fates_ctrlparms(tag,ival,rval,cval) call endrun(msg=errMsg(sourcefile, __LINE__)) end if - if(hlm_use_understory_damage .eq. unset_int) then + if(hlm_use_crown_damage .eq. unset_int) then if (fates_global_verbose()) then - write(fates_log(), *) 'switch for understory damage unset: hlm_use_understory_damage, exiting' - end if - call endrun(msg=errMsg(sourcefile, __LINE__)) - end if - - if(hlm_use_canopy_damage .eq. unset_int) then - if (fates_global_verbose()) then - write(fates_log(), *) 'switch for canopy damage unset: hlm_use_canopy_damage, exiting' + write(fates_log(), *) 'switch for crown damage unset: hlm_use_crown_damage, exiting' end if call endrun(msg=errMsg(sourcefile, __LINE__)) end if @@ -1832,17 +1823,10 @@ subroutine set_fates_ctrlparms(tag,ival,rval,cval) write(fates_log(),*) 'Transfering hlm_use_cohort_age_tracking= ',ival,' to FATES' end if - case('use_understory_damage') - hlm_use_understory_damage = ival - if (fates_global_verbose()) then - write(fates_log(),*) 'Transfering hlm_use_understory_damage= ',ival,' to FATES' - end if - - case('use_canopy_damage') - hlm_use_canopy_damage = ival + case('use_crown_damage') + hlm_use_crown_damage = ival if (fates_global_verbose()) then - write(fates_log(),*) 'Transfering hlm_use_canopy_damage= ',ival,' to FATES' - write(fates_log(),*) 'JN FatesInterfaceMod hlm_use_canopy_damage : ', hlm_use_canopy_damage + write(fates_log(),*) 'Transfering hlm_use_crown_damage= ',ival,' to FATES' end if case('use_logging') diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 26d36f62fa..806dd386e7 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -151,11 +151,8 @@ module FatesInterfaceTypesMod ! cohort age tracking. 1 = TRUE, 0 = FALSE - integer, public :: hlm_use_canopy_damage ! This flag signals whether or not to use - ! the canopy damage module. 1 = TRUE, 0 = FALSE - - integer, public :: hlm_use_understory_damage ! This flag signals whether or not to use - ! understory damage. 1 = TRUE, 0 = FALSE + integer, public :: hlm_use_crown_damage ! This flag signals whether or not to use + ! the crown damage module. 1 = TRUE, 0 = FALSE integer, public :: hlm_use_ed_st3 ! This flag signals whether or not to use diff --git a/main/FatesRestartInterfaceMod.F90 b/main/FatesRestartInterfaceMod.F90 index 41bc8e58f0..d0b2ea3d5d 100644 --- a/main/FatesRestartInterfaceMod.F90 +++ b/main/FatesRestartInterfaceMod.F90 @@ -1786,8 +1786,7 @@ end subroutine set_restart_var subroutine set_restart_vectors(this,nc,nsites,sites) - use FatesInterfaceTypesMod, only : hlm_use_canopy_damage - use FatesInterfaceTypesMod, only : hlm_use_understory_damage + use FatesInterfaceTypesMod, only : hlm_use_crown_damage use FatesInterfaceTypesMod, only : fates_maxElementsPerPatch use FatesInterfaceTypesMod, only : numpft use EDTypesMod, only : ed_site_type @@ -2369,7 +2368,7 @@ subroutine set_restart_vectors(this,nc,nsites,sites) ! this only copies live portions of transitions - but that's ok because the mortality ! bit only needs to be added for history outputs - if(hlm_use_canopy_damage .eq. itrue .or. hlm_use_understory_damage .eq. itrue) then + if(hlm_use_crown_damage .eq. itrue) then do i_scls = 1, nlevsclass do i_cdam = 1, nlevdamage @@ -2694,9 +2693,8 @@ subroutine get_restart_vectors(this, nc, nsites, sites) use EDTypesMod, only : numWaterMem use EDTypesMod, only : num_vegtemp_mem use FatesSizeAgeTypeIndicesMod, only : get_age_class_index - use FatesInterfaceTypesMod, only : hlm_use_canopy_damage - use FatesInterfaceTypesMod, only : hlm_use_understory_damage - + use FatesInterfaceTypesMod, only : hlm_use_crown_damage + ! !ARGUMENTS: class(fates_restart_interface_type) , intent(inout) :: this @@ -3296,7 +3294,7 @@ subroutine get_restart_vectors(this, nc, nsites, sites) io_idx_si_sc = io_idx_si_sc + 1 end do - if (hlm_use_canopy_damage .eq. itrue .or. hlm_use_understory_damage .eq. itrue) then + if (hlm_use_crown_damage .eq. itrue) then do i_cdam = 1, nlevdamage do i_pft = 1, numpft do i_scls = 1, nlevsclass diff --git a/parameter_files/fates_params_default.cdl b/parameter_files/fates_params_default.cdl index 42b37dd27d..7c9fefaf8f 100644 --- a/parameter_files/fates_params_default.cdl +++ b/parameter_files/fates_params_default.cdl @@ -157,6 +157,9 @@ variables: double fates_branch_turnover(fates_pft) ; fates_branch_turnover:units = "yr" ; fates_branch_turnover:long_name = "turnover time of branches" ; + double fates_damage_canopy_layer_code ; + fates_damage_canopy_layer_code:units = "unitless" ; + fates_damage_canopy_layer_code:long_name = "Integer code that decides whether damage affects canopy trees (1), understory trees (2)" ; double fates_damage_event_code ; fates_damage_event_code:units = "unitless" ; fates_damage_event_code:long_name = "Integer code that options how damage events are structured" ; @@ -920,6 +923,8 @@ data: fates_damage_frac = 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01 ; + fates_damage_canopy_layer_code = 1 ; + fates_damage_event_code = 1 ; fates_damage_mort_p1 = 9.0,9.0,9.0,9.0,9.0,9.0,9.0,9.0,9.0,9.0,9.0,9.0 ; From ece0c714e7f2996dea4decd7cca178f74ea49762 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 26 May 2022 11:38:42 -0700 Subject: [PATCH 36/84] converting new procedures to CamelCase --- biogeochem/DamageMainMod.F90 | 50 +++++++++++----------- biogeochem/EDCohortDynamicsMod.F90 | 4 +- biogeochem/EDMortalityFunctionsMod.F90 | 4 +- biogeochem/EDPatchDynamicsMod.F90 | 24 +++++------ biogeochem/FatesAllometryMod.F90 | 18 ++++---- biogeophys/FatesPlantRespPhotosynthMod.F90 | 4 +- main/EDMainMod.F90 | 6 +-- main/FatesHistoryInterfaceMod.F90 | 2 +- parameter_files/fates_params_default.cdl | 2 +- 9 files changed, 57 insertions(+), 57 deletions(-) diff --git a/biogeochem/DamageMainMod.F90 b/biogeochem/DamageMainMod.F90 index 8e8748692f..1609edf64d 100644 --- a/biogeochem/DamageMainMod.F90 +++ b/biogeochem/DamageMainMod.F90 @@ -5,8 +5,8 @@ module DamageMainMod use FatesConstantsMod , only : itrue, ifalse use FatesConstantsMod , only : years_per_day use FatesGlobals , only : fates_log - use FatesGlobals , only : endrun => fates_endrun - use shr_log_mod , only : errMsg => shr_log_errMsg + use FatesGlobals , only : endrun => fates_endrun + use shr_log_mod , only : errMsg => shr_log_errMsg use EDPftvarcon , only : EDPftvarcon_inst use EDParamsMod , only : damage_event_code use EDtypesMod , only : ed_site_type @@ -34,16 +34,16 @@ module DamageMainMod implicit none private - logical, protected :: damage_time ! if true then damage occurs during current time step + logical, protected :: DamageTime ! if true then damage occurs during current time step character(len=*), parameter, private :: sourcefile = & __FILE__ - public :: get_crown_reduction - public :: get_damage_frac - public :: is_it_damage_time - public :: damage_time - public :: get_damage_mortality + public :: GetCrownReduction + public :: GetDamageFrac + public :: IsItDamageTime + public :: DamageTime + public :: GetDamageMortality logical :: debug = .false. ! for debugging @@ -53,7 +53,7 @@ module DamageMainMod contains - subroutine is_it_damage_time(is_master, currentSite) + subroutine IsItDamageTime(is_master, currentSite) !---------------------------------------------------------------------------- ! This subroutine determines whether damage should occur (it is called daily) @@ -72,36 +72,36 @@ subroutine is_it_damage_time(is_master, currentSite) character(len=64) :: fmt = '(a,i2.2,a,i2.2,a,i4.4)' - damage_time = .false. + DamageTime = .false. icode = int(damage_event_code) model_day_int = nint(hlm_model_day) if(icode .eq. 1) then ! Damage is turned off - damage_time = .false. + DamageTime = .false. else if(icode .eq. 2) then ! Damage event on first time step if(model_day_int .eq.1) then - damage_time = .true. + DamageTime = .true. end if else if(icode .eq. 3) then ! Damage event every day - not sure this is recommended as it will result in a very large ! number of cohorts - damage_time = .true. + DamageTime = .true. else if(icode .eq. 4) then ! Damage event once a month if(hlm_current_day.eq.1 ) then - damage_time = .true. + DamageTime = .true. end if else if(icode < 0 .and. icode > -366) then ! Damage event every year on a specific day of the year if(hlm_day_of_year .eq. abs(icode) ) then - damage_time = .true. + DamageTime = .true. end if else if(icode > 10000 ) then @@ -113,31 +113,31 @@ subroutine is_it_damage_time(is_master, currentSite) if(hlm_current_day .eq. damage_date .and. & hlm_current_month .eq. damage_month .and. & hlm_current_year .eq. damage_year ) then - damage_time = .true. + DamageTime = .true. end if else ! Bad damage event flag write(fates_log(),*) 'An invalid damage code was specified in fates_params' - write(fates_log(),*) 'Check DamageMainMod.F90:is_it_damage_time()' + write(fates_log(),*) 'Check DamageMainMod.F90:IsItDamageTime()' write(fates_log(),*) 'for a breakdown of the valide codes and change' write(fates_log(),*) 'fates_damage_event_code in the file accordingly.' write(fates_log(),*) 'exiting' call endrun(msg=errMsg(sourcefile, __LINE__)) end if - if(damage_time .and. (is_master.eq.itrue) ) then + if(DamageTime .and. (is_master.eq.itrue) ) then write(fates_log(),fmt) 'Damage Event Enacted on date: ', & hlm_current_month,'-', hlm_current_day,'-',hlm_current_year end if return - end subroutine is_it_damage_time + end subroutine IsItDamageTime !---------------------------------------------------------------------------- - subroutine get_damage_frac(cc_cd, nc_cd, pft, dist_frac) + subroutine GetDamageFrac(cc_cd, nc_cd, pft, dist_frac) ! given current cohort damage class find the fraction of individuals @@ -160,11 +160,11 @@ subroutine get_damage_frac(cc_cd, nc_cd, pft, dist_frac) ! (if damage is occuring annually don't do this) - end subroutine get_damage_frac + end subroutine GetDamageFrac !------------------------------------------------------- - subroutine get_crown_reduction(crowndamage, crown_reduction) + subroutine GetCrownReduction(crowndamage, crown_reduction) !------------------------------------------------------------------ ! This function takes the crown damage class of a cohort (integer) @@ -185,13 +185,13 @@ subroutine get_crown_reduction(crowndamage, crown_reduction) crown_reduction = min(1.0_r8, (real(crowndamage) - 1.0_r8) * class_width) return - end subroutine get_crown_reduction + end subroutine GetCrownReduction !---------------------------------------------------------------------------------------- - subroutine get_damage_mortality(crowndamage,pft, dgmort) + subroutine GetDamageMortality(crowndamage,pft, dgmort) use FatesInterfaceTypesMod , only : nlevdamage use EDPftvarcon , only : EDPftvarcon_inst @@ -226,7 +226,7 @@ subroutine get_damage_mortality(crowndamage,pft, dgmort) end if return - end subroutine get_damage_mortality + end subroutine GetDamageMortality !---------------------------------------------------------------------------------------- diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index 519b47e3bb..03ee146b3f 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -1081,7 +1081,7 @@ subroutine fuse_cohorts(currentSite, currentPatch, bc_in) use FatesConstantsMod , only : itrue use FatesConstantsMod, only : days_per_year use EDTypesMod , only : maxCohortsPerPatch - use DamageMainMod, only : get_crown_reduction + use DamageMainMod, only : GetCrownReduction ! ! !ARGUMENTS type (ed_site_type), intent(inout), target :: currentSite @@ -2084,7 +2084,7 @@ subroutine EvaluateAndCorrectDBH(currentCohort,delta_dbh,delta_hite) ! consistent with stuctural biomass (or, in the case of grasses, leaf biomass) ! then correct (increase) the dbh to match that. ! ----------------------------------------------------------------------------------- - use DamageMainMod, only : get_crown_reduction + use DamageMainMod, only : GetCrownReduction ! argument type(ed_cohort_type),intent(inout) :: currentCohort diff --git a/biogeochem/EDMortalityFunctionsMod.F90 b/biogeochem/EDMortalityFunctionsMod.F90 index 69c7d5070a..13082cf910 100644 --- a/biogeochem/EDMortalityFunctionsMod.F90 +++ b/biogeochem/EDMortalityFunctionsMod.F90 @@ -59,7 +59,7 @@ subroutine mortality_rates( cohort_in,bc_in,cmort,hmort,bmort,frmort,smort,asmor use FatesConstantsMod, only : tfrz => t_water_freeze_k_1atm use FatesInterfaceTypesMod , only : hlm_hio_ignore_val use FatesConstantsMod, only : fates_check_param_set - use DamageMainMod, only : get_damage_mortality + use DamageMainMod, only : GetDamageMortality type (ed_cohort_type), intent(in) :: cohort_in type (bc_in_type), intent(in) :: bc_in @@ -123,7 +123,7 @@ subroutine mortality_rates( cohort_in,bc_in,cmort,hmort,bmort,frmort,smort,asmor ! Damage dependent mortality if (hlm_use_crown_damage .eq. itrue) then - call get_damage_mortality(cohort_in%crowndamage, cohort_in%pft, dgmort) + call GetDamageMortality(cohort_in%crowndamage, cohort_in%pft, dgmort) else dgmort = 0.0_r8 end if diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index da1b48cb2a..6fc1281434 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -62,7 +62,7 @@ module EDPatchDynamicsMod use EDLoggingMortalityMod, only : logging_time use EDLoggingMortalityMod, only : get_harvest_rate_area use EDParamsMod , only : fates_mortality_disturbance_fraction - use DamageMainMod , only : damage_time + use DamageMainMod , only : DamageTime use FatesAllometryMod , only : carea_allom use FatesAllometryMod , only : set_root_fraction use FatesConstantsMod , only : g_per_kg @@ -469,8 +469,8 @@ subroutine spawn_patches( currentSite, bc_in) use EDParamsMod , only : ED_val_understorey_death, logging_coll_under_frac use EDCohortDynamicsMod , only : zero_cohort, copy_cohort, terminate_cohorts use FatesConstantsMod , only : rsnbl_math_prec - use DamageMainMod , only : get_crown_reduction - use DamageMainMod , only : get_damage_frac + use DamageMainMod , only : GetCrownReduction + use DamageMainMod , only : GetDamageFrac use PRTLossFluxesMod , only : PRTDamageLosses use PRTGenericMod , only : leaf_organ use ChecksBalancesMod , only : SiteMassStock @@ -766,7 +766,7 @@ subroutine spawn_patches( currentSite, bc_in) ! and the damaged trees if(hlm_use_crown_damage .eq. itrue) then - if( damage_time ) then + if( DamageTime ) then call damage_litter_fluxes(currentSite, currentPatch, & new_patch, patch_site_areadis, patch_damage_litter) @@ -1259,7 +1259,7 @@ subroutine spawn_patches( currentSite, bc_in) ! Regardless of disturbance type, reduce mass of damaged trees if(hlm_use_crown_damage .eq. itrue) then - if(damage_time) then + if(DamageTime) then ! if woody if (prt_params%woody(currentCohort%pft)==1 ) then @@ -1272,7 +1272,7 @@ subroutine spawn_patches( currentSite, bc_in) ! for each damage class find the number density and if big enough allocate a new cohort do cd = currentCohort%crowndamage+1, nlevdamage - call get_damage_frac(currentCohort%crowndamage, cd, currentCohort%pft, cd_frac) + call GetDamageFrac(currentCohort%crowndamage, cd, currentCohort%pft, cd_frac) if(i_damage_code .eq. 1 .and. currentCohort%canopy_layer == 1) then cd_n = currentCohort%n * cd_frac @@ -1315,7 +1315,7 @@ subroutine spawn_patches( currentSite, bc_in) call carea_allom(nc_d%dbh, nc_d%n, currentSite%spread,& nc_d%pft, nc_d%crowndamage, nc_d%c_area) - call get_crown_reduction(nc_d%crowndamage, mass_frac) + call GetCrownReduction(nc_d%crowndamage, mass_frac) leaf_m_pre = nc_d%prt%GetState(leaf_organ, all_carbon_elements) + & @@ -1560,7 +1560,7 @@ subroutine spawn_patches( currentSite, bc_in) call endrun(msg=errMsg(sourcefile, __LINE__)) end if - if (damage_time) then + if (DamageTime) then write(fates_log(),*) 'Damage to litter: ',total_litter_d @@ -2383,8 +2383,8 @@ subroutine damage_litter_fluxes(currentSite, currentPatch, newPatch,patch_site_a ! !DESCRIPTION: ! ! !USES: - use DamageMainMod, only : get_crown_reduction - use DamageMainMod , only : get_damage_frac + use DamageMainMod, only : GetCrownReduction + use DamageMainMod , only : GetDamageFrac use SFParamsMod , only : SF_val_cwd_frac use FatesInterfaceTypesMod , only : nlevdamage use EDParamsMod , only : ED_val_understorey_death @@ -2528,7 +2528,7 @@ subroutine damage_litter_fluxes(currentSite, currentPatch, newPatch,patch_site_a do cd = currentCohort%crowndamage+1, nlevdamage - call get_damage_frac(currentCohort%crowndamage, cd, currentCohort%pft, cd_frac) + call GetDamageFrac(currentCohort%crowndamage, cd, currentCohort%pft, cd_frac) ! now to get the number of damaged trees we multiply by damage frac num_trees_cd = num_trees * cd_frac @@ -2538,7 +2538,7 @@ subroutine damage_litter_fluxes(currentSite, currentPatch, newPatch,patch_site_a ! if non negligable get litter if (num_trees_cd > nearzero ) then - call get_crown_reduction(cd, crown_reduction) + call GetCrownReduction(cd, crown_reduction) ! leaf loss in kg diff --git a/biogeochem/FatesAllometryMod.F90 b/biogeochem/FatesAllometryMod.F90 index 446312571d..7574950860 100644 --- a/biogeochem/FatesAllometryMod.F90 +++ b/biogeochem/FatesAllometryMod.F90 @@ -98,7 +98,7 @@ module FatesAllometryMod use FatesGlobals , only : FatesWarn,N2S,A2S,I2S use EDTypesMod , only : nlevleaf, dinc_vai use EDTypesMod , only : nclmax - use DamageMainMod , only : get_crown_reduction + use DamageMainMod , only : GetCrownReduction implicit none @@ -365,7 +365,7 @@ end subroutine h_allom subroutine bagw_allom(d,ipft,crowndamage, bagw,dbagwdd) - use DamageMainMod, only : get_crown_reduction + use DamageMainMod, only : GetCrownReduction use FatesParameterDerivedMod, only : param_derived real(r8),intent(in) :: d ! plant diameter [cm] @@ -407,7 +407,7 @@ subroutine bagw_allom(d,ipft,crowndamage, bagw,dbagwdd) end select if(crowndamage > 1) then - call get_crown_reduction(crowndamage, crown_reduction) + call GetCrownReduction(crowndamage, crown_reduction) bagw = bagw - (bagw * branch_frac * crown_reduction) if(present(dbagwdd))then dbagwdd = dbagwdd - (dbagwdd * branch_frac * crown_reduction) @@ -546,7 +546,7 @@ subroutine bleaf(d,ipft,crowndamage,canopy_trim,bl,dbldd) ! this routine is not name-spaced with allom_ ! ------------------------------------------------------------------------- - use DamageMainMod , only : get_crown_reduction + use DamageMainMod , only : GetCrownReduction real(r8),intent(in) :: d ! plant diameter [cm] integer(i4),intent(in) :: ipft ! PFT index @@ -577,7 +577,7 @@ subroutine bleaf(d,ipft,crowndamage,canopy_trim,bl,dbldd) if ( crowndamage > 1 ) then - call get_crown_reduction(crowndamage, crown_reduction) + call GetCrownReduction(crowndamage, crown_reduction) bl = bl * (1.0_r8 - crown_reduction) if(present(dbldd))then dbldd = dblmaxdd * canopy_trim * (1.0_r8 - crown_reduction) @@ -896,7 +896,7 @@ end function leafc_from_treelai subroutine bsap_allom(d,ipft,crowndamage,canopy_trim,sapw_area,bsap,dbsapdd) - use DamageMainMod , only : get_crown_reduction + use DamageMainMod , only : GetCrownReduction use FatesParameterDerivedMod, only : param_derived real(r8),intent(in) :: d ! plant diameter [cm] @@ -949,7 +949,7 @@ subroutine bsap_allom(d,ipft,crowndamage,canopy_trim,sapw_area,bsap,dbsapdd) ! fraction of biomass that would be in branches (pft specific) if(crowndamage > 1)then - call get_crown_reduction(crowndamage, crown_reduction) + call GetCrownReduction(crowndamage, crown_reduction) bsap = bsap - (bsap * agb_frac * branch_frac * crown_reduction) if(present(dbsapdd))then dbsapdd = dbsapdd - (dbsapdd * agb_frac * branch_frac * crown_reduction) @@ -2128,13 +2128,13 @@ subroutine carea_2pwr(dbh,spread,d2bl_p2,d2bl_ediff,d2ca_min,d2ca_max,c_area,inv c_area = spreadterm * dbh ** crown_area_to_dbh_exponent if(crowndamage > 1) then - call get_crown_reduction(crowndamage, crown_reduction) + call GetCrownReduction(crowndamage, crown_reduction) c_area = c_area * (1.0_r8 - crown_reduction) end if else if(crowndamage > 1) then - call get_crown_reduction(crowndamage, crown_reduction) + call GetCrownReduction(crowndamage, crown_reduction) c_area = c_area/(1.0_r8 - crown_reduction) end if dbh = (c_area / spreadterm) ** (1./crown_area_to_dbh_exponent) diff --git a/biogeophys/FatesPlantRespPhotosynthMod.F90 b/biogeophys/FatesPlantRespPhotosynthMod.F90 index 843866878d..27613cf355 100644 --- a/biogeophys/FatesPlantRespPhotosynthMod.F90 +++ b/biogeophys/FatesPlantRespPhotosynthMod.F90 @@ -139,7 +139,7 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) use FatesAllometryMod, only : set_root_fraction use FatesAllometryMod, only : decay_coeff_kn - use DamageMainMod, only : get_crown_reduction + use DamageMainMod, only : GetCrownReduction use FatesInterfaceTypesMod, only : hlm_use_crown_damage @@ -659,7 +659,7 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) agb_frac = prt_params%allom_agb_frac(currentCohort%pft) branch_frac = param_derived%branch_frac(currentCohort%pft) - call get_crown_reduction(currentCohort%crowndamage, crown_reduction) + call GetCrownReduction(currentCohort%crowndamage, crown_reduction) ! need the undamaged version if using ratios with roots sapw_c = sapw_c / & diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index d083f7fd1c..6bde3c2af7 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -81,7 +81,7 @@ module EDMainMod use FatesPlantHydraulicsMod , only : AccumulateMortalityWaterStorage use FatesAllometryMod , only : h_allom,tree_sai,tree_lai use EDLoggingMortalityMod , only : IsItLoggingTime - use DamageMainMod , only : is_it_damage_time + use DamageMainMod , only : IsItDamageTime use EDPatchDynamicsMod , only : get_frac_site_primary use FatesGlobals , only : endrun => fates_endrun use ChecksBalancesMod , only : SiteMassStock @@ -171,7 +171,7 @@ subroutine ed_ecosystem_dynamics(currentSite, bc_in, bc_out) call IsItLoggingTime(hlm_masterproc,currentSite) ! Call a routine that identifies if damage should occur - call is_it_damage_time(hlm_masterproc, currentSite) + call IsItDamageTime(hlm_masterproc, currentSite) !************************************************************************** ! Fire, growth, biogeochemistry. @@ -320,7 +320,7 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) use FatesInterfaceTypesMod, only : hlm_use_cohort_age_tracking use FatesConstantsMod, only : itrue use PRTGenericMod , only : all_carbon_elements - use DamageMainMod , only : damage_time + use DamageMainMod , only : DamageTime use EDCohortDynamicsMod , only : zero_cohort, copy_cohort, insert_cohort use EDCohortDynamicsMod , only : DeallocateCohort use FatesPlantHydraulicsMod, only : InitHydrCohort diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index c590dac7b6..deb4571b92 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -1839,7 +1839,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) use EDTypesMod , only : nlevleaf use EDParamsMod, only : ED_val_history_height_bin_edges use FatesInterfaceTypesMod, only : nlevdamage - use DamageMainMod , only : damage_time + use DamageMainMod , only : DamageTime ! Arguments class(fates_history_interface_type) :: this diff --git a/parameter_files/fates_params_default.cdl b/parameter_files/fates_params_default.cdl index fba1e186e6..c33d9683b3 100644 --- a/parameter_files/fates_params_default.cdl +++ b/parameter_files/fates_params_default.cdl @@ -165,7 +165,7 @@ variables: fates_damage_event_code:long_name = "Integer code that options how damage events are structured" ; double fates_damage_frac(fates_pft) ; fates_damage_frac:units = "fraction"; - fates_damage_frac:long_name = "fraction of cohort damaged in each damage event (event frequency specified in the is_it_damage_time subroutine)"; + fates_damage_frac:long_name = "fraction of cohort damaged in each damage event (event frequency specified in the IsItDamageTime subroutine)"; double fates_damage_mort_p1(fates_pft) ; fates_damage_mort_p1:units = "fraction crown loss - a value of 0.8 means 50% mortality with 80% loss of crown"; fates_damage_mort_p1:long_name = "inflection point of damage mortality function - to turn off damage mortality set this to a large number" ; From f73d65d2dde128a99bb925d8dde63bae45653ca9 Mon Sep 17 00:00:00 2001 From: Jessica Needham Date: Thu, 26 May 2022 13:04:49 -0700 Subject: [PATCH 37/84] [ change damage bin edges ] [ remove upper bin edge of 100 ] Fixes: [NGT-ED Github issue #] User interface changes?: [Yes (describe what changes), No] Code review: [Names] Test suite: [suite name, machine, compilers] Test baseline: Test namelist changes: Test answer changes: [bit for bit, roundoff, climate changing] Test summary: no testing --- main/FatesInterfaceMod.F90 | 2 +- parameter_files/fates_params_default.cdl | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 8a729c6bef..f33fa0c6a2 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -834,7 +834,7 @@ subroutine SetFatesGlobalElements(use_fates) nlevage = size(ED_val_history_ageclass_bin_edges,dim=1) nlevheight = size(ED_val_history_height_bin_edges,dim=1) nlevcoage = size(ED_val_history_coageclass_bin_edges,dim=1) - nlevdamage = size(ED_val_history_damage_bin_edges, dim=1) - 1 + nlevdamage = size(ED_val_history_damage_bin_edges, dim=1) ! do some checks on the size, age, and height bin arrays to make sure they make sense: ! make sure that all start at zero, and that both are monotonically increasing diff --git a/parameter_files/fates_params_default.cdl b/parameter_files/fates_params_default.cdl index 7c9fefaf8f..161842b1b3 100644 --- a/parameter_files/fates_params_default.cdl +++ b/parameter_files/fates_params_default.cdl @@ -5,7 +5,7 @@ dimensions: fates_history_height_bins = 6 ; fates_history_size_bins = 13 ; fates_history_coage_bins = 2 ; - fates_history_damage_bins = 6 ; + fates_history_damage_bins = 2 ; fates_hydr_organs = 4 ; fates_leafage_class = 1 ; fates_litterclass = 6 ; @@ -786,7 +786,7 @@ data: fates_history_coageclass_bin_edges = 0, 5 ; - fates_history_damage_bin_edges = 0, 20, 40, 60, 80, 100 ; + fates_history_damage_bin_edges = 0, 80 ; fates_history_height_bin_edges = 0, 0.1, 0.3, 1, 3, 10 ; From 59d43572177341cbbf48f5779316338d3aa017a5 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 26 May 2022 13:48:27 -0700 Subject: [PATCH 38/84] converting logical from CamelCase back to original format --- biogeochem/DamageMainMod.F90 | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/biogeochem/DamageMainMod.F90 b/biogeochem/DamageMainMod.F90 index 1609edf64d..6ab8bcb66d 100644 --- a/biogeochem/DamageMainMod.F90 +++ b/biogeochem/DamageMainMod.F90 @@ -34,7 +34,7 @@ module DamageMainMod implicit none private - logical, protected :: DamageTime ! if true then damage occurs during current time step + logical, protected :: damage_time ! if true then damage occurs during current time step character(len=*), parameter, private :: sourcefile = & __FILE__ @@ -42,7 +42,7 @@ module DamageMainMod public :: GetCrownReduction public :: GetDamageFrac public :: IsItDamageTime - public :: DamageTime + public :: damage_time public :: GetDamageMortality logical :: debug = .false. ! for debugging @@ -72,36 +72,36 @@ subroutine IsItDamageTime(is_master, currentSite) character(len=64) :: fmt = '(a,i2.2,a,i2.2,a,i4.4)' - DamageTime = .false. + damage_time = .false. icode = int(damage_event_code) model_day_int = nint(hlm_model_day) if(icode .eq. 1) then ! Damage is turned off - DamageTime = .false. + damage_time = .false. else if(icode .eq. 2) then ! Damage event on first time step if(model_day_int .eq.1) then - DamageTime = .true. + damage_time = .true. end if else if(icode .eq. 3) then ! Damage event every day - not sure this is recommended as it will result in a very large ! number of cohorts - DamageTime = .true. + damage_time = .true. else if(icode .eq. 4) then ! Damage event once a month if(hlm_current_day.eq.1 ) then - DamageTime = .true. + damage_time = .true. end if else if(icode < 0 .and. icode > -366) then ! Damage event every year on a specific day of the year if(hlm_day_of_year .eq. abs(icode) ) then - DamageTime = .true. + damage_time = .true. end if else if(icode > 10000 ) then @@ -113,7 +113,7 @@ subroutine IsItDamageTime(is_master, currentSite) if(hlm_current_day .eq. damage_date .and. & hlm_current_month .eq. damage_month .and. & hlm_current_year .eq. damage_year ) then - DamageTime = .true. + damage_time = .true. end if else From 657ba0ab3ed4a5f2f5662c4593cae31dc9d14a1d Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 26 May 2022 13:51:33 -0700 Subject: [PATCH 39/84] adding target_c_area local to UpdateCohortLAI --- biogeochem/EDCanopyStructureMod.F90 | 4 ++-- biogeochem/EDCohortDynamicsMod.F90 | 1 - 2 files changed, 2 insertions(+), 3 deletions(-) diff --git a/biogeochem/EDCanopyStructureMod.F90 b/biogeochem/EDCanopyStructureMod.F90 index ec2a1a628e..e4a84db206 100644 --- a/biogeochem/EDCanopyStructureMod.F90 +++ b/biogeochem/EDCanopyStructureMod.F90 @@ -1886,7 +1886,6 @@ subroutine update_hlm_dynamics(nsites,sites,fcolumn,bc_out) real(r8) :: total_canopy_area real(r8) :: total_patch_leaf_stem_area real(r8) :: weight ! Weighting for cohort variables in patch - real(r8) :: target_c_area do s = 1,nsites @@ -2249,7 +2248,8 @@ subroutine UpdateCohortLAI(currentCohort, canopy_layer_tlai, patcharea) ! Local variables real(r8) :: leaf_c ! leaf carbon [kg] - + real(r8) :: target_c_area + ! Obtain the leaf carbon leaf_c = currentCohort%prt%GetState(leaf_organ,all_carbon_elements) diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index 03ee146b3f..78328e2bdc 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -1111,7 +1111,6 @@ subroutine fuse_cohorts(currentSite, currentPatch, bc_in) real(r8) :: dynamic_age_fusion_tolerance real(r8) :: dbh real(r8) :: leaf_c ! leaf carbon [kg] - real(r8) :: target_c_area integer :: largersc, smallersc, sc_i ! indices for tracking the growth flux caused by fusion real(r8) :: larger_n, smaller_n From cc2d5f88fb86c7631703e1b2218e19acc6170f41 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Fri, 27 May 2022 15:19:57 -0700 Subject: [PATCH 40/84] fixing erroneous damage_time name changes --- biogeochem/DamageMainMod.F90 | 2 +- biogeochem/EDPatchDynamicsMod.F90 | 8 ++++---- main/EDMainMod.F90 | 1 - main/FatesHistoryInterfaceMod.F90 | 1 - 4 files changed, 5 insertions(+), 7 deletions(-) diff --git a/biogeochem/DamageMainMod.F90 b/biogeochem/DamageMainMod.F90 index 6ab8bcb66d..2d0a94dc06 100644 --- a/biogeochem/DamageMainMod.F90 +++ b/biogeochem/DamageMainMod.F90 @@ -126,7 +126,7 @@ subroutine IsItDamageTime(is_master, currentSite) call endrun(msg=errMsg(sourcefile, __LINE__)) end if - if(DamageTime .and. (is_master.eq.itrue) ) then + if(damage_time .and. (is_master.eq.itrue) ) then write(fates_log(),fmt) 'Damage Event Enacted on date: ', & hlm_current_month,'-', hlm_current_day,'-',hlm_current_year end if diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 6fc1281434..5fca8b5d11 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -62,7 +62,7 @@ module EDPatchDynamicsMod use EDLoggingMortalityMod, only : logging_time use EDLoggingMortalityMod, only : get_harvest_rate_area use EDParamsMod , only : fates_mortality_disturbance_fraction - use DamageMainMod , only : DamageTime + use DamageMainMod , only : damage_time use FatesAllometryMod , only : carea_allom use FatesAllometryMod , only : set_root_fraction use FatesConstantsMod , only : g_per_kg @@ -766,7 +766,7 @@ subroutine spawn_patches( currentSite, bc_in) ! and the damaged trees if(hlm_use_crown_damage .eq. itrue) then - if( DamageTime ) then + if(damage_time) then call damage_litter_fluxes(currentSite, currentPatch, & new_patch, patch_site_areadis, patch_damage_litter) @@ -1259,7 +1259,7 @@ subroutine spawn_patches( currentSite, bc_in) ! Regardless of disturbance type, reduce mass of damaged trees if(hlm_use_crown_damage .eq. itrue) then - if(DamageTime) then + if(damage_time) then ! if woody if (prt_params%woody(currentCohort%pft)==1 ) then @@ -1560,7 +1560,7 @@ subroutine spawn_patches( currentSite, bc_in) call endrun(msg=errMsg(sourcefile, __LINE__)) end if - if (DamageTime) then + if (damage_time) then write(fates_log(),*) 'Damage to litter: ',total_litter_d diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index 6bde3c2af7..06b4a3593d 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -320,7 +320,6 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) use FatesInterfaceTypesMod, only : hlm_use_cohort_age_tracking use FatesConstantsMod, only : itrue use PRTGenericMod , only : all_carbon_elements - use DamageMainMod , only : DamageTime use EDCohortDynamicsMod , only : zero_cohort, copy_cohort, insert_cohort use EDCohortDynamicsMod , only : DeallocateCohort use FatesPlantHydraulicsMod, only : InitHydrCohort diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index deb4571b92..3c76123408 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -1839,7 +1839,6 @@ subroutine update_history_dyn(this,nc,nsites,sites) use EDTypesMod , only : nlevleaf use EDParamsMod, only : ED_val_history_height_bin_edges use FatesInterfaceTypesMod, only : nlevdamage - use DamageMainMod , only : DamageTime ! Arguments class(fates_history_interface_type) :: this From 6b21b533ef9bee1942658d14a6a437b6afd1fb35 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Fri, 27 May 2022 15:26:35 -0700 Subject: [PATCH 41/84] fixing bad merge --- biogeochem/EDMortalityFunctionsMod.F90 | 13 +------------ 1 file changed, 1 insertion(+), 12 deletions(-) diff --git a/biogeochem/EDMortalityFunctionsMod.F90 b/biogeochem/EDMortalityFunctionsMod.F90 index 13082cf910..a7df37e5df 100644 --- a/biogeochem/EDMortalityFunctionsMod.F90 +++ b/biogeochem/EDMortalityFunctionsMod.F90 @@ -178,6 +178,7 @@ subroutine mortality_rates( cohort_in,bc_in,cmort,hmort,bmort,frmort,smort,asmor else write(fates_log(),*) 'dbh problem in mortality_rates', & cohort_in%dbh,cohort_in%pft,cohort_in%n,cohort_in%canopy_layer + call endrun(msg=errMsg(sourcefile, __LINE__)) endif !-------------------------------------------------------------------------------- ! Mortality due to cold and freezing stress (frmort), based on ED2 and: @@ -186,18 +187,6 @@ subroutine mortality_rates( cohort_in,bc_in,cmort,hmort,bmort,frmort,smort,asmor ! Eastern US carbon sink. Glob. Change Biol., 12, 2370-2390, ! doi: 10.1111/j.1365-2486.2006.01254.x - else - write(fates_log(),*) 'dbh problem in mortality_rates', & - cohort_in%dbh,cohort_in%pft,cohort_in%n,cohort_in%canopy_layer - call endrun(msg=errMsg(sourcefile, __LINE__)) - endif - !-------------------------------------------------------------------------------- - ! Mortality due to cold and freezing stress (frmort), based on ED2 and: - ! Albani, M.; D. Medvigy; G. C. Hurtt; P. R. Moorcroft, 2006: The contributions - ! of land-use change, CO2 fertilization, and climate variability to the - ! Eastern US carbon sink. Glob. Change Biol., 12, 2370-2390, - ! doi: 10.1111/j.1365-2486.2006.01254.x - temp_in_C = cohort_in%patchptr%tveg24%GetMean() - tfrz temp_dep_fraction = max(0.0_r8, min(1.0_r8, 1.0_r8 - (temp_in_C - & From a76d62f91edcffdcfa0bd3f57c4ed263a4da3ad5 Mon Sep 17 00:00:00 2001 From: Jessica Needham Date: Fri, 27 May 2022 15:28:42 -0700 Subject: [PATCH 42/84] [ update UpdateCohortLAI to accommodate extra arguments needed for damage ] [ site%spread needed in calculating target_carea for trees that are damaged ] Fixes: [NGT-ED Github issue #] User interface changes?: [Yes (describe what changes), No] Code review: [Names] Test suite: [suite name, machine, compilers] Test baseline: Test namelist changes: Test answer changes: [bit for bit, roundoff, climate changing] Test summary:no testing --- biogeochem/DamageMainMod.F90 | 2 +- biogeochem/EDCanopyStructureMod.F90 | 24 ++++++++++++++---------- biogeochem/EDMortalityFunctionsMod.F90 | 22 ++++++---------------- biogeochem/EDPatchDynamicsMod.F90 | 8 ++++---- main/EDMainMod.F90 | 2 +- main/FatesHistoryInterfaceMod.F90 | 2 +- 6 files changed, 27 insertions(+), 33 deletions(-) diff --git a/biogeochem/DamageMainMod.F90 b/biogeochem/DamageMainMod.F90 index 6ab8bcb66d..2d0a94dc06 100644 --- a/biogeochem/DamageMainMod.F90 +++ b/biogeochem/DamageMainMod.F90 @@ -126,7 +126,7 @@ subroutine IsItDamageTime(is_master, currentSite) call endrun(msg=errMsg(sourcefile, __LINE__)) end if - if(DamageTime .and. (is_master.eq.itrue) ) then + if(damage_time .and. (is_master.eq.itrue) ) then write(fates_log(),fmt) 'Damage Event Enacted on date: ', & hlm_current_month,'-', hlm_current_day,'-',hlm_current_year end if diff --git a/biogeochem/EDCanopyStructureMod.F90 b/biogeochem/EDCanopyStructureMod.F90 index e4a84db206..662b75c65d 100644 --- a/biogeochem/EDCanopyStructureMod.F90 +++ b/biogeochem/EDCanopyStructureMod.F90 @@ -1547,7 +1547,7 @@ subroutine leaf_area_profile( currentSite ) if (currentPatch%total_canopy_area > nearzero ) then - call UpdatePatchLAI(currentPatch, patch_lai) + call UpdatePatchLAI(currentPatch, patch_lai, CurrentSite) if(smooth_leaf_distribution == 1)then @@ -2181,7 +2181,7 @@ end subroutine CanopyLayerArea ! =============================================================================================== - subroutine UpdatePatchLAI(currentPatch, patch_lai) + subroutine UpdatePatchLAI(currentPatch, patch_lai, currentSite) ! -------------------------------------------------------------------------------------------- ! This subroutine works through the current patch cohorts and updates the canopy_layer_tlai @@ -2193,6 +2193,7 @@ subroutine UpdatePatchLAI(currentPatch, patch_lai) ! Arguments type(ed_patch_type),intent(inout), target :: currentPatch + type(ed_site_type),intent(inout), target :: currentSite real(r8), intent(inout) :: patch_lai ! Local Variables @@ -2215,7 +2216,8 @@ subroutine UpdatePatchLAI(currentPatch, patch_lai) ft = currentCohort%pft ! Update the cohort level lai and related variables - call UpdateCohortLAI(currentCohort,currentPatch%canopy_layer_tlai,currentPatch%total_canopy_area) + call UpdateCohortLAI(currentCohort,currentPatch%canopy_layer_tlai, & + currentPatch%total_canopy_area, currentSite%spread) ! Update the number of number of vegetation layers currentPatch%ncan(cl,ft) = max(currentPatch%ncan(cl,ft),currentCohort%NV) @@ -2234,7 +2236,7 @@ subroutine UpdatePatchLAI(currentPatch, patch_lai) end subroutine UpdatePatchLAI ! =============================================================================================== - subroutine UpdateCohortLAI(currentCohort, canopy_layer_tlai, patcharea) + subroutine UpdateCohortLAI(currentCohort, canopy_layer_tlai, patcharea, spread) ! Update LAI and related variables for a given cohort @@ -2245,26 +2247,28 @@ subroutine UpdateCohortLAI(currentCohort, canopy_layer_tlai, patcharea) type(ed_cohort_type),intent(inout), target :: currentCohort real(r8), intent(in) :: canopy_layer_tlai(nclmax) ! total leaf area index of each canopy layer real(r8), intent(in) :: patcharea ! either patch%total_canopy_area or patch%area - + real(r8), intent(in) :: spread ! currentSite%spread + ! Local variables real(r8) :: leaf_c ! leaf carbon [kg] - real(r8) :: target_c_area + real(r8) :: target_c_area ! target c_area - as if not damaged ! Obtain the leaf carbon leaf_c = currentCohort%prt%GetState(leaf_organ,all_carbon_elements) + ! Note that tree_lai has an internal check on the canopy locatoin currentCohort%treelai = tree_lai(leaf_c, currentCohort%pft, currentCohort%c_area, & currentCohort%n, currentCohort%canopy_layer, & canopy_layer_tlai,currentCohort%vcmax25top ) - call carea_allom(currentCohort%dbh, currentCohort%n, currentSite%spread, currentCohort%pft, & - 1, target_c_area) - + call carea_allom(currentCohort%dbh, currentCohort%n, spread, currentCohort%pft, & + 1, target_c_area) + if (hlm_use_sp .eq. ifalse) then currentCohort%treesai = tree_sai(currentCohort%pft, currentCohort%dbh, currentCohort%canopy_trim, & target_c_area, currentCohort%n, currentCohort%canopy_layer, & - currentPatch%canopy_layer_tlai, currentCohort%treelai , & + canopy_layer_tlai, currentCohort%treelai , & currentCohort%vcmax25top,4) end if diff --git a/biogeochem/EDMortalityFunctionsMod.F90 b/biogeochem/EDMortalityFunctionsMod.F90 index 13082cf910..6b006d90e9 100644 --- a/biogeochem/EDMortalityFunctionsMod.F90 +++ b/biogeochem/EDMortalityFunctionsMod.F90 @@ -175,22 +175,12 @@ subroutine mortality_rates( cohort_in,bc_in,cmort,hmort,bmort,frmort,smort,asmor cmort = 0.0_r8 endif + else write(fates_log(),*) 'dbh problem in mortality_rates', & cohort_in%dbh,cohort_in%pft,cohort_in%n,cohort_in%canopy_layer + call endrun(msg=errMsg(sourcefile, __LINE__)) endif - !-------------------------------------------------------------------------------- - ! Mortality due to cold and freezing stress (frmort), based on ED2 and: - ! Albani, M.; D. Medvigy; G. C. Hurtt; P. R. Moorcroft, 2006: The contributions - ! of land-use change, CO2 fertilization, and climate variability to the - ! Eastern US carbon sink. Glob. Change Biol., 12, 2370-2390, - ! doi: 10.1111/j.1365-2486.2006.01254.x - - else - write(fates_log(),*) 'dbh problem in mortality_rates', & - cohort_in%dbh,cohort_in%pft,cohort_in%n,cohort_in%canopy_layer - call endrun(msg=errMsg(sourcefile, __LINE__)) - endif !-------------------------------------------------------------------------------- ! Mortality due to cold and freezing stress (frmort), based on ED2 and: ! Albani, M.; D. Medvigy; G. C. Hurtt; P. R. Moorcroft, 2006: The contributions @@ -198,11 +188,11 @@ subroutine mortality_rates( cohort_in,bc_in,cmort,hmort,bmort,frmort,smort,asmor ! Eastern US carbon sink. Glob. Change Biol., 12, 2370-2390, ! doi: 10.1111/j.1365-2486.2006.01254.x - temp_in_C = cohort_in%patchptr%tveg24%GetMean() - tfrz + temp_in_C = cohort_in%patchptr%tveg24%GetMean() - tfrz - temp_dep_fraction = max(0.0_r8, min(1.0_r8, 1.0_r8 - (temp_in_C - & - EDPftvarcon_inst%freezetol(cohort_in%pft))/frost_mort_buffer) ) - frmort = EDPftvarcon_inst%mort_scalar_coldstress(cohort_in%pft) * temp_dep_fraction + temp_dep_fraction = max(0.0_r8, min(1.0_r8, 1.0_r8 - (temp_in_C - & + EDPftvarcon_inst%freezetol(cohort_in%pft))/frost_mort_buffer) ) + frmort = EDPftvarcon_inst%mort_scalar_coldstress(cohort_in%pft) * temp_dep_fraction !mortality_rates = bmort + hmort + cmort diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 6fc1281434..5e38a3ab0d 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -62,7 +62,7 @@ module EDPatchDynamicsMod use EDLoggingMortalityMod, only : logging_time use EDLoggingMortalityMod, only : get_harvest_rate_area use EDParamsMod , only : fates_mortality_disturbance_fraction - use DamageMainMod , only : DamageTime + use DamageMainMod , only : damage_time use FatesAllometryMod , only : carea_allom use FatesAllometryMod , only : set_root_fraction use FatesConstantsMod , only : g_per_kg @@ -766,7 +766,7 @@ subroutine spawn_patches( currentSite, bc_in) ! and the damaged trees if(hlm_use_crown_damage .eq. itrue) then - if( DamageTime ) then + if( damage_time ) then call damage_litter_fluxes(currentSite, currentPatch, & new_patch, patch_site_areadis, patch_damage_litter) @@ -1259,7 +1259,7 @@ subroutine spawn_patches( currentSite, bc_in) ! Regardless of disturbance type, reduce mass of damaged trees if(hlm_use_crown_damage .eq. itrue) then - if(DamageTime) then + if(damage_time) then ! if woody if (prt_params%woody(currentCohort%pft)==1 ) then @@ -1560,7 +1560,7 @@ subroutine spawn_patches( currentSite, bc_in) call endrun(msg=errMsg(sourcefile, __LINE__)) end if - if (DamageTime) then + if (damage_time) then write(fates_log(),*) 'Damage to litter: ',total_litter_d diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index 6bde3c2af7..5ee8372873 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -320,7 +320,7 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) use FatesInterfaceTypesMod, only : hlm_use_cohort_age_tracking use FatesConstantsMod, only : itrue use PRTGenericMod , only : all_carbon_elements - use DamageMainMod , only : DamageTime + use DamageMainMod , only : damage_time use EDCohortDynamicsMod , only : zero_cohort, copy_cohort, insert_cohort use EDCohortDynamicsMod , only : DeallocateCohort use FatesPlantHydraulicsMod, only : InitHydrCohort diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index deb4571b92..c590dac7b6 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -1839,7 +1839,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) use EDTypesMod , only : nlevleaf use EDParamsMod, only : ED_val_history_height_bin_edges use FatesInterfaceTypesMod, only : nlevdamage - use DamageMainMod , only : DamageTime + use DamageMainMod , only : damage_time ! Arguments class(fates_history_interface_type) :: this From e85d1f4d459d163af532da8aae3f419a50cfca8c Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Wed, 29 Jun 2022 10:29:16 -0400 Subject: [PATCH 43/84] Updated argument name in UpdateCohortLai --- biogeochem/EDCanopyStructureMod.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/biogeochem/EDCanopyStructureMod.F90 b/biogeochem/EDCanopyStructureMod.F90 index 85aa880829..611d6fad19 100644 --- a/biogeochem/EDCanopyStructureMod.F90 +++ b/biogeochem/EDCanopyStructureMod.F90 @@ -2238,7 +2238,7 @@ subroutine UpdatePatchLAI(currentPatch, patch_lai, currentSite) end subroutine UpdatePatchLAI ! =============================================================================================== - subroutine UpdateCohortLAI(currentCohort, canopy_layer_tlai, patcharea, spread) + subroutine UpdateCohortLAI(currentCohort, canopy_layer_tlai, total_canopy_area, spread) ! Update LAI and related variables for a given cohort @@ -2248,7 +2248,7 @@ subroutine UpdateCohortLAI(currentCohort, canopy_layer_tlai, patcharea, spread) ! Arguments type(ed_cohort_type),intent(inout), target :: currentCohort real(r8), intent(in) :: canopy_layer_tlai(nclmax) ! total leaf area index of each canopy layer - real(r8), intent(in) :: patcharea ! either patch%total_canopy_area or patch%area + real(r8), intent(in) :: total_canopy_area ! either patch%total_canopy_area or patch%area real(r8), intent(in) :: spread ! currentSite%spread ! Local variables @@ -2275,8 +2275,8 @@ subroutine UpdateCohortLAI(currentCohort, canopy_layer_tlai, patcharea, spread) end if ! Update the cohort lai and sai - currentCohort%lai = currentCohort%treelai *currentCohort%c_area/patcharea - currentCohort%sai = currentCohort%treesai *currentCohort%c_area/patcharea + currentCohort%lai = currentCohort%treelai *currentCohort%c_area/total_canopy_area + currentCohort%sai = currentCohort%treesai *currentCohort%c_area/total_canopy_area ! Number of actual vegetation layers in this cohort's crown currentCohort%nv = count((currentCohort%treelai+currentCohort%treesai) .gt. dlower_vai(:)) + 1 From bb345fc0bc37428aa30b1356b705abb1ad51d683 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Wed, 29 Jun 2022 12:47:57 -0400 Subject: [PATCH 44/84] Added the undamaged class named constant --- biogeochem/DamageMainMod.F90 | 8 ++++++++ biogeochem/EDCohortDynamicsMod.F90 | 4 ++-- main/EDInitMod.F90 | 5 +++-- 3 files changed, 13 insertions(+), 4 deletions(-) diff --git a/biogeochem/DamageMainMod.F90 b/biogeochem/DamageMainMod.F90 index 2d0a94dc06..6ea408dd82 100644 --- a/biogeochem/DamageMainMod.F90 +++ b/biogeochem/DamageMainMod.F90 @@ -47,6 +47,14 @@ module DamageMainMod logical :: debug = .false. ! for debugging + + ! The following is the special classification for undamaged plants + ! and is used in contexts where cohort%damageclass is used. This is + ! to flag to the user that an undamaged plant is assumed in those contexts + + integer, parameter, public :: undamaged_class = 1 + + ! ============================================================================ ! ============================================================================ diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index 230b8c28fe..75a06f3ddd 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -102,7 +102,7 @@ Module EDCohortDynamicsMod use PRTAllometricCNPMod, only : acnp_bc_out_id_pefflux use PRTAllometricCNPMod, only : acnp_bc_out_id_nneed use PRTAllometricCNPMod, only : acnp_bc_out_id_pneed - + use DamageMainMod, only : GetCrownReduction use shr_infnan_mod, only : nan => shr_infnan_nan, assignment(=) @@ -1080,7 +1080,7 @@ subroutine fuse_cohorts(currentSite, currentPatch, bc_in) use FatesInterfaceTypesMod , only : hlm_use_cohort_age_tracking use FatesConstantsMod , only : itrue use FatesConstantsMod, only : days_per_year - use DamageMainMod, only : GetCrownReduction + ! ! !ARGUMENTS diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index c1dd2dfda8..22e9203ef4 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -77,6 +77,7 @@ module EDInitMod use PRTGenericMod, only : phosphorus_element use PRTGenericMod, only : SetState use FatesSizeAgeTypeIndicesMod,only : get_age_class_index + use DamageMainMod, only : undamaged_class ! CIME GLOBALS use shr_log_mod , only : errMsg => shr_log_errMsg @@ -956,8 +957,8 @@ subroutine init_cohorts( site_in, patch_in, bc_in) call create_cohort(site_in, patch_in, pft, temp_cohort%n, temp_cohort%hite, & temp_cohort%coage, temp_cohort%dbh, prt_obj, temp_cohort%leafmemory,& temp_cohort%sapwmemory, temp_cohort%structmemory, cstatus, rstatus, & - temp_cohort%canopy_trim, temp_cohort%c_area, 1, temp_cohort%crowndamage,& - site_in%spread, bc_in) + temp_cohort%canopy_trim, temp_cohort%c_area, undamaged_class, & + temp_cohort%crowndamage, site_in%spread, bc_in) deallocate(temp_cohort) ! get rid of temporary cohort From ce6f93b1ba7bd3662c7248fa6227b416d53b4e63 Mon Sep 17 00:00:00 2001 From: Jessica Needham Date: Wed, 29 Jun 2022 11:05:05 -0700 Subject: [PATCH 45/84] [ Change tree_sai so that it is affected by damage ] [ Was using undamaged target lai to calculate tree_sai but it should actually be damaged lai. ] Fixes: [NGT-ED Github issue #] User interface changes?: [Yes (describe what changes), No] Code review: [Names] Test suite: [suite name, machine, compilers] Test baseline: Test namelist changes: Test answer changes: [bit for bit, roundoff, climate changing] Test summary: no testing --- biogeochem/EDCanopyStructureMod.F90 | 14 +++++--------- biogeochem/EDCohortDynamicsMod.F90 | 2 +- biogeochem/EDPhysiologyMod.F90 | 2 +- biogeochem/FatesAllometryMod.F90 | 6 +++--- 4 files changed, 10 insertions(+), 14 deletions(-) diff --git a/biogeochem/EDCanopyStructureMod.F90 b/biogeochem/EDCanopyStructureMod.F90 index 611d6fad19..9fc30b478b 100644 --- a/biogeochem/EDCanopyStructureMod.F90 +++ b/biogeochem/EDCanopyStructureMod.F90 @@ -2238,7 +2238,7 @@ subroutine UpdatePatchLAI(currentPatch, patch_lai, currentSite) end subroutine UpdatePatchLAI ! =============================================================================================== - subroutine UpdateCohortLAI(currentCohort, canopy_layer_tlai, total_canopy_area, spread) + subroutine UpdateCohortLAI(currentCohort, canopy_layer_tlai, total_canopy_area) ! Update LAI and related variables for a given cohort @@ -2249,11 +2249,9 @@ subroutine UpdateCohortLAI(currentCohort, canopy_layer_tlai, total_canopy_area, type(ed_cohort_type),intent(inout), target :: currentCohort real(r8), intent(in) :: canopy_layer_tlai(nclmax) ! total leaf area index of each canopy layer real(r8), intent(in) :: total_canopy_area ! either patch%total_canopy_area or patch%area - real(r8), intent(in) :: spread ! currentSite%spread ! Local variables real(r8) :: leaf_c ! leaf carbon [kg] - real(r8) :: target_c_area ! target c_area - as if not damaged ! Obtain the leaf carbon leaf_c = currentCohort%prt%GetState(leaf_organ,all_carbon_elements) @@ -2263,13 +2261,11 @@ subroutine UpdateCohortLAI(currentCohort, canopy_layer_tlai, total_canopy_area, currentCohort%treelai = tree_lai(leaf_c, currentCohort%pft, currentCohort%c_area, & currentCohort%n, currentCohort%canopy_layer, & canopy_layer_tlai,currentCohort%vcmax25top ) - - call carea_allom(currentCohort%dbh, currentCohort%n, spread, currentCohort%pft, & - 1, target_c_area) - + if (hlm_use_sp .eq. ifalse) then - currentCohort%treesai = tree_sai(currentCohort%pft, currentCohort%dbh, currentCohort%canopy_trim, & - target_c_area, currentCohort%n, currentCohort%canopy_layer, & + currentCohort%treesai = tree_sai(currentCohort%pft, currentCohort%dbh, currentCohort%crowndamage, & + currentCohort%canopy_trim, & + currentCohort%c_area, currentCohort%n, currentCohort%canopy_layer, & canopy_layer_tlai, currentCohort%treelai , & currentCohort%vcmax25top,4) end if diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index 75a06f3ddd..c690bf898f 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -287,7 +287,7 @@ subroutine create_cohort(currentSite, patchptr, pft, nn, hite, coage, dbh, & if(hlm_use_sp.eq.ifalse)then new_cohort%treesai = tree_sai(new_cohort%pft, new_cohort%dbh, & - new_cohort%canopy_trim, & + new_cohort%crowndamage, new_cohort%canopy_trim, & new_cohort%c_area, new_cohort%n, new_cohort%canopy_layer, & patchptr%canopy_layer_tlai, new_cohort%treelai,new_cohort%vcmax25top,2 ) end if diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index af846de2e6..0c13806859 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -475,7 +475,7 @@ subroutine trim_canopy( currentSite ) ! We don't need check on sp mode here since we don't trim_canopy with sp mode currentCohort%treesai = tree_sai(currentCohort%pft, & - currentCohort%dbh, & + currentCohort%dbh, currentCohort%crowndamage, & currentCohort%canopy_trim, & target_c_area, currentCohort%n,currentCohort%canopy_layer,& currentPatch%canopy_layer_tlai, currentCohort%treelai, & diff --git a/biogeochem/FatesAllometryMod.F90 b/biogeochem/FatesAllometryMod.F90 index 29f08e58ae..a537be5af3 100644 --- a/biogeochem/FatesAllometryMod.F90 +++ b/biogeochem/FatesAllometryMod.F90 @@ -740,7 +740,7 @@ end function tree_lai ! ============================================================================ - real(r8) function tree_sai(pft, dbh, canopy_trim, c_area, nplant, cl, & + real(r8) function tree_sai(pft, dbh, crowndamage, canopy_trim, c_area, nplant, cl, & canopy_lai, treelai, vcmax25top, call_id ) ! ============================================================================ @@ -749,6 +749,7 @@ real(r8) function tree_sai(pft, dbh, canopy_trim, c_area, nplant, cl, & integer, intent(in) :: pft real(r8), intent(in) :: dbh + integer, intent(in) :: crowndamage real(r8), intent(in) :: canopy_trim ! trimming function (0-1) real(r8), intent(in) :: c_area ! crown area (m2) real(r8), intent(in) :: nplant ! number of plants @@ -763,8 +764,7 @@ real(r8) function tree_sai(pft, dbh, canopy_trim, c_area, nplant, cl, & real(r8) :: target_lai real(r8) :: target_bleaf - ! target undamaged bleaf - call bleaf(dbh, pft, 1, canopy_trim, target_bleaf) + call bleaf(dbh, pft, crowndamage, canopy_trim, target_bleaf) target_lai = tree_lai(target_bleaf, pft, c_area, nplant, cl,& canopy_lai, vcmax25top) From d2dfb732953d8f94c5a0146d0cca300a3bb3a52d Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 30 Jun 2022 10:01:27 -0400 Subject: [PATCH 46/84] Minor variable name change for readability --- biogeochem/EDMortalityFunctionsMod.F90 | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/biogeochem/EDMortalityFunctionsMod.F90 b/biogeochem/EDMortalityFunctionsMod.F90 index f64d2b6901..d745f468d5 100644 --- a/biogeochem/EDMortalityFunctionsMod.F90 +++ b/biogeochem/EDMortalityFunctionsMod.F90 @@ -72,7 +72,8 @@ subroutine mortality_rates( cohort_in,bc_in,cmort,hmort,bmort,frmort,smort,asmor real(r8),intent(out) :: dgmort ! damage dependent mortality real(r8) :: frac ! relativised stored carbohydrate - real(r8) :: leaf_c ! leaf biomass kgC + real(r8) :: target_leaf_c ! target leaf biomass for the current trim status and + ! damage class [kgC] real(r8) :: store_c real(r8) :: hf_sm_threshold ! hydraulic failure soil moisture threshold real(r8) :: hf_flc_threshold ! hydraulic failure fractional loss of conductivity threshold @@ -164,10 +165,10 @@ subroutine mortality_rates( cohort_in,bc_in,cmort,hmort,bmort,frmort,smort,asmor ! Carbon Starvation induced mortality. if ( cohort_in%dbh > 0._r8 ) then - call bleaf(cohort_in%dbh,cohort_in%pft,cohort_in%crowndamage,cohort_in%canopy_trim,leaf_c) + call bleaf(cohort_in%dbh,cohort_in%pft,cohort_in%crowndamage,cohort_in%canopy_trim,target_leaf_c) store_c = cohort_in%prt%GetState(store_organ,all_carbon_elements) - call storage_fraction_of_target(leaf_c, store_c, frac) + call storage_fraction_of_target(target_leaf_c, store_c, frac) if( frac .lt. 1._r8) then cmort = max(0.0_r8,EDPftvarcon_inst%mort_scalar_cstarvation(cohort_in%pft) * & (1.0_r8 - frac)) From 71c56b190bf0225fff908a281c21ad11b4c9cecf Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 30 Jun 2022 10:24:50 -0400 Subject: [PATCH 47/84] Inremental change towards damage recovery refactor --- biogeochem/DamageMainMod.F90 | 184 ++++++++++++++++++++++++++++++ main/EDMainMod.F90 | 107 +++++------------ parteh/PRTAllometricCarbonMod.F90 | 84 -------------- 3 files changed, 211 insertions(+), 164 deletions(-) diff --git a/biogeochem/DamageMainMod.F90 b/biogeochem/DamageMainMod.F90 index 6ea408dd82..2330c2ebc0 100644 --- a/biogeochem/DamageMainMod.F90 +++ b/biogeochem/DamageMainMod.F90 @@ -44,6 +44,7 @@ module DamageMainMod public :: IsItDamageTime public :: damage_time public :: GetDamageMortality + public :: DamageRecovery logical :: debug = .false. ! for debugging @@ -60,6 +61,189 @@ module DamageMainMod contains + subroutine DamageRecovery(currentCohort,recoveryCohort) + + !--------------------------------------------------------------------------- + ! JN March 2021 + ! At this point it is possible that damaged cohorts have reached their + ! target allometries. There is a choice now - if they have excess carbon, + ! they can use it to grow along their reduced allometric targets - i.e. + ! dbh and all carbon pools grow out together. OR they can use excess carbon to + ! jump to a lower damage class by changing their target allometry and growing + ! to meet new C pools for same dbh. + ! + ! d = damage class + ! -------------------------------------------------------------------------- + + type(ed_cohort_type) :: currentCohort + type(ed_cohort_type), pointer :: recoveryCohort + + + + if (crowndamage > 1 .and. carbon_balance > calloc_abs_error) then + + if(damage_recovery_scalar > 0.0_r8) then + ! 1. What is excess carbon? + ! carbon_balance + + ! 2. What is biomass required to go from current damage level to next damage level? + + ! mass of this damage class + mass_d = (sum(leaf_c(1:nleafage)) + fnrt_c + store_c + sapw_c + struct_c ) + + ! Target sapwood biomass according to allometry and trimming [kgC] + call bsap_allom(dbh,ipft, crowndamage-1, canopy_trim,sapw_area,targetn_sapw_c) + ! Target total above ground biomass in woody/fibrous tissues [kgC] + call bagw_allom(dbh,ipft, crowndamage-1, targetn_agw_c) + ! Target total below ground biomass in woody/fibrous tissues [kgC] + call bbgw_allom(dbh,ipft,targetn_bgw_c) + ! Target total dead (structrual) biomass [kgC] + call bdead_allom( targetn_agw_c, targetn_bgw_c, targetn_sapw_c, ipft, targetn_struct_c) + ! Target fine-root biomass and deriv. according to allometry and trimming [kgC, kgC/cm] + call bfineroot(dbh,ipft,canopy_trim,targetn_fnrt_c) + ! Target storage carbon [kgC,kgC/cm] + call bstore_allom(dbh,ipft,crowndamage-1, canopy_trim,targetn_store_c) + ! Target leaf biomass according to allometry and trimming + if(leaf_status==2) then + call bleaf(dbh,ipft,crowndamage-1, canopy_trim,targetn_leaf_c) + else + targetn_leaf_c = 0._r8 + end if + + + mass_dminus1 = (max(sum(leaf_c), targetn_leaf_c) + max(fnrt_c, targetn_fnrt_c) + & + max(store_c, targetn_store_c) + max(sapw_c, targetn_sapw_c) + & + max(struct_c, targetn_struct_c)) + + ! Carbon needed to get from current mass to allometric target mass of next damage class up + recovery_demand = mass_dminus1 - mass_d + + ! 3. How many trees can get there with excess carbon? + max_recover_n = carbon_balance * n / recovery_demand + + ! 4. Use the scalar to decide how many to recover + n_recover = max_recover_n * damage_recovery_scalar + + ! carbon balance needs to be updated + + ! there is a special case where damage_recovery_scalar = 1, but + ! max_recover_n > n (i.e. there is more carbon than needed for all + ! individuals to recover to the next damage class. + ! in this case we can cheat, by making n_recover 0 and simply + ! allowing the donor cohort to recover and then go through + ! prt - will this work though? if they are not anywhere near allometry? + + + if(damage_recovery_scalar .eq. 1.0_r8 .and. max_recover_n > n) then + n_recover = 0.0_r8 + crowndamage = crowndamage - 1 + ! call prt from within itself here? + else + carbon_balance = (n * carbon_balance - (recovery_demand * n_recover)) /(n-n_recover) + end if + + ! we reduce number density here and continue on with daily prt for the + ! part of the cohort that is not recovering - staying fixed on its + ! current reduced allometries + n = n - n_recover + + ! Outside of parteh we will copy the cohort and allow the + ! recovery portion to change allometric targets. + + end if ! end if some recovery is permited + end if ! end if crowndamage + !------------------------------------------------------------------------------------ + + + + + + if(currentCohort%crowndamage > 1) then + + ! N is inout boundary condition so has now been updated. The difference must + ! go to a new cohort + n_recover = n_old - currentCohort%n + + if(n_recover > nearzero) then + + 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) + ! call zero_cohort(nc) + call copy_cohort(currentCohort, nc) + + nc%n = n_recover + nc%crowndamage = currentCohort%crowndamage - 1 + + ! Need to adjust the crown area which is NOT on a per individual basis + nc%c_area = nc%n/n_old * currentCohort%c_area + currentCohort%c_area = currentCohort%c_area - nc%c_area + + ! This new cohort spends carbon balance on growing out pools + ! (but not dbh) to reach new allometric targets + ! This was already calculated within parteh - this cohort should just + ! be able to hit allometric targets of one damage class down + call nc%prt%DamageRecovery() + + ! at this point we need to update fluxes or this cohort will + ! fail its mass conservation checks + + sapw_c = nc%prt%GetState(sapw_organ, all_carbon_elements) + struct_c = nc%prt%GetState(struct_organ, all_carbon_elements) + leaf_c = nc%prt%GetState(leaf_organ, all_carbon_elements) + fnrt_c = nc%prt%GetState(fnrt_organ, all_carbon_elements) + store_c = nc%prt%GetState(store_organ, all_carbon_elements) + repro_c = nc%prt%GetState(repro_organ, all_carbon_elements) + nc_carbon = sapw_c + struct_c + leaf_c + fnrt_c + store_c + repro_c + + cc_sapw_c = currentCohort%prt%GetState(sapw_organ, all_carbon_elements) + cc_struct_c = currentCohort%prt%GetState(struct_organ, all_carbon_elements) + cc_leaf_c = currentCohort%prt%GetState(leaf_organ, all_carbon_elements) + cc_fnrt_c = currentCohort%prt%GetState(fnrt_organ, all_carbon_elements) + cc_store_c = currentCohort%prt%GetState(store_organ, all_carbon_elements) + cc_repro_c = currentCohort%prt%GetState(repro_organ, all_carbon_elements) + cc_carbon = cc_sapw_c + cc_struct_c + cc_leaf_c + cc_fnrt_c + cc_store_c + cc_repro_c + + + call PRTDamageRecoveryFluxes(nc%prt, leaf_organ, leaf_c0, leaf_c, cc_leaf_c) + call PRTDamageRecoveryFluxes(nc%prt, repro_organ, repro_c0, repro_c, cc_repro_c) + call PRTDamageRecoveryFluxes(nc%prt, sapw_organ, sapw_c0, sapw_c, cc_sapw_c) + call PRTDamageRecoveryFluxes(nc%prt, struct_organ, struct_c0, struct_c, cc_struct_c) + call PRTDamageRecoveryFluxes(nc%prt, store_organ, store_c0, store_c, cc_store_c) + call PRTDamageRecoveryFluxes(nc%prt, fnrt_organ, fnrt_c0, fnrt_c, cc_fnrt_c) + + ! update crown area + call carea_allom(nc%dbh, nc%n, currentSite%spread, nc%pft, nc%crowndamage, nc%c_area) + call carea_allom(currentCohort%dbh, currentCohort%n, currentSite%spread, & + currentCohort%pft, currentCohort%crowndamage, currentCohort%c_area) + + + + !----------- Insert copy into linked list ----------------------! + nc%shorter => currentCohort + if(associated(currentCohort%taller))then + nc%taller => currentCohort%taller + currentCohort%taller%shorter => nc + else + currentPatch%tallest => nc + nc%taller => null() + endif + currentCohort%taller => nc + + end if ! end if greater than nearzero + + end if ! end if crowndamage > 1 + + + + + return + end subroutine DamageRecovery + subroutine IsItDamageTime(is_master, currentSite) diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index 06b4a3593d..dce23895ae 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -517,91 +517,38 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) total_c0 = sapw_c0 + struct_c0 + leaf_c0 + fnrt_c0 + store_c0 + repro_c0 cc_carbon = 0.0_r8 ! need to set it here to avoid nan errors if conditions aren't met below + + ! We split the allocation into phases (currently for all hypotheses) + ! In phase 1, allocation gets the mass of organs to match targets + ! In phase 2, allocation increases the mass of organs along with stature growth (dbh) + ! The reason why we split is to accomodate the damage code. Following phase 1, + ! we will allow the damage status of the cohorts to potentially recover, if they + ! have any left-over C/N/P resources. In this process, the cohort will be split + ! into two, each having a number count summing to the original. Where one cohort + ! will remain in the original damage class proceed with allocation, and the other + ! will reduce its damage class with new mass tarets. The latter will have to re-play + ! The first phase of allocation. Both cohorts have the opportunity (if resources remain) + ! to grow in stature (phase 2) - call currentCohort%prt%DailyPRT() + call currentCohort%prt%DailyPRT(phase=1) + if(hlm_use_crown_damage .eq. itrue) then + ! The loop order is shortest to tallest + ! The recovered cohort (ie one with larger targets) + ! is newly created in DamageRecovery(), and + ! is inserted into the next position, following the + ! original and current (unrecovered) cohort. + ! we pass it back here in case the pointer is + ! needed for diagnostics + call DamageRecovery(currentCohort,recoveredCohort) + end if + + call currentCohort%prt%DailyPRT(phase=2) + if(hlm_use_crown_damage .eq. itrue) then - if(currentCohort%crowndamage > 1) then - - ! N is inout boundary condition so has now been updated. The difference must - ! go to a new cohort - n_recover = n_old - currentCohort%n - - if(n_recover > nearzero) then - - 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) - ! call zero_cohort(nc) - call copy_cohort(currentCohort, nc) - - nc%n = n_recover - nc%crowndamage = currentCohort%crowndamage - 1 - - ! Need to adjust the crown area which is NOT on a per individual basis - nc%c_area = nc%n/n_old * currentCohort%c_area - currentCohort%c_area = currentCohort%c_area - nc%c_area - - ! This new cohort spends carbon balance on growing out pools - ! (but not dbh) to reach new allometric targets - ! This was already calculated within parteh - this cohort should just - ! be able to hit allometric targets of one damage class down - call nc%prt%DamageRecovery() - - ! at this point we need to update fluxes or this cohort will - ! fail its mass conservation checks - - sapw_c = nc%prt%GetState(sapw_organ, all_carbon_elements) - struct_c = nc%prt%GetState(struct_organ, all_carbon_elements) - leaf_c = nc%prt%GetState(leaf_organ, all_carbon_elements) - fnrt_c = nc%prt%GetState(fnrt_organ, all_carbon_elements) - store_c = nc%prt%GetState(store_organ, all_carbon_elements) - repro_c = nc%prt%GetState(repro_organ, all_carbon_elements) - nc_carbon = sapw_c + struct_c + leaf_c + fnrt_c + store_c + repro_c - - cc_sapw_c = currentCohort%prt%GetState(sapw_organ, all_carbon_elements) - cc_struct_c = currentCohort%prt%GetState(struct_organ, all_carbon_elements) - cc_leaf_c = currentCohort%prt%GetState(leaf_organ, all_carbon_elements) - cc_fnrt_c = currentCohort%prt%GetState(fnrt_organ, all_carbon_elements) - cc_store_c = currentCohort%prt%GetState(store_organ, all_carbon_elements) - cc_repro_c = currentCohort%prt%GetState(repro_organ, all_carbon_elements) - cc_carbon = cc_sapw_c + cc_struct_c + cc_leaf_c + cc_fnrt_c + cc_store_c + cc_repro_c - - - call PRTDamageRecoveryFluxes(nc%prt, leaf_organ, leaf_c0, leaf_c, cc_leaf_c) - call PRTDamageRecoveryFluxes(nc%prt, repro_organ, repro_c0, repro_c, cc_repro_c) - call PRTDamageRecoveryFluxes(nc%prt, sapw_organ, sapw_c0, sapw_c, cc_sapw_c) - call PRTDamageRecoveryFluxes(nc%prt, struct_organ, struct_c0, struct_c, cc_struct_c) - call PRTDamageRecoveryFluxes(nc%prt, store_organ, store_c0, store_c, cc_store_c) - call PRTDamageRecoveryFluxes(nc%prt, fnrt_organ, fnrt_c0, fnrt_c, cc_fnrt_c) - - ! update crown area - call carea_allom(nc%dbh, nc%n, currentSite%spread, nc%pft, nc%crowndamage, nc%c_area) - call carea_allom(currentCohort%dbh, currentCohort%n, currentSite%spread, & - currentCohort%pft, currentCohort%crowndamage, currentCohort%c_area) - - - - !----------- Insert copy into linked list ----------------------! - nc%shorter => currentCohort - if(associated(currentCohort%taller))then - nc%taller => currentCohort%taller - currentCohort%taller%shorter => nc - else - currentPatch%tallest => nc - nc%taller => null() - endif - currentCohort%taller => nc - - end if ! end if greater than nearzero - - end if ! end if crowndamage > 1 + end if ! end if crowndamage is on diff --git a/parteh/PRTAllometricCarbonMod.F90 b/parteh/PRTAllometricCarbonMod.F90 index c7f4f449bf..b4194919db 100644 --- a/parteh/PRTAllometricCarbonMod.F90 +++ b/parteh/PRTAllometricCarbonMod.F90 @@ -670,90 +670,6 @@ subroutine DailyPRTAllometricCarbon(this) ! left to allocate, and thus it must be on allometry when its not. ! ----------------------------------------------------------------------------------- - !----------------------------------------------------------------------------------- - ! JN March 2021 - ! At this point it is possible that damaged cohorts have reached their - ! target allometries. There is a choice now - if they have excess carbon, - ! they can use it to grow along their reduced allometric targets - i.e. - ! dbh and all carbon pools grow out together. OR they can use excess carbon to - ! jump to a lower damage class by changing their target allometry and growing - ! to meet new C pools for same dbh. - ! - ! d = damage class - - if (crowndamage > 1 .and. carbon_balance > calloc_abs_error) then - - if(damage_recovery_scalar > 0.0_r8) then - ! 1. What is excess carbon? - ! carbon_balance - - ! 2. What is biomass required to go from current damage level to next damage level? - - ! mass of this damage class - mass_d = (sum(leaf_c(1:nleafage)) + fnrt_c + store_c + sapw_c + struct_c ) - - ! Target sapwood biomass according to allometry and trimming [kgC] - call bsap_allom(dbh,ipft, crowndamage-1, canopy_trim,sapw_area,targetn_sapw_c) - ! Target total above ground biomass in woody/fibrous tissues [kgC] - call bagw_allom(dbh,ipft, crowndamage-1, targetn_agw_c) - ! Target total below ground biomass in woody/fibrous tissues [kgC] - call bbgw_allom(dbh,ipft,targetn_bgw_c) - ! Target total dead (structrual) biomass [kgC] - call bdead_allom( targetn_agw_c, targetn_bgw_c, targetn_sapw_c, ipft, targetn_struct_c) - ! Target fine-root biomass and deriv. according to allometry and trimming [kgC, kgC/cm] - call bfineroot(dbh,ipft,canopy_trim,targetn_fnrt_c) - ! Target storage carbon [kgC,kgC/cm] - call bstore_allom(dbh,ipft,crowndamage-1, canopy_trim,targetn_store_c) - ! Target leaf biomass according to allometry and trimming - if(leaf_status==2) then - call bleaf(dbh,ipft,crowndamage-1, canopy_trim,targetn_leaf_c) - else - targetn_leaf_c = 0._r8 - end if - - - mass_dminus1 = (max(sum(leaf_c), targetn_leaf_c) + max(fnrt_c, targetn_fnrt_c) + & - max(store_c, targetn_store_c) + max(sapw_c, targetn_sapw_c) + & - max(struct_c, targetn_struct_c)) - - ! Carbon needed to get from current mass to allometric target mass of next damage class up - recovery_demand = mass_dminus1 - mass_d - - ! 3. How many trees can get there with excess carbon? - max_recover_n = carbon_balance * n / recovery_demand - - ! 4. Use the scalar to decide how many to recover - n_recover = max_recover_n * damage_recovery_scalar - - ! carbon balance needs to be updated - - ! there is a special case where damage_recovery_scalar = 1, but - ! max_recover_n > n (i.e. there is more carbon than needed for all - ! individuals to recover to the next damage class. - ! in this case we can cheat, by making n_recover 0 and simply - ! allowing the donor cohort to recover and then go through - ! prt - will this work though? if they are not anywhere near allometry? - - - if(damage_recovery_scalar .eq. 1.0_r8 .and. max_recover_n > n) then - n_recover = 0.0_r8 - crowndamage = crowndamage - 1 - ! call prt from within itself here? - else - carbon_balance = (n * carbon_balance - (recovery_demand * n_recover)) /(n-n_recover) - end if - - ! we reduce number density here and continue on with daily prt for the - ! part of the cohort that is not recovering - staying fixed on its - ! current reduced allometries - n = n - n_recover - - ! Outside of parteh we will copy the cohort and allow the - ! recovery portion to change allometric targets. - - end if ! end if some recovery is permited - end if ! end if crowndamage - !------------------------------------------------------------------------------------ if_stature_growth: if( carbon_balance > calloc_abs_error ) then From 010a95fd300cf9cfde0c5d7574e4f318feb820fe Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 30 Jun 2022 14:38:10 -0400 Subject: [PATCH 48/84] Second pass through splitting allocation and modularizing the recovery code. --- biogeochem/DamageMainMod.F90 | 376 ++++++++++++++++------------- biogeochem/EDCohortDynamicsMod.F90 | 2 - biogeochem/FatesAllometryMod.F90 | 1 - main/EDMainMod.F90 | 185 +++++++------- parteh/PRTAllometricCarbonMod.F90 | 70 +----- 5 files changed, 305 insertions(+), 329 deletions(-) diff --git a/biogeochem/DamageMainMod.F90 b/biogeochem/DamageMainMod.F90 index 2330c2ebc0..650d0f8ddd 100644 --- a/biogeochem/DamageMainMod.F90 +++ b/biogeochem/DamageMainMod.F90 @@ -61,7 +61,7 @@ module DamageMainMod contains - subroutine DamageRecovery(currentCohort,recoveryCohort) + subroutine DamageRecovery(csite,cpatch,ccohort,newly_recovered) !--------------------------------------------------------------------------- ! JN March 2021 @@ -74,173 +74,219 @@ subroutine DamageRecovery(currentCohort,recoveryCohort) ! ! d = damage class ! -------------------------------------------------------------------------- - - type(ed_cohort_type) :: currentCohort - type(ed_cohort_type), pointer :: recoveryCohort - - - if (crowndamage > 1 .and. carbon_balance > calloc_abs_error) then - - if(damage_recovery_scalar > 0.0_r8) then - ! 1. What is excess carbon? - ! carbon_balance + type(ed_site_type) :: csite ! Site of the current cohort + type(ed_patch_type) :: cpatch ! patch of the current cohort + type(ed_cohort_type) :: ccohort ! Current (damaged) cohort + logical :: newly_recovered ! true if we create a new cohort + + ! locals + type(ed_cohort_type), pointer :: rcohort ! New cohort that recovers by + ! having an lower damage class + real(r8) :: sapw_area + real(r8) :: target_sapw_c,target_sapw_m + real(r8) :: target_agw_c + real(r8) :: target_bgw_c + real(r8) :: target_struct_c,target_struct_m + real(r8) :: target_fnrt_c,target_fnrt_m + real(r8) :: target_leaf_c,target_leaf_m + real(r8) :: target_store_c,target_store_m + real(r8) :: target_repro_m + real(r8) :: mass_d + real(r8) :: mass_dminus1 + real(r8) :: recovery_demand + real(r8) :: max_recover_nplant + real(r8) :: nplant_recover + + associate(dbh => ccohort%dbh, & + ipft => ccohort%pft, & + canopy_trim => ccohort%canopy_trim) + + ! If we are currently undamaged, no recovery + ! necessary, do nothing and return a null pointer + ! If the damage_recovery_scalar is zero, which + ! would be an unusual testing case, but possible, + ! then no recovery is possible, do nothing and + ! return a null pointer + if ((ccohort%crowndamage == undamaged_class) .or. & + (damage_recovery_scalar < nearzero) ) then + newly_recovered = .false. + return + end if + + cpatch => ccohort%patchptr + + + ! If we have not returned, then this cohort both has + ! a damaged status, and the ability to recover from that damage + ! ----------------------------------------------------------------- + + ! To determine recovery, the first priority is to determine how much + ! resources (C,N,P) are required to recover the plant to the target + ! pool sizes of the next (less) damage class + + ! Target sapwood biomass according to allometry and trimming [kgC] + call bsap_allom(dbh,ipft, ccohort%crowndamage-1, canopy_trim,sapw_area,target_sapw_c) + ! Target total above ground biomass in woody/fibrous tissues [kgC] + call bagw_allom(dbh,ipft, ccohort%crowndamage-1, target_agw_c) + ! Target total below ground biomass in woody/fibrous tissues [kgC] + call bbgw_allom(dbh,ipft,target_bgw_c) + ! Target total dead (structrual) biomass [kgC] + call bdead_allom( target_agw_c, target_bgw_c, target_sapw_c, ipft, target_struct_c) + ! Target fine-root biomass and deriv. according to allometry and trimming [kgC, kgC/cm] + call bfineroot(dbh,ipft,canopy_trim,target_fnrt_c) + ! Target storage carbon [kgC,kgC/cm] + call bstore_allom(dbh,ipft,crowndamage-1, canopy_trim,target_store_c) + ! Target leaf biomass according to allometry and trimming + if(ccohort%status_coh==leaves_on) then + call bleaf(dbh,ipft,crowndamage-1, canopy_trim,target_leaf_c) + else + target_leaf_c = 0._r8 + end if + + ! We will be taking the number of recovering plants + ! based on minimum of available resources for C/N/P (initialize high) + nplant_recover = 1.e10_r8 + + do el=1,num_elements + + ! Actual mass of chemical species in the organs + leaf_m = ccohort%prt%GetState(leaf_organ, element_list(el)) + store_m = ccohort%prt%GetState(store_organ, element_list(el)) + sapw_m = ccohort%prt%GetState(sapw_organ, element_list(el)) + fnrt_m = ccohort%prt%GetState(fnrt_organ, element_list(el)) + struct_m = ccohort%prt%GetState(struct_organ, element_list(el)) + repro_m = ccohort%prt%GetState(repro_organ, element_list(el)) + + ! Target mass of chemical species in organs, based on stature, + ! allometry and stoichiometry parameters + select case (element_list(el)) + case (carbon12_element) + target_store_m = target_store_c + target_leaf_m = target_leaf_c + target_fnrt_m = target_fnrt_c + target_struct_m = target_struct_c + target_sapw_m = target_sapw_c + target_repro_m = 0._r8 + available_m = ccohort%npp_acc + case (nitrogen_element) + target_struct_m = target_struct_c * & + prt_params%nitr_stoich_p1(ipft,prt_params%organ_param_id(struct_organ)) + target_leaf_m = target_leaf_c * & + prt_params%nitr_stoich_p1(ipft,prt_params%organ_param_id(leaf_organ)) + target_fnrt_m = target_fnrt_c * & + prt_params%nitr_stoich_p1(ipft,prt_params%organ_param_id(fnrt_organ)) + target_sapw_m = target_sapw_c * & + prt_params%nitr_stoich_p1(ipft,prt_params%organ_param_id(sapw_organ)) + target_repro_m = 0._r8 + target_store_m = StorageNutrientTarget(ipft, element_list(el), & + leaf_target_m, fnrt_target_m, sapw_target_m, struct_target_m) + ! For nutrients, all uptake is immediately put into storage, so just swap + ! them and assume storage is what is available, but needs to be filled up + available_m = store_m + store_m = 0._r8 + case (phosphorus_element) + target_struct_m = target_struct_c * & + prt_params%phos_stoich_p1(ipft,prt_params%organ_param_id(struct_organ)) + target_leaf_m = target_leaf_c * & + prt_params%phos_stoich_p1(ipft,prt_params%organ_param_id(leaf_organ)) + target_fnrt_m = target_fnrt_c * & + prt_params%phos_stoich_p1(ipft,prt_params%organ_param_id(fnrt_organ)) + target_sapw_m = target_sapw_c * & + prt_params%phos_stoich_p1(ipft,prt_params%organ_param_id(sapw_organ)) + target_repro_m = 0._r8 + target_store_m = StorageNutrientTarget(ipft, element_list(el), & + leaf_target_m, fnrt_target_m, sapw_target_m, struct_target_m) + end select + + ! 1. What is excess carbon? + ! carbon_balance + + ! 2. What is biomass required to go from current + ! damage level to next damage level? + + ! mass of this damage class + mass_d = leaf_m + store_m + sapw_m + fnrt_m + struct_m + repro_m + + mass_dminus1 = max(leaf_m, target_leaf_m) + max(fnrt_m, target_fnrt_m) + & + max(store_m, target_store_m) + max(sapw_m, target_sapw_m) + & + max(struct_m, target_struct_m)) + + ! Mass needed to get from current mass to allometric + ! target mass of next damage class up + recovery_demand = mass_dminus1 - mass_d + + ! 3. How many trees can get there with excess carbon? + max_recover_nplant = available_m * ccohort%n / recovery_demand + + ! 4. Use the scalar to decide how many to recover + nplant_recover = min(nplant_recover,max(0._r8,max_recover_nplant * damage_recovery_scalar)) + + end do - ! 2. What is biomass required to go from current damage level to next damage level? - - ! mass of this damage class - mass_d = (sum(leaf_c(1:nleafage)) + fnrt_c + store_c + sapw_c + struct_c ) - - ! Target sapwood biomass according to allometry and trimming [kgC] - call bsap_allom(dbh,ipft, crowndamage-1, canopy_trim,sapw_area,targetn_sapw_c) - ! Target total above ground biomass in woody/fibrous tissues [kgC] - call bagw_allom(dbh,ipft, crowndamage-1, targetn_agw_c) - ! Target total below ground biomass in woody/fibrous tissues [kgC] - call bbgw_allom(dbh,ipft,targetn_bgw_c) - ! Target total dead (structrual) biomass [kgC] - call bdead_allom( targetn_agw_c, targetn_bgw_c, targetn_sapw_c, ipft, targetn_struct_c) - ! Target fine-root biomass and deriv. according to allometry and trimming [kgC, kgC/cm] - call bfineroot(dbh,ipft,canopy_trim,targetn_fnrt_c) - ! Target storage carbon [kgC,kgC/cm] - call bstore_allom(dbh,ipft,crowndamage-1, canopy_trim,targetn_store_c) - ! Target leaf biomass according to allometry and trimming - if(leaf_status==2) then - call bleaf(dbh,ipft,crowndamage-1, canopy_trim,targetn_leaf_c) - else - targetn_leaf_c = 0._r8 - end if - - - mass_dminus1 = (max(sum(leaf_c), targetn_leaf_c) + max(fnrt_c, targetn_fnrt_c) + & - max(store_c, targetn_store_c) + max(sapw_c, targetn_sapw_c) + & - max(struct_c, targetn_struct_c)) - - ! Carbon needed to get from current mass to allometric target mass of next damage class up - recovery_demand = mass_dminus1 - mass_d - - ! 3. How many trees can get there with excess carbon? - max_recover_n = carbon_balance * n / recovery_demand - - ! 4. Use the scalar to decide how many to recover - n_recover = max_recover_n * damage_recovery_scalar - - ! carbon balance needs to be updated - - ! there is a special case where damage_recovery_scalar = 1, but - ! max_recover_n > n (i.e. there is more carbon than needed for all - ! individuals to recover to the next damage class. - ! in this case we can cheat, by making n_recover 0 and simply - ! allowing the donor cohort to recover and then go through - ! prt - will this work though? if they are not anywhere near allometry? - - - if(damage_recovery_scalar .eq. 1.0_r8 .and. max_recover_n > n) then - n_recover = 0.0_r8 - crowndamage = crowndamage - 1 - ! call prt from within itself here? - else - carbon_balance = (n * carbon_balance - (recovery_demand * n_recover)) /(n-n_recover) - end if - - ! we reduce number density here and continue on with daily prt for the - ! part of the cohort that is not recovering - staying fixed on its - ! current reduced allometries - n = n - n_recover - - ! Outside of parteh we will copy the cohort and allow the - ! recovery portion to change allometric targets. - - end if ! end if some recovery is permited - end if ! end if crowndamage - !------------------------------------------------------------------------------------ - - - - + ! there is a special case where damage_recovery_scalar = 1, but + ! max_recover_nplant > n (i.e. there is more carbon than needed for all + ! individuals to recover to the next damage class. + ! in this case we can cheat, by making n_recover 0 and simply + ! allowing the donor cohort to recover and then go through + ! prt - will this work though? if they are not anywhere near allometry? + + if( abs(damage_recovery_scalar-1._r8) < nearzero .and. & + nplant_recover > ccohort%n) then + nplant_recover = 0.0_r8 + crowndamage = crowndamage - 1 + end if + + if(nplant_recover < nearzero) then + + newly_recovered = .false. + return + + else + newly_recovered = .true. + allocate(rcohort) + if(hlm_use_planthydro .eq. itrue) call InitHydrCohort(csite,rcohort) + ! Initialize the PARTEH object and point to the + ! correct boundary condition fields + rcohort%prt => null() + call InitPRTObject(rcohort%prt) + call InitPRTBoundaryConditions(rcohort) + call copy_cohort(ccohort, rcohort) + + rcohort%n = nplant_recover + + rcohort%crowndamage = ccohort%crowndamage - 1 + + ! Need to adjust the crown area which is NOT on a per individual basis + call carea_allom(dbh,rcohort%n,site_spread,ipft,rcohort%crowndamage,c_area) + !rcohort%n/n_old * ccohort%c_area + !ccohort%c_area = ccohort%c_area - rcohort%c_area + + ! Update properties of the un-recovered (donor) cohort + ccohort%n = ccohort%n - rcohort%n + ccohort%c_area = ccohort%c_area * ccohort%n / (ccohort%n+rcohort%n) + + !----------- Insert copy into linked list ----------------------! + ! This subroutine is called within a loop in EDMain that + ! proceeds short to tall. We want the newly created cohort + ! to have an opportunity to experience the list, so we add + ! it in the list in a position taller than the current cohort + ! --------------------------------------------------------------! + + rcohort%shorter => ccohort + if(associated(ccohort%taller))then + rcohort%taller => ccohort%taller + ccohort%taller%shorter => rcohort + else + cpatch%tallest => rcohort + rcohort%taller => null() + endif + ccohort%taller => rcohort + + end if ! end if greater than nearzero + + end associate - if(currentCohort%crowndamage > 1) then - - ! N is inout boundary condition so has now been updated. The difference must - ! go to a new cohort - n_recover = n_old - currentCohort%n - - if(n_recover > nearzero) then - - 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) - ! call zero_cohort(nc) - call copy_cohort(currentCohort, nc) - - nc%n = n_recover - nc%crowndamage = currentCohort%crowndamage - 1 - - ! Need to adjust the crown area which is NOT on a per individual basis - nc%c_area = nc%n/n_old * currentCohort%c_area - currentCohort%c_area = currentCohort%c_area - nc%c_area - - ! This new cohort spends carbon balance on growing out pools - ! (but not dbh) to reach new allometric targets - ! This was already calculated within parteh - this cohort should just - ! be able to hit allometric targets of one damage class down - call nc%prt%DamageRecovery() - - ! at this point we need to update fluxes or this cohort will - ! fail its mass conservation checks - - sapw_c = nc%prt%GetState(sapw_organ, all_carbon_elements) - struct_c = nc%prt%GetState(struct_organ, all_carbon_elements) - leaf_c = nc%prt%GetState(leaf_organ, all_carbon_elements) - fnrt_c = nc%prt%GetState(fnrt_organ, all_carbon_elements) - store_c = nc%prt%GetState(store_organ, all_carbon_elements) - repro_c = nc%prt%GetState(repro_organ, all_carbon_elements) - nc_carbon = sapw_c + struct_c + leaf_c + fnrt_c + store_c + repro_c - - cc_sapw_c = currentCohort%prt%GetState(sapw_organ, all_carbon_elements) - cc_struct_c = currentCohort%prt%GetState(struct_organ, all_carbon_elements) - cc_leaf_c = currentCohort%prt%GetState(leaf_organ, all_carbon_elements) - cc_fnrt_c = currentCohort%prt%GetState(fnrt_organ, all_carbon_elements) - cc_store_c = currentCohort%prt%GetState(store_organ, all_carbon_elements) - cc_repro_c = currentCohort%prt%GetState(repro_organ, all_carbon_elements) - cc_carbon = cc_sapw_c + cc_struct_c + cc_leaf_c + cc_fnrt_c + cc_store_c + cc_repro_c - - - call PRTDamageRecoveryFluxes(nc%prt, leaf_organ, leaf_c0, leaf_c, cc_leaf_c) - call PRTDamageRecoveryFluxes(nc%prt, repro_organ, repro_c0, repro_c, cc_repro_c) - call PRTDamageRecoveryFluxes(nc%prt, sapw_organ, sapw_c0, sapw_c, cc_sapw_c) - call PRTDamageRecoveryFluxes(nc%prt, struct_organ, struct_c0, struct_c, cc_struct_c) - call PRTDamageRecoveryFluxes(nc%prt, store_organ, store_c0, store_c, cc_store_c) - call PRTDamageRecoveryFluxes(nc%prt, fnrt_organ, fnrt_c0, fnrt_c, cc_fnrt_c) - - ! update crown area - call carea_allom(nc%dbh, nc%n, currentSite%spread, nc%pft, nc%crowndamage, nc%c_area) - call carea_allom(currentCohort%dbh, currentCohort%n, currentSite%spread, & - currentCohort%pft, currentCohort%crowndamage, currentCohort%c_area) - - - - !----------- Insert copy into linked list ----------------------! - nc%shorter => currentCohort - if(associated(currentCohort%taller))then - nc%taller => currentCohort%taller - currentCohort%taller%shorter => nc - else - currentPatch%tallest => nc - nc%taller => null() - endif - currentCohort%taller => nc - - end if ! end if greater than nearzero - - end if ! end if crowndamage > 1 - - - - return end subroutine DamageRecovery diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index c690bf898f..bad98c2eb7 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -314,7 +314,6 @@ subroutine create_cohort(currentSite, patchptr, pft, nn, hite, coage, dbh, & call InitPRTBoundaryConditions(new_cohort) - ! Allocate running mean functions ! (Keeping as an example) @@ -410,7 +409,6 @@ subroutine InitPRTBoundaryConditions(new_cohort) call new_cohort%prt%RegisterBCInOut(ac_bc_inout_id_dbh,bc_rval = new_cohort%dbh) call new_cohort%prt%RegisterBCInOut(ac_bc_inout_id_netdc,bc_rval = new_cohort%npp_acc) - call new_cohort%prt%RegisterBCInOut(ac_bc_inout_id_n,bc_rval = new_cohort%n) call new_cohort%prt%RegisterBCInOut(ac_bc_inout_id_cdamage,bc_ival = new_cohort%crowndamage) call new_cohort%prt%RegisterBCIn(ac_bc_in_id_pft,bc_ival = new_cohort%pft) call new_cohort%prt%RegisterBCIn(ac_bc_in_id_ctrim,bc_rval = new_cohort%canopy_trim) diff --git a/biogeochem/FatesAllometryMod.F90 b/biogeochem/FatesAllometryMod.F90 index a537be5af3..0766ee645a 100644 --- a/biogeochem/FatesAllometryMod.F90 +++ b/biogeochem/FatesAllometryMod.F90 @@ -574,7 +574,6 @@ subroutine bleaf(d,ipft,crowndamage,canopy_trim,bl,dbldd) dbldd = dblmaxdd * canopy_trim end if - if ( crowndamage > 1 ) then call GetCrownReduction(crowndamage, crown_reduction) diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index dce23895ae..66c2c5a936 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -427,97 +427,95 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) currentPatch%age_class = get_age_class_index(currentPatch%age) - ! Update Canopy Biomass Pools + ! Within this loop, we may be creating new cohorts, which + ! are copies of pre-existing cohorts with reduced damage classes. + ! If that is true, we want to bypass some of the things in + ! this loop (such as calculation of npp, etc) because they + ! are derived from the donor and have been modified accordingly + newly_recovered = .false. + currentCohort => currentPatch%shortest do while(associated(currentCohort)) ft = currentCohort%pft - - ! Calculate the mortality derivatives - call Mortality_Derivative( currentSite, currentCohort, bc_in, frac_site_primary ) - - ! ----------------------------------------------------------------------------- - ! Apply Plant Allocation and Reactive Transport - ! ----------------------------------------------------------------------------- - ! ----------------------------------------------------------------------------- - ! Identify the net carbon gain for this dynamics interval - ! Set the available carbon pool, identify allocation portions, and - ! decrement the available carbon pool to zero. - ! ----------------------------------------------------------------------------- - - - if (hlm_use_ed_prescribed_phys .eq. itrue) then - if (currentCohort%canopy_layer .eq. 1) then - currentCohort%npp_acc = EDPftvarcon_inst%prescribed_npp_canopy(ft) & - * currentCohort%c_area / currentCohort%n / hlm_days_per_year + + ! Some cohorts are created and inserted to the list while + ! the loop is going. These are pointed to the "taller" position + ! of current, and then inherit properties of their donor (current) + ! we don't need to repeat things before allocation for these + ! newly_recovered cohorts + + if_newlyrecovered: if(.not.newly_recovered) then + + ! Calculate the mortality derivatives + call Mortality_Derivative( currentSite, currentCohort, bc_in, frac_site_primary ) + + ! ----------------------------------------------------------------------------- + ! Apply Plant Allocation and Reactive Transport + ! ----------------------------------------------------------------------------- + ! ----------------------------------------------------------------------------- + ! Identify the net carbon gain for this dynamics interval + ! Set the available carbon pool, identify allocation portions, and + ! decrement the available carbon pool to zero. + ! ----------------------------------------------------------------------------- + + if (hlm_use_ed_prescribed_phys .eq. itrue) then + if (currentCohort%canopy_layer .eq. 1) then + currentCohort%npp_acc = EDPftvarcon_inst%prescribed_npp_canopy(ft) & + * currentCohort%c_area / currentCohort%n / hlm_days_per_year + else + currentCohort%npp_acc = EDPftvarcon_inst%prescribed_npp_understory(ft) & + * currentCohort%c_area / currentCohort%n / hlm_days_per_year + endif + + ! We don't explicitly define a respiration rate for prescribe phys + ! but we do need to pass mass balance. So we say it is zero respiration + currentCohort%gpp_acc = currentCohort%npp_acc + currentCohort%resp_acc = 0._r8 + + end if + + ! ----------------------------------------------------------------------------- + ! Save NPP/GPP/R in these "hold" style variables. These variables + ! persist after this routine is complete, and used in I/O diagnostics. + ! Whereas the _acc style variables are zero'd because they are key + ! accumulation state variables. + ! + ! convert from kgC/indiv/day into kgC/indiv/year + ! _acc_hold is remembered until the next dynamics step (used for I/O) + ! _acc will be reset soon and will be accumulated on the next leaf + ! photosynthesis step + ! ----------------------------------------------------------------------------- + + currentCohort%npp_acc_hold = currentCohort%npp_acc * real(hlm_days_per_year,r8) + 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) + + ! Conduct Maintenance Turnover (parteh) + if(debug) call currentCohort%prt%CheckMassConservation(ft,3) + if(any(currentSite%dstatus == [phen_dstat_moiston,phen_dstat_timeon])) then + is_drought = .false. else - currentCohort%npp_acc = EDPftvarcon_inst%prescribed_npp_understory(ft) & - * currentCohort%c_area / currentCohort%n / hlm_days_per_year - endif - - ! We don't explicitly define a respiration rate for prescribe phys - ! but we do need to pass mass balance. So we say it is zero respiration - currentCohort%gpp_acc = currentCohort%npp_acc - currentCohort%resp_acc = 0._r8 - - end if - - ! ----------------------------------------------------------------------------- - ! Save NPP/GPP/R in these "hold" style variables. These variables - ! persist after this routine is complete, and used in I/O diagnostics. - ! Whereas the _acc style variables are zero'd because they are key - ! accumulation state variables. - ! - ! convert from kgC/indiv/day into kgC/indiv/year - ! _acc_hold is remembered until the next dynamics step (used for I/O) - ! _acc will be reset soon and will be accumulated on the next leaf - ! photosynthesis step - ! ----------------------------------------------------------------------------- - - currentCohort%npp_acc_hold = currentCohort%npp_acc * real(hlm_days_per_year,r8) - 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) - - - ! Conduct Maintenance Turnover (parteh) - if(debug) call currentCohort%prt%CheckMassConservation(ft,3) - if(any(currentSite%dstatus == [phen_dstat_moiston,phen_dstat_timeon])) then - is_drought = .false. - else - is_drought = .true. - end if - - call PRTMaintTurnover(currentCohort%prt,ft,is_drought) - - ! If the current diameter of a plant is somehow less than what is consistent - ! with what is allometrically consistent with the stuctural biomass, then - ! correct the dbh to match. - + is_drought = .true. + end if + + call PRTMaintTurnover(currentCohort%prt,ft,is_drought) + + ! If the current diameter of a plant is somehow less than what is consistent + ! with what is allometrically consistent with the stuctural biomass, then + ! correct the dbh to match. + + end if if_newlyrecovered + call EvaluateAndCorrectDBH(currentCohort,delta_dbh,delta_hite) - + hite_old = currentCohort%hite dbh_old = currentCohort%dbh - + ! ----------------------------------------------------------------------------- ! Growth and Allocation (PARTEH) ! ----------------------------------------------------------------------------- - ! cohorts will be split during this phase to allow some fraction to recover - ! keep track of starting population - n_old = currentCohort%n - - ! track initial carbon pools - - leaf_c0 = currentCohort%prt%GetState(leaf_organ, all_carbon_elements) - fnrt_c0 = currentCohort%prt%GetState(fnrt_organ, all_carbon_elements) - sapw_c0 = currentCohort%prt%GetState(sapw_organ, all_carbon_elements) - struct_c0 = currentCohort%prt%GetState(struct_organ, all_carbon_elements) - store_c0 = currentCohort%prt%GetState(store_organ, all_carbon_elements) - repro_c0 = currentCohort%prt%GetState(repro_organ, all_carbon_elements) - - total_c0 = sapw_c0 + struct_c0 + leaf_c0 + fnrt_c0 + store_c0 + repro_c0 - cc_carbon = 0.0_r8 ! need to set it here to avoid nan errors if conditions aren't met below - ! We split the allocation into phases (currently for all hypotheses) ! In phase 1, allocation gets the mass of organs to match targets ! In phase 2, allocation increases the mass of organs along with stature growth (dbh) @@ -531,8 +529,9 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) ! to grow in stature (phase 2) call currentCohort%prt%DailyPRT(phase=1) - if(hlm_use_crown_damage .eq. itrue) then - + + if((newly_recovered .eq. .false.) .and. & + (hlm_use_crown_damage .eq. itrue) ) then ! The loop order is shortest to tallest ! The recovered cohort (ie one with larger targets) ! is newly created in DamageRecovery(), and @@ -540,19 +539,22 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) ! original and current (unrecovered) cohort. ! we pass it back here in case the pointer is ! needed for diagnostics - call DamageRecovery(currentCohort,recoveredCohort) + call DamageRecovery(currentSite,currentPatch,currentCohort,newly_recovered) + + ! New targets may have been issued (based on damage status). If so, + ! we need to repeat phase 1 of allocation. This only happens if + ! the cohort is NOT split, and the whole thing graduates to a lesser + ! damage class + if(.not.newly_recovered)then + call currentCohort%prt%DailyPRT(phase=1) + end if + + else + newly_recovered = .false. end if call currentCohort%prt%DailyPRT(phase=2) - - if(hlm_use_crown_damage .eq. itrue) then - - - - end if ! end if crowndamage is on - - ! Update the mass balance tracking for the daily nutrient uptake flux ! Then zero out the daily uptakes, they have been used ! ----------------------------------------------------------------------------- @@ -688,11 +690,8 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) call coagetype_class_index(currentCohort%coage, currentCohort%pft, & currentCohort%coage_class,currentCohort%coage_by_pft_class) end if - currentCohort => currentCohort%taller - - end do currentPatch => currentPatch%older diff --git a/parteh/PRTAllometricCarbonMod.F90 b/parteh/PRTAllometricCarbonMod.F90 index b4194919db..746ca38ebf 100644 --- a/parteh/PRTAllometricCarbonMod.F90 +++ b/parteh/PRTAllometricCarbonMod.F90 @@ -90,9 +90,8 @@ module PRTAllometricCarbonMod integer, public, parameter :: ac_bc_inout_id_dbh = 1 ! Plant DBH integer, public, parameter :: ac_bc_inout_id_netdc = 2 ! Index for the net daily C input BC - integer, public, parameter :: ac_bc_inout_id_n = 3 ! Number of plants - integer, public, parameter :: ac_bc_inout_id_cdamage = 4 ! Index for the crowndamage input BC - integer, parameter :: num_bc_inout = 4 ! Number of in & output boundary conditions + integer, public, parameter :: ac_bc_inout_id_cdamage = 3 ! Index for the crowndamage input BC + integer, parameter :: num_bc_inout = 3 ! Number of in & output boundary conditions integer, public, parameter :: ac_bc_in_id_pft = 1 ! Index for the PFT input BC @@ -434,7 +433,6 @@ subroutine DailyPRTAllometricCarbon(this) dbh => this%bc_inout(ac_bc_inout_id_dbh)%rval carbon_balance => this%bc_inout(ac_bc_inout_id_netdc)%rval - n => this%bc_inout(ac_bc_inout_id_n)%rval crowndamage => this%bc_inout(ac_bc_inout_id_cdamage)%ival canopy_trim = this%bc_in(ac_bc_in_id_ctrim)%rval @@ -1152,70 +1150,6 @@ subroutine FastPRTAllometricCarbon(this) return end subroutine FastPRTAllometricCarbon - !------------------------------------------------------------------------------- - - subroutine PRTDamageRecovery(this) - ! ---------------------------------------------------------------------------------- - ! We are assigning mass to each organ based on the allometric targets - ! ---------------------------------------------------------------------------------- - class(callom_prt_vartypes) :: this - - - real(r8),pointer :: dbh - integer, pointer :: crowndamage - real(r8) :: canopy_trim - integer :: ipft - real(r8) :: target_leaf_c ! target leaf carbon [kgC] - real(r8) :: target_fnrt_c ! target fine-root carbon [kgC] - real(r8) :: target_sapw_c ! target sapwood carbon [kgC] - real(r8) :: target_store_c ! target storage carbon [kgC] - real(r8) :: target_agw_c ! target above ground carbon in woody tissues [kgC] - real(r8) :: target_bgw_c ! target below ground carbon in woody tissues [kgC] - real(r8) :: target_struct_c ! target structural carbon [kgC] - real(r8) :: sapw_area ! dummy var, x-section area of sapwood [m2] - integer :: leaf_status - real(r8) :: leaf_c_flux - integer, parameter :: iexp_leaf = 1 ! index 1 is the expanding leaf age class and - ! therefore all new carbon goes into that pool - - associate ( & - leaf_c => this%variables(leaf_c_id)%val, & - fnrt_c => this%variables(fnrt_c_id)%val(icd), & - sapw_c => this%variables(sapw_c_id)%val(icd), & - store_c => this%variables(store_c_id)%val(icd), & - repro_c => this%variables(repro_c_id)%val(icd), & - struct_c => this%variables(struct_c_id)%val(icd)) - - dbh => this%bc_inout(ac_bc_inout_id_dbh)%rval - crowndamage => this%bc_inout(ac_bc_inout_id_cdamage)%ival - canopy_trim = this%bc_in(ac_bc_in_id_ctrim)%rval - ipft = this%bc_in(ac_bc_in_id_pft)%ival - leaf_status = this%bc_in(ac_bc_in_id_lstat)%ival - - ! Get allometric targets for this dbh and crown damage class - call bsap_allom(dbh, ipft, crowndamage, canopy_trim, sapw_area, target_sapw_c) - call bagw_allom(dbh, ipft, crowndamage, target_agw_c) - call bbgw_allom(dbh, ipft, target_bgw_c) - call bdead_allom(target_agw_c, target_bgw_c, target_sapw_c, ipft, target_struct_c) - if(leaf_status ==2)then - call bleaf(dbh, ipft, crowndamage, canopy_trim, target_leaf_c) - else - target_leaf_c = 0.0_r8 - end if - call bfineroot(dbh, ipft, canopy_trim, target_fnrt_c) - call bstore_allom(dbh, ipft,crowndamage, canopy_trim, target_store_c) - - ! Now we assign these targets to the actual biomass pools - fnrt_c = max(target_fnrt_c, fnrt_c) - store_c = max(target_store_c, store_c) - sapw_c = max(target_sapw_c, sapw_c) - struct_c = max(target_struct_c, struct_c) - leaf_c_flux = target_leaf_c - sum(leaf_c) - leaf_c(iexp_leaf) = leaf_c(iexp_leaf) + leaf_c_flux - - end associate - end subroutine PRTDamageRecovery - ! ===================================================================================== end module PRTAllometricCarbonMod From 02b661a7254bb57813f247bd4d573ccb304ff014 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 30 Jun 2022 14:45:25 -0400 Subject: [PATCH 49/84] Minor updates to damage recovery --- biogeochem/DamageMainMod.F90 | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/biogeochem/DamageMainMod.F90 b/biogeochem/DamageMainMod.F90 index 650d0f8ddd..d015cc79ea 100644 --- a/biogeochem/DamageMainMod.F90 +++ b/biogeochem/DamageMainMod.F90 @@ -114,8 +114,6 @@ subroutine DamageRecovery(csite,cpatch,ccohort,newly_recovered) return end if - cpatch => ccohort%patchptr - ! If we have not returned, then this cohort both has ! a damaged status, and the ability to recover from that damage @@ -197,6 +195,10 @@ subroutine DamageRecovery(csite,cpatch,ccohort,newly_recovered) target_repro_m = 0._r8 target_store_m = StorageNutrientTarget(ipft, element_list(el), & leaf_target_m, fnrt_target_m, sapw_target_m, struct_target_m) + ! For nutrients, all uptake is immediately put into storage, so just swap + ! them and assume storage is what is available, but needs to be filled up + available_m = store_m + store_m = 0._r8 end select ! 1. What is excess carbon? @@ -258,7 +260,7 @@ subroutine DamageRecovery(csite,cpatch,ccohort,newly_recovered) rcohort%crowndamage = ccohort%crowndamage - 1 ! Need to adjust the crown area which is NOT on a per individual basis - call carea_allom(dbh,rcohort%n,site_spread,ipft,rcohort%crowndamage,c_area) + call carea_allom(dbh,rcohort%n,csite%spread,ipft,rcohort%crowndamage,rcohort%c_area) !rcohort%n/n_old * ccohort%c_area !ccohort%c_area = ccohort%c_area - rcohort%c_area From db144732cef952429a6c2ca3293aeb5f09eb7b8c Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 30 Jun 2022 17:02:52 -0400 Subject: [PATCH 50/84] Applying the phase argument to carbon allocation in parteh --- biogeochem/DamageMainMod.F90 | 12 +- main/EDMainMod.F90 | 21 +- parteh/PRTAllometricCarbonMod.F90 | 954 +++++++++++++++--------------- parteh/PRTGenericMod.F90 | 5 +- 4 files changed, 491 insertions(+), 501 deletions(-) diff --git a/biogeochem/DamageMainMod.F90 b/biogeochem/DamageMainMod.F90 index d015cc79ea..c2cef680e4 100644 --- a/biogeochem/DamageMainMod.F90 +++ b/biogeochem/DamageMainMod.F90 @@ -346,9 +346,9 @@ subroutine IsItDamageTime(is_master, currentSite) else if(icode > 10000 ) then ! Specific Event: YYYYMMDD - damage_date = icode - int(100* floor(real(icode)/100)) - damage_year = floor(real(icode)/10000) - damage_month = floor(real(icode)/100) - damage_year*100 + damage_date = icode - int(100* floor(real(icode,r8)/100._r8)) + damage_year = floor(real(icode,r8)/10000._r8) + damage_month = floor(real(icode,r8)/100._r8) - damage_year*100 if(hlm_current_day .eq. damage_date .and. & hlm_current_month .eq. damage_month .and. & @@ -422,7 +422,7 @@ subroutine GetCrownReduction(crowndamage, crown_reduction) real(r8) :: class_width class_width = 1.0_r8/nlevdamage - crown_reduction = min(1.0_r8, (real(crowndamage) - 1.0_r8) * class_width) + crown_reduction = min(1.0_r8, (real(crowndamage,r8) - 1.0_r8) * class_width) return end subroutine GetCrownReduction @@ -446,7 +446,7 @@ subroutine GetDamageMortality(crowndamage,pft, dgmort) real(r8) :: class_width real(r8) :: crown_loss - class_width = 1.0_r8/real(nlevdamage) + class_width = 1.0_r8/real(nlevdamage,r8) ! parameter to determine slope of exponential damage_mort_p1 = EDPftvarcon_inst%damage_mort_p1(pft) @@ -455,7 +455,7 @@ subroutine GetDamageMortality(crowndamage,pft, dgmort) ! make damage mortality a function of crownloss and not crowndamage ! class so that it doesn't need to be re-parameterised if the number ! of damage classes change. - crown_loss = min(1.0_r8, (real(crowndamage) - 1.0_r8) * class_width) + crown_loss = min(1.0_r8, (real(crowndamage,r8) - 1.0_r8) * class_width) if (crowndamage .eq. 1 ) then dgmort = 0.0_r8 diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index 66c2c5a936..03e9903de8 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -445,7 +445,7 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) ! we don't need to repeat things before allocation for these ! newly_recovered cohorts - if_newlyrecovered: if(.not.newly_recovered) then + if_not_newlyrecovered: if(.not.newly_recovered) then ! Calculate the mortality derivatives call Mortality_Derivative( currentSite, currentCohort, bc_in, frac_site_primary ) @@ -500,13 +500,22 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) end if call PRTMaintTurnover(currentCohort%prt,ft,is_drought) - - ! If the current diameter of a plant is somehow less than what is consistent - ! with what is allometrically consistent with the stuctural biomass, then - ! correct the dbh to match. - end if if_newlyrecovered + + ! ----------------------------------------------------------------------------------- + ! Call the routine that advances leaves in age. + ! This will move a portion of the leaf mass in each + ! age bin, to the next bin. This will not handle movement + ! of mass from the oldest bin into the litter pool, that is something else. + ! ----------------------------------------------------------------------------------- + call currentCohort%prt%AgeLeaves(ft,sec_per_day) + + end if if_not_newlyrecovered + + ! If the current diameter of a plant is somehow less than what is consistent + ! with what is allometrically consistent with the stuctural biomass, then + ! correct the dbh to match. call EvaluateAndCorrectDBH(currentCohort,delta_dbh,delta_hite) hite_old = currentCohort%hite diff --git a/parteh/PRTAllometricCarbonMod.F90 b/parteh/PRTAllometricCarbonMod.F90 index 746ca38ebf..d2bce65d35 100644 --- a/parteh/PRTAllometricCarbonMod.F90 +++ b/parteh/PRTAllometricCarbonMod.F90 @@ -125,7 +125,6 @@ module PRTAllometricCarbonMod procedure :: DailyPRT => DailyPRTAllometricCarbon procedure :: FastPRT => FastPRTAllometricCarbon - procedure :: DamageRecovery => PRTDamageRecovery end type callom_prt_vartypes @@ -244,7 +243,7 @@ end subroutine InitPRTGlobalAllometricCarbon ! ===================================================================================== - subroutine DailyPRTAllometricCarbon(this) + subroutine DailyPRTAllometricCarbon(this,phase) ! ----------------------------------------------------------------------------------- ! @@ -286,25 +285,26 @@ subroutine DailyPRTAllometricCarbon(this) ! ! ---------------------------------------------------------------------------------- - - ! The class is the only argument + class(callom_prt_vartypes) :: this ! this class + integer,intent(in) :: phase ! the phase splits the routine into parts + ! ----------------------------------------------------------------------------------- ! These are local copies of the in/out boundary condition structure ! ----------------------------------------------------------------------------------- real(r8),pointer :: dbh ! Diameter at breast height [cm] - ! this local will point to both in and out bc's + ! this local will point to both in and out bc's real(r8),pointer :: carbon_balance ! Daily carbon balance for this cohort [kgC] real(r8), pointer :: n ! number of plants integer, pointer :: crowndamage ! which crown damage class - - + + real(r8) :: canopy_trim ! The canopy trimming function [0-1] integer :: ipft ! Plant Functional Type index - + real(r8) :: target_leaf_c ! target leaf carbon [kgC] real(r8) :: target_fnrt_c ! target fine-root carbon [kgC] real(r8) :: target_sapw_c ! target sapwood carbon [kgC] @@ -323,14 +323,14 @@ subroutine DailyPRTAllometricCarbon(this) real(r8) :: total_below_target ! total biomass below the allometric target [kgC] real(r8) :: allocation_factor ! allocation factor (relative to demand) to - ! reconstruct tissues + ! reconstruct tissues real(r8) :: flux_adj ! adjustment made to growth flux term to minimize error [kgC] real(r8) :: store_target_fraction ! ratio between storage and leaf biomass when on allometry [kgC] real(r8) :: leaf_c_demand ! leaf carbon that is demanded to replace maintenance turnover [kgC] real(r8) :: fnrt_c_demand ! fineroot carbon that is demanded to replace - ! maintenance turnover [kgC] + ! maintenance turnover [kgC] real(r8) :: total_c_demand ! total carbon that is demanded to replace maintenance turnover [kgC] logical :: step_pass ! Did the integration step pass? @@ -343,7 +343,7 @@ subroutine DailyPRTAllometricCarbon(this) real(r8),dimension(max_nleafage) :: leaf_c0 - ! Initial value of carbon used to determine net flux + ! Initial value of carbon used to determine net flux real(r8) :: fnrt_c0 ! during this routine real(r8) :: sapw_c0 ! "" real(r8) :: store_c0 ! "" @@ -356,7 +356,7 @@ subroutine DailyPRTAllometricCarbon(this) logical :: grow_sapw ! Is sapwood at allometric target and should be grown? logical :: grow_store ! Is storage at allometric target and should be grown? - ! integrator variables + ! integrator variables real(r8) :: deltaC ! trial value for substep integer :: ierr ! error flag for allometric growth step integer :: nsteps ! number of sub-steps @@ -370,22 +370,6 @@ subroutine DailyPRTAllometricCarbon(this) integer :: leaf_status ! are leaves on (2) or off (1) real(r8) :: leaf_age_flux ! carbon mass flux between leaf age classification pools - ! for recovery dynamics - real(r8) :: mass_d - real(r8) :: mass_dminus1 - real(r8) :: recovery_demand - real(r8) :: targetn_sapw_c - real(r8) :: targetn_agw_c - real(r8) :: targetn_bgw_c - real(r8) :: targetn_struct_c - real(r8) :: targetn_leaf_c - real(r8) :: targetn_store_c - real(r8) :: targetn_fnrt_c - real(r8) :: max_recover_n - real(r8) :: n_recover - real(r8) :: damage_recovery_scalar - real(r8) :: carbon_balance2 - ! Integegrator variables c_pool is "mostly" carbon variables, it also includes ! dbh... ! ----------------------------------------------------------------------------------- @@ -401,501 +385,497 @@ subroutine DailyPRTAllometricCarbon(this) integer, parameter :: ODESolve = 2 ! 1=RKF45, 2=Euler integer, parameter :: iexp_leaf = 1 ! index 1 is the expanding (i.e. youngest) - ! leaf age class, and therefore - ! all new allocation goes into that pool + ! leaf age class, and therefore + ! all new allocation goes into that pool character(len= 9), parameter :: fmti = '(a,1x,i5)' character(len=13), parameter :: fmt0 = '(a,1x,es12.5)' character(len=19), parameter :: fmth = '(a,1x,a5,3(1x,a12))' character(len=22), parameter :: fmtg = '(a,5x,l1,3(1x,es12.5))' real(r8) :: intgr_params(num_bc_in+1) ! The boundary conditions to this routine, - ! are pressed into an array that is also - ! passed to the integrators - ! add one because we pass crown damage also - ! which is not a bc_in - + ! are pressed into an array that is also + ! passed to the integrators + ! add one because we pass crown damage also + ! which is not a bc_in - associate( & + associate( & + leaf_c => this%variables(leaf_c_id)%val, & - fnrt_c => this%variables(fnrt_c_id)%val(icd), & - sapw_c => this%variables(sapw_c_id)%val(icd), & - store_c => this%variables(store_c_id)%val(icd), & - repro_c => this%variables(repro_c_id)%val(icd), & - struct_c => this%variables(struct_c_id)%val(icd)) + fnrt_c => this%variables(fnrt_c_id)%val(icd), & + sapw_c => this%variables(sapw_c_id)%val(icd), & + store_c => this%variables(store_c_id)%val(icd), & + repro_c => this%variables(repro_c_id)%val(icd), & + struct_c => this%variables(struct_c_id)%val(icd)) - ! ----------------------------------------------------------------------------------- - ! 0. - ! Copy the boundary conditions into readable local variables. - ! We don't use pointers for bc's that ar "in" only, only "in-out" and "out" - ! ----------------------------------------------------------------------------------- + ! ----------------------------------------------------------------------------------- + ! 0. + ! Copy the boundary conditions into readable local variables. + ! We don't use pointers for bc's that ar "in" only, only "in-out" and "out" + ! ----------------------------------------------------------------------------------- + + dbh => this%bc_inout(ac_bc_inout_id_dbh)%rval + carbon_balance => this%bc_inout(ac_bc_inout_id_netdc)%rval + crowndamage => this%bc_inout(ac_bc_inout_id_cdamage)%ival + + canopy_trim = this%bc_in(ac_bc_in_id_ctrim)%rval + ipft = this%bc_in(ac_bc_in_id_pft)%ival + leaf_status = this%bc_in(ac_bc_in_id_lstat)%ival + + nleafage = prt_global%state_descriptor(leaf_c_id)%num_pos ! Number of leaf age class - dbh => this%bc_inout(ac_bc_inout_id_dbh)%rval - carbon_balance => this%bc_inout(ac_bc_inout_id_netdc)%rval - crowndamage => this%bc_inout(ac_bc_inout_id_cdamage)%ival - - canopy_trim = this%bc_in(ac_bc_in_id_ctrim)%rval - ipft = this%bc_in(ac_bc_in_id_pft)%ival - leaf_status = this%bc_in(ac_bc_in_id_lstat)%ival - - intgr_params(:) = un_initialized - intgr_params(ac_bc_in_id_ctrim) = this%bc_in(ac_bc_in_id_ctrim)%rval - intgr_params(ac_bc_in_id_pft) = real(this%bc_in(ac_bc_in_id_pft)%ival) - intgr_params(num_bc_in + 1) = real(this%bc_inout(ac_bc_inout_id_cdamage)%ival) - - nleafage = prt_global%state_descriptor(leaf_c_id)%num_pos ! Number of leaf age class - damage_recovery_scalar = prt_params%damage_recovery_scalar(ipft) - - ! ----------------------------------------------------------------------------------- - ! Call the routine that advances leaves in age. - ! This will move a portion of the leaf mass in each - ! age bin, to the next bin. This will not handle movement - ! of mass from the oldest bin into the litter pool, that is something else. - ! ----------------------------------------------------------------------------------- - call this%AgeLeaves(ipft,sec_per_day) + ! ----------------------------------------------------------------------------------- + ! I. Remember the values for the state variables at the beginning of this + ! routines. We will then use that to determine their net allocation and reactive + ! transport flux "%net_alloc" at the end. + ! ----------------------------------------------------------------------------------- + + leaf_c0(1:nleafage) = leaf_c(1:nleafage) ! Set initial leaf carbon + fnrt_c0 = fnrt_c ! Set initial fine-root carbon + sapw_c0 = sapw_c ! Set initial sapwood carbon + store_c0 = store_c ! Set initial storage carbon + repro_c0 = repro_c ! Set initial reproductive carbon + struct_c0 = struct_c ! Set initial structural carbon + + ! ----------------------------------------------------------------------------------- + ! II. Calculate target size of the biomass compartment for a given dbh. + ! ----------------------------------------------------------------------------------- - ! ----------------------------------------------------------------------------------- - ! I. Remember the values for the state variables at the beginning of this - ! routines. We will then use that to determine their net allocation and reactive - ! transport flux "%net_alloc" at the end. - ! ----------------------------------------------------------------------------------- - - leaf_c0(1:nleafage) = leaf_c(1:nleafage) ! Set initial leaf carbon - fnrt_c0 = fnrt_c ! Set initial fine-root carbon - sapw_c0 = sapw_c ! Set initial sapwood carbon - store_c0 = store_c ! Set initial storage carbon - repro_c0 = repro_c ! Set initial reproductive carbon - struct_c0 = struct_c ! Set initial structural carbon + ! Target sapwood biomass according to allometry and trimming [kgC] + call bsap_allom(dbh,ipft, crowndamage, canopy_trim,sapw_area,target_sapw_c) - ! ----------------------------------------------------------------------------------- - ! II. Calculate target size of the biomass compartment for a given dbh. - ! ----------------------------------------------------------------------------------- - - ! Target sapwood biomass according to allometry and trimming [kgC] - call bsap_allom(dbh,ipft, crowndamage, canopy_trim,sapw_area,target_sapw_c) - - ! Target total above ground biomass in woody/fibrous tissues [kgC] - call bagw_allom(dbh,ipft, crowndamage, target_agw_c) - - ! Target total below ground biomass in woody/fibrous tissues [kgC] - call bbgw_allom(dbh,ipft,target_bgw_c) - - ! Target total dead (structrual) biomass [kgC] - call bdead_allom( target_agw_c, target_bgw_c, target_sapw_c, ipft, target_struct_c) - - ! Target leaf biomass according to allometry and trimming - select case (leaf_status) - case (leaves_on) - call bleaf(dbh,ipft,crowndamage,canopy_trim,target_leaf_c) - case (leaves_off) - target_leaf_c = 0._r8 - end select - - ! Target fine-root biomass and deriv. according to allometry and trimming [kgC, kgC/cm] - call bfineroot(dbh,ipft,canopy_trim,target_fnrt_c) - - ! Target storage carbon [kgC,kgC/cm] - call bstore_allom(dbh,ipft,crowndamage,canopy_trim,target_store_c) + ! Target total above ground biomass in woody/fibrous tissues [kgC] + call bagw_allom(dbh,ipft, crowndamage, target_agw_c) + + ! Target total below ground biomass in woody/fibrous tissues [kgC] + call bbgw_allom(dbh,ipft,target_bgw_c) + + ! Target total dead (structrual) biomass [kgC] + call bdead_allom( target_agw_c, target_bgw_c, target_sapw_c, ipft, target_struct_c) + + ! Target leaf biomass according to allometry and trimming + select case (leaf_status) + case (leaves_on) + call bleaf(dbh,ipft,crowndamage,canopy_trim,target_leaf_c) + case (leaves_off) + target_leaf_c = 0._r8 + end select + + ! Target fine-root biomass and deriv. according to allometry and trimming [kgC, kgC/cm] + call bfineroot(dbh,ipft,canopy_trim,target_fnrt_c) + ! Target storage carbon [kgC,kgC/cm] + call bstore_allom(dbh,ipft,crowndamage,canopy_trim,target_store_c) - ! ----------------------------------------------------------------------------------- - ! III. Prioritize some amount of carbon to replace leaf/root turnover - ! Make sure it isn't a negative payment, and either pay what is available - ! or forcefully pay from storage. - ! ----------------------------------------------------------------------------------- - - if( prt_params%evergreen(ipft) == itrue ) then - leaf_c_demand = max(0.0_r8, & - prt_params%leaf_stor_priority(ipft)*sum(this%variables(leaf_c_id)%turnover(:))) - else - leaf_c_demand = 0.0_r8 - end if - - fnrt_c_demand = max(0.0_r8, & - prt_params%leaf_stor_priority(ipft)*this%variables(fnrt_c_id)%turnover(icd)) - - total_c_demand = leaf_c_demand + fnrt_c_demand - - if (total_c_demand > nearzero) then - - ! We pay this even if we don't have the carbon - ! Just don't pay so much carbon that storage+carbon_balance can't pay for it - allocation_factor = max(0.0_r8,min(1.0_r8,(store_c+carbon_balance)/total_c_demand)) - - ! MLO. Edited the code to switch the order of operations. The previous code would - ! subtract leaf flux from carbon balance before estimating the fine root flux, - ! potentially allowing less fluxes to fine roots than possible. - leaf_c_flux = leaf_c_demand * allocation_factor - fnrt_c_flux = fnrt_c_demand * allocation_factor - - ! Add carbon to the youngest age pool (i.e iexp_leaf = index 1) and fine roots - leaf_c(iexp_leaf) = leaf_c(iexp_leaf) + leaf_c_flux - fnrt_c = fnrt_c + fnrt_c_flux - - ! Remove fluxes from carbon balance. In case we may have drawn carbon from storage, - ! carbon_balance will become negative, in which case we will deplete carbon from - ! storage in the next step. - carbon_balance = carbon_balance - ( leaf_c_flux + fnrt_c_flux ) - end if + ! ----------------------------------------------------------------------------------- + ! Phase 1: Replace losses, push pools towards targets + ! ----------------------------------------------------------------------------------- - ! ----------------------------------------------------------------------------------- - ! IV. if carbon balance is negative, re-coup the losses from storage - ! if it is positive, give some love to storage carbon - ! ----------------------------------------------------------------------------------- + if_phase: if(phase.eq.1) then - if( carbon_balance < 0.0_r8 ) then + ! III. Prioritize some amount of carbon to replace leaf/root turnover + ! Make sure it isn't a negative payment, and either pay what is available + ! or forcefully pay from storage. + ! ----------------------------------------------------------------------------------- + + if( prt_params%evergreen(ipft) == itrue ) then + leaf_c_demand = max(0.0_r8, & + prt_params%leaf_stor_priority(ipft)*sum(this%variables(leaf_c_id)%turnover(:))) + else + leaf_c_demand = 0.0_r8 + end if + + fnrt_c_demand = max(0.0_r8, & + prt_params%leaf_stor_priority(ipft)*this%variables(fnrt_c_id)%turnover(icd)) - ! Store_c_flux will be negative, so store_c will be depleted - store_c_flux = carbon_balance - carbon_balance = carbon_balance - store_c_flux - store_c = store_c + store_c_flux + total_c_demand = leaf_c_demand + fnrt_c_demand + + if (total_c_demand > nearzero) then - else + ! We pay this even if we don't have the carbon + ! Just don't pay so much carbon that storage+carbon_balance can't pay for it + allocation_factor = max(0.0_r8,min(1.0_r8,(store_c+carbon_balance)/total_c_demand)) + + ! MLO. Edited the code to switch the order of operations. The previous code would + ! subtract leaf flux from carbon balance before estimating the fine root flux, + ! potentially allowing less fluxes to fine roots than possible. + leaf_c_flux = leaf_c_demand * allocation_factor + fnrt_c_flux = fnrt_c_demand * allocation_factor + + ! Add carbon to the youngest age pool (i.e iexp_leaf = index 1) and fine roots + leaf_c(iexp_leaf) = leaf_c(iexp_leaf) + leaf_c_flux + fnrt_c = fnrt_c + fnrt_c_flux + + ! Remove fluxes from carbon balance. In case we may have drawn carbon from storage, + ! carbon_balance will become negative, in which case we will deplete carbon from + ! storage in the next step. + carbon_balance = carbon_balance - ( leaf_c_flux + fnrt_c_flux ) + end if + + ! ----------------------------------------------------------------------------------- + ! IV. if carbon balance is negative, re-coup the losses from storage + ! if it is positive, give some love to storage carbon + ! ----------------------------------------------------------------------------------- - ! Accumulate some carbon in storage. If storage is completely depleted, aim to - ! increase storage, but not to replenish completely so we can still use some - ! carbon for growth. - store_below_target = max(0.0_r8,target_store_c - store_c) - store_target_fraction = max(0.0_r8, store_c/target_store_c ) + if( carbon_balance < 0.0_r8 ) then - store_c_flux = min(store_below_target,carbon_balance * & - max(exp(-1.*store_target_fraction**4._r8) - exp( -1.0_r8 ),0.0_r8)) + ! Store_c_flux will be negative, so store_c will be depleted + store_c_flux = carbon_balance + carbon_balance = carbon_balance - store_c_flux + store_c = store_c + store_c_flux - ! Move carbon from carbon balance to storage - carbon_balance = carbon_balance - store_c_flux - store_c = store_c + store_c_flux + else - end if + ! Accumulate some carbon in storage. If storage is completely depleted, aim to + ! increase storage, but not to replenish completely so we can still use some + ! carbon for growth. + store_below_target = max(0.0_r8,target_store_c - store_c) + store_target_fraction = max(0.0_r8, store_c/target_store_c ) - ! ----------------------------------------------------------------------------------- - ! V. If carbon is still available, prioritize some allocation to replace - ! the rest of the leaf/fineroot deficit - ! carbon balance is guaranteed to be >=0 beyond this point - ! MLO. Renamed demand with below target to make it consistent with the - ! definitions at the variable declaration part. - ! ----------------------------------------------------------------------------------- + store_c_flux = min(store_below_target,carbon_balance * & + max(exp(-1.*store_target_fraction**4._r8) - exp( -1.0_r8 ),0.0_r8)) - leaf_below_target = max(0.0_r8,target_leaf_c - sum(leaf_c(1:nleafage))) - fnrt_below_target = max(0.0_r8,target_fnrt_c - fnrt_c) + ! Move carbon from carbon balance to storage + carbon_balance = carbon_balance - store_c_flux + store_c = store_c + store_c_flux - total_below_target = leaf_below_target + fnrt_below_target + end if - if ( (carbon_balance > nearzero) .and. (total_below_target > nearzero) ) then - ! Find fraction of carbon to be allocated to leaves and fine roots - allocation_factor = min(1.0_r8, carbon_balance / total_below_target) + ! ----------------------------------------------------------------------------------- + ! V. If carbon is still available, prioritize some allocation to replace + ! the rest of the leaf/fineroot deficit + ! carbon balance is guaranteed to be >=0 beyond this point + ! MLO. Renamed demand with below target to make it consistent with the + ! definitions at the variable declaration part. + ! ----------------------------------------------------------------------------------- - ! MLO. Edited the code to switch the order of operations. The previous code would - ! subtract leaf flux from carbon balance before estimating the fine root flux, - ! potentially allowing less fluxes to fine roots than possible. - leaf_c_flux = leaf_below_target * allocation_factor - fnrt_c_flux = fnrt_below_target * allocation_factor + leaf_below_target = max(0.0_r8,target_leaf_c - sum(leaf_c(1:nleafage))) + fnrt_below_target = max(0.0_r8,target_fnrt_c - fnrt_c) - leaf_c(iexp_leaf) = leaf_c(iexp_leaf) + leaf_c_flux - fnrt_c = fnrt_c + fnrt_c_flux + total_below_target = leaf_below_target + fnrt_below_target + + if ( (carbon_balance > nearzero) .and. (total_below_target > nearzero) ) then + ! Find fraction of carbon to be allocated to leaves and fine roots + allocation_factor = min(1.0_r8, carbon_balance / total_below_target) - carbon_balance = carbon_balance - ( leaf_c_flux + fnrt_c_flux ) + ! MLO. Edited the code to switch the order of operations. The previous code would + ! subtract leaf flux from carbon balance before estimating the fine root flux, + ! potentially allowing less fluxes to fine roots than possible. + leaf_c_flux = leaf_below_target * allocation_factor + fnrt_c_flux = fnrt_below_target * allocation_factor - end if + leaf_c(iexp_leaf) = leaf_c(iexp_leaf) + leaf_c_flux + fnrt_c = fnrt_c + fnrt_c_flux + + carbon_balance = carbon_balance - ( leaf_c_flux + fnrt_c_flux ) + + end if + + ! ----------------------------------------------------------------------------------- + ! VI. If carbon is still available, we try to push all live + ! pools back towards allometry. But only upwards, if fusion happened + ! to generate some pools above allometric target, don't reduce the pool, + ! just ignore it until the rest of the plant grows to meet it. + ! ----------------------------------------------------------------------------------- + if( carbon_balance > nearzero ) then + + leaf_below_target = max(target_leaf_c - sum(leaf_c(1:nleafage)),0.0_r8) + fnrt_below_target = max(target_fnrt_c - fnrt_c,0.0_r8) + sapw_below_target = max(target_sapw_c - sapw_c,0.0_r8) + store_below_target = max(target_store_c - store_c,0.0_r8) + + total_below_target = leaf_below_target + fnrt_below_target + & + sapw_below_target + store_below_target + + if ( total_below_target > nearzero ) then + ! Find allocation factor based on available carbon and total demand to meet target. + allocation_factor = min(1.0_r8, carbon_balance / total_below_target) + + ! Find fluxes to individual pools + leaf_c_flux = leaf_below_target * allocation_factor + fnrt_c_flux = fnrt_below_target * allocation_factor + sapw_c_flux = sapw_below_target * allocation_factor + store_c_flux = store_below_target * allocation_factor + + leaf_c(iexp_leaf) = leaf_c(iexp_leaf) + leaf_c_flux + fnrt_c = fnrt_c + fnrt_c_flux + sapw_c = sapw_c + sapw_c_flux + store_c = store_c + store_c_flux + + carbon_balance = carbon_balance - & + ( leaf_c_flux + fnrt_c_flux + sapw_c_flux + store_c_flux ) + end if + end if + + ! ----------------------------------------------------------------------------------- + ! VII. If carbon is still available, replenish the structural pool to get + ! back on allometry + ! ----------------------------------------------------------------------------------- + + if( carbon_balance > nearzero ) then + + struct_below_target = max(target_struct_c - struct_c ,0.0_r8) + + if ( struct_below_target > 0.0_r8) then + + struct_c_flux = min(carbon_balance,struct_below_target) + carbon_balance = carbon_balance - struct_c_flux + struct_c = struct_c + struct_c_flux + + end if + + end if + + elseif( (phase.eq.2) .and. ( carbon_balance > calloc_abs_error ) then + + ! ----------------------------------------------------------------------------------- + ! VIII. If carbon is yet still available ... + ! Our pools are now either on allometry or above (from fusion). + ! We we can increment those pools at or below, + ! including structure and reproduction according to their rates + ! Use an adaptive euler integration. If the error is not nominal, + ! the carbon balance sub-step (deltaC) will be halved and tried again + ! + ! Note that we compare against calloc_abs_error here because it is possible + ! that all the carbon was effectively used up, but a miniscule amount + ! remains due to numerical precision (ie -20 or so), so even though + ! the plant has not been brought to be "on allometry", it thinks it has carbon + ! left to allocate, and thus it must be on allometry when its not. + ! ----------------------------------------------------------------------------------- + + intgr_params(:) = un_initialized + intgr_params(ac_bc_in_id_ctrim) = this%bc_in(ac_bc_in_id_ctrim)%rval + intgr_params(ac_bc_in_id_pft) = real(this%bc_in(ac_bc_in_id_pft)%ival) + intgr_params(num_bc_in + 1) = real(this%bc_inout(ac_bc_inout_id_cdamage)%ival) + + + + ! This routine checks that actual carbon is not below that targets. It does + ! allow actual pools to be above the target, and in these cases, it sends + ! a false on the "grow_<>" flag, allowing the plant to grow into these pools. + ! It also checks to make sure that structural biomass is not above the target. + ! ( MLO. Removed the check for storage because the same test is done inside + ! sub-routine TargetAllometryCheck.) + + call TargetAllometryCheck(sum(leaf_c0(1:nleafage)),fnrt_c0,sapw_c0,store_c0,struct_c0, & + sum(leaf_c(1:nleafage)), fnrt_c, sapw_c,store_c, struct_c, & + target_leaf_c, target_fnrt_c, target_sapw_c, & + target_store_c, target_struct_c, & + carbon_balance,ipft,leaf_status, & + grow_leaf, grow_fnrt, grow_sapw, grow_store, grow_struct) + + ! -------------------------------------------------------------------------------- + ! The numerical integration of growth requires that the instantaneous state + ! variables are passed in as an array. We call it "c_pool". + ! + ! Initialize the adaptive integrator arrays and flags + ! -------------------------------------------------------------------------------- + + ierr = 1 + totalC = carbon_balance + nsteps = 0 + + c_pool(:) = 0.0_r8 ! Zero state variable array + c_mask(:) = .false. ! This mask tells the integrator + ! which indices are active. Its possible + ! that due to fusion, or previous numerical + ! truncation errors, that one of these pools + ! may be larger than its target! We check + ! this, and if true, then we flag that + ! pool to be ignored. c_mask(i) = .false. + ! For grasses, since they don't grow very + ! large and thus won't accumulate such large + ! errors, we always mask as true. + + c_pool(leaf_c_id) = sum(leaf_c(1:nleafage)) + c_pool(fnrt_c_id) = fnrt_c + c_pool(sapw_c_id) = sapw_c + c_pool(store_c_id) = store_c + c_pool(struct_c_id) = struct_c + c_pool(repro_c_id) = repro_c + c_pool(dbh_id) = dbh + + ! Only grow leaves if we are in a "leaf-on" status + select case (leaf_status) + case (leaves_on) + c_mask(leaf_c_id) = grow_leaf + case default + c_mask(leaf_c_id) = .false. + end select + c_mask(fnrt_c_id) = grow_fnrt + c_mask(sapw_c_id) = grow_sapw + c_mask(struct_c_id) = grow_struct + c_mask(store_c_id) = grow_store + c_mask(repro_c_id) = .true. ! Always calculate reproduction on growth + c_mask(dbh_id) = .true. ! Always increment dbh on growth step + + + ! When using the Euler method, we keep things simple. We always try + ! to make the first integration step to span the entirety of the integration + ! window for the independent variable (available carbon) + + select case (ODESolve) + case (2) + this%ode_opt_step = totalC + end select + + do_solve_check: do while( ierr .ne. 0 ) + + deltaC = min(totalC,this%ode_opt_step) + select_ODESolve: select case (ODESolve) + case (1) + call RKF45(AllomCGrowthDeriv,c_pool,c_mask,deltaC,totalC, & + max_trunc_error,intgr_params,c_pool_out,this%ode_opt_step,step_pass) + + case (2) + call Euler(AllomCGrowthDeriv,c_pool,c_mask,deltaC,totalC,intgr_params,c_pool_out) + ! step_pass = .true. + + ! When integrating along the allometric curve, we have the luxury of perfect + ! hindsite. Ie, after we have made our step, we can see if the amount + ! of each carbon we have matches the target associated with the new dbh. + ! The following call evaluates how close we are to the allometically defined + ! targets. If we are too far (governed by max_trunc_error), then we + ! pass back the pass/fail flag (step_pass) as false. If false, then + ! we halve the step-size, and then retry. If that step was fine, then + ! we remember the current step size as a good next guess. + + call CheckIntegratedAllometries(c_pool_out(dbh_id),ipft,& + crowndamage, canopy_trim, & + c_pool_out(leaf_c_id), c_pool_out(fnrt_c_id), c_pool_out(sapw_c_id), & + c_pool_out(store_c_id), c_pool_out(struct_c_id), & + c_mask(leaf_c_id), c_mask(fnrt_c_id), c_mask(sapw_c_id), & + c_mask(store_c_id), c_mask(struct_c_id), max_trunc_error, step_pass) + if(step_pass) then + this%ode_opt_step = deltaC + else + this%ode_opt_step = 0.5*deltaC + end if + case default + write(fates_log(),*) 'An integrator was chosen that does not exist' + write(fates_log(),*) 'ODESolve = ',ODESolve + call endrun(msg=errMsg(sourcefile, __LINE__)) + end select select_ODESolve + + nsteps = nsteps + 1 + + if (step_pass) then ! If true, then step is accepted + totalC = totalC - deltaC + c_pool(:) = c_pool_out(:) + end if + + if(nsteps > max_substeps ) then + write(fates_log(),fmt=*) '---~---' + write(fates_log(),fmt=*) 'Plant Growth Integrator could not find' + write(fates_log(),fmt=*) 'a solution in less than ',max_substeps,' tries.' + write(fates_log(),fmt=*) 'Aborting!' + write(fates_log(),fmt=*) '---~---' + write(fates_log(),fmt=fmti) 'Leaf status =',leaf_status + write(fates_log(),fmt=fmt0) 'Carbon_balance =',carbon_balance + write(fates_log(),fmt=fmt0) 'deltaC =',deltaC + write(fates_log(),fmt=fmt0) 'totalC =',totalC + write(fates_log(),fmt=*) 'crowndamage : ', crowndamage + write(fates_log(),fmt=fmth) ' Tissue |', ' Grow',' Current',' Target' ,' Deficit' + write(fates_log(),fmt=fmtg) ' Leaf |', grow_leaf , sum(leaf_c(:)),target_leaf_c , target_leaf_c - sum(leaf_c(:)) + write(fates_log(),fmt=fmtg) ' Fine root |', grow_fnrt , fnrt_c,target_fnrt_c , target_fnrt_c - fnrt_c + write(fates_log(),fmt=fmtg) ' Sapwood |', grow_sapw , sapw_c,target_sapw_c , target_sapw_c - sapw_c + write(fates_log(),fmt=fmtg) ' Storage |', grow_store , store_c,target_store_c , target_store_c - store_c + write(fates_log(),fmt=fmtg) ' Structural |', grow_struct , struct_c,target_struct_c, target_struct_c - struct_c + write(fates_log(),fmt=*) '---~---' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + ! + ! TotalC should eventually be whittled down to near zero. + ! The solvers are not perfect, so we can't expect it to be perfectly zero. + ! Note that calloc_abs_error is 1e-9, which is really small (1 microgram of carbon) + ! yet also six orders of magnitude greater than typical rounding errors (~1e-15). + + ! At that point, update the actual states + ! -------------------------------------------------------------------------------- + if_step_pass: if( (totalC < calloc_abs_error) .and. (step_pass) )then + + ierr = 0 + leaf_c_flux = c_pool(leaf_c_id) - sum(leaf_c(1:nleafage)) + fnrt_c_flux = c_pool(fnrt_c_id) - fnrt_c + sapw_c_flux = c_pool(sapw_c_id) - sapw_c + store_c_flux = c_pool(store_c_id) - store_c + struct_c_flux = c_pool(struct_c_id) - struct_c + repro_c_flux = c_pool(repro_c_id) - repro_c + + ! Make an adjustment to flux partitions to make it match remaining c balance + flux_adj = carbon_balance/(leaf_c_flux+fnrt_c_flux+sapw_c_flux + & + store_c_flux+struct_c_flux+repro_c_flux) + + + leaf_c_flux = leaf_c_flux*flux_adj + fnrt_c_flux = fnrt_c_flux*flux_adj + sapw_c_flux = sapw_c_flux*flux_adj + store_c_flux = store_c_flux*flux_adj + struct_c_flux = struct_c_flux*flux_adj + repro_c_flux = repro_c_flux*flux_adj + + carbon_balance = carbon_balance - leaf_c_flux + leaf_c(iexp_leaf) = leaf_c(iexp_leaf) + leaf_c_flux + + carbon_balance = carbon_balance - fnrt_c_flux + fnrt_c = fnrt_c + fnrt_c_flux + + carbon_balance = carbon_balance - sapw_c_flux + sapw_c = sapw_c + sapw_c_flux + + carbon_balance = carbon_balance - store_c_flux + store_c = store_c + store_c_flux + + carbon_balance = carbon_balance - struct_c_flux + struct_c = struct_c + struct_c_flux + + carbon_balance = carbon_balance - repro_c_flux + repro_c = repro_c + repro_c_flux + + dbh = c_pool(dbh_id) + + if( abs(carbon_balance)>calloc_abs_error ) then + write(fates_log(),*) 'carbon conservation error while integrating pools' + write(fates_log(),*) 'along alometric curve' + write(fates_log(),*) 'carbon_balance = ',carbon_balance,totalC + write(fates_log(),*) 'exiting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + end if if_step_pass + + end do do_solve_check + + end if if_phase - ! ----------------------------------------------------------------------------------- - ! VI. If carbon is still available, we try to push all live - ! pools back towards allometry. But only upwards, if fusion happened - ! to generate some pools above allometric target, don't reduce the pool, - ! just ignore it until the rest of the plant grows to meet it. - ! ----------------------------------------------------------------------------------- - if( carbon_balance > nearzero ) then + ! Track the net allocations and transport from this routine + ! (the AgeLeaves() routine handled tracking allocation through aging) - leaf_below_target = max(target_leaf_c - sum(leaf_c(1:nleafage)),0.0_r8) - fnrt_below_target = max(target_fnrt_c - fnrt_c,0.0_r8) - sapw_below_target = max(target_sapw_c - sapw_c,0.0_r8) - store_below_target = max(target_store_c - store_c,0.0_r8) - - total_below_target = leaf_below_target + fnrt_below_target + & - sapw_below_target + store_below_target - - if ( total_below_target > nearzero ) then - ! Find allocation factor based on available carbon and total demand to meet target. - allocation_factor = min(1.0_r8, carbon_balance / total_below_target) - - ! Find fluxes to individual pools - leaf_c_flux = leaf_below_target * allocation_factor - fnrt_c_flux = fnrt_below_target * allocation_factor - sapw_c_flux = sapw_below_target * allocation_factor - store_c_flux = store_below_target * allocation_factor - - leaf_c(iexp_leaf) = leaf_c(iexp_leaf) + leaf_c_flux - fnrt_c = fnrt_c + fnrt_c_flux - sapw_c = sapw_c + sapw_c_flux - store_c = store_c + store_c_flux - - carbon_balance = carbon_balance - & - ( leaf_c_flux + fnrt_c_flux + sapw_c_flux + store_c_flux ) - end if - end if - - ! ----------------------------------------------------------------------------------- - ! VII. If carbon is still available, replenish the structural pool to get - ! back on allometry - ! ----------------------------------------------------------------------------------- + this%variables(leaf_c_id)%net_alloc(icd) = & + this%variables(leaf_c_id)%net_alloc(icd) + (leaf_c(icd) - leaf_c0(icd)) - if( carbon_balance > nearzero ) then - - struct_below_target = max(target_struct_c - struct_c ,0.0_r8) - - if ( struct_below_target > 0.0_r8) then - - struct_c_flux = min(carbon_balance,struct_below_target) - carbon_balance = carbon_balance - struct_c_flux - struct_c = struct_c + struct_c_flux - - end if - - end if - - ! ----------------------------------------------------------------------------------- - ! VIII. If carbon is yet still available ... - ! Our pools are now either on allometry or above (from fusion). - ! We we can increment those pools at or below, - ! including structure and reproduction according to their rates - ! Use an adaptive euler integration. If the error is not nominal, - ! the carbon balance sub-step (deltaC) will be halved and tried again - ! - ! Note that we compare against calloc_abs_error here because it is possible - ! that all the carbon was effectively used up, but a miniscule amount - ! remains due to numerical precision (ie -20 or so), so even though - ! the plant has not been brought to be "on allometry", it thinks it has carbon - ! left to allocate, and thus it must be on allometry when its not. - ! ----------------------------------------------------------------------------------- - + this%variables(fnrt_c_id)%net_alloc(icd) = & + this%variables(fnrt_c_id)%net_alloc(icd) + (fnrt_c - fnrt_c0) - if_stature_growth: if( carbon_balance > calloc_abs_error ) then - - ! This routine checks that actual carbon is not below that targets. It does - ! allow actual pools to be above the target, and in these cases, it sends - ! a false on the "grow_<>" flag, allowing the plant to grow into these pools. - ! It also checks to make sure that structural biomass is not above the target. - ! ( MLO. Removed the check for storage because the same test is done inside - ! sub-routine TargetAllometryCheck.) - - call TargetAllometryCheck(sum(leaf_c0(1:nleafage)),fnrt_c0,sapw_c0,store_c0,struct_c0, & - sum(leaf_c(1:nleafage)), fnrt_c, sapw_c,store_c, struct_c, & - target_leaf_c, target_fnrt_c, target_sapw_c, & - target_store_c, target_struct_c, & - carbon_balance,ipft,leaf_status, & - grow_leaf, grow_fnrt, grow_sapw, grow_store, grow_struct) - - ! -------------------------------------------------------------------------------- - ! The numerical integration of growth requires that the instantaneous state - ! variables are passed in as an array. We call it "c_pool". - ! - ! Initialize the adaptive integrator arrays and flags - ! -------------------------------------------------------------------------------- - - ierr = 1 - totalC = carbon_balance - nsteps = 0 - - c_pool(:) = 0.0_r8 ! Zero state variable array - c_mask(:) = .false. ! This mask tells the integrator - ! which indices are active. Its possible - ! that due to fusion, or previous numerical - ! truncation errors, that one of these pools - ! may be larger than its target! We check - ! this, and if true, then we flag that - ! pool to be ignored. c_mask(i) = .false. - ! For grasses, since they don't grow very - ! large and thus won't accumulate such large - ! errors, we always mask as true. - - c_pool(leaf_c_id) = sum(leaf_c(1:nleafage)) - c_pool(fnrt_c_id) = fnrt_c - c_pool(sapw_c_id) = sapw_c - c_pool(store_c_id) = store_c - c_pool(struct_c_id) = struct_c - c_pool(repro_c_id) = repro_c - c_pool(dbh_id) = dbh - - ! Only grow leaves if we are in a "leaf-on" status - select case (leaf_status) - case (leaves_on) - c_mask(leaf_c_id) = grow_leaf - case default - c_mask(leaf_c_id) = .false. - end select - c_mask(fnrt_c_id) = grow_fnrt - c_mask(sapw_c_id) = grow_sapw - c_mask(struct_c_id) = grow_struct - c_mask(store_c_id) = grow_store - c_mask(repro_c_id) = .true. ! Always calculate reproduction on growth - c_mask(dbh_id) = .true. ! Always increment dbh on growth step - - - ! When using the Euler method, we keep things simple. We always try - ! to make the first integration step to span the entirety of the integration - ! window for the independent variable (available carbon) - - select case (ODESolve) - case (2) - this%ode_opt_step = totalC - end select - - do_solve_check: do while( ierr .ne. 0 ) - - deltaC = min(totalC,this%ode_opt_step) - select_ODESolve: select case (ODESolve) - case (1) - call RKF45(AllomCGrowthDeriv,c_pool,c_mask,deltaC,totalC, & - max_trunc_error,intgr_params,c_pool_out,this%ode_opt_step,step_pass) - - case (2) - call Euler(AllomCGrowthDeriv,c_pool,c_mask,deltaC,totalC,intgr_params,c_pool_out) - ! step_pass = .true. - - ! When integrating along the allometric curve, we have the luxury of perfect - ! hindsite. Ie, after we have made our step, we can see if the amount - ! of each carbon we have matches the target associated with the new dbh. - ! The following call evaluates how close we are to the allometically defined - ! targets. If we are too far (governed by max_trunc_error), then we - ! pass back the pass/fail flag (step_pass) as false. If false, then - ! we halve the step-size, and then retry. If that step was fine, then - ! we remember the current step size as a good next guess. - - call CheckIntegratedAllometries(c_pool_out(dbh_id),ipft,& - crowndamage, canopy_trim, & - c_pool_out(leaf_c_id), c_pool_out(fnrt_c_id), c_pool_out(sapw_c_id), & - c_pool_out(store_c_id), c_pool_out(struct_c_id), & - c_mask(leaf_c_id), c_mask(fnrt_c_id), c_mask(sapw_c_id), & - c_mask(store_c_id), c_mask(struct_c_id), max_trunc_error, step_pass) - if(step_pass) then - this%ode_opt_step = deltaC - else - this%ode_opt_step = 0.5*deltaC - end if - case default - write(fates_log(),*) 'An integrator was chosen that does not exist' - write(fates_log(),*) 'ODESolve = ',ODESolve - call endrun(msg=errMsg(sourcefile, __LINE__)) - end select select_ODESolve - - nsteps = nsteps + 1 - - if (step_pass) then ! If true, then step is accepted - totalC = totalC - deltaC - c_pool(:) = c_pool_out(:) - end if - - if(nsteps > max_substeps ) then - write(fates_log(),fmt=*) '---~---' - write(fates_log(),fmt=*) 'Plant Growth Integrator could not find' - write(fates_log(),fmt=*) 'a solution in less than ',max_substeps,' tries.' - write(fates_log(),fmt=*) 'Aborting!' - write(fates_log(),fmt=*) '---~---' - write(fates_log(),fmt=fmti) 'Leaf status =',leaf_status - write(fates_log(),fmt=fmt0) 'Carbon_balance =',carbon_balance - write(fates_log(),fmt=fmt0) 'deltaC =',deltaC - write(fates_log(),fmt=fmt0) 'totalC =',totalC - write(fates_log(),fmt=*) 'crowndamage : ', crowndamage - write(fates_log(),fmt=fmth) ' Tissue |', ' Grow',' Current',' Target' ,' Deficit' - write(fates_log(),fmt=fmtg) ' Leaf |', grow_leaf , sum(leaf_c(:)),target_leaf_c , target_leaf_c - sum(leaf_c(:)) - write(fates_log(),fmt=fmtg) ' Fine root |', grow_fnrt , fnrt_c,target_fnrt_c , target_fnrt_c - fnrt_c - write(fates_log(),fmt=fmtg) ' Sapwood |', grow_sapw , sapw_c,target_sapw_c , target_sapw_c - sapw_c - write(fates_log(),fmt=fmtg) ' Storage |', grow_store , store_c,target_store_c , target_store_c - store_c - write(fates_log(),fmt=fmtg) ' Structural |', grow_struct , struct_c,target_struct_c, target_struct_c - struct_c - write(fates_log(),fmt=*) '---~---' - call endrun(msg=errMsg(sourcefile, __LINE__)) - end if - - ! - ! TotalC should eventually be whittled down to near zero. - ! The solvers are not perfect, so we can't expect it to be perfectly zero. - ! Note that calloc_abs_error is 1e-9, which is really small (1 microgram of carbon) - ! yet also six orders of magnitude greater than typical rounding errors (~1e-15). - - ! At that point, update the actual states - ! -------------------------------------------------------------------------------- - if_step_pass: if( (totalC < calloc_abs_error) .and. (step_pass) )then - - ierr = 0 - leaf_c_flux = c_pool(leaf_c_id) - sum(leaf_c(1:nleafage)) - fnrt_c_flux = c_pool(fnrt_c_id) - fnrt_c - sapw_c_flux = c_pool(sapw_c_id) - sapw_c - store_c_flux = c_pool(store_c_id) - store_c - struct_c_flux = c_pool(struct_c_id) - struct_c - repro_c_flux = c_pool(repro_c_id) - repro_c - - ! Make an adjustment to flux partitions to make it match remaining c balance - flux_adj = carbon_balance/(leaf_c_flux+fnrt_c_flux+sapw_c_flux + & - store_c_flux+struct_c_flux+repro_c_flux) - - - leaf_c_flux = leaf_c_flux*flux_adj - fnrt_c_flux = fnrt_c_flux*flux_adj - sapw_c_flux = sapw_c_flux*flux_adj - store_c_flux = store_c_flux*flux_adj - struct_c_flux = struct_c_flux*flux_adj - repro_c_flux = repro_c_flux*flux_adj - - carbon_balance = carbon_balance - leaf_c_flux - leaf_c(iexp_leaf) = leaf_c(iexp_leaf) + leaf_c_flux - - carbon_balance = carbon_balance - fnrt_c_flux - fnrt_c = fnrt_c + fnrt_c_flux - - carbon_balance = carbon_balance - sapw_c_flux - sapw_c = sapw_c + sapw_c_flux - - carbon_balance = carbon_balance - store_c_flux - store_c = store_c + store_c_flux - - carbon_balance = carbon_balance - struct_c_flux - struct_c = struct_c + struct_c_flux - - carbon_balance = carbon_balance - repro_c_flux - repro_c = repro_c + repro_c_flux - - dbh = c_pool(dbh_id) - - if( abs(carbon_balance)>calloc_abs_error ) then - write(fates_log(),*) 'carbon conservation error while integrating pools' - write(fates_log(),*) 'along alometric curve' - write(fates_log(),*) 'carbon_balance = ',carbon_balance,totalC - write(fates_log(),*) 'exiting' - call endrun(msg=errMsg(sourcefile, __LINE__)) - end if - - end if if_step_pass - - end do do_solve_check - - end if if_stature_growth - - ! Track the net allocations and transport from this routine - ! (the AgeLeaves() routine handled tracking allocation through aging) - - this%variables(leaf_c_id)%net_alloc(icd) = & - this%variables(leaf_c_id)%net_alloc(icd) + (leaf_c(icd) - leaf_c0(icd)) - - this%variables(fnrt_c_id)%net_alloc(icd) = & - this%variables(fnrt_c_id)%net_alloc(icd) + (fnrt_c - fnrt_c0) - - this%variables(sapw_c_id)%net_alloc(icd) = & - this%variables(sapw_c_id)%net_alloc(icd) + (sapw_c - sapw_c0) - - this%variables(store_c_id)%net_alloc(icd) = & - this%variables(store_c_id)%net_alloc(icd) + (store_c - store_c0) - - this%variables(repro_c_id)%net_alloc(icd) = & - this%variables(repro_c_id)%net_alloc(icd) + (repro_c - repro_c0) - - this%variables(struct_c_id)%net_alloc(icd) = & - this%variables(struct_c_id)%net_alloc(icd) + (struct_c - struct_c0) - - - - end associate - - return + this%variables(sapw_c_id)%net_alloc(icd) = & + this%variables(sapw_c_id)%net_alloc(icd) + (sapw_c - sapw_c0) + + this%variables(store_c_id)%net_alloc(icd) = & + this%variables(store_c_id)%net_alloc(icd) + (store_c - store_c0) + + this%variables(repro_c_id)%net_alloc(icd) = & + this%variables(repro_c_id)%net_alloc(icd) + (repro_c - repro_c0) + + this%variables(struct_c_id)%net_alloc(icd) = & + this%variables(struct_c_id)%net_alloc(icd) + (struct_c - struct_c0) + + + + end associate + + return end subroutine DailyPRTAllometricCarbon ! ===================================================================================== diff --git a/parteh/PRTGenericMod.F90 b/parteh/PRTGenericMod.F90 index fb83aebae7..001c617912 100644 --- a/parteh/PRTGenericMod.F90 +++ b/parteh/PRTGenericMod.F90 @@ -1254,9 +1254,10 @@ end function GetCoordVal ! ==================================================================================== - subroutine DailyPRTBase(this) + subroutine DailyPRTBase(this,phase) - class(prt_vartypes) :: this + class(prt_vartypes) :: this + integer,intent(in) :: phase ! We allow this and its children to be broken into phases write(fates_log(),*)'Daily PRT Allocation must be extended' call endrun(msg=errMsg(sourcefile, __LINE__)) From daafba13ba34a36ffbef2c3ec61afdd2d22576b5 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 30 Jun 2022 17:32:30 -0400 Subject: [PATCH 51/84] cleaning up damage boundary condition to parteh, adding in phase hooks to parteh_mode=2, even if its incompatible at the moment --- biogeochem/EDCohortDynamicsMod.F90 | 10 +- parteh/PRTAllometricCNPMod.F90 | 267 ++++++++++++++--------------- parteh/PRTAllometricCarbonMod.F90 | 48 +++--- 3 files changed, 163 insertions(+), 162 deletions(-) diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index bad98c2eb7..1f48a1f055 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -88,18 +88,17 @@ Module EDCohortDynamicsMod use PRTAllometricCarbonMod, only : callom_prt_vartypes use PRTAllometricCarbonMod, only : ac_bc_inout_id_netdc use PRTAllometricCarbonMod, only : ac_bc_in_id_pft - use PRTAllometricCarbonMod, only : ac_bc_inout_id_cdamage use PRTAllometricCarbonMod, only : ac_bc_inout_id_n use PRTAllometricCarbonMod, only : ac_bc_in_id_ctrim use PRTAllometricCarbonMod, only : ac_bc_inout_id_dbh - use PRTAllometricCarbonMod, only : ac_bc_in_id_lstat + use PRTAllometricCarbonMod, only : ac_bc_in_id_lstat, ac_bc_in_id_cdamage use PRTAllometricCNPMod, only : cnp_allom_prt_vartypes use PRTAllometricCNPMod, only : acnp_bc_in_id_pft, acnp_bc_in_id_ctrim use PRTAllometricCNPMod, only : acnp_bc_in_id_lstat, acnp_bc_inout_id_dbh use PRTAllometricCNPMod, only : acnp_bc_inout_id_rmaint_def, acnp_bc_in_id_netdc use PRTAllometricCNPMod, only : acnp_bc_in_id_netdnh4, acnp_bc_in_id_netdno3, acnp_bc_in_id_netdp use PRTAllometricCNPMod, only : acnp_bc_out_id_cefflux, acnp_bc_out_id_nefflux - use PRTAllometricCNPMod, only : acnp_bc_out_id_pefflux + use PRTAllometricCNPMod, only : acnp_bc_out_id_pefflux, acnp_bc_in_id_cdamage use PRTAllometricCNPMod, only : acnp_bc_out_id_nneed use PRTAllometricCNPMod, only : acnp_bc_out_id_pneed use DamageMainMod, only : GetCrownReduction @@ -409,7 +408,7 @@ subroutine InitPRTBoundaryConditions(new_cohort) call new_cohort%prt%RegisterBCInOut(ac_bc_inout_id_dbh,bc_rval = new_cohort%dbh) call new_cohort%prt%RegisterBCInOut(ac_bc_inout_id_netdc,bc_rval = new_cohort%npp_acc) - call new_cohort%prt%RegisterBCInOut(ac_bc_inout_id_cdamage,bc_ival = new_cohort%crowndamage) + call new_cohort%prt%RegisterBCIn(ac_bc_in_id_cdamage,bc_ival = new_cohort%crowndamage) call new_cohort%prt%RegisterBCIn(ac_bc_in_id_pft,bc_ival = new_cohort%pft) call new_cohort%prt%RegisterBCIn(ac_bc_in_id_ctrim,bc_rval = new_cohort%canopy_trim) call new_cohort%prt%RegisterBCIn(ac_bc_in_id_lstat,bc_ival = new_cohort%status_coh) @@ -423,7 +422,8 @@ subroutine InitPRTBoundaryConditions(new_cohort) call new_cohort%prt%RegisterBCIn(acnp_bc_in_id_netdnh4, bc_rval = new_cohort%daily_nh4_uptake) call new_cohort%prt%RegisterBCIn(acnp_bc_in_id_netdno3, bc_rval = new_cohort%daily_no3_uptake) call new_cohort%prt%RegisterBCIn(acnp_bc_in_id_netdp, bc_rval = new_cohort%daily_p_uptake) - + call new_cohort%prt%RegisterBCIn(acnp_bc_in_id_cdamage,bc_ival = new_cohort%crowndamage) + call new_cohort%prt%RegisterBCInOut(acnp_bc_inout_id_dbh,bc_rval = new_cohort%dbh) call new_cohort%prt%RegisterBCInOut(acnp_bc_inout_id_rmaint_def,bc_rval = new_cohort%resp_m_def) diff --git a/parteh/PRTAllometricCNPMod.F90 b/parteh/PRTAllometricCNPMod.F90 index 1ab310dd32..d9d0b1385d 100644 --- a/parteh/PRTAllometricCNPMod.F90 +++ b/parteh/PRTAllometricCNPMod.F90 @@ -138,11 +138,9 @@ module PRTAllometricCNPMod integer, public, parameter :: acnp_bc_inout_id_dbh = 1 ! Plant DBH integer, public, parameter :: acnp_bc_inout_id_rmaint_def = 2 ! Index for any accumulated - integer, public, parameter :: acnp_bc_inout_id_cdamage = 3 ! Crown damage index - integer, public, parameter :: acnp_bc_inout_id_num = 4 ! Number of plants + ! maintenance respiration deficit - ! maintenance respiration deficit - integer, public, parameter :: num_bc_inout = 4 + integer, public, parameter :: num_bc_inout = 2 ! ------------------------------------------------------------------------------------- ! Input only Boundary Indices (These are public) @@ -155,9 +153,10 @@ module PRTAllometricCNPMod integer, public, parameter :: acnp_bc_in_id_netdnh4 = 5 ! Index for the net daily NH4 input BC integer, public, parameter :: acnp_bc_in_id_netdno3 = 6 ! Index for the net daily NO3 input BC integer, public, parameter :: acnp_bc_in_id_netdp = 7 ! Index for the net daily P input BC + integer, public, parameter :: acnp_bc_in_id_cdamage = 8 ! Index for the crowndamage input BC ! 0=leaf off, 1=leaf on - integer, parameter :: num_bc_in = 7 + integer, parameter :: num_bc_in = 8 ! ------------------------------------------------------------------------------------- ! Output Boundary Indices (These are public) @@ -248,99 +247,100 @@ module PRTAllometricCNPMod subroutine InitPRTGlobalAllometricCNP() - ! ---------------------------------------------------------------------------------- - ! Initialize and populate the general mapping table that - ! organizes the specific variables in this module to - ! pre-ordained groups, so they can be used to inform - ! the rest of the model - ! - ! This routine is not part of the sp_pool_vartypes class - ! because it is the same for all plants and we need not - ! waste memory on it. - ! ----------------------------------------------------------------------------------- + ! ---------------------------------------------------------------------------------- + ! Initialize and populate the general mapping table that + ! organizes the specific variables in this module to + ! pre-ordained groups, so they can be used to inform + ! the rest of the model + ! + ! This routine is not part of the sp_pool_vartypes class + ! because it is the same for all plants and we need not + ! waste memory on it. + ! ----------------------------------------------------------------------------------- - integer :: nleafage + integer :: nleafage - allocate(prt_global_acnp) - allocate(prt_global_acnp%state_descriptor(num_vars)) + allocate(prt_global_acnp) + allocate(prt_global_acnp%state_descriptor(num_vars)) - prt_global_acnp%hyp_name = 'Allometric Flexible C+N+P' + prt_global_acnp%hyp_name = 'Allometric Flexible C+N+P' - prt_global_acnp%hyp_id = prt_cnp_flex_allom_hyp + prt_global_acnp%hyp_id = prt_cnp_flex_allom_hyp - call prt_global_acnp%ZeroGlobal() + call prt_global_acnp%ZeroGlobal() - ! The number of leaf age classes can be determined from the parameter file, - ! notably the size of the leaf-longevity parameter's second dimension. - ! This is the same value in FatesInterfaceMod.F90 + ! The number of leaf age classes can be determined from the parameter file, + ! notably the size of the leaf-longevity parameter's second dimension. + ! This is the same value in FatesInterfaceMod.F90 - nleafage = size(prt_params%leaf_long,dim=2) + nleafage = size(prt_params%leaf_long,dim=2) - if(nleafage>max_nleafage) then - write(fates_log(),*) 'The allometric carbon PARTEH hypothesis' - write(fates_log(),*) 'sets a maximum number of leaf age classes' - write(fates_log(),*) 'used for scratch space. The model wants' - write(fates_log(),*) 'exceed that. Simply increase max_nleafage' - write(fates_log(),*) 'found in parteh/PRTAllometricCarbonMod.F90' - call endrun(msg=errMsg(sourcefile, __LINE__)) - end if + if(nleafage>max_nleafage) then + write(fates_log(),*) 'The allometric carbon PARTEH hypothesis' + write(fates_log(),*) 'sets a maximum number of leaf age classes' + write(fates_log(),*) 'used for scratch space. The model wants' + write(fates_log(),*) 'exceed that. Simply increase max_nleafage' + write(fates_log(),*) 'found in parteh/PRTAllometricCarbonMod.F90' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if - call prt_global_acnp%RegisterVarInGlobal(leaf_c_id,'Leaf Carbon','leaf_c',leaf_organ,carbon12_element,nleafage) - call prt_global_acnp%RegisterVarInGlobal(fnrt_c_id,'Fine Root Carbon','fnrt_c',fnrt_organ,carbon12_element,icd) - call prt_global_acnp%RegisterVarInGlobal(sapw_c_id,'Sapwood Carbon','sapw_c',sapw_organ,carbon12_element,icd) - call prt_global_acnp%RegisterVarInGlobal(store_c_id,'Storage Carbon','store_c',store_organ,carbon12_element,icd) - call prt_global_acnp%RegisterVarInGlobal(struct_c_id,'Structural Carbon','struct_c',struct_organ,carbon12_element,icd) - call prt_global_acnp%RegisterVarInGlobal(repro_c_id,'Reproductive Carbon','repro_c',repro_organ,carbon12_element,icd) + call prt_global_acnp%RegisterVarInGlobal(leaf_c_id,'Leaf Carbon','leaf_c',leaf_organ,carbon12_element,nleafage) + call prt_global_acnp%RegisterVarInGlobal(fnrt_c_id,'Fine Root Carbon','fnrt_c',fnrt_organ,carbon12_element,icd) + call prt_global_acnp%RegisterVarInGlobal(sapw_c_id,'Sapwood Carbon','sapw_c',sapw_organ,carbon12_element,icd) + call prt_global_acnp%RegisterVarInGlobal(store_c_id,'Storage Carbon','store_c',store_organ,carbon12_element,icd) + call prt_global_acnp%RegisterVarInGlobal(struct_c_id,'Structural Carbon','struct_c',struct_organ,carbon12_element,icd) + call prt_global_acnp%RegisterVarInGlobal(repro_c_id,'Reproductive Carbon','repro_c',repro_organ,carbon12_element,icd) - call prt_global_acnp%RegisterVarInGlobal(leaf_n_id,'Leaf Nitrogen','leaf_n',leaf_organ,nitrogen_element,nleafage) - call prt_global_acnp%RegisterVarInGlobal(fnrt_n_id,'Fine Root Nitrogen','fnrt_n',fnrt_organ,nitrogen_element,icd) - call prt_global_acnp%RegisterVarInGlobal(sapw_n_id,'Sapwood Nitrogen','sapw_n',sapw_organ,nitrogen_element,icd) - call prt_global_acnp%RegisterVarInGlobal(store_n_id,'Storage Nitrogen','store_n',store_organ,nitrogen_element,icd) - call prt_global_acnp%RegisterVarInGlobal(struct_n_id,'Structural Nitrogen','struct_n',struct_organ,nitrogen_element,icd) - call prt_global_acnp%RegisterVarInGlobal(repro_n_id,'Reproductive Nitrogen','repro_n',repro_organ,nitrogen_element,icd) + call prt_global_acnp%RegisterVarInGlobal(leaf_n_id,'Leaf Nitrogen','leaf_n',leaf_organ,nitrogen_element,nleafage) + call prt_global_acnp%RegisterVarInGlobal(fnrt_n_id,'Fine Root Nitrogen','fnrt_n',fnrt_organ,nitrogen_element,icd) + call prt_global_acnp%RegisterVarInGlobal(sapw_n_id,'Sapwood Nitrogen','sapw_n',sapw_organ,nitrogen_element,icd) + call prt_global_acnp%RegisterVarInGlobal(store_n_id,'Storage Nitrogen','store_n',store_organ,nitrogen_element,icd) + call prt_global_acnp%RegisterVarInGlobal(struct_n_id,'Structural Nitrogen','struct_n',struct_organ,nitrogen_element,icd) + call prt_global_acnp%RegisterVarInGlobal(repro_n_id,'Reproductive Nitrogen','repro_n',repro_organ,nitrogen_element,icd) - call prt_global_acnp%RegisterVarInGlobal(leaf_p_id,'Leaf Phosphorus','leaf_p',leaf_organ,phosphorus_element,nleafage) - call prt_global_acnp%RegisterVarInGlobal(fnrt_p_id,'Fine Root Phosphorus','fnrt_p',fnrt_organ,phosphorus_element,icd) - call prt_global_acnp%RegisterVarInGlobal(sapw_p_id,'Sapwood Phosphorus','sapw_p',sapw_organ,phosphorus_element,icd) - call prt_global_acnp%RegisterVarInGlobal(store_p_id,'Storage Phosphorus','store_p',store_organ,phosphorus_element,icd) - call prt_global_acnp%RegisterVarInGlobal(struct_p_id,'Structural Phosphorus','struct_p',struct_organ,phosphorus_element,icd) - call prt_global_acnp%RegisterVarInGlobal(repro_p_id,'Reproductive Phosphorus','repro_p',repro_organ,phosphorus_element,icd) + call prt_global_acnp%RegisterVarInGlobal(leaf_p_id,'Leaf Phosphorus','leaf_p',leaf_organ,phosphorus_element,nleafage) + call prt_global_acnp%RegisterVarInGlobal(fnrt_p_id,'Fine Root Phosphorus','fnrt_p',fnrt_organ,phosphorus_element,icd) + call prt_global_acnp%RegisterVarInGlobal(sapw_p_id,'Sapwood Phosphorus','sapw_p',sapw_organ,phosphorus_element,icd) + call prt_global_acnp%RegisterVarInGlobal(store_p_id,'Storage Phosphorus','store_p',store_organ,phosphorus_element,icd) + call prt_global_acnp%RegisterVarInGlobal(struct_p_id,'Structural Phosphorus','struct_p',struct_organ,phosphorus_element,icd) + call prt_global_acnp%RegisterVarInGlobal(repro_p_id,'Reproductive Phosphorus','repro_p',repro_organ,phosphorus_element,icd) - ! Set some of the array sizes for input and output boundary conditions - prt_global_acnp%num_bc_in = num_bc_in - prt_global_acnp%num_bc_out = num_bc_out - prt_global_acnp%num_bc_inout = num_bc_inout - prt_global_acnp%num_vars = num_vars + ! Set some of the array sizes for input and output boundary conditions + prt_global_acnp%num_bc_in = num_bc_in + prt_global_acnp%num_bc_out = num_bc_out + prt_global_acnp%num_bc_inout = num_bc_inout + prt_global_acnp%num_vars = num_vars - ! Have the global generic pointer, point to this hypothesis' object - prt_global => prt_global_acnp + ! Have the global generic pointer, point to this hypothesis' object + prt_global => prt_global_acnp - return + return end subroutine InitPRTGlobalAllometricCNP ! ===================================================================================== - subroutine DailyPRTAllometricCNP(this) + subroutine DailyPRTAllometricCNP(this,phase) class(cnp_allom_prt_vartypes) :: this - + integer,intent(in) :: phase + ! Pointers to in-out bcs real(r8),pointer :: dbh ! Diameter at breast height [cm] real(r8),pointer :: maint_r_def ! Current maintenance respiration deficit [kgC] - integer ,pointer :: cdamage ! Crown damage - + ! Input only bcs integer :: ipft ! Plant Functional Type index real(r8) :: c_gain ! Daily carbon balance for this cohort [kgC] real(r8) :: n_gain ! Daily nitrogen uptake through fine-roots [kgN] real(r8) :: p_gain ! Daily phosphorus uptake through fine-roots [kgN] real(r8) :: canopy_trim ! The canopy trimming function [0-1] - + integer :: crowndamage ! which crown damage clas + ! Pointers to output bcs real(r8),pointer :: c_efflux ! Total plant efflux of carbon (kgC) real(r8),pointer :: n_efflux ! Total plant efflux of nitrogen (kgN) @@ -379,7 +379,6 @@ subroutine DailyPRTAllometricCNP(this) real(r8) :: n_gain0 real(r8) :: p_gain0 real(r8) :: maint_r_def0 - integer :: cdamage0 ! Used for mass checking, total mass allocated based ! on change in the states, should match gain0's @@ -389,6 +388,13 @@ subroutine DailyPRTAllometricCNP(this) real(r8) :: target_n,target_p real(r8) :: sum_c ! error checking sum + + ! We do not use damage with parteh_mode 2, so just + ! do everything in phase 1 and short-circuit the phase 2 call + ! ---------------------------------------------------------- + if(phase.eq.2) return + + ! integrator variables ! Copy the input only boundary conditions into readable local variables @@ -398,11 +404,12 @@ subroutine DailyPRTAllometricCNP(this) ! ----------------------------------------------------------------------------------- c_gain = this%bc_in(acnp_bc_in_id_netdc)%rval; c_gain0 = c_gain n_gain = this%bc_in(acnp_bc_in_id_netdnh4)%rval + & - this%bc_in(acnp_bc_in_id_netdno3)%rval + this%bc_in(acnp_bc_in_id_netdno3)%rval n_gain0 = n_gain p_gain = this%bc_in(acnp_bc_in_id_netdp)%rval; p_gain0 = p_gain canopy_trim = this%bc_in(acnp_bc_in_id_ctrim)%rval ipft = this%bc_in(acnp_bc_in_id_pft)%ival + crowndamage = this%bc_in(acnp_bc_in_id_cdamage)%ival ! Output only boundary conditions c_efflux => this%bc_out(acnp_bc_out_id_cefflux)%rval; c_efflux = 0._r8 @@ -411,42 +418,39 @@ subroutine DailyPRTAllometricCNP(this) n_need => this%bc_out(acnp_bc_out_id_nneed)%rval; n_need = fates_unset_r8 p_need => this%bc_out(acnp_bc_out_id_pneed)%rval; p_need = fates_unset_r8 - + ! In/out boundary conditions maint_r_def => this%bc_inout(acnp_bc_inout_id_rmaint_def)%rval; maint_r_def0 = maint_r_def dbh => this%bc_inout(acnp_bc_inout_id_dbh)%rval; dbh0 = dbh - cdamage => this%bc_inout(acnp_bc_inout_id_cdamage)%ival; cdamage0 = cdamage - - - - ! If more than 1 leaf age bin is present, this - ! call advances leaves in their age, but does - ! not actually remove any biomass from the plant - - call this%AgeLeaves(ipft,sec_per_day) - + + if(crowndamage>1)then + write(fates_log(),*) 'The crown damage model is incompatible with' + write(fates_log(),*) 'dynamic nutrients, ie parteh_mode=2' + write(fates_log(),*) 'This feature will be brought in in with CNP v2' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + ! Set all of the per-organ pointer arrays ! Note: Since growth only happens in the 1st leaf bin, we only ! point to that bin. However, we need to account for all bins ! when we calculate the deficit - + allocate(state_c(num_organs)) allocate(state_n(num_organs)) allocate(state_p(num_organs)) - + ! Set carbon targets based on the plant's current stature target_c(:) = fates_unset_r8 target_dcdd(:) = fates_unset_r8 - call bsap_allom(dbh,ipft,cdamage, canopy_trim, & - sapw_area,target_c(sapw_id),target_dcdd(sapw_id) ) - call bagw_allom(dbh,ipft,cdamage, agw_c_target,agw_dcdd_target) + call bsap_allom(dbh,ipft,canopy_trim,sapw_area,target_c(sapw_id),target_dcdd(sapw_id) ) + call bagw_allom(dbh,ipft,agw_c_target,agw_dcdd_target) call bbgw_allom(dbh,ipft,bgw_c_target,bgw_dcdd_target) call bdead_allom(agw_c_target,bgw_c_target, target_c(sapw_id), ipft, target_c(struct_id), & - agw_dcdd_target, bgw_dcdd_target, target_dcdd(sapw_id), target_dcdd(struct_id)) - call bleaf(dbh,ipft,cdamage, canopy_trim, target_c(leaf_id), target_dcdd(leaf_id)) + agw_dcdd_target, bgw_dcdd_target, target_dcdd(sapw_id), target_dcdd(struct_id)) + call bleaf(dbh,ipft,canopy_trim, target_c(leaf_id), target_dcdd(leaf_id)) call bfineroot(dbh,ipft,canopy_trim, target_c(fnrt_id), target_dcdd(fnrt_id)) - call bstore_allom(dbh,ipft,cdamage, canopy_trim, target_c(store_id), target_dcdd(store_id)) + call bstore_allom(dbh,ipft,canopy_trim, target_c(store_id), target_dcdd(store_id)) target_c(repro_id) = 0._r8 target_dcdd(repro_id) = 0._r8 @@ -467,7 +471,7 @@ subroutine DailyPRTAllometricCNP(this) i_var = prt_global%sp_organ_map(organ_list(i_org),phosphorus_element) state_p(i_org)%ptr => this%variables(i_var)%val(1) state_p0(i_org) = this%variables(i_var)%val(1) - + end do ! =================================================================================== @@ -484,21 +488,21 @@ subroutine DailyPRTAllometricCNP(this) i_var = prt_global%sp_organ_map(store_organ,phosphorus_element) p_gain = p_gain + sum(this%variables(i_var)%val(:)) this%variables(i_var)%val(:) = 0._r8 - + ! =================================================================================== ! Step 1. Prioritized allocation to replace tissues from turnover, and/or pay ! any un-paid maintenance respiration from storage. ! =================================================================================== - + call this%CNPPrioritizedReplacement(maint_r_def, c_gain, n_gain, p_gain, & - state_c, state_n, state_p, target_c) + state_c, state_n, state_p, target_c) sum_c = 0._r8 do i_org = 1,num_organs sum_c = sum_c+state_c(i_org)%ptr end do if( abs((c_gain0-c_gain) - & - (sum_c-sum(state_c0(:),dim=1)+(maint_r_def0-maint_r_def))) >calloc_abs_error ) then + (sum_c-sum(state_c0(:),dim=1)+(maint_r_def0-maint_r_def))) >calloc_abs_error ) then write(fates_log(),*) 'Carbon not balancing I' do i_org = 1,num_organs write(fates_log(),*) 'state_c: ',state_c(i_org)%ptr,state_c0(i_org) @@ -506,23 +510,23 @@ subroutine DailyPRTAllometricCNP(this) write(fates_log(),*) maint_r_def0-maint_r_def call endrun(msg=errMsg(sourcefile, __LINE__)) end if - + ! =================================================================================== ! Step 2. Grow out the stature of the plant by allocating to tissues beyond ! current targets. ! Attempts have been made to get all pools and species closest to allometric ! targets based on prioritized relative demand and allometry functions. ! =================================================================================== - + call this%CNPStatureGrowth(c_gain, n_gain, p_gain, & state_c, state_n, state_p, target_c, target_dcdd, cnp_limiter) - + sum_c = 0._r8 do i_org = 1,num_organs sum_c = sum_c+state_c(i_org)%ptr end do if( abs((c_gain0-c_gain) - & - (sum_c-sum(state_c0(:),dim=1)+(maint_r_def0-maint_r_def))) >calloc_abs_error ) then + (sum_c-sum(state_c0(:),dim=1)+(maint_r_def0-maint_r_def))) >calloc_abs_error ) then write(fates_log(),*) 'Carbon not balanceing II' do i_org = 1,num_organs write(fates_log(),*) 'state_c: ',state_c(i_org)%ptr,state_c0(i_org) @@ -536,14 +540,14 @@ subroutine DailyPRTAllometricCNP(this) ! At this point, at least 1 of the 3 resources have been used up. ! Allocate the remaining resources, or as a last resort, efflux them. ! =================================================================================== - + call this%CNPAllocateRemainder(c_gain, n_gain, p_gain, & state_c, state_n, state_p, c_efflux, n_efflux, p_efflux) ! Error Check: Make sure that the mass gains are completely used up if( abs(c_gain) > calloc_abs_error .or. & - abs(n_gain) > 0.1_r8*calloc_abs_error .or. & - abs(p_gain) > 0.02_r8*calloc_abs_error ) then + abs(n_gain) > 0.1_r8*calloc_abs_error .or. & + abs(p_gain) > 0.02_r8*calloc_abs_error ) then write(fates_log(),*) 'Allocation scheme should had used up all mass gain pools' write(fates_log(),*) 'Any mass that cannot be allocated should be effluxed' write(fates_log(),*) 'c_gain: ',c_gain @@ -557,39 +561,40 @@ subroutine DailyPRTAllometricCNP(this) ! Since this is also a check against what was available ! we include maintenance pay-back and efflux to the "allocated" ! pool to make sure everything balances. - + allocated_c = (maint_r_def0-maint_r_def) + c_efflux allocated_n = n_efflux allocated_p = p_efflux - + + ! Update the allocation flux diagnostic arrays for each 3 elements do i_org = 1,num_organs - + i_var = prt_global%sp_organ_map(organ_list(i_org),carbon12_element) this%variables(i_var)%net_alloc(1) = & this%variables(i_var)%net_alloc(1) + (state_c(i_org)%ptr - state_c0(i_org)) allocated_c = allocated_c + (state_c(i_org)%ptr - state_c0(i_org)) - + i_var = prt_global%sp_organ_map(organ_list(i_org),nitrogen_element) this%variables(i_var)%net_alloc(1) = & this%variables(i_var)%net_alloc(1) + (state_n(i_org)%ptr - state_n0(i_org)) allocated_n = allocated_n + (state_n(i_org)%ptr - state_n0(i_org)) - + i_var = prt_global%sp_organ_map(organ_list(i_org),phosphorus_element) this%variables(i_var)%net_alloc(1) = & this%variables(i_var)%net_alloc(1) + (state_p(i_org)%ptr - state_p0(i_org)) allocated_p = allocated_p + (state_p(i_org)%ptr - state_p0(i_org)) - + end do - + if(debug) then ! Error Check: Do a final balance between how much mass ! we had to work with, and how much was allocated - + if ( abs(allocated_c - c_gain0) > calloc_abs_error .or. & abs(allocated_n - n_gain0) > calloc_abs_error .or. & abs(allocated_p - p_gain0) > calloc_abs_error ) then @@ -608,14 +613,14 @@ subroutine DailyPRTAllometricCNP(this) target_n = this%GetNutrientTarget(nitrogen_element,store_organ) target_p = this%GetNutrientTarget(phosphorus_element,store_organ) - + n_need = target_n - state_n(store_id)%ptr p_need = target_p - state_p(store_id)%ptr - + deallocate(state_c) deallocate(state_n) deallocate(state_p) - + return end subroutine DailyPRTAllometricCNP @@ -1019,7 +1024,6 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & integer :: ipft real(r8) :: canopy_trim real(r8) :: leaf_status - integer :: icrowndamage integer :: i, ii ! organ index loops (masked and unmasked) integer :: istep ! outer step iteration loop @@ -1101,8 +1105,7 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & dbh => this%bc_inout(acnp_bc_inout_id_dbh)%rval ipft = this%bc_in(acnp_bc_in_id_pft)%ival canopy_trim = this%bc_in(acnp_bc_in_id_ctrim)%rval - icrowndamage = this%bc_inout(acnp_bc_inout_id_cdamage)%ival - + cnp_limiter = 0 ! If any of these resources is essentially tapped out, @@ -1124,7 +1127,7 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & intgr_params(:) = fates_unset_r8 intgr_params(acnp_bc_in_id_ctrim) = this%bc_in(acnp_bc_in_id_ctrim)%rval intgr_params(acnp_bc_in_id_pft) = real(this%bc_in(acnp_bc_in_id_pft)%ival) - + intgr_params(acnp_bc_in_id_cdamage) = real(this%bc_in(acnp_bc_in_id_cdamage)%ival) state_mask(:) = .false. mask_organs(:) = fates_unset_int @@ -1368,8 +1371,7 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & leafc_tp1 = leafc_tp1 + this%variables(i_var)%val(i) end do - call CheckIntegratedAllometries(state_array_out(dbh_id),ipft, & - icrowndamage, canopy_trim, & + call CheckIntegratedAllometries(state_array_out(dbh_id),ipft,canopy_trim, & leafc_tp1, state_array_out(fnrt_id), state_array_out(sapw_id), & state_array_out(store_id), state_array_out(struct_id), & state_mask(leaf_id), state_mask(fnrt_id), state_mask(sapw_id), & @@ -1459,13 +1461,13 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & storec_tp1 = state_array_out(store_id) structc_tp1 = state_array_out(struct_id) - call bleaf(dbh_tp1,ipft,icrowndamage, canopy_trim,leaf_c_target_tp1) + call bleaf(dbh_tp1,ipft,canopy_trim,leaf_c_target_tp1) call bfineroot(dbh_tp1,ipft,canopy_trim,fnrt_c_target_tp1) - call bsap_allom(dbh_tp1,ipft,icrowndamage,canopy_trim,sapw_area,sapw_c_target_tp1) - call bagw_allom(dbh_tp1,ipft,icrowndamage, agw_c_target_tp1) + call bsap_allom(dbh_tp1,ipft,canopy_trim,sapw_area,sapw_c_target_tp1) + call bagw_allom(dbh_tp1,ipft,agw_c_target_tp1) call bbgw_allom(dbh_tp1,ipft,bgw_c_target_tp1) call bdead_allom(agw_c_target_tp1,bgw_c_target_tp1, sapw_c_target_tp1, ipft, struct_c_target_tp1) - call bstore_allom(dbh_tp1,ipft,icrowndamage, canopy_trim,store_c_target_tp1) + call bstore_allom(dbh_tp1,ipft,canopy_trim,store_c_target_tp1) write(fates_log(),*) 'leaf_c: ',leafc_tp1, leaf_c_target_tp1,leafc_tp1-leaf_c_target_tp1 write(fates_log(),*) 'fnrt_c: ',fnrtc_tp1, fnrt_c_target_tp1,fnrtc_tp1- fnrt_c_target_tp1 @@ -1573,13 +1575,11 @@ subroutine CNPAllocateRemainder(this,c_gain, n_gain, p_gain, & real(r8), pointer :: dbh integer :: ipft real(r8) :: canopy_trim - integer, pointer :: icrowndamage dbh => this%bc_inout(acnp_bc_inout_id_dbh)%rval canopy_trim = this%bc_in(acnp_bc_in_id_ctrim)%rval ipft = this%bc_in(acnp_bc_in_id_pft)%ival - icrowndamage => this%bc_inout(acnp_bc_inout_id_cdamage)%ival ! ----------------------------------------------------------------------------------- ! If nutrients are still available, then we can bump up the values in the pools @@ -1631,7 +1631,7 @@ subroutine CNPAllocateRemainder(this,c_gain, n_gain, p_gain, & if(c_gain>calloc_abs_error) then ! Update carbon based allometric targets - call bstore_allom(dbh,ipft,icrowndamage, canopy_trim, store_c_target) + call bstore_allom(dbh,ipft,canopy_trim, store_c_target) ! Estimate the overflow store_c_target = store_c_target * (1.0_r8 + store_overflow_frac) @@ -1717,7 +1717,6 @@ function GetNutrientTargetCNP(this,element_id,organ_id,stoich_mode) result(targe real(r8) :: target_c real(r8),pointer :: dbh - integer, pointer :: cdamage real(r8) :: canopy_trim integer :: ipft integer :: i_cvar @@ -1726,13 +1725,13 @@ function GetNutrientTargetCNP(this,element_id,organ_id,stoich_mode) result(targe real(r8) :: sapw_c_target,agw_c_target real(r8) :: bgw_c_target,struct_c_target + + dbh => this%bc_inout(acnp_bc_inout_id_dbh)%rval canopy_trim = this%bc_in(acnp_bc_in_id_ctrim)%rval ipft = this%bc_in(acnp_bc_in_id_pft)%ival i_cvar = prt_global%sp_organ_map(organ_id,carbon12_element) - cdamage => this%bc_inout(acnp_bc_inout_id_cdamage)%ival - ! Storage of nutrients are assumed to have different compartments than ! for carbon, and thus their targets are not associated with a tissue @@ -1741,10 +1740,10 @@ function GetNutrientTargetCNP(this,element_id,organ_id,stoich_mode) result(targe if(organ_id == store_organ) then - call bleaf(dbh,ipft,1, canopy_trim,leaf_c_target) + call bleaf(dbh,ipft,canopy_trim,leaf_c_target) call bfineroot(dbh,ipft,canopy_trim,fnrt_c_target) - call bsap_allom(dbh,ipft,1, canopy_trim,sapw_area,sapw_c_target) - call bagw_allom(dbh,ipft,1, agw_c_target) + call bsap_allom(dbh,ipft,canopy_trim,sapw_area,sapw_c_target) + call bagw_allom(dbh,ipft,agw_c_target) call bbgw_allom(dbh,ipft,bgw_c_target) call bdead_allom(agw_c_target,bgw_c_target, sapw_c_target, ipft, struct_c_target) @@ -2102,8 +2101,8 @@ function AllomCNPGrowthDeriv(l_state_array,l_state_mask,cbalance,intgr_params) r ! locals integer :: ipft ! PFT index + integer :: crowndamage ! Damage class real(r8) :: canopy_trim ! Canopy trimming function (boundary condition [0-1] - integer :: icrowndamage ! crown damage index real(r8) :: leaf_c_target ! target leaf biomass, dummy var (kgC) real(r8) :: fnrt_c_target ! target fine-root biomass, dummy var (kgC) real(r8) :: sapw_c_target ! target sapwood biomass, dummy var (kgC) @@ -2142,16 +2141,16 @@ function AllomCNPGrowthDeriv(l_state_array,l_state_mask,cbalance,intgr_params) r canopy_trim = intgr_params(acnp_bc_in_id_ctrim) ipft = int(intgr_params(acnp_bc_in_id_pft)) - icrowndamage = int(intgr_params(acnp_bc_inout_id_cdamage)) - - call bleaf(dbh,ipft,icrowndamage, canopy_trim,leaf_c_target,leaf_dcdd_target) + crowndamage = int(intgr_params(acnp_bc_in_id_cdamage)) + + call bleaf(dbh,ipft,crowndamage,canopy_trim,leaf_c_target,leaf_dcdd_target) call bfineroot(dbh,ipft,canopy_trim,fnrt_c_target,fnrt_dcdd_target) - call bsap_allom(dbh,ipft,icrowndamage, canopy_trim,sapw_area,sapw_c_target,sapw_dcdd_target) - call bagw_allom(dbh,ipft,icrowndamage, agw_c_target,agw_dcdd_target) + call bsap_allom(dbh,ipft,crowndamage,canopy_trim,sapw_area,sapw_c_target,sapw_dcdd_target) + call bagw_allom(dbh,ipft,crowndamage,agw_c_target,agw_dcdd_target) call bbgw_allom(dbh,ipft,bgw_c_target,bgw_dcdd_target) call bdead_allom(agw_c_target,bgw_c_target, sapw_c_target, ipft, struct_c_target, & agw_dcdd_target, bgw_dcdd_target, sapw_dcdd_target, struct_dcdd_target) - call bstore_allom(dbh,ipft,icrowndamage,canopy_trim,store_c_target,store_dcdd_target) + call bstore_allom(dbh,ipft,crowndamage,canopy_trim,store_c_target,store_dcdd_target) if (mask_repro) then ! fraction of carbon going towards reproduction diff --git a/parteh/PRTAllometricCarbonMod.F90 b/parteh/PRTAllometricCarbonMod.F90 index d2bce65d35..2a158aed30 100644 --- a/parteh/PRTAllometricCarbonMod.F90 +++ b/parteh/PRTAllometricCarbonMod.F90 @@ -90,14 +90,15 @@ module PRTAllometricCarbonMod integer, public, parameter :: ac_bc_inout_id_dbh = 1 ! Plant DBH integer, public, parameter :: ac_bc_inout_id_netdc = 2 ! Index for the net daily C input BC - integer, public, parameter :: ac_bc_inout_id_cdamage = 3 ! Index for the crowndamage input BC - integer, parameter :: num_bc_inout = 3 ! Number of in & output boundary conditions + + integer, parameter :: num_bc_inout = 2 ! Number of in & output boundary conditions integer, public, parameter :: ac_bc_in_id_pft = 1 ! Index for the PFT input BC integer, public, parameter :: ac_bc_in_id_ctrim = 2 ! Index for the canopy trim function integer, public, parameter :: ac_bc_in_id_lstat = 3 ! Leaf status (on or off) - integer, parameter :: num_bc_in = 3 ! Number of input boundary conditions + integer, public, parameter :: ac_bc_in_id_cdamage = 4 ! Index for the crowndamage input BC + integer, parameter :: num_bc_in = 4 ! Number of input boundary conditions ! THere are no purely output boundary conditions @@ -298,8 +299,7 @@ subroutine DailyPRTAllometricCarbon(this,phase) ! this local will point to both in and out bc's real(r8),pointer :: carbon_balance ! Daily carbon balance for this cohort [kgC] - real(r8), pointer :: n ! number of plants - integer, pointer :: crowndamage ! which crown damage class + integer :: crowndamage ! which crown damage class real(r8) :: canopy_trim ! The canopy trimming function [0-1] @@ -392,12 +392,13 @@ subroutine DailyPRTAllometricCarbon(this,phase) character(len=19), parameter :: fmth = '(a,1x,a5,3(1x,a12))' character(len=22), parameter :: fmtg = '(a,5x,l1,3(1x,es12.5))' - real(r8) :: intgr_params(num_bc_in+1) ! The boundary conditions to this routine, + ! The boundary conditions to this routine, ! are pressed into an array that is also ! passed to the integrators ! add one because we pass crown damage also ! which is not a bc_in - + + real(r8) :: intgr_params(num_bc_in) associate( & @@ -417,12 +418,13 @@ subroutine DailyPRTAllometricCarbon(this,phase) dbh => this%bc_inout(ac_bc_inout_id_dbh)%rval carbon_balance => this%bc_inout(ac_bc_inout_id_netdc)%rval - crowndamage => this%bc_inout(ac_bc_inout_id_cdamage)%ival + canopy_trim = this%bc_in(ac_bc_in_id_ctrim)%rval ipft = this%bc_in(ac_bc_in_id_pft)%ival leaf_status = this%bc_in(ac_bc_in_id_lstat)%ival - + crowndamage = this%bc_in(ac_bc_in_id_cdamage)%ival + nleafage = prt_global%state_descriptor(leaf_c_id)%num_pos ! Number of leaf age class ! ----------------------------------------------------------------------------------- @@ -644,10 +646,10 @@ subroutine DailyPRTAllometricCarbon(this,phase) ! left to allocate, and thus it must be on allometry when its not. ! ----------------------------------------------------------------------------------- - intgr_params(:) = un_initialized - intgr_params(ac_bc_in_id_ctrim) = this%bc_in(ac_bc_in_id_ctrim)%rval - intgr_params(ac_bc_in_id_pft) = real(this%bc_in(ac_bc_in_id_pft)%ival) - intgr_params(num_bc_in + 1) = real(this%bc_inout(ac_bc_inout_id_cdamage)%ival) + intgr_params(:) = un_initialized + intgr_params(ac_bc_in_id_ctrim) = this%bc_in(ac_bc_in_id_ctrim)%rval + intgr_params(ac_bc_in_id_pft) = real(this%bc_in(ac_bc_in_id_pft)%ival) + intgr_params(ac_bc_in_id_cdamage) = real(this%bc_in(ac_bc_in_id_cdamage)%ival) @@ -906,16 +908,16 @@ function AllomCGrowthDeriv(c_pools,c_mask,cbalance,intgr_params) result(dCdx) real(r8),dimension(lbound(c_pools,dim=1):ubound(c_pools,dim=1)) :: dCdx ! locals - integer :: ipft ! PFT index - integer :: crowndamage + integer :: ipft ! PFT index + integer :: crowndamage ! Damage class real(r8) :: canopy_trim ! Canopy trimming function (boundary condition [0-1] - real(r8) :: ct_leaf ! target leaf biomass, dummy var (kgC) - real(r8) :: ct_fnrt ! target fine-root biomass, dummy var (kgC) - real(r8) :: ct_sap ! target sapwood biomass, dummy var (kgC) - real(r8) :: ct_agw ! target aboveground wood, dummy var (kgC) - real(r8) :: ct_bgw ! target belowground wood, dummy var (kgC) - real(r8) :: ct_store ! target storage, dummy var (kgC) - real(r8) :: ct_dead ! target structural biomas, dummy var (kgC) + real(r8) :: ct_leaf ! target leaf biomass, dummy var (kgC) + real(r8) :: ct_fnrt ! target fine-root biomass, dummy var (kgC) + real(r8) :: ct_sap ! target sapwood biomass, dummy var (kgC) + real(r8) :: ct_agw ! target aboveground wood, dummy var (kgC) + real(r8) :: ct_bgw ! target belowground wood, dummy var (kgC) + real(r8) :: ct_store ! target storage, dummy var (kgC) + real(r8) :: ct_dead ! target structural biomas, dummy var (kgC) real(r8) :: sapw_area ! dummy sapwood area real(r8) :: ct_dleafdd ! target leaf biomass derivative wrt diameter, (kgC/cm) real(r8) :: ct_dfnrtdd ! target fine-root biomass derivative wrt diameter, (kgC/cm) @@ -945,7 +947,7 @@ function AllomCGrowthDeriv(c_pools,c_mask,cbalance,intgr_params) result(dCdx) canopy_trim = intgr_params(ac_bc_in_id_ctrim) ipft = int(intgr_params(ac_bc_in_id_pft)) - crowndamage = int(intgr_params(num_bc_in + 1)) + crowndamage = int(intgr_params(ac_bc_in_id_cdamage)) call bleaf(dbh,ipft,crowndamage,canopy_trim,ct_leaf, dbldd=ct_dleafdd) call bfineroot(dbh,ipft,canopy_trim,ct_fnrt,ct_dfnrtdd) From f6bfc64e6f49cb738cea4d92098b01e84236dc0c Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Fri, 1 Jul 2022 12:15:46 -0600 Subject: [PATCH 52/84] Various merge resolutions and fixes for new damge recovery scheme --- biogeochem/DamageMainMod.F90 | 90 ++++++++++++++-------- biogeochem/EDCanopyStructureMod.F90 | 2 +- biogeochem/EDCohortDynamicsMod.F90 | 3 +- biogeochem/EDMortalityFunctionsMod.F90 | 4 +- biogeochem/EDPatchDynamicsMod.F90 | 17 ++-- biogeophys/FatesPlantRespPhotosynthMod.F90 | 4 +- main/EDInitMod.F90 | 4 +- main/EDMainMod.F90 | 9 ++- main/EDPftvarcon.F90 | 40 ++++++++++ main/FatesHistoryInterfaceMod.F90 | 18 ++--- main/FatesIOVariableKindMod.F90 | 3 - main/FatesInterfaceTypesMod.F90 | 26 +------ main/FatesParametersInterface.F90 | 2 - main/FatesRestartInterfaceMod.F90 | 18 ++--- parteh/PRTAllometricCNPMod.F90 | 53 +++++++------ parteh/PRTAllometricCarbonMod.F90 | 2 +- parteh/PRTParamsFATESMod.F90 | 10 ++- 17 files changed, 173 insertions(+), 132 deletions(-) diff --git a/biogeochem/DamageMainMod.F90 b/biogeochem/DamageMainMod.F90 index c2cef680e4..290db57225 100644 --- a/biogeochem/DamageMainMod.F90 +++ b/biogeochem/DamageMainMod.F90 @@ -4,15 +4,22 @@ module DamageMainMod use FatesConstantsMod , only : i4 => fates_int use FatesConstantsMod , only : itrue, ifalse use FatesConstantsMod , only : years_per_day + use FatesConstantsMod , only : nearzero use FatesGlobals , only : fates_log use FatesGlobals , only : endrun => fates_endrun use shr_log_mod , only : errMsg => shr_log_errMsg use EDPftvarcon , only : EDPftvarcon_inst use EDParamsMod , only : damage_event_code - use EDtypesMod , only : ed_site_type - use EDtypesMod , only : ed_patch_type - use EDtypesMod , only : ed_cohort_type - use EDtypesMod , only : AREA + use EDTypesMod , only : ed_site_type + use EDTypesMod , only : ed_patch_type + use EDTypesMod , only : ed_cohort_type + use EDTypesMod , only : AREA + use EDTypesMod , only : leaves_on + use PRTGenericMod, only : num_elements + use PRTGenericMod, only : element_list + use PRTGenericMod, only : carbon12_element + use PRTGenericMod, only : nitrogen_element + use PRTGenericMod, only : phosphorus_element use PRTGenericMod, only : leaf_organ use PRTGenericMod, only : carbon12_element use PRTGenericMod, only : all_carbon_elements @@ -23,13 +30,25 @@ module DamageMainMod use PRTGenericMod, only : repro_organ use PRTGenericMod, only : struct_organ use PRTGenericMod, only : SetState + use PRTGenericMod, only : StorageNutrientTarget + use PRTParametersMod, only : prt_params use FatesInterfaceTypesMod, only : hlm_current_day use FatesInterfaceTypesMod, only : hlm_current_month use FatesInterfaceTypesMod, only : hlm_current_year use FatesInterfaceTypesMod, only : hlm_model_day - use FatesInterfaceTypesMod , only : hlm_day_of_year - - + use FatesInterfaceTypesMod, only : hlm_day_of_year + use FatesInterfaceTypesMod, only : hlm_use_planthydro + use FatesAllometryMod, only : bsap_allom + use FatesAllometryMod, only : bagw_allom + use FatesAllometryMod, only : bbgw_allom + use FatesAllometryMod, only : bdead_allom + use FatesAllometryMod, only : bfineroot + use FatesAllometryMod, only : bstore_allom + use FatesAllometryMod, only : bleaf + use EDCohortDynamicsMod, only : copy_cohort + use FatesPlantHydraulicsMod, only : InitHydrCohort + use EDCohortDynamicsMod , only : InitPRTObject + use EDCohortDynamicsMod , only : InitPRTBoundaryConditions implicit none private @@ -77,26 +96,34 @@ subroutine DamageRecovery(csite,cpatch,ccohort,newly_recovered) type(ed_site_type) :: csite ! Site of the current cohort type(ed_patch_type) :: cpatch ! patch of the current cohort - type(ed_cohort_type) :: ccohort ! Current (damaged) cohort + type(ed_cohort_type),pointer :: ccohort ! Current (damaged) cohort logical :: newly_recovered ! true if we create a new cohort ! locals type(ed_cohort_type), pointer :: rcohort ! New cohort that recovers by ! having an lower damage class - real(r8) :: sapw_area - real(r8) :: target_sapw_c,target_sapw_m - real(r8) :: target_agw_c - real(r8) :: target_bgw_c - real(r8) :: target_struct_c,target_struct_m - real(r8) :: target_fnrt_c,target_fnrt_m - real(r8) :: target_leaf_c,target_leaf_m - real(r8) :: target_store_c,target_store_m - real(r8) :: target_repro_m - real(r8) :: mass_d - real(r8) :: mass_dminus1 - real(r8) :: recovery_demand - real(r8) :: max_recover_nplant - real(r8) :: nplant_recover + real(r8) :: sapw_area ! sapwood area + real(r8) :: target_sapw_c,target_sapw_m ! sapwood mass, C and N/P + real(r8) :: target_agw_c ! target above ground wood + real(r8) :: target_bgw_c ! target below ground wood + real(r8) :: target_struct_c,target_struct_m ! target structural C and N/P + real(r8) :: target_fnrt_c,target_fnrt_m ! target fine-root C and N/P + real(r8) :: target_leaf_c,target_leaf_m ! target leaf C and N/P + real(r8) :: target_store_c,target_store_m ! target storage C and N/P + real(r8) :: target_repro_m ! target reproductive C/N/P + real(r8) :: leaf_m,fnrt_m,sapw_m ! actual masses in organs C/N/P + real(r8) :: struct_m,store_m,repro_m ! actual masses in organs C/N/P + real(r8) :: mass_d ! intermediate term for nplant_recover + real(r8) :: mass_dminus1 ! intermediate term for nplant_recover + real(r8) :: available_m ! available mass that can be used to + ! improve damage class + real(r8) :: recovery_demand ! amount of mass needed to get to + ! get to the target of the next damage class + real(r8) :: max_recover_nplant ! max number of plants that could get to + ! target of next class + real(r8) :: nplant_recover ! number of plants in cohort that will + ! recover to the next class + integer :: el ! element loop counter associate(dbh => ccohort%dbh, & ipft => ccohort%pft, & @@ -109,7 +136,7 @@ subroutine DamageRecovery(csite,cpatch,ccohort,newly_recovered) ! then no recovery is possible, do nothing and ! return a null pointer if ((ccohort%crowndamage == undamaged_class) .or. & - (damage_recovery_scalar < nearzero) ) then + (EDPftvarcon_inst%damage_recovery_scalar(ipft) < nearzero) ) then newly_recovered = .false. return end if @@ -134,10 +161,10 @@ subroutine DamageRecovery(csite,cpatch,ccohort,newly_recovered) ! Target fine-root biomass and deriv. according to allometry and trimming [kgC, kgC/cm] call bfineroot(dbh,ipft,canopy_trim,target_fnrt_c) ! Target storage carbon [kgC,kgC/cm] - call bstore_allom(dbh,ipft,crowndamage-1, canopy_trim,target_store_c) + call bstore_allom(dbh,ipft,ccohort%crowndamage-1, canopy_trim,target_store_c) ! Target leaf biomass according to allometry and trimming if(ccohort%status_coh==leaves_on) then - call bleaf(dbh,ipft,crowndamage-1, canopy_trim,target_leaf_c) + call bleaf(dbh,ipft,ccohort%crowndamage-1, canopy_trim,target_leaf_c) else target_leaf_c = 0._r8 end if @@ -178,7 +205,7 @@ subroutine DamageRecovery(csite,cpatch,ccohort,newly_recovered) prt_params%nitr_stoich_p1(ipft,prt_params%organ_param_id(sapw_organ)) target_repro_m = 0._r8 target_store_m = StorageNutrientTarget(ipft, element_list(el), & - leaf_target_m, fnrt_target_m, sapw_target_m, struct_target_m) + target_leaf_m, target_fnrt_m, target_sapw_m, target_struct_m) ! For nutrients, all uptake is immediately put into storage, so just swap ! them and assume storage is what is available, but needs to be filled up available_m = store_m @@ -194,7 +221,7 @@ subroutine DamageRecovery(csite,cpatch,ccohort,newly_recovered) prt_params%phos_stoich_p1(ipft,prt_params%organ_param_id(sapw_organ)) target_repro_m = 0._r8 target_store_m = StorageNutrientTarget(ipft, element_list(el), & - leaf_target_m, fnrt_target_m, sapw_target_m, struct_target_m) + target_leaf_m, target_fnrt_m, target_sapw_m, target_struct_m) ! For nutrients, all uptake is immediately put into storage, so just swap ! them and assume storage is what is available, but needs to be filled up available_m = store_m @@ -212,7 +239,7 @@ subroutine DamageRecovery(csite,cpatch,ccohort,newly_recovered) mass_dminus1 = max(leaf_m, target_leaf_m) + max(fnrt_m, target_fnrt_m) + & max(store_m, target_store_m) + max(sapw_m, target_sapw_m) + & - max(struct_m, target_struct_m)) + max(struct_m, target_struct_m) ! Mass needed to get from current mass to allometric ! target mass of next damage class up @@ -222,7 +249,8 @@ subroutine DamageRecovery(csite,cpatch,ccohort,newly_recovered) max_recover_nplant = available_m * ccohort%n / recovery_demand ! 4. Use the scalar to decide how many to recover - nplant_recover = min(nplant_recover,max(0._r8,max_recover_nplant * damage_recovery_scalar)) + nplant_recover = min(nplant_recover,max(0._r8,max_recover_nplant * & + EDPftvarcon_inst%damage_recovery_scalar(ipft) )) end do @@ -233,10 +261,10 @@ subroutine DamageRecovery(csite,cpatch,ccohort,newly_recovered) ! allowing the donor cohort to recover and then go through ! prt - will this work though? if they are not anywhere near allometry? - if( abs(damage_recovery_scalar-1._r8) < nearzero .and. & + if( abs(EDPftvarcon_inst%damage_recovery_scalar(ipft)-1._r8) < nearzero .and. & nplant_recover > ccohort%n) then nplant_recover = 0.0_r8 - crowndamage = crowndamage - 1 + ccohort%crowndamage = ccohort%crowndamage - 1 end if if(nplant_recover < nearzero) then diff --git a/biogeochem/EDCanopyStructureMod.F90 b/biogeochem/EDCanopyStructureMod.F90 index 9fc30b478b..6efbbeee93 100644 --- a/biogeochem/EDCanopyStructureMod.F90 +++ b/biogeochem/EDCanopyStructureMod.F90 @@ -2219,7 +2219,7 @@ subroutine UpdatePatchLAI(currentPatch, patch_lai, currentSite) ! Update the cohort level lai and related variables call UpdateCohortLAI(currentCohort,currentPatch%canopy_layer_tlai, & - currentPatch%total_canopy_area, currentSite%spread) + currentPatch%total_canopy_area) ! Update the number of number of vegetation layers currentPatch%ncan(cl,ft) = max(currentPatch%ncan(cl,ft),currentCohort%NV) diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index 1f48a1f055..71aa369b07 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -11,7 +11,7 @@ Module EDCohortDynamicsMod use FatesInterfaceTypesMod , only : hlm_use_planthydro use FatesInterfaceTypesMod , only : hlm_use_sp use FatesInterfaceTypesMod , only : hlm_use_cohort_age_tracking - use FatesInterfaceTypesMod , only : hlm_use_crown_damage + use FatesInterfaceTypesMod , only : hlm_use_tree_damage use FatesInterfaceTypesMod , only : hlm_is_restart use FatesConstantsMod , only : r8 => fates_r8 use FatesConstantsMod , only : fates_unset_int @@ -88,7 +88,6 @@ Module EDCohortDynamicsMod use PRTAllometricCarbonMod, only : callom_prt_vartypes use PRTAllometricCarbonMod, only : ac_bc_inout_id_netdc use PRTAllometricCarbonMod, only : ac_bc_in_id_pft - use PRTAllometricCarbonMod, only : ac_bc_inout_id_n use PRTAllometricCarbonMod, only : ac_bc_in_id_ctrim use PRTAllometricCarbonMod, only : ac_bc_inout_id_dbh use PRTAllometricCarbonMod, only : ac_bc_in_id_lstat, ac_bc_in_id_cdamage diff --git a/biogeochem/EDMortalityFunctionsMod.F90 b/biogeochem/EDMortalityFunctionsMod.F90 index d745f468d5..e160703945 100644 --- a/biogeochem/EDMortalityFunctionsMod.F90 +++ b/biogeochem/EDMortalityFunctionsMod.F90 @@ -19,7 +19,7 @@ module EDMortalityFunctionsMod use FatesInterfaceTypesMod , only : hlm_use_ed_prescribed_phys use FatesInterfaceTypesMod , only : hlm_freq_day use FatesInterfaceTypesMod , only : hlm_use_planthydro - use FatesInterfaceTypesMod , only : hlm_use_crown_damage + use FatesInterfaceTypesMod , only : hlm_use_tree_damage use EDLoggingMortalityMod , only : LoggingMortality_frac use EDParamsMod , only : fates_mortality_disturbance_fraction @@ -123,7 +123,7 @@ subroutine mortality_rates( cohort_in,bc_in,cmort,hmort,bmort,frmort,smort,asmor end if ! Damage dependent mortality - if (hlm_use_crown_damage .eq. itrue) then + if (hlm_use_tree_damage .eq. itrue) then call GetDamageMortality(cohort_in%crowndamage, cohort_in%pft, dgmort) else dgmort = 0.0_r8 diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index ee6b4d2ae4..83c027fdf8 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -7,6 +7,7 @@ module EDPatchDynamicsMod use FatesGlobals , only : FatesWarn,N2S,A2S use FatesInterfaceTypesMod , only : hlm_freq_day use FatesInterfaceTypesMod , only : hlm_days_per_year + use FatesInterfaceTypesMod, only : hlm_use_tree_damage use EDPftvarcon , only : EDPftvarcon_inst use EDPftvarcon , only : GetDecompyFrac use PRTParametersMod , only : prt_params @@ -463,7 +464,6 @@ subroutine spawn_patches( currentSite, bc_in) use PRTLossFluxesMod , only : PRTDamageLosses use PRTGenericMod , only : leaf_organ use ChecksBalancesMod , only : SiteMassStock - use FatesInterfaceTypesMod, only : hlm_use_crown_damage use FatesInterfaceTypesMod, only : nlevdamage use FatesParameterDerivedMod, only : param_derived use EDParamsMod , only : damage_canopy_layer_code @@ -754,7 +754,7 @@ subroutine spawn_patches( currentSite, bc_in) ! and the damaged trees - if(hlm_use_crown_damage .eq. itrue) then + if(hlm_use_tree_damage .eq. itrue) then if(damage_time) then call damage_litter_fluxes(currentSite, currentPatch, & @@ -899,7 +899,7 @@ subroutine spawn_patches( currentSite, bc_in) total_c * g_per_kg * days_per_sec * years_per_day * ha_per_m2 - if (hlm_use_crown_damage .eq. itrue) then + if (hlm_use_tree_damage .eq. itrue) then currentSite%imort_rate_damage(currentCohort%crowndamage, & currentCohort%size_class, currentCohort%pft) = & @@ -1013,7 +1013,7 @@ subroutine spawn_patches( currentSite, bc_in) end if ! also track fire damage mortality and cflux along size x damage axis - if(hlm_use_crown_damage .eq. itrue) then + if(hlm_use_tree_damage .eq. itrue) then if(levcan==ican_upper) then currentSite%fmort_rate_canopy_damage(currentCohort%crowndamage, currentCohort%size_class, & currentCohort%pft) = & @@ -1172,7 +1172,7 @@ subroutine spawn_patches( currentSite, bc_in) logging_coll_under_frac/ hlm_freq_day ) * & total_c * g_per_kg * days_per_sec * years_per_day * ha_per_m2 - if (hlm_use_crown_damage .eq. itrue) then + if (hlm_use_tree_damage .eq. itrue) then currentSite%imort_rate_damage(currentCohort%crowndamage,& currentCohort%size_class, currentCohort%pft) = & currentSite%imort_rate_damage(currentCohort%crowndamage,& @@ -1247,7 +1247,7 @@ subroutine spawn_patches( currentSite, bc_in) ! Regardless of disturbance type, reduce mass of damaged trees - if(hlm_use_crown_damage .eq. itrue) then + if(hlm_use_tree_damage .eq. itrue) then if(damage_time) then ! if woody @@ -2378,7 +2378,6 @@ subroutine damage_litter_fluxes(currentSite, currentPatch, newPatch,patch_site_a use FatesInterfaceTypesMod , only : nlevdamage use EDParamsMod , only : ED_val_understorey_death use EDParamsMod , only : damage_canopy_layer_code - use FatesInterfaceTypesMod, only : hlm_use_crown_damage use FatesConstantsMod, only : itrue use FatesParameterDerivedMod, only : param_derived ! @@ -2493,7 +2492,7 @@ subroutine damage_litter_fluxes(currentSite, currentPatch, newPatch,patch_site_a if(prt_params%woody(currentCohort%pft)==1) then - if( hlm_use_crown_damage .eq.itrue .and. & + if( hlm_use_tree_damage .eq.itrue .and. & currentCohort%canopy_layer ==1 .and. i_damage_code .eq. 1 .and. & .not. currentCohort%isnew) then @@ -2501,7 +2500,7 @@ subroutine damage_litter_fluxes(currentSite, currentPatch, newPatch,patch_site_a num_trees = currentCohort%n * (1.0_r8 - fates_mortality_disturbance_fraction * & min(1.0_r8, currentCohort%dmort* hlm_freq_day)) - else if( hlm_use_crown_damage .eq.itrue .and. & + else if( hlm_use_tree_damage .eq.itrue .and. & currentCohort%canopy_layer > 1 .and. i_damage_code .eq. 2 .and. & .not. currentCohort%isnew) then diff --git a/biogeophys/FatesPlantRespPhotosynthMod.F90 b/biogeophys/FatesPlantRespPhotosynthMod.F90 index df836bbff4..e3286d7b00 100644 --- a/biogeophys/FatesPlantRespPhotosynthMod.F90 +++ b/biogeophys/FatesPlantRespPhotosynthMod.F90 @@ -138,7 +138,7 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) use DamageMainMod, only : GetCrownReduction - use FatesInterfaceTypesMod, only : hlm_use_crown_damage + use FatesInterfaceTypesMod, only : hlm_use_tree_damage ! ARGUMENTS: ! ----------------------------------------------------------------------------------- @@ -653,7 +653,7 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) sapw_c = currentCohort%prt%GetState(sapw_organ, all_carbon_elements) fnrt_c = currentCohort%prt%GetState(fnrt_organ, all_carbon_elements) - if (hlm_use_crown_damage .eq. itrue) then + if (hlm_use_tree_damage .eq. itrue) then agb_frac = prt_params%allom_agb_frac(currentCohort%pft) branch_frac = param_derived%branch_frac(currentCohort%pft) diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index 22e9203ef4..526f8b0715 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -43,7 +43,7 @@ module EDInitMod use FatesInterfaceTypesMod , only : hlm_use_planthydro use FatesInterfaceTypesMod , only : hlm_use_inventory_init use FatesInterfaceTypesMod , only : hlm_use_fixed_biogeog - use FatesInterfaceTypesMod , only : hlm_use_crown_damage + use FatesInterfaceTypesMod , only : hlm_use_tree_damage use FatesInterfaceTypesMod , only : hlm_use_sp use FatesInterfaceTypesMod , only : numpft use FatesInterfaceTypesMod , only : nleafage @@ -131,7 +131,7 @@ subroutine init_site_vars( site_in, bc_in, bc_out ) allocate(site_in%mass_balance(1:num_elements)) allocate(site_in%flux_diags(1:num_elements)) - if (hlm_use_crown_damage .eq. itrue) then + if (hlm_use_tree_damage .eq. itrue) then allocate(site_in%term_nindivs_canopy_damage(1:nlevdamage, 1:nlevsclass, 1:numpft)) allocate(site_in%term_nindivs_ustory_damage(1:nlevdamage, 1:nlevsclass, 1:numpft)) allocate(site_in%imort_rate_damage(1:nlevdamage, 1:nlevsclass, 1:numpft)) diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index 03e9903de8..ccdc3e5ae7 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -19,7 +19,7 @@ module EDMainMod use FatesInterfaceTypesMod , only : hlm_use_cohort_age_tracking use FatesInterfaceTypesMod , only : hlm_reference_date use FatesInterfaceTypesMod , only : hlm_use_ed_prescribed_phys - use FatesInterfaceTypesMod , only : hlm_use_crown_damage + use FatesInterfaceTypesMod , only : hlm_use_tree_damage use FatesInterfaceTypesMod , only : hlm_use_ed_st3 use FatesInterfaceTypesMod , only : hlm_use_sp use FatesInterfaceTypesMod , only : bc_in_type @@ -361,7 +361,10 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) real(r8) :: delta_dbh ! correction for dbh real(r8) :: delta_hite ! correction for hite real(r8) :: current_npp ! place holder for calculating npp each year in prescribed physiology mode - + logical :: newly_recovered ! If the current loop is dealing with a newly created cohort, which + ! was created because it is a clone of the previous cohort in + ! a lowered damage state. This cohort should bypass several calculations + ! because it inherited them (such as daily carbon balance) real(r8) :: target_leaf_c real(r8) :: frac_site_primary @@ -540,7 +543,7 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) call currentCohort%prt%DailyPRT(phase=1) if((newly_recovered .eq. .false.) .and. & - (hlm_use_crown_damage .eq. itrue) ) then + (hlm_use_tree_damage .eq. itrue) ) then ! The loop order is shortest to tallest ! The recovered cohort (ie one with larger targets) ! is newly created in DamageRecovery(), and diff --git a/main/EDPftvarcon.F90 b/main/EDPftvarcon.F90 index 7d6d4f641b..d7319dfa2c 100644 --- a/main/EDPftvarcon.F90 +++ b/main/EDPftvarcon.F90 @@ -131,6 +131,14 @@ module EDPftvarcon real(r8), allocatable :: prescribed_recruitment(:) ! this is only for the ! prescribed_physiology_mode + + ! Damage Parameters + + real(r8), allocatable :: damage_frac(:) ! Fraction of each cohort damaged per year + real(r8), allocatable :: damage_mort_p1(:) ! Inflection point for damage mortality function + real(r8), allocatable :: damage_mort_p2(:) ! Rate parameter for damage mortality function + real(r8), allocatable :: damage_recovery_scalar(:) ! what fraction of cohort gets to recover + ! Nutrient Aquisition (ECA & RD) @@ -430,6 +438,22 @@ subroutine Register_PFT(this, fates_params) call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) + name = 'fates_damage_frac' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_damage_mort_p1' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_damage_mort_p2' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_damage_recovery_scalar' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + name = 'fates_fire_alpha_SH' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) @@ -763,6 +787,22 @@ subroutine Receive_PFT(this, fates_params) call fates_params%RetrieveParameterAllocate(name=name, & data=this%prescribed_recruitment) + name = 'fates_damage_frac' + call fates_params%RetrieveParameterAllocate(name=name, & + data=this%damage_frac) + + name = 'fates_damage_mort_p1' + call fates_params%RetrieveParameterAllocate(name=name, & + data=this%damage_mort_p1) + + name = 'fates_damage_mort_p2' + call fates_params%RetrieveParameterAllocate(name=name, & + data=this%damage_mort_p2) + + name = 'fates_damage_recovery_scalar' + call fates_params%RetrieveParameterAllocate(name=name, & + data=this%damage_recovery_scalar) + name = 'fates_fire_alpha_SH' call fates_params%RetrieveParameterAllocate(name=name, & data=this%fire_alpha_SH) diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index abac9921d7..2987c5df56 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -38,7 +38,7 @@ module FatesHistoryInterfaceMod use FatesInterfaceTypesMod , only : hlm_use_planthydro use FatesInterfaceTypesMod , only : hlm_use_ed_st3 use FatesInterfaceTypesMod , only : hlm_use_cohort_age_tracking - use FatesInterfaceTypesMod , only : hlm_use_crown_damage + use FatesInterfaceTypesMod , only : hlm_use_tree_damage use FatesInterfaceTypesMod , only : nlevdamage use FatesInterfaceTypesMod , only : numpft use FatesInterfaceTypesMod , only : hlm_freq_day @@ -2216,7 +2216,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) end do ! damage variables - site level - this needs to be OUT of the patch loop - if(hlm_use_crown_damage .eq. itrue) then + if(hlm_use_tree_damage .eq. itrue) then this%hvars(ih_crownarea_canopy_damage_si)%r81d(io_si) = & this%hvars(ih_crownarea_canopy_damage_si)%r81d(io_si) + & @@ -2643,7 +2643,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) scls => ccohort%size_class, & cacls => ccohort%coage_class, & capf => ccohort%coage_by_pft_class, & - cdam => ccohort%crowndamage)) + cdam => ccohort%crowndamage) gpp_cached = (hio_gpp_si_scpf(io_si,scpf)) * & days_per_year * sec_per_day @@ -2749,7 +2749,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) end if ! damage variables - cohort level - if(hlm_use_crown_damage .eq. itrue) then + if(hlm_use_tree_damage .eq. itrue) then cdpf = get_cdamagesizepft_class_index(ccohort%dbh, ccohort%crowndamage, ccohort%pft) @@ -2912,7 +2912,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) ccohort%n * ccohort%npp_acc_hold / m2_per_ha / days_per_year / sec_per_day ! damage variables - canopy - if(hlm_use_crown_damage .eq. itrue) then + if(hlm_use_tree_damage .eq. itrue) then ! carbon starvation mortality in the canopy by size x damage x pft this%hvars(ih_m3_mortality_canopy_si_cdpf)%r82d(io_si,cdpf) = & @@ -3045,7 +3045,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) ccohort%npp_acc_hold * ccohort%n / m2_per_ha / days_per_year / sec_per_day ! damage variables - understory - if(hlm_use_crown_damage .eq. itrue) then + if(hlm_use_tree_damage .eq. itrue) then ! carbon mortality in the understory by damage x size x pft this%hvars(ih_m3_mortality_understory_si_cdpf)%r82d(io_si,cdpf) = & @@ -3335,7 +3335,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_firemortality_carbonflux_si_pft(io_si,i_pft) = sites(s)%fmort_carbonflux_canopy(i_pft) / g_per_kg end do - if(hlm_use_crown_damage .eq. itrue) then + if(hlm_use_tree_damage .eq. itrue) then do i_pft = 1, numpft do icdam = 1, nlevdamage @@ -3417,7 +3417,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_m9_si_scpf(io_si,i_scpf) + & hio_m10_si_scpf(io_si,i_scpf) - if(hlm_use_crown_damage .eq. itrue) then + if(hlm_use_tree_damage .eq. itrue) then hio_mortality_si_pft(io_si, i_pft) = hio_mortality_si_pft(io_si,i_pft) + & this%hvars(ih_m11_si_scpf)%r82d(io_si,i_scpf) end if @@ -6923,7 +6923,7 @@ subroutine define_history_vars(this, initialize_variables) ! CROWN DAMAGE VARIABLES - if_crowndamage: if(hlm_use_crown_damage .eq. itrue) then + if_crowndamage: if(hlm_use_tree_damage .eq. itrue) then call this%set_history_var(vname='FATES_CROWNAREA_CANOPY_CD', units = 'm2 m-2 yr-1', & long='crownarea lost to damage each year', use_default='inactive', & diff --git a/main/FatesIOVariableKindMod.F90 b/main/FatesIOVariableKindMod.F90 index c311b03de0..853122730e 100644 --- a/main/FatesIOVariableKindMod.F90 +++ b/main/FatesIOVariableKindMod.F90 @@ -36,9 +36,6 @@ module FatesIOVariableKindMod character(*), parameter, public :: site_cdsc_r8 = 'SI_CDSC_R8' character(*), parameter, public :: site_cdam_r8 = 'SI_CDAM_R8' character(*), parameter, public :: site_cnlfpft_r8 = 'SI_CNLFPFT_R8' - character(*), parameter, public :: site_cdpf_r8 = 'SI_CDPF_R8' - character(*), parameter, public :: site_cdsc_r8 = 'SI_CDSC_R8' - character(*), parameter, public :: site_cdam_r8 = 'SI_CDAM_R8' character(*), parameter, public :: site_scag_r8 = 'SI_SCAG_R8' character(*), parameter, public :: site_scagpft_r8 = 'SI_SCAGPFT_R8' character(*), parameter, public :: site_agepft_r8 = 'SI_AGEPFT_R8' diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index ad9020cb65..5df7fd7abf 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -146,21 +146,6 @@ module FatesInterfaceTypesMod ! cohort age tracking. 1 = TRUE, 0 = FALSE -<<<<<<< HEAD - integer, public :: hlm_use_crown_damage ! This flag signals whether or not to use - ! the crown damage module. 1 = TRUE, 0 = FALSE - - - integer, public :: hlm_use_ed_st3 ! This flag signals whether or not to use - ! (ST)atic (ST)and (ST)ructure mode (ST3) - ! Essentially, this gives us the ability - ! to turn off "dynamics", ie growth, disturbance - ! recruitment and mortality. - ! (EXPERIMENTAL!!!!! - RGK 07-2017) - ! 1 = TRUE, 0 = FALSE - ! default should be FALSE (dynamics on) - ! cannot be true with prescribed_phys -======= integer, public :: hlm_use_tree_damage ! This flag signals whether or not to turn on the ! tree damage module @@ -173,7 +158,6 @@ module FatesInterfaceTypesMod ! 1 = TRUE, 0 = FALSE ! default should be FALSE (dynamics on) ! cannot be true with prescribed_phys ->>>>>>> master integer, public :: hlm_use_ed_prescribed_phys ! This flag signals whether or not to use ! prescribed physiology, somewhat the opposite @@ -255,13 +239,6 @@ module FatesInterfaceTypesMod real(r8), public, allocatable :: fates_hdim_levsclass(:) ! plant size class lower bound dimension integer , public, allocatable :: fates_hdim_pfmap_levscpf(:) ! map of pfts into size-class x pft dimension integer , public, allocatable :: fates_hdim_scmap_levscpf(:) ! map of size-class into size-class x pft dimension - integer , public, allocatable :: fates_hdim_pftmap_levcdpf(:) ! map of pfts into size x crowndamage x pft dimension - integer , public, allocatable :: fates_hdim_cdmap_levcdpf(:) ! map of crowndamage into size x crowndamage x pft - integer , public, allocatable :: fates_hdim_scmap_levcdpf(:) ! map of size into size x crowndamage x pft - integer , public, allocatable :: fates_hdim_cdmap_levcdsc(:) ! map of crowndamage into size x crowndamage - integer , public, allocatable :: fates_hdim_scmap_levcdsc(:) ! map of size into size x crowndamage - integer , public, allocatable :: fates_hdim_levdamage(:) ! plant damage class lower bound dimension - real(r8), public, allocatable :: fates_hdim_levage(:) ! patch age lower bound dimension real(r8), public, allocatable :: fates_hdim_levheight(:) ! height lower bound dimension integer , public, allocatable :: fates_hdim_levpft(:) ! plant pft dimension @@ -554,7 +531,7 @@ module FatesInterfaceTypesMod character(len=64), allocatable :: hlm_harvest_catnames(:) ! names of hlm_harvest d1 integer :: hlm_harvest_units ! what units are the harvest rates specified in? [area vs carbon] - + ! Fixed biogeography mode real(r8), allocatable :: pft_areafrac(:) ! Fractional area of the FATES column occupied by each PFT @@ -745,6 +722,7 @@ module FatesInterfaceTypesMod ! small fluxes for various reasons ! [mm H2O/s] + ! 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] diff --git a/main/FatesParametersInterface.F90 b/main/FatesParametersInterface.F90 index ff44b73cd0..aa13150c4a 100644 --- a/main/FatesParametersInterface.F90 +++ b/main/FatesParametersInterface.F90 @@ -31,12 +31,10 @@ module FatesParametersInterface character(len=*), parameter, public :: dimension_name_hydr_organs = 'fates_hydr_organs' character(len=*), parameter, public :: dimension_name_prt_organs = 'fates_plant_organs' character(len=*), parameter, public :: dimension_name_leaf_age = 'fates_leafage_class' - character(len=*), parameter, public :: dimension_name_damage = 'fates_damage_class' character(len=*), parameter, public :: dimension_name_history_size_bins = 'fates_history_size_bins' character(len=*), parameter, public :: dimension_name_history_age_bins = 'fates_history_age_bins' character(len=*), parameter, public :: dimension_name_history_height_bins = 'fates_history_height_bins' character(len=*), parameter, public :: dimension_name_history_coage_bins = 'fates_history_coage_bins' - character(len=*), parameter, public :: dimension_name_history_damage_bins = 'fates_history_damage_bins' character(len=*), parameter, public :: dimension_name_hlm_pftno = 'fates_hlm_pftno' character(len=*), parameter, public :: dimension_name_history_damage_bins = 'fates_history_damage_bins' character(len=*), parameter, public :: dimension_name_damage = 'fates_damage_class' diff --git a/main/FatesRestartInterfaceMod.F90 b/main/FatesRestartInterfaceMod.F90 index 027dd08cfb..a225cce2e8 100644 --- a/main/FatesRestartInterfaceMod.F90 +++ b/main/FatesRestartInterfaceMod.F90 @@ -20,6 +20,7 @@ module FatesRestartInterfaceMod use FatesInterfaceTypesMod, only : hlm_use_planthydro use FatesInterfaceTypesMod, only : hlm_use_sp use FatesInterfaceTypesMod, only : fates_maxElementsPerSite + use FatesInterfaceTypesMod, only : hlm_use_tree_damage use EDCohortDynamicsMod, only : UpdateCohortBioPhysRates use FatesHydraulicsMemMod, only : nshell use FatesHydraulicsMemMod, only : n_hypool_ag @@ -1792,7 +1793,6 @@ end subroutine set_restart_var subroutine set_restart_vectors(this,nc,nsites,sites) - use FatesInterfaceTypesMod, only : hlm_use_crown_damage use FatesInterfaceTypesMod, only : fates_maxElementsPerPatch use FatesInterfaceTypesMod, only : numpft use EDTypesMod, only : ed_site_type @@ -1970,9 +1970,7 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_promcflux_si => this%rvars(ir_promcflux_si)%r81d, & rio_imortcflux_sipft => this%rvars(ir_imortcflux_sipft)%r81d, & rio_fmortcflux_cano_sipft => this%rvars(ir_fmortcflux_cano_sipft)%r81d, & - rio_fmortcflux_usto_sipft => this%rvars(ir_fmortcflux_usto_sipft)%r81d) - - ! damage + rio_fmortcflux_usto_sipft => this%rvars(ir_fmortcflux_usto_sipft)%r81d, & rio_imortrate_sicdpf => this%rvars(ir_imortrate_sicdpf)%r81d, & rio_imortcflux_sicdsc => this%rvars(ir_imortcflux_sicdsc)%r81d, & rio_termcflux_cano_sicdsc => this%rvars(ir_termcflux_cano_sicdsc)%r81d, & @@ -2379,7 +2377,7 @@ subroutine set_restart_vectors(this,nc,nsites,sites) ! this only copies live portions of transitions - but that's ok because the mortality ! bit only needs to be added for history outputs - if(hlm_use_crown_damage .eq. itrue) then + if(hlm_use_tree_damage .eq. itrue) then do i_scls = 1, nlevsclass do i_cdam = 1, nlevdamage @@ -2708,8 +2706,6 @@ subroutine get_restart_vectors(this, nc, nsites, sites) use EDTypesMod, only : numWaterMem use EDTypesMod, only : num_vegtemp_mem use FatesSizeAgeTypeIndicesMod, only : get_age_class_index - use FatesInterfaceTypesMod, only : hlm_use_crown_damage - ! !ARGUMENTS: class(fates_restart_interface_type) , intent(inout) :: this @@ -2870,13 +2866,9 @@ subroutine get_restart_vectors(this, nc, nsites, sites) rio_promcflux_si => this%rvars(ir_promcflux_si)%r81d, & rio_termcarea_cano_si => this%rvars(ir_termcarea_cano_si)%r81d, & rio_termcarea_usto_si => this%rvars(ir_termcarea_usto_si)%r81d, & - rio_imortcarea_si => this%rvars(ir_imortcarea_si)%r81d, & rio_fmortcarea_cano_si => this%rvars(ir_fmortcarea_cano_si)%r81d, & rio_fmortcarea_usto_si => this%rvars(ir_fmortcarea_usto_si)%r81d, & - - - ! Damage rio_imortrate_sicdpf => this%rvars(ir_imortrate_sicdpf)%r81d, & rio_termnindiv_cano_sicdpf => this%rvars(ir_termnindiv_cano_sicdpf)%r81d, & rio_termnindiv_usto_sicdpf => this%rvars(ir_termnindiv_usto_sicdpf)%r81d, & @@ -2888,7 +2880,7 @@ subroutine get_restart_vectors(this, nc, nsites, sites) rio_fmortcflux_cano_sicdsc => this%rvars(ir_fmortcflux_cano_sicdsc)%r81d, & rio_fmortcflux_usto_sicdsc => this%rvars(ir_fmortcflux_usto_sicdsc)%r81d, & rio_crownarea_cano_damage_si=> this%rvars(ir_crownarea_cano_si)%r81d, & - rio_crownarea_usto_damage_si=> this%rvars(ir_crownarea_usto_si)%r81d ) + rio_crownarea_usto_damage_si=> this%rvars(ir_crownarea_usto_si)%r81d, & rio_imortcflux_sipft => this%rvars(ir_imortcflux_sipft)%r81d, & rio_fmortcflux_cano_sipft => this%rvars(ir_fmortcflux_cano_sipft)%r81d, & rio_fmortcflux_usto_sipft => this%rvars(ir_fmortcflux_usto_sipft)%r81d) @@ -3308,7 +3300,7 @@ subroutine get_restart_vectors(this, nc, nsites, sites) io_idx_si_sc = io_idx_si_sc + 1 end do - if (hlm_use_crown_damage .eq. itrue) then + if (hlm_use_tree_damage .eq. itrue) then do i_cdam = 1, nlevdamage do i_pft = 1, numpft do i_scls = 1, nlevsclass diff --git a/parteh/PRTAllometricCNPMod.F90 b/parteh/PRTAllometricCNPMod.F90 index d9d0b1385d..6170a7ae2e 100644 --- a/parteh/PRTAllometricCNPMod.F90 +++ b/parteh/PRTAllometricCNPMod.F90 @@ -339,7 +339,7 @@ subroutine DailyPRTAllometricCNP(this,phase) real(r8) :: n_gain ! Daily nitrogen uptake through fine-roots [kgN] real(r8) :: p_gain ! Daily phosphorus uptake through fine-roots [kgN] real(r8) :: canopy_trim ! The canopy trimming function [0-1] - integer :: crowndamage ! which crown damage clas + integer :: crown_damage ! which crown damage clas ! Pointers to output bcs real(r8),pointer :: c_efflux ! Total plant efflux of carbon (kgC) @@ -409,7 +409,7 @@ subroutine DailyPRTAllometricCNP(this,phase) p_gain = this%bc_in(acnp_bc_in_id_netdp)%rval; p_gain0 = p_gain canopy_trim = this%bc_in(acnp_bc_in_id_ctrim)%rval ipft = this%bc_in(acnp_bc_in_id_pft)%ival - crowndamage = this%bc_in(acnp_bc_in_id_cdamage)%ival + crown_damage = this%bc_in(acnp_bc_in_id_cdamage)%ival ! Output only boundary conditions c_efflux => this%bc_out(acnp_bc_out_id_cefflux)%rval; c_efflux = 0._r8 @@ -424,7 +424,7 @@ subroutine DailyPRTAllometricCNP(this,phase) dbh => this%bc_inout(acnp_bc_inout_id_dbh)%rval; dbh0 = dbh - if(crowndamage>1)then + if(crown_damage>1)then write(fates_log(),*) 'The crown damage model is incompatible with' write(fates_log(),*) 'dynamic nutrients, ie parteh_mode=2' write(fates_log(),*) 'This feature will be brought in in with CNP v2' @@ -443,14 +443,14 @@ subroutine DailyPRTAllometricCNP(this,phase) ! Set carbon targets based on the plant's current stature target_c(:) = fates_unset_r8 target_dcdd(:) = fates_unset_r8 - call bsap_allom(dbh,ipft,canopy_trim,sapw_area,target_c(sapw_id),target_dcdd(sapw_id) ) - call bagw_allom(dbh,ipft,agw_c_target,agw_dcdd_target) + call bsap_allom(dbh,ipft,crown_damage,canopy_trim,sapw_area,target_c(sapw_id),target_dcdd(sapw_id) ) + call bagw_allom(dbh,ipft,crown_damage,agw_c_target,agw_dcdd_target) call bbgw_allom(dbh,ipft,bgw_c_target,bgw_dcdd_target) call bdead_allom(agw_c_target,bgw_c_target, target_c(sapw_id), ipft, target_c(struct_id), & agw_dcdd_target, bgw_dcdd_target, target_dcdd(sapw_id), target_dcdd(struct_id)) - call bleaf(dbh,ipft,canopy_trim, target_c(leaf_id), target_dcdd(leaf_id)) + call bleaf(dbh,ipft,crown_damage,canopy_trim, target_c(leaf_id), target_dcdd(leaf_id)) call bfineroot(dbh,ipft,canopy_trim, target_c(fnrt_id), target_dcdd(fnrt_id)) - call bstore_allom(dbh,ipft,canopy_trim, target_c(store_id), target_dcdd(store_id)) + call bstore_allom(dbh,ipft,crown_damage,canopy_trim, target_c(store_id), target_dcdd(store_id)) target_c(repro_id) = 0._r8 target_dcdd(repro_id) = 0._r8 @@ -1024,6 +1024,7 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & integer :: ipft real(r8) :: canopy_trim real(r8) :: leaf_status + integer :: crown_damage ! which crown damage clas integer :: i, ii ! organ index loops (masked and unmasked) integer :: istep ! outer step iteration loop @@ -1104,6 +1105,7 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & leaf_status = this%bc_in(acnp_bc_in_id_lstat)%ival dbh => this%bc_inout(acnp_bc_inout_id_dbh)%rval ipft = this%bc_in(acnp_bc_in_id_pft)%ival + crown_damage = this%bc_in(acnp_bc_in_id_cdamage)%ival canopy_trim = this%bc_in(acnp_bc_in_id_ctrim)%rval cnp_limiter = 0 @@ -1371,7 +1373,7 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & leafc_tp1 = leafc_tp1 + this%variables(i_var)%val(i) end do - call CheckIntegratedAllometries(state_array_out(dbh_id),ipft,canopy_trim, & + call CheckIntegratedAllometries(state_array_out(dbh_id),ipft,crown_damage,canopy_trim, & leafc_tp1, state_array_out(fnrt_id), state_array_out(sapw_id), & state_array_out(store_id), state_array_out(struct_id), & state_mask(leaf_id), state_mask(fnrt_id), state_mask(sapw_id), & @@ -1461,13 +1463,13 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & storec_tp1 = state_array_out(store_id) structc_tp1 = state_array_out(struct_id) - call bleaf(dbh_tp1,ipft,canopy_trim,leaf_c_target_tp1) + call bleaf(dbh_tp1,ipft,crown_damage,canopy_trim,leaf_c_target_tp1) call bfineroot(dbh_tp1,ipft,canopy_trim,fnrt_c_target_tp1) - call bsap_allom(dbh_tp1,ipft,canopy_trim,sapw_area,sapw_c_target_tp1) - call bagw_allom(dbh_tp1,ipft,agw_c_target_tp1) + call bsap_allom(dbh_tp1,ipft,crown_damage,canopy_trim,sapw_area,sapw_c_target_tp1) + call bagw_allom(dbh_tp1,ipft,crown_damage,agw_c_target_tp1) call bbgw_allom(dbh_tp1,ipft,bgw_c_target_tp1) call bdead_allom(agw_c_target_tp1,bgw_c_target_tp1, sapw_c_target_tp1, ipft, struct_c_target_tp1) - call bstore_allom(dbh_tp1,ipft,canopy_trim,store_c_target_tp1) + call bstore_allom(dbh_tp1,ipft,crown_damage,canopy_trim,store_c_target_tp1) write(fates_log(),*) 'leaf_c: ',leafc_tp1, leaf_c_target_tp1,leafc_tp1-leaf_c_target_tp1 write(fates_log(),*) 'fnrt_c: ',fnrtc_tp1, fnrt_c_target_tp1,fnrtc_tp1- fnrt_c_target_tp1 @@ -1575,11 +1577,12 @@ subroutine CNPAllocateRemainder(this,c_gain, n_gain, p_gain, & real(r8), pointer :: dbh integer :: ipft real(r8) :: canopy_trim - + integer :: crown_damage dbh => this%bc_inout(acnp_bc_inout_id_dbh)%rval canopy_trim = this%bc_in(acnp_bc_in_id_ctrim)%rval ipft = this%bc_in(acnp_bc_in_id_pft)%ival + crown_damage = this%bc_in(acnp_bc_in_id_cdamage)%ival ! ----------------------------------------------------------------------------------- ! If nutrients are still available, then we can bump up the values in the pools @@ -1631,7 +1634,7 @@ subroutine CNPAllocateRemainder(this,c_gain, n_gain, p_gain, & if(c_gain>calloc_abs_error) then ! Update carbon based allometric targets - call bstore_allom(dbh,ipft,canopy_trim, store_c_target) + call bstore_allom(dbh,ipft,crown_damage,canopy_trim, store_c_target) ! Estimate the overflow store_c_target = store_c_target * (1.0_r8 + store_overflow_frac) @@ -1720,6 +1723,7 @@ function GetNutrientTargetCNP(this,element_id,organ_id,stoich_mode) result(targe real(r8) :: canopy_trim integer :: ipft integer :: i_cvar + integer :: crown_damage real(r8) :: sapw_area real(r8) :: leaf_c_target,fnrt_c_target real(r8) :: sapw_c_target,agw_c_target @@ -1732,7 +1736,8 @@ function GetNutrientTargetCNP(this,element_id,organ_id,stoich_mode) result(targe canopy_trim = this%bc_in(acnp_bc_in_id_ctrim)%rval ipft = this%bc_in(acnp_bc_in_id_pft)%ival i_cvar = prt_global%sp_organ_map(organ_id,carbon12_element) - + crown_damage = this%bc_in(acnp_bc_in_id_cdamage)%ival + ! Storage of nutrients are assumed to have different compartments than ! for carbon, and thus their targets are not associated with a tissue ! but is more represented as a fraction of the maximum amount of nutrient @@ -1740,10 +1745,10 @@ function GetNutrientTargetCNP(this,element_id,organ_id,stoich_mode) result(targe if(organ_id == store_organ) then - call bleaf(dbh,ipft,canopy_trim,leaf_c_target) + call bleaf(dbh,ipft,crown_damage,canopy_trim,leaf_c_target) call bfineroot(dbh,ipft,canopy_trim,fnrt_c_target) - call bsap_allom(dbh,ipft,canopy_trim,sapw_area,sapw_c_target) - call bagw_allom(dbh,ipft,agw_c_target) + call bsap_allom(dbh,ipft,crown_damage,canopy_trim,sapw_area,sapw_c_target) + call bagw_allom(dbh,ipft,crown_damage,agw_c_target) call bbgw_allom(dbh,ipft,bgw_c_target) call bdead_allom(agw_c_target,bgw_c_target, sapw_c_target, ipft, struct_c_target) @@ -2101,7 +2106,7 @@ function AllomCNPGrowthDeriv(l_state_array,l_state_mask,cbalance,intgr_params) r ! locals integer :: ipft ! PFT index - integer :: crowndamage ! Damage class + integer :: crown_damage ! Damage class real(r8) :: canopy_trim ! Canopy trimming function (boundary condition [0-1] real(r8) :: leaf_c_target ! target leaf biomass, dummy var (kgC) real(r8) :: fnrt_c_target ! target fine-root biomass, dummy var (kgC) @@ -2141,16 +2146,16 @@ function AllomCNPGrowthDeriv(l_state_array,l_state_mask,cbalance,intgr_params) r canopy_trim = intgr_params(acnp_bc_in_id_ctrim) ipft = int(intgr_params(acnp_bc_in_id_pft)) - crowndamage = int(intgr_params(acnp_bc_in_id_cdamage)) + crown_damage = int(intgr_params(acnp_bc_in_id_cdamage)) - call bleaf(dbh,ipft,crowndamage,canopy_trim,leaf_c_target,leaf_dcdd_target) + call bleaf(dbh,ipft,crown_damage,canopy_trim,leaf_c_target,leaf_dcdd_target) call bfineroot(dbh,ipft,canopy_trim,fnrt_c_target,fnrt_dcdd_target) - call bsap_allom(dbh,ipft,crowndamage,canopy_trim,sapw_area,sapw_c_target,sapw_dcdd_target) - call bagw_allom(dbh,ipft,crowndamage,agw_c_target,agw_dcdd_target) + call bsap_allom(dbh,ipft,crown_damage,canopy_trim,sapw_area,sapw_c_target,sapw_dcdd_target) + call bagw_allom(dbh,ipft,crown_damage,agw_c_target,agw_dcdd_target) call bbgw_allom(dbh,ipft,bgw_c_target,bgw_dcdd_target) call bdead_allom(agw_c_target,bgw_c_target, sapw_c_target, ipft, struct_c_target, & agw_dcdd_target, bgw_dcdd_target, sapw_dcdd_target, struct_dcdd_target) - call bstore_allom(dbh,ipft,crowndamage,canopy_trim,store_c_target,store_dcdd_target) + call bstore_allom(dbh,ipft,crown_damage,canopy_trim,store_c_target,store_dcdd_target) if (mask_repro) then ! fraction of carbon going towards reproduction diff --git a/parteh/PRTAllometricCarbonMod.F90 b/parteh/PRTAllometricCarbonMod.F90 index 2a158aed30..56f8c8e1f4 100644 --- a/parteh/PRTAllometricCarbonMod.F90 +++ b/parteh/PRTAllometricCarbonMod.F90 @@ -629,7 +629,7 @@ subroutine DailyPRTAllometricCarbon(this,phase) end if - elseif( (phase.eq.2) .and. ( carbon_balance > calloc_abs_error ) then + elseif( (phase.eq.2) .and. ( carbon_balance > calloc_abs_error )) then ! ----------------------------------------------------------------------------------- ! VIII. If carbon is yet still available ... diff --git a/parteh/PRTParamsFATESMod.F90 b/parteh/PRTParamsFATESMod.F90 index 66033a3194..76558874b7 100644 --- a/parteh/PRTParamsFATESMod.F90 +++ b/parteh/PRTParamsFATESMod.F90 @@ -1378,14 +1378,16 @@ function NewRecruitTotalStoichiometry(ft,element_id) result(recruit_stoich) real(r8) :: c_total ! total target carbon real(r8) :: nutr_total ! total target nutrient + integer, parameter :: not_damaged = 1 ! this is also in MainDamageMod, here for dependency purposes + call h2d_allom(EDPftvarcon_inst%hgt_min(ft),ft,dbh) - call bleaf(dbh,ft,init_recruit_trim,c_leaf) + call bleaf(dbh,ft,not_damaged,init_recruit_trim,c_leaf) call bfineroot(dbh,ft,init_recruit_trim,c_fnrt) - call bsap_allom(dbh,ft,init_recruit_trim,a_sapw, c_sapw) - call bagw_allom(dbh,ft,c_agw) + call bsap_allom(dbh,ft,not_damaged,init_recruit_trim,a_sapw, c_sapw) + call bagw_allom(dbh,ft,not_damaged,c_agw) call bbgw_allom(dbh,ft,c_bgw) call bdead_allom(c_agw,c_bgw,c_sapw,ft,c_struct) - call bstore_allom(dbh,ft,init_recruit_trim,c_store) + call bstore_allom(dbh,ft,not_damaged,init_recruit_trim,c_store) ! Total carbon in a newly recruited plant c_total = c_leaf + c_fnrt + c_sapw + c_struct + c_store From b660f7b65efe791b51d06a789b027b2f5648114a Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Fri, 1 Jul 2022 14:42:09 -0400 Subject: [PATCH 53/84] Moving DamageRecovery to cohortdynamics --- biogeochem/DamageMainMod.F90 | 272 +---------------------------- biogeochem/EDCohortDynamicsMod.F90 | 244 +++++++++++++++++++++++++- main/EDMainMod.F90 | 1 + 3 files changed, 246 insertions(+), 271 deletions(-) diff --git a/biogeochem/DamageMainMod.F90 b/biogeochem/DamageMainMod.F90 index 290db57225..41e32ef59d 100644 --- a/biogeochem/DamageMainMod.F90 +++ b/biogeochem/DamageMainMod.F90 @@ -14,41 +14,11 @@ module DamageMainMod use EDTypesMod , only : ed_patch_type use EDTypesMod , only : ed_cohort_type use EDTypesMod , only : AREA - use EDTypesMod , only : leaves_on - use PRTGenericMod, only : num_elements - use PRTGenericMod, only : element_list - use PRTGenericMod, only : carbon12_element - use PRTGenericMod, only : nitrogen_element - use PRTGenericMod, only : phosphorus_element - use PRTGenericMod, only : leaf_organ - use PRTGenericMod, only : carbon12_element - use PRTGenericMod, only : all_carbon_elements - use PRTGenericMod, only : leaf_organ - use PRTGenericMod, only : fnrt_organ - use PRTGenericMod, only : sapw_organ - use PRTGenericMod, only : store_organ - use PRTGenericMod, only : repro_organ - use PRTGenericMod, only : struct_organ - use PRTGenericMod, only : SetState - use PRTGenericMod, only : StorageNutrientTarget - use PRTParametersMod, only : prt_params use FatesInterfaceTypesMod, only : hlm_current_day use FatesInterfaceTypesMod, only : hlm_current_month use FatesInterfaceTypesMod, only : hlm_current_year use FatesInterfaceTypesMod, only : hlm_model_day use FatesInterfaceTypesMod, only : hlm_day_of_year - use FatesInterfaceTypesMod, only : hlm_use_planthydro - use FatesAllometryMod, only : bsap_allom - use FatesAllometryMod, only : bagw_allom - use FatesAllometryMod, only : bbgw_allom - use FatesAllometryMod, only : bdead_allom - use FatesAllometryMod, only : bfineroot - use FatesAllometryMod, only : bstore_allom - use FatesAllometryMod, only : bleaf - use EDCohortDynamicsMod, only : copy_cohort - use FatesPlantHydraulicsMod, only : InitHydrCohort - use EDCohortDynamicsMod , only : InitPRTObject - use EDCohortDynamicsMod , only : InitPRTBoundaryConditions implicit none private @@ -63,7 +33,7 @@ module DamageMainMod public :: IsItDamageTime public :: damage_time public :: GetDamageMortality - public :: DamageRecovery + logical :: debug = .false. ! for debugging @@ -80,245 +50,7 @@ module DamageMainMod contains - subroutine DamageRecovery(csite,cpatch,ccohort,newly_recovered) - - !--------------------------------------------------------------------------- - ! JN March 2021 - ! At this point it is possible that damaged cohorts have reached their - ! target allometries. There is a choice now - if they have excess carbon, - ! they can use it to grow along their reduced allometric targets - i.e. - ! dbh and all carbon pools grow out together. OR they can use excess carbon to - ! jump to a lower damage class by changing their target allometry and growing - ! to meet new C pools for same dbh. - ! - ! d = damage class - ! -------------------------------------------------------------------------- - - type(ed_site_type) :: csite ! Site of the current cohort - type(ed_patch_type) :: cpatch ! patch of the current cohort - type(ed_cohort_type),pointer :: ccohort ! Current (damaged) cohort - logical :: newly_recovered ! true if we create a new cohort - - ! locals - type(ed_cohort_type), pointer :: rcohort ! New cohort that recovers by - ! having an lower damage class - real(r8) :: sapw_area ! sapwood area - real(r8) :: target_sapw_c,target_sapw_m ! sapwood mass, C and N/P - real(r8) :: target_agw_c ! target above ground wood - real(r8) :: target_bgw_c ! target below ground wood - real(r8) :: target_struct_c,target_struct_m ! target structural C and N/P - real(r8) :: target_fnrt_c,target_fnrt_m ! target fine-root C and N/P - real(r8) :: target_leaf_c,target_leaf_m ! target leaf C and N/P - real(r8) :: target_store_c,target_store_m ! target storage C and N/P - real(r8) :: target_repro_m ! target reproductive C/N/P - real(r8) :: leaf_m,fnrt_m,sapw_m ! actual masses in organs C/N/P - real(r8) :: struct_m,store_m,repro_m ! actual masses in organs C/N/P - real(r8) :: mass_d ! intermediate term for nplant_recover - real(r8) :: mass_dminus1 ! intermediate term for nplant_recover - real(r8) :: available_m ! available mass that can be used to - ! improve damage class - real(r8) :: recovery_demand ! amount of mass needed to get to - ! get to the target of the next damage class - real(r8) :: max_recover_nplant ! max number of plants that could get to - ! target of next class - real(r8) :: nplant_recover ! number of plants in cohort that will - ! recover to the next class - integer :: el ! element loop counter - - associate(dbh => ccohort%dbh, & - ipft => ccohort%pft, & - canopy_trim => ccohort%canopy_trim) - - ! If we are currently undamaged, no recovery - ! necessary, do nothing and return a null pointer - ! If the damage_recovery_scalar is zero, which - ! would be an unusual testing case, but possible, - ! then no recovery is possible, do nothing and - ! return a null pointer - if ((ccohort%crowndamage == undamaged_class) .or. & - (EDPftvarcon_inst%damage_recovery_scalar(ipft) < nearzero) ) then - newly_recovered = .false. - return - end if - - - ! If we have not returned, then this cohort both has - ! a damaged status, and the ability to recover from that damage - ! ----------------------------------------------------------------- - - ! To determine recovery, the first priority is to determine how much - ! resources (C,N,P) are required to recover the plant to the target - ! pool sizes of the next (less) damage class - - ! Target sapwood biomass according to allometry and trimming [kgC] - call bsap_allom(dbh,ipft, ccohort%crowndamage-1, canopy_trim,sapw_area,target_sapw_c) - ! Target total above ground biomass in woody/fibrous tissues [kgC] - call bagw_allom(dbh,ipft, ccohort%crowndamage-1, target_agw_c) - ! Target total below ground biomass in woody/fibrous tissues [kgC] - call bbgw_allom(dbh,ipft,target_bgw_c) - ! Target total dead (structrual) biomass [kgC] - call bdead_allom( target_agw_c, target_bgw_c, target_sapw_c, ipft, target_struct_c) - ! Target fine-root biomass and deriv. according to allometry and trimming [kgC, kgC/cm] - call bfineroot(dbh,ipft,canopy_trim,target_fnrt_c) - ! Target storage carbon [kgC,kgC/cm] - call bstore_allom(dbh,ipft,ccohort%crowndamage-1, canopy_trim,target_store_c) - ! Target leaf biomass according to allometry and trimming - if(ccohort%status_coh==leaves_on) then - call bleaf(dbh,ipft,ccohort%crowndamage-1, canopy_trim,target_leaf_c) - else - target_leaf_c = 0._r8 - end if - - ! We will be taking the number of recovering plants - ! based on minimum of available resources for C/N/P (initialize high) - nplant_recover = 1.e10_r8 - - do el=1,num_elements - - ! Actual mass of chemical species in the organs - leaf_m = ccohort%prt%GetState(leaf_organ, element_list(el)) - store_m = ccohort%prt%GetState(store_organ, element_list(el)) - sapw_m = ccohort%prt%GetState(sapw_organ, element_list(el)) - fnrt_m = ccohort%prt%GetState(fnrt_organ, element_list(el)) - struct_m = ccohort%prt%GetState(struct_organ, element_list(el)) - repro_m = ccohort%prt%GetState(repro_organ, element_list(el)) - - ! Target mass of chemical species in organs, based on stature, - ! allometry and stoichiometry parameters - select case (element_list(el)) - case (carbon12_element) - target_store_m = target_store_c - target_leaf_m = target_leaf_c - target_fnrt_m = target_fnrt_c - target_struct_m = target_struct_c - target_sapw_m = target_sapw_c - target_repro_m = 0._r8 - available_m = ccohort%npp_acc - case (nitrogen_element) - target_struct_m = target_struct_c * & - prt_params%nitr_stoich_p1(ipft,prt_params%organ_param_id(struct_organ)) - target_leaf_m = target_leaf_c * & - prt_params%nitr_stoich_p1(ipft,prt_params%organ_param_id(leaf_organ)) - target_fnrt_m = target_fnrt_c * & - prt_params%nitr_stoich_p1(ipft,prt_params%organ_param_id(fnrt_organ)) - target_sapw_m = target_sapw_c * & - prt_params%nitr_stoich_p1(ipft,prt_params%organ_param_id(sapw_organ)) - target_repro_m = 0._r8 - target_store_m = StorageNutrientTarget(ipft, element_list(el), & - target_leaf_m, target_fnrt_m, target_sapw_m, target_struct_m) - ! For nutrients, all uptake is immediately put into storage, so just swap - ! them and assume storage is what is available, but needs to be filled up - available_m = store_m - store_m = 0._r8 - case (phosphorus_element) - target_struct_m = target_struct_c * & - prt_params%phos_stoich_p1(ipft,prt_params%organ_param_id(struct_organ)) - target_leaf_m = target_leaf_c * & - prt_params%phos_stoich_p1(ipft,prt_params%organ_param_id(leaf_organ)) - target_fnrt_m = target_fnrt_c * & - prt_params%phos_stoich_p1(ipft,prt_params%organ_param_id(fnrt_organ)) - target_sapw_m = target_sapw_c * & - prt_params%phos_stoich_p1(ipft,prt_params%organ_param_id(sapw_organ)) - target_repro_m = 0._r8 - target_store_m = StorageNutrientTarget(ipft, element_list(el), & - target_leaf_m, target_fnrt_m, target_sapw_m, target_struct_m) - ! For nutrients, all uptake is immediately put into storage, so just swap - ! them and assume storage is what is available, but needs to be filled up - available_m = store_m - store_m = 0._r8 - end select - - ! 1. What is excess carbon? - ! carbon_balance - - ! 2. What is biomass required to go from current - ! damage level to next damage level? - - ! mass of this damage class - mass_d = leaf_m + store_m + sapw_m + fnrt_m + struct_m + repro_m - - mass_dminus1 = max(leaf_m, target_leaf_m) + max(fnrt_m, target_fnrt_m) + & - max(store_m, target_store_m) + max(sapw_m, target_sapw_m) + & - max(struct_m, target_struct_m) - - ! Mass needed to get from current mass to allometric - ! target mass of next damage class up - recovery_demand = mass_dminus1 - mass_d - - ! 3. How many trees can get there with excess carbon? - max_recover_nplant = available_m * ccohort%n / recovery_demand - - ! 4. Use the scalar to decide how many to recover - nplant_recover = min(nplant_recover,max(0._r8,max_recover_nplant * & - EDPftvarcon_inst%damage_recovery_scalar(ipft) )) - - end do - - ! there is a special case where damage_recovery_scalar = 1, but - ! max_recover_nplant > n (i.e. there is more carbon than needed for all - ! individuals to recover to the next damage class. - ! in this case we can cheat, by making n_recover 0 and simply - ! allowing the donor cohort to recover and then go through - ! prt - will this work though? if they are not anywhere near allometry? - - if( abs(EDPftvarcon_inst%damage_recovery_scalar(ipft)-1._r8) < nearzero .and. & - nplant_recover > ccohort%n) then - nplant_recover = 0.0_r8 - ccohort%crowndamage = ccohort%crowndamage - 1 - end if - - if(nplant_recover < nearzero) then - - newly_recovered = .false. - return - - else - newly_recovered = .true. - allocate(rcohort) - if(hlm_use_planthydro .eq. itrue) call InitHydrCohort(csite,rcohort) - ! Initialize the PARTEH object and point to the - ! correct boundary condition fields - rcohort%prt => null() - call InitPRTObject(rcohort%prt) - call InitPRTBoundaryConditions(rcohort) - call copy_cohort(ccohort, rcohort) - - rcohort%n = nplant_recover - - rcohort%crowndamage = ccohort%crowndamage - 1 - - ! Need to adjust the crown area which is NOT on a per individual basis - call carea_allom(dbh,rcohort%n,csite%spread,ipft,rcohort%crowndamage,rcohort%c_area) - !rcohort%n/n_old * ccohort%c_area - !ccohort%c_area = ccohort%c_area - rcohort%c_area - - ! Update properties of the un-recovered (donor) cohort - ccohort%n = ccohort%n - rcohort%n - ccohort%c_area = ccohort%c_area * ccohort%n / (ccohort%n+rcohort%n) - - !----------- Insert copy into linked list ----------------------! - ! This subroutine is called within a loop in EDMain that - ! proceeds short to tall. We want the newly created cohort - ! to have an opportunity to experience the list, so we add - ! it in the list in a position taller than the current cohort - ! --------------------------------------------------------------! - - rcohort%shorter => ccohort - if(associated(ccohort%taller))then - rcohort%taller => ccohort%taller - ccohort%taller%shorter => rcohort - else - cpatch%tallest => rcohort - rcohort%taller => null() - endif - ccohort%taller => rcohort - - end if ! end if greater than nearzero - - end associate - - return - end subroutine DamageRecovery + subroutine IsItDamageTime(is_master, currentSite) diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index 71aa369b07..0f2a0b2008 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -42,6 +42,7 @@ Module EDCohortDynamicsMod use EDTypesMod , only : ican_upper use EDTypesMod , only : site_fluxdiags_type use PRTGenericMod , only : num_elements + use EDTypesMod , only : leaves_on use EDParamsMod , only : ED_val_cohort_age_fusion_tol use FatesInterfaceTypesMod , only : hlm_use_planthydro use FatesInterfaceTypesMod , only : hlm_parteh_mode @@ -126,7 +127,8 @@ Module EDCohortDynamicsMod public :: UpdateCohortBioPhysRates public :: DeallocateCohort public :: EvaluateAndCorrectDBH - + public :: DamageRecovery + logical, parameter :: debug = .false. ! local debug flag character(len=*), parameter, private :: sourcefile = & @@ -2166,5 +2168,245 @@ end subroutine EvaluateAndCorrectDBH !------------------------------------------------------------------------------------ + subroutine DamageRecovery(csite,cpatch,ccohort,newly_recovered) + + !--------------------------------------------------------------------------- + ! JN March 2021 + ! At this point it is possible that damaged cohorts have reached their + ! target allometries. There is a choice now - if they have excess carbon, + ! they can use it to grow along their reduced allometric targets - i.e. + ! dbh and all carbon pools grow out together. OR they can use excess carbon to + ! jump to a lower damage class by changing their target allometry and growing + ! to meet new C pools for same dbh. + ! + ! d = damage class + ! -------------------------------------------------------------------------- + + type(ed_site_type) :: csite ! Site of the current cohort + type(ed_patch_type) :: cpatch ! patch of the current cohort + type(ed_cohort_type),pointer :: ccohort ! Current (damaged) cohort + logical :: newly_recovered ! true if we create a new cohort + + ! locals + type(ed_cohort_type), pointer :: rcohort ! New cohort that recovers by + ! having an lower damage class + real(r8) :: sapw_area ! sapwood area + real(r8) :: target_sapw_c,target_sapw_m ! sapwood mass, C and N/P + real(r8) :: target_agw_c ! target above ground wood + real(r8) :: target_bgw_c ! target below ground wood + real(r8) :: target_struct_c,target_struct_m ! target structural C and N/P + real(r8) :: target_fnrt_c,target_fnrt_m ! target fine-root C and N/P + real(r8) :: target_leaf_c,target_leaf_m ! target leaf C and N/P + real(r8) :: target_store_c,target_store_m ! target storage C and N/P + real(r8) :: target_repro_m ! target reproductive C/N/P + real(r8) :: leaf_m,fnrt_m,sapw_m ! actual masses in organs C/N/P + real(r8) :: struct_m,store_m,repro_m ! actual masses in organs C/N/P + real(r8) :: mass_d ! intermediate term for nplant_recover + real(r8) :: mass_dminus1 ! intermediate term for nplant_recover + real(r8) :: available_m ! available mass that can be used to + ! improve damage class + real(r8) :: recovery_demand ! amount of mass needed to get to + ! get to the target of the next damage class + real(r8) :: max_recover_nplant ! max number of plants that could get to + ! target of next class + real(r8) :: nplant_recover ! number of plants in cohort that will + ! recover to the next class + integer :: el ! element loop counter + + associate(dbh => ccohort%dbh, & + ipft => ccohort%pft, & + canopy_trim => ccohort%canopy_trim) + + ! If we are currently undamaged, no recovery + ! necessary, do nothing and return a null pointer + ! If the damage_recovery_scalar is zero, which + ! would be an unusual testing case, but possible, + ! then no recovery is possible, do nothing and + ! return a null pointer + if ((ccohort%crowndamage == undamaged_class) .or. & + (EDPftvarcon_inst%damage_recovery_scalar(ipft) < nearzero) ) then + newly_recovered = .false. + return + end if + + + ! If we have not returned, then this cohort both has + ! a damaged status, and the ability to recover from that damage + ! ----------------------------------------------------------------- + + ! To determine recovery, the first priority is to determine how much + ! resources (C,N,P) are required to recover the plant to the target + ! pool sizes of the next (less) damage class + + ! Target sapwood biomass according to allometry and trimming [kgC] + call bsap_allom(dbh,ipft, ccohort%crowndamage-1, canopy_trim,sapw_area,target_sapw_c) + ! Target total above ground biomass in woody/fibrous tissues [kgC] + call bagw_allom(dbh,ipft, ccohort%crowndamage-1, target_agw_c) + ! Target total below ground biomass in woody/fibrous tissues [kgC] + call bbgw_allom(dbh,ipft,target_bgw_c) + ! Target total dead (structrual) biomass [kgC] + call bdead_allom( target_agw_c, target_bgw_c, target_sapw_c, ipft, target_struct_c) + ! Target fine-root biomass and deriv. according to allometry and trimming [kgC, kgC/cm] + call bfineroot(dbh,ipft,canopy_trim,target_fnrt_c) + ! Target storage carbon [kgC,kgC/cm] + call bstore_allom(dbh,ipft,ccohort%crowndamage-1, canopy_trim,target_store_c) + ! Target leaf biomass according to allometry and trimming + if(ccohort%status_coh==leaves_on) then + call bleaf(dbh,ipft,ccohort%crowndamage-1, canopy_trim,target_leaf_c) + else + target_leaf_c = 0._r8 + end if + + ! We will be taking the number of recovering plants + ! based on minimum of available resources for C/N/P (initialize high) + nplant_recover = 1.e10_r8 + + do el=1,num_elements + + ! Actual mass of chemical species in the organs + leaf_m = ccohort%prt%GetState(leaf_organ, element_list(el)) + store_m = ccohort%prt%GetState(store_organ, element_list(el)) + sapw_m = ccohort%prt%GetState(sapw_organ, element_list(el)) + fnrt_m = ccohort%prt%GetState(fnrt_organ, element_list(el)) + struct_m = ccohort%prt%GetState(struct_organ, element_list(el)) + repro_m = ccohort%prt%GetState(repro_organ, element_list(el)) + + ! Target mass of chemical species in organs, based on stature, + ! allometry and stoichiometry parameters + select case (element_list(el)) + case (carbon12_element) + target_store_m = target_store_c + target_leaf_m = target_leaf_c + target_fnrt_m = target_fnrt_c + target_struct_m = target_struct_c + target_sapw_m = target_sapw_c + target_repro_m = 0._r8 + available_m = ccohort%npp_acc + case (nitrogen_element) + target_struct_m = target_struct_c * & + prt_params%nitr_stoich_p1(ipft,prt_params%organ_param_id(struct_organ)) + target_leaf_m = target_leaf_c * & + prt_params%nitr_stoich_p1(ipft,prt_params%organ_param_id(leaf_organ)) + target_fnrt_m = target_fnrt_c * & + prt_params%nitr_stoich_p1(ipft,prt_params%organ_param_id(fnrt_organ)) + target_sapw_m = target_sapw_c * & + prt_params%nitr_stoich_p1(ipft,prt_params%organ_param_id(sapw_organ)) + target_repro_m = 0._r8 + target_store_m = StorageNutrientTarget(ipft, element_list(el), & + target_leaf_m, target_fnrt_m, target_sapw_m, target_struct_m) + ! For nutrients, all uptake is immediately put into storage, so just swap + ! them and assume storage is what is available, but needs to be filled up + available_m = store_m + store_m = 0._r8 + case (phosphorus_element) + target_struct_m = target_struct_c * & + prt_params%phos_stoich_p1(ipft,prt_params%organ_param_id(struct_organ)) + target_leaf_m = target_leaf_c * & + prt_params%phos_stoich_p1(ipft,prt_params%organ_param_id(leaf_organ)) + target_fnrt_m = target_fnrt_c * & + prt_params%phos_stoich_p1(ipft,prt_params%organ_param_id(fnrt_organ)) + target_sapw_m = target_sapw_c * & + prt_params%phos_stoich_p1(ipft,prt_params%organ_param_id(sapw_organ)) + target_repro_m = 0._r8 + target_store_m = StorageNutrientTarget(ipft, element_list(el), & + target_leaf_m, target_fnrt_m, target_sapw_m, target_struct_m) + ! For nutrients, all uptake is immediately put into storage, so just swap + ! them and assume storage is what is available, but needs to be filled up + available_m = store_m + store_m = 0._r8 + end select + + ! 1. What is excess carbon? + ! carbon_balance + + ! 2. What is biomass required to go from current + ! damage level to next damage level? + + ! mass of this damage class + mass_d = leaf_m + store_m + sapw_m + fnrt_m + struct_m + repro_m + + mass_dminus1 = max(leaf_m, target_leaf_m) + max(fnrt_m, target_fnrt_m) + & + max(store_m, target_store_m) + max(sapw_m, target_sapw_m) + & + max(struct_m, target_struct_m) + + ! Mass needed to get from current mass to allometric + ! target mass of next damage class up + recovery_demand = mass_dminus1 - mass_d + + ! 3. How many trees can get there with excess carbon? + max_recover_nplant = available_m * ccohort%n / recovery_demand + + ! 4. Use the scalar to decide how many to recover + nplant_recover = min(nplant_recover,max(0._r8,max_recover_nplant * & + EDPftvarcon_inst%damage_recovery_scalar(ipft) )) + + end do + + ! there is a special case where damage_recovery_scalar = 1, but + ! max_recover_nplant > n (i.e. there is more carbon than needed for all + ! individuals to recover to the next damage class. + ! in this case we can cheat, by making n_recover 0 and simply + ! allowing the donor cohort to recover and then go through + ! prt - will this work though? if they are not anywhere near allometry? + + if( abs(EDPftvarcon_inst%damage_recovery_scalar(ipft)-1._r8) < nearzero .and. & + nplant_recover > ccohort%n) then + nplant_recover = 0.0_r8 + ccohort%crowndamage = ccohort%crowndamage - 1 + end if + + if(nplant_recover < nearzero) then + + newly_recovered = .false. + return + + else + newly_recovered = .true. + allocate(rcohort) + if(hlm_use_planthydro .eq. itrue) call InitHydrCohort(csite,rcohort) + ! Initialize the PARTEH object and point to the + ! correct boundary condition fields + rcohort%prt => null() + call InitPRTObject(rcohort%prt) + call InitPRTBoundaryConditions(rcohort) + call copy_cohort(ccohort, rcohort) + + rcohort%n = nplant_recover + + rcohort%crowndamage = ccohort%crowndamage - 1 + + ! Need to adjust the crown area which is NOT on a per individual basis + call carea_allom(dbh,rcohort%n,csite%spread,ipft,rcohort%crowndamage,rcohort%c_area) + !rcohort%n/n_old * ccohort%c_area + !ccohort%c_area = ccohort%c_area - rcohort%c_area + + ! Update properties of the un-recovered (donor) cohort + ccohort%n = ccohort%n - rcohort%n + ccohort%c_area = ccohort%c_area * ccohort%n / (ccohort%n+rcohort%n) + + !----------- Insert copy into linked list ----------------------! + ! This subroutine is called within a loop in EDMain that + ! proceeds short to tall. We want the newly created cohort + ! to have an opportunity to experience the list, so we add + ! it in the list in a position taller than the current cohort + ! --------------------------------------------------------------! + + rcohort%shorter => ccohort + if(associated(ccohort%taller))then + rcohort%taller => ccohort%taller + ccohort%taller%shorter => rcohort + else + cpatch%tallest => rcohort + rcohort%taller => null() + endif + ccohort%taller => rcohort + + end if ! end if greater than nearzero + + end associate + + return + end subroutine DamageRecovery + end module EDCohortDynamicsMod diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index ccdc3e5ae7..537381a977 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -36,6 +36,7 @@ module EDMainMod use EDCohortDynamicsMod , only : sort_cohorts use EDCohortDynamicsMod , only : count_cohorts use EDCohortDynamicsMod , only : EvaluateAndCorrectDBH + use EDCohortDynamicsMod , only : DamageRecovery use EDPatchDynamicsMod , only : disturbance_rates use EDPatchDynamicsMod , only : fuse_patches use EDPatchDynamicsMod , only : spawn_patches From bfe205cf8eacb7b4d898aba6fdaa3380d7f15ab6 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Fri, 1 Jul 2022 13:17:19 -0600 Subject: [PATCH 54/84] resolution on moving damagerecovery --- biogeochem/EDCohortDynamicsMod.F90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index 0f2a0b2008..9d3f6e4bfe 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -30,6 +30,7 @@ Module EDCohortDynamicsMod use EDTypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type use EDTypesMod , only : nclmax use PRTGenericMod , only : element_list + use PRTGenericMod , only : StorageNutrientTarget use FatesLitterMod , only : ncwd use FatesLitterMod , only : ndcmpy use FatesLitterMod , only : litter_type @@ -68,6 +69,7 @@ Module EDCohortDynamicsMod use FatesAllometryMod , only : bdead_allom use FatesAllometryMod , only : h_allom use FatesAllometryMod , only : carea_allom + use FatesAllometryMod , only : bstore_allom use FatesAllometryMod , only : ForceDBH use FatesAllometryMod , only : tree_lai, tree_sai use FatesAllometryMod , only : set_root_fraction @@ -102,6 +104,7 @@ Module EDCohortDynamicsMod use PRTAllometricCNPMod, only : acnp_bc_out_id_nneed use PRTAllometricCNPMod, only : acnp_bc_out_id_pneed use DamageMainMod, only : GetCrownReduction + use DamageMainMod, only : undamaged_class use shr_infnan_mod, only : nan => shr_infnan_nan, assignment(=) From 84e84b986569ae0b424fad590ee63d0b0bb9085f Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Fri, 1 Jul 2022 13:32:10 -0600 Subject: [PATCH 55/84] Removed check on use_tree_damage, which is allowed now --- main/FatesInterfaceMod.F90 | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 0ca5aafb63..b878219e2f 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -1383,6 +1383,7 @@ subroutine set_fates_ctrlparms(tag,ival,rval,cval) hlm_use_sp = unset_int hlm_use_inventory_init = unset_int hlm_inventory_ctrl_file = 'unset' + hlm_use_tree_damage = unset_int case('check_allset') @@ -1538,11 +1539,6 @@ subroutine set_fates_ctrlparms(tag,ival,rval,cval) call endrun(msg=errMsg(sourcefile, __LINE__)) end if - if(hlm_use_tree_damage .eq. itrue) then - write(fates_log(),*) 'hlm_use_tree_damage is not available yet, value: ',hlm_use_tree_damage,' ,set to false' - call endrun(msg=errMsg(sourcefile, __LINE__)) - end if - if(hlm_nitrogen_spec .eq. unset_int) then write(fates_log(),*) 'FATES parameters unset: hlm_nitrogen_spec, exiting' call endrun(msg=errMsg(sourcefile, __LINE__)) From 650077a26ae52135c11635f5a17040c08526aba4 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Fri, 1 Jul 2022 13:33:58 -0600 Subject: [PATCH 56/84] Fixes to use_tree_damage --- main/FatesInterfaceMod.F90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index b878219e2f..b73b378aa0 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -1383,7 +1383,6 @@ subroutine set_fates_ctrlparms(tag,ival,rval,cval) hlm_use_sp = unset_int hlm_use_inventory_init = unset_int hlm_inventory_ctrl_file = 'unset' - hlm_use_tree_damage = unset_int case('check_allset') @@ -1534,7 +1533,7 @@ subroutine set_fates_ctrlparms(tag,ival,rval,cval) call endrun(msg=errMsg(sourcefile, __LINE__)) end if - if(hlm_use_tree_damage .eq. unset_int .or. hlm_use_tree_damage .eq. itrue) then + if(hlm_use_tree_damage .eq. unset_int) then write(fates_log(),*) 'FATES dimension/parameter unset: hlm_use_tree_damage, exiting' call endrun(msg=errMsg(sourcefile, __LINE__)) end if From 71c41c6b7606500c46e895dc99b4984709d2f942 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Sun, 3 Jul 2022 08:56:14 -0600 Subject: [PATCH 57/84] Making tree_sai in canopy_trim use actual area --- biogeochem/EDPhysiologyMod.F90 | 5 +---- biogeochem/FatesAllometryMod.F90 | 13 +++++++------ 2 files changed, 8 insertions(+), 10 deletions(-) diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 0c13806859..45d9ca38a3 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -470,14 +470,11 @@ subroutine trim_canopy( currentSite ) currentCohort%n, currentCohort%canopy_layer, & currentPatch%canopy_layer_tlai,currentCohort%vcmax25top ) - call carea_allom(currentCohort%dbh,currentCohort%n,currentSite%spread,currentCohort%pft,& - 1, target_c_area) - ! We don't need check on sp mode here since we don't trim_canopy with sp mode currentCohort%treesai = tree_sai(currentCohort%pft, & currentCohort%dbh, currentCohort%crowndamage, & currentCohort%canopy_trim, & - target_c_area, currentCohort%n,currentCohort%canopy_layer,& + currentCohort%c_area, currentCohort%n,currentCohort%canopy_layer,& currentPatch%canopy_layer_tlai, currentCohort%treelai, & currentCohort%vcmax25top,0 ) diff --git a/biogeochem/FatesAllometryMod.F90 b/biogeochem/FatesAllometryMod.F90 index 0766ee645a..6a15985965 100644 --- a/biogeochem/FatesAllometryMod.F90 +++ b/biogeochem/FatesAllometryMod.F90 @@ -497,16 +497,16 @@ subroutine carea_allom(dbh,nplant,site_spread,ipft,crowndamage,c_area,inverse) case(1) dbh_eff = min(dbh,dbh_maxh) call carea_2pwr(dbh_eff,site_spread,d2bl_p2,d2bl_ediff,d2ca_min,d2ca_max, & - c_area,do_inverse, crowndamage) + crowndamage,c_area, do_inverse) capped_allom = .true. case(2) ! "2par_pwr") - call carea_2pwr(dbh,site_spread,d2bl_p2,d2bl_ediff,d2ca_min,d2ca_max,c_area, & - do_inverse, crowndamage) + call carea_2pwr(dbh,site_spread,d2bl_p2,d2bl_ediff,d2ca_min,d2ca_max, & + crowndamage, c_area, do_inverse) capped_allom = .false. case(3) dbh_eff = min(dbh,dbh_maxh) call carea_2pwr(dbh_eff,site_spread,d2bl_p2,d2bl_ediff,d2ca_min,d2ca_max, & - c_area,do_inverse, crowndamage) + crowndamage, c_area, do_inverse) capped_allom = .true. case DEFAULT write(fates_log(),*) 'An undefined leaf allometry was specified: ', & @@ -2083,7 +2083,8 @@ end subroutine CrownDepth ! ============================================================================= - subroutine carea_2pwr(dbh,spread,d2bl_p2,d2bl_ediff,d2ca_min,d2ca_max,c_area,inverse,crowndamage) + subroutine carea_2pwr(dbh,spread,d2bl_p2,d2bl_ediff,d2ca_min, & + d2ca_max,crowndamage,c_area,inverse) ! ============================================================================ ! Calculate area of ground covered by entire cohort. (m2) @@ -2096,9 +2097,9 @@ subroutine carea_2pwr(dbh,spread,d2bl_p2,d2bl_ediff,d2ca_min,d2ca_max,c_area,inv real(r8),intent(in) :: d2bl_ediff ! area difference factor in the diameter-bleaf allometry (exponent) real(r8),intent(in) :: d2ca_min ! minimum diameter to crown area scaling factor real(r8),intent(in) :: d2ca_max ! maximum diameter to crown area scaling factor + integer,intent(in) :: crowndamage ! crowndamage class [1: undamaged, >1: damaged] real(r8),intent(inout) :: c_area ! crown area for one plant [m2] logical,intent(in) :: inverse ! if true, calculate dbh from crown area rather than its reverse - integer,intent(in) :: crowndamage ! crowndamage class [1: undamaged, >1: damaged] real(r8) :: crown_area_to_dbh_exponent real(r8) :: spreadterm ! Effective 2bh to crown area scaling factor From 52f5b8719260a323bbc9878e702446037023bba2 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Tue, 5 Jul 2022 13:09:15 -0600 Subject: [PATCH 58/84] argument re-ordering in crowndamage allometry argument and adding in the call to initalize the derived damage parameter --- biogeochem/EDCohortDynamicsMod.F90 | 18 ++++++++---------- biogeochem/FatesAllometryMod.F90 | 8 ++++---- main/FatesParameterDerivedMod.F90 | 9 ++++----- 3 files changed, 16 insertions(+), 19 deletions(-) diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index 9d3f6e4bfe..f81e5df9b4 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -1319,10 +1319,10 @@ subroutine fuse_cohorts(currentSite, currentPatch, bc_in) if( prt_params%woody(currentCohort%pft) == itrue ) then - call ForceDBH( currentCohort%pft, currentCohort%canopy_trim, & + call ForceDBH( currentCohort%pft, currentCohort%crowndamage, & + currentCohort%canopy_trim, & currentCohort%dbh, currentCohort%hite, & - bdead = currentCohort%prt%GetState(struct_organ,all_carbon_elements), & - crowndamage = currentCohort%crowndamage) + bdead = currentCohort%prt%GetState(struct_organ,all_carbon_elements)) end if ! @@ -1357,11 +1357,10 @@ subroutine fuse_cohorts(currentSite, currentPatch, bc_in) ! ----------------------------------------------------------------- ! if( prt_params%woody(currentCohort%pft) == itrue ) then - call ForceDBH( currentCohort%pft, currentCohort%canopy_trim, & + call ForceDBH( currentCohort%pft, currentCohort%crowndamage, & + currentCohort%canopy_trim, & currentCohort%dbh, currentCohort%hite, & - bdead = currentCohort%prt%GetState(struct_organ,all_carbon_elements),& - crowndamage = currentCohort%crowndamage) - + bdead = currentCohort%prt%GetState(struct_organ,all_carbon_elements)) end if ! call carea_allom(currentCohort%dbh,newn,currentSite%spread,currentCohort%pft,& @@ -2140,8 +2139,7 @@ subroutine EvaluateAndCorrectDBH(currentCohort,delta_dbh,delta_hite) if( (struct_c - target_struct_c ) > calloc_abs_error ) then - call ForceDBH( ipft,canopy_trim, dbh, hite_out, bdead=struct_c, & - crowndamage = icrowndamage) + call ForceDBH( ipft,icrowndamage,canopy_trim, dbh, hite_out, bdead=struct_c) delta_dbh = dbh - currentCohort%dbh delta_hite = hite_out - currentCohort%hite @@ -2158,7 +2156,7 @@ subroutine EvaluateAndCorrectDBH(currentCohort,delta_dbh,delta_hite) call bleaf(dbh,ipft,icrowndamage, canopy_trim,target_leaf_c) if( ( leaf_c - target_leaf_c ) > calloc_abs_error ) then - call ForceDBH( ipft, canopy_trim, dbh, hite_out, bl=leaf_c ) + call ForceDBH( ipft, icrowndamage, canopy_trim, dbh, hite_out, bl=leaf_c ) delta_dbh = dbh - currentCohort%dbh delta_hite = hite_out - currentCohort%hite currentCohort%dbh = dbh diff --git a/biogeochem/FatesAllometryMod.F90 b/biogeochem/FatesAllometryMod.F90 index 6a15985965..43497b5b44 100644 --- a/biogeochem/FatesAllometryMod.F90 +++ b/biogeochem/FatesAllometryMod.F90 @@ -2404,7 +2404,7 @@ real(r8) function decay_coeff_kn(pft,vcmax25top) end function decay_coeff_kn ! ===================================================================================== -subroutine ForceDBH( ipft, canopy_trim, d, h, bdead, bl, crowndamage) +subroutine ForceDBH( ipft, crowndamage, canopy_trim, d, h, bdead, bl ) ! ========================================================================= ! This subroutine estimates the diameter based on either the structural biomass @@ -2419,7 +2419,7 @@ subroutine ForceDBH( ipft, canopy_trim, d, h, bdead, bl, crowndamage) integer(i4),intent(in) :: ipft ! PFT index - integer(i4),intent(in),optional :: crowndamage ! crowndamage [1: undamaged, >1: damaged] + integer(i4),intent(in) :: crowndamage ! crowndamage [1: undamaged, >1: damaged] real(r8),intent(in) :: canopy_trim real(r8),intent(inout) :: d ! plant diameter [cm] real(r8),intent(out) :: h ! plant height @@ -2504,7 +2504,7 @@ subroutine ForceDBH( ipft, canopy_trim, d, h, bdead, bl, crowndamage) call endrun(msg=errMsg(sourcefile, __LINE__)) end if - call bleaf(d,ipft,1,canopy_trim,bt_leaf,dbt_leaf_dd) + call bleaf(d,ipft,crowndamage,canopy_trim,bt_leaf,dbt_leaf_dd) counter = 0 step_frac = step_frac0 @@ -2513,7 +2513,7 @@ subroutine ForceDBH( ipft, canopy_trim, d, h, bdead, bl, crowndamage) dd = step_frac*(bl-bt_leaf)/dbt_leaf_dd d_try = d + dd - call bleaf(d_try,ipft,1,canopy_trim,bt_leaf_try,dbt_leaf_dd_try) + call bleaf(d_try,ipft,crowndamage,canopy_trim,bt_leaf_try,dbt_leaf_dd_try) ! Prevent overshooting if(bt_leaf_try > (bl+calloc_abs_error)) then diff --git a/main/FatesParameterDerivedMod.F90 b/main/FatesParameterDerivedMod.F90 index 0214224ee3..e63a361384 100644 --- a/main/FatesParameterDerivedMod.F90 +++ b/main/FatesParameterDerivedMod.F90 @@ -66,10 +66,9 @@ end subroutine InitAllocate ! ===================================================================================== ! =================================================================================== - subroutine InitAllocateDamageTransitions(this,nlevdamage, numpft) + subroutine InitAllocateDamageTransitions(this,numpft) class(param_derived_type), intent(inout) :: this - integer, intent(in) :: nlevdamage integer, intent(in) :: numpft allocate(this%damage_transitions(nlevdamage,nlevdamage, numpft)) @@ -96,6 +95,7 @@ subroutine Init(this,numpft) associate( vcmax25top => EDPftvarcon_inst%vcmax25top ) call this%InitAllocate(numpft) + call this%InitDamageTransitions(numpft) do ft = 1,numpft @@ -129,13 +129,12 @@ end subroutine Init !========================================================================= - subroutine InitDamageTransitions(this, nlevdamage, numpft) + subroutine InitDamageTransitions(this, numpft) use EDPftvarcon, only: EDPftvarcon_inst class(param_derived_type), intent(inout) :: this - integer, intent(in) :: nlevdamage integer, intent(in) :: numpft ! local variables @@ -144,7 +143,7 @@ subroutine InitDamageTransitions(this, nlevdamage, numpft) real(r8) :: damage_frac ! damage fraction - call this%InitAllocateDamageTransitions(nlevdamage, numpft) + call this%InitAllocateDamageTransitions(numpft) do ft = 1, numpft From b26610612625fe0e05b0e57ac3b15ce08875e79e Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Tue, 5 Jul 2022 20:26:23 -0600 Subject: [PATCH 59/84] Removed a redundant (double) allocation call --- biogeochem/EDPatchDynamicsMod.F90 | 11 ----------- 1 file changed, 11 deletions(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 83c027fdf8..df27f99d33 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -804,17 +804,6 @@ subroutine spawn_patches( currentSite, bc_in) agb_frac = prt_params%allom_agb_frac(currentCohort%pft) branch_frac = param_derived%branch_frac(currentCohort%pft) - allocate(nc) ! new cohort surviving - 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) - 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) From 34a6fe33d8b12f1156342e00b4bd36ab0cf38012 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Wed, 6 Jul 2022 11:55:13 -0400 Subject: [PATCH 60/84] Removed patch level damage code, in preparation for moving it to a pre-disturbance part of the dynamics code. --- biogeochem/EDPatchDynamicsMod.F90 | 817 ++++++------------------------ 1 file changed, 157 insertions(+), 660 deletions(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index df27f99d33..7fe99f2ee6 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -6,8 +6,6 @@ module EDPatchDynamicsMod use FatesGlobals , only : fates_log use FatesGlobals , only : FatesWarn,N2S,A2S use FatesInterfaceTypesMod , only : hlm_freq_day - use FatesInterfaceTypesMod , only : hlm_days_per_year - use FatesInterfaceTypesMod, only : hlm_use_tree_damage use EDPftvarcon , only : EDPftvarcon_inst use EDPftvarcon , only : GetDecompyFrac use PRTParametersMod , only : prt_params @@ -44,7 +42,6 @@ module EDPatchDynamicsMod use FatesInterfaceTypesMod , only : hlm_use_planthydro use FatesInterfaceTypesMod , only : hlm_numSWb use FatesInterfaceTypesMod , only : bc_in_type - use FatesInterfaceTypesMod , only : hlm_days_per_year use FatesInterfaceTypesMod , only : numpft use FatesInterfaceTypesMod , only : hlm_stepsize use FatesInterfaceTypesMod , only : hlm_use_sp @@ -61,7 +58,6 @@ module EDPatchDynamicsMod use EDLoggingMortalityMod, only : logging_time use EDLoggingMortalityMod, only : get_harvest_rate_area use EDParamsMod , only : fates_mortality_disturbance_fraction - use DamageMainMod , only : damage_time use FatesAllometryMod , only : carea_allom use FatesAllometryMod , only : set_root_fraction use FatesConstantsMod , only : g_per_kg @@ -139,7 +135,6 @@ module EDPatchDynamicsMod real(r8), parameter :: existing_litt_localization = 1.0_r8 real(r8), parameter :: treefall_localization = 0.0_r8 real(r8), parameter :: burn_localization = 0.0_r8 - real(r8), parameter :: damage_localization = 0.0_r8 character(len=512) :: msg ! Message string for warnings and logging @@ -212,11 +207,9 @@ subroutine disturbance_rates( site_in, bc_in) call mortality_rates(currentCohort,bc_in,cmort,hmort,bmort,frmort,smort,asmort,dgmort) currentCohort%dmort = cmort+hmort+bmort+frmort+smort+asmort+dgmort - call carea_allom(currentCohort%dbh,currentCohort%n,site_in%spread,currentCohort%pft, & currentCohort%crowndamage,currentCohort%c_area) - ! Initialize diagnostic mortality rates currentCohort%cmort = cmort currentCohort%bmort = bmort @@ -225,7 +218,7 @@ subroutine disturbance_rates( site_in, bc_in) currentCohort%smort = smort currentCohort%asmort = asmort currentCohort%dgmort = dgmort - + call LoggingMortality_frac(currentCohort%pft, currentCohort%dbh, currentCohort%canopy_layer, & lmort_direct,lmort_collateral,lmort_infra,l_degrad,& bc_in%hlm_harvest_rates, & @@ -299,8 +292,6 @@ subroutine disturbance_rates( site_in, bc_in) currentCohort%c_area/currentPatch%area endif - - currentCohort => currentCohort%taller enddo !currentCohort @@ -450,7 +441,6 @@ subroutine spawn_patches( currentSite, bc_in) ! 6) For mortality, Plants in new and existing understorey are killed ! 7) For fire, burned plants are killed, and unburned plants are added to new patch. ! 8) New cohorts are added to new patch and sorted. - ! This includes splitting cohorts within the new patch into different damage classes ! 9) New patch is added into linked list ! 10) Area checked, and patchno recalculated. ! @@ -459,31 +449,19 @@ subroutine spawn_patches( currentSite, bc_in) use EDParamsMod , only : ED_val_understorey_death, logging_coll_under_frac use EDCohortDynamicsMod , only : zero_cohort, copy_cohort, terminate_cohorts use FatesConstantsMod , only : rsnbl_math_prec - use DamageMainMod , only : GetCrownReduction - use DamageMainMod , only : GetDamageFrac - use PRTLossFluxesMod , only : PRTDamageLosses - use PRTGenericMod , only : leaf_organ - use ChecksBalancesMod , only : SiteMassStock - use FatesInterfaceTypesMod, only : nlevdamage - use FatesParameterDerivedMod, only : param_derived - use EDParamsMod , only : damage_canopy_layer_code - + ! ! !ARGUMENTS: type (ed_site_type), intent(inout), target :: currentSite type (bc_in_type), intent(in) :: bc_in ! ! !LOCAL VARIABLES: - type(litter_type), pointer :: litt - type(litter_type), pointer :: litt_new - type (ed_patch_type) , pointer :: new_patch type (ed_patch_type) , pointer :: new_patch_primary type (ed_patch_type) , pointer :: new_patch_secondary type (ed_patch_type) , pointer :: currentPatch type (ed_cohort_type), pointer :: currentCohort type (ed_cohort_type), pointer :: nc - type (ed_cohort_type), pointer :: nc_d type (ed_cohort_type), pointer :: storesmallcohort type (ed_cohort_type), pointer :: storebigcohort real(r8) :: site_areadis_primary ! total area disturbed (to primary forest) in m2 per site per day @@ -499,48 +477,14 @@ subroutine spawn_patches( currentSite, bc_in) real(r8) :: sapw_c ! sapwood carbon [kg] real(r8) :: store_c ! storage carbon [kg] real(r8) :: struct_c ! structure carbon [kg] - real(r8) :: repro_c ! reproductive carbon [kg] real(r8) :: total_c ! total carbon of plant [kg] real(r8) :: leaf_burn_frac ! fraction of leaves burned in fire ! for both woody and grass species real(r8) :: leaf_m ! leaf mass during partial burn calculations - - real(r8) :: total_litter_d ! total litter from damage - real(r8) :: patch_damage_litter ! patch level litter from damage - real(r8) :: mass_frac ! mass to remove from damaged cohorts - real(r8) :: leaf_m_pre ! leaf mass pre damage - real(r8) :: leaf_m_post ! leaf mass post damage - real(r8) :: leaf_loss_prt ! leaf mass lost - real(r8) :: sapw_m_pre ! sapw mass pre damage - real(r8) :: sapw_m_post ! sapw mass post damage - real(r8) :: sapw_loss_prt ! sapw mass lost - real(r8) :: struct_m_pre ! struct mass pre damage - real(r8) :: struct_m_post ! struct mass post damage - real(r8) :: struct_loss_prt ! struct mass lost - real(r8) :: store_m_pre ! storage mass pre damage - real(r8) :: store_m_post ! storage mass post damage - real(r8) :: store_loss_prt ! storage mass lost - real(r8) :: cd_n ! number in new damaged cohort - real(r8) :: cd_n_total ! total number damaged - integer :: cd ! crowndamage counter - real(r8) :: cd_frac ! fraction of cohort going to new damage class - real(r8) :: agb_frac ! agoveground biomass fraction of cohort - real(r8) :: branch_frac ! branch fraction of aboveground biomass - logical :: found_youngest_primary ! logical for finding the first primary forest patch integer :: min_nocomp_pft, max_nocomp_pft, i_nocomp_pft - - integer :: i_damage_code !--------------------------------------------------------------------- - real(r8), parameter :: damage_error_fail = 1.0e-6_r8 - - !--------------------------------------------------------------------- - - i_damage_code = int(damage_canopy_layer_code) - - total_litter_d = 0.0_r8 - storesmallcohort => null() ! storage of the smallest cohort for insertion routine storebigcohort => null() ! storage of the largest cohort for insertion routine @@ -552,12 +496,6 @@ subroutine spawn_patches( currentSite, bc_in) max_nocomp_pft = fates_unset_int endif - leaf_loss_prt = 0.0_r8 - sapw_loss_prt = 0.0_r8 - struct_loss_prt = 0.0_r8 - store_loss_prt = 0.0_r8 - patch_damage_litter = 0.0_r8 - ! zero the diagnostic disturbance rate fields currentSite%disturbance_rates_primary_to_primary(1:N_DIST_TYPES) = 0._r8 currentSite%disturbance_rates_primary_to_secondary(1:N_DIST_TYPES) = 0._r8 @@ -632,7 +570,7 @@ subroutine spawn_patches( currentSite, bc_in) ! 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 @@ -647,12 +585,12 @@ subroutine spawn_patches( currentSite, bc_in) ! 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) + 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() @@ -685,7 +623,7 @@ subroutine spawn_patches( currentSite, bc_in) ! 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. - + currentPatch => currentSite%oldest_patch do while(associated(currentPatch)) @@ -695,45 +633,46 @@ subroutine spawn_patches( currentSite, bc_in) ! This is the amount of patch area that is disturbed, and donated by the donor patch_site_areadis = currentPatch%area * currentPatch%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 - ! disturbance type is not logging - if (currentPatch%anthro_disturbance_label .eq. primaryforest .and. & - (currentPatch%disturbance_mode .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 + ! 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 + if (currentPatch%anthro_disturbance_label .eq. primaryforest .and. & + (currentPatch%disturbance_mode .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 dominant 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 + (currentPatch%disturbance_mode .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. if(currentPatch%disturbance_mode .ne. dtype_ifire) then - currentPatch%burnt_frac_litter(:) = 0._r8 + currentPatch%burnt_frac_litter(:) = 0._r8 end if call TransLitterNewPatch( currentSite, currentPatch, new_patch, patch_site_areadis) @@ -747,23 +686,9 @@ subroutine spawn_patches( currentSite, bc_in) call fire_litter_fluxes(currentSite, currentPatch, & new_patch, patch_site_areadis,bc_in) else - call mortality_litter_fluxes(currentSite, currentPatch,& + call mortality_litter_fluxes(currentSite, currentPatch, & new_patch, patch_site_areadis,bc_in) - end if - - - - ! and the damaged trees - if(hlm_use_tree_damage .eq. itrue) then - if(damage_time) then - - call damage_litter_fluxes(currentSite, currentPatch, & - new_patch, patch_site_areadis, patch_damage_litter) - end if - end if - - ! in kg - for mass conservation checking - total_litter_d = total_litter_d + patch_damage_litter + endif ! Copy any means or timers from the original patch to the new patch @@ -779,7 +704,6 @@ subroutine spawn_patches( currentSite, bc_in) ! ! Next, we loop through the cohorts in the donor patch, copy them with ! area modified number density into the new-patch, and apply survivorship. - ! Cohorts in the new patch have to be split into damage and undamaged. ! ------------------------------------------------------------------------- currentCohort => currentPatch%shortest @@ -801,64 +725,54 @@ subroutine spawn_patches( currentSite, bc_in) call zero_cohort(nc) - agb_frac = prt_params%allom_agb_frac(currentCohort%pft) - branch_frac = param_derived%branch_frac(currentCohort%pft) - - - ! 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) - ! nc_d is the new cohort that goes in the disturbed (new) patch and gets damaged - 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 - - - ! As we loop through disturbances we just focus on nc - surviving trees in new patch - ! After this loop we can alter number densities in nc and nc_d and apply damage - - ! if treefall mortality is the dominant disturbance - if(currentPatch%disturbance_mode .eq. dtype_ifall) then + ! 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) - ! if canopy - if(currentCohort%canopy_layer == 1)then + !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 dominant disturbance + if(currentPatch%disturbance_mode .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)) - + 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 + ! because the cohort should dissappear nc%hmort = nan nc%bmort = nan nc%frmort = nan nc%smort = nan nc%asmort = nan - nc%dgmort = 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. @@ -867,7 +781,7 @@ subroutine spawn_patches( currentSite, bc_in) ! 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 @@ -878,7 +792,7 @@ subroutine spawn_patches( currentSite, bc_in) 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_crownarea = currentSite%imort_crownarea + & currentCohort%c_area * ED_val_understorey_death / hlm_freq_day @@ -887,8 +801,7 @@ subroutine spawn_patches( currentSite, bc_in) (nc%n * ED_val_understorey_death / hlm_freq_day ) * & total_c * g_per_kg * days_per_sec * years_per_day * ha_per_m2 - - if (hlm_use_tree_damage .eq. itrue) then + if (hlm_use_crown_damage .eq. itrue) then currentSite%imort_rate_damage(currentCohort%crowndamage, & currentCohort%size_class, currentCohort%pft) = & @@ -902,13 +815,13 @@ subroutine spawn_patches( currentSite, bc_in) total_c * g_per_kg * days_per_sec * years_per_day * ha_per_m2 end if - - + + ! 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 @@ -916,62 +829,62 @@ subroutine spawn_patches( currentSite, bc_in) ! 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%dgmort = currentCohort%dgmort nc%dmort = currentCohort%dmort + nc%dgmort = currentCohort%dgmort 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 ! if not woody + + 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%dgmort = currentCohort%dgmort nc%dmort = currentCohort%dmort + nc%dgmort = currentCohort%dgmort nc%lmort_direct = currentCohort%lmort_direct nc%lmort_collateral = currentCohort%lmort_collateral nc%lmort_infra = currentCohort%lmort_infra - + endif - end if - + endif + ! Fire is the dominant disturbance elseif (currentPatch%disturbance_mode .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) = & @@ -985,12 +898,12 @@ subroutine spawn_patches( currentSite, bc_in) currentSite%fmort_crownarea_canopy = currentSite%fmort_crownarea_canopy + & currentCohort%c_area * currentCohort%fire_mort / hlm_freq_day - + 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) * & @@ -998,11 +911,10 @@ subroutine spawn_patches( currentSite, bc_in) currentSite%fmort_crownarea_ustory = currentSite%fmort_crownarea_ustory + & currentCohort%c_area * currentCohort%fire_mort / hlm_freq_day - end if ! also track fire damage mortality and cflux along size x damage axis - if(hlm_use_tree_damage .eq. itrue) then + if(hlm_use_crown_damage .eq. itrue) then if(levcan==ican_upper) then currentSite%fmort_rate_canopy_damage(currentCohort%crowndamage, currentCohort%size_class, & currentCohort%pft) = & @@ -1025,17 +937,17 @@ subroutine spawn_patches( currentSite, bc_in) total_c * g_per_kg * days_per_sec * ha_per_m2 end if 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 @@ -1052,36 +964,37 @@ subroutine spawn_patches( currentSite, bc_in) ! 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 + ! 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__)) + (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)) + 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 + 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 @@ -1090,24 +1003,26 @@ subroutine spawn_patches( currentSite, bc_in) currentCohort%fraction_crown_burned = 0.0_r8 nc%fraction_crown_burned = 0.0_r8 - ! Logging is the dominant disturbance - elseif (currentPatch%disturbance_mode .eq. dtype_ilog ) then + + ! Logging is the dominant disturbance + elseif (currentPatch%disturbance_mode .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))) + (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 @@ -1123,13 +1038,15 @@ subroutine spawn_patches( currentSite, bc_in) 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. @@ -1137,8 +1054,7 @@ subroutine spawn_patches( currentSite, bc_in) ! 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 @@ -1150,45 +1066,27 @@ subroutine spawn_patches( currentSite, bc_in) currentSite%imort_rate(currentCohort%size_class, currentCohort%pft) + & nc%n * currentPatch%fract_ldist_not_harvested * & logging_coll_under_frac / hlm_freq_day - - currentSite%imort_crownarea = currentSite%imort_crownarea + & - nc%c_area * 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 - - if (hlm_use_tree_damage .eq. itrue) then - currentSite%imort_rate_damage(currentCohort%crowndamage,& - currentCohort%size_class, currentCohort%pft) = & - currentSite%imort_rate_damage(currentCohort%crowndamage,& - currentCohort%size_class, currentCohort%pft) + & - nc%n * currentPatch%fract_ldist_not_harvested * & - logging_coll_under_frac / hlm_freq_day - - currentSite%imort_cflux_damage(nc%crowndamage, nc%size_class) = & - currentSite%imort_cflux_damage(nc%crowndamage, nc%size_class) + & - (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 - end if - + + ! 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 @@ -1200,17 +1098,17 @@ subroutine spawn_patches( currentSite, bc_in) nc%lmort_direct = currentCohort%lmort_direct nc%lmort_collateral = currentCohort%lmort_collateral nc%lmort_infra = currentCohort%lmort_infra - - else ! if not woody - + + 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 @@ -1218,176 +1116,21 @@ subroutine spawn_patches( currentSite, bc_in) nc%frmort = currentCohort%frmort nc%smort = currentCohort%smort nc%asmort = currentCohort%asmort - nc%dgmort = currentCohort%dgmort 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 - - end if - - else - write(fates_log(),*) 'unknown disturbance mode?' - write(fates_log(),*) 'disturbance_mode: ',currentPatch%disturbance_mode - call endrun(msg=errMsg(sourcefile, __LINE__)) - end if ! Select disturbance mode - - - ! Regardless of disturbance type, reduce mass of damaged trees - if(hlm_use_tree_damage .eq. itrue) then - if(damage_time) then - - ! if woody - if (prt_params%woody(currentCohort%pft)==1 ) then - - if(.not. currentCohort%isnew ) then - - ! to keep track of how much canopy n needs to be reduced by after the loop - cd_n_total = 0.0_r8 - - ! for each damage class find the number density and if big enough allocate a new cohort - do cd = currentCohort%crowndamage+1, nlevdamage - - call GetDamageFrac(currentCohort%crowndamage, cd, currentCohort%pft, cd_frac) - - if(i_damage_code .eq. 1 .and. currentCohort%canopy_layer == 1) then - cd_n = currentCohort%n * cd_frac - else if(i_damage_code .eq. 2 .and. currentCohort%canopy_layer > 1) then - cd_n = nc%n * cd_frac - else - cd_n = 0._r8 - end if - - - if(cd_n > nearzero) then - - cd_n_total = cd_n_total + cd_n - - allocate(nc_d) ! new cohort surviving but damaged - if(hlm_use_planthydro.eq.itrue) call InitHydrCohort(CurrentSite,nc_d) - - ! Initialize the PARTEH object and point to the - ! correct boundary condition fields - nc_d%prt => null() - - call InitPRTObject(nc_d%prt) - call InitPRTBoundaryConditions(nc_d) - call zero_cohort(nc_d) - - ! nc_canopy_d is the new cohort that gets damaged - call copy_cohort(currentCohort, nc_d) - - nc_d%canopy_layer = currentCohort%canopy_layer - nc_d%canopy_layer_yesterday = 1._r8 - - ! new number densities - we just do damaged cohort here - - ! undamaged at the end of the cohort loop once we know how many damaged to - ! subtract - - nc_d%n = cd_n - nc_d%crowndamage = cd - - ! update crown area here - for cohort fusion and canopy organisation below - call carea_allom(nc_d%dbh, nc_d%n, currentSite%spread,& - nc_d%pft, nc_d%crowndamage, nc_d%c_area) - - call GetCrownReduction(nc_d%crowndamage, mass_frac) - - - leaf_m_pre = nc_d%prt%GetState(leaf_organ, all_carbon_elements) + & - nc_d%prt%GetState(repro_organ, all_carbon_elements) - call PRTDamageLosses(nc_d%prt, leaf_organ, mass_frac) - call PRTDamageLosses(nc_d%prt, repro_organ, mass_frac) - leaf_m_post = nc_d%prt%GetState(leaf_organ, all_carbon_elements) + & - nc_d%prt%GetState(repro_organ, all_carbon_elements) - - leaf_loss_prt = leaf_loss_prt + (leaf_m_pre - leaf_m_post)* & - nc_d%n - - sapw_m_pre = nc_d%prt%GetState(sapw_organ, all_carbon_elements) - call PRTDamageLosses(nc_d%prt, sapw_organ, mass_frac * & - branch_frac * agb_frac) - sapw_m_post = nc_d%prt%GetState(sapw_organ, all_carbon_elements) - sapw_loss_prt = sapw_loss_prt + (sapw_m_pre - sapw_m_post)*nc_d%n - - struct_m_pre = nc_d%prt%GetState(struct_organ, all_carbon_elements) - call PRTDamageLosses(nc_d%prt, struct_organ, mass_frac * & - branch_frac * agb_frac) - struct_m_post = nc_d%prt%GetState(struct_organ, all_carbon_elements) - struct_loss_prt = struct_loss_prt + (struct_m_pre - struct_m_post)* & - nc_d%n - - store_m_pre = nc_d%prt%GetState(store_organ, all_carbon_elements) - call PRTDamageLosses(nc_d%prt, store_organ, mass_frac * & - branch_frac * agb_frac) - store_m_post = nc_d%prt%GetState(store_organ, all_carbon_elements) - store_loss_prt = store_loss_prt + (store_m_pre - store_m_post)* & - nc_d%n - - fnrt_c = nc_d%prt%GetState(fnrt_organ, all_carbon_elements) - - - if(i_damage_code .eq. 1 ) then - currentSite%crownarea_canopy_damage = currentSite%crownarea_canopy_damage + & - (currentCohort%c_area/currentCohort%n - nc_d%c_area/nc_d%n) * nc_d%n - end if - - if(i_damage_code .eq. 2 ) then - currentSite%crownarea_ustory_damage = currentSite%crownarea_ustory_damage + & - (currentCohort%c_area/currentCohort%n - nc_d%c_area/nc_d%n) * nc_d%n - end if - - - storebigcohort => currentPatch%tallest - storesmallcohort => currentPatch%shortest - if(associated(currentPatch%tallest))then - tnull = 0 - else - tnull = 1 - currentPatch%tallest => nc_d - nc_d%taller => null() - endif - - if(associated(currentPatch%shortest))then - snull = 0 - else - snull = 1 - currentPatch%shortest => nc_d - nc_d%shorter => null() - endif - - call insert_cohort(nc_d, currentPatch%tallest, currentPatch%shortest, & - tnull, snull, storebigcohort, storesmallcohort) - - currentPatch%tallest => storebigcohort - currentPatch%shortest => storesmallcohort - - end if ! end if new n is large enough - - end do ! end crowndamage loop - - ! Reduce currentCohort%n now based on sum of all new damage classes - ! And update c_area of the undamaged cohort (since number density has changed) - if(i_damage_code .eq. 1 ) then - currentCohort%n = currentCohort%n - cd_n_total - call carea_allom(currentCohort%dbh, currentCohort%n, currentSite%spread,& - currentCohort%pft, currentCohort%crowndamage, currentCohort%c_area) - else if(i_damage_code .eq. 2 ) then - nc%n = nc%n - cd_n_total - call carea_allom(nc%dbh, nc%n, currentSite%spread,& - nc%pft, nc%crowndamage, nc%c_area) - end if - - - end if ! end if not new - end if ! end if canopy and woody - end if ! end if damage time - end if ! end if damage is on - + + endif ! Select canopy layer + + else + write(fates_log(),*) 'unknown disturbance mode?' + write(fates_log(),*) 'disturbance_mode: ',currentPatch%disturbance_mode + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if ! Select disturbance mode - ! Put new undamaged cohorts in the correct place in the linked list if (nc%n > 0.0_r8) then storebigcohort => new_patch%tallest storesmallcohort => new_patch%shortest @@ -1398,7 +1141,7 @@ subroutine spawn_patches( currentSite, bc_in) new_patch%tallest => nc nc%taller => null() endif - + if(associated(new_patch%shortest))then snull = 0 else @@ -1408,24 +1151,22 @@ subroutine spawn_patches( currentSite, bc_in) endif nc%patchptr => new_patch call insert_cohort(nc, new_patch%tallest, new_patch%shortest, & - tnull, snull, storebigcohort, storesmallcohort) - + 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 currentPatch%area = currentPatch%area - patch_site_areadis @@ -1438,20 +1179,19 @@ subroutine spawn_patches( currentSite, bc_in) call terminate_cohorts(currentSite, currentPatch, 2,16,bc_in) call sort_cohorts(currentPatch) - 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 - + end if cp_nocomp_matches_2_if + currentPatch => currentPatch%younger + + enddo ! currentPatch patch loop. - enddo ! currentPatch patch loop. - !*************************/ + !*************************/ !** INSERT NEW PATCH(ES) INTO LINKED LIST !*************************/ @@ -1527,24 +1267,6 @@ subroutine spawn_patches( currentSite, bc_in) call check_patch_area(currentSite) call set_patchno(currentSite) - - ! Stop run if the amount of litter from damage does not match the biomass lost from damaged cohorts - if ( abs(total_litter_d - (leaf_loss_prt + sapw_loss_prt + & - struct_loss_prt + store_loss_prt)) > damage_error_fail ) then - write(fates_log(),*) 'Damage to litter does not match biomass loss' - write(fates_log(),*) 'Damage to litter: ',total_litter_d, & - 'biomass loss: ', (leaf_loss_prt + sapw_loss_prt + struct_loss_prt + store_loss_prt), & - 'error: ',total_litter_d - (leaf_loss_prt + sapw_loss_prt + struct_loss_prt + store_loss_prt) - call endrun(msg=errMsg(sourcefile, __LINE__)) - end if - - if (damage_time) then - - - write(fates_log(),*) 'Damage to litter: ',total_litter_d - write(fates_log(),*) 'Damage from trees:',leaf_loss_prt+ & - sapw_loss_prt + struct_loss_prt + store_loss_prt - end if end do nocomp_pft_loop return @@ -1572,8 +1294,6 @@ subroutine check_patch_area( currentSite ) real(r8) :: seed_stock real(r8) :: litter_stock real(r8) :: mass_gain - real(r8) :: litter_leaf - real(r8) :: live_leaf real(r8), parameter :: area_error_fail = 1.0e-6_r8 !--------------------------------------------------------------------- @@ -1607,7 +1327,8 @@ subroutine check_patch_area( currentSite ) do el = 1,num_elements ! This returns the total mass on the patch for the current area [kg] - call PatchMassStock(largestPatch,el,live_stock,seed_stock,litter_stock) + call PatchMassStock(largestPatch,el,live_stock,seed_stock,litter_stock) + ! Then we scale the total mass by the added area mass_gain = (seed_stock+litter_stock) * & (area_site-areatot)/largestPatch%area @@ -1749,7 +1470,6 @@ subroutine TransLitterNewPatch(currentSite, & curr_litt => currentPatch%litter(el) new_litt => newPatch%litter(el) - ! Distribute the fragmentation litter flux rates. This is only used for diagnostics ! at this point. Litter fragmentation has already been passed to the output ! boundary flux arrays. @@ -1873,7 +1593,6 @@ subroutine TransLitterNewPatch(currentSite, & end do end do - do pft = 1,numpft @@ -2339,6 +2058,7 @@ subroutine mortality_litter_fluxes(currentSite, currentPatch, & flux_diags%leaf_litter_input(pft) = flux_diags%leaf_litter_input(pft) + & num_dead*(leaf_m + repro_m) + flux_diags%root_litter_input(pft) = flux_diags%root_litter_input(pft) + & num_dead * (fnrt_m + store_m*(1.0_r8-EDPftvarcon_inst%allom_frbstor_repro(pft))) @@ -2353,229 +2073,6 @@ subroutine mortality_litter_fluxes(currentSite, currentPatch, & return end subroutine mortality_litter_fluxes - ! ============================================================================ - - subroutine damage_litter_fluxes(currentSite, currentPatch, newPatch,patch_site_areadis, & - total_damage_litter) - ! - ! !DESCRIPTION: - ! - ! !USES: - use DamageMainMod, only : GetCrownReduction - use DamageMainMod , only : GetDamageFrac - use SFParamsMod , only : SF_val_cwd_frac - use FatesInterfaceTypesMod , only : nlevdamage - use EDParamsMod , only : ED_val_understorey_death - use EDParamsMod , only : damage_canopy_layer_code - use FatesConstantsMod, only : itrue - use FatesParameterDerivedMod, only : param_derived - ! - - ! !ARGUMENTS: - type(ed_site_type) , intent(inout), target :: currentSite - type(ed_patch_type) , intent(inout), target :: currentPatch - type(ed_patch_type) , intent(inout), target :: newPatch - real(r8) , intent(in) :: patch_site_areadis - real(r8), intent(out) :: total_damage_litter - - - ! !LOCAL VARIABLES: - type(ed_cohort_type), pointer :: currentCohort - type(litter_type), pointer :: new_litt - type(litter_type), pointer :: curr_litt - type(site_massbal_type), pointer :: site_mass - type(site_fluxdiags_type), pointer :: flux_diags - - real(r8) :: leaf_donatable_mass ! mass of donatable litter [kg] - real(r8) :: branch_donatable_mass! mass of donatable cwd [kg] - real(r8) :: leaf_m ! leaf mass [kg] - real(r8) :: sapw_m ! sapwood mass [kg] - real(r8) :: struct_m ! structure mass [kg] - real(r8) :: repro_m ! reproductive mass [kg] - real(r8) :: store_m ! storage mass [kg] - real(r8) :: remainder_area ! current patch area after donation [m2] - real(r8) :: retain_frac ! Fraction of mass to be retained - real(r8) :: retain_m2 ! area normalization for litter mass destined to old patch [m-2] - real(r8) :: donate_frac ! Fraction of mass to be donated - real(r8) :: donate_m2 ! area normalization for litter mass destined to new patch [m-2] - integer :: pft ! plant functional type index - integer :: crowndamage ! new increased crown damage class - real(r8) :: crown_reduction ! amount that crown is reduced by (must be same as leaf biomass) - real(r8) :: leaf_loss ! amount of leaf biomass that has been lost - real(r8) :: branch_loss ! amount of branch biomass that has been lost - integer :: dcmpy ! decomposability index - real(r8) :: seed_mass ! Total seed mass generated from storage death [kg] - integer :: c ! coarse woody debris pool index - integer :: el ! element loop index - integer :: sl ! soil layer index - integer :: element_id ! parteh compatible global element index - real(r8) :: dcmpy_frac ! decomposability fraction - real(r8) :: num_trees ! number of trees that were damaged - real(r8) :: num_trees_cd - integer :: cd - real(r8) :: cd_frac - real(r8) :: agb_frac - real(r8) :: branch_frac - integer :: ncwd_no_trunk - real(r8), allocatable :: SF_val_CWD_frac_canopy(:) - real(r8) :: cd_n_tot - integer :: i_damage_code - - !--------------------------------------------------------------------- - i_damage_code = int(damage_canopy_layer_code) - - total_damage_litter = 0.0_r8 - cd_n_tot = 0.0_r8 - ncwd_no_trunk = ncwd - 1 - allocate(SF_val_CWD_frac_canopy(ncwd_no_trunk)) - - ! crown damage is currently not trunks - but we want 100% of - ! damage above to go to litter. We therefore have to - ! renormalise just the first three litter bins - SF_val_CWD_frac_canopy = SF_val_CWD_frac(1:ncwd_no_trunk)/sum(SF_val_CWD_frac(1:ncwd_no_trunk)) - - - ! m2 - remainder_area = currentPatch%area - patch_site_areadis - ! fraction of litter to retain (remain area frac * how much - ! dispersal of litter there is) - retain_frac = (1.0_r8-damage_localization) * & - remainder_area/(newPatch%area+remainder_area) - donate_frac = 1.0_r8-retain_frac - - if(remainder_area > rsnbl_math_prec) then - retain_m2 = retain_frac/remainder_area - donate_m2 = (1.0_r8-retain_frac)/newPatch%area - else - retain_m2 = 0._r8 - donate_m2 = 1._r8/newPatch%area - end if - - - ! loop through elements and spread between retain and donate litter - do el = 1,num_elements - - element_id = element_list(el) - site_mass => currentSite%mass_balance(el) - flux_diags => currentSite%flux_diags(el) - curr_litt => currentPatch%litter(el) ! Litter pool of "current" patch - new_litt => newPatch%litter(el) - - - - currentCohort => currentPatch%shortest - - do while(associated(currentCohort)) - - - pft = currentCohort%pft - agb_frac = prt_params%allom_agb_frac(pft) - branch_frac = param_derived%branch_frac(pft) - - ! Get mass in Kg of the element in the specified organ - sapw_m = currentCohort%prt%GetState(sapw_organ, element_id) - struct_m = currentCohort%prt%GetState(struct_organ, element_id) - leaf_m = currentCohort%prt%GetState(leaf_organ, element_id) !kg - repro_m = currentCohort%prt%GetState(repro_organ, element_id) - store_m = currentCohort%prt%GetState(store_organ, element_id) - - if(prt_params%woody(currentCohort%pft)==1) then - - if( hlm_use_tree_damage .eq.itrue .and. & - currentCohort%canopy_layer ==1 .and. i_damage_code .eq. 1 .and. & - .not. currentCohort%isnew) then - - ! litter is called before damage - so we need to account for mortality here too - num_trees = currentCohort%n * (1.0_r8 - fates_mortality_disturbance_fraction * & - min(1.0_r8, currentCohort%dmort* hlm_freq_day)) - - else if( hlm_use_tree_damage .eq.itrue .and. & - currentCohort%canopy_layer > 1 .and. i_damage_code .eq. 2 .and. & - .not. currentCohort%isnew) then - - ! for trees in new patch to be damaged - num_trees = currentCohort%n * (patch_site_areadis/currentPatch%area) * & - (1.0_r8 - ED_val_understorey_death) - - else - num_trees = 0._r8 - end if - - - - do cd = currentCohort%crowndamage+1, nlevdamage - - call GetDamageFrac(currentCohort%crowndamage, cd, currentCohort%pft, cd_frac) - - ! now to get the number of damaged trees we multiply by damage frac - num_trees_cd = num_trees * cd_frac - - cd_n_tot = cd_n_tot + num_trees_cd - - ! if non negligable get litter - if (num_trees_cd > nearzero ) then - - call GetCrownReduction(cd, crown_reduction) - - - ! leaf loss in kg - leaf_loss = (leaf_m + repro_m) * crown_reduction - leaf_donatable_mass = num_trees_cd * leaf_loss - - do dcmpy=1,ndcmpy - dcmpy_frac = GetDecompyFrac(pft,leaf_organ,dcmpy) - - new_litt%leaf_fines(dcmpy) = new_litt%leaf_fines(dcmpy) + & - leaf_donatable_mass*donate_m2*dcmpy_frac ! kg per m2 - curr_litt%leaf_fines(dcmpy) = curr_litt%leaf_fines(dcmpy) + & - leaf_donatable_mass*retain_m2*dcmpy_frac ! kg per m2 - end do - - flux_diags%leaf_litter_input(pft) = flux_diags%leaf_litter_input(pft) + & - leaf_donatable_mass - - ! branch loss - branch_loss = (sapw_m + struct_m + store_m) * crown_reduction * & - branch_frac * agb_frac * num_trees_cd - - do c=1,(ncwd_no_trunk) - - branch_donatable_mass = branch_loss * SF_val_CWD_frac_canopy(c) - - ! Transfer wood of dying trees to AG CWD pools - new_litt%ag_cwd(c) = new_litt%ag_cwd(c) + branch_donatable_mass * donate_m2 - - curr_litt%ag_cwd(c) = curr_litt%ag_cwd(c) + branch_donatable_mass * retain_m2 - - flux_diags%cwd_ag_input(c) = & - flux_diags%cwd_ag_input(c) + branch_donatable_mass - - end do - - ! should match leaf damage that is printed after PRTDamageLosses is called - total_damage_litter = total_damage_litter + leaf_donatable_mass + & - branch_loss - - end if ! end if non-negligable - end do ! end crown damage loop - - end if ! end if woody - - - - currentCohort => currentCohort%taller - - - enddo !currentCohort - - enddo ! end element - - return - end subroutine damage_litter_fluxes - - - - ! ============================================================================ subroutine create_patch(currentSite, new_patch, age, areap, label,nocomp_pft) From 33516666a9c543e5f381a3d6cffe3543178f4044 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Wed, 6 Jul 2022 11:53:57 -0600 Subject: [PATCH 61/84] Added declaration of global hlm_use_tree_damage --- biogeochem/EDPatchDynamicsMod.F90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 7fe99f2ee6..345e725b0e 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -47,6 +47,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_use_tree_damage use FatesGlobals , only : endrun => fates_endrun use FatesConstantsMod , only : r8 => fates_r8 use FatesConstantsMod , only : itrue, ifalse @@ -801,7 +802,7 @@ subroutine spawn_patches( currentSite, bc_in) (nc%n * ED_val_understorey_death / hlm_freq_day ) * & total_c * g_per_kg * days_per_sec * years_per_day * ha_per_m2 - if (hlm_use_crown_damage .eq. itrue) then + if (hlm_use_tree_damage .eq. itrue) then currentSite%imort_rate_damage(currentCohort%crowndamage, & currentCohort%size_class, currentCohort%pft) = & @@ -914,7 +915,7 @@ subroutine spawn_patches( currentSite, bc_in) end if ! also track fire damage mortality and cflux along size x damage axis - if(hlm_use_crown_damage .eq. itrue) then + if(hlm_use_tree_damage .eq. itrue) then if(levcan==ican_upper) then currentSite%fmort_rate_canopy_damage(currentCohort%crowndamage, currentCohort%size_class, & currentCohort%pft) = & From b9d7b97cdb3068963e379e7edf7afdb2cab8700e Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Wed, 6 Jul 2022 15:35:07 -0400 Subject: [PATCH 62/84] First pass at the new damage application routine --- biogeochem/EDPhysiologyMod.F90 | 141 +++++++++++++++++++++++++++++++++ main/EDMainMod.F90 | 3 +- 2 files changed, 143 insertions(+), 1 deletion(-) diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 45d9ca38a3..7ea5344f4e 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -121,6 +121,7 @@ module EDPhysiologyMod public :: ZeroAllocationRates public :: PreDisturbanceLitterFluxes public :: PreDisturbanceIntegrateLitter + public :: GenerateDamageAndLitterFluxes public :: SeedIn logical, parameter :: debug = .false. ! local debug flag @@ -186,6 +187,146 @@ subroutine ZeroAllocationRates( currentSite ) return end subroutine ZeroAllocationRates + ! ============================================================================ + + subroutine GenerateDamageAndLitterFluxes( currentSite, currentPatch, bc_in ) + + if(hlm_use_crown_damage .ne. itrue) return + + if(.not.damage_time) return + + currentCohort => currentPatch%tallest + do while (associated(currentCohort)) + + ! Ignore damage to new plants and non-woody plants + if(prt_params%woody(currentCohort%pft)==ifalse ) cycle + if(currentCohort%isnew ) cycle + + agb_frac = prt_params%allom_agb_frac(currentCohort%pft) + branch_frac = param_derived%branch_frac(currentCohort%pft) + + do_dclass: do cd = currentCohort%crowndamage+1, nlevdamage + + call GetDamageFrac(currentCohort%crowndamage, cd, currentCohort%pft, cd_frac) + + ! now to get the number of damaged trees we multiply by damage frac + num_trees_cd = currentCohort%n * cd_frac + + ! if non negligable lets create a new cohort and generate some litter + if_numtrees: if (num_trees_cd > nearzero ) then + + ! Create a new damaged cohort + allocate(nc_d) ! new cohort surviving but damaged + if(hlm_use_planthydro.eq.itrue) call InitHydrCohort(CurrentSite,nc_d) + + ! Initialize the PARTEH object and point to the + ! correct boundary condition fields + nc_d%prt => null() + + call InitPRTObject(nc_d%prt) + call InitPRTBoundaryConditions(nc_d) + call zero_cohort(nc_d) + + ! nc_canopy_d is the new cohort that gets damaged + call copy_cohort(currentCohort, nc_d) + + ! new number densities - we just do damaged cohort here - + ! undamaged at the end of the cohort loop once we know how many damaged to + ! subtract + + nc_d%n = num_trees_cd + nc_d%crowndamage = cd + + ! Remove these trees from the donor cohort + currentCohort%n = currentCohort%n - num_trees_cd + + ! update crown area here - for cohort fusion and canopy organisation below + call carea_allom(nc_d%dbh, nc_d%n, currentSite%spread,& + nc_d%pft, nc_d%crowndamage, nc_d%c_area) + + call GetCrownReduction(cd, crown_loss_frac) + + do_element: do el = 1, num_elements + + litt => currentPatch%litter(el) + flux_diags => currentSite%flux_diags(el) + + ! Reduce the mass of the newly damaged cohort + ! Fine-roots are not damaged as of yet + ! only above-ground sapwood,structure and storage in + ! branches is damaged/removed + branch_loss_frac = crown_loss_frac * branch_frac * agb_frac + + leaf_loss = nc_d%prt%GetState(leaf_organ,element_id(el))*crown_loss_frac + repro_loss = nc_d%prt%GetState(repro_organ,element_id(el))*crown_loss_frac + sapw_loss = nc_d%prt%GetState(sapw_organ,element_id(el))*branch_loss_frac + store_loss = nc_d%prt%GetState(store_organ,element_id(el))*branch_loss_frac + struct_loss = nc_d%prt%GetState(struct_organ,element_id(el))*branch_loss_frac + + ! ------------------------------------------------------ + ! Transfer the biomass from the cohort's + ! damage to the litter input fluxes + ! ------------------------------------------------------ + + do dcmpy=1,ndcmpy + dcmpy_frac = GetDecompyFrac(pft,leaf_organ,dcmpy) + litt%leaf_fines_in(dcmpy) = litt%leaf_fines_in(dcmpy) + & + (store_loss+leaf_loss+repro_loss) * & + nc_d%n * dcmpy_frac / currentPatch%area + end do + + flux_diags%leaf_litter_input(pft) = & + flux_diags%leaf_litter_input(pft) + & + (store_loss+leaf_loss+repro_loss) * nc_d%n + + do c = 1,ncwd + litt%ag_cwd_in(c) = litt%ag_cwd_in(c) + & + (sapw_loss + struct_loss) * & + SF_val_CWD_frac(c) * nc_d%n / & + currentPatch%area + + flux_diags%cwd_ag_input(c) = flux_diags%cwd_ag_input(c) + & + (struct_m_turnover + sapw_m_turnover) * & + SF_val_CWD_frac(c) * nc_d%n + end do + + end do do_element + + ! Applying the damage to the cohort, does not need to happen + ! in the element loop, it will loop inside that call + call PRTDamageLosses(nc_d%prt, leaf_organ, crown_loss_frac) + call PRTDamageLosses(nc_d%prt, repro_organ, crown_loss_frac) + call PRTDamageLosses(nc_d%prt, sapw_organ, branch_loss_frac) + call PRTDamageLosses(nc_d%prt, store_organ, branch_loss_frac) + call PRTDamageLosses(nc_d%prt, struct_organ, branch_loss_frac) + + + !----------- Insert new cohort into the linked list + ! This list is going tall to short, lets add this new + ! cohort into a taller position so we don't hit it again + ! as the loop traverses + ! --------------------------------------------------------------! + + nc_d%shorter => currentCohort + if(associated(currentCohort%taller))then + nc_d%taller => currentCohort%taller + currentCohort%taller%shorter => nc_d + else + cpatch%tallest => nc_d + nc_d%taller => null() + endif + currentCohort%taller => nc_d + + + end if if_numtrees + + end do do_dclass + + currentCohort => currentCohort%shorter + enddo + + return + end subroutine GenerateDamageAndLitterFluxes ! ============================================================================ diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index 537381a977..04f71fc615 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -738,10 +738,11 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) currentPatch => currentSite%youngest_patch do while(associated(currentPatch)) + + call GenerateDamageAndLitterFluxes( currentSite, currentPatch, bc_in) call PreDisturbanceLitterFluxes( currentSite, currentPatch, bc_in) - call PreDisturbanceIntegrateLitter(currentPatch ) currentPatch => currentPatch%older From 3e2aeab861d1fd522c7580e9a99739db6953bf88 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Mon, 11 Jul 2022 14:51:45 -0400 Subject: [PATCH 63/84] Adding variable definitions to the damage generation routine --- biogeochem/EDPhysiologyMod.F90 | 152 ++++++++++++++++++++------------- 1 file changed, 92 insertions(+), 60 deletions(-) diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 7ea5344f4e..7fff02491a 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -13,12 +13,14 @@ module EDPhysiologyMod use FatesInterfaceTypesMod, only : hlm_day_of_year use FatesInterfaceTypesMod, only : numpft use FatesInterfaceTypesMod, only : nleafage + use FatesInterfaceTypesMod, only : nlevdamage use FatesInterfaceTypesMod, only : hlm_use_planthydro use FatesInterfaceTypesMod, only : hlm_parteh_mode use FatesInterfaceTypesMod, only : hlm_use_fixed_biogeog use FatesInterfaceTypesMod, only : hlm_use_nocomp use FatesInterfaceTypesMod, only : hlm_nitrogen_spec use FatesInterfaceTypesMod, only : hlm_phosphorus_spec + use FatesInterfaceTypesMod, only : hlm_use_tree_damage use FatesConstantsMod, only : r8 => fates_r8 use FatesConstantsMod, only : nearzero use EDPftvarcon , only : EDPftvarcon_inst @@ -103,11 +105,13 @@ module EDPhysiologyMod use PRTGenericMod, only : repro_organ use PRTGenericMod, only : struct_organ use PRTGenericMod, only : SetState - use PRTLossFluxesMod, only : PRTPhenologyFlush - use PRTLossFluxesMod, only : PRTDeciduousTurnover - use PRTLossFluxesMod, only : PRTReproRelease - use PRTGenericMod, only : StorageNutrientTarget - + use PRTLossFluxesMod, only : PRTPhenologyFlush + use PRTLossFluxesMod, only : PRTDeciduousTurnover + use PRTLossFluxesMod, only : PRTReproRelease + use PRTGenericMod, only : StorageNutrientTarget + use DamageMainMod, only : damage_time + use SFParamsMod, only : SF_val_CWD_frac + implicit none private @@ -189,67 +193,96 @@ end subroutine ZeroAllocationRates ! ============================================================================ - subroutine GenerateDamageAndLitterFluxes( currentSite, currentPatch, bc_in ) + subroutine GenerateDamageAndLitterFluxes( csite, cpatch, bc_in ) - if(hlm_use_crown_damage .ne. itrue) return + ! Arguments + type(ed_site_type) :: csite + type(ed_patch_type) :: cpatch + type(bc_in_type), intent(in) :: bc_in + - if(.not.damage_time) return + ! Locals + type(ed_cohort_type), pointer :: ccohort ! Current cohort + type(ed_cohort_type), pointer :: ndcohort ! Newly damage-class cohort + type(litter_type), pointer :: litt ! Points to the litter object + type(site_fluxdiags_type), pointer :: flux_diags ! pointer to site level flux diagnostics object + integer :: cd ! Damage class index + integer :: el ! Element index + integer :: dcmpy ! Decomposition pool index + integer :: c ! CWD pool index + real(r8) :: cd_frac ! Fraction of trees damaged in this class transition + real(r8) :: num_trees_cd ! Number of trees to spawn into the new damage class cohort + real(r8) :: crown_loss_frac ! Fraction of crown lost from one damage class to next + real(r8) :: branch_loss_frac ! Fraction of sap, structure and storage lost in branch + ! fall during damage + real(r8) :: leaf_loss ! Mass lost to each organ during damage [kg] + real(r8) :: repro_loss ! "" [kg] + real(r8) :: sapw_loss ! "" [kg] + real(r8) :: store_loss ! "" [kg] + real(r8) :: struct_loss ! "" [kg] + real(r8) :: dcmpy_frac ! fraction of mass going to each decomposition pool - currentCohort => currentPatch%tallest - do while (associated(currentCohort)) + + if(hlm_use_tree_damage .ne. itrue) return - ! Ignore damage to new plants and non-woody plants - if(prt_params%woody(currentCohort%pft)==ifalse ) cycle - if(currentCohort%isnew ) cycle + if(.not.damage_time) return - agb_frac = prt_params%allom_agb_frac(currentCohort%pft) - branch_frac = param_derived%branch_frac(currentCohort%pft) + ccohort => cpatch%tallest + do while (associated(ccohort)) - do_dclass: do cd = currentCohort%crowndamage+1, nlevdamage + ! Ignore damage to new plants and non-woody plants + if(prt_params%woody(ccohort%pft)==ifalse ) cycle + if(ccohort%isnew ) cycle + + associate( ipft => ccohort%pft, & + agb_frac => prt_params%allom_agb_frac(ccohort%pft), & + branch_frac => param_derived%branch_frac(ccohort%pft)) + + do_dclass: do cd = ccohort%crowndamage+1, nlevdamage - call GetDamageFrac(currentCohort%crowndamage, cd, currentCohort%pft, cd_frac) + call GetDamageFrac(ccohort%crowndamage, cd, ipft, cd_frac) ! now to get the number of damaged trees we multiply by damage frac - num_trees_cd = currentCohort%n * cd_frac + num_trees_cd = ccohort%n * cd_frac ! if non negligable lets create a new cohort and generate some litter if_numtrees: if (num_trees_cd > nearzero ) then ! Create a new damaged cohort - allocate(nc_d) ! new cohort surviving but damaged - if(hlm_use_planthydro.eq.itrue) call InitHydrCohort(CurrentSite,nc_d) + allocate(ndcohort) ! new cohort surviving but damaged + if(hlm_use_planthydro.eq.itrue) call InitHydrCohort(csite,ndcohort) ! Initialize the PARTEH object and point to the ! correct boundary condition fields - nc_d%prt => null() + ndcohort%prt => null() - call InitPRTObject(nc_d%prt) - call InitPRTBoundaryConditions(nc_d) - call zero_cohort(nc_d) + call InitPRTObject(ndcohort%prt) + call InitPRTBoundaryConditions(ndcohort) + call zero_cohort(ndcohort) ! nc_canopy_d is the new cohort that gets damaged - call copy_cohort(currentCohort, nc_d) + call copy_cohort(ccohort, ndcohort) ! new number densities - we just do damaged cohort here - ! undamaged at the end of the cohort loop once we know how many damaged to ! subtract - nc_d%n = num_trees_cd - nc_d%crowndamage = cd + ndcohort%n = num_trees_cd + ndcohort%crowndamage = cd ! Remove these trees from the donor cohort - currentCohort%n = currentCohort%n - num_trees_cd + ccohort%n = ccohort%n - num_trees_cd ! update crown area here - for cohort fusion and canopy organisation below - call carea_allom(nc_d%dbh, nc_d%n, currentSite%spread,& - nc_d%pft, nc_d%crowndamage, nc_d%c_area) + call carea_allom(ndcohort%dbh, ndcohort%n, csite%spread,& + ipft, ndcohort%crowndamage, ndcohort%c_area) call GetCrownReduction(cd, crown_loss_frac) do_element: do el = 1, num_elements - litt => currentPatch%litter(el) - flux_diags => currentSite%flux_diags(el) + litt => cpatch%litter(el) + flux_diags => csite%flux_diags(el) ! Reduce the mass of the newly damaged cohort ! Fine-roots are not damaged as of yet @@ -257,11 +290,11 @@ subroutine GenerateDamageAndLitterFluxes( currentSite, currentPatch, bc_in ) ! branches is damaged/removed branch_loss_frac = crown_loss_frac * branch_frac * agb_frac - leaf_loss = nc_d%prt%GetState(leaf_organ,element_id(el))*crown_loss_frac - repro_loss = nc_d%prt%GetState(repro_organ,element_id(el))*crown_loss_frac - sapw_loss = nc_d%prt%GetState(sapw_organ,element_id(el))*branch_loss_frac - store_loss = nc_d%prt%GetState(store_organ,element_id(el))*branch_loss_frac - struct_loss = nc_d%prt%GetState(struct_organ,element_id(el))*branch_loss_frac + leaf_loss = ndcohort%prt%GetState(leaf_organ,element_id(el))*crown_loss_frac + repro_loss = ndcohort%prt%GetState(repro_organ,element_id(el))*crown_loss_frac + sapw_loss = ndcohort%prt%GetState(sapw_organ,element_id(el))*branch_loss_frac + store_loss = ndcohort%prt%GetState(store_organ,element_id(el))*branch_loss_frac + struct_loss = ndcohort%prt%GetState(struct_organ,element_id(el))*branch_loss_frac ! ------------------------------------------------------ ! Transfer the biomass from the cohort's @@ -272,33 +305,33 @@ subroutine GenerateDamageAndLitterFluxes( currentSite, currentPatch, bc_in ) dcmpy_frac = GetDecompyFrac(pft,leaf_organ,dcmpy) litt%leaf_fines_in(dcmpy) = litt%leaf_fines_in(dcmpy) + & (store_loss+leaf_loss+repro_loss) * & - nc_d%n * dcmpy_frac / currentPatch%area + ndcohort%n * dcmpy_frac / cpatch%area end do flux_diags%leaf_litter_input(pft) = & flux_diags%leaf_litter_input(pft) + & - (store_loss+leaf_loss+repro_loss) * nc_d%n + (store_loss+leaf_loss+repro_loss) * ndcohort%n do c = 1,ncwd litt%ag_cwd_in(c) = litt%ag_cwd_in(c) + & (sapw_loss + struct_loss) * & - SF_val_CWD_frac(c) * nc_d%n / & - currentPatch%area + SF_val_CWD_frac(c) * ndcohort%n / & + cpatch%area flux_diags%cwd_ag_input(c) = flux_diags%cwd_ag_input(c) + & - (struct_m_turnover + sapw_m_turnover) * & - SF_val_CWD_frac(c) * nc_d%n + (struct_loss + sapw_loss) * & + SF_val_CWD_frac(c) * ndcohort%n end do end do do_element ! Applying the damage to the cohort, does not need to happen ! in the element loop, it will loop inside that call - call PRTDamageLosses(nc_d%prt, leaf_organ, crown_loss_frac) - call PRTDamageLosses(nc_d%prt, repro_organ, crown_loss_frac) - call PRTDamageLosses(nc_d%prt, sapw_organ, branch_loss_frac) - call PRTDamageLosses(nc_d%prt, store_organ, branch_loss_frac) - call PRTDamageLosses(nc_d%prt, struct_organ, branch_loss_frac) + call PRTDamageLosses(ndcohort%prt, leaf_organ, crown_loss_frac) + call PRTDamageLosses(ndcohort%prt, repro_organ, crown_loss_frac) + call PRTDamageLosses(ndcohort%prt, sapw_organ, branch_loss_frac) + call PRTDamageLosses(ndcohort%prt, store_organ, branch_loss_frac) + call PRTDamageLosses(ndcohort%prt, struct_organ, branch_loss_frac) !----------- Insert new cohort into the linked list @@ -307,22 +340,22 @@ subroutine GenerateDamageAndLitterFluxes( currentSite, currentPatch, bc_in ) ! as the loop traverses ! --------------------------------------------------------------! - nc_d%shorter => currentCohort - if(associated(currentCohort%taller))then - nc_d%taller => currentCohort%taller - currentCohort%taller%shorter => nc_d + ndcohort%shorter => ccohort + if(associated(ccohort%taller))then + ndcohort%taller => ccohort%taller + ccohort%taller%shorter => ndcohort else - cpatch%tallest => nc_d - nc_d%taller => null() + cpatch%tallest => ndcohort + ndcohort%taller => null() endif - currentCohort%taller => nc_d - + ccohort%taller => ndcohort end if if_numtrees end do do_dclass - - currentCohort => currentCohort%shorter + + end associate + ccohort => ccohort%shorter enddo return @@ -1958,7 +1991,7 @@ subroutine recruitment( currentSite, currentPatch, bc_in ) ! !USES: use FatesInterfaceTypesMod, only : hlm_use_ed_prescribed_phys use FatesLitterMod , only : ncwd - use SFParamsMod , only : SF_val_CWD_frac + ! ! !ARGUMENTS type(ed_site_type), intent(inout), target :: currentSite @@ -2289,7 +2322,6 @@ subroutine CWDInput( currentSite, currentPatch, litt, bc_in) ! and turnover in dying trees. ! ! !USES: - use SFParamsMod , only : SF_val_CWD_frac ! ! !ARGUMENTS From 85f7e55d2e73c720e6c601fdf80ea624305c8b45 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Tue, 12 Jul 2022 13:00:30 -0600 Subject: [PATCH 64/84] Added module use statements to damage and litter generation module --- biogeochem/EDPhysiologyMod.F90 | 24 ++++++++++++++++-------- main/EDMainMod.F90 | 1 + 2 files changed, 17 insertions(+), 8 deletions(-) diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 7fff02491a..f1268e5e7a 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -31,6 +31,8 @@ module EDPhysiologyMod use EDCohortDynamicsMod , only : zero_cohort use EDCohortDynamicsMod , only : create_cohort, sort_cohorts use EDCohortDynamicsMod , only : InitPRTObject + use EDCohortDynamicsMod , only : InitPRTBoundaryConditions + use EDCohortDynamicsMod , only : copy_cohort use FatesAllometryMod , only : tree_lai use FatesAllometryMod , only : tree_sai use FatesAllometryMod , only : leafc_from_treelai @@ -108,9 +110,15 @@ module EDPhysiologyMod use PRTLossFluxesMod, only : PRTPhenologyFlush use PRTLossFluxesMod, only : PRTDeciduousTurnover use PRTLossFluxesMod, only : PRTReproRelease + use PRTLossFluxesMod, only : PRTDamageLosses use PRTGenericMod, only : StorageNutrientTarget use DamageMainMod, only : damage_time + use DamageMainMod, only : GetCrownReduction + use DamageMainMod, only : GetDamageFrac use SFParamsMod, only : SF_val_CWD_frac + use FatesParameterDerivedMod, only : param_derived + use FatesPlantHydraulicsMod, only : InitHydrCohort + implicit none private @@ -290,11 +298,11 @@ subroutine GenerateDamageAndLitterFluxes( csite, cpatch, bc_in ) ! branches is damaged/removed branch_loss_frac = crown_loss_frac * branch_frac * agb_frac - leaf_loss = ndcohort%prt%GetState(leaf_organ,element_id(el))*crown_loss_frac - repro_loss = ndcohort%prt%GetState(repro_organ,element_id(el))*crown_loss_frac - sapw_loss = ndcohort%prt%GetState(sapw_organ,element_id(el))*branch_loss_frac - store_loss = ndcohort%prt%GetState(store_organ,element_id(el))*branch_loss_frac - struct_loss = ndcohort%prt%GetState(struct_organ,element_id(el))*branch_loss_frac + leaf_loss = ndcohort%prt%GetState(leaf_organ,element_list(el))*crown_loss_frac + repro_loss = ndcohort%prt%GetState(repro_organ,element_list(el))*crown_loss_frac + sapw_loss = ndcohort%prt%GetState(sapw_organ,element_list(el))*branch_loss_frac + store_loss = ndcohort%prt%GetState(store_organ,element_list(el))*branch_loss_frac + struct_loss = ndcohort%prt%GetState(struct_organ,element_list(el))*branch_loss_frac ! ------------------------------------------------------ ! Transfer the biomass from the cohort's @@ -302,14 +310,14 @@ subroutine GenerateDamageAndLitterFluxes( csite, cpatch, bc_in ) ! ------------------------------------------------------ do dcmpy=1,ndcmpy - dcmpy_frac = GetDecompyFrac(pft,leaf_organ,dcmpy) + dcmpy_frac = GetDecompyFrac(ipft,leaf_organ,dcmpy) litt%leaf_fines_in(dcmpy) = litt%leaf_fines_in(dcmpy) + & (store_loss+leaf_loss+repro_loss) * & ndcohort%n * dcmpy_frac / cpatch%area end do - flux_diags%leaf_litter_input(pft) = & - flux_diags%leaf_litter_input(pft) + & + flux_diags%leaf_litter_input(ipft) = & + flux_diags%leaf_litter_input(ipft) + & (store_loss+leaf_loss+repro_loss) * ndcohort%n do c = 1,ncwd diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index 04f71fc615..33bbaff3d4 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -50,6 +50,7 @@ module EDMainMod use EDPhysiologyMod , only : ZeroLitterFluxes use EDPhysiologyMod , only : PreDisturbanceLitterFluxes use EDPhysiologyMod , only : PreDisturbanceIntegrateLitter + use EDPhysiologyMod , only : GenerateDamageAndLitterFluxes use FatesSoilBGCFluxMod , only : FluxIntoLitterPools use EDCohortDynamicsMod , only : UpdateCohortBioPhysRates use FatesSoilBGCFluxMod , only : PrepNutrientAquisitionBCs From eadc8955715f9af5bff9c8217c70945f96c140ea Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 15 Sep 2022 22:16:07 -0400 Subject: [PATCH 65/84] Syntax updates for tree damage mode --- biogeochem/EDCanopyStructureMod.F90 | 5 +- biogeochem/EDPatchDynamicsMod.F90 | 1 - fire/SFMainMod.F90 | 2 - main/EDTypesMod.F90 | 2 +- main/FatesInventoryInitMod.F90 | 8 +- parameter_files/patch_default_bciopt224.xml | 84 ++++++++++----------- 6 files changed, 49 insertions(+), 53 deletions(-) diff --git a/biogeochem/EDCanopyStructureMod.F90 b/biogeochem/EDCanopyStructureMod.F90 index 6efbbeee93..d3332432e8 100644 --- a/biogeochem/EDCanopyStructureMod.F90 +++ b/biogeochem/EDCanopyStructureMod.F90 @@ -1546,7 +1546,7 @@ subroutine leaf_area_profile( currentSite ) if (currentPatch%total_canopy_area > nearzero ) then - call UpdatePatchLAI(currentPatch, patch_lai, CurrentSite) + call UpdatePatchLAI(currentPatch, patch_lai) if(smooth_leaf_distribution == 1)then @@ -2183,7 +2183,7 @@ end subroutine CanopyLayerArea ! =============================================================================================== - subroutine UpdatePatchLAI(currentPatch, patch_lai, currentSite) + subroutine UpdatePatchLAI(currentPatch, patch_lai) ! -------------------------------------------------------------------------------------------- ! This subroutine works through the current patch cohorts and updates the canopy_layer_tlai @@ -2195,7 +2195,6 @@ subroutine UpdatePatchLAI(currentPatch, patch_lai, currentSite) ! Arguments type(ed_patch_type),intent(inout), target :: currentPatch - type(ed_site_type),intent(inout), target :: currentSite real(r8), intent(inout) :: patch_lai ! Local Variables diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 8f652d541b..833ca3d07d 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -47,7 +47,6 @@ 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_use_tree_damage use FatesGlobals , only : endrun => fates_endrun use FatesConstantsMod , only : r8 => fates_r8 use FatesConstantsMod , only : itrue, ifalse diff --git a/fire/SFMainMod.F90 b/fire/SFMainMod.F90 index 7f2c037846..d5cf38d004 100644 --- a/fire/SFMainMod.F90 +++ b/fire/SFMainMod.F90 @@ -427,8 +427,6 @@ subroutine rate_of_spread ( currentSite ) SF_val_miner_damp, & SF_val_fuel_energy - use FatesInterfaceTypesMod, only : hlm_current_day, hlm_current_month - type(ed_site_type), intent(in), target :: currentSite type(ed_patch_type), pointer :: currentPatch diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index b7a14a6902..1d4cd39d9f 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -54,7 +54,7 @@ module EDTypesMod integer, parameter, public :: idiffuse = 2 ! This is the array index for diffuse radiation ! parameters that govern the VAI (LAI+SAI) bins used in radiative transfer code - integer, parameter, public :: nlevleaf = 30 ! number of leaf+stem layers in canopy layer + integer, parameter, public :: nlevleaf = 50 ! number of leaf+stem layers in canopy layer real(r8), public :: dinc_vai(nlevleaf) = fates_unset_r8 ! VAI bin widths array real(r8), public :: dlower_vai(nlevleaf) = fates_unset_r8 ! lower edges of VAI bins diff --git a/main/FatesInventoryInitMod.F90 b/main/FatesInventoryInitMod.F90 index 5b591716fd..31cc2b07ad 100644 --- a/main/FatesInventoryInitMod.F90 +++ b/main/FatesInventoryInitMod.F90 @@ -1031,17 +1031,19 @@ subroutine set_inventory_edcohort_type1(csite,bc_in,css_file_unit,npatches, & ! Calculate the leaf biomass (calculates a maximum first, then applies canopy trim ! and sla scaling factors) - call bleaf(temp_cohort%dbh,temp_cohort%pft,1,& + call bleaf(temp_cohort%dbh,temp_cohort%pft,temp_cohort%crowndamage,& temp_cohort%canopy_trim,c_leaf) ! Calculate fine root biomass call bfineroot(temp_cohort%dbh,temp_cohort%pft,temp_cohort%canopy_trim,c_fnrt) ! Calculate sapwood biomass - call bsap_allom(temp_cohort%dbh,temp_cohort%pft,1, 1.0_r8,temp_cohort%canopy_trim, a_sapw, c_sapw) + call bsap_allom(temp_cohort%dbh,temp_cohort%pft,temp_cohort%crowndamage, & + temp_cohort%canopy_trim, a_sapw, c_sapw) call bdead_allom( c_agw, c_bgw, c_sapw, temp_cohort%pft, c_struct ) - call bstore_allom(temp_cohort%dbh, temp_cohort%pft, 1, temp_cohort%canopy_trim, c_store) + call bstore_allom(temp_cohort%dbh, temp_cohort%pft, temp_cohort%crowndamage, & + temp_cohort%canopy_trim, c_store) temp_cohort%leafmemory = 0._r8 temp_cohort%sapwmemory = 0._r8 temp_cohort%structmemory = 0._r8 diff --git a/parameter_files/patch_default_bciopt224.xml b/parameter_files/patch_default_bciopt224.xml index bfcc288efa..635f634d11 100644 --- a/parameter_files/patch_default_bciopt224.xml +++ b/parameter_files/patch_default_bciopt224.xml @@ -5,48 +5,46 @@ fates_params_opt224_vmn6phi_080621.cdl 1 - 0 - 0 - 1,1,3,4 - 0.03347526,0.024,1e-08,0.0047 - 0.03347526,0.024,1e-08,0.0047 - 0.025,0,0,0 - 0.45,0.25,0,0 - 0.8012471 - 30.94711 - 0.0673 - 0.976 - -9 - -9 - 3 - 0.1266844 - 1.281329 - -9 - 0.768654 - 0.768654 - 57.6 - 0.74 - 21.6 - 200 - 2 - 5 - 0.4863088 - 3 - 3e-06 - 3e-06 - 3e-07 - 3e-08 - 0.03991654 - 0.01995827 - 0.01303514 - 0.02955703 - 3 - 3 - 0.04680188 - 0.001 - 0.8374751 - -1 - 0.5 - 1 + 0 + 0 + 1,1,3,4 + 0.03347526,0.024,1e-08,0.0047 + 0.45,0.25,0,0 + 0.8012471 + 30.94711 + 0.0673 + 0.976 + -9 + -9 + 3 + 0.1266844 + 1.281329 + -9 + 0.768654 + 0.768654 + 57.6 + 0.74 + 21.6 + 200 + 2 + 5 + 0.4863088 + 3 + 3e-06 + 3e-06 + 3e-07 + 3e-08 + 0.03991654 + 0.01995827 + 0.01303514 + 0.02955703 + 3 + 3 + 0.04680188 + 0.001 + 0.8374751 + -1 + 0.5 + 1 From 32a5a4d7cbd895f76f60b603a2d2619327577bed Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 15 Sep 2022 22:16:33 -0400 Subject: [PATCH 66/84] slight correction to crown damage calc --- biogeochem/EDPhysiologyMod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 04783e01c2..540a42e5f9 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -282,10 +282,10 @@ subroutine GenerateDamageAndLitterFluxes( csite, cpatch, bc_in ) ccohort%n = ccohort%n - num_trees_cd ! update crown area here - for cohort fusion and canopy organisation below - call carea_allom(ndcohort%dbh, ndcohort%n, csite%spread,& + call carea_allom(ndcohort%dbh, ndcohort%n, csite%spread, & ipft, ndcohort%crowndamage, ndcohort%c_area) - call GetCrownReduction(cd, crown_loss_frac) + call GetCrownReduction(cd-ccohort%crowndamage, crown_loss_frac) do_element: do el = 1, num_elements From cf912373776756eeab84a32fa66f601cfca86090 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 15 Sep 2022 22:17:08 -0400 Subject: [PATCH 67/84] Fixes to allocation phases vis-a-vis recovery --- main/EDMainMod.F90 | 16 +++++++++------- parteh/PRTAllometricCarbonMod.F90 | 14 ++++++++++---- 2 files changed, 19 insertions(+), 11 deletions(-) diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index b53efda20e..847962fdb5 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -514,18 +514,19 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) ! of mass from the oldest bin into the litter pool, that is something else. ! ----------------------------------------------------------------------------------- call currentCohort%prt%AgeLeaves(ft,sec_per_day) - + end if if_not_newlyrecovered - ! If the current diameter of a plant is somehow less than what is consistent ! with what is allometrically consistent with the stuctural biomass, then ! correct the dbh to match. call EvaluateAndCorrectDBH(currentCohort,delta_dbh,delta_hite) + ! We want to save these values for the newly recovered cohort as well hite_old = currentCohort%hite dbh_old = currentCohort%dbh + ! ----------------------------------------------------------------------------- ! Growth and Allocation (PARTEH) ! ----------------------------------------------------------------------------- @@ -543,9 +544,8 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) ! to grow in stature (phase 2) call currentCohort%prt%DailyPRT(phase=1) - - if((newly_recovered .eq. .false.) .and. & - (hlm_use_tree_damage .eq. itrue) ) then + + if((.not.newly_recovered) .and. (hlm_use_tree_damage .eq. itrue) ) then ! The loop order is shortest to tallest ! The recovered cohort (ie one with larger targets) ! is newly created in DamageRecovery(), and @@ -560,14 +560,16 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) ! the cohort is NOT split, and the whole thing graduates to a lesser ! damage class if(.not.newly_recovered)then - call currentCohort%prt%DailyPRT(phase=1) + call currentCohort%prt%DailyPRT(phase=2) end if else newly_recovered = .false. end if + + !print*,"CD:",currentcohort%crowndamage - call currentCohort%prt%DailyPRT(phase=2) + call currentCohort%prt%DailyPRT(phase=3) ! Update the mass balance tracking for the daily nutrient uptake flux ! Then zero out the daily uptakes, they have been used diff --git a/parteh/PRTAllometricCarbonMod.F90 b/parteh/PRTAllometricCarbonMod.F90 index 56f8c8e1f4..53f20a1538 100644 --- a/parteh/PRTAllometricCarbonMod.F90 +++ b/parteh/PRTAllometricCarbonMod.F90 @@ -474,7 +474,7 @@ subroutine DailyPRTAllometricCarbon(this,phase) ! Phase 1: Replace losses, push pools towards targets ! ----------------------------------------------------------------------------------- - if_phase: if(phase.eq.1) then + if_phase1: if(phase.eq.1) then ! III. Prioritize some amount of carbon to replace leaf/root turnover ! Make sure it isn't a negative payment, and either pay what is available @@ -544,6 +544,11 @@ subroutine DailyPRTAllometricCarbon(this,phase) end if + end if if_phase1 + + + if_phase12: if((phase==1) .or. (phase==2))then + ! ----------------------------------------------------------------------------------- ! V. If carbon is still available, prioritize some allocation to replace ! the rest of the leaf/fineroot deficit @@ -628,8 +633,9 @@ subroutine DailyPRTAllometricCarbon(this,phase) end if end if - - elseif( (phase.eq.2) .and. ( carbon_balance > calloc_abs_error )) then + end if if_phase12 + + if_phase3: if( (phase.eq.3) .and. ( carbon_balance > calloc_abs_error )) then ! ----------------------------------------------------------------------------------- ! VIII. If carbon is yet still available ... @@ -850,7 +856,7 @@ subroutine DailyPRTAllometricCarbon(this,phase) end do do_solve_check - end if if_phase + end if if_phase3 ! Track the net allocations and transport from this routine ! (the AgeLeaves() routine handled tracking allocation through aging) From dc3e5f433024c5a8e8f31352c834a2a3fb4f711f Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Fri, 16 Sep 2022 15:11:04 -0400 Subject: [PATCH 68/84] Subtle fixes to the allocation phasing and damage --- biogeochem/EDCohortDynamicsMod.F90 | 17 ++--------------- main/EDMainMod.F90 | 16 +++++----------- 2 files changed, 7 insertions(+), 26 deletions(-) diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index 2cf8b4a5f0..e43942b0b8 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -2341,24 +2341,11 @@ subroutine DamageRecovery(csite,cpatch,ccohort,newly_recovered) max_recover_nplant = available_m * ccohort%n / recovery_demand ! 4. Use the scalar to decide how many to recover - nplant_recover = min(nplant_recover,max(0._r8,max_recover_nplant * & - EDPftvarcon_inst%damage_recovery_scalar(ipft) )) + nplant_recover = min(nplant_recover,min(ccohort%n,max(0._r8,max_recover_nplant * & + EDPftvarcon_inst%damage_recovery_scalar(ipft) ))) end do - ! there is a special case where damage_recovery_scalar = 1, but - ! max_recover_nplant > n (i.e. there is more carbon than needed for all - ! individuals to recover to the next damage class. - ! in this case we can cheat, by making n_recover 0 and simply - ! allowing the donor cohort to recover and then go through - ! prt - will this work though? if they are not anywhere near allometry? - - if( abs(EDPftvarcon_inst%damage_recovery_scalar(ipft)-1._r8) < nearzero .and. & - nplant_recover > ccohort%n) then - nplant_recover = 0.0_r8 - ccohort%crowndamage = ccohort%crowndamage - 1 - end if - if(nplant_recover < nearzero) then newly_recovered = .false. diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index 847962fdb5..93970bc888 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -543,8 +543,12 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) ! The first phase of allocation. Both cohorts have the opportunity (if resources remain) ! to grow in stature (phase 2) - call currentCohort%prt%DailyPRT(phase=1) + if(.not.newly_recovered)then + call currentCohort%prt%DailyPRT(phase=1) + end if + call currentCohort%prt%DailyPRT(phase=2) + if((.not.newly_recovered) .and. (hlm_use_tree_damage .eq. itrue) ) then ! The loop order is shortest to tallest ! The recovered cohort (ie one with larger targets) @@ -555,20 +559,10 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) ! needed for diagnostics call DamageRecovery(currentSite,currentPatch,currentCohort,newly_recovered) - ! New targets may have been issued (based on damage status). If so, - ! we need to repeat phase 1 of allocation. This only happens if - ! the cohort is NOT split, and the whole thing graduates to a lesser - ! damage class - if(.not.newly_recovered)then - call currentCohort%prt%DailyPRT(phase=2) - end if - else newly_recovered = .false. end if - !print*,"CD:",currentcohort%crowndamage - call currentCohort%prt%DailyPRT(phase=3) ! Update the mass balance tracking for the daily nutrient uptake flux From d5e9ad456c475cb63313c673ee6af3721aad3e25 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Fri, 16 Sep 2022 15:17:21 -0400 Subject: [PATCH 69/84] Fixes, yet again, to allocation and phasing --- main/EDMainMod.F90 | 18 ++++++++---------- parteh/PRTAllometricCarbonMod.F90 | 4 ++-- 2 files changed, 10 insertions(+), 12 deletions(-) diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index 93970bc888..681645a71b 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -532,16 +532,14 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) ! ----------------------------------------------------------------------------- ! We split the allocation into phases (currently for all hypotheses) - ! In phase 1, allocation gets the mass of organs to match targets - ! In phase 2, allocation increases the mass of organs along with stature growth (dbh) - ! The reason why we split is to accomodate the damage code. Following phase 1, - ! we will allow the damage status of the cohorts to potentially recover, if they - ! have any left-over C/N/P resources. In this process, the cohort will be split - ! into two, each having a number count summing to the original. Where one cohort - ! will remain in the original damage class proceed with allocation, and the other - ! will reduce its damage class with new mass tarets. The latter will have to re-play - ! The first phase of allocation. Both cohorts have the opportunity (if resources remain) - ! to grow in stature (phase 2) + ! In phase 1, allocation, we address prioritized allocation that should + ! only happen once per day, this is only allocation that does not grow stature. + ! In phase 2, allocation , we address allocation that can be performed + ! as many times as necessary. This is allocation that does not contain stature + ! growth. This is separate from phase 1, because some recovering plants + ! will have new allocation targets that need to be updated after they change status. + ! In Phase 3, we assume that the plant has reached its targets, and any + ! left-over resources are used to grow the stature of the plant if(.not.newly_recovered)then call currentCohort%prt%DailyPRT(phase=1) diff --git a/parteh/PRTAllometricCarbonMod.F90 b/parteh/PRTAllometricCarbonMod.F90 index 53f20a1538..be4b2bbdff 100644 --- a/parteh/PRTAllometricCarbonMod.F90 +++ b/parteh/PRTAllometricCarbonMod.F90 @@ -547,7 +547,7 @@ subroutine DailyPRTAllometricCarbon(this,phase) end if if_phase1 - if_phase12: if((phase==1) .or. (phase==2))then + if_phase2: if(phase.eq.2)then ! ----------------------------------------------------------------------------------- ! V. If carbon is still available, prioritize some allocation to replace @@ -633,7 +633,7 @@ subroutine DailyPRTAllometricCarbon(this,phase) end if end if - end if if_phase12 + end if if_phase2 if_phase3: if( (phase.eq.3) .and. ( carbon_balance > calloc_abs_error )) then From 38d9f3292d8f097c0502e5745cbfa0dbb667f6aa Mon Sep 17 00:00:00 2001 From: Jessica F Needham Date: Fri, 16 Sep 2022 13:30:21 -0700 Subject: [PATCH 70/84] Changes to sapwood respiration to account for aboveground damage. --- biogeochem/DamageMainMod.F90 | 3 +- biogeophys/FatesPlantRespPhotosynthMod.F90 | 45 ++++++++++++++++++---- 2 files changed, 38 insertions(+), 10 deletions(-) diff --git a/biogeochem/DamageMainMod.F90 b/biogeochem/DamageMainMod.F90 index 41e32ef59d..227c97f795 100644 --- a/biogeochem/DamageMainMod.F90 +++ b/biogeochem/DamageMainMod.F90 @@ -156,8 +156,7 @@ subroutine GetDamageFrac(cc_cd, nc_cd, pft, dist_frac) integer, intent(in) :: pft real(r8), intent(out) :: dist_frac ! probability of current cohort moving to new damage level - dist_frac = param_derived%damage_transitions(cc_cd, nc_cd, pft) !* years_per_day - ! (if damage is occuring annually don't do this) + dist_frac = param_derived%damage_transitions(cc_cd, nc_cd, pft) end subroutine GetDamageFrac diff --git a/biogeophys/FatesPlantRespPhotosynthMod.F90 b/biogeophys/FatesPlantRespPhotosynthMod.F90 index e3286d7b00..7e9e29b5e5 100644 --- a/biogeophys/FatesPlantRespPhotosynthMod.F90 +++ b/biogeophys/FatesPlantRespPhotosynthMod.F90 @@ -248,10 +248,12 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) real(r8) :: agb_frac ! fraction of biomass aboveground real(r8) :: branch_frac ! fraction of aboveground woody biomass in branches real(r8) :: crown_reduction ! reduction in crown biomass from damage - real(r8) :: sapw_c_predamage ! pre damage sapwood - real(r8) :: sapw_n ! sapwood n - real(r8) :: sapw_n_predamage ! pre damage sapwood n - + real(r8) :: sapw_c_bgw ! belowground sapwood + real(r8) :: sapw_c_agw ! aboveground sapwood + real(r8) :: sapw_n ! sapwood nitrogen + real(r8) :: sapw_n_bgw ! nitrogen in belowground portion of sapwood + real(r8) :: sapw_n_agw ! nitrogen in aboveground portion of sapwood + ! ----------------------------------------------------------------------------------- ! Keeping these two definitions in case they need to be added later ! @@ -280,6 +282,8 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) ! Photosynthesis and stomatal conductance parameters, from: ! Bonan et al (2011) JGR, 116, doi:10.1029/2010JG001593 ! ----------------------------------------------------------------------------------- + + associate( & c3psn => EDPftvarcon_inst%c3psn , & @@ -653,15 +657,23 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) sapw_c = currentCohort%prt%GetState(sapw_organ, all_carbon_elements) fnrt_c = currentCohort%prt%GetState(fnrt_organ, all_carbon_elements) + if (hlm_use_tree_damage .eq. itrue) then + + ! Crown damage currenly only reduces the aboveground portion of + ! sapwood. Therefore we calculate the aboveground and the belowground portion + ! sapwood for use in stem respiration. agb_frac = prt_params%allom_agb_frac(currentCohort%pft) branch_frac = param_derived%branch_frac(currentCohort%pft) call GetCrownReduction(currentCohort%crowndamage, crown_reduction) - ! need the undamaged version if using ratios with roots - sapw_c = sapw_c / & + ! Undamaged below ground portion + sapw_c_bgw = sapw_c / & (1.0_r8 - (agb_frac * branch_frac * (1.0_r8-crown_reduction))) + ! Damaged aboveground portion + sapw_c_agw = sapw_c - sapw_c_bgw + end if @@ -669,10 +681,10 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) case (prt_carbon_allom_hyp) live_stem_n = prt_params%allom_agb_frac(currentCohort%pft) * & - sapw_c * prt_params%nitr_stoich_p1(ft,prt_params%organ_param_id(sapw_organ)) + sapw_c_agw * prt_params%nitr_stoich_p1(ft,prt_params%organ_param_id(sapw_organ)) live_croot_n = (1.0_r8-prt_params%allom_agb_frac(currentCohort%pft)) * & - sapw_c * prt_params%nitr_stoich_p1(ft,prt_params%organ_param_id(sapw_organ)) + sapw_c_bgw * prt_params%nitr_stoich_p1(ft,prt_params%organ_param_id(sapw_organ)) fnrt_n = fnrt_c * prt_params%nitr_stoich_p1(ft,prt_params%organ_param_id(fnrt_organ)) @@ -684,8 +696,25 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) live_croot_n = (1.0_r8-prt_params%allom_agb_frac(currentCohort%pft)) * & currentCohort%prt%GetState(sapw_organ, nitrogen_element) + fnrt_n = currentCohort%prt%GetState(fnrt_organ, nitrogen_element) + if (hlm_use_tree_damage .eq. itrue) then + + sapw_n = currentCohort%prt%GetState(sapw_organ, nitrogen_element) + + sapw_n_bgw = sapw_n / & + (1.0_r8 - (agb_frac * branch_frac * (1.0_r8 - crown_reduction))) + sapw_n_agw = sapw_n - sapw_n_bgw + + live_croot_n = (1.0_r8-prt_params%allom_agb_frac(currentCohort%pft)) * & + sapw_n_bgw + + live_stem_n = prt_params%allom_agb_frac(currentCohort%pft) * & + sapw_n_agw + + end if + ! If one wants to break coupling with dynamic N conentrations, ! use the stoichiometry parameter ! From 6fc3bef30fd454fa3859258069319ef475b6a058 Mon Sep 17 00:00:00 2001 From: Jessica F Needham Date: Sat, 17 Sep 2022 08:23:55 -0700 Subject: [PATCH 71/84] Fix the sapwood respiration bug --- biogeophys/FatesPlantRespPhotosynthMod.F90 | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/biogeophys/FatesPlantRespPhotosynthMod.F90 b/biogeophys/FatesPlantRespPhotosynthMod.F90 index 7e9e29b5e5..b4b3dabaa0 100644 --- a/biogeophys/FatesPlantRespPhotosynthMod.F90 +++ b/biogeophys/FatesPlantRespPhotosynthMod.F90 @@ -250,9 +250,11 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) real(r8) :: crown_reduction ! reduction in crown biomass from damage real(r8) :: sapw_c_bgw ! belowground sapwood real(r8) :: sapw_c_agw ! aboveground sapwood + real(r8) :: sapw_c_undamaged ! the target sapwood of an undamaged tree real(r8) :: sapw_n ! sapwood nitrogen real(r8) :: sapw_n_bgw ! nitrogen in belowground portion of sapwood real(r8) :: sapw_n_agw ! nitrogen in aboveground portion of sapwood + real(r8) :: sapw_n_undamaged ! nitrogen in sapwood of undamaged tree ! ----------------------------------------------------------------------------------- ! Keeping these two definitions in case they need to be added later @@ -668,9 +670,11 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) branch_frac = param_derived%branch_frac(currentCohort%pft) call GetCrownReduction(currentCohort%crowndamage, crown_reduction) - ! Undamaged below ground portion - sapw_c_bgw = sapw_c / & + sapw_c_undamaged = sapw_c / & (1.0_r8 - (agb_frac * branch_frac * (1.0_r8-crown_reduction))) + ! Undamaged below ground portion + sapw_c_bgw = sapw_c_undamaged * (1.0_r8 - agb_frac) + ! Damaged aboveground portion sapw_c_agw = sapw_c - sapw_c_bgw @@ -703,8 +707,10 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) sapw_n = currentCohort%prt%GetState(sapw_organ, nitrogen_element) - sapw_n_bgw = sapw_n / & + sapw_n_undamaged = sapw_n / & (1.0_r8 - (agb_frac * branch_frac * (1.0_r8 - crown_reduction))) + + sapw_n_bgw = sapw_n_undamaged * (1.0_r8 - agb_frac) sapw_n_agw = sapw_n - sapw_n_bgw live_croot_n = (1.0_r8-prt_params%allom_agb_frac(currentCohort%pft)) * & From c955cf182eb111a0ab9c5c7dedacd27e4fce76e2 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Tue, 20 Sep 2022 14:35:56 -0400 Subject: [PATCH 72/84] Slight update to allow FATES CNP to work with new phased allocation, albeit not compatible with tree damage --- parteh/PRTAllometricCNPMod.F90 | 20 ++++++++++++-------- 1 file changed, 12 insertions(+), 8 deletions(-) diff --git a/parteh/PRTAllometricCNPMod.F90 b/parteh/PRTAllometricCNPMod.F90 index 6170a7ae2e..d640797e6f 100644 --- a/parteh/PRTAllometricCNPMod.F90 +++ b/parteh/PRTAllometricCNPMod.F90 @@ -389,11 +389,12 @@ subroutine DailyPRTAllometricCNP(this,phase) real(r8) :: sum_c ! error checking sum - ! We do not use damage with parteh_mode 2, so just - ! do everything in phase 1 and short-circuit the phase 2 call - ! ---------------------------------------------------------- - if(phase.eq.2) return - + ! Right now FATES CNP is not compatable with tree damage + ! only simulate calls for phase 1 (ie call this once) + ! Compatability will be enabled with PR #880 + + if(phase>1)return + ! integrator variables @@ -511,6 +512,7 @@ subroutine DailyPRTAllometricCNP(this,phase) call endrun(msg=errMsg(sourcefile, __LINE__)) end if + ! =================================================================================== ! Step 2. Grow out the stature of the plant by allocating to tissues beyond ! current targets. @@ -626,7 +628,7 @@ end subroutine DailyPRTAllometricCNP ! ===================================================================================== - subroutine CNPPrioritizedReplacement(this, & + subroutine CNPPrioritizedReplacement(this, & maint_r_deficit, c_gain, n_gain, p_gain, & state_c, state_n, state_p, target_c) @@ -698,8 +700,11 @@ subroutine CNPPrioritizedReplacement(this, & ! If it is, then we track the variable ids associated with that pool for each CNP ! species. It "should" work fine if there are NO priority=1 pools... ! ----------------------------------------------------------------------------------- + + curpri_org(:) = fates_unset_int ! reset "current-priority" organ ids + i = 0 do ii = 1, num_organs @@ -843,9 +848,8 @@ subroutine CNPPrioritizedReplacement(this, & state_c(store_id)%ptr = state_c(store_id)%ptr + store_c_flux - end if + end if - ! ----------------------------------------------------------------------------------- ! If carbon is still available, allocate to remaining high ! carbon balance is guaranteed to be >=0 beyond this point From ae40104e214c8d797b2dc146f89da585bcc2b2d6 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Tue, 20 Sep 2022 14:41:38 -0400 Subject: [PATCH 73/84] Added user name checks for damage mode and parteh 2 --- main/FatesInterfaceMod.F90 | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index b73b378aa0..07b8375cdc 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -1536,6 +1536,14 @@ subroutine set_fates_ctrlparms(tag,ival,rval,cval) if(hlm_use_tree_damage .eq. unset_int) then write(fates_log(),*) 'FATES dimension/parameter unset: hlm_use_tree_damage, exiting' call endrun(msg=errMsg(sourcefile, __LINE__)) + else + if((hlm_use_tree_damage .eq. itrue) .and. & + (hlm_parteh_mode .eq. prt_cnp_flex_allom_hyp))then + write(fates_log(),*) 'FATES tree damage is not (yet) compatible with CNP allocation (fates_parteh_mode = 2)' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + end if if(hlm_nitrogen_spec .eq. unset_int) then From 2b064f02309c839b214a37917ec35104a1c51dff Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Tue, 20 Sep 2022 14:50:35 -0400 Subject: [PATCH 74/84] Updated error statement for fates cnp and tree damage --- main/FatesInterfaceMod.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 07b8375cdc..ea18390877 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -1539,7 +1539,8 @@ subroutine set_fates_ctrlparms(tag,ival,rval,cval) else if((hlm_use_tree_damage .eq. itrue) .and. & (hlm_parteh_mode .eq. prt_cnp_flex_allom_hyp))then - write(fates_log(),*) 'FATES tree damage is not (yet) compatible with CNP allocation (fates_parteh_mode = 2)' + write(fates_log(),*) 'FATES tree damage (use_fates_tree_damage = .true.) is not' + write(fates_log(),*) '(yet) compatible with CNP allocation (fates_parteh_mode = 2)' call endrun(msg=errMsg(sourcefile, __LINE__)) end if From f99840782a4b080ceba423cd5bfb1b2040a95624 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Tue, 20 Sep 2022 20:17:16 -0400 Subject: [PATCH 75/84] reverting nlevleaf --- main/EDTypesMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index e58fecdb25..071b54f424 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -54,7 +54,7 @@ module EDTypesMod integer, parameter, public :: idiffuse = 2 ! This is the array index for diffuse radiation ! parameters that govern the VAI (LAI+SAI) bins used in radiative transfer code - integer, parameter, public :: nlevleaf = 50 ! number of leaf+stem layers in canopy layer + integer, parameter, public :: nlevleaf = 30 ! number of leaf+stem layers in canopy layer real(r8), public :: dinc_vai(nlevleaf) = fates_unset_r8 ! VAI bin widths array real(r8), public :: dlower_vai(nlevleaf) = fates_unset_r8 ! lower edges of VAI bins From 35dad01912be6c823f5b461f042a56617bf2a88a Mon Sep 17 00:00:00 2001 From: Jessica F Needham Date: Thu, 22 Sep 2022 08:41:47 -0700 Subject: [PATCH 76/84] Changing how damage fraction is calculated to account for variable damage class widths --- biogeochem/DamageMainMod.F90 | 71 ++++++++++++++++--------------- main/FatesParameterDerivedMod.F90 | 18 +++++--- 2 files changed, 50 insertions(+), 39 deletions(-) diff --git a/biogeochem/DamageMainMod.F90 b/biogeochem/DamageMainMod.F90 index 227c97f795..cc336ec390 100644 --- a/biogeochem/DamageMainMod.F90 +++ b/biogeochem/DamageMainMod.F90 @@ -10,6 +10,7 @@ module DamageMainMod use shr_log_mod , only : errMsg => shr_log_errMsg use EDPftvarcon , only : EDPftvarcon_inst use EDParamsMod , only : damage_event_code + use EDParamsMod , only : ED_val_history_damage_bin_edges use EDTypesMod , only : ed_site_type use EDTypesMod , only : ed_patch_type use EDTypesMod , only : ed_cohort_type @@ -88,7 +89,7 @@ subroutine IsItDamageTime(is_master, currentSite) end if else if(icode .eq. 3) then - ! Damage event every day - not sure this is recommended as it will result in a very large + ! Damage event every day - this is not recommended as it will result in a very large ! number of cohorts damage_time = .true. @@ -100,6 +101,7 @@ subroutine IsItDamageTime(is_master, currentSite) else if(icode < 0 .and. icode > -366) then ! Damage event every year on a specific day of the year + ! specified as negative day of year if(hlm_day_of_year .eq. abs(icode) ) then damage_time = .true. end if @@ -120,7 +122,7 @@ subroutine IsItDamageTime(is_master, currentSite) ! Bad damage event flag write(fates_log(),*) 'An invalid damage code was specified in fates_params' write(fates_log(),*) 'Check DamageMainMod.F90:IsItDamageTime()' - write(fates_log(),*) 'for a breakdown of the valide codes and change' + write(fates_log(),*) 'for a breakdown of the valid codes and change' write(fates_log(),*) 'fates_damage_event_code in the file accordingly.' write(fates_log(),*) 'exiting' call endrun(msg=errMsg(sourcefile, __LINE__)) @@ -140,9 +142,9 @@ end subroutine IsItDamageTime subroutine GetDamageFrac(cc_cd, nc_cd, pft, dist_frac) - ! given current cohort damage class find the fraction of individuals + ! Given the current cohort damage class find the fraction of individuals ! going to the new damage class. - ! Consults a look up table of transitions from param derived. + ! This subroutine consults a look up table of transitions from param derived. ! USES use FatesInterfaceTypesMod, only : nlevdamage @@ -153,12 +155,12 @@ subroutine GetDamageFrac(cc_cd, nc_cd, pft, dist_frac) ! ARGUMENTS integer, intent(in) :: cc_cd ! current cohort crown damage integer, intent(in) :: nc_cd ! new cohort crown damage - integer, intent(in) :: pft - real(r8), intent(out) :: dist_frac ! probability of current cohort moving to new damage level + integer, intent(in) :: pft ! plant functional type + real(r8), intent(out) :: dist_frac ! probability of current cohort moving to + ! new damage level dist_frac = param_derived%damage_transitions(cc_cd, nc_cd, pft) - end subroutine GetDamageFrac !------------------------------------------------------- @@ -166,22 +168,17 @@ end subroutine GetDamageFrac subroutine GetCrownReduction(crowndamage, crown_reduction) !------------------------------------------------------------------ - ! This function takes the crown damage class of a cohort (integer) - ! and returns the fraction of the crown that is lost - ! Since crowndamage class = 1 means no damage, we subtract one - ! before multiplying by 0.2 - ! Therefore, first damage class is 20% loss of crown, second 40% etc. + ! This subroutine takes the crown damage class of a cohort (integer) + ! and returns the fraction of the crown that is lost. !------------------------------------------------------------------- - use FatesInterfaceTypesMod , only : nlevdamage - - integer(i4), intent(in) :: crowndamage - real(r8), intent(out) :: crown_reduction - ! local variables - real(r8) :: class_width + integer(i4), intent(in) :: crowndamage ! crown damage class of the cohort + real(r8), intent(out) :: crown_reduction ! fraction of crown lost from damage - class_width = 1.0_r8/nlevdamage - crown_reduction = min(1.0_r8, (real(crowndamage,r8) - 1.0_r8) * class_width) + crown_reduction = ED_val_history_damage_bin_edges(crowndamage)/100.0_r8 + + write(fates_log(),*) 'JN crowndamage', crowndamage + write(fates_log(),*) 'JN crownreduction', crown_reduction return end subroutine GetCrownReduction @@ -192,30 +189,36 @@ end subroutine GetCrownReduction subroutine GetDamageMortality(crowndamage,pft, dgmort) - use FatesInterfaceTypesMod , only : nlevdamage + !------------------------------------------------------------------ + ! This subroutine calculates damage-dependent mortality. + ! Not all damage related mortality will be captured by mechanisms in FATES + ! (e.g. carbon starvation mortality). Damage could also lead to damage + ! due to unrepresented mechanisms such as pathogens or increased + ! vulnerability to wind throws. This function captures mortality due to + ! those unrepresented mechanisms. + !------------------------------------------------------------------ + + + use FatesInterfaceTypesMod , only : nlevdamage use EDPftvarcon , only : EDPftvarcon_inst - integer(i4), intent(in) :: crowndamage - integer(i4), intent(in) :: pft - real(r8), intent(out) :: dgmort + integer(i4), intent(in) :: crowndamage ! crown damage class of the cohort + integer(i4), intent(in) :: pft ! plant functional type + real(r8), intent(out) :: dgmort ! mortality directly associated with damage ! local variables - real(r8) :: damage_mort_p1 - real(r8) :: damage_mort_p2 - real(r8) :: class_width - real(r8) :: crown_loss - - class_width = 1.0_r8/real(nlevdamage,r8) - - ! parameter to determine slope of exponential + real(r8) :: damage_mort_p1 ! inflection point of the damage mortalty relationship + real(r8) :: damage_mort_p2 ! rate parameter for the damage mortality relationship + real(r8) :: crown_loss ! fraction of crown lost + damage_mort_p1 = EDPftvarcon_inst%damage_mort_p1(pft) damage_mort_p2 = EDPftvarcon_inst%damage_mort_p2(pft) ! make damage mortality a function of crownloss and not crowndamage ! class so that it doesn't need to be re-parameterised if the number ! of damage classes change. - crown_loss = min(1.0_r8, (real(crowndamage,r8) - 1.0_r8) * class_width) - + crown_loss = ED_val_history_damage_bin_edges(crowndamage)/ 100.0_r8 + if (crowndamage .eq. 1 ) then dgmort = 0.0_r8 else diff --git a/main/FatesParameterDerivedMod.F90 b/main/FatesParameterDerivedMod.F90 index e63a361384..1a2ff4e856 100644 --- a/main/FatesParameterDerivedMod.F90 +++ b/main/FatesParameterDerivedMod.F90 @@ -15,7 +15,8 @@ module FatesParameterDerivedMod use FatesInterfaceTypesMod, only : nleafage use FatesInterfaceTypesMod, only : nlevdamage use FatesGlobals , only : fates_log - + use EDParamsMod , only : ED_val_history_damage_bin_edges + implicit none private @@ -141,7 +142,7 @@ subroutine InitDamageTransitions(this, numpft) integer :: ft ! pft index integer :: i ! crowndamage index real(r8) :: damage_frac ! damage fraction - + real(r8) :: class_widths ! widths of each damage class call this%InitAllocateDamageTransitions(numpft) @@ -153,12 +154,19 @@ subroutine InitDamageTransitions(this, numpft) ! zero the column this%damage_transitions(i,:,ft) = 0._r8 - ! 1 - damage rate stay the same + ! damage rate stays the same this%damage_transitions(i,i,ft) = 1.0_r8 - damage_frac + ! class widths + ! append 100 to ED_val_history_damage_bin_edges + ! gets class widths (something like below) + !class_widths = ED_val_history_damage_bin_edges(2:nlevdamage) - & + ! ED_val_history_damage_bin_edges(1:(nlevdamage-1)) + if(i < nlevdamage) then - ! fraction damaged get evenly split between higher damage classes - this%damage_transitions(i,i+1:nlevdamage,ft) = damage_frac/(nlevdamage - i) + ! fraction damaged get split according to class width +! this%damage_transitions(i,i+1:nlevdamage,ft) = damage_frac/ & + ! sum(class_widths(i+1:nlevdamage)) * class_widths(i+1:nlevdamage) end if ! Make sure it sums to one - they have to go somewhere this%damage_transitions(i, :, ft) = this%damage_transitions(i, :, ft)/SUM(this%damage_transitions(i, :, ft)) From bec8928c4ab01e634df7afdb242c992819c9ef4e Mon Sep 17 00:00:00 2001 From: Jessica F Needham Date: Fri, 23 Sep 2022 17:19:35 -0700 Subject: [PATCH 77/84] Tidy up some debugging print statements --- biogeochem/DamageMainMod.F90 | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/biogeochem/DamageMainMod.F90 b/biogeochem/DamageMainMod.F90 index cc336ec390..b56fd0363e 100644 --- a/biogeochem/DamageMainMod.F90 +++ b/biogeochem/DamageMainMod.F90 @@ -177,9 +177,6 @@ subroutine GetCrownReduction(crowndamage, crown_reduction) crown_reduction = ED_val_history_damage_bin_edges(crowndamage)/100.0_r8 - write(fates_log(),*) 'JN crowndamage', crowndamage - write(fates_log(),*) 'JN crownreduction', crown_reduction - return end subroutine GetCrownReduction @@ -217,7 +214,7 @@ subroutine GetDamageMortality(crowndamage,pft, dgmort) ! make damage mortality a function of crownloss and not crowndamage ! class so that it doesn't need to be re-parameterised if the number ! of damage classes change. - crown_loss = ED_val_history_damage_bin_edges(crowndamage)/ 100.0_r8 + crown_loss = ED_val_history_damage_bin_edges(crowndamage)/100.0_r8 if (crowndamage .eq. 1 ) then dgmort = 0.0_r8 From 3efa3d0e557e80a8520fe30bef550a3f84d5b2b2 Mon Sep 17 00:00:00 2001 From: Jessica F Needham Date: Mon, 26 Sep 2022 16:32:34 -0700 Subject: [PATCH 78/84] Fix damage transition matrix to account for flexible damage bins --- main/FatesParameterDerivedMod.F90 | 27 +++++++++++++++++++-------- 1 file changed, 19 insertions(+), 8 deletions(-) diff --git a/main/FatesParameterDerivedMod.F90 b/main/FatesParameterDerivedMod.F90 index 1a2ff4e856..0eacab293f 100644 --- a/main/FatesParameterDerivedMod.F90 +++ b/main/FatesParameterDerivedMod.F90 @@ -141,11 +141,27 @@ subroutine InitDamageTransitions(this, numpft) ! local variables integer :: ft ! pft index integer :: i ! crowndamage index + integer :: j ! damage bin index real(r8) :: damage_frac ! damage fraction - real(r8) :: class_widths ! widths of each damage class + real(r8), allocatable :: damage_bin_edges_ex(:) ! including the upper bound of 100 + real(r8), allocatable :: class_widths(:) ! widths of each damage class call this%InitAllocateDamageTransitions(numpft) + + allocate(class_widths(1:nlevdamage)) + allocate(damage_bin_edges_ex(1:(nlevdamage+1))) + ! class widths + ! append 100 to ED_val_history_damage_bin_edges + do j = 1,nlevdamage + damage_bin_edges_ex(j) = ED_val_history_damage_bin_edges(j) + end do + damage_bin_edges_ex(j) = 100.0_r8 + + ! gets class widths (something like below) + class_widths = damage_bin_edges_ex(2:(nlevdamage+1)) - & + damage_bin_edges_ex(1:nlevdamage) + do ft = 1, numpft damage_frac = EDPftvarcon_inst%damage_frac(ft) @@ -157,16 +173,11 @@ subroutine InitDamageTransitions(this, numpft) ! damage rate stays the same this%damage_transitions(i,i,ft) = 1.0_r8 - damage_frac - ! class widths - ! append 100 to ED_val_history_damage_bin_edges - ! gets class widths (something like below) - !class_widths = ED_val_history_damage_bin_edges(2:nlevdamage) - & - ! ED_val_history_damage_bin_edges(1:(nlevdamage-1)) if(i < nlevdamage) then ! fraction damaged get split according to class width -! this%damage_transitions(i,i+1:nlevdamage,ft) = damage_frac/ & - ! sum(class_widths(i+1:nlevdamage)) * class_widths(i+1:nlevdamage) + this%damage_transitions(i,i+1:nlevdamage,ft) = damage_frac * & + class_widths(i+1:nlevdamage)/ SUM(class_widths(i+1:nlevdamage)) end if ! Make sure it sums to one - they have to go somewhere this%damage_transitions(i, :, ft) = this%damage_transitions(i, :, ft)/SUM(this%damage_transitions(i, :, ft)) From 0251401c2926f6c4087673b2736913ff42ca9b0a Mon Sep 17 00:00:00 2001 From: Jessica F Needham Date: Mon, 26 Sep 2022 16:33:09 -0700 Subject: [PATCH 79/84] add crowndamage to allometry calls in EDPhysiologyMod --- biogeochem/EDPhysiologyMod.F90 | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index e9a28b63fd..7cdbc28ba4 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -1296,10 +1296,12 @@ subroutine phenology_leafonoff(currentSite) currentCohort%status_coh = leaves_on ! Leaves are on, so change status to ! stop flow of carbon out of bstore. - call bleaf(currentCohort%dbh,currentCohort%pft,currentCohort%canopy_trim,target_leaf_c) - call bsap_allom(currentCohort%dbh,currentCohort%pft, & + call bleaf(currentCohort%dbh,currentCohort%pft,currentCohort%crowndamage, & + currentCohort%canopy_trim,target_leaf_c) + call bsap_allom(currentCohort%dbh,currentCohort%pft,currentCohort%crowndamage, & currentCohort%canopy_trim,sapw_area,target_sapw_c) - call bagw_allom(currentCohort%dbh,currentCohort%pft,target_agw_c) + call bagw_allom(currentCohort%dbh,currentCohort%pft,currentCohort%crowndamage,& + target_agw_c) call bbgw_allom(currentCohort%dbh,currentCohort%pft,target_bgw_c) call bdead_allom( target_agw_c, target_bgw_c, target_sapw_c, & currentCohort%pft, target_struct_c) @@ -1400,11 +1402,12 @@ subroutine phenology_leafonoff(currentSite) currentCohort%status_coh = leaves_on ! Leaves are on, so change status to ! stop flow of carbon out of bstore. - call bleaf(currentCohort%dbh,currentCohort%pft,& + call bleaf(currentCohort%dbh,currentCohort%pft,currentCohort%crowndamage,& currentCohort%canopy_trim,target_leaf_c) - call bsap_allom(currentCohort%dbh,currentCohort%pft, & + call bsap_allom(currentCohort%dbh,currentCohort%pft,currentCohort%crowndamage,& currentCohort%canopy_trim,sapw_area,target_sapw_c) - call bagw_allom(currentCohort%dbh,currentCohort%pft,target_agw_c) + call bagw_allom(currentCohort%dbh,currentCohort%pft,currentCohort%crowndamage,& + target_agw_c) call bbgw_allom(currentCohort%dbh,currentCohort%pft,target_bgw_c) call bdead_allom( target_agw_c, target_bgw_c, target_sapw_c, & currentCohort%pft, target_struct_c) From de822e461e068e1f7f89285314123016fb29f450 Mon Sep 17 00:00:00 2001 From: Jessica F Needham Date: Mon, 26 Sep 2022 21:11:12 -0700 Subject: [PATCH 80/84] Update sapwood respiration to fix damage related bug --- biogeophys/FatesPlantRespPhotosynthMod.F90 | 18 +++++++----------- 1 file changed, 7 insertions(+), 11 deletions(-) diff --git a/biogeophys/FatesPlantRespPhotosynthMod.F90 b/biogeophys/FatesPlantRespPhotosynthMod.F90 index b4b3dabaa0..83971ba9f8 100644 --- a/biogeophys/FatesPlantRespPhotosynthMod.F90 +++ b/biogeophys/FatesPlantRespPhotosynthMod.F90 @@ -671,24 +671,22 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) call GetCrownReduction(currentCohort%crowndamage, crown_reduction) sapw_c_undamaged = sapw_c / & - (1.0_r8 - (agb_frac * branch_frac * (1.0_r8-crown_reduction))) + (1.0_r8 - (agb_frac * branch_frac * crown_reduction)) ! Undamaged below ground portion sapw_c_bgw = sapw_c_undamaged * (1.0_r8 - agb_frac) ! Damaged aboveground portion sapw_c_agw = sapw_c - sapw_c_bgw - + end if select case(hlm_parteh_mode) case (prt_carbon_allom_hyp) - live_stem_n = prt_params%allom_agb_frac(currentCohort%pft) * & - sapw_c_agw * prt_params%nitr_stoich_p1(ft,prt_params%organ_param_id(sapw_organ)) + live_stem_n = sapw_c_agw * prt_params%nitr_stoich_p1(ft,prt_params%organ_param_id(sapw_organ)) - live_croot_n = (1.0_r8-prt_params%allom_agb_frac(currentCohort%pft)) * & - sapw_c_bgw * prt_params%nitr_stoich_p1(ft,prt_params%organ_param_id(sapw_organ)) + live_croot_n = sapw_c_bgw * prt_params%nitr_stoich_p1(ft,prt_params%organ_param_id(sapw_organ)) fnrt_n = fnrt_c * prt_params%nitr_stoich_p1(ft,prt_params%organ_param_id(fnrt_organ)) @@ -708,16 +706,14 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) sapw_n = currentCohort%prt%GetState(sapw_organ, nitrogen_element) sapw_n_undamaged = sapw_n / & - (1.0_r8 - (agb_frac * branch_frac * (1.0_r8 - crown_reduction))) + (1.0_r8 - (agb_frac * branch_frac * crown_reduction)) sapw_n_bgw = sapw_n_undamaged * (1.0_r8 - agb_frac) sapw_n_agw = sapw_n - sapw_n_bgw - live_croot_n = (1.0_r8-prt_params%allom_agb_frac(currentCohort%pft)) * & - sapw_n_bgw + live_croot_n = sapw_n_bgw - live_stem_n = prt_params%allom_agb_frac(currentCohort%pft) * & - sapw_n_agw + live_stem_n = sapw_n_agw end if From e5b012122c03ba71590ec100d47a5fb20fbaa1e0 Mon Sep 17 00:00:00 2001 From: Jessica F Needham Date: Mon, 3 Oct 2022 17:04:45 -0700 Subject: [PATCH 81/84] Tidy comments on damage code --- biogeochem/DamageMainMod.F90 | 14 +++++--------- biogeochem/EDCohortDynamicsMod.F90 | 10 +++------- biogeochem/EDPhysiologyMod.F90 | 2 +- 3 files changed, 9 insertions(+), 17 deletions(-) diff --git a/biogeochem/DamageMainMod.F90 b/biogeochem/DamageMainMod.F90 index b56fd0363e..f0a05f7ee6 100644 --- a/biogeochem/DamageMainMod.F90 +++ b/biogeochem/DamageMainMod.F90 @@ -76,7 +76,7 @@ subroutine IsItDamageTime(is_master, currentSite) damage_time = .false. icode = int(damage_event_code) - model_day_int = nint(hlm_model_day) + model_day_int = int(hlm_model_day) if(icode .eq. 1) then ! Damage is turned off @@ -90,7 +90,7 @@ subroutine IsItDamageTime(is_master, currentSite) else if(icode .eq. 3) then ! Damage event every day - this is not recommended as it will result in a very large - ! number of cohorts + ! number of cohorts which will likely be terminated damage_time = .true. else if(icode .eq. 4) then @@ -147,8 +147,6 @@ subroutine GetDamageFrac(cc_cd, nc_cd, pft, dist_frac) ! This subroutine consults a look up table of transitions from param derived. ! USES - use FatesInterfaceTypesMod, only : nlevdamage - use FatesConstantsMod, only : years_per_day use FatesParameterDerivedMod, only : param_derived @@ -156,7 +154,7 @@ subroutine GetDamageFrac(cc_cd, nc_cd, pft, dist_frac) integer, intent(in) :: cc_cd ! current cohort crown damage integer, intent(in) :: nc_cd ! new cohort crown damage integer, intent(in) :: pft ! plant functional type - real(r8), intent(out) :: dist_frac ! probability of current cohort moving to + real(r8), intent(out) :: dist_frac ! fraction of current cohort moving to ! new damage level dist_frac = param_derived%damage_transitions(cc_cd, nc_cd, pft) @@ -167,10 +165,10 @@ end subroutine GetDamageFrac subroutine GetCrownReduction(crowndamage, crown_reduction) - !------------------------------------------------------------------ + !------------------------------------------------------------------ ! This subroutine takes the crown damage class of a cohort (integer) ! and returns the fraction of the crown that is lost. - !------------------------------------------------------------------- + !------------------------------------------------------------------- integer(i4), intent(in) :: crowndamage ! crown damage class of the cohort real(r8), intent(out) :: crown_reduction ! fraction of crown lost from damage @@ -195,8 +193,6 @@ subroutine GetDamageMortality(crowndamage,pft, dgmort) ! those unrepresented mechanisms. !------------------------------------------------------------------ - - use FatesInterfaceTypesMod , only : nlevdamage use EDPftvarcon , only : EDPftvarcon_inst integer(i4), intent(in) :: crowndamage ! crown damage class of the cohort diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index e4777ee86d..5e77496713 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -103,7 +103,6 @@ Module EDCohortDynamicsMod use PRTAllometricCNPMod, only : acnp_bc_out_id_pefflux, acnp_bc_in_id_cdamage use PRTAllometricCNPMod, only : acnp_bc_out_id_nneed use PRTAllometricCNPMod, only : acnp_bc_out_id_pneed - use DamageMainMod, only : GetCrownReduction use DamageMainMod, only : undamaged_class use shr_infnan_mod, only : nan => shr_infnan_nan, assignment(=) @@ -2055,7 +2054,6 @@ subroutine EvaluateAndCorrectDBH(currentCohort,delta_dbh,delta_hite) ! consistent with stuctural biomass (or, in the case of grasses, leaf biomass) ! then correct (increase) the dbh to match that. ! ----------------------------------------------------------------------------------- - use DamageMainMod, only : GetCrownReduction ! argument type(ed_cohort_type),intent(inout) :: currentCohort @@ -2161,7 +2159,7 @@ subroutine DamageRecovery(csite,cpatch,ccohort,newly_recovered) ! locals type(ed_cohort_type), pointer :: rcohort ! New cohort that recovers by - ! having an lower damage class + ! having a lower damage class real(r8) :: sapw_area ! sapwood area real(r8) :: target_sapw_c,target_sapw_m ! sapwood mass, C and N/P real(r8) :: target_agw_c ! target above ground wood @@ -2178,7 +2176,7 @@ subroutine DamageRecovery(csite,cpatch,ccohort,newly_recovered) real(r8) :: available_m ! available mass that can be used to ! improve damage class real(r8) :: recovery_demand ! amount of mass needed to get to - ! get to the target of the next damage class + ! the target of the next damage class real(r8) :: max_recover_nplant ! max number of plants that could get to ! target of next class real(r8) :: nplant_recover ! number of plants in cohort that will @@ -2336,9 +2334,7 @@ subroutine DamageRecovery(csite,cpatch,ccohort,newly_recovered) ! Need to adjust the crown area which is NOT on a per individual basis call carea_allom(dbh,rcohort%n,csite%spread,ipft,rcohort%crowndamage,rcohort%c_area) - !rcohort%n/n_old * ccohort%c_area - !ccohort%c_area = ccohort%c_area - rcohort%c_area - + ! Update properties of the un-recovered (donor) cohort ccohort%n = ccohort%n - rcohort%n ccohort%c_area = ccohort%c_area * ccohort%n / (ccohort%n+rcohort%n) diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 7cdbc28ba4..d86a4fe2e6 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -211,7 +211,7 @@ subroutine GenerateDamageAndLitterFluxes( csite, cpatch, bc_in ) ! Locals type(ed_cohort_type), pointer :: ccohort ! Current cohort - type(ed_cohort_type), pointer :: ndcohort ! Newly damage-class cohort + type(ed_cohort_type), pointer :: ndcohort ! New damage-class cohort type(litter_type), pointer :: litt ! Points to the litter object type(site_fluxdiags_type), pointer :: flux_diags ! pointer to site level flux diagnostics object integer :: cd ! Damage class index From 9dddd746ec3983a495088f8c394ffef9eb2dc16c Mon Sep 17 00:00:00 2001 From: Gregory Lemieux <7565064+glemieux@users.noreply.github.com> Date: Mon, 24 Oct 2022 14:53:48 -0700 Subject: [PATCH 82/84] Update biogeophys/FatesPlantRespPhotosynthMod.F90 Refactor damage check to enable the use of `sap_c_` variables regardless of run mode --- biogeophys/FatesPlantRespPhotosynthMod.F90 | 23 +++++++++++----------- 1 file changed, 12 insertions(+), 11 deletions(-) diff --git a/biogeophys/FatesPlantRespPhotosynthMod.F90 b/biogeophys/FatesPlantRespPhotosynthMod.F90 index 83971ba9f8..5dd700e77f 100644 --- a/biogeophys/FatesPlantRespPhotosynthMod.F90 +++ b/biogeophys/FatesPlantRespPhotosynthMod.F90 @@ -665,20 +665,21 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) ! Crown damage currenly only reduces the aboveground portion of ! sapwood. Therefore we calculate the aboveground and the belowground portion ! sapwood for use in stem respiration. - - agb_frac = prt_params%allom_agb_frac(currentCohort%pft) - branch_frac = param_derived%branch_frac(currentCohort%pft) call GetCrownReduction(currentCohort%crowndamage, crown_reduction) - - sapw_c_undamaged = sapw_c / & + + else + crown_reduction = 0.0_r8 + end if + + agb_frac = prt_params%allom_agb_frac(currentCohort%pft) + branch_frac = param_derived%branch_frac(currentCohort%pft) + sapw_c_undamaged = sapw_c / & (1.0_r8 - (agb_frac * branch_frac * crown_reduction)) - ! Undamaged below ground portion - sapw_c_bgw = sapw_c_undamaged * (1.0_r8 - agb_frac) + ! Undamaged below ground portion + sapw_c_bgw = sapw_c_undamaged * (1.0_r8 - agb_frac) - ! Damaged aboveground portion - sapw_c_agw = sapw_c - sapw_c_bgw - - end if + ! Damaged aboveground portion + sapw_c_agw = sapw_c - sapw_c_bgw select case(hlm_parteh_mode) From ab4e75b5b06a49a46d43c8e73998a30461a64f9d Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Mon, 24 Oct 2022 15:06:49 -0700 Subject: [PATCH 83/84] fix whitespace and add comment --- biogeophys/FatesPlantRespPhotosynthMod.F90 | 25 +++++++++++----------- 1 file changed, 13 insertions(+), 12 deletions(-) diff --git a/biogeophys/FatesPlantRespPhotosynthMod.F90 b/biogeophys/FatesPlantRespPhotosynthMod.F90 index 5dd700e77f..4b8d34f664 100644 --- a/biogeophys/FatesPlantRespPhotosynthMod.F90 +++ b/biogeophys/FatesPlantRespPhotosynthMod.F90 @@ -667,19 +667,20 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) ! sapwood for use in stem respiration. call GetCrownReduction(currentCohort%crowndamage, crown_reduction) - else - crown_reduction = 0.0_r8 - end if + else + crown_reduction = 0.0_r8 + end if - agb_frac = prt_params%allom_agb_frac(currentCohort%pft) - branch_frac = param_derived%branch_frac(currentCohort%pft) - sapw_c_undamaged = sapw_c / & - (1.0_r8 - (agb_frac * branch_frac * crown_reduction)) - ! Undamaged below ground portion - sapw_c_bgw = sapw_c_undamaged * (1.0_r8 - agb_frac) - - ! Damaged aboveground portion - sapw_c_agw = sapw_c - sapw_c_bgw + ! If crown reduction is zero, undamaged sapwood target will equal sapwood carbon + agb_frac = prt_params%allom_agb_frac(currentCohort%pft) + branch_frac = param_derived%branch_frac(currentCohort%pft) + sapw_c_undamaged = sapw_c / (1.0_r8 - (agb_frac * branch_frac * crown_reduction)) + + ! Undamaged below ground portion + sapw_c_bgw = sapw_c_undamaged * (1.0_r8 - agb_frac) + + ! Damaged aboveground portion + sapw_c_agw = sapw_c - sapw_c_bgw select case(hlm_parteh_mode) From b1e4a1a0e047ec298216460b91b940994402df3f Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Mon, 24 Oct 2022 15:38:10 -0700 Subject: [PATCH 84/84] add debug check --- main/FatesParameterDerivedMod.F90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/main/FatesParameterDerivedMod.F90 b/main/FatesParameterDerivedMod.F90 index 0eacab293f..aa1584feb0 100644 --- a/main/FatesParameterDerivedMod.F90 +++ b/main/FatesParameterDerivedMod.F90 @@ -46,6 +46,8 @@ module FatesParameterDerivedMod type(param_derived_type), public :: param_derived + logical :: debug = .false. ! for module level debugging + contains ! =================================================================================== @@ -183,7 +185,7 @@ subroutine InitDamageTransitions(this, numpft) this%damage_transitions(i, :, ft) = this%damage_transitions(i, :, ft)/SUM(this%damage_transitions(i, :, ft)) end do - write(fates_log(),'(a/,5(F12.6,1x))') 'annual transition matrix : ', this%damage_transitions(:,:,ft) + if (debug) write(fates_log(),'(a/,5(F12.6,1x))') 'annual transition matrix : ', this%damage_transitions(:,:,ft) end do