diff --git a/.gitattributes b/.gitattributes new file mode 100644 index 0000000000..e140598ee0 --- /dev/null +++ b/.gitattributes @@ -0,0 +1,28 @@ +# ----------------------------------------------------------------------------------------------------- +# Repo-wide git configuration file +# +# This file overrides the configurations specified below for all git users that have cloned this repo. +# This is primarily being implemented to allow users to develop code with any operating system (OS) +# preferred and mitigates potential problems with end of line (eol) character differences. +# ----------------------------------------------------------------------------------------------------- + +## Set the default end of line behavior (i.e. normalization to `lf` upon commit) for all files git recognizes as text +* text=auto + +# Note that the above *only* applies to newly commited files. If the file previously existed with a `crlf` end of file +# and was checked out to local, then git will not change the eol character during check-in (i.e. commit). For +# windows users they will see a warning like this: +# warning: CRLF will be replaced by LF in functional_unit_testing/allometry/drive_allomtests.py. +# The file will have its original line endings in your working directory + +## Explicitly declare to git which files should be normalized (i.e. treated as text files) +*.cdl text +*.F90 text +*.F90_in text +*.py text +*.sh text +*.txt text +*.xml text + +## Declare to git which file types are binary files and should not have end of line modified +*.mod binary \ No newline at end of file diff --git a/.gitignore b/.gitignore index 7ee0dc8765..40f2a49386 100644 --- a/.gitignore +++ b/.gitignore @@ -48,4 +48,6 @@ Thumbs.db # Old Files -*~ \ No newline at end of file +*~ +# Editor specific setting files +*.vscode \ No newline at end of file diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index ee13cdeb1d..b7aa26a795 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -21,6 +21,10 @@ Those who wish to contribute code to FATES must have those changes integrated th * It is best to create an issue to describe the work you are undertaking prior to starting. This helps the community sync with your efforts, prevents duplication of efforts, and science is not done in a vaccuum! * Expect peers to interact, help, discuss and eventually approve your submission (pull-request) +## Joining Discussions and Meetings + +In addition to the github discussions, we hold a roughly biweekly call, which covers both scientific and technical issues related to FATES. We use a google group to organize, schedule, and discuss these calls. Emails to the list are moderated and we try to be pretty ruthless about preventing anything other than this topic from appearing on it. To join, apply to the group here: https://groups.google.com/forum/#!forum/fates_model + ## Things to Remember * Make commits in logical units (i.e. group changes) diff --git a/LICENSE.txt b/LICENSE.txt index be5cae20af..3adb025dca 100644 --- a/LICENSE.txt +++ b/LICENSE.txt @@ -1,6 +1,6 @@ Functionally Assembled Terrestrial Ecosystem Simulator (“FATES”) -Copyright (c) 2016-2018, The Regents of the University of California, through Lawrence +Copyright (c) 2016-2020, The Regents of the University of California, through Lawrence Berkeley National Laboratory, University Corporation for Atmospheric Research, Los Alamos National Security, LLC (LANS), as operator of Los Alamos National Laboratory (LANL), and President and Fellows of Harvard College. All rights reserved. diff --git a/biogeochem/EDCanopyStructureMod.F90 b/biogeochem/EDCanopyStructureMod.F90 index 8dd5e139c1..bfa50250a9 100644 --- a/biogeochem/EDCanopyStructureMod.F90 +++ b/biogeochem/EDCanopyStructureMod.F90 @@ -14,10 +14,12 @@ module EDCanopyStructureMod use EDPftvarcon , only : EDPftvarcon_inst use FatesAllometryMod , only : carea_allom use EDCohortDynamicsMod , only : copy_cohort, terminate_cohorts, fuse_cohorts - use EDCohortDynamicsMod , only : InitPRTCohort + use EDCohortDynamicsMod , only : InitPRTObject + use EDCohortDynamicsMod , only : InitPRTBoundaryConditions + use EDCohortDynamicsMod , only : SendCohortToLitter use FatesAllometryMod , only : tree_lai use FatesAllometryMod , only : tree_sai - use EDtypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type, ncwd + use EDtypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type use EDTypesMod , only : nclmax use EDTypesMod , only : nlevleaf use EDtypesMod , only : AREA @@ -117,9 +119,7 @@ subroutine canopy_structure( currentSite , bc_in ) ! !USES: use EDParamsMod, only : ED_val_comp_excln - use EDtypesMod , only : ncwd use EDTypesMod , only : min_patch_area - use EDTypesMod , only : val_check_ed_vars use FatesInterfaceMod, only : bc_in_type ! ! !ARGUMENTS @@ -193,7 +193,7 @@ subroutine canopy_structure( currentSite , bc_in ) ! Its possible that before we even enter this scheme ! some cohort numbers are very low. Terminate them. - call terminate_cohorts(currentSite, currentPatch, 1) + call terminate_cohorts(currentSite, currentPatch, 1, 12) ! Calculate how many layers we have in this canopy ! This also checks the understory to see if its crown @@ -206,12 +206,12 @@ subroutine canopy_structure( currentSite , bc_in ) ! After demotions, we may then again have cohorts that are very very ! very sparse, remove them - call terminate_cohorts(currentSite, currentPatch, 1) + call terminate_cohorts(currentSite, currentPatch, 1,13) call fuse_cohorts(currentSite, currentPatch, bc_in) ! Remove cohorts for various other reasons - call terminate_cohorts(currentSite, currentPatch, 2) + call terminate_cohorts(currentSite, currentPatch, 2,13) ! --------------------------------------------------------------------------------------- @@ -230,12 +230,12 @@ subroutine canopy_structure( currentSite , bc_in ) end do ! Remove cohorts that are incredibly sparse - call terminate_cohorts(currentSite, currentPatch, 1) + call terminate_cohorts(currentSite, currentPatch, 1,14) call fuse_cohorts(currentSite, currentPatch, bc_in) ! Remove cohorts for various other reasons - call terminate_cohorts(currentSite, currentPatch, 2) + call terminate_cohorts(currentSite, currentPatch, 2,14) end if @@ -331,7 +331,6 @@ end subroutine canopy_structure subroutine DemoteFromLayer(currentSite,currentPatch,i_lyr) use EDParamsMod, only : ED_val_comp_excln - use EDtypesMod , only : ncwd use SFParamsMod, only : SF_val_CWD_frac ! !ARGUMENTS @@ -658,11 +657,17 @@ subroutine DemoteFromLayer(currentSite,currentPatch,i_lyr) allocate(copyc) - call InitPRTCohort(copyc) + ! Initialize the PARTEH object and point to the + ! correct boundary condition fields + copyc%prt => null() + call InitPRTObject(copyc%prt) + call InitPRTBoundaryConditions(copyc) + if( hlm_use_planthydro.eq.itrue ) then call InitHydrCohort(currentSite,copyc) endif - call copy_cohort(currentCohort, copyc) + + call copy_cohort(currentCohort, copyc) newarea = currentCohort%c_area - cc_loss copyc%n = currentCohort%n*newarea/currentCohort%c_area @@ -708,50 +713,10 @@ subroutine DemoteFromLayer(currentSite,currentPatch,i_lyr) if(currentCohort%canopy_layer>nclmax )then - ! put the litter from the terminated cohorts into the fragmenting pools - do i_cwd=1,ncwd - - currentPatch%CWD_AG(i_cwd) = currentPatch%CWD_AG(i_cwd) + & - (struct_c + sapw_c ) * & - EDPftvarcon_inst%allom_agb_frac(currentCohort%pft) * & - SF_val_CWD_frac(i_cwd)*currentCohort%n/currentPatch%area - - currentPatch%CWD_BG(i_cwd) = currentPatch%CWD_BG(i_cwd) + & - (struct_c + sapw_c) * & - (1.0_r8-EDPftvarcon_inst%allom_agb_frac(currentCohort%pft)) * & - SF_val_CWD_frac(i_cwd)*currentCohort%n/currentPatch%area !litter flux per m2. - - enddo - - currentPatch%leaf_litter(currentCohort%pft) = & - currentPatch%leaf_litter(currentCohort%pft) + & - leaf_c * currentCohort%n/currentPatch%area ! leaf litter flux per m2. - - currentPatch%root_litter(currentCohort%pft) = & - currentPatch%root_litter(currentCohort%pft) + & - (fnrt_c + store_c) * currentCohort%n/currentPatch%area - - ! keep track of the above fluxes at the site level as a - ! CWD/litter input flux (in kg / site-m2 / yr) - do i_cwd=1,ncwd - currentSite%CWD_AG_diagnostic_input_carbonflux(i_cwd) = & - currentSite%CWD_AG_diagnostic_input_carbonflux(i_cwd) & - + currentCohort%n * (struct_c + sapw_c) * & - SF_val_CWD_frac(i_cwd) * EDPftvarcon_inst%allom_agb_frac(currentCohort%pft) & - * hlm_days_per_year / AREA - currentSite%CWD_BG_diagnostic_input_carbonflux(i_cwd) = & - currentSite%CWD_BG_diagnostic_input_carbonflux(i_cwd) & - + currentCohort%n * (struct_c + sapw_c) * & - SF_val_CWD_frac(i_cwd) * (1.0_r8 - & - EDPftvarcon_inst%allom_agb_frac(currentCohort%pft)) * hlm_days_per_year / AREA - enddo - - currentSite%leaf_litter_diagnostic_input_carbonflux(currentCohort%pft) = & - currentSite%leaf_litter_diagnostic_input_carbonflux(currentCohort%pft) + & - currentCohort%n * leaf_c * hlm_days_per_year / AREA - currentSite%root_litter_diagnostic_input_carbonflux(currentCohort%pft) = & - currentSite%root_litter_diagnostic_input_carbonflux(currentCohort%pft) + & - currentCohort%n * (fnrt_c + store_c) * hlm_days_per_year / AREA + ! put the litter from the terminated cohorts + ! straight into the fragmenting pools + call SendCohortToLitter(currentSite,currentPatch, & + currentCohort,currentCohort%n) currentCohort%n = 0.0_r8 currentCohort%c_area = 0.0_r8 @@ -1145,7 +1110,12 @@ subroutine PromoteIntoLayer(currentSite,currentPatch,i_lyr) allocate(copyc) - call InitPRTCohort(copyc) + ! Initialize the PARTEH object and point to the + ! correct boundary condition fields + copyc%prt => null() + call InitPRTObject(copyc%prt) + call InitPRTBoundaryConditions(copyc) + if( hlm_use_planthydro.eq.itrue ) then call InitHydrCohort(CurrentSite,copyc) endif @@ -1287,8 +1257,6 @@ subroutine canopy_summarization( nsites, sites, bc_in ) use FatesInterfaceMod , only : bc_in_type use EDPatchDynamicsMod , only : set_patchno - use FatesAllometryMod , only : set_root_fraction - use FatesAllometryMod , only : i_hydro_rootprof_context use FatesSizeAgeTypeIndicesMod, only : sizetype_class_index use EDtypesMod , only : area use EDPftvarcon , only : EDPftvarcon_inst @@ -1330,18 +1298,6 @@ subroutine canopy_summarization( nsites, sites, bc_in ) do while(associated(currentPatch)) - ! Calculate rooting depth fractions for the patch x pft - ! Note that we are calling for the root fractions in the hydrologic context. - ! See explanation in FatesAllometryMod. In other locations, this - ! function is called to return the profile of biomass as used for litter - - do ft = 1, numpft - call set_root_fraction(currentPatch%rootfr_ft(ft,1:bc_in(s)%nlevsoil), ft, & - bc_in(s)%zi_sisl,lowerb=lbound(bc_in(s)%zi_sisl,1), & - icontext=i_hydro_rootprof_context) - end do - - !zero cohort-summed variables. currentPatch%total_canopy_area = 0.0_r8 currentPatch%total_tree_area = 0.0_r8 diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index 97cb1cc218..5da20187a4 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -17,21 +17,25 @@ module EDCohortDynamicsMod use FatesConstantsMod , only : calloc_abs_error use FatesInterfaceMod , only : hlm_days_per_year use FatesInterfaceMod , only : nleafage + use SFParamsMod , only : SF_val_CWD_frac use EDPftvarcon , only : EDPftvarcon_inst + use EDPftvarcon , only : GetDecompyFrac use FatesParameterDerivedMod, only : param_derived use EDTypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type use EDTypesMod , only : nclmax - use EDTypesMod , only : ncwd + use EDTypesMod , only : element_list + use FatesLitterMod , only : ncwd + use FatesLitterMod , only : ndcmpy + use FatesLitterMod , only : litter_type use EDTypesMod , only : maxCohortsPerPatch use EDTypesMod , only : AREA use EDTypesMod , only : min_npm2, min_nppatch use EDTypesMod , only : min_n_safemath use EDTypesMod , only : nlevleaf - use EDTypesMod , only : equal_leaf_aclass - use EDTypesMod , only : first_leaf_aclass - use EDTypesMod , only : nan_leaf_aclass use EDTypesMod , only : max_nleafage use EDTypesMod , only : ican_upper + use EDTypesMod , only : site_fluxdiags_type + use EDTypesMod , only : num_elements use FatesInterfaceMod , only : hlm_use_planthydro use FatesInterfaceMod , only : hlm_parteh_mode use FatesPlantHydraulicsMod, only : FuseCohortHydraulics @@ -56,15 +60,15 @@ module EDCohortDynamicsMod use FatesAllometryMod , only : carea_allom use FatesAllometryMod , only : ForceDBH use FatesAllometryMod , only : tree_lai, tree_sai - + use FatesAllometryMod , only : i_biomass_rootprof_context + use FatesAllometryMod , only : set_root_fraction use PRTGenericMod, only : prt_carbon_allom_hyp use PRTGenericMod, only : prt_cnp_flex_allom_hyp - use PRTGenericMod, only : InitPRTVartype use PRTGenericMod, only : prt_vartypes use PRTGenericMod, only : all_carbon_elements use PRTGenericMod, only : carbon12_element use PRTGenericMod, only : nitrogen_element - use PRTGenericMod, only : phosphorous_element + use PRTGenericMod, only : phosphorus_element use PRTGenericMod, only : leaf_organ use PRTGenericMod, only : fnrt_organ use PRTGenericMod, only : sapw_organ @@ -78,7 +82,10 @@ module EDCohortDynamicsMod use PRTAllometricCarbonMod, only : ac_bc_in_id_pft 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 PRTAllometricCNPMod, only : cnp_allom_prt_vartypes + use shr_infnan_mod, only : nan => shr_infnan_nan, assignment(=) ! CIME globals @@ -96,8 +103,11 @@ module EDCohortDynamicsMod public :: sort_cohorts public :: copy_cohort public :: count_cohorts - public :: InitPRTCohort + public :: InitPRTObject + public :: InitPRTBoundaryConditions + public :: SendCohortToLitter public :: UpdateCohortBioPhysRates + public :: DeallocateCohort public :: EvaluateAndCorrectDBH logical, parameter :: debug = .false. ! local debug flag @@ -118,9 +128,9 @@ module EDCohortDynamicsMod !-------------------------------------------------------------------------------------! - subroutine create_cohort(currentSite, patchptr, pft, nn, hite, dbh, bleaf, bfineroot, & - bsap, bdead, bstore, laimemory, status, recruitstatus,ctrim, & - clayer, spread, leaf_aclass_init, bc_in) + subroutine create_cohort(currentSite, patchptr, pft, nn, hite, dbh, & + prt, laimemory, sapwmemory, structmemory, & + status, recruitstatus, ctrim, clayer, spread, bc_in) ! ! !DESCRIPTION: @@ -139,41 +149,39 @@ subroutine create_cohort(currentSite, patchptr, pft, nn, hite, dbh, bleaf, bfine type(ed_site_type), intent(inout), target :: currentSite type(ed_patch_type), intent(inout), pointer :: patchptr - integer, intent(in) :: pft ! Cohort Plant Functional Type - 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) - integer, intent(in) :: recruitstatus ! recruit status of plant - ! (1 = recruitment , 0 = other) - real(r8), intent(in) :: nn ! number of individuals in cohort - ! per 'area' (10000m2 default) - real(r8), intent(in) :: hite ! height: meters - real(r8), intent(in) :: dbh ! dbh: cm - real(r8), intent(in) :: bleaf ! biomass in leaves: kgC - real(r8), intent(in) :: bfineroot ! biomass in fineroots: kgC - real(r8), intent(in) :: bsap ! biomass in sapwood: kgC - real(r8), intent(in) :: bdead ! total dead biomass: kGC per indiv - real(r8), intent(in) :: bstore ! stored carbon: kGC per indiv - real(r8), intent(in) :: laimemory ! target leaf biomass- set from - ! previous year: kGC per indiv - real(r8), intent(in) :: ctrim ! What is the fraction of the maximum - ! leaf biomass that we are targeting? - real(r8), intent(in) :: spread ! The community assembly effects how - ! spread crowns are in horizontal space - integer, intent(in) :: leaf_aclass_init ! how to initialized the leaf age class - ! distribution - integer :: iage ! loop counter for leaf age classes - type(bc_in_type), intent(in) :: bc_in ! External boundary conditions + integer, intent(in) :: pft ! Cohort Plant Functional Type + 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) + integer, intent(in) :: recruitstatus ! recruit status of plant + ! (1 = recruitment , 0 = other) + real(r8), intent(in) :: nn ! number of individuals in cohort + ! per 'area' (10000m2 default) + real(r8), intent(in) :: hite ! height: meters + real(r8), intent(in) :: dbh ! dbh: cm + class(prt_vartypes),target :: prt ! The allocated PARTEH + ! object + real(r8), intent(in) :: laimemory ! target leaf biomass- set from + ! previous year: kGC per indiv + real(r8), intent(in) :: sapwmemory ! target sapwood biomass- set from + ! previous year: kGC per indiv + real(r8), intent(in) :: structmemory ! target structural biomass- set from + ! previous year: kGC per indiv + real(r8), intent(in) :: ctrim ! What is the fraction of the maximum + ! leaf biomass that we are targeting? + real(r8), intent(in) :: spread ! The community assembly effects how + ! spread crowns are in horizontal space + type(bc_in_type), intent(in) :: bc_in ! External boundary conditions - ! ! !LOCAL VARIABLES: type(ed_cohort_type), pointer :: new_cohort ! Pointer to New Cohort structure. type(ed_cohort_type), pointer :: storesmallcohort - type(ed_cohort_type), pointer :: storebigcohort - real(r8) :: frac_leaf_aclass(max_nleafage) ! Fraction of leaves in each age-class - integer :: tnull,snull ! are the tallest and shortest cohorts allocate - integer :: nlevsoi_hyd ! number of hydraulically active soil layers + type(ed_cohort_type), pointer :: storebigcohort + integer :: iage ! loop counter for leaf age classes + real(r8) :: leaf_c ! total leaf carbon + integer :: tnull,snull ! are the tallest and shortest cohorts allocate + integer :: nlevsoi_hyd ! number of hydraulically active soil layers !---------------------------------------------------------------------- @@ -182,10 +190,18 @@ subroutine create_cohort(currentSite, patchptr, pft, nn, hite, dbh, bleaf, bfine call nan_cohort(new_cohort) ! Make everything in the cohort not-a-number call zero_cohort(new_cohort) ! Zero things that need to be zeroed. + ! Point to the PARTEH object + new_cohort%prt => prt + + ! The PARTEH cohort object should be allocated and already + ! initialized in this routine. + call new_cohort%prt%CheckInitialConditions() + + !**********************/ ! Define cohort state variable !**********************/ - + new_cohort%indexnumber = fates_unset_int ! Cohort indexing was not thread-safe, setting ! bogus value for the time being (RGK-012017) @@ -200,62 +216,11 @@ subroutine create_cohort(currentSite, patchptr, pft, nn, hite, dbh, bleaf, bfine new_cohort%canopy_layer = clayer new_cohort%canopy_layer_yesterday = real(clayer, r8) new_cohort%laimemory = laimemory - - - ! All newly initialized cohorts start off with an assumption - ! about leaf age (depending on what is calling the initialization - ! of this cohort - - if(leaf_aclass_init .eq. equal_leaf_aclass) then - frac_leaf_aclass(1:nleafage) = 1._r8 / real(nleafage,r8) - elseif(leaf_aclass_init .eq. first_leaf_aclass) then - frac_leaf_aclass(1:nleafage) = 0._r8 - frac_leaf_aclass(1) = 1._r8 - elseif(leaf_aclass_init .eq. nan_leaf_aclass) then - frac_leaf_aclass(1:nleafage) = nan - else - write(fates_log(),*) 'An unknown leaf age distribution was' - write(fates_log(),*) 'requested during create cohort' - write(fates_log(),*) 'leaf_aclass_init: ',leaf_aclass_init - call endrun(msg=errMsg(sourcefile, __LINE__)) - end if - - ! Initialize the Plant allocative Reactive Transport (PaRT) module - ! Choose from one of the extensible hypotheses (EH) - ! ----------------------------------------------------------------------------------- - - call InitPRTCohort(new_cohort) - - ! The initialization allocates memory, but the boundary and initial - ! contitions must be set. All new cohorts go through create_cohort() - ! so this should be the only place this is called. Alternatively - ! cohorts can be copied and fused, but special routines handle that. - ! ----------------------------------------------------------------------------------- - - select case(hlm_parteh_mode) - case (prt_carbon_allom_hyp) - - do iage = 1,nleafage - call SetState(new_cohort%prt,leaf_organ, carbon12_element, & - bleaf*frac_leaf_aclass(iage),iage) - end do - call SetState(new_cohort%prt,fnrt_organ, carbon12_element, bfineroot) - call SetState(new_cohort%prt,sapw_organ, carbon12_element, bsap) - call SetState(new_cohort%prt,store_organ, carbon12_element, bstore) - call SetState(new_cohort%prt,struct_organ , carbon12_element, bdead) - call SetState(new_cohort%prt,repro_organ , carbon12_element, 0.0_r8) - - end select - - - ! This call cycles through the initial conditions, and makes sure that they - ! are all initialized. - ! ----------------------------------------------------------------------------------- - - call new_cohort%prt%CheckInitialConditions() + new_cohort%sapwmemory = sapwmemory + new_cohort%structmemory = structmemory ! This sets things like vcmax25top, that depend on the - ! leaf age fractions + ! leaf age fractions (which are defined by PARTEH) call UpdateCohortBioPhysRates(new_cohort) call sizetype_class_index(new_cohort%dbh,new_cohort%pft, & @@ -267,7 +232,7 @@ subroutine create_cohort(currentSite, patchptr, pft, nn, hite, dbh, bleaf, bfine ! In these cases, testing if things like biomass are reasonable is pre-mature ! However, in this part of the code, we will pass in nominal values for size, number and type - if (new_cohort%dbh <= 0.0_r8 .or. new_cohort%n == 0._r8 .or. new_cohort%pft == 0 ) then + if (new_cohort%dbh <= 0._r8 .or. new_cohort%n == 0._r8 .or. new_cohort%pft == 0 ) then write(fates_log(),*) 'ED: something is zero in create_cohort', & new_cohort%dbh,new_cohort%n, & new_cohort%pft @@ -277,7 +242,11 @@ subroutine create_cohort(currentSite, patchptr, pft, nn, hite, dbh, bleaf, bfine ! Assign canopy extent and depth call carea_allom(new_cohort%dbh,new_cohort%n,spread,new_cohort%pft,new_cohort%c_area) - new_cohort%treelai = tree_lai(bleaf, new_cohort%pft, new_cohort%c_area, & + ! 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 ) @@ -306,6 +275,8 @@ subroutine create_cohort(currentSite, patchptr, pft, nn, hite, dbh, bleaf, bfine patchptr%shortest => new_cohort endif + call InitPRTBoundaryConditions(new_cohort) + ! Recuits do not have mortality rates, nor have they moved any ! carbon when they are created. They will bias our statistics ! until they have experienced a full day. We need a newly recruited flag. @@ -336,6 +307,7 @@ subroutine create_cohort(currentSite, patchptr, pft, nn, hite, dbh, bleaf, bfine call initTreeHydStates(currentSite,new_cohort, bc_in) if(recruitstatus==1)then + new_cohort%co_hydr%is_newly_recruited = .true. ! If plant hydraulics is active, we must constrain the @@ -345,6 +317,7 @@ subroutine create_cohort(currentSite, patchptr, pft, nn, hite, dbh, bleaf, bfine ! states in the temporary cohort, to calculate this new number density call ConstrainRecruitNumber(currentSite,new_cohort, bc_in) + endif endif @@ -359,82 +332,112 @@ end subroutine create_cohort ! ------------------------------------------------------------------------------------- - subroutine InitPRTCohort(new_cohort) - - ! ---------------------------------------------------------------------------------- - ! This subroutine simply allocates and attaches the correct PRT object. - ! The call to InitPRTVartype() performs the allocation of the variables - ! and boundary conditions inside the object. It also initializes - ! all values as unitialized (large bogus values). - ! - ! Each PARTEH allocation hypothesis has different expectations of boundary conditions. - ! These are specified by pointers to values in the host model. Because these - ! are pointers, they just need to be set once when the prt object is first initalized. - ! The calls below to "RegisterBCINOut", "RegisterBCIn" and "RegisterBCOut" are - ! setting those pointers. - ! ----------------------------------------------------------------------------------- + subroutine InitPRTBoundaryConditions(new_cohort) + + ! Set the boundary conditions that flow in an out of the PARTEH + ! allocation hypotheses. These are pointers in the PRT objects that + ! point to values outside in the FATES model. + + ! Example: + ! "ac_bc_inout_id_dbh" is the unique integer that defines the object index + ! for the allometric carbon "ac" boundary condition "bc" for DBH "dbh" + ! that is classified as input and output "inout". + ! See PRTAllometricCarbonMod.F90 to track its usage. + ! bc_rval is used as the optional argument identifyer to specify a real + ! value boundary condition. + ! bc_ival is used as the optional argument identifyer to specify an integer + ! value boundary condition. - ! - ! !ARGUMENTS - type(ed_cohort_type), intent(inout), target :: new_cohort - type(callom_prt_vartypes), pointer :: callom_prt + type(ed_cohort_type), intent(inout), target :: new_cohort - ! Allocate the PRT class object - ! Each hypothesis has a different object which is an extension - ! of the base class. + select case(hlm_parteh_mode) + case (prt_carbon_allom_hyp) + + ! Register boundary conditions for the Carbon Only Allometric Hypothesis + + 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%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) - select case(hlm_parteh_mode) - case (prt_carbon_allom_hyp) - - allocate(callom_prt) - new_cohort%prt => callom_prt - - case DEFAULT + case (prt_cnp_flex_allom_hyp) - write(fates_log(),*) 'You specified an unknown PRT module' - write(fates_log(),*) 'Aborting' - call endrun(msg=errMsg(sourcefile, __LINE__)) + write(fates_log(),*) 'You have not specified the boundary conditions for the' + write(fates_log(),*) 'CNP with flexible stoichiometries hypothesis. Please do so. Dude.' + call endrun(msg=errMsg(sourcefile, __LINE__)) + - end select - - ! This is the call to allocate the data structures in the PRT object - ! This call will be extended to each specific class. + case DEFAULT + + write(fates_log(),*) 'You specified an unknown PRT module' + write(fates_log(),*) 'Aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + + end select + - call new_cohort%prt%InitPRTVartype() + end subroutine InitPRTBoundaryConditions + ! ------------------------------------------------------------------------------------! + + subroutine InitPRTObject(prt) - ! Set the boundary conditions that flow in an out of the PARTEH - ! allocation hypotheses. These are pointers in the PRT objects that - ! point to values outside in the FATES model. + ! ----------------------------------------------------------------------------------- + ! + ! This routine allocates the PARTEH object that is associated with each cohort. + ! The argument that is passed in is a pointer that is then associated with this + ! newly allocated object. + ! The object that is allocated is the specific extended class for the hypothesis + ! of choice. + ! Following this, the object and its internal mappings are initialized. + ! This routine does NOT set any of the initial conditions, or boundary conditions + ! such as the organ/element masses. Those are handled after this call. + ! + ! ----------------------------------------------------------------------------------- - ! Example: - ! "ac_bc_inout_id_dbh" is the unique integer that defines the object index - ! for the allometric carbon "ac" boundary condition "bc" for DBH "dbh" - ! that is classified as input and output "inout". - ! See PRTAllometricCarbonMod.F90 to track its usage. - ! bc_rval is used as the optional argument identifyer to specify a real - ! value boundary condition. - ! bc_ival is used as the optional argument identifyer to specify an integer - ! value boundary condition. - + ! Argument + class(prt_vartypes), pointer :: prt + + ! Potential Extended types + class(callom_prt_vartypes), pointer :: c_allom_prt + ! class(cnp_allom_prt_vartypes), pointer :: cnp_allom_prt + - select case(hlm_parteh_mode) - case (prt_carbon_allom_hyp) + select case(hlm_parteh_mode) + case (prt_carbon_allom_hyp) + + allocate(c_allom_prt) + prt => c_allom_prt + + case (prt_cnp_flex_allom_hyp) + + !! allocate(cnp_allom_prt) + !! prt => cnp_allom_prt + + write(fates_log(),*) 'Flexible CNP allocation is still in development' + write(fates_log(),*) 'Aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) - ! Register boundary conditions for the Carbon Only Allometric Hypothesis + case DEFAULT + + write(fates_log(),*) 'You specified an unknown PRT module' + write(fates_log(),*) 'Aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + + end select + + ! This is the call to allocate the data structures in the PRT object + ! This call will be extended to each specific class. - 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%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 prt%InitPRTVartype() + - end select + return + end subroutine InitPRTObject - return - end subroutine InitPRTCohort - !-------------------------------------------------------------------------------------! subroutine nan_cohort(cc_p) @@ -474,11 +477,12 @@ subroutine nan_cohort(cc_p) currentCohort%size_class = fates_unset_int ! size class index currentCohort%size_class_lasttimestep = fates_unset_int ! size class index currentCohort%size_by_pft_class = fates_unset_int ! size by pft classification index - currentCohort%n = nan ! number of individuals in cohort per 'area' (10000m2 default) currentCohort%dbh = nan ! 'diameter at breast height' in cm currentCohort%hite = nan ! height: meters currentCohort%laimemory = nan ! target leaf biomass- set from previous year: kGC per indiv + currentCohort%sapwmemory = nan ! target sapwood biomass- set from previous year: kGC per indiv + currentCohort%structmemory = nan ! target structural biomass- set from previous year: kGC per indiv currentCohort%lai = nan ! leaf area index of cohort m2/m2 currentCohort%sai = nan ! stem area index of cohort m2/m2 currentCohort%g_sb_laweight = nan ! Total leaf conductance of cohort (stomata+blayer) weighted by leaf-area [m/s]*[m2] @@ -489,7 +493,7 @@ subroutine nan_cohort(cc_p) currentCohort%c_area = nan ! areal extent of canopy (m2) currentCohort%treelai = nan ! lai of tree (total leaf area (m2) / canopy area (m2) currentCohort%treesai = nan ! stem area index of tree (total stem area (m2) / canopy area (m2) - + currentCohort%seed_prod = nan currentCohort%vcmax25top = nan currentCohort%jmax25top = nan currentCohort%tpu25top = nan @@ -528,8 +532,6 @@ subroutine nan_cohort(cc_p) currentCohort%lmort_collateral = nan currentCohort%l_degrad = nan - - currentCohort%seed_prod = nan ! reproduction seed and clonal: KgC/indiv/year currentCohort%c_area = nan ! areal extent of canopy (m2) currentCohort%treelai = nan ! lai of tree (total leaf area (m2) / canopy area (m2) currentCohort%treesai = nan ! stem area index of tree (total stem area (m2) / canopy area (m2) @@ -586,9 +588,9 @@ subroutine zero_cohort(cc_p) currentcohort%year_net_uptake(:) = 999._r8 ! this needs to be 999, or trimming of new cohorts will break. currentcohort%ts_net_uptake(:) = 0._r8 - currentcohort%seed_prod = 0._r8 currentcohort%fraction_crown_burned = 0._r8 currentCohort%size_class = 1 + currentCohort%seed_prod = 0._r8 currentCohort%size_class_lasttimestep = 0 currentcohort%npp_acc_hold = 0._r8 currentcohort%gpp_acc_hold = 0._r8 @@ -610,18 +612,19 @@ subroutine zero_cohort(cc_p) end subroutine zero_cohort !-------------------------------------------------------------------------------------! - subroutine terminate_cohorts( currentSite, currentPatch, level ) + subroutine terminate_cohorts( currentSite, currentPatch, level , call_index) ! ! !DESCRIPTION: ! terminates cohorts when they get too small ! ! !USES: - use SFParamsMod, only : SF_val_CWD_frac + ! ! !ARGUMENTS type (ed_site_type) , intent(inout), target :: currentSite type (ed_patch_type), intent(inout), target :: currentPatch integer , intent(in) :: level + integer :: call_index ! Important point regarding termination levels. Termination is typically ! called after fusion. We do this so that we can re-capture the biomass that would @@ -643,34 +646,32 @@ subroutine terminate_cohorts( currentSite, currentPatch, level ) real(r8) :: fnrt_c ! fineroot carbon [kg] real(r8) :: repro_c ! reproductive carbon [kg] real(r8) :: struct_c ! structural carbon [kg] - - integer :: terminate ! do we terminate (1) or not (0) + integer :: terminate ! do we terminate (itrue) or not (ifalse) integer :: c ! counter for litter size class. integer :: levcan ! canopy level !---------------------------------------------------------------------- - currentCohort => currentPatch%shortest do while (associated(currentCohort)) - terminate = 0 + terminate = ifalse tallerCohort => currentCohort%taller - leaf_c = currentCohort%prt%GetState(leaf_organ, all_carbon_elements) - store_c = currentCohort%prt%GetState(store_organ, all_carbon_elements) - sapw_c = currentCohort%prt%GetState(sapw_organ, all_carbon_elements) - fnrt_c = currentCohort%prt%GetState(fnrt_organ, all_carbon_elements) - struct_c = currentCohort%prt%GetState(struct_organ, all_carbon_elements) - repro_c = currentCohort%prt%GetState(repro_organ, all_carbon_elements) + leaf_c = currentCohort%prt%GetState(leaf_organ, carbon12_element) + store_c = currentCohort%prt%GetState(store_organ, carbon12_element) + sapw_c = currentCohort%prt%GetState(sapw_organ, carbon12_element) + fnrt_c = currentCohort%prt%GetState(fnrt_organ, carbon12_element) + struct_c = currentCohort%prt%GetState(struct_organ, carbon12_element) + repro_c = currentCohort%prt%GetState(repro_organ, carbon12_element) ! Check if number density is so low is breaks math (level 1) if (currentcohort%n < min_n_safemath .and. level == 1) then - terminate = 1 - if ( debug ) then - write(fates_log(),*) 'terminating cohorts 0',currentCohort%n/currentPatch%area,currentCohort%dbh - endif + terminate = itrue + if ( debug ) then + write(fates_log(),*) 'terminating cohorts 0',currentCohort%n/currentPatch%area,currentCohort%dbh,call_index + endif endif - + ! The rest of these are only allowed if we are not dealing with a recruit (level 2) if (.not.currentCohort%isnew .and. level == 2) then @@ -678,45 +679,43 @@ subroutine terminate_cohorts( currentSite, currentPatch, level ) if (currentCohort%n/currentPatch%area <= min_npm2 .or. & ! currentCohort%n <= min_nppatch .or. & (currentCohort%dbh < 0.00001_r8 .and. store_c < 0._r8) ) then - terminate = 1 - + terminate = itrue if ( debug ) then - write(fates_log(),*) 'terminating cohorts 1',currentCohort%n/currentPatch%area,currentCohort%dbh + write(fates_log(),*) 'terminating cohorts 1',currentCohort%n/currentPatch%area,currentCohort%dbh,call_index endif endif ! Outside the maximum canopy layer if (currentCohort%canopy_layer > nclmax ) then - terminate = 1 + terminate = itrue if ( debug ) then - write(fates_log(),*) 'terminating cohorts 2', currentCohort%canopy_layer + write(fates_log(),*) 'terminating cohorts 2', currentCohort%canopy_layer,call_index endif endif ! live biomass pools are terminally depleted if ( ( sapw_c+leaf_c+fnrt_c ) < 1e-10_r8 .or. & - store_c < 1e-10_r8) then - terminate = 1 + store_c < 1e-10_r8) then + terminate = itrue if ( debug ) then write(fates_log(),*) 'terminating cohorts 3', & - sapw_c,leaf_c,fnrt_c,store_c + sapw_c,leaf_c,fnrt_c,store_c,call_index endif endif ! Total cohort biomass is negative if ( ( struct_c+sapw_c+leaf_c+fnrt_c+store_c ) < 0._r8) then - terminate = 1 + terminate = itrue if ( debug ) then - write(fates_log(),*) 'terminating cohorts 4', & - struct_c,sapw_c,leaf_c,fnrt_c,store_c - - endif - - endif + write(fates_log(),*) 'terminating cohorts 4', & + struct_c,sapw_c,leaf_c,fnrt_c,store_c,call_index + endif + + endif endif ! if (.not.currentCohort%isnew .and. level == 2) then - if (terminate == 1) then - + if (terminate == itrue) then + ! preserve a record of the to-be-terminated cohort for mortality accounting levcan = currentCohort%canopy_layer @@ -737,52 +736,14 @@ subroutine terminate_cohorts( currentSite, currentPatch, level ) currentCohort%n * (struct_c+sapw_c+leaf_c+fnrt_c+store_c+repro_c) end if - !put the litter from the terminated cohorts straight into the fragmenting pools - if (currentCohort%n.gt.0.0_r8) then - do c=1,ncwd - - currentPatch%CWD_AG(c) = currentPatch%CWD_AG(c) + currentCohort%n*(struct_c+sapw_c) / & - currentPatch%area & - * SF_val_CWD_frac(c) * EDPftvarcon_inst%allom_agb_frac(currentCohort%pft) - currentPatch%CWD_BG(c) = currentPatch%CWD_BG(c) + currentCohort%n*(struct_c+sapw_c) / & - currentPatch%area & - * SF_val_CWD_frac(c) * (1.0_r8 - EDPftvarcon_inst%allom_agb_frac(currentCohort%pft)) - enddo - - currentPatch%leaf_litter(currentCohort%pft) = currentPatch%leaf_litter(currentCohort%pft) + currentCohort%n* & - (leaf_c)/currentPatch%area - - currentPatch%root_litter(currentCohort%pft) = currentPatch%root_litter(currentCohort%pft) + currentCohort%n* & - (fnrt_c+store_c)/currentPatch%area - - - ! keep track of the above fluxes at the site level as a CWD/litter input flux (in kg / site-m2 / yr) - do c=1,ncwd - currentSite%CWD_AG_diagnostic_input_carbonflux(c) = currentSite%CWD_AG_diagnostic_input_carbonflux(c) & - + currentCohort%n*(struct_c + sapw_c) * & - SF_val_CWD_frac(c) * EDPftvarcon_inst%allom_agb_frac(currentCohort%pft) * hlm_days_per_year / AREA - currentSite%CWD_BG_diagnostic_input_carbonflux(c) = currentSite%CWD_BG_diagnostic_input_carbonflux(c) & - + currentCohort%n*(struct_c + sapw_c) * & - SF_val_CWD_frac(c) * (1.0_r8 - EDPftvarcon_inst%allom_agb_frac(currentCohort%pft)) * hlm_days_per_year / AREA - enddo - - currentSite%leaf_litter_diagnostic_input_carbonflux(currentCohort%pft) = & - currentSite%leaf_litter_diagnostic_input_carbonflux(currentCohort%pft) + & - currentCohort%n * (leaf_c) * hlm_days_per_year / AREA - currentSite%root_litter_diagnostic_input_carbonflux(currentCohort%pft) = & - currentSite%root_litter_diagnostic_input_carbonflux(currentCohort%pft) + & - currentCohort%n * (fnrt_c + store_c) * hlm_days_per_year / AREA + ! put the litter from the terminated cohorts + ! straight into the fragmenting pools + if (currentCohort%n.gt.0.0_r8) then + call SendCohortToLitter(currentSite,currentPatch, & + currentCohort,currentCohort%n) end if - ! Zero out the state pools - call SetState(currentCohort%prt,leaf_organ,carbon12_element,0.0_r8) - call SetState(currentCohort%prt,fnrt_organ,carbon12_element,0.0_r8) - call SetState(currentCohort%prt,sapw_organ,carbon12_element,0.0_r8) - call SetState(currentCohort%prt,struct_organ,carbon12_element,0.0_r8) - call SetState(currentCohort%prt,repro_organ,carbon12_element,0.0_r8) - call SetState(currentCohort%prt,store_organ,carbon12_element,0.0_r8) - ! Set pointers and remove the current cohort from the list shorterCohort => currentCohort%shorter @@ -801,13 +762,8 @@ subroutine terminate_cohorts( currentSite, currentPatch, level ) shorterCohort%taller => tallerCohort endif - ! At this point, nothing should be pointing to current Cohort - if (hlm_use_planthydro.eq.itrue) call DeallocateHydrCohort(currentCohort) - - ! Deallocate the cohort's PRT structure - call currentCohort%prt%DeallocatePRTVartypes() - deallocate(currentCohort%prt) + call DeallocateCohort(currentCohort) deallocate(currentCohort) nullify(currentCohort) @@ -817,7 +773,153 @@ subroutine terminate_cohorts( currentSite, currentPatch, level ) end subroutine terminate_cohorts - !-------------------------------------------------------------------------------------! + ! ===================================================================================== + + subroutine SendCohortToLitter(csite,cpatch,ccohort,nplant) + + ! ----------------------------------------------------------------------------------- + ! This routine transfers the existing mass in all pools and all elements + ! on a vegetation cohort, into the litter pool. + ! + ! Important: (1) This IS NOT turnover, this is not a partial transfer. + ! (2) This is from a select number of plants in the cohort. ie this is + ! not a "whole-sale" sending of all plants to litter. + ! (3) This does not affect the PER PLANT mass pools, so + ! do not update any PARTEH structures. + ! (4) The change in plant number density (due to death or termination) + ! IS NOT handled here. + ! (5) This routine is NOT used for disturbance, mostly + ! because this routine assumes a cohort lands in its patch + ! Whereas the disturbance scheme does NOT assume that. + ! ----------------------------------------------------------------------------------- + + ! Arguments + type (ed_site_type) , target :: csite + type (ed_patch_type) , target :: cpatch + type (ed_cohort_type) , target :: ccohort + real(r8) :: nplant ! Number (absolute) + ! of plants to transfer + + ! + type(litter_type), pointer :: litt ! Litter object for each element + type(site_fluxdiags_type),pointer :: flux_diags + + real(r8) :: leaf_m ! leaf mass [kg] + real(r8) :: store_m ! storage mass [kg] + real(r8) :: sapw_m ! sapwood mass [kg] + real(r8) :: fnrt_m ! fineroot mass [kg] + real(r8) :: repro_m ! reproductive mass [kg] + real(r8) :: struct_m ! structural mass [kg] + real(r8) :: plant_dens! plant density [/m2] + real(r8) :: dcmpy_frac! fraction of mass going to each decomposability partition + integer :: el ! loop index for elements + integer :: c ! loop index for CWD + integer :: pft ! pft index of the cohort + integer :: sl ! loop index for soil layers + integer :: dcmpy ! loop index for decomposability + + !---------------------------------------------------------------------- + + pft = ccohort%pft + + plant_dens = nplant/cpatch%area + + call set_root_fraction(csite%rootfrac_scr, pft, csite%zi_soil, & + icontext = i_biomass_rootprof_context) + + do el=1,num_elements + + 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)) + + litt => cpatch%litter(el) + flux_diags => csite%flux_diags(el) + + do c=1,ncwd + + ! above ground CWD + litt%ag_cwd(c) = litt%ag_cwd(c) + plant_dens * & + (struct_m+sapw_m) * SF_val_CWD_frac(c) * & + EDPftvarcon_inst%allom_agb_frac(pft) + + ! below ground CWD + do sl=1,csite%nlevsoil + litt%bg_cwd(c,sl) = litt%bg_cwd(c,sl) + plant_dens * & + (struct_m+sapw_m) * SF_val_CWD_frac(c) * & + (1.0_r8 - EDPftvarcon_inst%allom_agb_frac(pft)) * & + csite%rootfrac_scr(sl) + enddo + + ! above ground + flux_diags%cwd_ag_input(c) = flux_diags%cwd_ag_input(c) + & + (struct_m+sapw_m) * SF_val_CWD_frac(c) * & + EDPftvarcon_inst%allom_agb_frac(pft) * nplant + + ! below ground + flux_diags%cwd_bg_input(c) = flux_diags%cwd_bg_input(c) + & + (struct_m + sapw_m) * SF_val_CWD_frac(c) * & + (1.0_r8 - EDPftvarcon_inst%allom_agb_frac(pft)) * nplant + + enddo + + do dcmpy=1,ndcmpy + dcmpy_frac = GetDecompyFrac(pft,leaf_organ,dcmpy) + + litt%leaf_fines(dcmpy) = litt%leaf_fines(dcmpy) + & + plant_dens * (leaf_m+repro_m) * dcmpy_frac + + dcmpy_frac = GetDecompyFrac(pft,fnrt_organ,dcmpy) + do sl=1,csite%nlevsoil + litt%root_fines(dcmpy,sl) = litt%root_fines(dcmpy,sl) + & + plant_dens * (fnrt_m+store_m) * csite%rootfrac_scr(sl) * dcmpy_frac + end do + + end do + + flux_diags%leaf_litter_input(pft) = & + flux_diags%leaf_litter_input(pft) + & + (leaf_m+repro_m) * nplant + flux_diags%root_litter_input(pft) = & + flux_diags%root_litter_input(pft) + & + (fnrt_m+store_m) * nplant + + + end do + + return + end subroutine SendCohortToLitter + + + !-------------------------------------------------------------------------------------- + + + + subroutine DeallocateCohort(currentCohort) + + ! ---------------------------------------------------------------------------------- + ! This subroutine deallocates all dynamic memory and objects + ! inside the cohort structure. This DOES NOT deallocate + ! the cohort structure itself. + ! ---------------------------------------------------------------------------------- + + type(ed_cohort_type),intent(inout) :: currentCohort + + ! At this point, nothing should be pointing to current Cohort + if (hlm_use_planthydro.eq.itrue) call DeallocateHydrCohort(currentCohort) + + ! Deallocate the cohort's PRT structures + call currentCohort%prt%DeallocatePRTVartypes() + + ! Deallocate the PRT object + deallocate(currentCohort%prt) + + return + end subroutine DeallocateCohort + subroutine fuse_cohorts(currentSite, currentPatch, bc_in) @@ -941,7 +1043,6 @@ subroutine fuse_cohorts(currentSite, currentPatch, bc_in) end do end if - ! Fuse all mass pools call currentCohort%prt%WeightedFusePRTVartypes(nextc%prt, & currentCohort%n/newn ) @@ -952,6 +1053,12 @@ subroutine fuse_cohorts(currentSite, currentPatch, bc_in) currentCohort%laimemory = (currentCohort%n*currentCohort%laimemory & + nextc%n*nextc%laimemory)/newn + + currentCohort%sapwmemory = (currentCohort%n*currentCohort%sapwmemory & + + nextc%n*nextc%sapwmemory)/newn + + currentCohort%structmemory = (currentCohort%n*currentCohort%structmemory & + + nextc%n*nextc%structmemory)/newn currentCohort%canopy_trim = (currentCohort%n*currentCohort%canopy_trim & + nextc%n*nextc%canopy_trim)/newn @@ -990,6 +1097,7 @@ subroutine fuse_cohorts(currentSite, currentPatch, bc_in) ! cohorts' dbh ! ----------------------------------------------------------------- ! + call carea_allom(currentCohort%dbh,currentCohort%n, & currentSite%spread,currentCohort%pft,& currentCohort%c_area,inverse=.false.) @@ -1061,24 +1169,8 @@ subroutine fuse_cohorts(currentSite, currentPatch, bc_in) call endrun(msg=errMsg(sourcefile, __LINE__)) end select - - ! If fusion forces the actual leaf biomass to be unreasonably - ! greater than the target (ie 25%), reset the DBH - -! call bleaf(currentCohort%dbh,currentCohort%pft, & -! currentCohort%canopy_trim,leaf_c_target) - leaf_c = currentCohort%prt%GetState(leaf_organ,all_carbon_elements) -! if (leaf_c > leaf_c_target*1.25_r8) then -! call ForceDBH( currentCohort%pft, currentCohort%canopy_trim, & -! currentCohort%dbh, currentCohort%hite, & -! bl = leaf_c) -! call carea_allom(currentCohort%dbh,newn,currentSite%spread,currentCohort%pft, & -! currentCohort%c_area,inverse=.false.) -! end if - - currentCohort%treelai = tree_lai(leaf_c, currentCohort%pft, currentCohort%c_area, newn, & currentCohort%canopy_layer, currentPatch%canopy_layer_tlai, & currentCohort%vcmax25top) @@ -1086,12 +1178,9 @@ subroutine fuse_cohorts(currentSite, currentPatch, bc_in) currentCohort%c_area, newn, currentCohort%canopy_layer, & currentPatch%canopy_layer_tlai, currentCohort%treelai,currentCohort%vcmax25top,1 ) - - call sizetype_class_index(currentCohort%dbh,currentCohort%pft, & currentCohort%size_class,currentCohort%size_by_pft_class) - if(hlm_use_planthydro.eq.itrue) then call FuseCohortHydraulics(currentSite,currentCohort,nextc,bc_in,newn) endif @@ -1141,7 +1230,6 @@ subroutine fuse_cohorts(currentSite, currentPatch, bc_in) ! their initization values, which should be the same for eahc if ( .not.currentCohort%isnew) then - currentCohort%seed_prod = (currentCohort%n*currentCohort%seed_prod + & nextc%n*nextc%seed_prod)/newn currentCohort%gpp_acc = (currentCohort%n*currentCohort%gpp_acc + & @@ -1220,23 +1308,20 @@ subroutine fuse_cohorts(currentSite, currentPatch, bc_in) endif ! At this point, nothing should be pointing to current Cohort - ! update hydraulics quantities that are functions of hite & biomasses - ! deallocate the hydro structure of nextc + ! update hydraulics quantities that are functions of hite & biomasses + ! deallocate the hydro structure of nextc if (hlm_use_planthydro.eq.itrue) then - call carea_allom(currentCohort%dbh,currentCohort%n,currentSite%spread, & - currentCohort%pft,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 ) - call updateSizeDepTreeHydProps(currentSite,currentCohort, bc_in) - call DeallocateHydrCohort(nextc) - endif - - ! Deallocate the cohort's PRT structure - call nextc%prt%DeallocatePRTVartypes() - deallocate(nextc%prt) + call carea_allom(currentCohort%dbh,currentCohort%n,currentSite%spread, & + currentCohort%pft,currentCohort%c_area) + leaf_c = currentCohort%prt%GetState(leaf_organ, carbon12_element) + currentCohort%treelai = tree_lai(leaf_c, & + currentCohort%pft, currentCohort%c_area, currentCohort%n, & + currentCohort%canopy_layer, currentPatch%canopy_layer_tlai, & + currentCohort%vcmax25top ) + call updateSizeDepTreeHydProps(currentSite,currentCohort, bc_in) + endif + + call DeallocateCohort(nextc) deallocate(nextc) nullify(nextc) @@ -1500,6 +1585,8 @@ subroutine copy_cohort( currentCohort,copyc ) n%dbh = o%dbh n%hite = o%hite n%laimemory = o%laimemory + n%sapwmemory = o%sapwmemory + n%structmemory = o%structmemory n%lai = o%lai n%sai = o%sai n%g_sb_laweight = o%g_sb_laweight @@ -1533,8 +1620,8 @@ subroutine copy_cohort( currentCohort,copyc ) n%npp_tstep = o%npp_tstep n%npp_acc = o%npp_acc - if ( debug ) write(fates_log(),*) 'EDcohortDyn Ia ',o%npp_acc - if ( debug ) write(fates_log(),*) 'EDcohortDyn Ib ',o%resp_acc + if ( debug .and. .not.o%isnew ) write(fates_log(),*) 'EDcohortDyn Ia ',o%npp_acc + if ( debug .and. .not.o%isnew ) write(fates_log(),*) 'EDcohortDyn Ib ',o%resp_acc n%resp_tstep = o%resp_tstep n%resp_acc = o%resp_acc @@ -1557,6 +1644,7 @@ subroutine copy_cohort( currentCohort,copyc ) ! ALLOCATION n%dmort = o%dmort n%seed_prod = o%seed_prod + n%treelai = o%treelai n%treesai = o%treesai n%c_area = o%c_area @@ -1581,9 +1669,7 @@ subroutine copy_cohort( currentCohort,copyc ) n%dhdt = o%dhdt n%ddbhdt = o%ddbhdt - if ( debug ) write(fates_log(),*) 'EDCohortDyn dpstoredt ',o%dbstoredt - - ! FIRE + ! FIRE n%fraction_crown_burned = o%fraction_crown_burned n%fire_mort = o%fire_mort n%crownfire_mort = o%crownfire_mort @@ -1608,7 +1694,7 @@ subroutine copy_cohort( currentCohort,copyc ) end subroutine copy_cohort !-------------------------------------------------------------------------------------! - function count_cohorts( currentPatch ) result ( backcount ) + subroutine count_cohorts( currentPatch ) ! ! !DESCRIPTION: ! @@ -1618,8 +1704,8 @@ function count_cohorts( currentPatch ) result ( backcount ) type(ed_patch_type), intent(inout), target :: currentPatch !new site ! ! !LOCAL VARIABLES: - type(ed_cohort_type), pointer ::currentCohort !new patch - integer backcount + type(ed_cohort_type), pointer :: currentCohort !new patch + integer :: backcount !---------------------------------------------------------------------- currentCohort => currentPatch%shortest @@ -1641,7 +1727,7 @@ function count_cohorts( currentPatch ) result ( backcount ) write(fates_log(),*) 'problem with linked list, not symmetrical' endif - end function count_cohorts + end subroutine count_cohorts ! =================================================================================== diff --git a/biogeochem/EDLoggingMortalityMod.F90 b/biogeochem/EDLoggingMortalityMod.F90 index 03b2ac4cda..f8c9a4cef8 100644 --- a/biogeochem/EDLoggingMortalityMod.F90 +++ b/biogeochem/EDLoggingMortalityMod.F90 @@ -1,502 +1,638 @@ - -module EDLoggingMortalityMod - - ! ==================================================================================== - ! Purpose: 1. create logging mortalities: - ! (a) direct logging mortality (cohort level) - ! (b) collateral mortality (cohort level) - ! (c) infrastructure mortality (cohort level) - ! 2. move the logged trunk fluxes from live into product pool - ! 3. move logging-associated mortality fluxes from live to CWD - ! 4. keep carbon balance (in ed_total_balance_check) - ! - ! Yi Xu & M.Huang - ! Date: 09/2017 - ! Last updated: 10/2017 - ! ==================================================================================== - - use FatesConstantsMod , only : r8 => fates_r8 - use EDTypesMod , only : ed_cohort_type - use EDTypesMod , only : ed_patch_type - use EDTypesMod , only : ncwd - use EDTypesMod , only : ed_site_type - use EDTypesMod , only : ed_resources_management_type - use EDTypesMod , only : dtype_ilog - use EDTypesMod , only : dtype_ifall - use EDTypesMod , only : dtype_ifire - use EDPftvarcon , only : EDPftvarcon_inst - use EDParamsMod , only : logging_event_code - use EDParamsMod , only : logging_dbhmin - use EDParamsMod , only : logging_collateral_frac - use EDParamsMod , only : logging_direct_frac - use EDParamsMod , only : logging_mechanical_frac - use EDParamsMod , only : logging_coll_under_frac - use EDParamsMod , only : logging_dbhmax_infra - use FatesInterfaceMod , only : hlm_current_year - use FatesInterfaceMod , only : hlm_current_month - use FatesInterfaceMod , only : hlm_current_day - use FatesInterfaceMod , only : hlm_model_day - use FatesInterfaceMod , only : hlm_day_of_year - use FatesInterfaceMod , only : hlm_days_per_year - use FatesInterfaceMod , only : hlm_use_logging - use FatesInterfaceMod , only : hlm_use_planthydro - use FatesConstantsMod , only : itrue,ifalse - use FatesGlobals , only : endrun => fates_endrun - use FatesGlobals , only : fates_log - use shr_log_mod , only : errMsg => shr_log_errMsg - use FatesPlantHydraulicsMod, only : AccumulateMortalityWaterStorage - - use PRTGenericMod , only : all_carbon_elements - use PRTGenericMod , only : sapw_organ, struct_organ, leaf_organ - use PRTGenericMod , only : fnrt_organ, store_organ, repro_organ - - - implicit none - private - - logical, protected :: logging_time ! If true, logging should be - ! performed during the current time-step - - character(len=*), parameter, private :: sourcefile = & - __FILE__ - - public :: LoggingMortality_frac - public :: logging_litter_fluxes - public :: logging_time - public :: IsItLoggingTime - -contains - - subroutine IsItLoggingTime(is_master,currentSite) - - ! ------------------------------------------------------------------------------- - ! This subroutine determines if the current dynamics step should enact - ! the logging module. - ! This is done by comparing the current model time to the logging event - ! ids. If there is a match, it is logging time. - ! ------------------------------------------------------------------------------- - - integer, intent(in) :: is_master - type(ed_site_type), intent(inout), target :: currentSite ! site structure - - integer :: icode ! Integer equivalent of the event code (parameter file only allows reals) - integer :: log_date ! Day of month for logging exctracted from event code - integer :: log_month ! Month of year for logging extraced from event code - integer :: log_year ! Year for logging extracted from event code - character(len=64) :: fmt = '(a,i2.2,a,i2.2,a,i4.4)' - - logging_time = .false. - icode = int(logging_event_code) - - if(hlm_use_logging.eq.ifalse) return - - if(icode .eq. 1) then - ! Logging is turned off - logging_time = .false. - - else if(icode .eq. 2) then - ! Logging event on the first step - if( hlm_model_day.eq.1 ) then - logging_time = .true. - end if - - else if(icode .eq. 3) then - ! Logging event every day - logging_time = .true. - - else if(icode .eq. 4) then - ! logging event once a month - if(hlm_current_day.eq.1 ) then - logging_time = .true. - end if - - else if(icode < 0 .and. icode > -366) then - ! Logging event every year on specific day of year - if(hlm_day_of_year .eq. abs(icode) ) then - logging_time = .true. - end if - - else if(icode > 10000 ) then - ! Specific Event: YYYYMMDD - log_date = icode - int(100* floor(real(icode)/100)) - log_year = floor(real(icode)/10000) - log_month = floor(real(icode)/100) - log_year*100 - - if( hlm_current_day.eq.log_date .and. & - hlm_current_month.eq.log_month .and. & - hlm_current_year.eq.log_year ) then - logging_time = .true. - end if - else - ! Bad logging event flag - write(fates_log(),*) 'An invalid logging code was specified in fates_params' - write(fates_log(),*) 'Check EDLoggingMortalityMod.F90:IsItLoggingTime()' - write(fates_log(),*) 'for a breakdown of the valid codes and change' - write(fates_log(),*) 'fates_logging_event_code in the file accordingly.' - write(fates_log(),*) 'exiting' - call endrun(msg=errMsg(sourcefile, __LINE__)) - end if - - ! Initialize some site level diagnostics that are calculated for each event - currentSite%resources_management%delta_litter_stock = 0.0_r8 - currentSite%resources_management%delta_biomass_stock = 0.0_r8 - currentSite%resources_management%delta_individual = 0.0_r8 - - if(logging_time .and. (is_master.eq.itrue) ) then - write(fates_log(),fmt) 'Logging Event Enacted on date: ', & - hlm_current_month,'-',hlm_current_day,'-',hlm_current_year - end if - return - end subroutine IsItLoggingTime - - ! ====================================================================================== - - subroutine LoggingMortality_frac( pft_i, dbh, canopy_layer, lmort_direct, & - lmort_collateral, lmort_infra, l_degrad ) - - ! Arguments - integer, intent(in) :: pft_i ! pft index - real(r8), intent(in) :: dbh ! diameter at breast height (cm) - integer, intent(in) :: canopy_layer ! canopy layer of this cohort - real(r8), intent(out) :: lmort_direct ! direct (harvestable) mortality fraction - real(r8), intent(out) :: lmort_collateral ! collateral damage mortality fraction - real(r8), intent(out) :: lmort_infra ! infrastructure mortality fraction - real(r8), intent(out) :: l_degrad ! fraction of trees that are not killed - ! but suffer from forest degradation (i.e. they - ! are moved to newly-anthro-disturbed secondary - ! forest patch) - - ! Parameters - real(r8), parameter :: adjustment = 1.0 ! adjustment for mortality rates - - if (logging_time) then - if(EDPftvarcon_inst%woody(pft_i) == 1)then ! only set logging rates for trees - - ! Pass logging rates to cohort level - - if (dbh >= logging_dbhmin ) then - lmort_direct = logging_direct_frac * adjustment - l_degrad = 0._r8 - else - lmort_direct = 0.0_r8 - l_degrad = logging_direct_frac * adjustment - end if - - if (dbh >= logging_dbhmax_infra) then - lmort_infra = 0.0_r8 - l_degrad = l_degrad + logging_mechanical_frac * adjustment - else - lmort_infra = logging_mechanical_frac * adjustment - end if - !damage rates for size class < & > threshold_size need to be specified seperately - - ! Collateral damage to smaller plants below the canopy layer - ! will be applied via "understory_death" via the disturbance algorithm - if (canopy_layer .eq. 1) then - lmort_collateral = logging_collateral_frac * adjustment - endif - - else - lmort_direct = 0.0_r8 - lmort_collateral = 0.0_r8 - lmort_infra = 0.0_r8 - l_degrad = 0.0_r8 - end if - else - lmort_direct = 0.0_r8 - lmort_collateral = 0.0_r8 - lmort_infra = 0.0_r8 - l_degrad = 0.0_r8 - end if - - end subroutine LoggingMortality_frac - - ! ============================================================================ - - subroutine logging_litter_fluxes(currentSite, currentPatch, newPatch, patch_site_areadis) - - ! ------------------------------------------------------------------------------------------- - ! - ! DESCRIPTION: - ! Carbon going from ongoing mortality into CWD pools. - ! This module includes only those fluxes associated with a disturbance generated by logging. - ! Purpose: - ! 1) move logging-associated carbon to CWD and litter pool - ! 2) move the logging trunk from live into product pool - ! 3) generate fluxes used in carbon balance checking - ! E.g,: - ! Remove trunk of logged trees from litter/CWD - ! Add other parts of logged trees and all parts of collaterally and mechanically - ! damaged trees into CWD/litter - ! - ! This routine is only called if logging disturbance is the dominant disturbance. - ! - ! - ! Note: The litter losses due to disturbance in the logging case is almost - ! exactly like the natural tree-fall case. The big differences are that - ! the mortality rates governing the fluxes, follow a different rule set. - ! We also compute an export flux (product) that does not go to litter. - ! - ! Trunk Product Flux: Only usable wood is exported from a site. This is the above-ground - ! portion of the bole, and only boles associated with direct-logging, - ! not inftrastructure or collateral damage mortality. - ! - ! ------------------------------------------------------------------------------------------- - - - !USES: - use SFParamsMod, only : SF_val_cwd_frac - use EDtypesMod, only : area - use EDtypesMod, only : ed_site_type - use EDtypesMod, only : ed_patch_type - use EDtypesMod, only : ed_cohort_type - use FatesAllometryMod , only : carea_allom - - - ! !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 - - !LOCAL VARIABLES: - type(ed_cohort_type), pointer :: currentCohort - real(r8) :: litter_area ! area over which to distribute this litter (m2/site). - real(r8) :: np_mult ! Fraction of the new patch which came from the current patch - real(r8) :: direct_dead ! Mortality count through direct logging - real(r8) :: indirect_dead ! Mortality count through: impacts, infrastructure and collateral damage - real(r8) :: trunk_product_site ! flux of carbon in trunk products exported off site [ kgC/site ] - ! (note we are accumulating over the patch, but scale is site level) - real(r8) :: delta_litter_stock ! flux of carbon in total litter flux [ kgC/site ] - real(r8) :: delta_biomass_stock ! total flux of carbon through mortality (litter+product) [ kgC/site ] - real(r8) :: delta_individual ! change in plant number through mortality [ plants/site ] - real(r8) :: cwd_litter_density ! Component woody biomass transferred through mortality [kgC/m2] - ! (works with canopy_mortality_woody_litter, breaks into CWD partition - ! and converts units to /m2) - real(r8) :: woody_litter ! Woody biomass transferred through mortality [kgC/site] - real(r8) :: leaf_litter ! Leafy biomass transferred through mortality [kgC/site] - real(r8) :: root_litter ! Rooty + storage biomass transferred through mort [kgC/site] - real(r8) :: agb_frac ! local copy of the above ground biomass fraction [fraction] - real(r8) :: leaf_c ! leaf carbon [kg] - real(r8) :: fnrt_c ! fineroot carbon [kg] - real(r8) :: sapw_c ! sapwood carbon [kg] - real(r8) :: store_c ! storage carbon [kg] - real(r8) :: struct_c ! structure carbon [kg] - integer :: p ! pft index - integer :: c ! cwd index - - - ! Zero some site level accumulator diagnsotics - trunk_product_site = 0.0_r8 - delta_litter_stock = 0.0_r8 - delta_biomass_stock = 0.0_r8 - delta_individual = 0.0_r8 - - - currentCohort => currentPatch%shortest - do while(associated(currentCohort)) - p = currentCohort%pft - - 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) - - if(currentCohort%canopy_layer == 1)then - direct_dead = currentCohort%n * currentCohort%lmort_direct - indirect_dead = currentCohort%n * & - (currentCohort%lmort_collateral + currentCohort%lmort_infra) - - else - if(EDPftvarcon_inst%woody(currentCohort%pft) == 1)then - direct_dead = 0.0_r8 - indirect_dead = logging_coll_under_frac * currentCohort%n * & - (patch_site_areadis/currentPatch%area) !kgC/site/day - else - ! If the cohort of interest is grass, it will not experience - ! any mortality associated with the logging disturbance - direct_dead = 0.0_r8 - indirect_dead = 0.0_r8 - end if - end if - - agb_frac = EDPftvarcon_inst%allom_agb_frac(currentCohort%pft) - litter_area = currentPatch%area - np_mult = patch_site_areadis/newPatch%area - - - if( hlm_use_planthydro == itrue ) then - call AccumulateMortalityWaterStorage(currentSite,currentCohort,(direct_dead+indirect_dead)) - end if - - - ! ---------------------------------------------------------------------------------------- - ! Handle woody litter flux for non-bole components of biomass - ! This litter is distributed between the current and new patches, & - ! not to any other patches. This is really the eventually area of the current patch & - ! (currentPatch%area-patch_site_areadis) +patch_site_areadis... - ! For the new patch, only some fraction of its land area (patch_areadis/np%area) is - ! derived from the current patch, so we need to multiply by patch_areadis/np%area - ! ---------------------------------------------------------------------------------------- - - do c = 1,ncwd-1 - woody_litter = (direct_dead+indirect_dead) * & - (struct_c + sapw_c ) - cwd_litter_density = SF_val_CWD_frac(c) * woody_litter / litter_area - - newPatch%cwd_ag(c) = newPatch%cwd_ag(c) + agb_frac * cwd_litter_density * np_mult - currentPatch%cwd_ag(c) = currentPatch%cwd_ag(c) + agb_frac * cwd_litter_density - newPatch%cwd_bg(c) = newPatch%cwd_bg(c) + (1._r8-agb_frac) * cwd_litter_density * np_mult - currentPatch%cwd_bg(c) = currentPatch%cwd_bg(c) + (1._r8-agb_frac) * cwd_litter_density - - ! Diagnostics on fluxes into the AG and BG CWD pools - currentSite%CWD_AG_diagnostic_input_carbonflux(c) = & - currentSite%CWD_AG_diagnostic_input_carbonflux(c) + & - SF_val_CWD_frac(c) * woody_litter * hlm_days_per_year * agb_frac/ AREA - - currentSite%CWD_BG_diagnostic_input_carbonflux(c) = & - currentSite%CWD_BG_diagnostic_input_carbonflux(c) + & - SF_val_CWD_frac(c) * woody_litter * hlm_days_per_year * (1.0_r8 - agb_frac) / AREA - - ! Diagnostic specific to resource management code - delta_litter_stock = delta_litter_stock + woody_litter * SF_val_CWD_frac(c) - - enddo - - ! ---------------------------------------------------------------------------------------- - ! Handle litter flux for the boles of infrastucture and collateral damage mort - ! In this case the boles from direct logging are exported off-site and are not added - ! to the litter pools. That is why we handle this outside the loop above. Only the - ! collateral damange and infrastructure logging is applied to bole litter - ! ---------------------------------------------------------------------------------------- - - woody_litter = indirect_dead * (struct_c + sapw_c) - - cwd_litter_density = SF_val_CWD_frac(ncwd) * woody_litter / litter_area - - newPatch%cwd_ag(ncwd) = newPatch%cwd_ag(ncwd) + agb_frac * cwd_litter_density * np_mult - currentPatch%cwd_ag(ncwd) = currentPatch%cwd_ag(ncwd) + agb_frac * cwd_litter_density - - newPatch%cwd_bg(ncwd) = newPatch%cwd_bg(ncwd) + (1._r8-agb_frac) * cwd_litter_density * np_mult - currentPatch%cwd_bg(ncwd) = currentPatch%cwd_bg(ncwd) + (1._r8-agb_frac) * cwd_litter_density - - currentSite%CWD_AG_diagnostic_input_carbonflux(ncwd) = & - currentSite%CWD_AG_diagnostic_input_carbonflux(ncwd) + & - SF_val_CWD_frac(ncwd) * woody_litter * hlm_days_per_year * agb_frac/ AREA - - currentSite%CWD_BG_diagnostic_input_carbonflux(ncwd) = & - currentSite%CWD_BG_diagnostic_input_carbonflux(ncwd) + & - SF_val_CWD_frac(ncwd) * woody_litter * hlm_days_per_year * (1.0_r8 - agb_frac) / AREA - - delta_litter_stock = delta_litter_stock + woody_litter * SF_val_CWD_frac(ncwd) - - ! ---------------------------------------------------------------------------------------- - ! Handle litter flux for the belowground portion of directly logged boles - ! ---------------------------------------------------------------------------------------- - - woody_litter = direct_dead * (struct_c + sapw_c) - cwd_litter_density = SF_val_CWD_frac(ncwd) * woody_litter / litter_area - - newPatch%cwd_bg(ncwd) = newPatch%cwd_bg(ncwd) + & - (1._r8-agb_frac) * cwd_litter_density * np_mult - - currentPatch%cwd_bg(ncwd) = currentPatch%cwd_bg(ncwd) + & - (1._r8-agb_frac) * cwd_litter_density - - currentSite%CWD_BG_diagnostic_input_carbonflux(ncwd) = & - currentSite%CWD_BG_diagnostic_input_carbonflux(ncwd) + & - SF_val_CWD_frac(ncwd) * woody_litter * hlm_days_per_year * (1.0_r8 - agb_frac) / AREA - - - ! ---------------------------------------------------------------------------------------- - ! Handle harvest (export, flux-out) flux for the above ground boles - ! In this case the boles from direct logging are exported off-site and are not added - ! to the litter pools. That is why we handle this outside the loop above. Only the - ! collateral damange and infrastructure logging is applied to litter - ! - ! Losses to the system as a whole, for C-balancing (kGC/site/day) - ! Site level product, (kgC/site, accumulated over simulation) - ! ---------------------------------------------------------------------------------------- - - trunk_product_site = trunk_product_site + & - SF_val_CWD_frac(ncwd) * agb_frac * direct_dead * (struct_c + sapw_c) - - - ! ---------------------------------------------------------------------------------------- - ! Handle fluxes of leaf, root and storage carbon into litter pools. - ! (none of these are exported) - ! ---------------------------------------------------------------------------------------- - - leaf_litter = (direct_dead+indirect_dead) * leaf_c - root_litter = (direct_dead+indirect_dead) * (fnrt_c + store_c) - - newPatch%leaf_litter(p) = newPatch%leaf_litter(p) + leaf_litter / litter_area * np_mult - newPatch%root_litter(p) = newPatch%root_litter(p) + root_litter / litter_area * np_mult - - currentPatch%leaf_litter(p) = currentPatch%leaf_litter(p) + leaf_litter / litter_area - currentPatch%root_litter(p) = currentPatch%root_litter(p) + root_litter / litter_area - - ! track as diagnostic fluxes - currentSite%leaf_litter_diagnostic_input_carbonflux(p) = & - currentSite%leaf_litter_diagnostic_input_carbonflux(p) + & - leaf_litter * hlm_days_per_year / AREA - - currentSite%root_litter_diagnostic_input_carbonflux(p) = & - currentSite%root_litter_diagnostic_input_carbonflux(p) + & - root_litter * hlm_days_per_year / AREA - - - ! Logging specific diagnostics - ! ---------------------------------------------------------------------------------------- - - ! Note that litter stock also has terms above in the CWD loop - delta_litter_stock = delta_litter_stock + & - leaf_litter + & - root_litter - - delta_biomass_stock = delta_biomass_stock + & - leaf_litter + & - root_litter + & - (direct_dead+indirect_dead) * (struct_c + sapw_c) - - delta_individual = delta_individual + & - direct_dead + & - indirect_dead - - currentCohort => currentCohort%taller - end do - - ! Update the amount of carbon exported from the site through logging - ! operations. Currently we assume only above-ground portion - ! of the tree bole that experienced "direct" logging is exported - ! This portion is known as "trunk_product_site - - - currentSite%flux_out = currentSite%flux_out + trunk_product_site - - currentSite%resources_management%trunk_product_site = & - currentSite%resources_management%trunk_product_site + & - trunk_product_site - - currentSite%resources_management%delta_litter_stock = & - currentSite%resources_management%delta_litter_stock + & - delta_litter_stock - - currentSite%resources_management%delta_biomass_stock = & - currentSite%resources_management%delta_biomass_stock + & - delta_biomass_stock - - currentSite%resources_management%delta_individual = & - currentSite%resources_management%delta_individual + & - delta_individual - - currentCohort => newPatch%shortest - do while(associated(currentCohort)) - call carea_allom(currentCohort%dbh,currentCohort%n,currentSite%spread,currentCohort%pft,currentCohort%c_area) - currentCohort => currentCohort%taller - enddo - - end subroutine logging_litter_fluxes - -end module EDLoggingMortalityMod +module EDLoggingMortalityMod + + ! ==================================================================================== + ! Purpose: 1. create logging mortalities: + ! (a) direct logging mortality (cohort level) + ! (b) collateral mortality (cohort level) + ! (c) infrastructure mortality (cohort level) + ! 2. move the logged trunk fluxes from live into product pool + ! 3. move logging-associated mortality fluxes from live to CWD + ! 4. keep carbon balance (in ed_total_balance_check) + ! + ! Yi Xu & M.Huang + ! Date: 09/2017 + ! ==================================================================================== + + use FatesConstantsMod , only : r8 => fates_r8 + use EDTypesMod , only : ed_cohort_type + use EDTypesMod , only : ed_patch_type + use EDTypesMod , only : site_massbal_type + use EDTypesMod , only : site_fluxdiags_type + use FatesLitterMod , only : ncwd + use FatesLitterMod , only : ndcmpy + use FatesLitterMod , only : litter_type + use EDTypesMod , only : ed_site_type + use EDTypesMod , only : ed_resources_management_type + use EDTypesMod , only : dtype_ilog + use EDTypesMod , only : dtype_ifall + use EDTypesMod , only : dtype_ifire + use EDPftvarcon , only : EDPftvarcon_inst + use EDPftvarcon , only : GetDecompyFrac + use EDTypesMod , only : num_elements + use EDTypesMod , only : element_list + use EDParamsMod , only : logging_export_frac + use EDParamsMod , only : logging_event_code + use EDParamsMod , only : logging_dbhmin + use EDParamsMod , only : logging_collateral_frac + use EDParamsMod , only : logging_direct_frac + use EDParamsMod , only : logging_mechanical_frac + use EDParamsMod , only : logging_coll_under_frac + use EDParamsMod , only : logging_dbhmax_infra + use FatesInterfaceMod , only : hlm_current_year + use FatesInterfaceMod , only : hlm_current_month + use FatesInterfaceMod , only : hlm_current_day + use FatesInterfaceMod , only : hlm_model_day + use FatesInterfaceMod , only : hlm_day_of_year + use FatesInterfaceMod , only : hlm_days_per_year + use FatesInterfaceMod , only : hlm_use_logging + use FatesInterfaceMod , only : hlm_use_planthydro + use FatesConstantsMod , only : itrue,ifalse + use FatesGlobals , only : endrun => fates_endrun + use FatesGlobals , only : fates_log + use shr_log_mod , only : errMsg => shr_log_errMsg + use FatesPlantHydraulicsMod, only : AccumulateMortalityWaterStorage + use PRTGenericMod , only : all_carbon_elements,carbon12_element + use PRTGenericMod , only : sapw_organ, struct_organ, leaf_organ + use PRTGenericMod , only : fnrt_organ, store_organ, repro_organ + use FatesAllometryMod , only : set_root_fraction + use FatesAllometryMod , only : i_biomass_rootprof_context + + implicit none + private + + logical, protected :: logging_time ! If true, logging should be + ! performed during the current time-step + + + ! harvest litter localization specifies how much of the litter from a falling + ! tree lands within the newly generated patch, and how much lands outside of + ! the new patch, and thus in the original patch. By setting this to zero, + ! it is assumed that there is no preference, and thus the mass is distributed + ! equally. If this is set to 1, then all of the mass lands in the new + ! patch, and is thus "completely local". + + + real(r8), parameter :: harvest_litter_localization = 0.0_r8 + + character(len=*), parameter, private :: sourcefile = & + __FILE__ + + public :: LoggingMortality_frac + public :: logging_litter_fluxes + public :: logging_time + public :: IsItLoggingTime + +contains + + subroutine IsItLoggingTime(is_master,currentSite) + + ! ------------------------------------------------------------------------------- + ! This subroutine determines if the current dynamics step should enact + ! the logging module. + ! This is done by comparing the current model time to the logging event + ! ids. If there is a match, it is logging time. + ! ------------------------------------------------------------------------------- + + integer, intent(in) :: is_master + type(ed_site_type), intent(inout), target :: currentSite ! site structure + + integer :: icode ! Integer equivalent of the event code (parameter file only allows reals) + integer :: log_date ! Day of month for logging exctracted from event code + integer :: log_month ! Month of year for logging extraced from event code + integer :: log_year ! Year for logging extracted from event code + character(len=64) :: fmt = '(a,i2.2,a,i2.2,a,i4.4)' + + logging_time = .false. + icode = int(logging_event_code) + + if(hlm_use_logging.eq.ifalse) return + + if(icode .eq. 1) then + ! Logging is turned off + logging_time = .false. + + else if(icode .eq. 2) then + ! Logging event on the first step + if( hlm_model_day.eq.1 ) then + logging_time = .true. + end if + + else if(icode .eq. 3) then + ! Logging event every day + logging_time = .true. + + else if(icode .eq. 4) then + ! logging event once a month + if(hlm_current_day.eq.1 ) then + logging_time = .true. + end if + + else if(icode < 0 .and. icode > -366) then + ! Logging event every year on specific day of year + if(hlm_day_of_year .eq. abs(icode) ) then + logging_time = .true. + end if + + else if(icode > 10000 ) then + ! Specific Event: YYYYMMDD + log_date = icode - int(100* floor(real(icode)/100)) + log_year = floor(real(icode)/10000) + log_month = floor(real(icode)/100) - log_year*100 + + if( hlm_current_day.eq.log_date .and. & + hlm_current_month.eq.log_month .and. & + hlm_current_year.eq.log_year ) then + logging_time = .true. + end if + else + ! Bad logging event flag + write(fates_log(),*) 'An invalid logging code was specified in fates_params' + write(fates_log(),*) 'Check EDLoggingMortalityMod.F90:IsItLoggingTime()' + write(fates_log(),*) 'for a breakdown of the valid codes and change' + write(fates_log(),*) 'fates_logging_event_code in the file accordingly.' + write(fates_log(),*) 'exiting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + ! Initialize some site level diagnostics that are calculated for each event + currentSite%resources_management%delta_litter_stock = 0.0_r8 + currentSite%resources_management%delta_biomass_stock = 0.0_r8 + currentSite%resources_management%delta_individual = 0.0_r8 + + if(logging_time .and. (is_master.eq.itrue) ) then + write(fates_log(),fmt) 'Logging Event Enacted on date: ', & + hlm_current_month,'-',hlm_current_day,'-',hlm_current_year + end if + return + end subroutine IsItLoggingTime + + ! ====================================================================================== + + subroutine LoggingMortality_frac( pft_i, dbh, canopy_layer, lmort_direct, & + lmort_collateral,lmort_infra, l_degrad ) + + ! Arguments + integer, intent(in) :: pft_i ! pft index + real(r8), intent(in) :: dbh ! diameter at breast height (cm) + integer, intent(in) :: canopy_layer ! canopy layer of this cohort + real(r8), intent(out) :: lmort_direct ! direct (harvestable) mortality fraction + real(r8), intent(out) :: lmort_collateral ! collateral damage mortality fraction + real(r8), intent(out) :: lmort_infra ! infrastructure mortality fraction + real(r8), intent(out) :: l_degrad ! fraction of trees that are not killed + ! but suffer from forest degradation (i.e. they + ! are moved to newly-anthro-disturbed secondary + ! forest patch) + + ! Parameters + real(r8), parameter :: adjustment = 1.0 ! adjustment for mortality rates + + if (logging_time) then + if(EDPftvarcon_inst%woody(pft_i) == 1)then ! only set logging rates for trees + + ! Pass logging rates to cohort level + + if (dbh >= logging_dbhmin ) then + lmort_direct = logging_direct_frac * adjustment + l_degrad = 0._r8 + else + lmort_direct = 0.0_r8 + l_degrad = logging_direct_frac * adjustment + end if + + if (dbh >= logging_dbhmax_infra) then + lmort_infra = 0.0_r8 + l_degrad = l_degrad + logging_mechanical_frac * adjustment + else + lmort_infra = logging_mechanical_frac * adjustment + end if + !damage rates for size class < & > threshold_size need to be specified seperately + + ! Collateral damage to smaller plants below the direct logging size threshold + ! will be applied via "understory_death" via the disturbance algorithm + ! Important: Degredation rates really only have an impact when + ! applied to the canopy layer. So we don't add to degredation + ! for collateral damage, even understory collateral damage. + + if (canopy_layer .eq. 1) then + lmort_collateral = logging_collateral_frac * adjustment + else + lmort_collateral = 0._r8 + endif + + else + lmort_direct = 0.0_r8 + lmort_collateral = 0.0_r8 + lmort_infra = 0.0_r8 + l_degrad = 0.0_r8 + end if + else + lmort_direct = 0.0_r8 + lmort_collateral = 0.0_r8 + lmort_infra = 0.0_r8 + l_degrad = 0.0_r8 + end if + + end subroutine LoggingMortality_frac + + ! ============================================================================ + + subroutine logging_litter_fluxes(currentSite, currentPatch, newPatch, patch_site_areadis) + + ! ------------------------------------------------------------------------------------------- + ! + ! DESCRIPTION: + ! Carbon going from ongoing mortality into CWD pools. + ! This module includes only those fluxes associated with a disturbance generated by logging. + ! Purpose: + ! 1) move logging-associated carbon to CWD and litter pool + ! 2) move the logging trunk from live into product pool + ! 3) generate fluxes used in carbon balance checking + ! E.g,: + ! Remove trunk of logged trees from litter/CWD + ! Add other parts of logged trees and all parts of collaterally and mechanically + ! damaged trees into CWD/litter + ! + ! This routine is only called if logging disturbance is the dominant disturbance. + ! + ! + ! Note: The litter losses due to disturbance in the logging case is almost + ! exactly like the natural tree-fall case. The big differences are that + ! the mortality rates governing the fluxes, follow a different rule set. + ! We also compute an export flux (product) that does not go to litter. + ! + ! Trunk Product Flux: Only usable wood is exported from a site, substracted by a + ! transportation loss fraction. This is the above-ground portion of the bole, + ! and only boles associated with direct-logging, not inftrastructure or + ! collateral damage mortality. + ! + ! ------------------------------------------------------------------------------------------- + + + !USES: + use SFParamsMod, only : SF_val_cwd_frac + use EDtypesMod, only : area + use EDtypesMod, only : ed_site_type + use EDtypesMod, only : ed_patch_type + use EDtypesMod, only : ed_cohort_type + use FatesAllometryMod , only : carea_allom + + + ! !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 + + !LOCAL VARIABLES: + type(ed_cohort_type), pointer :: currentCohort + type(site_massbal_type), pointer :: site_mass + type(site_fluxdiags_type), pointer :: flux_diags + type(litter_type),pointer :: new_litt + type(litter_type),pointer :: cur_litt + + real(r8) :: direct_dead ! Mortality count through direct logging + real(r8) :: indirect_dead ! Mortality count through: impacts, infrastructure and collateral damage + real(r8) :: trunk_product_site ! flux of carbon in trunk products exported off site [ kgC/site ] + ! (note we are accumulating over the patch, but scale is site level) + real(r8) :: delta_litter_stock ! flux of carbon in total litter flux [ kgC/site ] + real(r8) :: delta_biomass_stock ! total flux of carbon through mortality (litter+product) [ kgC/site ] + real(r8) :: delta_individual ! change in plant number through mortality [ plants/site ] + real(r8) :: leaf_litter ! Leafy biomass transferred through mortality [kgC/site] + real(r8) :: root_litter ! Rooty + storage biomass transferred through mort [kgC/site] + real(r8) :: ag_wood ! above ground wood mass [kg] + real(r8) :: bg_wood ! below ground wood mass [kg] + real(r8) :: remainder_area ! current patch's remaining area after donation [m2] + real(r8) :: leaf_m ! leaf element mass [kg] + real(r8) :: fnrt_m ! fineroot element mass [kg] + real(r8) :: sapw_m ! sapwood element mass [kg] + real(r8) :: store_m ! storage element mass [kg] + real(r8) :: struct_m ! structure element mass [kg] + real(r8) :: repro_m ! reproductive mass [kg] + real(r8) :: retain_frac ! fraction of litter retained in the donor patch + real(r8) :: donate_frac ! fraction of litter sent to newly formed patch + real(r8) :: dcmpy_frac ! fraction going into each decomposability pool + integer :: dcmpy ! index for decomposability pools + integer :: element_id ! parteh global element index + integer :: pft ! pft index + integer :: c ! cwd index + integer :: nlevsoil ! number of soil layers + integer :: ilyr ! soil layer loop index + integer :: el ! elemend loop index + + + nlevsoil = currentSite%nlevsoil + + ! If/when sending litter fluxes to the old patch, we divide the total + ! mass sent to that patch, by the area it will have remaining + ! after it donates area. + ! i.e. subtract the area it is donating. + + remainder_area = currentPatch%area - patch_site_areadis + + + ! Calculate the fraction of litter to be retained versus donated + ! vis-a-vis the new and donor patch + + retain_frac = (1.0_r8-harvest_litter_localization) * & + remainder_area/(newPatch%area+remainder_area) + donate_frac = 1.0_r8-retain_frac + + do el = 1,num_elements + + element_id = element_list(el) + site_mass => currentSite%mass_balance(el) + flux_diags=> currentSite%flux_diags(el) + cur_litt => currentPatch%litter(el) ! Litter pool of "current" patch + new_litt => newPatch%litter(el) ! Litter pool of "new" patch + + + ! Zero some site level accumulator diagnsotics + trunk_product_site = 0.0_r8 + delta_litter_stock = 0.0_r8 + delta_biomass_stock = 0.0_r8 + delta_individual = 0.0_r8 + + ! ----------------------------------------------------------------------------- + ! Part 1: Send parts of dying plants to the litter pool. + ! ----------------------------------------------------------------------------- + + currentCohort => currentPatch%shortest + do while(associated(currentCohort)) + pft = currentCohort%pft + + 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) + fnrt_m = currentCohort%prt%GetState(fnrt_organ, element_id) + store_m = currentCohort%prt%GetState(store_organ, element_id) + repro_m = currentCohort%prt%GetState(repro_organ, element_id) + + if(currentCohort%canopy_layer == 1)then + direct_dead = currentCohort%n * currentCohort%lmort_direct + indirect_dead = currentCohort%n * & + (currentCohort%lmort_collateral + currentCohort%lmort_infra) + + else + + ! This routine is only called during disturbance. The litter + ! fluxes from non-disturbance generating mortality are + ! handled in EDPhysiology. Disturbance generating mortality + ! are those cohorts in the top canopy layer, or those + ! plants that were impacted. Thus, no direct dead can occur + ! here, and indirect are impacts. + + if(EDPftvarcon_inst%woody(currentCohort%pft) == 1)then + direct_dead = 0.0_r8 + indirect_dead = logging_coll_under_frac * & + (1._r8-currentPatch%fract_ldist_not_harvested) * currentCohort%n * & + (patch_site_areadis/currentPatch%area) !kgC/site/day + else + ! If the cohort of interest is grass, it will not experience + ! any mortality associated with the logging disturbance + direct_dead = 0.0_r8 + indirect_dead = 0.0_r8 + end if + end if + + if( (element_id .eq. carbon12_element) .and. & + hlm_use_planthydro == itrue ) then + call AccumulateMortalityWaterStorage(currentSite, & + currentCohort,(direct_dead+indirect_dead)) + end if + + ! ---------------------------------------------------------------------------------------- + ! Handle woody litter flux for non-bole components of biomass + ! This litter is distributed between the current and new patches, & + ! not to any other patches. This is really the eventually area of the current patch & + ! (currentPatch%area-patch_site_areadis) +patch_site_areadis... + ! For the new patch, only some fraction of its land area (patch_areadis/np%area) is + ! derived from the current patch, so we need to multiply by patch_areadis/np%area + ! ---------------------------------------------------------------------------------------- + + call set_root_fraction(currentSite%rootfrac_scr, pft, currentSite%zi_soil, & + icontext = i_biomass_rootprof_context) + + + ag_wood = (direct_dead+indirect_dead) * (struct_m + sapw_m ) * & + EDPftvarcon_inst%allom_agb_frac(currentCohort%pft) + bg_wood = (direct_dead+indirect_dead) * (struct_m + sapw_m ) * & + (1._r8 - EDPftvarcon_inst%allom_agb_frac(currentCohort%pft)) + + do c = 1,ncwd-1 + + new_litt%ag_cwd(c) = new_litt%ag_cwd(c) + & + ag_wood * SF_val_CWD_frac(c) * donate_frac/newPatch%area + cur_litt%ag_cwd(c) = cur_litt%ag_cwd(c) + & + ag_wood * SF_val_CWD_frac(c) * retain_frac/remainder_area + + do ilyr = 1,nlevsoil + + new_litt%bg_cwd(c,ilyr) = new_litt%bg_cwd(c,ilyr) + & + bg_wood * currentSite%rootfrac_scr(ilyr) * & + SF_val_CWD_frac(c) * donate_frac/newPatch%area + + cur_litt%bg_cwd(c,ilyr) = cur_litt%bg_cwd(c,ilyr) + & + bg_wood * currentSite%rootfrac_scr(ilyr) * & + SF_val_CWD_frac(c) * retain_frac/remainder_area + end do + + + ! Diagnostics on fluxes into the AG and BG CWD pools + flux_diags%cwd_ag_input(c) = flux_diags%cwd_ag_input(c) + & + SF_val_CWD_frac(c) * ag_wood + + flux_diags%cwd_bg_input(c) = flux_diags%cwd_bg_input(c) + & + SF_val_CWD_frac(c) * bg_wood + + ! Diagnostic specific to resource management code + if( element_id .eq. carbon12_element) then + delta_litter_stock = delta_litter_stock + & + (ag_wood + bg_wood) * SF_val_CWD_frac(c) + end if + + enddo + + ! ---------------------------------------------------------------------------------------- + ! Handle litter flux for the trunk wood of infrastucture and collateral damage mort + ! ---------------------------------------------------------------------------------------- + + ag_wood = indirect_dead * (struct_m + sapw_m ) * & + EDPftvarcon_inst%allom_agb_frac(currentCohort%pft) + bg_wood = indirect_dead * (struct_m + sapw_m ) * & + (1._r8 - EDPftvarcon_inst%allom_agb_frac(currentCohort%pft)) + + new_litt%ag_cwd(ncwd) = new_litt%ag_cwd(ncwd) + ag_wood * & + SF_val_CWD_frac(ncwd) * donate_frac/newPatch%area + + cur_litt%ag_cwd(ncwd) = cur_litt%ag_cwd(ncwd) + ag_wood * & + SF_val_CWD_frac(ncwd) * retain_frac/remainder_area + + do ilyr = 1,nlevsoil + + new_litt%bg_cwd(ncwd,ilyr) = new_litt%bg_cwd(ncwd,ilyr) + & + bg_wood * currentSite%rootfrac_scr(ilyr) * & + SF_val_CWD_frac(ncwd) * donate_frac/newPatch%area + + cur_litt%bg_cwd(ncwd,ilyr) = cur_litt%bg_cwd(ncwd,ilyr) + & + bg_wood * currentSite%rootfrac_scr(ilyr) * & + SF_val_CWD_frac(ncwd) * retain_frac/remainder_area + + end do + + flux_diags%cwd_ag_input(ncwd) = flux_diags%cwd_ag_input(ncwd) + & + SF_val_CWD_frac(ncwd) * ag_wood + + flux_diags%cwd_bg_input(ncwd) = flux_diags%cwd_bg_input(ncwd) + & + SF_val_CWD_frac(ncwd) * bg_wood + + if( element_id .eq. carbon12_element) then + delta_litter_stock = delta_litter_stock + & + (ag_wood+bg_wood) * SF_val_CWD_frac(ncwd) + end if + + ! --------------------------------------------------------------------------------------- + ! Handle below-ground trunk flux for directly logged trees (c = ncwd) + ! ---------------------------------------------------------------------------------------- + + bg_wood = direct_dead * (struct_m + sapw_m ) * SF_val_CWD_frac(ncwd) * & + (1._r8 - EDPftvarcon_inst%allom_agb_frac(currentCohort%pft)) + + do ilyr = 1,nlevsoil + new_litt%bg_cwd(ncwd,ilyr) = new_litt%bg_cwd(ncwd,ilyr) + & + bg_wood * currentSite%rootfrac_scr(ilyr) * & + donate_frac/newPatch%area + + cur_litt%bg_cwd(ncwd,ilyr) = cur_litt%bg_cwd(ncwd,ilyr) + & + bg_wood * currentSite%rootfrac_scr(ilyr) * & + retain_frac/remainder_area + end do + + flux_diags%cwd_bg_input(ncwd) = flux_diags%cwd_bg_input(ncwd) + & + bg_wood + + ! ---------------------------------------------------------------------------------------- + ! Handle harvest (export, flux-out) flux for the above ground boles + ! In this case a fraction (export_frac) of the boles from direct logging are + ! exported off-site, while the remainder (1-export_frac) is added to the litter pools. + ! + ! Losses to the system as a whole, for C-balancing (kGC/site/day) + ! Site level product, (kgC/site, accumulated over simulation) + ! ---------------------------------------------------------------------------------------- + + ag_wood = direct_dead * (struct_m + sapw_m ) * & + EDPftvarcon_inst%allom_agb_frac(currentCohort%pft) * & + SF_val_CWD_frac(ncwd) + + trunk_product_site = trunk_product_site + & + ag_wood * logging_export_frac + + ! This is for checking the total mass balance [kg/site/day] + site_mass%wood_product = site_mass%wood_product + & + ag_wood * logging_export_frac + + new_litt%ag_cwd(ncwd) = new_litt%ag_cwd(ncwd) + ag_wood * & + (1._r8-logging_export_frac)*donate_frac/newPatch%area + + cur_litt%ag_cwd(ncwd) = cur_litt%ag_cwd(ncwd) + ag_wood * & + (1._r8-logging_export_frac)*retain_frac/remainder_area + + ! --------------------------------------------------------------------------- + ! Handle fluxes of leaf, root and storage carbon into litter pools. + ! (none of these are exported) + ! --------------------------------------------------------------------------- + + leaf_litter = (direct_dead+indirect_dead)*(leaf_m + repro_m) + root_litter = (direct_dead+indirect_dead)*(fnrt_m + store_m) + + + do dcmpy=1,ndcmpy + + dcmpy_frac = GetDecompyFrac(pft,leaf_organ,dcmpy) + + new_litt%leaf_fines(dcmpy) = new_litt%leaf_fines(dcmpy) + & + leaf_litter * donate_frac/newPatch%area * dcmpy_frac + + cur_litt%leaf_fines(dcmpy) = cur_litt%leaf_fines(dcmpy) + & + leaf_litter * retain_frac/remainder_area * dcmpy_frac + + dcmpy_frac = GetDecompyFrac(pft,fnrt_organ,dcmpy) + do ilyr = 1,nlevsoil + new_litt%root_fines(dcmpy,ilyr) = new_litt%root_fines(dcmpy,ilyr) + & + root_litter * currentSite%rootfrac_scr(ilyr) * dcmpy_frac * & + donate_frac/newPatch%area + + cur_litt%root_fines(dcmpy,ilyr) = cur_litt%root_fines(dcmpy,ilyr) + & + root_litter * currentSite%rootfrac_scr(ilyr) * dcmpy_frac * & + retain_frac/remainder_area + end do + end do + + ! track as diagnostic fluxes + flux_diags%leaf_litter_input(pft) = flux_diags%leaf_litter_input(pft) + & + leaf_litter + + flux_diags%root_litter_input(pft) = flux_diags%root_litter_input(pft) + & + root_litter + + ! Logging specific diagnostics + ! ---------------------------------------------------------------------------------------- + + ! Note that litter stock also has terms above in the CWD loop + if( element_id .eq. carbon12_element) then + delta_litter_stock = delta_litter_stock + & + leaf_litter + & + root_litter + + delta_biomass_stock = delta_biomass_stock + & + leaf_litter + & + root_litter + & + (direct_dead+indirect_dead) * (struct_m + sapw_m) + + delta_individual = delta_individual + & + direct_dead + & + indirect_dead + end if + + currentCohort => currentCohort%taller + end do + + ! Update the amount of carbon exported from the site through logging + ! operations. Currently we assume only above-ground portion + ! of the tree bole that experienced "direct" logging is exported + ! This portion is known as "trunk_product_site + + if(element_id .eq. carbon12_element) then + currentSite%resources_management%trunk_product_site = & + currentSite%resources_management%trunk_product_site + & + trunk_product_site + + currentSite%resources_management%delta_litter_stock = & + currentSite%resources_management%delta_litter_stock + & + delta_litter_stock + + currentSite%resources_management%delta_biomass_stock = & + currentSite%resources_management%delta_biomass_stock + & + delta_biomass_stock + + currentSite%resources_management%delta_individual = & + currentSite%resources_management%delta_individual + & + delta_individual + + end if + + end do + + ! Not sure why this is called here, but I suppose it can't hurt + ! (rgk 06-2019) + + currentCohort => newPatch%shortest + do while(associated(currentCohort)) + call carea_allom(currentCohort%dbh,currentCohort%n,currentSite%spread, & + currentCohort%pft,currentCohort%c_area) + currentCohort => currentCohort%taller + enddo + + return + end subroutine logging_litter_fluxes + +end module EDLoggingMortalityMod diff --git a/biogeochem/EDMortalityFunctionsMod.F90 b/biogeochem/EDMortalityFunctionsMod.F90 index d527b59b0b..bb39e6cf39 100644 --- a/biogeochem/EDMortalityFunctionsMod.F90 +++ b/biogeochem/EDMortalityFunctionsMod.F90 @@ -59,6 +59,7 @@ subroutine mortality_rates( cohort_in,bc_in,cmort,hmort,bmort,frmort ) real(r8),intent(out) :: hmort ! hydraulic failure mortality real(r8),intent(out) :: frmort ! freezing stress mortality + real(r8) :: frac ! relativised stored carbohydrate real(r8) :: leaf_c_target ! target leaf biomass kgC real(r8) :: store_c @@ -125,8 +126,7 @@ subroutine mortality_rates( cohort_in,bc_in,cmort,hmort,bmort,frmort ) 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 @@ -200,15 +200,18 @@ subroutine Mortality_Derivative( currentSite, currentCohort, bc_in) currentCohort%lmort_infra, & currentCohort%l_degrad) + + + if (currentCohort%canopy_layer > 1)then - ! Include understory logging mortality rates not associated with disturbance dndt_logging = (currentCohort%lmort_direct + & currentCohort%lmort_collateral + & currentCohort%lmort_infra)/hlm_freq_day - currentCohort%dndt = -1.0_r8 * (cmort+hmort+bmort+frmort+dndt_logging) * currentCohort%n else + ! 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) * currentCohort%n endif diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 7969773b8a..a68a47a65e 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -6,12 +6,22 @@ module EDPatchDynamicsMod use FatesGlobals , only : fates_log use FatesInterfaceMod , only : hlm_freq_day use EDPftvarcon , only : EDPftvarcon_inst + use EDPftvarcon , only : GetDecompyFrac use EDCohortDynamicsMod , only : fuse_cohorts, sort_cohorts, insert_cohort - use EDtypesMod , only : ncwd, n_dbh_bins, area, patchfusion_dbhbin_loweredges + use EDCohortDynamicsMod , only : DeallocateCohort + use EDTypesMod , only : area_site => area + use ChecksBalancesMod , only : PatchMassStock + use FatesLitterMod , only : ncwd + use FatesLitterMod , only : ndcmpy + use FatesLitterMod , only : litter_type + use EDTypesMod , only : homogenize_seed_pfts + use EDTypesMod , only : n_dbh_bins, area, patchfusion_dbhbin_loweredges use EDtypesMod , only : force_patchfuse_min_biomass use EDTypesMod , only : maxPatchesPerSite use EDTypesMod , only : maxPatchesPerSite_by_disttype use EDTypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type + use EDTypesMod , only : site_massbal_type + use EDTypesMod , only : site_fluxdiags_type use EDTypesMod , only : min_patch_area use EDTypesMod , only : min_patch_area_forced use EDTypesMod , only : nclmax @@ -20,6 +30,13 @@ module EDPatchDynamicsMod use EDTypesMod , only : dtype_ilog use EDTypesMod , only : dtype_ifire use EDTypesMod , only : ican_upper + use EDTypesMod , only : num_elements + use EDTypesMod , only : element_list + use EDTypesMod , only : element_pos + use EDTypesMod , only : lg_sf + use EDTypesMod , only : dl_sf + use EDTypesMod , only : dump_patch + use FatesConstantsMod , only : rsnbl_math_prec use FatesInterfaceMod , only : hlm_use_planthydro use FatesInterfaceMod , only : hlm_numSWb use FatesInterfaceMod , only : bc_in_type @@ -27,7 +44,7 @@ module EDPatchDynamicsMod use FatesInterfaceMod , only : numpft use FatesGlobals , only : endrun => fates_endrun use FatesConstantsMod , only : r8 => fates_r8 - use FatesConstantsMod , only : itrue + use FatesConstantsMod , only : itrue, ifalse use FatesPlantHydraulicsMod, only : InitHydrCohort use FatesPlantHydraulicsMod, only : AccumulateMortalityWaterStorage use FatesPlantHydraulicsMod, only : DeallocateHydrCohort @@ -35,6 +52,8 @@ module EDPatchDynamicsMod use EDLoggingMortalityMod, only : logging_time use EDParamsMod , only : fates_mortality_disturbance_fraction use FatesAllometryMod , only : carea_allom + use FatesAllometryMod , only : set_root_fraction + use FatesAllometryMod , only : i_biomass_rootprof_context use FatesConstantsMod , only : g_per_kg use FatesConstantsMod , only : ha_per_m2 use FatesConstantsMod , only : days_per_sec @@ -42,10 +61,13 @@ module EDPatchDynamicsMod use FatesConstantsMod , only : nearzero use FatesConstantsMod , only : primaryforest, secondaryforest use FatesConstantsMod , only : n_anthro_disturbance_categories - - use EDCohortDynamicsMod , only : InitPRTCohort - + use FatesConstantsMod , only : fates_unset_r8 + use FatesConstantsMod , only : fates_unset_int + use EDCohortDynamicsMod , only : InitPRTObject + use EDCohortDynamicsMod , only : InitPRTBoundaryConditions + use ChecksBalancesMod, only : SiteMassStock use PRTGenericMod, only : all_carbon_elements + use PRTGenericMod, only : carbon12_element use PRTGenericMod, only : leaf_organ use PRTGenericMod, only : fnrt_organ use PRTGenericMod, only : sapw_organ @@ -53,7 +75,9 @@ module EDPatchDynamicsMod use PRTGenericMod, only : repro_organ use PRTGenericMod, only : struct_organ use PRTLossFluxesMod, only : PRTBurnLosses - + use FatesInterfaceMod, only : hlm_parteh_mode + use PRTGenericMod, only : prt_carbon_allom_hyp + use PRTGenericMod, only : prt_cnp_flex_allom_hyp ! CIME globals use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) @@ -79,6 +103,26 @@ module EDPatchDynamicsMod logical, parameter :: debug = .false. + ! When creating new patches from other patches, we need to send some of the + ! litter from the old patch to the new patch. Likewise, when plants die + ! from the disturbance, we need to send some amount from the old patch to + ! the new patch. If the plant matter falls straight down, then that + ! would make a case for all of the litter going to the new patch. + ! This would be localization=1 + ! But if we think some of the plant matter drifts, or a tall tree lands + ! outside of its gap, or are afraid of newly formed patches having + ! too much burnable material, then we drop the localization from 1 down + ! a notch. + ! Note that in all cases, a localization of 0, suggests that litter + ! is dispensed randomly in space among the area of the new and old + ! patch combined. A localization of 1 suggests that + ! all litter is sent to the new patch. + + 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 + + ! 10/30/09: Created by Rosie Fisher ! ============================================================================ @@ -151,13 +195,14 @@ subroutine disturbance_rates( site_in, bc_in) call LoggingMortality_frac(currentCohort%pft, currentCohort%dbh, currentCohort%canopy_layer, & lmort_direct,lmort_collateral,lmort_infra,l_degrad ) - currentCohort%lmort_direct = lmort_direct + currentCohort%lmort_direct = lmort_direct currentCohort%lmort_collateral = lmort_collateral currentCohort%lmort_infra = lmort_infra currentCohort%l_degrad = l_degrad currentCohort => currentCohort%taller end do + currentPatch%disturbance_mode = fates_unset_int currentPatch => currentPatch%younger end do @@ -186,7 +231,7 @@ subroutine disturbance_rates( site_in, bc_in) ! Logging Disturbance Rate currentPatch%disturbance_rates(dtype_ilog) = currentPatch%disturbance_rates(dtype_ilog) + & - min(1.0_r8, currentCohort%lmort_direct + & + min(1.0_r8, currentCohort%lmort_direct + & currentCohort%lmort_collateral + & currentCohort%lmort_infra + & currentCohort%l_degrad ) * & @@ -207,14 +252,14 @@ subroutine disturbance_rates( site_in, bc_in) endif ! Fire Disturbance Rate - ! Fudge - fires can't burn the whole patch, as this causes /0 errors. - ! This is accumulating the daily fires over the whole 30 day patch generation phase. - currentPatch%disturbance_rates(dtype_ifire) = & - min(0.99_r8,currentPatch%disturbance_rates(dtype_ifire) + currentPatch%frac_burnt) + ! Fires can't burn the whole patch, as this causes /0 errors. + currentPatch%disturbance_rates(dtype_ifire) = currentPatch%frac_burnt - if (currentPatch%disturbance_rates(dtype_ifire) > 0.98_r8)then + if (debug) then + if (currentPatch%disturbance_rates(dtype_ifire) > 0.98_r8)then write(fates_log(),*) 'very high fire areas', & - currentPatch%disturbance_rates(dtype_ifire),currentPatch%frac_burnt + currentPatch%disturbance_rates(dtype_ifire),currentPatch%frac_burnt + endif endif @@ -226,11 +271,12 @@ subroutine disturbance_rates( site_in, bc_in) ! to still diagnose and track the non-disturbance rate ! ------------------------------------------------------------------------------------------ - + ! DISTURBANCE IS LOGGING if (currentPatch%disturbance_rates(dtype_ilog) > currentPatch%disturbance_rates(dtype_ifall) .and. & currentPatch%disturbance_rates(dtype_ilog) > currentPatch%disturbance_rates(dtype_ifire) ) then currentPatch%disturbance_rate = currentPatch%disturbance_rates(dtype_ilog) + currentPatch%disturbance_mode = dtype_ilog ! Update diagnostics currentCohort => currentPatch%shortest @@ -245,11 +291,12 @@ subroutine disturbance_rates( site_in, bc_in) currentCohort => currentCohort%taller enddo !currentCohort - ! DISTURBANCE IS FIRE + ! DISTURBANCE IS FIRE elseif (currentPatch%disturbance_rates(dtype_ifire) > currentPatch%disturbance_rates(dtype_ifall) .and. & currentPatch%disturbance_rates(dtype_ifire) > currentPatch%disturbance_rates(dtype_ilog) ) then currentPatch%disturbance_rate = currentPatch%disturbance_rates(dtype_ifire) + currentPatch%disturbance_mode = dtype_ifire ! Update diagnostics, zero non-fire mortality rates currentCohort => currentPatch%shortest @@ -275,11 +322,12 @@ subroutine disturbance_rates( site_in, bc_in) currentCohort => currentCohort%taller enddo !currentCohort - else ! If fire and loggin are not greater than treefall, just set disturbance rate to tree-fall + else ! If fire and logging are not greater than treefall, just set disturbance rate to tree-fall ! which is most likely a 0.0 currentPatch%disturbance_rate = currentPatch%disturbance_rates(dtype_ifall) - + currentPatch%disturbance_mode = dtype_ifall + ! Update diagnostics, zero non-treefall mortality rates currentCohort => currentPatch%shortest do while(associated(currentCohort)) @@ -340,12 +388,9 @@ subroutine spawn_patches( currentSite, bc_in) real(r8) :: site_areadis_secondary ! total area disturbed (to secondary forest) in m2 per site per day real(r8) :: patch_site_areadis ! total area disturbed in m2 per patch per day real(r8) :: age ! notional age of this patch in years + integer :: el ! element loop index integer :: tnull ! is there a tallest cohort? integer :: snull ! is there a shortest cohort? - real(r8) :: root_litter_local(maxpft) ! initial value of root litter. KgC/m2 - real(r8) :: leaf_litter_local(maxpft) ! initial value of leaf litter. KgC/m2 - real(r8) :: cwd_ag_local(ncwd) ! initial value of above ground coarse woody debris. KgC/m2 - real(r8) :: cwd_bg_local(ncwd) ! initial value of below ground coarse woody debris. KgC/m2 integer :: levcan ! canopy level real(r8) :: leaf_c ! leaf carbon [kg] real(r8) :: fnrt_c ! fineroot carbon [kg] @@ -353,7 +398,9 @@ subroutine spawn_patches( currentSite, bc_in) real(r8) :: store_c ! storage carbon [kg] real(r8) :: struct_c ! structure 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 !--------------------------------------------------------------------- storesmallcohort => null() ! storage of the smallest cohort for insertion routine @@ -362,21 +409,24 @@ subroutine spawn_patches( currentSite, bc_in) ! calculate area of disturbed land, in this timestep, by summing contributions from each existing patch. currentPatch => currentSite%youngest_patch - ! zero site-level fire fluxes - currentSite%cwd_ag_burned = 0.0_r8 - currentSite%leaf_litter_burned = 0.0_r8 - currentSite%total_burn_flux_to_atm = 0.0_r8 - site_areadis_primary = 0.0_r8 site_areadis_secondary = 0.0_r8 + do while(associated(currentPatch)) - !FIX(RF,032414) Does using the max(fire,mort) actually make sense here? + if(currentPatch%disturbance_rate>1.0_r8) then write(fates_log(),*) 'patch disturbance rate > 1 ?',currentPatch%disturbance_rate call endrun(msg=errMsg(sourcefile, __LINE__)) end if + ! Check to make sure that the disturbance mode of the patch is set + if( .not.any(currentPatch%disturbance_mode == [dtype_ilog,dtype_ifall,dtype_ifire])) then + write(fates_log(),*) 'undefined disturbance mode? : ',currentPatch%disturbance_mode + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + ! Only create new patches that have non-negligible amount of land if((currentPatch%area*currentPatch%disturbance_rate) > nearzero ) then @@ -384,8 +434,7 @@ subroutine spawn_patches( currentSite, bc_in) ! 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_rates(dtype_ilog) .lt. currentPatch%disturbance_rates(dtype_ifall) .or. & - currentPatch%disturbance_rates(dtype_ilog) .lt. currentPatch%disturbance_rates(dtype_ifire)) ) then + (currentPatch%disturbance_mode .ne. dtype_ilog) ) then site_areadis_primary = site_areadis_primary + currentPatch%area * currentPatch%disturbance_rate else @@ -393,138 +442,170 @@ subroutine spawn_patches( currentSite, bc_in) endif end if - + currentPatch => currentPatch%older - enddo ! end loop over patches. sum area disturbed for all patches. - + ! It is possible that no disturbance area was generated if ( (site_areadis_primary + site_areadis_secondary) > nearzero) then - cwd_ag_local = 0.0_r8 - cwd_bg_local = 0.0_r8 - leaf_litter_local = 0.0_r8 - root_litter_local = 0.0_r8 age = 0.0_r8 ! create two empty patches, to absorb newly disturbed primary and secondary forest area ! first create patch to receive primary forest area if ( site_areadis_primary .gt. nearzero ) then allocate(new_patch_primary) - call create_patch(currentSite, new_patch_primary, age, site_areadis_primary, & - cwd_ag_local, cwd_bg_local, leaf_litter_local, & - root_litter_local, bc_in%nlevsoil, primaryforest) + + call create_patch(currentSite, new_patch_primary, age, & + site_areadis_primary, primaryforest) + + ! Initialize the litter pools to zero, these + ! pools will be populated by looping over the existing patches + ! and transfering in mass + do el=1,num_elements + call new_patch_primary%litter(el)%InitConditions(init_leaf_fines=0._r8, & + init_root_fines=0._r8, & + init_ag_cwd=0._r8, & + init_bg_cwd=0._r8, & + init_seed=0._r8, & + init_seed_germ=0._r8) + end do new_patch_primary%tallest => null() new_patch_primary%shortest => null() + endif + ! next create patch to receive secondary forest area if ( site_areadis_secondary .gt. nearzero) then allocate(new_patch_secondary) - call create_patch(currentSite, new_patch_secondary, age, site_areadis_secondary, & - cwd_ag_local, cwd_bg_local, leaf_litter_local, & - root_litter_local, bc_in%nlevsoil, secondaryforest) + call create_patch(currentSite, new_patch_secondary, age, & + site_areadis_secondary, secondaryforest) + + ! Initialize the litter pools to zero, these + ! pools will be populated by looping over the existing patches + ! and transfering in mass + do el=1,num_elements + call new_patch_secondary%litter(el)%InitConditions(init_leaf_fines=0._r8, & + init_root_fines=0._r8, & + init_ag_cwd=0._r8, & + init_bg_cwd=0._r8, & + init_seed=0._r8, & + init_seed_germ=0._r8) + end do new_patch_secondary%tallest => null() - new_patch_secondary%shortest => null() + new_patch_secondary%shortest => null() + endif - currentPatch => currentSite%oldest_patch ! loop round all the patches that contribute surviving indivduals and litter - ! pools to the new patch. - do while(associated(currentPatch)) + ! 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_rates(dtype_ilog) .lt. & - currentPatch%disturbance_rates(dtype_ifall)) .or. & - (currentPatch%disturbance_rates(dtype_ilog) .lt. & - currentPatch%disturbance_rates(dtype_ifire)))) then - new_patch => new_patch_primary - else - new_patch => new_patch_secondary - endif + + 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 ! 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_rates(dtype_ilog) .lt. & - currentPatch%disturbance_rates(dtype_ifall)) .or. & - (currentPatch%disturbance_rates(dtype_ilog) .lt. & - currentPatch%disturbance_rates(dtype_ifire)))) 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 - call average_patch_properties(currentPatch, new_patch, patch_site_areadis) - - if ((currentPatch%disturbance_rates(dtype_ilog) > & - currentPatch%disturbance_rates(dtype_ifall)) .and. & - (currentPatch%disturbance_rates(dtype_ilog) > & - currentPatch%disturbance_rates(dtype_ifire)) ) then - + + ! 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 + end if + + call TransLitterNewPatch( currentSite, currentPatch, new_patch, patch_site_areadis) + + ! Transfer in litter fluxes from plants in various contexts of death and destruction + + if(currentPatch%disturbance_mode .eq. dtype_ilog) then call logging_litter_fluxes(currentSite, currentPatch, new_patch, patch_site_areadis) - - elseif ((currentPatch%disturbance_rates(dtype_ifire) > & - currentPatch%disturbance_rates(dtype_ifall)) .and. & - (currentPatch%disturbance_rates(dtype_ifire) > & - currentPatch%disturbance_rates(dtype_ilog)) ) then - + elseif(currentPatch%disturbance_mode .eq. dtype_ifire) then call fire_litter_fluxes(currentSite, currentPatch, new_patch, patch_site_areadis) - else - call mortality_litter_fluxes(currentSite, currentPatch, new_patch, patch_site_areadis) - endif - - !INSERT SURVIVORS FROM DISTURBANCE INTO NEW PATCH + + ! -------------------------------------------------------------------------- + ! The newly formed patch from disturbance (new_patch), has now been given + ! some litter from dead plants and pre-existing litter from the donor patches. + ! + ! Next, we loop through the cohorts in the donor patch, copy them with + ! area modified number density into the new-patch, and apply survivorship. + ! ------------------------------------------------------------------------- + currentCohort => currentPatch%shortest do while(associated(currentCohort)) - - allocate(nc) - if(hlm_use_planthydro.eq.itrue) call InitHydrCohort(CurrentSite,nc) - call InitPRTCohort(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_rates(dtype_ifall) > & - currentPatch%disturbance_rates(dtype_ifire)) .and. & - (currentPatch%disturbance_rates(dtype_ifall) > & - currentPatch%disturbance_rates(dtype_ilog)))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) + + ! 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 - + 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 @@ -571,7 +652,6 @@ subroutine spawn_patches( currentSite, bc_in) nc%n * 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 @@ -626,16 +706,13 @@ subroutine spawn_patches( currentSite, bc_in) endif ! Fire is the dominant disturbance - elseif ((currentPatch%disturbance_rates(dtype_ifire) > & - currentPatch%disturbance_rates(dtype_ifall)) .and. & - (currentPatch%disturbance_rates(dtype_ifire) > & - currentPatch%disturbance_rates(dtype_ilog))) then !fire + 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) + currentCohort%n = currentCohort%n * (1._r8 - patch_site_areadis/currentPatch%area) levcan = currentCohort%canopy_layer @@ -679,13 +756,54 @@ subroutine spawn_patches( currentSite, bc_in) nc%lmort_direct = currentCohort%lmort_direct nc%lmort_collateral = currentCohort%lmort_collateral nc%lmort_infra = currentCohort%lmort_infra + + + ! Some of of the leaf mass from living plants has been + ! burned off. Here, we remove that mass, and + ! tally it in the flux we sent to the atmosphere + + if(EDPftvarcon_inst%woody(currentCohort%pft) == 1)then + leaf_burn_frac = currentCohort%fraction_crown_burned + else + + ! Grasses determine their fraction of leaves burned here + + leaf_burn_frac = currentPatch%burnt_frac_litter(lg_sf) + endif + ! Perform a check to make sure that spitfire gave + ! us reasonable mortality and burn fraction rates - ! Logging is the dominant disturbance - elseif ((currentPatch%disturbance_rates(dtype_ilog) > & - currentPatch%disturbance_rates(dtype_ifall)) .and. & - (currentPatch%disturbance_rates(dtype_ilog) > & - currentPatch%disturbance_rates(dtype_ifire))) then ! Logging + 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(),*) EDPftvarcon_inst%woody(currentCohort%pft) + write(fates_log(),*) leaf_burn_frac + write(fates_log(),*) currentCohort%fire_mort + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + do el = 1,num_elements + + leaf_m = nc%prt%GetState(leaf_organ, element_list(el)) + + currentSite%mass_balance(el)%burn_flux_to_atm = & + currentSite%mass_balance(el)%burn_flux_to_atm + & + leaf_burn_frac * leaf_m * nc%n + end do + + ! Here the mass is removed from the plant + + call PRTBurnLosses(nc%prt, leaf_organ, leaf_burn_frac) + currentCohort%fraction_crown_burned = 0.0_r8 + nc%fraction_crown_burned = 0.0_r8 + + + + ! Logging is the 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 @@ -756,7 +874,7 @@ subroutine spawn_patches( currentSite, bc_in) ! LOGGING SURVIVORSHIP OF UNDERSTORY PLANTS IS SET AS A NEW PARAMETER ! in the fatesparameter files nc%n = nc%n * (1.0_r8 - & - currentPatch%fract_ldist_not_harvested * logging_coll_under_frac) + (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 @@ -795,7 +913,11 @@ subroutine spawn_patches( currentSite, bc_in) endif ! Select canopy layer - end if ! Select disturbance mode + 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 if (nc%n > 0.0_r8) then storebigcohort => new_patch%tallest @@ -824,9 +946,7 @@ subroutine spawn_patches( currentSite, bc_in) else ! Get rid of the new temporary cohort - if(hlm_use_planthydro.eq.itrue) call DeallocateHydrCohort(nc) - call nc%prt%DeallocatePRTVartypes() - deallocate(nc%prt) + call DeallocateCohort(nc) deallocate(nc) endif @@ -842,12 +962,12 @@ subroutine spawn_patches( currentSite, bc_in) ! the first call to terminate cohorts removes sparse number densities, ! the second call removes for all other reasons (sparse culling must happen ! before fusion) - call terminate_cohorts(currentSite, currentPatch, 1) + call terminate_cohorts(currentSite, currentPatch, 1,16) call fuse_cohorts(currentSite,currentPatch, bc_in) - call terminate_cohorts(currentSite, currentPatch, 2) + call terminate_cohorts(currentSite, currentPatch, 2,16) call sort_cohorts(currentPatch) - - end if ! if (patch_site_areadis > nearzero) then + + end if ! if ( new_patch%area > nearzero ) then !zero disturbance rate trackers currentPatch%disturbance_rate = 0._r8 @@ -856,28 +976,28 @@ subroutine spawn_patches( currentSite, bc_in) currentPatch => currentPatch%younger - enddo ! currentPatch patch loop. + enddo ! currentPatch patch loop. - - !*************************/ - !** INSERT NEW PATCH(ES) INTO LINKED LIST - !**********`***************/ + !*************************/ + !** INSERT NEW PATCH(ES) INTO LINKED LIST + !**********`***************/ - if ( site_areadis_primary .gt. nearzero) then + if ( site_areadis_primary .gt. nearzero) then currentPatch => currentSite%youngest_patch new_patch_primary%older => currentPatch - new_patch_primary%younger => NULL() + new_patch_primary%younger => null() currentPatch%younger => new_patch_primary currentSite%youngest_patch => new_patch_primary - endif - - if ( site_areadis_secondary .gt. nearzero) then + endif + + if ( site_areadis_secondary .gt. nearzero) then currentPatch => currentSite%youngest_patch new_patch_secondary%older => currentPatch - new_patch_secondary%younger=> NULL() + new_patch_secondary%younger=> null() currentPatch%younger => new_patch_secondary currentSite%youngest_patch => new_patch_secondary - endif + endif + ! sort out the cohorts, since some of them may be so small as to need removing. ! the first call to terminate cohorts removes sparse number densities, @@ -885,16 +1005,16 @@ subroutine spawn_patches( currentSite, bc_in) ! before fusion) if ( site_areadis_primary .gt. nearzero) then - call terminate_cohorts(currentSite, new_patch_primary, 1) + call terminate_cohorts(currentSite, new_patch_primary, 1,17) call fuse_cohorts(currentSite,new_patch_primary, bc_in) - call terminate_cohorts(currentSite, new_patch_primary, 2) + call terminate_cohorts(currentSite, new_patch_primary, 2,17) call sort_cohorts(new_patch_primary) endif if ( site_areadis_secondary .gt. nearzero) then - call terminate_cohorts(currentSite, new_patch_secondary, 1) + call terminate_cohorts(currentSite, new_patch_secondary, 1,18) call fuse_cohorts(currentSite,new_patch_secondary, bc_in) - call terminate_cohorts(currentSite, new_patch_secondary, 2) + call terminate_cohorts(currentSite, new_patch_secondary, 2,18) call sort_cohorts(new_patch_secondary) endif @@ -908,6 +1028,7 @@ subroutine spawn_patches( currentSite, bc_in) end subroutine spawn_patches ! ============================================================================ + subroutine check_patch_area( currentSite ) ! ! !DESCRIPTION: @@ -919,11 +1040,16 @@ subroutine check_patch_area( currentSite ) type(ed_site_type), intent(in), target :: currentSite ! ! !LOCAL VARIABLES: - real(r8) :: areatot + real(r8) :: areatot type(ed_patch_type), pointer :: currentPatch type(ed_patch_type), pointer :: largestPatch - real(r8) :: largest_area - real(r8), parameter :: area_error_fail = 1.0e-6_r8 + real(r8) :: largest_area + integer :: el + real(r8) :: live_stock + real(r8) :: seed_stock + real(r8) :: litter_stock + real(r8) :: mass_gain + real(r8), parameter :: area_error_fail = 1.0e-6_r8 !--------------------------------------------------------------------- areatot = 0._r8 @@ -941,11 +1067,11 @@ subroutine check_patch_area( currentSite ) currentPatch => currentPatch%younger end do - if ( abs( areatot - area ) > nearzero ) then + if ( abs( areatot - area_site ) > nearzero ) then - if ( abs(areatot-area) > area_error_fail ) then + if ( abs(areatot-area_site) > area_error_fail ) then write(fates_log(),*) 'Patch areas do not sum to 10000 within tolerance' - write(fates_log(),*) 'Total area: ',areatot,'absolute error: ',areatot-area + write(fates_log(),*) 'Total area: ',areatot,'absolute error: ',areatot-area_site call endrun(msg=errMsg(sourcefile, __LINE__)) end if @@ -954,7 +1080,20 @@ subroutine check_patch_area( currentSite ) write(fates_log(),*) 'largest patch. This may have slight impacts on carbon balance.' end if - largestPatch%area = largestPatch%area + (area-areatot) + 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) + + ! Then we scale the total mass by the added area + mass_gain = (seed_stock+litter_stock) * & + (area_site-areatot)/largestPatch%area + + currentSite%mass_balance(el)%patch_resize_err = & + currentSite%mass_balance(el)%patch_resize_err + mass_gain + + end do + + largestPatch%area = largestPatch%area + (area_site-areatot) endif @@ -988,294 +1127,473 @@ subroutine set_patchno( currentSite ) end subroutine set_patchno ! ============================================================================ - subroutine average_patch_properties( currentPatch, newPatch, patch_site_areadis ) + + subroutine TransLitterNewPatch(currentSite, & + currentPatch, & + newPatch, & + patch_site_areadis) + + ! ----------------------------------------------------------------------------------- + ! + ! This routine transfers litter fluxes and rates from a donor patch "currentPatch" into + ! the new patch. + ! This may include the transfer of existing litter from a patch that burned. + ! This ROUTINE DOES TRANSFER PARTIALLY BURNED LITTER ! - ! !DESCRIPTION: - ! Average together the state properties of all of the donor patches that - ! make up the new patch. + ! Also, note we are not transfering in diagnostics that were calculated + ! prior to disturbance, because those diagnostics we applied to the patch + ! before it split, so the diagnostics should reflect those ages and areas. + ! + ! We do transfer fragmentation fluxes, because we need maintain mass conservation. + ! + ! We do transfer the seed pool, because we don't currently burn seeds. + ! Note the seed-pool can decay into the litter pool, where + ! it can burn. + ! + ! The "newPatch" is the newly created patch. This patch has already been given + ! an area which is the sum of disturbed area from a list of donors. + ! At this point in the call sequence, we are looping over a list of + ! donor patches, and transferring over their litter pools which is in units + ! kg/m2, we need to make sure that we are conserving mass. + ! + ! AD = Area of each Donor [m2] + ! LD = Litter of each Donor [kg/m2] + ! + ! SUM( AD * LD) / SUM (AD) = SUM( AD*LD/SUM(AD) ) + ! + ! newPatch%area = SUM(AD) the sum of all donor areas has already been given to newPatch + ! patch_site_areadis = AD this is the currently donated area + ! + ! The fragmentation/decomposition flux from donor patches has + ! already occured in existing patches. However some of their area + ! has been carved out for this new patch which is receiving donations. + ! Lets maintain conservation on that pre-existing mass flux in these + ! newly disturbed patches. Include only the fragmentation flux. + ! ----------------------------------------------------------------------------------- + ! ! !USES: ! ! !ARGUMENTS: - type(ed_patch_type) , intent(in), target :: currentPatch - type(ed_patch_type) , intent(inout) :: newPatch - real(r8) , intent(out) :: patch_site_areadis ! amount of land disturbed in this patch. m2 - ! - ! !LOCAL VARIABLES: - integer :: c,p ! counters for PFT and litter size class. - !--------------------------------------------------------------------- + type(ed_site_type) , intent(in), target :: currentSite ! site + type(ed_patch_type) , intent(in), target :: currentPatch ! Donor patch + type(ed_patch_type) , intent(inout) :: newPatch ! New patch + real(r8) , intent(in) :: patch_site_areadis ! Area being donated + ! by current patch - ! how much land is disturbed in this donor patch? - patch_site_areadis = currentPatch%area * currentPatch%disturbance_rate - - do c = 1,ncwd !move litter pool en mass into the new patch. - newPatch%cwd_ag(c) = newPatch%cwd_ag(c) + currentPatch%cwd_ag(c) * patch_site_areadis/newPatch%area - newPatch%cwd_bg(c) = newPatch%cwd_bg(c) + currentPatch%cwd_bg(c) * patch_site_areadis/newPatch%area - enddo + + ! locals + type(site_massbal_type), pointer :: site_mass + type(litter_type),pointer :: curr_litt ! litter object for current patch + type(litter_type),pointer :: new_litt ! litter object for the new patch + real(r8) :: remainder_area ! amount of area remaining in patch after donation + real(r8) :: burned_mass ! the mass of litter that was supposed to be provided + ! by the donor, but was burned [kg] + real(r8) :: donatable_mass ! mass of donatable litter [kg] + real(r8) :: donate_frac ! the fraction of litter mass sent to the new patch + real(r8) :: retain_frac ! the fraction of litter mass retained by the donor patch + real(r8) :: donate_m2 ! area normalization for litter mass destined to new patch [m-2] + real(r8) :: retain_m2 ! area normalization for litter mass destined to old patch [m-2] + integer :: el ! element loop counter + integer :: c ! CWD loop counter + integer :: pft ! PFT loop counter + integer :: dcmpy ! Decomposibility loop counter + integer :: sl ! soil layer loop counter + real(r8) :: litter_stock0,litter_stock1 + real(r8) :: burn_flux0,burn_flux1 + real(r8) :: error + + do el = 1,num_elements + + site_mass => currentSite%mass_balance(el) + 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. + + do c = 1,ncwd + new_litt%ag_cwd_frag(c) = new_litt%ag_cwd_frag(c) + & + curr_litt%ag_cwd_frag(c) * patch_site_areadis/newPatch%area + + do sl=1,currentSite%nlevsoil + new_litt%bg_cwd_frag(c,sl) = new_litt%bg_cwd_frag(c,sl) + & + curr_litt%bg_cwd_frag(c,sl) * patch_site_areadis/newPatch%area + end do + enddo + + do dcmpy = 1,ndcmpy + + new_litt%leaf_fines_frag(dcmpy) = new_litt%leaf_fines_frag(dcmpy) + & + curr_litt%leaf_fines_frag(dcmpy) * patch_site_areadis/newPatch%area + + do sl=1,currentSite%nlevsoil + new_litt%root_fines_frag(dcmpy,sl) = new_litt%root_fines_frag(dcmpy,sl) + & + curr_litt%root_fines_frag(dcmpy,sl) * patch_site_areadis/newPatch%area + end do + + enddo - do p = 1,numpft !move litter pool en mass into the new patch - newPatch%root_litter(p) = newPatch%root_litter(p) + & - currentPatch%root_litter(p) * patch_site_areadis/newPatch%area - newPatch%leaf_litter(p) = newPatch%leaf_litter(p) + & - currentPatch%leaf_litter(p) * patch_site_areadis/newPatch%area - - ! The fragmentation/decomposition flux from donor patches has already - ! occured in existing patches. However some of their area has been - ! carved out for this new patches which is receiving donations. - ! Lets maintain conservation on that pre-existing mass flux in - ! these newly disturbed patches + ! ----------------------------------------------------------------------------- + ! Distribute the existing litter that was already in place on the donor + ! patch. Some of this burns and is sent to the atmosphere, and some goes to the + ! litter stocks of the newly created patch. ALso, some may be retained in the + ! donor patch. + ! + ! This routine handles litter transfer for all types. Note that some of the + ! transfer may burn. If this routine is being called for a tree-fall + ! or logging disturbance, it is assumed that the burned_masses should come + ! out to zero. + ! ----------------------------------------------------------------------------- + + ! If/when sending litter fluxes to the old patch, we divide the total + ! mass sent to that patch, by the area it will have remaining + ! after it donates area. + ! i.e. subtract the area it is donating. - newPatch%root_litter_out(p) = newPatch%root_litter_out(p) + & - currentPatch%root_litter_out(p) * patch_site_areadis/newPatch%area - newPatch%leaf_litter_out(p) = newPatch%leaf_litter_out(p) + & - currentPatch%leaf_litter_out(p) * patch_site_areadis/newPatch%area + remainder_area = currentPatch%area - patch_site_areadis - enddo + ! Calculate the fraction of litter to be retained versus donated + ! vis-a-vis the new and donor patch + + retain_frac = (1.0_r8-existing_litt_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.0_r8/newPatch%area + end if + + + if (debug) then + burn_flux0 = site_mass%burn_flux_to_atm + litter_stock0 = curr_litt%GetTotalLitterMass()*currentPatch%area + & + new_litt%GetTotalLitterMass()*newPatch%area + end if + + do c = 1,ncwd + + ! Transfer above ground CWD + donatable_mass = curr_litt%ag_cwd(c) * patch_site_areadis * & + (1._r8 - currentPatch%burnt_frac_litter(c)) - end subroutine average_patch_properties + burned_mass = curr_litt%ag_cwd(c) * patch_site_areadis * & + currentPatch%burnt_frac_litter(c) + + new_litt%ag_cwd(c) = new_litt%ag_cwd(c) + donatable_mass*donate_m2 + curr_litt%ag_cwd(c) = curr_litt%ag_cwd(c) + donatable_mass*retain_m2 + + site_mass%burn_flux_to_atm = site_mass%burn_flux_to_atm + burned_mass + + ! Transfer below ground CWD (none burns) + + do sl = 1,currentSite%nlevsoil + donatable_mass = curr_litt%bg_cwd(c,sl) * patch_site_areadis + new_litt%bg_cwd(c,sl) = new_litt%bg_cwd(c,sl) + donatable_mass*donate_m2 + curr_litt%bg_cwd(c,sl) = curr_litt%bg_cwd(c,sl) + donatable_mass*retain_m2 + end do + + enddo + + do dcmpy=1,ndcmpy + + ! Transfer leaf fines + donatable_mass = curr_litt%leaf_fines(dcmpy) * patch_site_areadis * & + (1._r8 - currentPatch%burnt_frac_litter(dl_sf)) + + burned_mass = curr_litt%leaf_fines(dcmpy) * patch_site_areadis * & + currentPatch%burnt_frac_litter(dl_sf) + + new_litt%leaf_fines(dcmpy) = new_litt%leaf_fines(dcmpy) + donatable_mass*donate_m2 + curr_litt%leaf_fines(dcmpy) = curr_litt%leaf_fines(dcmpy) + donatable_mass*retain_m2 + + site_mass%burn_flux_to_atm = site_mass%burn_flux_to_atm + burned_mass + + ! Transfer root fines (none burns) + do sl = 1,currentSite%nlevsoil + donatable_mass = curr_litt%root_fines(dcmpy,sl) * patch_site_areadis + new_litt%root_fines(dcmpy,sl) = new_litt%root_fines(dcmpy,sl) + donatable_mass*donate_m2 + curr_litt%root_fines(dcmpy,sl) = curr_litt%root_fines(dcmpy,sl) + donatable_mass*retain_m2 + end do + + end do + + do pft = 1,numpft + + ! Transfer seeds (currently we don't burn seeds) + donatable_mass = curr_litt%seed(pft) * patch_site_areadis + + new_litt%seed(pft) = new_litt%seed(pft) + donatable_mass * donate_m2 + curr_litt%seed(pft) = curr_litt%seed(pft) + donatable_mass * retain_m2 + + donatable_mass = curr_litt%seed_germ(pft) * patch_site_areadis + + new_litt%seed_germ(pft) = new_litt%seed_germ(pft) + donatable_mass * donate_m2 + curr_litt%seed_germ(pft) = curr_litt%seed_germ(pft) + donatable_mass * retain_m2 + + enddo + + ! -------------------------------------------------------------------------- + ! Mass conservation check, set debug=.true. if mass imbalances in + ! EDMainMod start triggering. + ! -------------------------------------------------------------------------- + if (debug) then + burn_flux1 = site_mass%burn_flux_to_atm + litter_stock1 = curr_litt%GetTotalLitterMass()*remainder_area + & + new_litt%GetTotalLitterMass()*newPatch%area + error = (litter_stock1 - litter_stock0) + (burn_flux1-burn_flux0) + if(abs(error)>1.e-8_r8) then + write(fates_log(),*) 'non trivial carbon mass balance error in litter transfer' + write(fates_log(),*) 'abs error: ',error + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + end if + + + end do + + return + end subroutine TransLitterNewPatch ! ============================================================================ - subroutine fire_litter_fluxes(currentSite, cp_target, new_patch_target, patch_site_areadis) + + subroutine fire_litter_fluxes(currentSite, currentPatch, newPatch, patch_site_areadis) ! ! !DESCRIPTION: ! CWD pool burned by a fire. ! Carbon going from burned trees into CWD pool ! Burn parts of trees that don't die in fire ! Burn live grasses and kill them. + ! Note: The number density of living plants in the donating patch (currentPatch) + ! has not been scaled down by area yet. That happens after this routine. + ! ! !USES: use SFParamsMod, only : SF_VAL_CWD_FRAC - use EDtypesMod , only : dl_sf ! ! !ARGUMENTS: type(ed_site_type) , intent(inout), target :: currentSite - type(ed_patch_type) , intent(inout), target :: cp_target - type(ed_patch_type) , intent(inout), target :: new_patch_target - real(r8) , intent(inout) :: patch_site_areadis + type(ed_patch_type) , intent(inout), target :: currentPatch ! Donor Patch + type(ed_patch_type) , intent(inout), target :: newPatch ! New Patch + real(r8) , intent(in) :: patch_site_areadis ! Area being donated + ! by current patch ! ! !LOCAL VARIABLES: - type(ed_patch_type) , pointer :: currentPatch - type(ed_patch_type) , pointer :: new_patch - type(ed_cohort_type), pointer :: currentCohort - real(r8) :: bcroot ! amount of below ground coarse root per cohort kgC. (goes into CWD_BG) - real(r8) :: bstem ! amount of above ground stem biomass per cohort kgC.(goes into CWG_AG) - real(r8) :: dead_tree_density ! no trees killed by fire per m2 - reaL(r8) :: burned_litter ! amount of each litter pool burned by fire. kgC/m2/day - real(r8) :: burned_leaves ! amount of tissue consumed by fire for leaves. KgC/individual/day - real(r8) :: leaf_burn_frac ! fraction of leaves burned - real(r8) :: leaf_c ! leaf carbon [kg] - real(r8) :: fnrt_c ! fineroot carbon [kg] - real(r8) :: sapw_c ! sapwood carbon [kg] - real(r8) :: store_c ! storage carbon [kg] - real(r8) :: struct_c ! structure carbon [kg] - integer :: c, p - !--------------------------------------------------------------------- - !check that total area is not exceeded. - currentPatch => cp_target - new_patch => new_patch_target + 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) :: donatable_mass ! non-burned litter mass provided by the donor [kg] + ! some may or may not be retained by the donor + real(r8) :: burned_mass ! the mass of litter that was supposed to be provided + ! by the donor, but was burned [kg] + real(r8) :: remainder_area ! current patch's remaining area after donation [m2] + real(r8) :: retain_frac ! the fraction of litter mass retained by the donor patch + real(r8) :: bcroot ! amount of below ground coarse root per cohort kg + real(r8) :: bstem ! amount of above ground stem biomass per cohort kg + real(r8) :: leaf_burn_frac ! fraction of leaves burned + real(r8) :: leaf_m ! leaf mass [kg] + real(r8) :: fnrt_m ! fineroot mass [kg] + real(r8) :: sapw_m ! sapwood mass [kg] + real(r8) :: store_m ! storage mass [kg] + real(r8) :: struct_m ! structure mass [kg] + real(r8) :: repro_m ! Reproductive mass (seeds/flowers) [kg] + real(r8) :: num_dead_trees ! total number of dead trees passed in with the burn area + real(r8) :: num_live_trees ! total number of live trees passed in with the burn area + real(r8) :: donate_m2 ! area normalization for litter mass destined to new patch [m-2] + real(r8) :: retain_m2 ! area normalization for litter mass staying in donor patch [m-2] + real(r8) :: dcmpy_frac ! fraction of mass going to each decomposability partition + integer :: el ! element loop index + integer :: sl ! soil layer index + integer :: c ! loop index for coarse woody debris pools + integer :: pft ! loop index for plant functional types + integer :: dcmpy ! loop index for decomposability pool + integer :: element_id ! parteh compatible global element index - if ( currentPatch%fire == 1 ) then !only do this if there was a fire in this actual patch. - - ! how much land is disturbed in this donor patch? - patch_site_areadis = currentPatch%area * currentPatch%disturbance_rate + !--------------------------------------------------------------------- - !************************************/ - !PART 1) Burn the fractions of existing litter in the new patch that were consumed by the fire. - !************************************/ - do c = 1,ncwd - burned_litter = new_patch%cwd_ag(c) * patch_site_areadis/new_patch%area * & - currentPatch%burnt_frac_litter(c+1) !kG/m2/day - new_patch%cwd_ag(c) = new_patch%cwd_ag(c) - burned_litter - currentSite%flux_out = currentSite%flux_out + burned_litter * new_patch%area !kG/site/day - currentSite%total_burn_flux_to_atm = currentSite%total_burn_flux_to_atm + & - burned_litter * new_patch%area !kG/site/day - enddo + ! Only do this if there was a fire in this actual patch. + if ( currentPatch%fire == ifalse ) return - do p = 1,numpft - burned_litter = new_patch%leaf_litter(p) * patch_site_areadis/new_patch%area * & - currentPatch%burnt_frac_litter(dl_sf) - new_patch%leaf_litter(p) = new_patch%leaf_litter(p) - burned_litter - currentSite%flux_out = currentSite%flux_out + burned_litter * new_patch%area !kG/site/day - currentSite%total_burn_flux_to_atm = currentSite%total_burn_flux_to_atm + & - burned_litter * new_patch%area !kG/site/day - enddo - - !************************************/ - !PART 2) Put unburned parts of plants that died in the fire into the litter pool of new and old patches - ! This happens BEFORE the plant numbers have been updated. So we are working with the - ! pre-fire population of plants, which is the right way round. - !************************************/ + ! If plant hydraulics are turned on, account for water leaving the plant-soil + ! mass balance through the dead trees + if (hlm_use_planthydro == itrue) then currentCohort => currentPatch%shortest do while(associated(currentCohort)) - p = currentCohort%pft - - if(EDPftvarcon_inst%woody(p) == 1)then !DEAD (FROM FIRE) TREES - !************************************/ - ! Number of trees that died because of the fire, per m2 of ground. - ! Divide their litter into the four litter streams, and spread evenly across ground surface. - !************************************/ - - 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) - - ! stem biomass per tree - bstem = (sapw_c + struct_c) * EDPftvarcon_inst%allom_agb_frac(p) - ! coarse root biomass per tree - bcroot = (sapw_c + struct_c) * (1.0_r8 - EDPftvarcon_inst%allom_agb_frac(p) ) - ! density of dead trees per m2. - dead_tree_density = (currentCohort%fire_mort * currentCohort%n*patch_site_areadis/currentPatch%area) / AREA - - if( hlm_use_planthydro == itrue ) then - call AccumulateMortalityWaterStorage(currentSite,currentCohort,dead_tree_density*AREA) - end if - - ! Unburned parts of dead tree pool. - ! Unburned leaves and roots - - new_patch%leaf_litter(p) = new_patch%leaf_litter(p) + dead_tree_density * leaf_c * (1.0_r8-currentCohort%fraction_crown_burned) - - new_patch%root_litter(p) = new_patch%root_litter(p) + dead_tree_density * (fnrt_c+store_c) + num_dead_trees = (currentCohort%fire_mort * & + currentCohort%n*patch_site_areadis/currentPatch%area) + call AccumulateMortalityWaterStorage(currentSite,currentCohort,num_dead_trees) + end do + end if - currentPatch%leaf_litter(p) = currentPatch%leaf_litter(p) + dead_tree_density * & - leaf_c * (1.0_r8-currentCohort%fraction_crown_burned) - currentPatch%root_litter(p) = currentPatch%root_litter(p) + dead_tree_density * & - (fnrt_c + store_c) + ! If/when sending litter fluxes to the donor patch, we divide the total + ! mass sent to that patch, by the area it will have remaining + ! after it donates area. + ! i.e. subtract the area it is donating. + + remainder_area = currentPatch%area - patch_site_areadis + + ! Calculate the fraction of litter to be retained versus donated + ! vis-a-vis the new and donor patch (if the area remaining + ! in the original donor patch is small, don't bother + ! retaining anything.) + retain_frac = (1.0_r8-burn_localization) * & + remainder_area/(newPatch%area+remainder_area) + + 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.0_r8/newPatch%area + end if - ! track as diagnostic fluxes - currentSite%leaf_litter_diagnostic_input_carbonflux(p) = currentSite%leaf_litter_diagnostic_input_carbonflux(p) + & - leaf_c * (1.0_r8-currentCohort%fraction_crown_burned) * currentCohort%fire_mort * currentCohort%n * & - hlm_days_per_year / AREA + 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) ! Litter pool of "new" patch + + ! ----------------------------------------------------------------------------- + ! PART 1) Handle mass fluxes associated with plants that died in the fire. This + ! includes transfer of non burned plant material to litter, and the burned + ! part to the atmosphere. + ! ------------------------------------------------------------------------------ - currentSite%root_litter_diagnostic_input_carbonflux(p) = currentSite%root_litter_diagnostic_input_carbonflux(p) + & - (fnrt_c + store_c) * (1.0_r8-currentCohort%fraction_crown_burned) * currentCohort%fire_mort * & - currentCohort%n * hlm_days_per_year / AREA - - ! below ground coarse woody debris from burned trees - do c = 1,ncwd - new_patch%cwd_bg(c) = new_patch%cwd_bg(c) + dead_tree_density * SF_val_CWD_frac(c) * bcroot - currentPatch%cwd_bg(c) = currentPatch%cwd_bg(c) + dead_tree_density * SF_val_CWD_frac(c) * bcroot - - ! track as diagnostic fluxes - currentSite%CWD_BG_diagnostic_input_carbonflux(c) = currentSite%CWD_BG_diagnostic_input_carbonflux(c) + & - SF_val_CWD_frac(c) * bcroot * currentCohort%fire_mort * currentCohort%n * & - hlm_days_per_year / AREA - enddo - - ! above ground coarse woody debris from unburned twigs and small branches - do c = 1,2 - new_patch%cwd_ag(c) = new_patch%cwd_ag(c) + dead_tree_density * SF_val_CWD_frac(c) * bstem & - * (1.0_r8-currentCohort%fraction_crown_burned) - currentPatch%cwd_ag(c) = currentPatch%cwd_ag(c) + dead_tree_density * SF_val_CWD_frac(c) * & - bstem * (1.0_r8-currentCohort%fraction_crown_burned) - - ! track as diagnostic fluxes - currentSite%CWD_AG_diagnostic_input_carbonflux(c) = currentSite%CWD_AG_diagnostic_input_carbonflux(c) + & - SF_val_CWD_frac(c) * bstem * (1.0_r8-currentCohort%fraction_crown_burned) * currentCohort%fire_mort & - * currentCohort%n * hlm_days_per_year / AREA - enddo + currentCohort => currentPatch%shortest + do while(associated(currentCohort)) + + pft = currentCohort%pft - ! above ground coarse woody debris from large branches and stems: these do not burn in crown fires. - do c = 3,4 - new_patch%cwd_ag(c) = new_patch%cwd_ag(c) + dead_tree_density * SF_val_CWD_frac(c) * bstem - currentPatch%cwd_ag(c) = currentPatch%cwd_ag(c) + dead_tree_density * SF_val_CWD_frac(c) * bstem - - ! track as diagnostic fluxes - currentSite%CWD_AG_diagnostic_input_carbonflux(c) = currentSite%CWD_AG_diagnostic_input_carbonflux(c) + & - SF_val_CWD_frac(c) * bstem * currentCohort%fire_mort * currentCohort%n * & - hlm_days_per_year / AREA - enddo + ! Number of trees that died because of the fire, per m2 of ground. + ! Divide their litter into the four litter streams, and spread + ! across ground surface. + ! ----------------------------------------------------------------------- - ! Burned parts of dead tree pool. - ! Burned twigs and small branches. - do c = 1,2 - - currentSite%cwd_ag_burned(c) = currentSite%cwd_ag_burned(c) + dead_tree_density * & - SF_val_CWD_frac(c) * bstem * currentCohort%fraction_crown_burned - currentSite%flux_out = currentSite%flux_out + dead_tree_density * & - AREA * SF_val_CWD_frac(c) * bstem * currentCohort%fraction_crown_burned - currentSite%total_burn_flux_to_atm = currentSite%total_burn_flux_to_atm + dead_tree_density * & - AREA * SF_val_CWD_frac(c) * bstem * currentCohort%fraction_crown_burned - - enddo + 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) + fnrt_m = currentCohort%prt%GetState(fnrt_organ, element_id) + store_m = currentCohort%prt%GetState(store_organ, element_id) + repro_m = currentCohort%prt%GetState(repro_organ, element_id) - !burned leaves. - do p = 1,numpft - - currentSite%leaf_litter_burned(p) = currentSite%leaf_litter_burned(p) + & - dead_tree_density * leaf_c * currentCohort%fraction_crown_burned - - currentSite%flux_out = currentSite%flux_out + & - dead_tree_density * AREA * leaf_c * currentCohort%fraction_crown_burned - - currentSite%total_burn_flux_to_atm = currentSite%total_burn_flux_to_atm + & - dead_tree_density * AREA * leaf_c * currentCohort%fraction_crown_burned - - enddo - - endif - - currentCohort => currentCohort%taller - - enddo ! currentCohort - - !************************************/ - ! PART 3) Burn parts of trees that did *not* die in the fire. - ! currently we only remove leaves. branch and assocaited sapwood consumption coming soon. - ! PART 4) Burn parts of grass that are consumed by the fire. - ! grasses are not killed directly by fire. They die by losing all of their leaves and starving. - !************************************/ - currentCohort => new_patch%shortest - do while(associated(currentCohort)) - - sapw_c = currentCohort%prt%GetState(sapw_organ, all_carbon_elements) - leaf_c = currentCohort%prt%GetState(leaf_organ, all_carbon_elements) - - call carea_allom(currentCohort%dbh,currentCohort%n,currentSite%spread,currentCohort%pft,currentCohort%c_area) - - if(EDPftvarcon_inst%woody(currentCohort%pft) == 1)then - burned_leaves = leaf_c * currentCohort%fraction_crown_burned - else - burned_leaves = leaf_c * currentPatch%burnt_frac_litter(6) - endif + ! Absolute number of dead trees being transfered in with the donated area + num_dead_trees = (currentCohort%fire_mort*currentCohort%n * & + patch_site_areadis/currentPatch%area) - if (burned_leaves > 0.0_r8) then + ! Contribution of dead trees to leaf litter + donatable_mass = num_dead_trees * (leaf_m+repro_m) * & + (1.0_r8-currentCohort%fraction_crown_burned) - ! Remove burned leaves from the pool - if(leaf_c>nearzero) then - leaf_burn_frac = burned_leaves/leaf_c - else - leaf_burn_frac = 0.0_r8 - end if - call PRTBurnLosses(currentCohort%prt, leaf_organ, leaf_burn_frac) + ! Contribution of dead trees to leaf burn-flux + burned_mass = num_dead_trees * (leaf_m+repro_m) * currentCohort%fraction_crown_burned - !KgC/gridcell/day - currentSite%flux_out = currentSite%flux_out + burned_leaves * currentCohort%n * & - patch_site_areadis/currentPatch%area * AREA - - currentSite%total_burn_flux_to_atm = currentSite%total_burn_flux_to_atm+ burned_leaves * currentCohort%n * & - patch_site_areadis/currentPatch%area * AREA - - endif - currentCohort%fraction_crown_burned = 0.0_r8 - - currentCohort => currentCohort%taller - - enddo + do dcmpy=1,ndcmpy + dcmpy_frac = GetDecompyFrac(pft,leaf_organ,dcmpy) + new_litt%leaf_fines(dcmpy) = new_litt%leaf_fines(dcmpy) + & + donatable_mass*donate_m2*dcmpy_frac + curr_litt%leaf_fines(dcmpy) = curr_litt%leaf_fines(dcmpy) + & + donatable_mass*retain_m2*dcmpy_frac + end do + + site_mass%burn_flux_to_atm = site_mass%burn_flux_to_atm + burned_mass + + call set_root_fraction(currentSite%rootfrac_scr, pft, currentSite%zi_soil, & + icontext = i_biomass_rootprof_context) + + ! Contribution of dead trees to root litter (no root burn flux to atm) + do dcmpy=1,ndcmpy + dcmpy_frac = GetDecompyFrac(pft,fnrt_organ,dcmpy) + do sl = 1,currentSite%nlevsoil + donatable_mass = num_dead_trees * (fnrt_m+store_m) * currentSite%rootfrac_scr(sl) + new_litt%root_fines(dcmpy,sl) = new_litt%root_fines(dcmpy,sl) + & + donatable_mass*donate_m2*dcmpy_frac + curr_litt%root_fines(dcmpy,sl) = curr_litt%root_fines(dcmpy,sl) + & + donatable_mass*retain_m2*dcmpy_frac + end do + end do + + ! Track as diagnostic fluxes + flux_diags%leaf_litter_input(pft) = & + flux_diags%leaf_litter_input(pft) + & + num_dead_trees * (leaf_m+repro_m) * (1.0_r8-currentCohort%fraction_crown_burned) + + flux_diags%root_litter_input(pft) = & + flux_diags%root_litter_input(pft) + & + (fnrt_m + store_m) * num_dead_trees + + ! coarse root biomass per tree + bcroot = (sapw_m + struct_m) * (1.0_r8 - EDPftvarcon_inst%allom_agb_frac(pft) ) + + ! below ground coarse woody debris from burned trees + do c = 1,ncwd + do sl = 1,currentSite%nlevsoil + donatable_mass = num_dead_trees * SF_val_CWD_frac(c) * & + bcroot * currentSite%rootfrac_scr(sl) + + new_litt%bg_cwd(c,sl) = new_litt%bg_cwd(c,sl) + & + donatable_mass * donate_m2 + curr_litt%bg_cwd(c,sl) = curr_litt%bg_cwd(c,sl) + & + donatable_mass * retain_m2 + + ! track diagnostics + flux_diags%cwd_bg_input(c) = & + flux_diags%cwd_bg_input(c) + & + donatable_mass + enddo + end do - endif !currentPatch%fire. + ! stem biomass per tree + bstem = (sapw_m + struct_m) * EDPftvarcon_inst%allom_agb_frac(pft) + ! Above ground coarse woody debris from twigs and small branches + ! a portion of this pool may burn + do c = 1,ncwd + donatable_mass = num_dead_trees * SF_val_CWD_frac(c) * bstem + if (c == 1 .or. c == 2) then + donatable_mass = donatable_mass * (1.0_r8-currentCohort%fraction_crown_burned) + burned_mass = num_dead_trees * SF_val_CWD_frac(c) * bstem * & + currentCohort%fraction_crown_burned + site_mass%burn_flux_to_atm = site_mass%burn_flux_to_atm + burned_mass + endif + new_litt%ag_cwd(c) = new_litt%ag_cwd(c) + donatable_mass * donate_m2 + curr_litt%ag_cwd(c) = curr_litt%ag_cwd(c) + donatable_mass * retain_m2 + flux_diags%cwd_ag_input(c) = flux_diags%cwd_ag_input(c) + donatable_mass + enddo + + + currentCohort => currentCohort%taller + enddo + end do + + return end subroutine fire_litter_fluxes ! ============================================================================ - subroutine mortality_litter_fluxes(currentSite, cp_target, new_patch_target, patch_site_areadis) + + subroutine mortality_litter_fluxes(currentSite, currentPatch, newPatch, patch_site_areadis) ! ! !DESCRIPTION: - ! Carbon going from ongoing mortality into CWD pools. + ! Carbon going from mortality associated with disturbance into CWD pools. + ! By "associated with disturbance", this includes tree death that + ! forms gaps, as well as tree death due to impacts from those trees. + ! + ! We calculate the fraction of litter to be retained versus donated + ! vis-a-vis the new and donor patch. At this step, we have not + ! yet removed the area from the pre-existing patch (currentPatch), + ! so we pre-compute "remainder_area", which is the soon-to-be + ! area of the patch once disturbance is completed. ! ! !USES: use EDParamsMod, only : ED_val_understorey_death @@ -1283,157 +1601,206 @@ subroutine mortality_litter_fluxes(currentSite, cp_target, new_patch_target, pat ! ! !ARGUMENTS: type(ed_site_type) , intent(inout), target :: currentSite - type(ed_patch_type) , intent(inout), target :: cp_target - type(ed_patch_type) , intent(inout), target :: new_patch_target + type(ed_patch_type) , intent(inout), target :: currentPatch + type(ed_patch_type) , intent(inout), target :: newPatch real(r8) , intent(in) :: patch_site_areadis + ! ! !LOCAL VARIABLES: - real(r8) :: cwd_litter_density - real(r8) :: litter_area ! area over which to distribute this litter. - type(ed_cohort_type), pointer :: currentCohort - type(ed_patch_type) , pointer :: currentPatch - type(ed_patch_type) , pointer :: new_patch - real(r8) :: understorey_dead !Number of individual dead from the canopy layer /day - real(r8) :: canopy_dead !Number of individual dead from the understorey layer /day - real(r8) :: np_mult !Fraction of the new patch which came from the current patch (and so needs the same litter) - real(r8) :: leaf_c ! leaf carbon [kg] - real(r8) :: fnrt_c ! fineroot carbon [kg] - real(r8) :: sapw_c ! sapwood carbon [kg] - real(r8) :: store_c ! storage carbon [kg] - real(r8) :: struct_c ! structure carbon [kg] - integer :: p,c - real(r8) :: canopy_mortality_woody_litter(maxpft) ! flux of wood litter in to litter pool: KgC/m2/day - real(r8) :: canopy_mortality_leaf_litter(maxpft) ! flux in to leaf litter from tree death: KgC/m2/day - real(r8) :: canopy_mortality_root_litter(maxpft) ! flux in to froot litter from tree death: KgC/m2/day + 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) :: remainder_area ! amount of area remaining in patch after donation + real(r8) :: num_dead + real(r8) :: donatable_mass ! mass of donatable litter [kg] + real(r8) :: leaf_m ! leaf mass [kg] + real(r8) :: fnrt_m ! fineroot mass [kg] + real(r8) :: sapw_m ! sapwood mass [kg] + real(r8) :: store_m ! storage mass [kg] + real(r8) :: struct_m ! structure mass [kg] + real(r8) :: repro_m ! reproductive mass [kg] + real(r8) :: retain_frac ! Fraction of mass to be retained + 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] + real(r8) :: retain_m2 ! area normalization for litter mass destined to old patch [m-2] + real(r8) :: ag_wood ! Total above ground mass in wood [kg] + real(r8) :: bg_wood ! Total bg mass in wood [kg] + real(r8) :: seed_mass ! Total seed mass generated from storage death [kg] + integer :: pft ! plant functional type index + integer :: dcmpy ! decomposability index + 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 !--------------------------------------------------------------------- - currentPatch => cp_target - new_patch => new_patch_target - canopy_mortality_woody_litter(:) = 0.0_r8 ! mortality generated litter. KgC/m2/day - canopy_mortality_leaf_litter(:) = 0.0_r8 - canopy_mortality_root_litter(:) = 0.0_r8 + remainder_area = currentPatch%area - patch_site_areadis + + retain_frac = (1.0_r8-treefall_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 - currentCohort => currentPatch%shortest - do while(associated(currentCohort)) - p = currentCohort%pft - - 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) - if(currentCohort%canopy_layer == 1)then - !currentCohort%dmort = mortality_rates(currentCohort) - !the disturbance calculations are done with the previous n, c_area and d_mort. So it's probably & - !not right to recalcualte dmort here. - canopy_dead = currentCohort%n * min(1.0_r8,currentCohort%dmort * hlm_freq_day * fates_mortality_disturbance_fraction) + 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) ! Litter pool of "new" patch - canopy_mortality_woody_litter(p)= canopy_mortality_woody_litter(p) + & - canopy_dead*(struct_c + sapw_c) - canopy_mortality_leaf_litter(p) = canopy_mortality_leaf_litter(p) + & - canopy_dead*leaf_c + currentCohort => currentPatch%shortest + do while(associated(currentCohort)) - ! Some plants upon death will transfer storage carbon to seed production - ! Storage carbon that is not transferred to seeds goes to root litter flux + pft = currentCohort%pft + + 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) + fnrt_m = currentCohort%prt%GetState(fnrt_organ, element_id) + store_m = currentCohort%prt%GetState(store_organ, element_id) + repro_m = currentCohort%prt%GetState(repro_organ, element_id) - canopy_mortality_root_litter(p) = canopy_mortality_root_litter(p) + & - canopy_dead*(fnrt_c + store_c*(1.0_r8-EDPftvarcon_inst%allom_frbstor_repro(p)) ) + if(currentCohort%canopy_layer == 1)then - currentSite%seed_bank(p) = currentSite%seed_bank(p) + & - canopy_dead * store_c * EDPftvarcon_inst%allom_frbstor_repro(p)/AREA + ! Upper canopy trees. The total dead is based on their disturbance + ! generating mortality rate. + + num_dead = currentCohort%n * min(1.0_r8,currentCohort%dmort * & + hlm_freq_day * fates_mortality_disturbance_fraction) + + elseif(EDPftvarcon_inst%woody(pft) == itrue) then + + ! Understorey trees. The total dead is based on their survivorship + ! function, and the total area of disturbance. + + num_dead = ED_val_understorey_death * currentCohort%n * & + (patch_site_areadis/currentPatch%area) + else + + ! The only thing left is uderstory grasses. These guys aren't + ! killed by tree-fall disturbance events. - if( hlm_use_planthydro == itrue ) then - call AccumulateMortalityWaterStorage(currentSite,currentCohort, canopy_dead) - end if + num_dead = 0._r8 + + end if + + ! Update water balance by removing dead plant water + ! but only do this once (use the carbon element id) + if( (element_id == carbon12_element) .and. & + (hlm_use_planthydro == itrue) ) then + call AccumulateMortalityWaterStorage(currentSite,currentCohort, num_dead) + end if + + ! Transfer leaves of dying trees to leaf litter (includes seeds too) + do dcmpy=1,ndcmpy + dcmpy_frac = GetDecompyFrac(pft,leaf_organ,dcmpy) + new_litt%leaf_fines(dcmpy) = new_litt%leaf_fines(dcmpy) + & + num_dead*(leaf_m+repro_m)*donate_m2*dcmpy_frac + + curr_litt%leaf_fines(dcmpy) = curr_litt%leaf_fines(dcmpy) + & + num_dead*(leaf_m+repro_m)*retain_m2*dcmpy_frac + end do + + ! Pre-calculate Structural and sapwood, below and above ground, total mass [kg] + ag_wood = num_dead * (struct_m + sapw_m) * EDPftvarcon_inst%allom_agb_frac(pft) + bg_wood = num_dead * (struct_m + sapw_m) * (1.0_r8-EDPftvarcon_inst%allom_agb_frac(pft)) + + call set_root_fraction(currentSite%rootfrac_scr, pft, currentSite%zi_soil, & + icontext = i_biomass_rootprof_context) - else - if(EDPftvarcon_inst%woody(currentCohort%pft) == 1)then + do c=1,ncwd - understorey_dead = ED_val_understorey_death * currentCohort%n * (patch_site_areadis/currentPatch%area) !kgC/site/day - canopy_mortality_woody_litter(p) = canopy_mortality_woody_litter(p) + & - understorey_dead*(struct_c + sapw_c) - canopy_mortality_leaf_litter(p)= canopy_mortality_leaf_litter(p)+ & - understorey_dead*leaf_c - canopy_mortality_root_litter(p)= canopy_mortality_root_litter(p)+ & - understorey_dead*(fnrt_c + store_c) - - if( hlm_use_planthydro == itrue ) then - call AccumulateMortalityWaterStorage(currentSite,currentCohort, understorey_dead) - end if - - ! FIX(SPM,040114) - clarify this comment - ! grass is not killed by canopy mortality disturbance events. - ! Just move it into the new patch area. - else - ! no-op - endif - endif + ! Transfer wood of dying trees to AG CWD pools + new_litt%ag_cwd(c) = new_litt%ag_cwd(c) + ag_wood * & + SF_val_CWD_frac(c) * donate_m2 + curr_litt%ag_cwd(c) = curr_litt%ag_cwd(c) + ag_wood * & + SF_val_CWD_frac(c) * retain_m2 + + ! Transfer wood of dying trees to BG CWD pools + do sl = 1,currentSite%nlevsoil + new_litt%bg_cwd(c,sl) = new_litt%bg_cwd(c,sl) + bg_wood * & + currentSite%rootfrac_scr(sl) * SF_val_CWD_frac(c) * & + donate_m2 + + curr_litt%bg_cwd(c,sl) = curr_litt%bg_cwd(c,sl) + bg_wood * & + currentSite%rootfrac_scr(sl) * SF_val_CWD_frac(c) * & + retain_m2 + end do + end do + + ! Transfer fine roots of dying trees to below ground litter pools + do dcmpy=1,ndcmpy + dcmpy_frac = GetDecompyFrac(pft,fnrt_organ,dcmpy) + do sl=1,currentSite%nlevsoil + new_litt%root_fines(dcmpy,sl) = new_litt%root_fines(dcmpy,sl) + & + num_dead * currentSite%rootfrac_scr(sl) * & + (fnrt_m + store_m*(1.0_r8-EDPftvarcon_inst%allom_frbstor_repro(pft))) * & + donate_m2 * dcmpy_frac + + curr_litt%root_fines(dcmpy,sl) = curr_litt%root_fines(dcmpy,sl) + & + num_dead * currentSite%rootfrac_scr(sl) * & + (fnrt_m + store_m*(1.0_r8-EDPftvarcon_inst%allom_frbstor_repro(pft))) * & + retain_m2 * dcmpy_frac + end do + end do + + ! Transfer some of the storage that is shunted to reproduction + ! upon death, to the seed-pool. This is was designed for grasses, + ! but it is possible that some trees may utilize this behavior too + + seed_mass = num_dead * store_m * EDPftvarcon_inst%allom_frbstor_repro(pft) + + ! SEED DISTRIBUTION IS BREAKING MASS CONSERVATION RIGHT NOW... +! call DistributeSeeds(currentSite,seed_mass,el,pft) + + new_litt%seed(pft) = new_litt%seed(pft) + seed_mass * donate_m2 + curr_litt%seed(pft) = curr_litt%seed(pft) + seed_mass * retain_m2 + ! track diagnostic fluxes + do c=1,ncwd + flux_diags%cwd_ag_input(c) = & + flux_diags%cwd_ag_input(c) + SF_val_CWD_frac(c) * ag_wood + + flux_diags%cwd_bg_input(c) = & + flux_diags%cwd_bg_input(c) + SF_val_CWD_frac(c) * bg_wood + end do - + flux_diags%leaf_litter_input(pft) = flux_diags%leaf_litter_input(pft) + & + num_dead*(leaf_m + repro_m) - currentCohort => currentCohort%taller - - enddo !currentCohort - - !************************************/ - !Evenly distribute the litter from the trees that died across the new and old patches - !************************************/ - !************************************/ - !Evenly distribute the litter from the trees that died across the new and old patches - !'litter' fluxes here are in KgC - !************************************/ - litter_area = currentPatch%area - np_mult = patch_site_areadis/new_patch%area - ! This litter is distributed between the current and new patches, & - ! not to any other patches. This is really the eventually area of the current patch & - ! (currentPatch%area-patch_site_areadis) +patch_site_areadis... - ! For the new patch, only some fraction of its land area (patch_areadis/np%area) is derived from the current patch - ! so we need to multiply by patch_areadis/np%area - - do p = 1,numpft - - do c = 1,ncwd - - cwd_litter_density = SF_val_CWD_frac(c) * canopy_mortality_woody_litter(p) / litter_area - - new_patch%cwd_ag(c) = new_patch%cwd_ag(c) + EDPftvarcon_inst%allom_agb_frac(p) * cwd_litter_density * np_mult - currentPatch%cwd_ag(c) = currentPatch%cwd_ag(c) + EDPftvarcon_inst%allom_agb_frac(p) * cwd_litter_density - new_patch%cwd_bg(c) = new_patch%cwd_bg(c) + (1._r8-EDPftvarcon_inst%allom_agb_frac(p)) * cwd_litter_density & - * np_mult - currentPatch%cwd_bg(c) = currentPatch%cwd_bg(c) + (1._r8-EDPftvarcon_inst%allom_agb_frac(p)) * cwd_litter_density + 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))) - ! track as diagnostic fluxes - currentSite%CWD_AG_diagnostic_input_carbonflux(c) = currentSite%CWD_AG_diagnostic_input_carbonflux(c) + & - SF_val_CWD_frac(c) * canopy_mortality_woody_litter(p) * hlm_days_per_year * EDPftvarcon_inst%allom_agb_frac(p) & - / AREA - currentSite%CWD_BG_diagnostic_input_carbonflux(c) = currentSite%CWD_BG_diagnostic_input_carbonflux(c) + & - SF_val_CWD_frac(c) * canopy_mortality_woody_litter(p) * hlm_days_per_year * (1.0_r8 & - - EDPftvarcon_inst%allom_agb_frac(p)) / AREA - enddo - - new_patch%leaf_litter(p) = new_patch%leaf_litter(p) + canopy_mortality_leaf_litter(p) / litter_area * np_mult - new_patch%root_litter(p) = new_patch%root_litter(p) + canopy_mortality_root_litter(p) / litter_area * np_mult - - currentPatch%leaf_litter(p) = currentPatch%leaf_litter(p) + canopy_mortality_leaf_litter(p) / litter_area - currentPatch%root_litter(p) = currentPatch%root_litter(p) + canopy_mortality_root_litter(p) / litter_area - ! track as diagnostic fluxes - currentSite%leaf_litter_diagnostic_input_carbonflux(p) = currentSite%leaf_litter_diagnostic_input_carbonflux(p) + & - canopy_mortality_leaf_litter(p) * hlm_days_per_year / AREA + + currentCohort => currentCohort%taller + enddo !currentCohort - currentSite%root_litter_diagnostic_input_carbonflux(p) = currentSite%root_litter_diagnostic_input_carbonflux(p) + & - canopy_mortality_root_litter(p) * hlm_days_per_year / AREA enddo + + return end subroutine mortality_litter_fluxes ! ============================================================================ - subroutine create_patch(currentSite, new_patch, age, areap,cwd_ag_local,cwd_bg_local, & - leaf_litter_local,root_litter_local,nlevsoil,label) + + subroutine create_patch(currentSite, new_patch, age, areap, label) + ! ! !DESCRIPTION: ! Set default values for creating a new patch @@ -1445,15 +1812,12 @@ subroutine create_patch(currentSite, new_patch, age, areap,cwd_ag_local,cwd_bg_l type(ed_patch_type), intent(inout), target :: new_patch real(r8), intent(in) :: age ! notional age of this patch in years real(r8), intent(in) :: areap ! initial area of this patch in m2. - real(r8), intent(in) :: cwd_ag_local(:) ! initial value of above ground coarse woody debris. KgC/m2 - real(r8), intent(in) :: cwd_bg_local(:) ! initial value of below ground coarse woody debris. KgC/m2 - real(r8), intent(in) :: root_litter_local(:) ! initial value of root litter. KgC/m2 - real(r8), intent(in) :: leaf_litter_local(:) ! initial value of leaf litter. KgC/m2 - integer, intent(in) :: nlevsoil ! number of soil layers integer, intent(in) :: label ! anthropogenic disturbance label - ! + ! !LOCAL VARIABLES: !--------------------------------------------------------------------- + integer :: el ! element loop index + allocate(new_patch%tr_soil_dir(hlm_numSWb)) allocate(new_patch%tr_soil_dif(hlm_numSWb)) @@ -1463,9 +1827,23 @@ subroutine create_patch(currentSite, new_patch, age, areap,cwd_ag_local,cwd_bg_l allocate(new_patch%fabi(hlm_numSWb)) allocate(new_patch%sabs_dir(hlm_numSWb)) allocate(new_patch%sabs_dif(hlm_numSWb)) - allocate(new_patch%rootfr_ft(numpft,nlevsoil)) - allocate(new_patch%rootr_ft(numpft,nlevsoil)) - + + + ! Litter + ! Allocate, Zero Fluxes, and Initialize to "unset" values + + allocate(new_patch%litter(num_elements)) + do el=1,num_elements + call new_patch%litter(el)%InitAllocate(numpft,currentSite%nlevsoil,element_list(el)) + call new_patch%litter(el)%ZeroFlux() + call new_patch%litter(el)%InitConditions(init_leaf_fines = fates_unset_r8, & + init_root_fines = fates_unset_r8, & + init_ag_cwd = fates_unset_r8, & + init_bg_cwd = fates_unset_r8, & + init_seed = fates_unset_r8, & + init_seed_germ = fates_unset_r8) + end do + call zero_patch(new_patch) !The nan value in here is not working?? new_patch%tallest => null() ! pointer to patch's tallest cohort @@ -1478,10 +1856,6 @@ subroutine create_patch(currentSite, new_patch, age, areap,cwd_ag_local,cwd_bg_l new_patch%age = age new_patch%age_class = 1 new_patch%area = areap - new_patch%cwd_ag = cwd_ag_local - new_patch%cwd_bg = cwd_bg_local - new_patch%leaf_litter = leaf_litter_local - new_patch%root_litter = root_litter_local ! assign anthropgenic disturbance category and label new_patch%anthro_disturbance_label = label @@ -1490,14 +1864,11 @@ subroutine create_patch(currentSite, new_patch, age, areap,cwd_ag_local,cwd_bg_l else new_patch%age_since_anthro_disturbance = -1._r8 ! replace with fates_unset_r8 when possible endif - - !zeroing things because of the surfacealbedo problem... shouldnt really be necesary - new_patch%cwd_ag_in(:) = 0._r8 - new_patch%cwd_bg_in(:) = 0._r8 - - new_patch%cwd_ag_out(:) = 0._r8 - new_patch%cwd_bg_out(:) = 0._r8 + ! This new value will be generated when the calculate disturbance + ! rates routine is called. This does not need to be remembered or in the restart file. + new_patch%disturbance_mode = fates_unset_int + new_patch%f_sun = 0._r8 new_patch%ed_laisun_z(:,:,:) = 0._r8 new_patch%ed_laisha_z(:,:,:) = 0._r8 @@ -1512,12 +1883,13 @@ subroutine create_patch(currentSite, new_patch, age, areap,cwd_ag_local,cwd_bg_l new_patch%fabd_sha_z(:,:,:) = 0._r8 new_patch%fabi_sun_z(:,:,:) = 0._r8 new_patch%fabi_sha_z(:,:,:) = 0._r8 + new_patch%scorch_ht(:) = 0._r8 new_patch%frac_burnt = 0._r8 new_patch%total_tree_area = 0.0_r8 new_patch%NCL_p = 1 - + return end subroutine create_patch ! ============================================================================ @@ -1585,22 +1957,9 @@ subroutine zero_patch(cp_p) currentPatch%disturbance_rate = 0._r8 currentPatch%fract_ldist_not_harvested = 0._r8 - ! LITTER - currentPatch%cwd_ag(:) = 0.0_r8 ! above ground coarse woody debris gc/m2. - currentPatch%cwd_bg(:) = 0.0_r8 ! below ground coarse woody debris - currentPatch%root_litter(:) = 0.0_r8 ! In new disturbed patches, loops over donors to increment total, needs zero here - currentPatch%leaf_litter(:) = 0.0_r8 ! In new disturbed patches, loops over donors to increment total, needs zero here - - ! Cold-start initialized patches should have no litter flux in/out as they have not undergone any time. - ! Litter fluxes in/out also need to be initialized to zero for newly disturbed patches, as they - ! will incorporate the fluxes from donors over a loop, and need an initialization - - currentPatch%leaf_litter_in(:) = 0.0_r8 ! As a newly created patch with no age, there is no flux in - currentPatch%leaf_litter_out(:) = 0.0_r8 ! As a newly created patch with no age, no frag or decomp has happened yet - currentPatch%root_litter_in(:) = 0.0_r8 ! As a newly created patch with no age, there is no flux in - currentPatch%root_litter_out(:) = 0.0_r8 ! As a newly created patch with no age, no frag or decomp has happened yet ! FIRE + currentPatch%litter_moisture(:) = 0.0_r8 ! litter moisture currentPatch%fuel_eff_moist = 0.0_r8 ! average fuel moisture content of the ground fuel ! (incl. live grasses. omits 1000hr fuels) currentPatch%livegrass = 0.0_r8 ! total ag grass biomass in patch. 1=c3 grass, 2=c4 grass. gc/m2 @@ -1622,19 +1981,13 @@ subroutine zero_patch(cp_p) currentPatch%fire = 999 ! sr decide_fire.1=fire hot enough to proceed. 0=stop everything- no fires today currentPatch%fd = 0.0_r8 ! fire duration (mins) currentPatch%ros_back = 0.0_r8 ! backward ros (m/min) - currentPatch%ab = 0.0_r8 ! area burnt daily m2 - currentPatch%nf = 0.0_r8 ! number of fires initiated daily - currentPatch%sh = 0.0_r8 ! average scorch height for the patch(m) - currentPatch%frac_burnt = 0.0_r8 ! fraction burnt in each timestep. + currentPatch%scorch_ht(:) = 0.0_r8 ! scorch height of flames on a given PFT + currentPatch%frac_burnt = 0.0_r8 ! fraction burnt daily currentPatch%burnt_frac_litter(:) = 0.0_r8 currentPatch%btran_ft(:) = 0.0_r8 currentPatch%canopy_layer_tlai(:) = 0.0_r8 - currentPatch%seeds_in(:) = 0.0_r8 - currentPatch%seed_decay(:) = 0.0_r8 - currentPatch%seed_germination(:) = 0.0_r8 - currentPatch%fab(:) = 0.0_r8 currentPatch%sabs_dir(:) = 0.0_r8 currentPatch%sabs_dif(:) = 0.0_r8 @@ -1697,13 +2050,13 @@ subroutine fuse_patches( csite, bc_in ) do i_disttype = 1, n_anthro_disturbance_categories !---------------------------------------------------------------------! - ! We only really care about fusing patches if nopatches > 1 ! + ! We only really care about fusing patches if nopatches > 1 ! !---------------------------------------------------------------------! iterate = 1 !---------------------------------------------------------------------! - ! Keep doing this until nopatches >= maxPatchesPerSite ! + ! Keep doing this until nopatches <= maxPatchesPerSite ! !---------------------------------------------------------------------! do while(iterate == 1) @@ -1716,9 +2069,9 @@ subroutine fuse_patches( csite, bc_in ) currentPatch => currentPatch%older enddo - !---------------------------------------------------------------------! + !-------------------------------------------------------------------------------! ! Loop round current & target (currentPatch,tpp) patches to assess combinations ! - !---------------------------------------------------------------------! + !-------------------------------------------------------------------------------! currentPatch => currentSite%youngest_patch do while(associated(currentPatch)) tpp => currentSite%youngest_patch @@ -1729,8 +2082,10 @@ subroutine fuse_patches( csite, bc_in ) endif if(associated(tpp).and.associated(currentPatch))then - - ! only fuse patches whose anthropogenic disturbance categroy matches taht of the outer loop that we are in + !--------------------------------------------------------------------! + ! only fuse patches whose anthropogenic disturbance category matches ! + ! that of the outer loop that we are in ! + !--------------------------------------------------------------------! if ( tpp%anthro_disturbance_label .eq. i_disttype .and. & currentPatch%anthro_disturbance_label .eq. i_disttype) then @@ -1776,15 +2131,16 @@ subroutine fuse_patches( csite, bc_in ) do z = 1,n_dbh_bins ! loop over hgt bins !---------------------------------- - !is there biomass in this category? + ! is there biomass in this category? !---------------------------------- if(currentPatch%pft_agb_profile(ft,z) > 0.0_r8 .or. & tpp%pft_agb_profile(ft,z) > 0.0_r8)then - !------------------------------------------------------------------------------------- - ! what is the relative difference in biomass i nthis category between the two patches? - !------------------------------------------------------------------------------------- + !---------------------------------------------------------------------! + ! what is the relative difference in biomass in this category between + ! the two patches? + !---------------------------------------------------------------------! norm = abs(currentPatch%pft_agb_profile(ft,z) - & tpp%pft_agb_profile(ft,z))/(0.5_r8 * & @@ -1811,12 +2167,31 @@ subroutine fuse_patches( csite, bc_in ) ! or both are older than forced fusion age ! !-------------------------------------------------------------------------! - if(fuse_flag == 1)then + if(fuse_flag == 1)then + + !-----------------------! + ! fuse the two patches ! + !-----------------------! + tmpptr => currentPatch%older call fuse_2_patches(csite, currentPatch, tpp) call fuse_cohorts(csite,tpp, bc_in) call sort_cohorts(tpp) currentPatch => tmpptr + + !------------------------------------------------------------------------! + ! since we've just fused two patches, but are still in the midst of ! + ! a patch x patch loop, reset the patch fusion tolerance to the starting ! + ! value so that any subsequent fusions in this loop are done with that ! + ! value. otherwise we can end up in a situation where we've loosened the ! + ! fusion tolerance to get nopatches <= maxPatchesPerSite, but then, ! + ! having accomplished that, we continue through all the patch x patch ! + ! combinations and then all the patches get fused, ending up with ! + ! nopatches << maxPatchesPerSite and losing all heterogeneity. ! + !------------------------------------------------------------------------! + + profiletol = ED_val_patch_fusion_tol + else ! write(fates_log(),*) 'patches not fused' endif @@ -1889,6 +2264,7 @@ subroutine fuse_2_patches(csite, dp, rp) type (ed_cohort_type), pointer :: storebigcohort integer :: c,p !counters for pft and litter size class. integer :: tnull,snull ! are the tallest and shortest cohorts associated? + integer :: el ! loop counting index for elements type(ed_patch_type), pointer :: youngerp ! pointer to the patch younger than donor type(ed_patch_type), pointer :: olderp ! pointer to the patch older than donor real(r8) :: inv_sum_area ! Inverse of the sum of the two patches areas @@ -1901,30 +2277,11 @@ subroutine fuse_2_patches(csite, dp, rp) rp%age = (dp%age * dp%area + rp%age * rp%area) * inv_sum_area rp%age_class = get_age_class_index(rp%age) - - - do c = 1,ncwd - rp%cwd_ag(c) = (dp%cwd_ag(c)*dp%area + rp%cwd_ag(c)*rp%area) * inv_sum_area - rp%cwd_bg(c) = (dp%cwd_bg(c)*dp%area + rp%cwd_bg(c)*rp%area) * inv_sum_area - enddo - do p = 1,numpft - rp%seeds_in(p) = (rp%seeds_in(p)*rp%area + dp%seeds_in(p)*dp%area) * inv_sum_area - rp%seed_decay(p) = (rp%seed_decay(p)*rp%area + dp%seed_decay(p)*dp%area) * inv_sum_area - rp%seed_germination(p) = (rp%seed_germination(p)*rp%area + dp%seed_germination(p)*dp%area) * inv_sum_area - - rp%leaf_litter(p) = (dp%leaf_litter(p)*dp%area + rp%leaf_litter(p)*rp%area) * inv_sum_area - rp%root_litter(p) = (dp%root_litter(p)*dp%area + rp%root_litter(p)*rp%area) * inv_sum_area - - rp%root_litter_out(p) = (dp%root_litter_out(p)*dp%area + rp%root_litter_out(p)*rp%area) * inv_sum_area - rp%leaf_litter_out(p) = (dp%leaf_litter_out(p)*dp%area + rp%leaf_litter_out(p)*rp%area) * inv_sum_area - - rp%root_litter_in(p) = (dp%root_litter_in(p)*dp%area + rp%root_litter_in(p)*rp%area) * inv_sum_area - rp%leaf_litter_in(p) = (dp%leaf_litter_in(p)*dp%area + rp%leaf_litter_in(p)*rp%area) * inv_sum_area + do el = 1,num_elements + call rp%litter(el)%FuseLitter(rp%area,dp%area,dp%litter(el)) + end do - rp%dleaf_litter_dt(p) = (dp%dleaf_litter_dt(p)*dp%area + rp%dleaf_litter_dt(p)*rp%area) * inv_sum_area - rp%droot_litter_dt(p) = (dp%droot_litter_dt(p)*dp%area + rp%droot_litter_dt(p)*rp%area) * inv_sum_area - enddo rp%fuel_eff_moist = (dp%fuel_eff_moist*dp%area + rp%fuel_eff_moist*rp%area) * inv_sum_area rp%livegrass = (dp%livegrass*dp%area + rp%livegrass*rp%area) * inv_sum_area @@ -1940,9 +2297,7 @@ subroutine fuse_2_patches(csite, dp, rp) rp%fi = (dp%fi*dp%area + rp%fi*rp%area) * inv_sum_area rp%fd = (dp%fd*dp%area + rp%fd*rp%area) * inv_sum_area rp%ros_back = (dp%ros_back*dp%area + rp%ros_back*rp%area) * inv_sum_area - rp%ab = (dp%ab*dp%area + rp%ab*rp%area) * inv_sum_area - rp%nf = (dp%nf*dp%area + rp%nf*rp%area) * inv_sum_area - rp%sh = (dp%sh*dp%area + rp%sh*rp%area) * inv_sum_area + rp%scorch_ht(:) = (dp%scorch_ht(:)*dp%area + rp%scorch_ht(:)*rp%area) * inv_sum_area rp%frac_burnt = (dp%frac_burnt*dp%area + rp%frac_burnt*rp%area) * inv_sum_area rp%burnt_frac_litter(:) = (dp%burnt_frac_litter(:)*dp%area + rp%burnt_frac_litter(:)*rp%area) * inv_sum_area rp%btran_ft(:) = (dp%btran_ft(:)*dp%area + rp%btran_ft(:)*rp%area) * inv_sum_area @@ -2155,6 +2510,39 @@ subroutine terminate_patches(currentSite) return end subroutine terminate_patches + ! ===================================================================================== + + subroutine DistributeSeeds(currentSite,seed_mass,el,pft) + + ! !ARGUMENTS: + type(ed_site_type), target, intent(inout) :: currentSite ! + real(r8), intent(in) :: seed_mass ! mass of seed input [kg] + integer, intent(in) :: el ! element index + integer, intent(in) :: pft ! pft index + + ! !LOCAL VARIABLES: + type(ed_patch_type), pointer :: currentPatch + type(litter_type), pointer :: litt + + + currentPatch => currentSite%oldest_patch + do while(associated(currentPatch)) + litt => currentPatch%litter(el) + + if(homogenize_seed_pfts) then + litt%seed(:) = litt%seed(:) + seed_mass/(area_site*real(numpft,r8)) + else + litt%seed(pft) = litt%seed(pft) + seed_mass/area_site + end if + + currentPatch => currentPatch%younger + end do + + + return + end subroutine DistributeSeeds + + ! ===================================================================================== subroutine dealloc_patch(cpatch) @@ -2164,8 +2552,10 @@ subroutine dealloc_patch(cpatch) ! structure itself. type(ed_patch_type), target :: cpatch + type(ed_cohort_type), pointer :: ccohort ! current type(ed_cohort_type), pointer :: ncohort ! next + integer :: el ! loop counter for elements ! First Deallocate the cohort space ! ----------------------------------------------------------------------------------- @@ -2173,14 +2563,19 @@ subroutine dealloc_patch(cpatch) do while(associated(ccohort)) ncohort => ccohort%taller - if(hlm_use_planthydro.eq.itrue) call DeallocateHydrCohort(ccohort) - call ccohort%prt%DeallocatePRTVartypes() - deallocate(ccohort%prt) + + call DeallocateCohort(ccohort) deallocate(ccohort) ccohort => ncohort end do + ! Deallocate all litter objects + do el=1,num_elements + call cpatch%litter(el)%DeallocateLitt() + end do + deallocate(cpatch%litter) + ! Secondly, and lastly, deallocate the allocatable vector spaces in the patch if(allocated(cpatch%tr_soil_dir))then deallocate(cpatch%tr_soil_dir) @@ -2191,8 +2586,7 @@ subroutine dealloc_patch(cpatch) deallocate(cpatch%fabi) deallocate(cpatch%sabs_dir) deallocate(cpatch%sabs_dif) - deallocate(cpatch%rootfr_ft) - deallocate(cpatch%rootr_ft) + end if return diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 5f3c8c842f..e5ba9e1e9f 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -17,26 +17,38 @@ module EDPhysiologyMod use FatesInterfaceMod, only : hlm_parteh_mode use FatesConstantsMod, only : r8 => fates_r8 use FatesConstantsMod, only : nearzero + use FatesConstantsMod, only : g_per_kg + use FatesConstantsMod, only : days_per_sec use EDPftvarcon , only : EDPftvarcon_inst + use EDPftvarcon , only : GetDecompyFrac use FatesInterfaceMod, only : bc_in_type use EDCohortDynamicsMod , only : zero_cohort - use EDCohortDynamicsMod , only : create_cohort, sort_cohorts,InitPRTCohort + use EDCohortDynamicsMod , only : create_cohort, sort_cohorts + use EDCohortDynamicsMod , only : InitPRTObject use FatesAllometryMod , only : tree_lai use FatesAllometryMod , only : tree_sai use FatesAllometryMod , only : decay_coeff_kn - + use FatesLitterMod , only : litter_type + use EDTypesMod , only : site_massbal_type + use EDTypesMod , only : numlevsoil_max use EDTypesMod , only : numWaterMem use EDTypesMod , only : dl_sf, dinc_ed - use EDTypesMod , only : ncwd + use FatesLitterMod , only : ncwd + use FatesLitterMod , only : ndcmpy + use FatesLitterMod , only : ilabile + use FatesLitterMod , only : ilignin + use FatesLitterMod , only : icellulose use EDTypesMod , only : nlevleaf use EDTypesMod , only : num_vegtemp_mem use EDTypesMod , only : maxpft use EDTypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type - use EDTypesMod , only : dump_cohort - use EDTypesMod , only : first_leaf_aclass use EDTypesMod , only : leaves_on use EDTypesMod , only : leaves_off use EDTypesMod , only : min_n_safemath + use EDTypesMod , only : num_elements + use EDTypesMod , only : element_list + use EDTypesMod , only : element_pos + use EDTypesMod , only : site_fluxdiags_type use EDTypesMod , only : phen_cstat_nevercold use EDTypesMod , only : phen_cstat_iscold use EDTypesMod , only : phen_cstat_notcold @@ -49,12 +61,14 @@ module EDPhysiologyMod use FatesGlobals , only : fates_log use FatesGlobals , only : endrun => fates_endrun use EDParamsMod , only : fates_mortality_disturbance_fraction - + use EDParamsMod , only : q10_mr + use EDParamsMod , only : q10_froz + use EDParamsMod , only : logging_export_frac use FatesPlantHydraulicsMod , only : AccumulateMortalityWaterStorage use FatesConstantsMod , only : itrue,ifalse use FatesConstantsMod , only : calloc_abs_error - + use FatesConstantsMod , only : years_per_day use FatesAllometryMod , only : h_allom use FatesAllometryMod , only : h2d_allom use FatesAllometryMod , only : bagw_allom @@ -66,13 +80,18 @@ module EDPhysiologyMod use FatesAllometryMod , only : bbgw_allom use FatesAllometryMod , only : carea_allom use FatesAllometryMod , only : CheckIntegratedAllometries + use FatesAllometryMod, only : set_root_fraction + use FatesAllometryMod, only : i_biomass_rootprof_context use PRTGenericMod, only : prt_carbon_allom_hyp + use PRTGenericMod, only : prt_cnp_flex_allom_hyp + use PRTGenericMod, only : prt_vartypes use PRTGenericMod, only : leaf_organ + use PRTGenericMod, only : sapw_organ, struct_organ use PRTGenericMod, only : all_carbon_elements use PRTGenericMod, only : carbon12_element use PRTGenericMod, only : nitrogen_element - use PRTGenericMod, only : phosphorous_element + use PRTGenericMod, only : phosphorus_element use PRTGenericMod, only : leaf_organ use PRTGenericMod, only : fnrt_organ use PRTGenericMod, only : sapw_organ @@ -82,43 +101,59 @@ module EDPhysiologyMod use PRTGenericMod, only : SetState use PRTLossFluxesMod, only : PRTPhenologyFlush use PRTLossFluxesMod, only : PRTDeciduousTurnover + use PRTLossFluxesMod, only : PRTReproRelease implicit none private - public :: non_canopy_derivs public :: trim_canopy public :: phenology - private :: phenology_leafonoff public :: recruitment - private :: cwd_input - private :: cwd_out - private :: fragmentation_scaler - private :: seeds_in - private :: seed_decay - private :: seed_germination - public :: flux_into_litter_pools + public :: ZeroLitterFluxes + public :: FluxIntoLitterPools public :: ZeroAllocationRates + public :: PreDisturbanceLitterFluxes + public :: PreDisturbanceIntegrateLitter + public :: SeedIn - logical, parameter :: debug = .false. ! local debug flag character(len=*), parameter, private :: sourcefile = & __FILE__ - integer, parameter :: i_dbh = 1 ! Array index associated with dbh - integer, parameter :: i_cleaf = 2 ! Array index associated with leaf carbon - integer, parameter :: i_cfroot = 3 ! Array index associated with fine-root carbon - integer, parameter :: i_csap = 4 ! Array index associated with sapwood carbon - integer, parameter :: i_cstore = 5 ! Array index associated with storage carbon - integer, parameter :: i_cdead = 6 ! Array index associated with structural carbon - integer, parameter :: i_crepro = 7 ! Array index associated with reproductive carbon - integer, parameter :: n_cplantpools = 7 ! Size of the carbon only integration framework integer, parameter :: dleafon_drycheck = 100 ! Drought deciduous leaves max days on check parameter ! ============================================================================ contains + subroutine ZeroLitterFluxes( currentSite ) + + ! This routine loops through all patches in a site + ! and zero's the flux terms for the litter pools. + ! This is typically called at the beginning of the dynamics + ! call sequence. + + + ! !ARGUMENTS + type(ed_site_type), intent(inout), target :: currentSite + type(ed_patch_type), pointer :: currentPatch + + integer :: el + + currentPatch => currentSite%youngest_patch + do while(associated(currentPatch)) + do el=1,num_elements + call currentPatch%litter(el)%ZeroFlux() + end do + currentPatch => currentPatch%older + end do + + + return + end subroutine ZeroLitterFluxes + + ! ===================================================================================== + subroutine ZeroAllocationRates( currentSite ) ! !ARGUMENTS @@ -146,68 +181,182 @@ end subroutine ZeroAllocationRates ! ============================================================================ - subroutine non_canopy_derivs( currentSite, currentPatch, bc_in ) - ! - ! !DESCRIPTION: - ! Returns time differentials of the state vector + subroutine PreDisturbanceLitterFluxes( currentSite, currentPatch, bc_in ) + + ! ----------------------------------------------------------------------------------- + ! + ! This subroutine calculates all of the different litter input and output fluxes + ! associated with seed turnover, seed influx, litterfall from live and + ! dead plants, germination, and fragmentation. ! - ! !USES: - use EDTypesMod, only : AREA + ! At this time we do not have explicit herbivory, and burning losses to litter + ! are handled elsewhere. ! + ! Note: The processes conducted here DO NOT handle litter fluxes associated + ! with disturbance. Those fluxes are handled elsewhere (EDPatchDynamcisMod) + ! because the fluxes are potentially cross patch, and also dealing + ! patch areas that are changing. + ! + ! ----------------------------------------------------------------------------------- + + ! !ARGUMENTS - type(ed_site_type), intent(inout), target :: currentSite - type(ed_patch_type), intent(inout) :: currentPatch - type(bc_in_type), intent(in) :: bc_in + type(ed_site_type), intent(inout) :: currentSite + type(ed_patch_type), intent(inout) :: currentPatch + type(bc_in_type), intent(in) :: bc_in ! ! !LOCAL VARIABLES: - integer c,p - !---------------------------------------------------------------------- + type(site_massbal_type), pointer :: site_mass + type(litter_type), pointer :: litt ! Points to the litter object for + ! the different element types + integer :: el ! Litter element loop index + integer :: nlev_eff_decomp ! Number of active layers over which + ! fragmentation fluxes are transfered + !------------------------------------------------------------------------------------ + + ! Calculate the fragmentation rates + call fragmentation_scaler(currentPatch, bc_in) - currentPatch%leaf_litter_in(:) = 0.0_r8 - currentPatch%root_litter_in(:) = 0.0_r8 - currentPatch%dleaf_litter_dt(:) = 0.0_r8 - currentPatch%droot_litter_dt(:) = 0.0_r8 - currentPatch%leaf_litter_out(:) = 0.0_r8 - currentPatch%root_litter_out(:) = 0.0_r8 - currentPatch%cwd_AG_in(:) = 0.0_r8 - currentPatch%cwd_BG_in(:) = 0.0_r8 - currentPatch%cwd_AG_out(:) = 0.0_r8 - currentPatch%cwd_BG_out(:) = 0.0_r8 - currentPatch%seeds_in(:) = 0.0_r8 - currentPatch%seed_decay(:) = 0.0_r8 - currentPatch%seed_germination(:) = 0.0_r8 - - ! update seed fluxes - call seeds_in(currentSite, currentPatch) - call seed_decay(currentSite, currentPatch) - call seed_germination(currentSite, currentPatch) - - ! update fragmenting pool fluxes - call cwd_input( currentSite, currentPatch) - call cwd_out( currentSite, currentPatch, bc_in) - - do p = 1,numpft - currentSite%dseed_dt(p) = currentSite%dseed_dt(p) + & - (currentPatch%seeds_in(p) - currentPatch%seed_decay(p) - & - currentPatch%seed_germination(p)) * currentPatch%area/AREA - enddo + + do el = 1, num_elements + + litt => currentPatch%litter(el) + + ! Calculate loss rate of viable seeds to litter + call SeedDecay(litt) + + ! Send those decaying seeds in the previous call + ! to the litter input flux + call SeedDecayToFines(litt) + + ! Calculate seed germination rate, the status flags prevent + ! germination from occuring when the site is in a drought + ! (for drought deciduous) or too cold (for cold deciduous) + call SeedGermination(litt, currentSite%cstatus, currentSite%dstatus) + + ! Send fluxes from newly created litter into the litter pools + ! This litter flux is from non-disturbance inducing mortality, as well + ! as litter fluxes from live trees + call CWDInput(currentSite, currentPatch, litt) + + + ! Only calculate fragmentation flux over layers that are active + ! (RGK-Mar2019) SHOULD WE MAX THIS AT 1? DONT HAVE TO + + nlev_eff_decomp = max(bc_in%max_rooting_depth_index_col, 1) + call CWDOut(litt,currentPatch%fragmentation_scaler,nlev_eff_decomp) + + + site_mass => currentSite%mass_balance(el) + + ! Fragmentation flux to soil decomposition model [kg/site/day] + site_mass%frag_out = site_mass%frag_out + currentPatch%area * & + ( sum(litt%ag_cwd_frag) + sum(litt%bg_cwd_frag) + & + sum(litt%leaf_fines_frag) + sum(litt%root_fines_frag)) + + end do + + + return + end subroutine PreDisturbanceLitterFluxes + + ! ===================================================================================== + + subroutine PreDisturbanceIntegrateLitter(currentPatch) + + ! ----------------------------------------------------------------------------------- + ! + ! This step applies the litter fluxes to the prognostic state variables. + ! This procedure is called in response to fluxes generated from: + ! 1) seed rain, + ! 2) non-disturbance generating turnover + ! 3) litter fall from living plants + ! 4) fragmentation + ! + ! This routine does NOT accomodate the litter fluxes associated with + ! disturbance generation. That will happen after this call. + ! Fluxes associated with FIRE also happen after this step. + ! + ! All states are in units kg/m2 + ! All fluxes are in units kg/m2/day + ! The integration step is 1 day, thus time is implied + ! + ! ----------------------------------------------------------------------------------- + + ! Arguments + type(ed_patch_type),intent(inout),target :: currentPatch + + + ! Locals + type(litter_type), pointer :: litt + integer :: el ! Loop counter for litter element type + integer :: pft ! pft loop counter + integer :: c ! CWD loop counter + integer :: nlevsoil ! number of soil layers + integer :: ilyr ! soil layer loop counter + integer :: dcmpy ! decomposability index + + do el = 1, num_elements + + litt => currentPatch%litter(el) + + ! Update the bank of viable seeds + ! ----------------------------------------------------------------------------------- + + do pft = 1,numpft + litt%seed(pft) = litt%seed(pft) + & + litt%seed_in_local(pft) + & + litt%seed_in_extern(pft) - & + litt%seed_decay(pft) - & + litt%seed_germ_in(pft) + + ! Note that the recruitment scheme will use seed_germ + ! for its construction costs. + litt%seed_germ(pft) = litt%seed_germ(pft) + & + litt%seed_germ_in(pft) - & + litt%seed_germ_decay(pft) + + + enddo + + ! Update the Coarse Woody Debris pools (above and below) + ! ----------------------------------------------------------------------------------- + nlevsoil = size(litt%bg_cwd,dim=2) + do c = 1,ncwd + litt%ag_cwd(c) = litt%ag_cwd(c) + litt%ag_cwd_in(c) - litt%ag_cwd_frag(c) + do ilyr=1,nlevsoil + litt%bg_cwd(c,ilyr) = litt%bg_cwd(c,ilyr) & + + litt%bg_cwd_in(c,ilyr) & + - litt%bg_cwd_frag(c,ilyr) + enddo + end do - do c = 1,ncwd - currentPatch%dcwd_AG_dt(c) = currentPatch%cwd_AG_in(c) - currentPatch%cwd_AG_out(c) - currentPatch%dcwd_BG_dt(c) = currentPatch%cwd_BG_in(c) - currentPatch%cwd_BG_out(c) - enddo + ! Update the fine litter pools from leaves and fine-roots + ! ----------------------------------------------------------------------------------- + + do dcmpy = 1,ndcmpy - do p = 1,numpft - currentPatch%dleaf_litter_dt(p) = currentPatch%leaf_litter_in(p) - & - currentPatch%leaf_litter_out(p) - currentPatch%droot_litter_dt(p) = currentPatch%root_litter_in(p) - & - currentPatch%root_litter_out(p) - enddo + litt%leaf_fines(dcmpy) = litt%leaf_fines(dcmpy) & + + litt%leaf_fines_in(dcmpy) & + - litt%leaf_fines_frag(dcmpy) + do ilyr=1,nlevsoil + litt%root_fines(dcmpy,ilyr) = litt%root_fines(dcmpy,ilyr) & + + litt%root_fines_in(dcmpy,ilyr) & + - litt%root_fines_frag(dcmpy,ilyr) + enddo + + end do + + end do ! litter element loop + + return + end subroutine PreDisturbanceIntegrateLitter - end subroutine non_canopy_derivs + ! ============================================================================ + subroutine trim_canopy( currentSite ) ! ! !DESCRIPTION: @@ -234,7 +383,6 @@ subroutine trim_canopy( currentSite ) real(r8) :: kn ! nitrogen decay coefficient real(r8) :: sla_max ! Observational constraint on how large sla (m2/gC) can become real(r8) :: leaf_c ! leaf carbon [kg] - real(r8) :: fnrt_c ! fineroot carbon [kg] real(r8) :: sapw_c ! sapwood carbon [kg] real(r8) :: store_c ! storage carbon [kg] real(r8) :: struct_c ! structure carbon [kg] @@ -514,10 +662,31 @@ subroutine phenology( currentSite, bc_in ) endif ! ! accumulate the GDD using daily mean temperatures - if (bc_in%t_veg24_si .gt. tfrz) then + ! Don't accumulate GDD during the growing season (that wouldn't make sense) + if (bc_in%t_veg24_si .gt. tfrz.and. currentSite%cstatus == phen_cstat_iscold) then currentSite%grow_deg_days = currentSite%grow_deg_days + bc_in%t_veg24_si - tfrz endif + !this logic is to prevent GDD accumulating after the leaves have fallen and before the + ! beginnning of the accumulation period, to prevend erroneous autumn leaf flushing. + if(model_day_int>365)then !only do this after the first year to prevent odd behaviour + + if(currentSite%lat .gt. 0.0_r8)then !Northern Hemisphere + ! In the north, don't accumulate when we are past the leaf fall date. + ! Accumulation starts on day 1 of year in NH. + ! The 180 is to prevent going into an 'always off' state after initialization + if( model_day_int .gt. currentSite%cleafoffdate.and.hlm_day_of_year.gt.180)then ! + currentSite%grow_deg_days = 0._r8 + endif + else !Southern Hemisphere + ! In the South, don't accumulate after the leaf off date, and before the start of + ! the accumulation phase (day 181). + if(model_day_int .gt. currentSite%cleafoffdate.and.hlm_day_of_year.lt.gddstart) then! + currentSite%grow_deg_days = 0._r8 + endif + endif + endif !year1 + ! Calculate the number of days since the leaves last came on ! and off. If this is the beginning of the simulation, that day might ! not had occured yet, so set it to last year to get things rolling @@ -547,9 +716,12 @@ subroutine phenology( currentSite, bc_in ) if ( (currentSite%cstatus == phen_cstat_iscold .or. & currentSite%cstatus == phen_cstat_nevercold) .and. & (currentSite%grow_deg_days > gdd_threshold) .and. & + (dayssincecleafoff > ED_val_phen_mindayson) .and. & (currentSite%nchilldays >= 1)) then currentSite%cstatus = phen_cstat_notcold ! Set to not-cold status (leaves can come on) currentSite%cleafondate = model_day_int + dayssincecleafon = 0 + currentSite%grow_deg_days = 0._r8 ! zero GDD for the rest of the year until counting season begins. if ( debug ) write(fates_log(),*) 'leaves on' endif !GDD @@ -756,11 +928,15 @@ subroutine phenology_leafonoff(currentSite) type(ed_cohort_type), pointer :: currentCohort real(r8) :: leaf_c ! leaf carbon [kg] + real(r8) :: sapw_c ! sapwood carbon [kg] + real(r8) :: struct_c ! structural wood carbon [kg] real(r8) :: store_c ! storage carbon [kg] real(r8) :: store_c_transfer_frac ! Fraction of storage carbon used to flush leaves + real(r8) :: totalmemory ! total memory of carbon [kg] integer :: ipft real(r8), parameter :: leaf_drop_fraction = 1.0_r8 - + real(r8), parameter :: carbon_store_buffer = 0.10_r8 + real(r8) :: stem_drop_fraction !------------------------------------------------------------------------ currentPatch => CurrentSite%oldest_patch @@ -773,11 +949,15 @@ subroutine phenology_leafonoff(currentSite) ! Retrieve existing leaf and storage carbon - call currentCohort%prt%CheckMassConservation(ipft,0) + if(debug) call currentCohort%prt%CheckMassConservation(ipft,0) store_c = currentCohort%prt%GetState(store_organ, all_carbon_elements) leaf_c = currentCohort%prt%GetState(leaf_organ, all_carbon_elements) - + sapw_c = currentCohort%prt%GetState(sapw_organ, all_carbon_elements) + struct_c = currentCohort%prt%GetState(struct_organ, all_carbon_elements) + + stem_drop_fraction = EDPftvarcon_inst%phen_stem_drop_fraction(ipft) + ! COLD LEAF ON ! The site level flags signify that it is no-longer too cold ! for leaves. Time to signal flushing @@ -789,18 +969,55 @@ subroutine phenology_leafonoff(currentSite) ! stop flow of carbon out of bstore. if(store_c>nearzero) then - store_c_transfer_frac = & - min(EDPftvarcon_inst%phenflush_fraction(ipft)*currentCohort%laimemory, store_c)/store_c + ! flush either the amount required from the laimemory, or -most- of the storage pool + ! RF: added a criterion to stop the entire store pool emptying and triggering termination mortality + ! n.b. this might not be necessary if we adopted a more gradual approach to leaf flushing... + store_c_transfer_frac = min((EDPftvarcon_inst%phenflush_fraction(ipft)* & + currentCohort%laimemory)/store_c,(1.0_r8-carbon_store_buffer)) + + if(EDPftvarcon_inst%woody(ipft).ne.itrue)then + totalmemory=currentCohort%laimemory+currentCohort%sapwmemory+currentCohort%structmemory + store_c_transfer_frac = min((EDPftvarcon_inst%phenflush_fraction(ipft)* & + totalmemory)/store_c, (1.0_r8-carbon_store_buffer)) + endif + else store_c_transfer_frac = 0.0_r8 end if ! This call will request that storage carbon will be transferred to ! leaf tissues. It is specified as a fraction of the available storage - call PRTPhenologyFlush(currentCohort%prt, ipft, leaf_organ, store_c_transfer_frac) + if(EDPftvarcon_inst%woody(ipft) == itrue) then + + call PRTPhenologyFlush(currentCohort%prt, ipft, leaf_organ, store_c_transfer_frac) + currentCohort%laimemory = 0.0_r8 + + else + + ! Check that the stem drop fraction is set to non-zero amount otherwise flush all carbon store to leaves + if (stem_drop_fraction .gt. 0.0_r8) then + + call PRTPhenologyFlush(currentCohort%prt, ipft, leaf_organ, & + store_c_transfer_frac*currentCohort%laimemory/totalmemory) + + call PRTPhenologyFlush(currentCohort%prt, ipft, sapw_organ, & + store_c_transfer_frac*currentCohort%sapwmemory/totalmemory) - currentCohort%laimemory = 0.0_r8 + call PRTPhenologyFlush(currentCohort%prt, ipft, struct_organ, & + store_c_transfer_frac*currentCohort%structmemory/totalmemory) + else + + call PRTPhenologyFlush(currentCohort%prt, ipft, leaf_organ, & + store_c_transfer_frac) + + end if + + currentCohort%laimemory = 0.0_r8 + currentCohort%structmemory = 0.0_r8 + currentCohort%sapwmemory = 0.0_r8 + + endif endif !pft phenology endif ! growing season @@ -810,26 +1027,42 @@ subroutine phenology_leafonoff(currentSite) if (currentCohort%status_coh == leaves_on) then ! leaves have not dropped - - ! This sets the cohort to the "leaves off" flag - currentCohort%status_coh = leaves_off + ! leaf off occur on individuals bigger than specific size for grass + if (currentCohort%dbh > EDPftvarcon_inst%phen_cold_size_threshold(ipft) & + .or. EDPftvarcon_inst%woody(ipft)==itrue) then + + ! This sets the cohort to the "leaves off" flag + currentCohort%status_coh = leaves_off - ! Remember what the lai was (leaf mass actually) was for next year - ! the same amount back on in the spring... + ! Remember what the lai was (leaf mass actually) was for next year + ! the same amount back on in the spring... - currentCohort%laimemory = leaf_c + currentCohort%laimemory = leaf_c - ! Drop Leaves (this routine will update the leaf state variables, - ! for carbon and any other element that are prognostic. It will - ! also track the turnover masses that will be sent to litter later on) + ! Drop Leaves (this routine will update the leaf state variables, + ! for carbon and any other element that are prognostic. It will + ! also track the turnover masses that will be sent to litter later on) - call PRTDeciduousTurnover(currentCohort%prt,ipft, & - leaf_organ, leaf_drop_fraction) - + call PRTDeciduousTurnover(currentCohort%prt,ipft, & + leaf_organ, leaf_drop_fraction) + + if(EDPftvarcon_inst%woody(ipft).ne.itrue)then + + currentCohort%sapwmemory = sapw_c * stem_drop_fraction + + currentCohort%structmemory = struct_c * stem_drop_fraction + + call PRTDeciduousTurnover(currentCohort%prt,ipft, & + sapw_organ, stem_drop_fraction) - endif !leaf status - endif !currentSite status - endif !season_decid + call PRTDeciduousTurnover(currentCohort%prt,ipft, & + struct_organ, stem_drop_fraction) + + endif ! woody plant check + endif ! individual dbh size check + endif !leaf status + endif !currentSite status + endif !season_decid ! DROUGHT LEAF ON ! Site level flag indicates it is no longer in drought condition @@ -837,232 +1070,349 @@ subroutine phenology_leafonoff(currentSite) if (EDPftvarcon_inst%stress_decid(ipft) == itrue )then - if (currentSite%dstatus == phen_dstat_moiston .or. & + if (currentSite%dstatus == phen_dstat_moiston .or. & currentSite%dstatus == phen_dstat_timeon )then - ! we have just moved to leaves being on . - if (currentCohort%status_coh == leaves_off)then + ! we have just moved to leaves being on . + if (currentCohort%status_coh == leaves_off)then !is it the leaf-on day? Are the leaves currently off? - currentCohort%status_coh = leaves_on ! Leaves are on, so change status to + currentCohort%status_coh = leaves_on ! Leaves are on, so change status to ! stop flow of carbon out of bstore. - if(store_c>nearzero) then - store_c_transfer_frac = & + if(store_c>nearzero) then + + store_c_transfer_frac = & min(EDPftvarcon_inst%phenflush_fraction(ipft)*currentCohort%laimemory, store_c)/store_c - else - store_c_transfer_frac = 0.0_r8 - end if + + if(EDPftvarcon_inst%woody(ipft).ne.itrue)then + + totalmemory=currentCohort%laimemory+currentCohort%sapwmemory+currentCohort%structmemory + store_c_transfer_frac = min(EDPftvarcon_inst%phenflush_fraction(ipft)* & + totalmemory, store_c)/store_c + + endif + + else + store_c_transfer_frac = 0.0_r8 + endif ! This call will request that storage carbon will be transferred to ! leaf tissues. It is specified as a fraction of the available storage - call PRTPhenologyFlush(currentCohort%prt, ipft, & - leaf_organ, store_c_transfer_frac) + if(EDPftvarcon_inst%woody(ipft) == itrue) then + + call PRTPhenologyFlush(currentCohort%prt, ipft, & + leaf_organ, store_c_transfer_frac) - currentCohort%laimemory = 0.0_r8 + currentCohort%laimemory = 0.0_r8 + + else - endif !currentCohort status again? - endif !currentSite status + ! Check that the stem drop fraction is set to non-zero amount otherwise flush all carbon store to leaves + if (stem_drop_fraction .gt. 0.0_r8) then - !DROUGHT LEAF OFF - if (currentSite%dstatus == phen_dstat_moistoff .or. & - currentSite%dstatus == phen_dstat_timeoff) then + call PRTPhenologyFlush(currentCohort%prt, ipft, leaf_organ, & + store_c_transfer_frac*currentCohort%laimemory/totalmemory) - if (currentCohort%status_coh == leaves_on) then ! leaves have not dropped + call PRTPhenologyFlush(currentCohort%prt, ipft, sapw_organ, & + store_c_transfer_frac*currentCohort%sapwmemory/totalmemory) - ! This sets the cohort to the "leaves off" flag - currentCohort%status_coh = leaves_off - - ! Remember what the lai (leaf mass actually) was for next year - currentCohort%laimemory = leaf_c + call PRTPhenologyFlush(currentCohort%prt, ipft, struct_organ, & + store_c_transfer_frac*currentCohort%structmemory/totalmemory) - call PRTDeciduousTurnover(currentCohort%prt,ipft, & - leaf_organ, leaf_drop_fraction) + else - endif - endif !status - endif !drought dec. + call PRTPhenologyFlush(currentCohort%prt, ipft, leaf_organ, & + store_c_transfer_frac) - call currentCohort%prt%CheckMassConservation(ipft,1) + end if + + currentCohort%laimemory = 0.0_r8 + currentCohort%structmemory = 0.0_r8 + currentCohort%sapwmemory = 0.0_r8 + + endif ! woody plant check + endif !currentCohort status again? + endif !currentSite status - currentCohort => currentCohort%shorter - enddo !currentCohort + !DROUGHT LEAF OFF + if (currentSite%dstatus == phen_dstat_moistoff .or. & + currentSite%dstatus == phen_dstat_timeoff) then + + if (currentCohort%status_coh == leaves_on) then ! leaves have not dropped + + ! This sets the cohort to the "leaves off" flag + currentCohort%status_coh = leaves_off + + ! Remember what the lai (leaf mass actually) was for next year + currentCohort%laimemory = leaf_c + + call PRTDeciduousTurnover(currentCohort%prt,ipft, & + leaf_organ, leaf_drop_fraction) + + if(EDPftvarcon_inst%woody(ipft).ne.itrue)then + + currentCohort%sapwmemory = sapw_c * stem_drop_fraction + currentCohort%structmemory = struct_c * stem_drop_fraction + + call PRTDeciduousTurnover(currentCohort%prt,ipft, & + sapw_organ, stem_drop_fraction) + + call PRTDeciduousTurnover(currentCohort%prt,ipft, & + struct_organ, stem_drop_fraction) + endif - currentPatch => currentPatch%younger + endif + endif !status + endif !drought dec. - enddo !currentPatch + if(debug) call currentCohort%prt%CheckMassConservation(ipft,1) + + currentCohort => currentCohort%shorter + enddo !currentCohort + + currentPatch => currentPatch%younger + + enddo !currentPatch end subroutine phenology_leafonoff - ! ============================================================================ - subroutine seeds_in( currentSite, cp_pnt ) - ! - ! !DESCRIPTION: - ! Flux from plants into seed pool. - ! + ! ===================================================================================== + + subroutine SeedIn( currentSite, bc_in ) + + ! ----------------------------------------------------------------------------------- + ! Flux from plants into the seed pool. + ! It is assumed that allocation to seed on living pools has already been calculated + ! at the daily time step. + ! Note: Some seed generation can occur during disturbance. It is assumed that + ! some plants use their storage upon death to create seeds, but this in only + ! triggered during non-fire and non-logging events. See + ! subroutine mortality_litter_fluxes() and DistributeSeeds(), look for + ! parameter allom_frbstor_repro + ! ----------------------------------------------------------------------------------- + + ! !USES: - use EDTypesMod, only : AREA + use EDTypesMod, only : area use EDTypesMod, only : homogenize_seed_pfts ! ! !ARGUMENTS type(ed_site_type), intent(inout), target :: currentSite - type(ed_patch_type), intent(inout), target :: cp_pnt ! seeds go to these patches. - ! - ! !LOCAL VARIABLES: - type(ed_patch_type), pointer :: currentPatch - type(ed_cohort_type), pointer :: currentCohort - integer :: p - logical :: pft_present(maxpft) - real(r8) :: store_c_to_repro ! carbon sent from storage to reproduction upon death [kg/plant] - real(r8) :: npfts_present - !---------------------------------------------------------------------- + type(bc_in_type), intent(in) :: bc_in - currentPatch => cp_pnt - - currentPatch%seeds_in(:) = 0.0_r8 + type(ed_patch_type), pointer :: currentPatch + type(litter_type), pointer :: litt + type(ed_cohort_type), pointer :: currentCohort + type(site_massbal_type), pointer :: site_mass + + integer :: pft + real(r8) :: store_m_to_repro ! mass sent from storage to reproduction upon death [kg/plant] + real(r8) :: site_seed_rain(maxpft) ! This is the sum of seed-rain for the site [kg/site/day] + real(r8) :: seed_in_external ! Mass of externally generated seeds [kg/m2/day] + real(r8) :: seed_stoich ! Mass ratio of nutrient per C12 in seeds [kg/kg] + real(r8) :: seed_prod ! Seed produced in this dynamics step [kg/day] + integer :: n_litt_types ! number of litter element types (c,n,p, etc) + integer :: el ! loop counter for litter element types + integer :: element_id ! element id consistent with parteh/PRTGenericMod.F90 + !------------------------------------------------------------------------------------ + + do el = 1, num_elements + + site_seed_rain(:) = 0._r8 + + element_id = element_list(el) + + site_mass => currentSite%mass_balance(el) - if ( homogenize_seed_pfts ) then - ! special mode to remove intergenerational filters on PFT existence: each PFT seeds all PFTs - ! first loop over all patches and cohorts to see what and how many PFTs are present on this site - pft_present(:) = .false. - npfts_present = 0._r8 + ! Loop over all patches and sum up the seed input for each PFT currentPatch => currentSite%oldest_patch - do while(associated(currentPatch)) + do while (associated(currentPatch)) + currentCohort => currentPatch%tallest do while (associated(currentCohort)) - p = currentCohort%pft - if (.not. pft_present(p)) then - pft_present(p) = .true. - npfts_present = npfts_present + 1._r8 - endif - currentCohort => currentCohort%shorter - enddo !cohort loop - currentPatch => currentPatch%younger - enddo ! patch loop - - ! now calculate the homogenized seed flux into each PFT pool - currentPatch => cp_pnt - currentCohort => currentPatch%tallest - do while (associated(currentCohort)) - - ! a certain fraction of bstore goes to clonal reproduction when plants die - store_c_to_repro = currentCohort%prt%GetState(store_organ,all_carbon_elements) * & - EDPftvarcon_inst%allom_frbstor_repro(currentCohort%pft) + + pft = currentCohort%pft - do p = 1, numpft - if (pft_present(p)) then - - currentPatch%seeds_in(p) = currentPatch%seeds_in(p) + & - (currentCohort%seed_prod * currentCohort%n - & - currentCohort%dndt*store_c_to_repro) & - /(currentPatch%area * npfts_present) - endif - end do - currentCohort => currentCohort%shorter - enddo !cohort loop - else + ! a certain fraction of bstore might go to clonal reproduction when plants die + ! (since this is only applied to the dying portion of the cohort + ! we do not actually pair down the storage via PARTEH, instead + ! we just make sure that we don't send a portion of the storage + ! to the litter in CWDInput) + ! units = [kg/ha/day] = [kg] * [fraction] * [plants/ha/year] * [year/day] + store_m_to_repro = -currentCohort%prt%GetState(store_organ,element_id) * & + EDPftvarcon_inst%allom_frbstor_repro(pft)*currentCohort%dndt*years_per_day + + ! Transfer all reproductive tissues into seed production + ! The following call to PRTReproRelease, will return the mass + ! of seeds [kg] released by the plant, per the mass_fraction + ! specified as input. This routine will also remove the mass + ! from the parteh state-variable. + + call PRTReproRelease(currentCohort%prt,repro_organ,element_id, & + 1.0_r8, seed_prod) + + if(element_id==carbon12_element)then + currentcohort%seed_prod = seed_prod + end if - ! normal case: each PFT seeds its own type - currentCohort => currentPatch%tallest - do while (associated(currentCohort)) - p = currentCohort%pft + site_seed_rain(pft) = site_seed_rain(pft) + & + (seed_prod * currentCohort%n + store_m_to_repro) + + currentCohort => currentCohort%shorter + enddo !cohort loop + + currentPatch => currentPatch%younger + enddo - ! a certain fraction of bstore goes to clonal reproduction when plants die - store_c_to_repro = currentCohort%prt%GetState(store_organ,all_carbon_elements) * & - EDPftvarcon_inst%allom_frbstor_repro(p) + ! We can choose to homogenize seeds. This is simple, we just + ! add up all the seed from each pft at the site level, and then + ! equally distribute to the PFT pools + if ( homogenize_seed_pfts ) then + site_seed_rain(1:numpft) = sum(site_seed_rain(:))/real(numpft,r8) + end if - currentPatch%seeds_in(p) = currentPatch%seeds_in(p) + & - (currentCohort%seed_prod * currentCohort%n - & - currentCohort%dndt*store_c_to_repro)/currentPatch%area - - currentCohort => currentCohort%shorter - enddo !cohort loop - - endif + + ! Loop over all patches again and disperse the mixed seeds into the input flux + ! arrays + + ! If there is forced external seed rain, we calculate the input mass flux + ! from the different elements, usung the seed optimal stoichiometry + ! for non-carbon + select case(element_id) + case(carbon12_element) + seed_stoich = 1._r8 + case(nitrogen_element) + seed_stoich = EDPftvarcon_inst%prt_nitr_stoich_p2(pft,repro_organ) + case(phosphorus_element) + seed_stoich = EDPftvarcon_inst%prt_phos_stoich_p2(pft,repro_organ) + case default + write(fates_log(), *) 'undefined element specified' + write(fates_log(), *) 'while defining forced external seed mass flux' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end select + - do p = 1,numpft - currentPatch%seeds_in(p) = currentPatch%seeds_in(p) + & - EDPftvarcon_inst%seed_rain(p) !KgC/m2/year - currentSite%seed_rain_flux(p) = currentSite%seed_rain_flux(p) + & - EDPftvarcon_inst%seed_rain(p) * currentPatch%area/AREA !KgC/m2/year + ! Loop over all patches and sum up the seed input for each PFT + currentPatch => currentSite%oldest_patch + do while (associated(currentPatch)) - currentSite%flux_in = currentSite%flux_in + & - EDPftvarcon_inst%seed_rain(p) * currentPatch%area * hlm_freq_day + litt => currentPatch%litter(el) + do pft = 1,numpft + + ! Seed input from local sources (within site) + litt%seed_in_local(pft) = litt%seed_in_local(pft) + site_seed_rain(pft)/area + + ! Seed input from external sources (user param seed rain, or dispersal model) + seed_in_external = seed_stoich*EDPftvarcon_inst%seed_suppl(pft)*years_per_day + + litt%seed_in_extern(pft) = litt%seed_in_extern(pft) + seed_in_external - enddo + ! Seeds entering externally [kg/site/day] + site_mass%seed_in = site_mass%seed_in + seed_in_external*currentPatch%area + enddo + + + currentPatch => currentPatch%younger + enddo + + end do - end subroutine seeds_in + return + end subroutine SeedIn ! ============================================================================ - subroutine seed_decay( currentSite, currentPatch ) + + subroutine SeedDecay( litt ) ! ! !DESCRIPTION: ! Flux from seed pool into leaf litter pool ! - ! !USES: - use EDPftvarcon , only : EDPftvarcon_inst - ! - ! !ARGUMENTS - type(ed_site_type), intent(inout), target :: currentSite - type(ed_patch_type),intent(inout) :: currentPatch ! seeds go to these patches. + ! !ARGUMENTS + type(litter_type) :: litt ! ! !LOCAL VARIABLES: - integer :: p + integer :: pft !---------------------------------------------------------------------- ! default value from Liscke and Loffler 2006 ; making this a PFT-specific parameter ! decays the seed pool according to exponential model - ! seed_decay_turnover is in yr-1 - do p = 1,numpft - currentPatch%seed_decay(p) = currentSite%seed_bank(p) * EDPftvarcon_inst%seed_decay_turnover(p) + ! seed_decay_rate is in yr-1 + ! seed_decay is kg/day + ! Assume that decay rates are same for all chemical species + + do pft = 1,numpft + litt%seed_decay(pft) = litt%seed(pft) * & + EDPftvarcon_inst%seed_decay_rate(pft)*years_per_day + + litt%seed_germ_decay(pft) = litt%seed_germ(pft) * & + EDPftvarcon_inst%seed_decay_rate(pft)*years_per_day + enddo - - end subroutine seed_decay + + return + end subroutine SeedDecay ! ============================================================================ - subroutine seed_germination( currentSite, currentPatch ) + subroutine SeedGermination( litt, cold_stat, drought_stat ) ! ! !DESCRIPTION: ! Flux from seed pool into sapling pool ! ! !USES: - use EDPftvarcon , only : EDPftvarcon_inst + ! - ! !ARGUMENTS - type(ed_site_type), intent(inout), target :: currentSite - type(ed_patch_type),intent(inout) :: currentPatch ! seeds go to these patches. + ! !ARGUMENTS + type(litter_type) :: litt + integer, intent(in) :: cold_stat ! Is the site in cold leaf-off status? + integer, intent(in) :: drought_stat ! Is the site in drought leaf-off status? ! ! !LOCAL VARIABLES: - integer :: p - real(r8) max_germination !cap on germination rates. KgC/m2/yr Lishcke et al. 2009 - !---------------------------------------------------------------------- + integer :: pft - max_germination = 1.0_r8 !this is arbitrary + + real(r8), parameter :: max_germination = 1.0_r8 ! Cap on germination rates. + ! KgC/m2/yr Lishcke et al. 2009 + + ! Turning of this cap? because the cap will impose changes on proportionality + ! of nutrients. (RGK 02-2019) + !real(r8), parameter :: max_germination = 1.e6_r8 ! Force to very high number + + !---------------------------------------------------------------------- - ! germination_timescale is being pulled to PFT parameter; units are 1/yr + ! germination_rate is being pulled to PFT parameter; units are 1/yr ! thus the mortality rate of seed -> recruit (in units of carbon) - ! is seed_decay_turnover(p)/germination_timescale(p) - ! and thus the mortlaity rate (in units of individuals) is the product of + ! is seed_decay_rate(p)/germination_rate(p) + ! and thus the mortality rate (in units of individuals) is the product of ! that times the ratio of (hypothetical) seed mass to recruit biomass - do p = 1,numpft - currentPatch%seed_germination(p) = min(currentSite%seed_bank(p) * & - EDPftvarcon_inst%germination_timescale(p),max_germination) + do pft = 1,numpft + litt%seed_germ_in(pft) = min(litt%seed(pft) * EDPftvarcon_inst%germination_rate(pft), & + max_germination)*years_per_day + !set the germination only under the growing season...c.xu - if ( (EDPftvarcon_inst%season_decid(p) == itrue) .and. & - (any(currentSite%cstatus == [phen_cstat_nevercold,phen_cstat_iscold]))) then - currentPatch%seed_germination(p) = 0.0_r8 - endif - if ( (EDPftvarcon_inst%stress_decid(p) == itrue) .and. & - (any(currentSite%dstatus == [phen_dstat_timeoff,phen_dstat_moistoff]))) then - currentPatch%seed_germination(p) = 0.0_r8 + + if ((EDPftvarcon_inst%season_decid(pft) == itrue ) .and. & + (any(cold_stat == [phen_cstat_nevercold,phen_cstat_iscold]))) then + litt%seed_germ_in(pft) = 0.0_r8 endif + if ((EDPftvarcon_inst%stress_decid(pft) == itrue ) .and. & + (any(drought_stat == [phen_dstat_timeoff,phen_dstat_moistoff]))) then + litt%seed_germ_in(pft) = 0.0_r8 + end if + enddo - end subroutine seed_germination + end subroutine SeedGermination + + ! ===================================================================================== + + + + ! ===================================================================================== @@ -1080,18 +1430,37 @@ subroutine recruitment( currentSite, currentPatch, bc_in ) type(bc_in_type), intent(in) :: bc_in ! ! !LOCAL VARIABLES: + class(prt_vartypes), pointer :: prt integer :: ft 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 integer :: cohortstatus + 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,parameter :: recruitstatus = 1 !weather it the new created cohorts is recruited or initialized - real(r8) :: b_leaf - real(r8) :: b_fineroot ! fine root biomass [kgC] - real(r8) :: b_sapwood ! sapwood biomass [kgC] - real(r8) :: a_sapwood ! sapwood cross section are [m2] (dummy) - real(r8) :: b_agw ! Above ground biomass [kgC] - real(r8) :: b_bgw ! Below ground biomass [kgC] - real(r8) :: b_dead - real(r8) :: b_store + real(r8) :: c_leaf ! target leaf biomass [kgC] + real(r8) :: c_fnrt ! target fine root biomass [kgC] + real(r8) :: c_sapw ! target sapwood biomass [kgC] + real(r8) :: a_sapw ! target sapwood cross section are [m2] (dummy) + real(r8) :: c_agw ! target Above ground biomass [kgC] + real(r8) :: c_bgw ! target Below ground biomass [kgC] + real(r8) :: c_struct ! target Structural biomass [kgc] + real(r8) :: c_store ! target Storage biomass [kgC] + real(r8) :: m_leaf ! leaf mass (element agnostic) [kg] + real(r8) :: m_fnrt ! fine-root mass (element agnostic) [kg] + real(r8) :: m_sapw ! sapwood mass (element agnostic) [kg] + real(r8) :: m_agw ! AG wood mass (element agnostic) [kg] + real(r8) :: m_bgw ! BG wood mass (element agnostic) [kg] + real(r8) :: m_struct ! structural mass (element agnostic) [kg] + real(r8) :: m_store ! storage mass (element agnostic) [kg] + real(r8) :: m_repro ! reproductive mass (element agnostic) [kg] + real(r8) :: mass_avail ! The mass of each nutrient/carbon available in the seed_germination pool [kg] + real(r8) :: mass_demand ! Total mass demanded by the plant to achieve the stoichiometric targets + ! of all the organs in the recruits. Used for both [kg per plant] and [kg per cohort] + real(r8) :: stem_drop_fraction + !---------------------------------------------------------------------- allocate(temp_cohort) ! create temporary cohort @@ -1102,83 +1471,255 @@ subroutine recruitment( currentSite, currentPatch, bc_in ) temp_cohort%canopy_trim = 0.8_r8 !starting with the canopy not fully expanded temp_cohort%pft = ft temp_cohort%hite = EDPftvarcon_inst%hgt_min(ft) + stem_drop_fraction = EDPftvarcon_inst%phen_stem_drop_fraction(ft) call h2d_allom(temp_cohort%hite,ft,temp_cohort%dbh) ! Initialize live pools - call bleaf(temp_cohort%dbh,ft,temp_cohort%canopy_trim,b_leaf) - call bfineroot(temp_cohort%dbh,ft,temp_cohort%canopy_trim,b_fineroot) - call bsap_allom(temp_cohort%dbh,ft,temp_cohort%canopy_trim,a_sapwood, b_sapwood) - call bagw_allom(temp_cohort%dbh,ft,b_agw) - call bbgw_allom(temp_cohort%dbh,ft,b_bgw) - call bdead_allom(b_agw,b_bgw,b_sapwood,ft,b_dead) - call bstore_allom(temp_cohort%dbh,ft,temp_cohort%canopy_trim,b_store) + call bleaf(temp_cohort%dbh,ft,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 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) ! Default assumption is that leaves are on cohortstatus = leaves_on temp_cohort%laimemory = 0.0_r8 + temp_cohort%sapwmemory = 0.0_r8 + temp_cohort%structmemory = 0.0_r8 - if ( (EDPftvarcon_inst%season_decid(temp_cohort%pft) == itrue) .and. & - (any(currentSite%cstatus == [phen_cstat_nevercold,phen_cstat_iscold]))) then - temp_cohort%laimemory = b_leaf - b_leaf = 0.0_r8 - cohortstatus = leaves_off + + ! But if the plant is seasonally (cold) deciduous, and the site status is flagged + ! as "cold", then set the cohort's status to leaves_off, and remember the leaf biomass + if ((EDPftvarcon_inst%season_decid(ft) == itrue) .and. & + (any(currentSite%cstatus == [phen_cstat_nevercold,phen_cstat_iscold]))) then + temp_cohort%laimemory = c_leaf + c_leaf = 0.0_r8 + + ! If plant is not woody then set sapwood and structural biomass as well + if (EDPftvarcon_inst%woody(ft).ne.itrue) then + temp_cohort%sapwmemory = c_sapw * stem_drop_fraction + temp_cohort%structmemory = c_struct * stem_drop_fraction + c_sapw = (1.0_r8 - stem_drop_fraction) * c_sapw + c_struct = (1.0_r8 - stem_drop_fraction) * c_struct + endif + cohortstatus = leaves_off endif - - if ( (EDPftvarcon_inst%stress_decid(temp_cohort%pft) == itrue) .and. & - (any(currentSite%dstatus == [phen_dstat_timeoff,phen_dstat_moistoff]))) then - temp_cohort%laimemory = b_leaf - b_leaf = 0.0_r8 - cohortstatus = leaves_off + + ! Or.. if the plant is drought deciduous, and the site status is flagged as + ! "in a drought", then likewise, set the cohort's status to leaves_off, and remember leaf + ! biomass + if ((EDPftvarcon_inst%stress_decid(ft) == itrue) .and. & + (any(currentSite%dstatus == [phen_dstat_timeoff,phen_dstat_moistoff]))) then + temp_cohort%laimemory = c_leaf + c_leaf = 0.0_r8 + + ! If plant is not woody then set sapwood and structural biomass as well + if(EDPftvarcon_inst%woody(ft).ne.itrue)then + temp_cohort%sapwmemory = c_sapw * stem_drop_fraction + temp_cohort%structmemory = c_struct * stem_drop_fraction + c_sapw = (1.0_r8 - stem_drop_fraction) * c_sapw + c_struct = (1.0_r8 - stem_drop_fraction) * c_struct + endif + cohortstatus = leaves_off endif + + + ! Cycle through available carbon and nutrients, find the limiting element + ! to dictate the total number of plants that can be generated + + if ( (hlm_use_ed_prescribed_phys .eq. ifalse) .or. & + (EDPftvarcon_inst%prescribed_recruitment(ft) .lt. 0._r8) ) then + + temp_cohort%n = 1.e10_r8 + + do el = 1,num_elements + + element_id = element_list(el) + select case(element_id) + case(carbon12_element) + + mass_demand = (c_struct+c_leaf+c_fnrt+c_sapw+c_store) + + case(nitrogen_element) + + mass_demand = c_struct*EDPftvarcon_inst%prt_nitr_stoich_p1(ft,struct_organ) + & + c_leaf*EDPftvarcon_inst%prt_nitr_stoich_p1(ft,leaf_organ) + & + c_fnrt*EDPftvarcon_inst%prt_nitr_stoich_p1(ft,fnrt_organ) + & + c_sapw*EDPftvarcon_inst%prt_nitr_stoich_p1(ft,sapw_organ) + & + c_store*EDPftvarcon_inst%prt_nitr_stoich_p1(ft,store_organ) + + case(phosphorus_element) + + mass_demand = c_struct*EDPftvarcon_inst%prt_phos_stoich_p1(ft,struct_organ) + & + c_leaf*EDPftvarcon_inst%prt_phos_stoich_p1(ft,leaf_organ) + & + c_fnrt*EDPftvarcon_inst%prt_phos_stoich_p1(ft,fnrt_organ) + & + c_sapw*EDPftvarcon_inst%prt_phos_stoich_p1(ft,sapw_organ) + & + c_store*EDPftvarcon_inst%prt_phos_stoich_p1(ft,store_organ) + + case default + write(fates_log(),*) 'Undefined element type in recruitment' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end select + + mass_avail = currentPatch%area * currentPatch%litter(el)%seed_germ(ft) + + ! ------------------------------------------------------------------------ + ! Update number density if this is the limiting mass + ! ------------------------------------------------------------------------ + + temp_cohort%n = min(temp_cohort%n, mass_avail/mass_demand) + + end do - if (hlm_use_ed_prescribed_phys .eq. ifalse .or. EDPftvarcon_inst%prescribed_recruitment(ft) .lt. 0. ) then - temp_cohort%n = currentPatch%area * currentPatch%seed_germination(ft)*hlm_freq_day & - / (b_dead+b_leaf+b_fineroot+b_sapwood+b_store) else ! prescribed recruitment rates. number per sq. meter per year - temp_cohort%n = currentPatch%area * EDPftvarcon_inst%prescribed_recruitment(ft) * hlm_freq_day + temp_cohort%n = currentPatch%area * & + EDPftvarcon_inst%prescribed_recruitment(ft) * & + hlm_freq_day endif - ! Only bother allocating a new cohort if there is a reasonable amount of it if (temp_cohort%n > min_n_safemath )then - if ( debug ) write(fates_log(),*) 'EDPhysiologyMod.F90 call create_cohort ' - call create_cohort(currentSite,currentPatch, temp_cohort%pft, temp_cohort%n, temp_cohort%hite, temp_cohort%dbh, & - b_leaf, b_fineroot, b_sapwood, b_dead, b_store, & - temp_cohort%laimemory, cohortstatus,recruitstatus, temp_cohort%canopy_trim, currentPatch%NCL_p, & - currentSite%spread, first_leaf_aclass, bc_in) + ! ----------------------------------------------------------------------------- + ! PART II. + ! Initialize the PARTEH object, and determine the initial masses of all + ! organs and elements. + ! ----------------------------------------------------------------------------- - ! Note that if hydraulics is on, the number of cohorts may had changed due to hydraulic constraints. - ! This constaint is applied during "create_cohort" subroutine. - - ! keep track of how many individuals were recruited for passing to history - currentSite%recruitment_rate(ft) = currentSite%recruitment_rate(ft) + temp_cohort%n - - ! modify the carbon balance accumulators to take into account the different way of defining recruitment - ! add prescribed rates as an input C flux, and the recruitment that would have otherwise occured as an output flux - ! (since the carbon associated with them effectively vanishes) - ! check the water for hydraulics - if (hlm_use_ed_prescribed_phys .ne. ifalse .and. EDPftvarcon_inst%prescribed_recruitment(ft) .ge. 0. ) then - currentSite%flux_in = currentSite%flux_in + temp_cohort%n * & - (b_store + b_leaf + b_fineroot + b_sapwood + b_dead) - currentSite%flux_out = currentSite%flux_out + currentPatch%area * currentPatch%seed_germination(ft)*hlm_freq_day - endif + prt => null() + call InitPRTObject(prt) + do el = 1,num_elements + + element_id = element_list(el) + + ! If this is carbon12, then the initialization is straight forward + ! otherwise, we use stoichiometric ratios + select case(element_id) + case(carbon12_element) + + m_struct = c_struct + m_leaf = c_leaf + m_fnrt = c_fnrt + m_sapw = c_sapw + m_store = c_store + m_repro = 0._r8 + + case(nitrogen_element) + + m_struct = c_struct*EDPftvarcon_inst%prt_nitr_stoich_p1(ft,struct_organ) + m_leaf = c_leaf*EDPftvarcon_inst%prt_nitr_stoich_p1(ft,leaf_organ) + m_fnrt = c_fnrt*EDPftvarcon_inst%prt_nitr_stoich_p1(ft,fnrt_organ) + m_sapw = c_sapw*EDPftvarcon_inst%prt_nitr_stoich_p1(ft,sapw_organ) + m_store = c_store*EDPftvarcon_inst%prt_nitr_stoich_p1(ft,store_organ) + m_repro = 0._r8 + + case(phosphorus_element) + + m_struct = c_struct*EDPftvarcon_inst%prt_phos_stoich_p1(ft,struct_organ) + m_leaf = c_leaf*EDPftvarcon_inst%prt_phos_stoich_p1(ft,leaf_organ) + m_fnrt = c_fnrt*EDPftvarcon_inst%prt_phos_stoich_p1(ft,fnrt_organ) + m_sapw = c_sapw*EDPftvarcon_inst%prt_phos_stoich_p1(ft,sapw_organ) + m_store = c_store*EDPftvarcon_inst%prt_phos_stoich_p1(ft,store_organ) + m_repro = 0._r8 + + end select + + select case(hlm_parteh_mode) + case (prt_carbon_allom_hyp,prt_cnp_flex_allom_hyp ) + + ! Put all of the leaf mass into the first bin + call SetState(prt,leaf_organ, element_id,m_leaf,1) + do iage = 2,nleafage + call SetState(prt,leaf_organ, element_id,0._r8,iage) + end do + + call SetState(prt,fnrt_organ, element_id, m_fnrt) + call SetState(prt,sapw_organ, element_id, m_sapw) + call SetState(prt,store_organ, element_id, m_store) + call SetState(prt,struct_organ, element_id, m_struct) + call SetState(prt,repro_organ, element_id, m_repro) + + case default + write(fates_log(),*) 'Unspecified PARTEH module during create_cohort' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end select + + site_mass => currentSite%mass_balance(el) + + ! Remove mass from the germination pool. However, if we are use prescribed physiology, + ! AND the forced recruitment model, then we are not realling using the prognostic + ! seed_germination model, so we have to short circuit things. We send all of the + ! seed germination mass to an outflux pool, and use an arbitrary generic input flux + ! to balance out the new recruits. + + if ( (hlm_use_ed_prescribed_phys .eq. itrue ) .and. & + (EDPftvarcon_inst%prescribed_recruitment(ft) .ge. 0._r8 )) then + + site_mass%flux_generic_in = site_mass%flux_generic_in + & + temp_cohort%n*(m_struct + m_leaf + m_fnrt + m_sapw + m_store + m_repro) + + site_mass%flux_generic_out = site_mass%flux_generic_out + & + currentPatch%area * currentPatch%litter(el)%seed_germ(ft) + + currentPatch%litter(el)%seed_germ(ft) = 0._r8 + + + else + + currentPatch%litter(el)%seed_germ(ft) = currentPatch%litter(el)%seed_germ(ft) - & + temp_cohort%n / currentPatch%area * & + (m_struct + m_leaf + m_fnrt + m_sapw + m_store + m_repro) + + end if + - endif - enddo !pft loop - deallocate(temp_cohort) ! delete temporary cohort + end do + + ! This call cycles through the initial conditions, and makes sure that they + ! are all initialized. + ! ----------------------------------------------------------------------------------- + + call prt%CheckInitialConditions() + + ! This initializes the cohort + call create_cohort(currentSite,currentPatch, temp_cohort%pft, temp_cohort%n, & + temp_cohort%hite, temp_cohort%dbh, prt, & + temp_cohort%laimemory, temp_cohort%sapwmemory, temp_cohort%structmemory, & + cohortstatus, recruitstatus, & + temp_cohort%canopy_trim, currentPatch%NCL_p, currentSite%spread, bc_in) + + ! Note that if hydraulics is on, the number of cohorts may had + ! changed due to hydraulic constraints. + ! This constaint is applied during "create_cohort" subroutine. + + ! keep track of how many individuals were recruited for passing to history + currentSite%recruitment_rate(ft) = currentSite%recruitment_rate(ft) + temp_cohort%n + + + endif + enddo !pft loop + + deallocate(temp_cohort) ! delete temporary cohort end subroutine recruitment ! ============================================================================ - subroutine CWD_Input( currentSite, currentPatch) + + subroutine CWDInput( currentSite, currentPatch, litt) + ! ! !DESCRIPTION: - ! Generate litter fields from turnover. + ! Generate litter fields from turnover. + ! Note, that the when this is called, the number density of the plants + ! has not been reduced from non-mortal turnover yet. + ! Thus, we need to avoid double counting losses from dying trees + ! and turnover in dying trees. ! ! !USES: use SFParamsMod , only : SF_val_CWD_frac @@ -1187,204 +1728,350 @@ subroutine CWD_Input( currentSite, currentPatch) ! !ARGUMENTS type(ed_site_type), intent(inout), target :: currentSite type(ed_patch_type),intent(inout), target :: currentPatch + type(litter_type),intent(inout),target :: litt + + ! ! !LOCAL VARIABLES: - type(ed_cohort_type), pointer :: currentCohort - integer :: c,p + type(ed_cohort_type), pointer :: currentCohort + type(site_fluxdiags_type), pointer :: flux_diags + type(site_massbal_type), pointer :: site_mass + integer :: c real(r8) :: dead_n ! total understorey dead tree density real(r8) :: dead_n_dlogging ! direct logging understory dead-tree density real(r8) :: dead_n_ilogging ! indirect understory dead-tree density (logging) real(r8) :: dead_n_natural ! understory dead density not associated ! with direct logging - real(r8) :: leaf_c ! leaf carbon [kg] - real(r8) :: fnrt_c - real(r8) :: sapw_c - real(r8) :: struct_c - real(r8) :: store_c - real(r8) :: leaf_c_turnover ! leaf turnover [kg] - real(r8) :: fnrt_c_turnover - real(r8) :: sapw_c_turnover - real(r8) :: struct_c_turnover - real(r8) :: store_c_turnover - - real(r8) :: trunk_product ! carbon flux into trunk products kgC/day/site + real(r8) :: leaf_m ! mass of the element of interest in the + ! leaf [kg] + real(r8) :: fnrt_m ! fine-root [kg] + real(r8) :: sapw_m ! sapwood [kg] + real(r8) :: struct_m ! structural [kg] + real(r8) :: store_m ! storage [kg] + real(r8) :: repro_m ! reproductive [kg] + real(r8) :: leaf_m_turnover ! leaf turnover [kg] + real(r8) :: fnrt_m_turnover + real(r8) :: sapw_m_turnover + real(r8) :: struct_m_turnover + real(r8) :: store_m_turnover + real(r8) :: repro_m_turnover + real(r8) :: dcmpy_frac ! Fraction of mass sent to decomposability pool + real(r8) :: plant_dens ! Number of plants per m2 + real(r8) :: bg_cwd_tot ! Total below-ground coarse woody debris + ! input flux + real(r8) :: root_fines_tot ! Total below-ground fine root coarse + ! woody debris + integer :: element_id ! element id consistent with parteh/PRTGenericMod.F90 + + real(r8) :: trunk_wood ! carbon flux into trunk products kgC/day/site + integer :: ilyr integer :: pft + integer :: dcmpy ! decomposability pool index + integer :: numlevsoil ! Actual number of soil layers !---------------------------------------------------------------------- - ! ================================================ + ! ----------------------------------------------------------------------------------- ! Other direct litter fluxes happen in phenology and in spawn_patches. - ! ================================================ + ! ----------------------------------------------------------------------------------- - currentCohort => currentPatch%shortest + numlevsoil = currentSite%nlevsoil + element_id = litt%element_id + + ! Object tracking flux diagnostics for each element + flux_diags => currentSite%flux_diags(element_pos(element_id)) + + ! Object tracking site level mass balance for each element + site_mass => currentSite%mass_balance(element_pos(element_id)) + + currentCohort => currentPatch%shortest do while(associated(currentCohort)) pft = currentCohort%pft - leaf_c_turnover = currentCohort%prt%GetTurnover(leaf_organ,all_carbon_elements) - store_c_turnover = currentCohort%prt%GetTurnover(store_organ,all_carbon_elements) - fnrt_c_turnover = currentCohort%prt%GetTurnover(fnrt_organ,all_carbon_elements) - sapw_c_turnover = currentCohort%prt%GetTurnover(sapw_organ,all_carbon_elements) - struct_c_turnover = currentCohort%prt%GetTurnover(struct_organ,all_carbon_elements) + call set_root_fraction(currentSite%rootfrac_scr, pft, currentSite%zi_soil, & + icontext = i_biomass_rootprof_context) - leaf_c = currentCohort%prt%GetState(leaf_organ,all_carbon_elements) - store_c = currentCohort%prt%GetState(store_organ,all_carbon_elements) - fnrt_c = currentCohort%prt%GetState(fnrt_organ,all_carbon_elements) - sapw_c = currentCohort%prt%GetState(sapw_organ,all_carbon_elements) - struct_c = currentCohort%prt%GetState(struct_organ,all_carbon_elements) + leaf_m_turnover = currentCohort%prt%GetTurnover(leaf_organ,element_id) + store_m_turnover = currentCohort%prt%GetTurnover(store_organ,element_id) + fnrt_m_turnover = currentCohort%prt%GetTurnover(fnrt_organ,element_id) + sapw_m_turnover = currentCohort%prt%GetTurnover(sapw_organ,element_id) + struct_m_turnover = currentCohort%prt%GetTurnover(struct_organ,element_id) + repro_m_turnover = currentCohort%prt%GetTurnover(repro_organ,element_id) - ! ================================================ - ! Litter from tissue turnover. KgC/m2/year - ! ================================================ + leaf_m = currentCohort%prt%GetState(leaf_organ,element_id) + store_m = currentCohort%prt%GetState(store_organ,element_id) + fnrt_m = currentCohort%prt%GetState(fnrt_organ,element_id) + sapw_m = currentCohort%prt%GetState(sapw_organ,element_id) + struct_m = currentCohort%prt%GetState(struct_organ,element_id) + repro_m = currentCohort%prt%GetState(repro_organ,element_id) + + plant_dens = currentCohort%n/currentPatch%area + + ! --------------------------------------------------------------------------------- + ! PART 1 Litter fluxes from non-mortal tissue turnovers Kg/m2/day + ! Important note: Turnover has already been removed from the cohorts. + ! So, in the next part of this algorithm, when we send the biomass + ! from dying trees to the litter pools, we don't have to worry + ! about double counting. + ! --------------------------------------------------------------------------------- - currentPatch%leaf_litter_in(pft) = currentPatch%leaf_litter_in(pft) + & - leaf_c_turnover * currentCohort%n/currentPatch%area/hlm_freq_day + flux_diags%leaf_litter_input(pft) = & + flux_diags%leaf_litter_input(pft) + & + leaf_m_turnover * currentCohort%n - currentPatch%root_litter_in(pft) = currentPatch%root_litter_in(pft) + & - (fnrt_c_turnover + store_c_turnover ) * & - currentCohort%n/currentPatch%area/hlm_freq_day + root_fines_tot = (fnrt_m_turnover + store_m_turnover ) * & + plant_dens + + do dcmpy=1,ndcmpy + dcmpy_frac = GetDecompyFrac(pft,leaf_organ,dcmpy) + litt%leaf_fines_in(dcmpy) = litt%leaf_fines_in(dcmpy) + & + (leaf_m_turnover+repro_m_turnover) * plant_dens * dcmpy_frac + + dcmpy_frac = GetDecompyFrac(pft,fnrt_organ,dcmpy) + do ilyr = 1, numlevsoil + litt%root_fines_in(dcmpy,ilyr) = litt%root_fines_in(dcmpy,ilyr) + & + currentSite%rootfrac_scr(ilyr) * root_fines_tot * dcmpy_frac + end do + end do + + flux_diags%root_litter_input(pft) = & + flux_diags%root_litter_input(pft) + & + (fnrt_m_turnover + store_m_turnover ) * currentCohort%n - !daily leaf loss needs to be scaled up to the annual scale here. - - ! --------------------------------------------------------------------------------- ! Assumption: turnover from deadwood and sapwood are lumped together in CWD pool - ! --------------------------------------------------------------------------------- do c = 1,ncwd - currentPatch%cwd_AG_in(c) = currentPatch%cwd_AG_in(c) + & - (sapw_c_turnover + struct_c_turnover)/hlm_freq_day * & - SF_val_CWD_frac(c) * currentCohort%n/currentPatch%area * & - EDPftvarcon_inst%allom_agb_frac(currentCohort%pft) - - currentPatch%cwd_BG_in(c) = currentPatch%cwd_BG_in(c) + & - (sapw_c_turnover + struct_c_turnover)/hlm_freq_day * & - SF_val_CWD_frac(c) * currentCohort%n/currentPatch%area * & - (1.0_r8-EDPftvarcon_inst%allom_agb_frac(currentCohort%pft)) + litt%ag_cwd_in(c) = litt%ag_cwd_in(c) + & + (sapw_m_turnover + struct_m_turnover) * & + SF_val_CWD_frac(c) * plant_dens * & + EDPftvarcon_inst%allom_agb_frac(pft) + + flux_diags%cwd_ag_input(c) = flux_diags%cwd_ag_input(c) + & + (struct_m_turnover + sapw_m_turnover) * SF_val_CWD_frac(c) * & + EDPftvarcon_inst%allom_agb_frac(pft) * currentCohort%n + + bg_cwd_tot = (sapw_m_turnover + struct_m_turnover) * & + SF_val_CWD_frac(c) * plant_dens * & + (1.0_r8-EDPftvarcon_inst%allom_agb_frac(pft)) + + do ilyr = 1, numlevsoil + litt%bg_cwd_in(c,ilyr) = litt%bg_cwd_in(c,ilyr) + & + bg_cwd_tot * currentSite%rootfrac_scr(ilyr) + end do + + flux_diags%cwd_bg_input(c) = flux_diags%cwd_bg_input(c) + & + bg_cwd_tot*currentPatch%area + enddo - !if (currentCohort%canopy_layer > 1)then - ! ================================================ - ! Litter fluxes for understorey mortality. KgC/m2/year - ! ================================================ + ! --------------------------------------------------------------------------------- + ! PART 2 Litter fluxes from non-disturbance inducing mortality. Kg/m2/day + ! --------------------------------------------------------------------------------- - ! Total number of dead understory (n/m2) - dead_n = -1.0_r8 * currentCohort%dndt / currentPatch%area + ! Total number of dead (n/m2/day) + dead_n = -1.0_r8 * currentCohort%dndt/currentPatch%area*years_per_day - ! Total number of dead understory from direct logging - ! (it is possible that large harvestable trees are in the understory) - dead_n_dlogging = ( currentCohort%lmort_direct) * & - currentCohort%n/hlm_freq_day/currentPatch%area - - ! Total number of dead understory from indirect logging - dead_n_ilogging = ( currentCohort%lmort_collateral + currentCohort%lmort_infra) * & - currentCohort%n/hlm_freq_day/currentPatch%area - - dead_n_natural = dead_n - dead_n_dlogging - dead_n_ilogging + if(currentCohort%canopy_layer > 1)then - - currentPatch%leaf_litter_in(pft) = currentPatch%leaf_litter_in(pft) + & - (leaf_c)* dead_n - ! %n has not been updated due to mortality yet, thus - ! the litter flux has already been counted since it captured - ! the losses of live trees and those flagged for death - - currentPatch%root_litter_in(pft) = currentPatch%root_litter_in(pft) + & - (fnrt_c + store_c*(1._r8-EDPftvarcon_inst%allom_frbstor_repro(pft)) ) * dead_n - - ! Update diagnostics that track resource management - currentSite%resources_management%delta_litter_stock = & - currentSite%resources_management%delta_litter_stock + & - (leaf_c + fnrt_c + store_c ) * & - (dead_n_ilogging+dead_n_dlogging) * & - hlm_freq_day * currentPatch%area - - ! Update diagnostics that track resource management - currentSite%resources_management%delta_biomass_stock = & - currentSite%resources_management%delta_biomass_stock + & - (leaf_c + fnrt_c + store_c ) * & - (dead_n_ilogging+dead_n_dlogging) * & - hlm_freq_day * currentPatch%area - - if( hlm_use_planthydro == itrue ) then - !call AccumulateMortalityWaterStorage(currentSite,currentCohort,dead_n) - call AccumulateMortalityWaterStorage(currentSite,currentCohort,& - -1.0_r8 * currentCohort%dndt * hlm_freq_day) - end if - + ! Total number of dead understory from direct logging + ! (it is possible that large harvestable trees are in the understory) + dead_n_dlogging = currentCohort%lmort_direct * & + currentCohort%n/currentPatch%area - do c = 1,ncwd - - currentPatch%cwd_BG_in(c) = currentPatch%cwd_BG_in(c) + (struct_c + sapw_c) * & - SF_val_CWD_frac(c) * dead_n * (1.0_r8-EDPftvarcon_inst%allom_agb_frac(currentCohort%pft)) + ! Total number of dead understory from indirect logging + dead_n_ilogging = (currentCohort%lmort_collateral + currentCohort%lmort_infra) * & + currentCohort%n/currentPatch%area - ! Send AGB component of boles from non direct-logging activities to AGB litter pool - if (c==ncwd) then - - currentPatch%cwd_AG_in(c) = currentPatch%cwd_AG_in(c) + (struct_c + sapw_c) * & - SF_val_CWD_frac(c) * (dead_n_natural+dead_n_ilogging) * & - EDPftvarcon_inst%allom_agb_frac(currentCohort%pft) - - else + else - currentPatch%cwd_AG_in(c) = currentPatch%cwd_AG_in(c) + (struct_c + sapw_c) * & - SF_val_CWD_frac(c) * dead_n * & - EDPftvarcon_inst%allom_agb_frac(currentCohort%pft) + ! All mortality from logging in the canopy is + ! is disturbance generating - ! Send AGB component of boles from direct-logging activities to export/harvest pool - ! Generate trunk product (kgC/day/site) - trunk_product = (struct_c + sapw_c) * & - SF_val_CWD_frac(c) * dead_n_dlogging * EDPftvarcon_inst%allom_agb_frac(currentCohort%pft) * & - hlm_freq_day * currentPatch%area - - currentSite%flux_out = currentSite%flux_out + trunk_product - - ! Update diagnostics that track resource management - currentSite%resources_management%trunk_product_site = & - currentSite%resources_management%trunk_product_site + & - trunk_product - ! Update diagnostics that track resource management - currentSite%resources_management%trunk_product_site = & - currentSite%resources_management%trunk_product_site + & - trunk_product - end if + dead_n_dlogging = 0._r8 + dead_n_ilogging = 0._r8 - ! Update diagnostics that track resource management - currentSite%resources_management%delta_litter_stock = & - currentSite%resources_management%delta_litter_stock + & - (struct_c + sapw_c) * & - SF_val_CWD_frac(c) * (dead_n_natural+dead_n_ilogging) * & - hlm_freq_day * currentPatch%area - ! Update diagnostics that track resource management - currentSite%resources_management%delta_biomass_stock = & - currentSite%resources_management%delta_biomass_stock + & - (struct_c + sapw_c) * & - SF_val_CWD_frac(c) * dead_n * & - hlm_freq_day * currentPatch%area - - if (currentPatch%cwd_AG_in(c) < 0.0_r8)then - write(fates_log(),*) 'negative CWD in flux',currentPatch%cwd_AG_in(c), & - (struct_c + sapw_c), dead_n - endif + end if + + dead_n_natural = dead_n - dead_n_dlogging - dead_n_ilogging + + + flux_diags%leaf_litter_input(pft) = & + flux_diags%leaf_litter_input(pft) + & + leaf_m * dead_n*currentPatch%area + + + ! %n has not been updated due to mortality yet, thus + ! the litter flux has already been counted since it captured + ! the losses of live trees and those flagged for death + + root_fines_tot = dead_n * (fnrt_m + & + store_m*(1._r8-EDPftvarcon_inst%allom_frbstor_repro(pft)) ) + + do dcmpy=1,ndcmpy + + dcmpy_frac = GetDecompyFrac(pft,leaf_organ,dcmpy) + litt%leaf_fines_in(dcmpy) = litt%leaf_fines_in(dcmpy) + & + (leaf_m+repro_m) * dead_n * dcmpy_frac + dcmpy_frac = GetDecompyFrac(pft,fnrt_organ,dcmpy) + do ilyr = 1, numlevsoil + litt%root_fines_in(dcmpy,ilyr) = litt%root_fines_in(dcmpy,ilyr) + & + root_fines_tot * currentSite%rootfrac_scr(ilyr) * dcmpy_frac end do - ! Update diagnostics that track resource management - currentSite%resources_management%delta_individual = & - currentSite%resources_management%delta_individual + & - (dead_n_dlogging+dead_n_ilogging) * hlm_freq_day * currentPatch%area - - !endif !canopy layer - - currentCohort => currentCohort%taller - enddo ! end loop over cohorts + end do + + flux_diags%root_litter_input(pft) = & + flux_diags%root_litter_input(pft) + & + root_fines_tot*currentPatch%area + + ! Track CWD inputs from dead plants + + do c = 1,ncwd + + ! Below-ground + + bg_cwd_tot = (struct_m + sapw_m) * & + SF_val_CWD_frac(c) * dead_n * & + (1.0_r8-EDPftvarcon_inst%allom_agb_frac(pft)) + + do ilyr = 1, numlevsoil + litt%bg_cwd_in(c,ilyr) = litt%bg_cwd_in(c,ilyr) + & + currentSite%rootfrac_scr(ilyr) * bg_cwd_tot + end do + + flux_diags%cwd_bg_input(c) = flux_diags%cwd_bg_input(c) + & + bg_cwd_tot * currentPatch%area + + ! Send AGB component of boles from logging activities into the litter. + ! This includes fluxes from indirect modes of death, as well as the + ! non-exported boles due to direct harvesting. + + if (c==ncwd) then + + + trunk_wood = (struct_m + sapw_m) * & + SF_val_CWD_frac(c) * dead_n_dlogging * & + EDPftvarcon_inst%allom_agb_frac(pft) + + site_mass%wood_product = site_mass%wood_product + & + trunk_wood * currentPatch%area * logging_export_frac + + ! Add AG wood to litter from the non-exported fraction of wood + ! from direct anthro sources + + litt%ag_cwd_in(c) = litt%ag_cwd_in(c) + & + trunk_wood * (1._r8-logging_export_frac) + + flux_diags%cwd_ag_input(c) = flux_diags%cwd_ag_input(c) + & + trunk_wood * (1._r8-logging_export_frac) * currentPatch%area + + ! Add AG wood to litter from indirect anthro sources + + litt%ag_cwd_in(c) = litt%ag_cwd_in(c) + (struct_m + sapw_m) * & + SF_val_CWD_frac(c) * (dead_n_natural+dead_n_ilogging) * & + EDPftvarcon_inst%allom_agb_frac(pft) + + flux_diags%cwd_ag_input(c) = flux_diags%cwd_ag_input(c) + & + SF_val_CWD_frac(c) * (dead_n_natural+dead_n_ilogging) * & + currentPatch%area * EDPftvarcon_inst%allom_agb_frac(pft) + + else + + litt%ag_cwd_in(c) = litt%ag_cwd_in(c) + (struct_m + sapw_m) * & + SF_val_CWD_frac(c) * dead_n * & + EDPftvarcon_inst%allom_agb_frac(pft) + + flux_diags%cwd_ag_input(c) = flux_diags%cwd_ag_input(c) + & + SF_val_CWD_frac(c) * dead_n * (struct_m + sapw_m) * & + currentPatch%area * EDPftvarcon_inst%allom_agb_frac(pft) + + end if + + end do + + + ! Update diagnostics that track resource management + + if( element_id .eq. carbon12_element ) then + + currentSite%resources_management%delta_litter_stock = & + currentSite%resources_management%delta_litter_stock + & + (leaf_m + fnrt_m + store_m ) * & + (dead_n_ilogging+dead_n_dlogging) * currentPatch%area + + currentSite%resources_management%delta_biomass_stock = & + currentSite%resources_management%delta_biomass_stock + & + (leaf_m + fnrt_m + store_m ) * & + (dead_n_ilogging+dead_n_dlogging) *currentPatch%area + + currentSite%resources_management%trunk_product_site = & + currentSite%resources_management%trunk_product_site + & + trunk_wood * logging_export_frac * currentPatch%area + + do c = 1,ncwd + currentSite%resources_management%delta_litter_stock = & + currentSite%resources_management%delta_litter_stock + & + (struct_m + sapw_m) * & + SF_val_CWD_frac(c) * (dead_n_natural+dead_n_ilogging) * & + currentPatch%area + + currentSite%resources_management%delta_biomass_stock = & + currentSite%resources_management%delta_biomass_stock + & + (struct_m + sapw_m) * & + SF_val_CWD_frac(c) * dead_n * currentPatch%area + end do + + ! Update diagnostics that track resource management + currentSite%resources_management%delta_individual = & + currentSite%resources_management%delta_individual + & + (dead_n_dlogging+dead_n_ilogging) * hlm_freq_day * currentPatch%area + end if + + + currentCohort => currentCohort%taller + enddo ! end loop over cohorts + + + return + end subroutine CWDInput + + ! ===================================================================================== + + subroutine SeedDecayToFines(litt) + + type(litter_type) :: litt + ! + ! !LOCAL VARIABLES: + integer :: pft + + ! Add decaying seeds to the leaf litter + ! ----------------------------------------------------------------------------------- + + do pft = 1,numpft + + litt%leaf_fines_in(ilabile) = litt%leaf_fines_in(ilabile) + & + (litt%seed_decay(pft) + litt%seed_germ_decay(pft)) * EDPftvarcon_inst%lf_flab(pft) + + litt%leaf_fines_in(icellulose) = litt%leaf_fines_in(icellulose) + & + (litt%seed_decay(pft) + litt%seed_germ_decay(pft)) * EDPftvarcon_inst%lf_fcel(pft) + + litt%leaf_fines_in(ilignin) = litt%leaf_fines_in(ilignin) + & + (litt%seed_decay(pft) + litt%seed_germ_decay(pft)) * EDPftvarcon_inst%lf_flig(pft) - do p = 1,numpft - currentPatch%leaf_litter_in(p) = currentPatch%leaf_litter_in(p) + currentPatch%seed_decay(p) !KgC/m2/yr enddo + + + return + end subroutine SeedDecayToFines + + - end subroutine CWD_Input - ! ============================================================================ + + ! ===================================================================================== + subroutine fragmentation_scaler( currentPatch, bc_in) ! ! !DESCRIPTION: @@ -1412,28 +2099,21 @@ subroutine fragmentation_scaler( currentPatch, bc_in) real(r8) :: catanf ! hyperbolic temperature function from CENTURY real(r8) :: catanf_30 ! hyperbolic temperature function from CENTURY real(r8) :: t1 ! temperature argument - real(r8) :: Q10 ! temperature dependence - real(r8) :: froz_q10 ! separate q10 for frozen soil respiration rates. - ! default to same as above zero rates !---------------------------------------------------------------------- catanf(t1) = 11.75_r8 +(29.7_r8 / pi) * atan( pi * 0.031_r8 * ( t1 - 15.4_r8 )) catanf_30 = catanf(30._r8) ifp = currentPatch%patchno - - ! set "froz_q10" parameter - froz_q10 = FatesSynchronizedParamsInst%froz_q10 - Q10 = FatesSynchronizedParamsInst%Q10 if ( .not. use_century_tfunc ) then !calculate rate constant scalar for soil temperature,assuming that the base rate constants !are assigned for non-moisture limiting conditions at 25C. if (bc_in%t_veg24_pa(ifp) >= tfrz) then - t_scalar = Q10**((bc_in%t_veg24_pa(ifp)-(tfrz+25._r8))/10._r8) + t_scalar = q10_mr**((bc_in%t_veg24_pa(ifp)-(tfrz+25._r8))/10._r8) ! Q10**((t_soisno(c,j)-(tfrz+25._r8))/10._r8) else - t_scalar = (Q10**(-25._r8/10._r8))*(froz_q10**((bc_in%t_veg24_pa(ifp)-tfrz)/10._r8)) + t_scalar = (q10_mr**(-25._r8/10._r8))*(q10_froz**((bc_in%t_veg24_pa(ifp)-tfrz)/10._r8)) !Q10**(-25._r8/10._r8))*(froz_q10**((t_soisno(c,j)-tfrz)/10._r8) endif else @@ -1446,14 +2126,15 @@ subroutine fragmentation_scaler( currentPatch, bc_in) !BTRAN APPROACH - is quite simple, but max's out decomp at all unstressed !soil moisture values, which is not realistic. !litter decomp is proportional to water limitation on average... - w_scalar = sum(currentPatch%btran_ft(1:numpft))/numpft + w_scalar = sum(currentPatch%btran_ft(1:numpft))/real(numpft,r8) currentPatch%fragmentation_scaler = min(1.0_r8,max(0.0_r8,t_scalar * w_scalar)) end subroutine fragmentation_scaler ! ============================================================================ - subroutine cwd_out( currentSite, currentPatch, bc_in ) + + subroutine CWDOut( litt, fragmentation_scaler, nlev_eff_decomp ) ! ! !DESCRIPTION: ! Simple CWD fragmentation Model @@ -1464,64 +2145,57 @@ subroutine cwd_out( currentSite, currentPatch, bc_in ) ! ! !ARGUMENTS - type(ed_site_type), intent(inout), target :: currentSite - type(ed_patch_type), intent(inout), target :: currentPatch - type(bc_in_type), intent(in) :: bc_in + type(litter_type),intent(inout),target :: litt + + real(r8),intent(in) :: fragmentation_scaler + + ! This is not necessarily every soil layer, this is the number + ! of effective layers that are active and can be sent + ! to the soil decomposition model + integer,intent(in) :: nlev_eff_decomp ! ! !LOCAL VARIABLES: - integer :: c,ft + integer :: c + integer :: ilyr + integer :: dcmpy + integer :: numlevsoil !---------------------------------------------------------------------- - currentPatch%root_litter_out(:) = 0.0_r8 - currentPatch%leaf_litter_out(:) = 0.0_r8 - - call fragmentation_scaler(currentPatch, bc_in) + do c = 1,ncwd - !Flux of coarse woody debris into decomposing litter pool. + litt%ag_cwd_frag(c) = litt%ag_cwd(c) * SF_val_max_decomp(c) * & + years_per_day * fragmentation_scaler + + do ilyr = 1,nlev_eff_decomp + + litt%bg_cwd_frag(c,ilyr) = litt%bg_cwd(c,ilyr) * SF_val_max_decomp(c) * & + years_per_day * fragmentation_scaler - currentPatch%cwd_ag_out(1:ncwd) = 0.0_r8 - currentPatch%cwd_bg_out(1:ncwd) = 0.0_r8 - currentPatch%leaf_litter_out(:) = 0.0_r8 - currentPatch%root_litter_out(:) = 0.0_r8 - - do c = 1,ncwd - currentPatch%cwd_ag_out(c) = max(0.0_r8, currentPatch%cwd_ag(c) * & - SF_val_max_decomp(c+1) * currentPatch%fragmentation_scaler ) - currentPatch%cwd_bg_out(c) = max(0.0_r8, currentPatch%cwd_bg(c) * & - SF_val_max_decomp(c+1) * currentPatch%fragmentation_scaler ) - enddo + enddo + end do - ! this is the rate at which dropped leaves stop being part of the burnable pool and begin to be part of the - ! decomposing pool. This should probably be highly sensitive to moisture, but also to the type of leaf - ! thick leaves can dry out before they are decomposed, for example. - ! this section needs further scientific input. + ! this is the rate at which dropped leaves stop being part of the burnable pool + ! and begin to be part of the decomposing pool. This should probably be highly + ! sensitive to moisture, but also to the type of leaf thick leaves can dry out + ! before they are decomposed, for example. This section needs further scientific input. - do ft = 1,numpft - currentPatch%leaf_litter_out(ft) = max(0.0_r8,currentPatch%leaf_litter(ft)* SF_val_max_decomp(dl_sf) * & - currentPatch%fragmentation_scaler ) - currentPatch%root_litter_out(ft) = max(0.0_r8,currentPatch%root_litter(ft)* SF_val_max_decomp(dl_sf) * & - currentPatch%fragmentation_scaler ) - if ( currentPatch%leaf_litter_out(ft)<0.0_r8.or.currentPatch%root_litter_out(ft)<0.0_r8)then - write(fates_log(),*) 'root or leaf out is negative?',SF_val_max_decomp(dl_sf),currentPatch%fragmentation_scaler - endif - enddo + do dcmpy = 1,ndcmpy - !add up carbon going into fragmenting pools - currentSite%flux_out = currentSite%flux_out + sum(currentPatch%leaf_litter_out) * & - currentPatch%area *hlm_freq_day!kgC/site/day - currentSite%flux_out = currentSite%flux_out + sum(currentPatch%root_litter_out) * & - currentPatch%area *hlm_freq_day!kgC/site/day - currentSite%flux_out = currentSite%flux_out + sum(currentPatch%cwd_ag_out) * & - currentPatch%area *hlm_freq_day!kgC/site/day - currentSite%flux_out = currentSite%flux_out + sum(currentPatch%cwd_bg_out) * & - currentPatch%area *hlm_freq_day!kgC/site/day + litt%leaf_fines_frag(dcmpy) = litt%leaf_fines(dcmpy) * & + years_per_day * SF_val_max_decomp(dl_sf) * fragmentation_scaler + + do ilyr = 1,nlev_eff_decomp + litt%root_fines_frag(dcmpy,ilyr) = litt%root_fines(dcmpy,ilyr) * & + years_per_day * SF_val_max_decomp(dl_sf) * fragmentation_scaler + end do + enddo - end subroutine cwd_out + end subroutine CWDOut ! ===================================================================================== - subroutine flux_into_litter_pools(nsites, sites, bc_in, bc_out) + subroutine FluxIntoLitterPools(nsites, sites, bc_in, bc_out) ! ----------------------------------------------------------------------------------- ! Created by Charlie Koven and Rosie Fisher, 2014-2015 @@ -1550,7 +2224,6 @@ subroutine flux_into_litter_pools(nsites, sites, bc_in, bc_out) ! ----------------------------------------------------------------------------------- use EDTypesMod, only : AREA - use EDPftvarcon, only : EDPftvarcon_inst use FatesConstantsMod, only : sec_per_day use FatesInterfaceMod, only : bc_in_type, bc_out_type use FatesInterfaceMod, only : hlm_use_vertsoilc @@ -1558,377 +2231,187 @@ subroutine flux_into_litter_pools(nsites, sites, bc_in, bc_out) use FatesConstantsMod, only : itrue use FatesGlobals, only : endrun => fates_endrun use EDParamsMod , only : ED_val_cwd_flig, ED_val_cwd_fcel - use FatesAllometryMod, only : set_root_fraction - use FatesAllometryMod, only : i_biomass_rootprof_context + implicit none ! !ARGUMENTS - integer , intent(in) :: nsites - type(ed_site_type) , intent(inout), target :: sites(nsites) - type(bc_in_type) , intent(in) :: bc_in(:) - type(bc_out_type) , intent(inout) :: bc_out(:) - ! - ! !LOCAL VARIABLES: - type (ed_patch_type) , pointer :: currentPatch - type (ed_cohort_type) , pointer :: currentCohort - type(ed_site_type), pointer :: cs - integer p,ci,j,s - real(r8) time_convert ! from year to seconds - real(r8) mass_convert ! ED uses kg, CLM uses g - integer :: begp,endp - integer :: begc,endc !bounds + integer , intent(in) :: nsites + type(ed_site_type) , intent(inout) :: sites(nsites) + type(bc_in_type) , intent(in) :: bc_in(:) + type(bc_out_type) , intent(inout), target :: bc_out(:) - !------------------------------------------------------------------------ - ! The following scratch arrays are allocated for maximum possible - ! pft and layer usage - - real(r8) :: cinput_rootfr(1:maxpft, 1:hlm_numlevgrnd) - real(r8) :: croot_prof_perpatch(1:hlm_numlevgrnd) - real(r8) :: surface_prof(1:hlm_numlevgrnd) - integer :: ft - integer :: nlev_eff_decomp - real(r8) :: rootfr_tot(1:maxpft) - real(r8) :: biomass_bg_ft(1:maxpft) - real(r8) :: surface_prof_tot, leaf_prof_sum, stem_prof_sum, froot_prof_sum, biomass_bg_tot - real(r8) :: delta - real(r8) :: leaf_c - real(r8) :: store_c - real(r8) :: fnrt_c - real(r8) :: sapw_c - real(r8) :: struct_c + ! !LOCAL VARIABLES: + type (ed_patch_type), pointer :: currentPatch + type (ed_cohort_type), pointer :: currentCohort + real(r8), pointer :: flux_cel_si(:) + real(r8), pointer :: flux_lab_si(:) + real(r8), pointer :: flux_lig_si(:) + type(litter_type), pointer :: litt + + real(r8) :: surface_prof(1:hlm_numlevgrnd) ! this array is used to distribute + ! fragmented litter on the surface + ! into the soil/decomposition + ! layers. It exponentially decays + real(r8) :: surface_prof_tot ! normalizes the surface_prof array + integer :: ft ! PFT number + integer :: nlev_eff_soil ! number of effective soil layers + integer :: nlev_eff_decomp ! number of effective decomp layers + real(r8) :: area_frac ! fraction of site's area of current patch + real(r8) :: z_decomp ! Used for calculating depth midpoints of decomp layers + integer :: s ! Site index + integer :: el ! Element index (C,N,P,etc) + integer :: j ! Soil layer index + integer :: id ! Decomposition layer index + integer :: ic ! CWD type index ! NOTE(rgk, 201705) this parameter was brought over from SoilBiogeochemVerticalProfile ! how steep profile is for surface components (1/ e_folding depth) (1/m) real(r8), parameter :: surfprof_exp = 10. - real(r8) :: leaf_prof(1:nsites, 1:hlm_numlevgrnd) - real(r8) :: froot_prof(1:nsites, 1:maxpft, 1:hlm_numlevgrnd) - real(r8) :: croot_prof(1:nsites, 1:hlm_numlevgrnd) - real(r8) :: stem_prof(1:nsites, 1:hlm_numlevgrnd) + do s = 1,nsites - + ! This is the number of effective soil layers to transfer from + nlev_eff_soil = max(bc_in(s)%max_rooting_depth_index_col, 1) - delta = 0.001_r8 - !no of seconds in a year. - time_convert = 365.0_r8*sec_per_day + ! The decomposition layers are most likely the exact same layers + ! as the soil layers (same depths also), unless it is a simplified + ! single layer case, where nlevdecomp = 1 - ! number of grams in a kilogram - mass_convert = 1000._r8 - - - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! first calculate vertical profiles - ! define two types of profiles: - ! (1) a surface profile, for leaves and stem inputs, which is the same for each - ! pft but differs from one site to the next to avoid inputting any C into permafrost or bedrock - ! (2) a fine root profile, which is indexed by both site and pft, differs for - ! each pft and also from one site to the next to avoid inputting any C into permafrost or bedrock - ! (3) a coarse root profile, which is the root-biomass=weighted average of the fine root profiles - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - if (hlm_use_vertsoilc == itrue) then + nlev_eff_decomp = min(bc_in(s)%nlevdecomp,nlev_eff_soil) - ! initialize profiles to zero - leaf_prof(1:nsites, 1:hlm_numlevgrnd ) = 0._r8 - froot_prof(1:nsites, 1:maxpft, 1:hlm_numlevgrnd) = 0._r8 - stem_prof(1:nsites, 1:hlm_numlevgrnd) = 0._r8 + ! define a single shallow surface profile for surface additions + ! (leaves, stems, and N deposition). This sends the above ground + ! mass into the soil pools using an exponential depth decay function. + ! Since it is sending an absolute mass [kg] into variable layer + ! widths, we multiply the profile by the layer width, so that + ! wider layers get proportionally more. After the masses + ! are sent, each layer will normalize by depth. - do s = 1,nsites - - ! Calculate the number of effective decomposition layers - ! This takes into account if vertical soil biogeochem is on, how deep the soil column - ! is, and also which layers may be frozen - nlev_eff_decomp = min(max(bc_in(s)%max_rooting_depth_index_col, 1), bc_in(s)%nlevdecomp) + surface_prof(:) = 0._r8 + z_decomp = 0._r8 + do id = 1,nlev_eff_decomp + z_decomp = z_decomp+0.5*bc_in(s)%dz_decomp_sisl(id) + surface_prof(id) = exp(-surfprof_exp * z_decomp) * bc_in(s)%dz_decomp_sisl(id) + z_decomp = z_decomp+0.5*bc_in(s)%dz_decomp_sisl(id) + end do + surface_prof_tot = sum(surface_prof) + do id = 1,nlev_eff_decomp + surface_prof(id) = surface_prof(id)/surface_prof_tot + end do - ! define a single shallow surface profile for surface additions (leaves, stems, and N deposition) - surface_prof(:) = 0._r8 - do j = 1, bc_in(s)%nlevdecomp - surface_prof(j) = exp(-surfprof_exp * bc_in(s)%z_sisl(j)) / bc_in(s)%dz_decomp_sisl(j) - end do + ! Loop over the different elements. + do el = 1, num_elements + + ! Zero out the boundary flux arrays + ! Make a pointer to the cellulose, labile and lignan + ! flux partitions. + + select case (element_list(el)) + case (carbon12_element) + bc_out(s)%litt_flux_cel_c_si(:) = 0._r8 + bc_out(s)%litt_flux_lig_c_si(:) = 0._r8 + bc_out(s)%litt_flux_lab_c_si(:) = 0._r8 + flux_cel_si => bc_out(s)%litt_flux_cel_c_si(:) + flux_lab_si => bc_out(s)%litt_flux_lab_c_si(:) + flux_lig_si => bc_out(s)%litt_flux_lig_c_si(:) + case (nitrogen_element) + bc_out(s)%litt_flux_cel_n_si(:) = 0._r8 + bc_out(s)%litt_flux_lig_n_si(:) = 0._r8 + bc_out(s)%litt_flux_lab_n_si(:) = 0._r8 + flux_cel_si => bc_out(s)%litt_flux_cel_n_si(:) + flux_lab_si => bc_out(s)%litt_flux_lab_n_si(:) + flux_lig_si => bc_out(s)%litt_flux_lig_n_si(:) + case (phosphorus_element) + bc_out(s)%litt_flux_cel_p_si(:) = 0._r8 + bc_out(s)%litt_flux_lig_p_si(:) = 0._r8 + bc_out(s)%litt_flux_lab_p_si(:) = 0._r8 + flux_cel_si => bc_out(s)%litt_flux_cel_p_si(:) + flux_lab_si => bc_out(s)%litt_flux_lab_p_si(:) + flux_lig_si => bc_out(s)%litt_flux_lig_p_si(:) + end select - ! ----------------------------------------------------------------------------- - ! This is the rooting profile. cinput_rootfr - ! This array will calculate root - ! mass as far down as the soil column goes. It is possible - ! that the active layers are not as deep as the roots go. - ! That is ok, the roots in the active layers will be talied up and - ! normalized. - ! ----------------------------------------------------------------------------- - - cinput_rootfr(:,:) = 0._r8 - do ft = 1, numpft + currentPatch => sites(s)%oldest_patch + do while (associated(currentPatch)) - ! This generates a rooting profile over the whole soil column for each pft - ! Note that we are calling for the root fractions in the biomass - ! for litter context, and not the hydrologic uptake context. - - call set_root_fraction(cinput_rootfr(ft,1:bc_in(s)%nlevsoil), ft, & - bc_in(s)%zi_sisl, lowerb=lbound(bc_in(s)%zi_sisl,1), & - icontext=i_biomass_rootprof_context) + ! Set a pointer to the litter object + ! for the current element on the current + ! patch + litt => currentPatch%litter(el) + area_frac = currentPatch%area/area + + do ic = 1, ncwd + + do id = 1,nlev_eff_decomp + flux_cel_si(id) = flux_cel_si(id) + & + litt%ag_cwd_frag(ic) * ED_val_cwd_fcel * area_frac * surface_prof(id) + + flux_lig_si(id) = flux_lig_si(id) + & + litt%ag_cwd_frag(ic) * ED_val_cwd_flig * area_frac * surface_prof(id) + end do + + do j = 1, nlev_eff_soil + + id = bc_in(s)%decomp_id(j) ! Map from soil layer to decomp layer + + flux_cel_si(id) = flux_cel_si(id) + & + litt%bg_cwd_frag(ic,j) * ED_val_cwd_fcel * area_frac + + flux_lig_si(id) = flux_lig_si(id) + & + litt%bg_cwd_frag(ic,j) * ED_val_cwd_flig * area_frac + + end do + end do - do j=1,nlev_eff_decomp - cinput_rootfr(ft,j) = cinput_rootfr(ft,j)/bc_in(s)%dz_decomp_sisl(j) + ! leaf and fine root fragmentation fluxes + + do id = 1,nlev_eff_decomp + + flux_lab_si(id) = flux_lab_si(id) + & + litt%leaf_fines_frag(ilabile) * area_frac* surface_prof(id) + + flux_cel_si(id) = flux_cel_si(id) + & + litt%leaf_fines_frag(icellulose) * area_frac* surface_prof(id) + + flux_lig_si(id) = flux_lig_si(id) + & + litt%leaf_fines_frag(ilignin) * area_frac* surface_prof(id) + end do - end do + do j = 1, nlev_eff_soil + + id = bc_in(s)%decomp_id(j) - ! - ! now add permafrost constraint: integrate rootfr over active layer of soil site, - ! truncate below permafrost or bedrock table where present, and rescale so that integral = 1 - rootfr_tot(:) = 0._r8 - - surface_prof_tot = 0._r8 - ! - do j = 1, nlev_eff_decomp - surface_prof_tot = surface_prof_tot + surface_prof(j) * bc_in(s)%dz_decomp_sisl(j) - end do + flux_lab_si(id) = flux_lab_si(id) + & + litt%root_fines_frag(ilabile,j) * area_frac + flux_cel_si(id) = flux_cel_si(id) + & + litt%root_fines_frag(icellulose,j) * area_frac + flux_lig_si(id) = flux_lig_si(id) + & + litt%root_fines_frag(ilignin,j) * area_frac + enddo - do ft = 1,numpft - do j = 1, nlev_eff_decomp - rootfr_tot(ft) = rootfr_tot(ft) + cinput_rootfr(ft,j)*bc_in(s)%dz_decomp_sisl(j) - end do + + currentPatch => currentPatch%younger end do - ! - ! rescale the fine root profile - do ft = 1,numpft - if ( (bc_in(s)%max_rooting_depth_index_col > 0) .and. (rootfr_tot(ft) > 0._r8) ) then - ! where there is not permafrost extending to the surface, integrate the profiles - ! over the active layer this is equivalent to integrating over all soil layers - ! outside of permafrost regions - do j = 1, nlev_eff_decomp - froot_prof(s,ft,j) = cinput_rootfr(ft,j) / rootfr_tot(ft) - end do - else - ! if fully frozen, or no roots, put everything in the top layer - froot_prof(s,ft,1) = 1._r8/bc_in(s)%dz_decomp_sisl(1) - endif + + ! Normalize all masses over the decomposition layer's depth + ! Convert from kg/m2/day -> g/m3/s + + do id = 1,nlev_eff_decomp + flux_cel_si(id) = days_per_sec * g_per_kg * & + flux_cel_si(id) / bc_in(s)%dz_decomp_sisl(id) + flux_lig_si(id) = days_per_sec * g_per_kg * & + flux_lig_si(id) / bc_in(s)%dz_decomp_sisl(id) + flux_lab_si(id) = days_per_sec * g_per_kg * & + flux_lab_si(id) / bc_in(s)%dz_decomp_sisl(id) end do - ! - ! rescale the shallow profiles - if ( (bc_in(s)%max_rooting_depth_index_col > 0) .and. (surface_prof_tot > 0._r8) ) then - ! where there is not permafrost extending to the surface, integrate the profiles over - ! the active layer this is equivalent to integrating over all soil layers outside of - ! permafrost regions - do j = 1, nlev_eff_decomp - ! set all surface processes to shallower profile - leaf_prof(s,j) = surface_prof(j)/ surface_prof_tot - stem_prof(s,j) = surface_prof(j)/ surface_prof_tot - end do - else - ! if fully frozen, or no roots, put everything in the top layer - leaf_prof(s,1) = 1._r8/bc_in(s)%dz_decomp_sisl(1) - stem_prof(s,1) = 1._r8/bc_in(s)%dz_decomp_sisl(1) - do j = 2, bc_in(s)%nlevdecomp - leaf_prof(s,j) = 0._r8 - stem_prof(s,j) = 0._r8 - end do - endif - end do - - else + end do ! do elements - ! for one layer decomposition model, set profiles to unity - leaf_prof(1:nsites, :) = 1._r8 - froot_prof(1:nsites, 1:numpft, :) = 1._r8 - stem_prof(1:nsites, :) = 1._r8 - - end if - - ! sanity check to ensure they integrate to 1 - do s = 1, nsites - ! check the leaf and stem profiles - leaf_prof_sum = 0._r8 - stem_prof_sum = 0._r8 - do j = 1, bc_in(s)%nlevdecomp - leaf_prof_sum = leaf_prof_sum + leaf_prof(s,j) * bc_in(s)%dz_decomp_sisl(j) - stem_prof_sum = stem_prof_sum + stem_prof(s,j) * bc_in(s)%dz_decomp_sisl(j) - end do - if ( ( abs(stem_prof_sum - 1._r8) > delta ) .or. ( abs(leaf_prof_sum - 1._r8) > delta ) ) then - write(fates_log(), *) 'profile sums: ', leaf_prof_sum, stem_prof_sum - write(fates_log(), *) 'surface_prof: ', surface_prof - write(fates_log(), *) 'surface_prof_tot: ', surface_prof_tot - write(fates_log(), *) 'leaf_prof: ', leaf_prof(s,:) - write(fates_log(), *) 'stem_prof: ', stem_prof(s,:) - write(fates_log(), *) 'max_rooting_depth_index_col: ', bc_in(s)%max_rooting_depth_index_col - write(fates_log(), *) 'bc_in(s)%dz_decomp_sisl: ', bc_in(s)%dz_decomp_sisl - call endrun(msg=errMsg(sourcefile, __LINE__)) - endif - ! now check each fine root profile - do ft = 1,numpft - froot_prof_sum = 0._r8 - do j = 1, bc_in(s)%nlevdecomp - froot_prof_sum = froot_prof_sum + froot_prof(s,ft,j) * bc_in(s)%dz_decomp_sisl(j) - end do - if ( ( abs(froot_prof_sum - 1._r8) > delta ) ) then - write(fates_log(), *) 'profile sums: ', froot_prof_sum - call endrun(msg=errMsg(sourcefile, __LINE__)) - endif - end do - end do - - ! zero the site-level C input variables - do s = 1, nsites - do j = 1, bc_in(s)%nlevdecomp - bc_out(s)%FATES_c_to_litr_lab_c_col(j) = 0._r8 - bc_out(s)%FATES_c_to_litr_cel_c_col(j) = 0._r8 - bc_out(s)%FATES_c_to_litr_lig_c_col(j) = 0._r8 - croot_prof(s,j) = 0._r8 - end do - end do - - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! now disaggregate the inputs vertically, using the vertical profiles - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - do s = 1,nsites - - - currentPatch => sites(s)%oldest_patch - do while(associated(currentPatch)) - - ! the CWD pools lose information about which PFT they came from; - ! for the stems this doesn't matter as they all have the same profile, - ! however for the coarse roots they may have different profiles. - ! to approximately recover this information, loop over all cohorts in patch - ! to calculate the total root biomass in that patch of each pft, and then - ! rescale the croot_prof as the weighted average of the froot_prof - biomass_bg_ft(1:numpft) = 0._r8 - currentCohort => currentPatch%tallest - do while(associated(currentCohort)) - - leaf_c = currentCohort%prt%GetState(leaf_organ,all_carbon_elements) - store_c = currentCohort%prt%GetState(store_organ,all_carbon_elements) - fnrt_c = currentCohort%prt%GetState(fnrt_organ,all_carbon_elements) - sapw_c = currentCohort%prt%GetState(sapw_organ,all_carbon_elements) - struct_c = currentCohort%prt%GetState(struct_organ,all_carbon_elements) - - biomass_bg_ft(currentCohort%pft) = biomass_bg_ft(currentCohort%pft) + & - ( (struct_c + sapw_c) * & - (1.0_r8-EDPftvarcon_inst%allom_agb_frac(currentCohort%pft)) + & - (fnrt_c + store_c ) ) * & - (currentCohort%n / currentPatch%area) - - currentCohort => currentCohort%shorter - enddo !currentCohort - ! - biomass_bg_tot = 0._r8 - do ft = 1,numpft - biomass_bg_tot = biomass_bg_tot + biomass_bg_ft(ft) - end do - ! - - ! zero this for each patch - croot_prof_perpatch(1:bc_in(s)%nlevdecomp) = 0._r8 - - ! - if ( biomass_bg_tot .gt. 0._r8) then - do ft = 1,numpft - do j = 1, bc_in(s)%nlevdecomp - croot_prof_perpatch(j) = croot_prof_perpatch(j) + & - froot_prof(s,ft,j) * biomass_bg_ft(ft) / biomass_bg_tot - end do - end do - else ! no biomass - croot_prof_perpatch(1) = 1./bc_in(s)%dz_decomp_sisl(1) - end if - - ! - ! add croot_prof as weighted average (weighted by patch area) of croot_prof_perpatch - do j = 1, bc_in(s)%nlevdecomp - croot_prof(s, j) = croot_prof(s, j) + croot_prof_perpatch(j) * currentPatch%area / AREA - end do - ! - ! now disaggregate, vertically and by decomposition substrate type, the - ! actual fluxes from CWD and litter pools - ! - ! do c = 1, ncwd - ! write(fates_log(),*)'cdk CWD_AG_out', c, currentpatch%CWD_AG_out(c), - ! ED_val_cwd_fcel, currentpatch%area/AREA - ! write(fates_log(),*)'cdk CWD_BG_out', c, currentpatch%CWD_BG_out(c), - ! ED_val_cwd_fcel, currentpatch%area/AREA - ! end do - ! do ft = 1,numpft - ! write(fates_log(),*)'cdk leaf_litter_out', ft, currentpatch%leaf_litter_out(ft), - ! ED_val_cwd_fcel, currentpatch%area/AREA - ! write(fates_log(),*)'cdk root_litter_out', ft, currentpatch%root_litter_out(ft), - ! ED_val_cwd_fcel, currentpatch%area/AREA - ! end do - ! ! - ! CWD pools fragmenting into decomposing litter pools. - do ci = 1, ncwd - do j = 1, bc_in(s)%nlevdecomp - bc_out(s)%FATES_c_to_litr_cel_c_col(j) = bc_out(s)%FATES_c_to_litr_cel_c_col(j) + & - currentpatch%CWD_AG_out(ci) * ED_val_cwd_fcel * & - currentpatch%area/AREA * stem_prof(s,j) - bc_out(s)%FATES_c_to_litr_lig_c_col(j) = bc_out(s)%FATES_c_to_litr_lig_c_col(j) + & - currentpatch%CWD_AG_out(ci) * ED_val_cwd_flig * & - currentpatch%area/AREA * stem_prof(s,j) - ! - bc_out(s)%FATES_c_to_litr_cel_c_col(j) = bc_out(s)%FATES_c_to_litr_cel_c_col(j) + & - currentpatch%CWD_BG_out(ci) * ED_val_cwd_fcel * & - currentpatch%area/AREA * croot_prof_perpatch(j) - bc_out(s)%FATES_c_to_litr_lig_c_col(j) = bc_out(s)%FATES_c_to_litr_lig_c_col(j) + & - currentpatch%CWD_BG_out(ci) * ED_val_cwd_flig * & - currentpatch%area/AREA * croot_prof_perpatch(j) - end do - end do - - ! leaf and fine root pools. - do ft = 1,numpft - do j = 1, bc_in(s)%nlevdecomp - bc_out(s)%FATES_c_to_litr_lab_c_col(j) = bc_out(s)%FATES_c_to_litr_lab_c_col(j) + & - currentpatch%leaf_litter_out(ft) * EDPftvarcon_inst%lf_flab(ft) * & - currentpatch%area/AREA * leaf_prof(s,j) - bc_out(s)%FATES_c_to_litr_cel_c_col(j) = bc_out(s)%FATES_c_to_litr_cel_c_col(j) + & - currentpatch%leaf_litter_out(ft) * EDPftvarcon_inst%lf_fcel(ft) * & - currentpatch%area/AREA * leaf_prof(s,j) - bc_out(s)%FATES_c_to_litr_lig_c_col(j) = bc_out(s)%FATES_c_to_litr_lig_c_col(j) + & - currentpatch%leaf_litter_out(ft) * EDPftvarcon_inst%lf_flig(ft) * & - currentpatch%area/AREA * leaf_prof(s,j) - ! - bc_out(s)%FATES_c_to_litr_lab_c_col(j) = bc_out(s)%FATES_c_to_litr_lab_c_col(j) + & - currentpatch%root_litter_out(ft) * EDPftvarcon_inst%fr_flab(ft) * & - currentpatch%area/AREA * froot_prof(s,ft,j) - bc_out(s)%FATES_c_to_litr_cel_c_col(j) = bc_out(s)%FATES_c_to_litr_cel_c_col(j) + & - currentpatch%root_litter_out(ft) * EDPftvarcon_inst%fr_fcel(ft) * & - currentpatch%area/AREA * froot_prof(s,ft,j) - bc_out(s)%FATES_c_to_litr_lig_c_col(j) = bc_out(s)%FATES_c_to_litr_lig_c_col(j) + & - currentpatch%root_litter_out(ft) * EDPftvarcon_inst%fr_flig(ft) * & - currentpatch%area/AREA * froot_prof(s,ft,j) - enddo - end do - - currentPatch => currentPatch%younger - end do !currentPatch - - end do ! do sites(s) - - do s = 1, nsites - do j = 1, bc_in(s)%nlevdecomp - ! time unit conversion - bc_out(s)%FATES_c_to_litr_lab_c_col(j)=bc_out(s)%FATES_c_to_litr_lab_c_col(j) * & - mass_convert / time_convert - bc_out(s)%FATES_c_to_litr_cel_c_col(j)=bc_out(s)%FATES_c_to_litr_cel_c_col(j) * & - mass_convert / time_convert - bc_out(s)%FATES_c_to_litr_lig_c_col(j)=bc_out(s)%FATES_c_to_litr_lig_c_col(j) * & - mass_convert / time_convert - end do - end do - - ! write(fates_log(),*)'cdk FATES_c_to_litr_lab_c: ', FATES_c_to_litr_lab_c - ! write_col(fates_log(),*)'cdk FATES_c_to_litr_cel_c: ', FATES_c_to_litr_cel_c - ! write_col(fates_log(),*)'cdk FATES_c_to_litr_lig_c: ', FATES_c_to_litr_lig_c - ! write_col(fates_log(),*)'cdk bounds%begc, bounds%endc: ', bounds%begc, bounds%endc - ! write(fates_log(),*)'cdk leaf_prof: ', leaf_prof - ! write(fates_log(),*)'cdk stem_prof: ', stem_prof - ! write(fates_log(),*)'cdk froot_prof: ', froot_prof - ! write(fates_log(),*)'cdk croot_prof_perpatch: ', croot_prof_perpatch - ! write(fates_log(),*)'cdk croot_prof: ', croot_prof - - end subroutine flux_into_litter_pools + end do ! do sites(s) + return +end subroutine FluxIntoLitterPools diff --git a/biogeochem/FatesAllometryMod.F90 b/biogeochem/FatesAllometryMod.F90 index 42eae69cdc..d43b1e7769 100644 --- a/biogeochem/FatesAllometryMod.F90 +++ b/biogeochem/FatesAllometryMod.F90 @@ -309,7 +309,7 @@ subroutine h2d_allom(h,ipft,d,dddh) allom_hmode => EDPftvarcon_inst%allom_hmode(ipft)) select case(int(allom_hmode)) - case (1) ! Obrien et al. 199X BCI + case (1) ! O'Brien et al 1995, BCI call h2d_obrien(h,p1,p2,d,dddh) case (2) ! poorter 2006 call h2d_poorter2006(h,p1,p2,p3,d,dddh) @@ -805,9 +805,7 @@ subroutine bsap_allom(d,ipft,canopy_trim,sapw_area,bsap,dbsapdd) select case(int(EDPftvarcon_inst%allom_smode(ipft))) ! --------------------------------------------------------------------- - ! Currently both sapwood area proportionality methods use the same - ! machinery. The only differences are related to the parameter - ! checking at the beginning. For constant proportionality, the slope + ! Currently only one sapwood allometry model. the slope ! of the la:sa to diameter line is zero. ! --------------------------------------------------------------------- case(1) ! linearly related to leaf area based on target leaf biomass @@ -1979,7 +1977,7 @@ end subroutine carea_2pwr ! ========================================================================= - subroutine set_root_fraction(root_fraction, ft, zi, lowerb, icontext ) + subroutine set_root_fraction(root_fraction, ft, zi, icontext ) ! ! !DESCRIPTION: ! Calculates the fractions of the root biomass in each layer for each pft. @@ -1991,10 +1989,9 @@ subroutine set_root_fraction(root_fraction, ft, zi, lowerb, icontext ) ! ! !ARGUMENTS - real(r8),intent(inout) :: root_fraction(:) - integer, intent(in) :: ft - integer,intent(in) :: lowerb - real(r8),intent(in) :: zi(lowerb:) + real(r8),intent(inout) :: root_fraction(:) ! Normalized profile + integer, intent(in) :: ft ! functional typpe + real(r8),intent(in) :: zi(0:) ! Center of depth [m] integer,intent(in) :: icontext ! Parameters @@ -2017,13 +2014,16 @@ subroutine set_root_fraction(root_fraction, ft, zi, lowerb, icontext ) integer, parameter :: exponential_2p_profile_type = 3 integer :: root_profile_type + integer :: corr_id(1) ! This is the bin with largest fraction + ! add/subtract any corrections there + real(r8) :: correction ! This correction ensures that root fractions + ! sum to 1.0 !---------------------------------------------------------------------- - if(lbound(zi,1).ne.0) then - write(fates_log(),*) 'lbound:',lbound(zi) - write(fates_log(),*) 'ubound:',ubound(zi) - write(fates_log(),*) 'layer interface levels should have 0 index' + if(size(zi) .ne. (size(root_fraction)+1)) then + write(fates_log(),*) 'layer interface array should be 1 larger than' + write(fates_log(),*) 'root fraction array' call endrun(msg=errMsg(sourcefile, __LINE__)) end if @@ -2056,6 +2056,18 @@ subroutine set_root_fraction(root_fraction, ft, zi, lowerb, icontext ) call endrun(msg=errMsg(sourcefile, __LINE__)) end select +! if( abs(sum(root_fraction)-1.0_r8) > 1.e-9_r8 ) then +! write(fates_log(),*) 'Root fractions should add up to 1' +! write(fates_log(),*) root_fraction +! call endrun(msg=errMsg(sourcefile, __LINE__)) +! end if + + correction = 1._r8 - sum(root_fraction) + corr_id = maxloc(root_fraction) + root_fraction(corr_id(1)) = root_fraction(corr_id(1)) + correction + + + return end subroutine set_root_fraction diff --git a/biogeochem/FatesLitterMod.F90 b/biogeochem/FatesLitterMod.F90 new file mode 100644 index 0000000000..be5ec48aa9 --- /dev/null +++ b/biogeochem/FatesLitterMod.F90 @@ -0,0 +1,429 @@ +module FatesLitterMod + + ! ------------------------------------------------------------------------------------- + ! This module contains methods and type definitions for all things litter. + ! "litter" means all organic material that is no longer associated with a live plant. + ! Also, in FATES we only track "un-fragmented" and "un-decomposed" litter. This + ! is a decision of pragmatism, as FATES is not a soil decomposition model, yet FATES + ! does need to retain litter for fire calculations. Therefore, we retain + ! undecomposed litter for a period of time in FATES, until it fragments and is passed + ! to another model to handle deocomposition. + ! + ! This encompasses: 1) "Coarse Woody Debris" + ! 2) fine materials leaves, roots etc + ! (sometimes exclusively refered to as litter) + ! 3) Reproductive materials (seeds, nuts, fruits) + ! + ! Important point: THESE POOLS DO NOT CONTAIN DECOMPOSING MATTER !!!!! + ! + ! Another Important Point: We track the fine litter by its "decomposability" pool. + ! However, we don't actually apply any differential + ! turnover rates based on these pools, we are just + ! differentiating, tracking and preserving them to be + ! passed in the correct partitions to the BGC model. + ! Their partitions are a PFT parameter. + ! + ! ------------------------------------------------------------------------------------- + + + ! To-do: + ! 8) In CWD_IN, add the flux diagnostics, then remove the + ! patch level rate in the history code + + + use FatesConstantsMod, only : r8 => fates_r8 + use FatesConstantsMod, only : i4 => fates_int + use FatesConstantsMod, only : nearzero + use FatesConstantsMod, only : calloc_abs_error + use FatesConstantsMod, only : fates_unset_r8 + + use FatesGlobals , only : endrun => fates_endrun + use FatesGlobals , only : fates_log + use shr_log_mod , only : errMsg => shr_log_errMsg + + implicit none + private + + + integer, public, parameter :: ncwd = 4 ! number of coarse woody debris pools + ! (twig,s branch,l branch, trunk) + + integer, public, parameter :: ndcmpy = 3 ! number of "decomposability" pools in + ! fines (lignin, cellulose, labile) + + integer, public, parameter :: ilabile = 1 ! Array index for labile portion + integer, public, parameter :: icellulose = 2 ! Array index for cellulose portion + integer, public, parameter :: ilignin = 3 ! Array index for the lignin portion + + + type, public :: litter_type + + + ! This object is allocated for each element (C, N, P, etc) that we wish to track. + + integer :: element_id ! This element ID should + ! be associated with the element + ! types listed in parteh/PRTGenericMod.F90 + + ! --------------------------------------------------------------------------------- + ! Prognostic variables (litter and coarse woody debris) + ! Note that we do not track the fines (leaf/fine-root debris) by PFT. We track them + ! by their decomposing pools (i.e. chemical fraction). This is the same dimensioning + ! that gets passed back to the external BGC model, and saves a lot of space. + ! --------------------------------------------------------------------------------- + + + real(r8) :: ag_cwd(ncwd) ! above ground coarse wood debris (cwd) [kg/m2] + real(r8),allocatable :: bg_cwd(:,:) ! below ground coarse wood debris (cwd x soil) [kg/m2] + real(r8),allocatable :: leaf_fines(:) ! above ground leaf litter (dcmpy) [kg/m2] + real(r8),allocatable :: root_fines(:,:) ! below ground fine root litter (dcmpy x soil) [kg/m2] + + real(r8),allocatable :: seed(:) ! the seed pool (viable) (pft) [kg/m2] + real(r8),allocatable :: seed_germ(:) ! the germinated seed pool (pft) [kg/m2] + + + ! --------------------------------------------------------------------------------- + ! Fluxes in - dying trees / seed rain (does not include disturbance fluxes) + ! --------------------------------------------------------------------------------- + + real(r8) :: ag_cwd_in(ncwd) ! (cwd) [kg/m2/day] + real(r8),allocatable :: bg_cwd_in(:,:) ! (cwd x soil) [kg/m2/day] + real(r8),allocatable :: leaf_fines_in(:) ! (dcmpy) [kg/m2/day] + real(r8),allocatable :: root_fines_in(:,:) ! (dcmpy x soil [kg/m2/day] + + real(r8),allocatable :: seed_in_local(:) ! (pft) [kg/m2/day] (from local sources) + real(r8),allocatable :: seed_in_extern(:) ! (pft) [kg/m2/day] (from outside cell) + + + ! --------------------------------------------------------------------------------- + ! Fluxes out - fragmentation, seed decay (does not include disturbance) + ! --------------------------------------------------------------------------------- + + real(r8) :: ag_cwd_frag(ncwd) ! above ground cwd fragmentation flux [kg/m2/day] + real(r8),allocatable :: bg_cwd_frag(:,:) ! below ground cwd fragmentation flux [kg/m2/day] + real(r8),allocatable :: leaf_fines_frag(:) ! above ground fines fragmentation flux [kg/m2/day] + real(r8),allocatable :: root_fines_frag(:,:) ! kg/m2/day + + real(r8), allocatable :: seed_decay(:) ! decay of viable seeds to litter [kg/m2/day] + real(r8), allocatable :: seed_germ_decay(:) ! decay of germinated seeds to litter [kg/m2/day] + real(r8), allocatable :: seed_germ_in(:) ! flux from viable to germinated seed [kg/m2/day] + + contains + + procedure,non_overridable :: InitAllocate + procedure,non_overridable :: DeallocateLitt + procedure,non_overridable :: InitConditions + procedure,non_overridable :: FuseLitter + procedure,non_overridable :: CopyLitter + procedure,non_overridable :: ZeroFlux + procedure,non_overridable :: GetTotalLitterMass + + end type litter_type + + ! Part 3: Public extended types + + character(len=*), parameter, private :: sourcefile = __FILE__ + +contains + + subroutine FuseLitter(this,self_area,donor_area,donor_litt) + + ! ----------------------------------------------------------------------------------- + ! The litter pools are all area normalized. This routine + ! will use area weighting to determine the resulting + ! litter density per area of all the pools. Essentially + ! summing up the total mass by multiplying each component + ! area, and then normalizing by the new total. + ! ----------------------------------------------------------------------------------- + + + class(litter_type) :: this + real(r8),intent(in) :: self_area + real(r8),intent(in) :: donor_area + type(litter_type),intent(in) :: donor_litt + + ! locals + integer :: nlevsoil ! number of soil layers + integer :: c ! cwd index + integer :: pft ! pft index + integer :: ilyr ! soil layer index + integer :: dcmpy ! dcmpyical pool index + integer :: npft ! number of PFTs + real(r8) :: self_weight ! weighting of the recieving litter pool + real(r8) :: donor_weight ! weighting of the donating litter pool + + + nlevsoil = size(this%bg_cwd,dim=2) + npft = size(this%seed,dim=1) + + self_weight = self_area /(donor_area+self_area) + donor_weight = 1._r8 - self_weight + + + do c=1,ncwd + this%ag_cwd(c) = this%ag_cwd(c) *self_weight + & + donor_litt%ag_cwd(c) * donor_weight + this%ag_cwd_in(c) = this%ag_cwd_in(c) *self_weight + & + donor_litt%ag_cwd_in(c) * donor_weight + this%ag_cwd_frag(c) = this%ag_cwd_frag(c) *self_weight + & + donor_litt%ag_cwd_frag(c) * donor_weight + do ilyr = 1,nlevsoil + this%bg_cwd(c,ilyr) = this%bg_cwd(c,ilyr) * self_weight + & + donor_litt%bg_cwd(c,ilyr) * donor_weight + this%bg_cwd_in(c,ilyr) = this%bg_cwd_in(c,ilyr) * self_weight + & + donor_litt%bg_cwd_in(c,ilyr) * donor_weight + this%bg_cwd_frag(c,ilyr) = this%bg_cwd_frag(c,ilyr) * self_weight + & + donor_litt%bg_cwd_frag(c,ilyr) * donor_weight + end do + + end do + + + do pft=1,npft + + this%seed(pft) = this%seed(pft) * self_weight + & + donor_litt%seed(pft) * donor_weight + this%seed_germ(pft) = this%seed_germ(pft) * self_weight + & + donor_litt%seed_germ(pft) * donor_weight + + this%seed_in_local(pft) = this%seed_in_local(pft) * self_weight + & + donor_litt%seed_in_local(pft) * donor_weight + this%seed_in_extern(pft) = this%seed_in_extern(pft) * self_weight + & + donor_litt%seed_in_extern(pft) * donor_weight + + this%seed_decay(pft) = this%seed_decay(pft) * self_weight + & + donor_litt%seed_decay(pft) * donor_weight + this%seed_germ_decay(pft) = this%seed_germ_decay(pft) * self_weight + & + donor_litt%seed_germ_decay(pft) * donor_weight + this%seed_germ_in(pft) = this%seed_germ_in(pft) * self_weight + & + donor_litt%seed_germ_in(pft) * donor_weight + end do + + + do dcmpy=1,ndcmpy + + this%leaf_fines(dcmpy) = this%leaf_fines(dcmpy) * self_weight + & + donor_litt%leaf_fines(dcmpy) * donor_weight + this%leaf_fines_in(dcmpy) = this%leaf_fines_in(dcmpy) * self_weight + & + donor_litt%leaf_fines_in(dcmpy) * donor_weight + this%leaf_fines_frag(dcmpy) = this%leaf_fines_frag(dcmpy) * self_weight + & + donor_litt%leaf_fines_frag(dcmpy) * donor_weight + + do ilyr=1,nlevsoil + this%root_fines(dcmpy,ilyr) = this%root_fines(dcmpy,ilyr) * self_weight + & + donor_litt%root_fines(dcmpy,ilyr) * donor_weight + this%root_fines_in(dcmpy,ilyr) = this%root_fines_in(dcmpy,ilyr) * self_weight + & + donor_litt%root_fines_in(dcmpy,ilyr) * donor_weight + this%root_fines_frag(dcmpy,ilyr) = this%root_fines_frag(dcmpy,ilyr) * self_weight + & + donor_litt%root_fines_frag(dcmpy,ilyr) * donor_weight + end do + end do + + return + end subroutine FuseLitter + + ! ===================================================================================== + + subroutine CopyLitter(this,donor_litt) + + ! This might not need to ever be called. When a new patch is created + ! from disturbance, litter initialization is handled elsewhere (EDPatchDynamics) + + + class(litter_type) :: this + type(litter_type),intent(in) :: donor_litt + + + this%ag_cwd(:) = donor_litt%ag_cwd(:) + this%ag_cwd_in(:) = donor_litt%ag_cwd_in(:) + this%ag_cwd_frag(:) = donor_litt%ag_cwd_frag(:) + + this%bg_cwd(:,:) = donor_litt%bg_cwd(:,:) + this%bg_cwd_in(:,:) = donor_litt%bg_cwd_in(:,:) + this%bg_cwd_frag(:,:) = donor_litt%bg_cwd_frag(:,:) + + this%leaf_fines(:) = donor_litt%leaf_fines(:) + this%seed(:) = donor_litt%seed(:) + this%seed_germ(:) = donor_litt%seed_germ(:) + this%leaf_fines_in(:) = donor_litt%leaf_fines_in(:) + this%seed_in_local(:) = donor_litt%seed_in_local(:) + + this%seed_in_extern(:) = donor_litt%seed_in_extern(:) + this%leaf_fines_frag(:) = donor_litt%leaf_fines_frag(:) + + this%seed_decay(:) = donor_litt%seed_decay(:) + this%seed_germ_decay(:) = donor_litt%seed_germ_decay(:) + this%seed_germ_in(:) = donor_litt%seed_germ_in(:) + this%root_fines(:,:) = donor_litt%root_fines(:,:) + this%root_fines_in(:,:) = donor_litt%root_fines_in(:,:) + this%root_fines_frag(:,:) = donor_litt%root_fines_frag(:,:) + + return + end subroutine CopyLitter + + ! ===================================================================================== + + subroutine InitAllocate(this,numpft,numlevsoil,element_id) + + class(litter_type) :: this + integer,intent(in) :: numpft ! number of plant functional types + integer,intent(in) :: numlevsoil ! number of soil layers + integer,intent(in) :: element_id ! PARTEH compliant element index + + this%element_id = element_id + + allocate(this%bg_cwd_in(ncwd,numlevsoil)) + allocate(this%bg_cwd(ncwd,numlevsoil)) + allocate(this%bg_cwd_frag(ncwd,numlevsoil)) + + allocate(this%leaf_fines(ndcmpy)) + allocate(this%root_fines(ndcmpy,numlevsoil)) + allocate(this%leaf_fines_in(ndcmpy)) + allocate(this%root_fines_in(ndcmpy,numlevsoil)) + allocate(this%leaf_fines_frag(ndcmpy)) + allocate(this%root_fines_frag(ndcmpy,numlevsoil)) + + allocate(this%seed_in_local(numpft)) + allocate(this%seed_in_extern(numpft)) + allocate(this%seed(numpft)) + allocate(this%seed_germ(numpft)) + allocate(this%seed_germ_in(numpft)) + allocate(this%seed_germ_decay(numpft)) + allocate(this%seed_decay(numpft)) + + ! Initialize everything to a nonsense flag + this%ag_cwd(:) = fates_unset_r8 + this%bg_cwd(:,:) = fates_unset_r8 + this%leaf_fines(:) = fates_unset_r8 + this%root_fines(:,:) = fates_unset_r8 + this%seed(:) = fates_unset_r8 + this%seed_germ(:) = fates_unset_r8 + + this%ag_cwd_in(:) = fates_unset_r8 + this%bg_cwd_in(:,:) = fates_unset_r8 + this%leaf_fines_in(:) = fates_unset_r8 + this%root_fines_in(:,:) = fates_unset_r8 + this%seed_in_local(:) = fates_unset_r8 + this%seed_in_extern(:) = fates_unset_r8 + + this%ag_cwd_frag(:) = fates_unset_r8 + this%bg_cwd_frag(:,:) = fates_unset_r8 + this%leaf_fines_frag(:) = fates_unset_r8 + this%root_fines_frag(:,:) = fates_unset_r8 + + this%seed_decay(:) = fates_unset_r8 + this%seed_germ_decay(:) = fates_unset_r8 + this%seed_germ_in(:) = fates_unset_r8 + + return + end subroutine InitAllocate + + ! ===================================================================================== + + subroutine InitConditions(this, & + init_leaf_fines, & + init_root_fines, & + init_ag_cwd, & + init_bg_cwd, & + init_seed, & + init_seed_germ) + + ! This procedure initialized litter pools. This does not allow initialization + ! of each soil layer depth, or decomposability pool. This is meant for + ! uniform initializations. This is used for cold-starts, but is not + ! used in restarts. For patch fusion, this routine is used to zero the pools + ! before accumulating debris from multiple patches. + + + class(litter_type) :: this + real(r8),intent(in) :: init_leaf_fines + real(r8),intent(in) :: init_root_fines + real(r8),intent(in) :: init_ag_cwd + real(r8),intent(in) :: init_bg_cwd + real(r8),intent(in) :: init_seed + real(r8),intent(in) :: init_seed_germ + + this%ag_cwd(:) = init_ag_cwd + this%bg_cwd(:,:) = init_bg_cwd + this%leaf_fines(:) = init_leaf_fines + this%root_fines(:,:) = init_root_fines + this%seed(:) = init_seed + this%seed_germ(:) = init_seed_germ + + return + end subroutine InitConditions + + ! ===================================================================================== + + subroutine DeallocateLitt(this) + + class(litter_type) :: this + + deallocate(this%bg_cwd) + deallocate(this%leaf_fines) + deallocate(this%root_fines) + deallocate(this%seed) + deallocate(this%seed_germ) + + deallocate(this%bg_cwd_in) + deallocate(this%leaf_fines_in) + deallocate(this%root_fines_in) + deallocate(this%seed_in_local) + deallocate(this%seed_in_extern) + + deallocate(this%bg_cwd_frag) + deallocate(this%leaf_fines_frag) + deallocate(this%root_fines_frag) + + deallocate(this%seed_decay) + deallocate(this%seed_germ_decay) + deallocate(this%seed_germ_in) + + return + end subroutine DeallocateLitt + + ! ===================================================================================== + + subroutine ZeroFlux(this) + + class(litter_type) :: this + + this%ag_cwd_in(:) = 0._r8 + this%bg_cwd_in(:,:) = 0._r8 + this%leaf_fines_in(:) = 0._r8 + this%root_fines_in(:,:) = 0._r8 + this%seed_in_local(:) = 0._r8 + this%seed_in_extern(:) = 0._r8 + + this%ag_cwd_frag(:) = 0._r8 + this%bg_cwd_frag(:,:) = 0._r8 + this%leaf_fines_frag(:) = 0._r8 + this%root_fines_frag(:,:) = 0._r8 + + this%seed_germ_in(:) = 0._r8 + this%seed_decay(:) = 0._r8 + this%seed_germ_decay(:) = 0._r8 + + + return + end subroutine ZeroFlux + + ! =================================================== + + function GetTotalLitterMass(this) result(total_mass) + + class(litter_type) :: this + real(r8) :: total_mass + + total_mass = sum(this%ag_cwd) + & + sum(this%bg_cwd) + & + sum(this%root_fines) + & + sum(this%leaf_fines) + & + sum(this%seed) + & + sum(this%seed_germ) + + return + end function GetTotalLitterMass + + +end module FatesLitterMod diff --git a/biogeophys/EDAccumulateFluxesMod.F90 b/biogeophys/EDAccumulateFluxesMod.F90 index 43e53bfa5f..37ac96df52 100644 --- a/biogeophys/EDAccumulateFluxesMod.F90 +++ b/biogeophys/EDAccumulateFluxesMod.F90 @@ -13,6 +13,8 @@ module EDAccumulateFluxesMod use FatesGlobals, only : fates_log use shr_log_mod , only : errMsg => shr_log_errMsg use FatesConstantsMod , only : r8 => fates_r8 + + implicit none private ! @@ -54,13 +56,12 @@ subroutine AccumulateFluxes_ED(nsites, sites, bc_in, bc_out, dt_time) integer :: c ! clm/alm column integer :: s ! ed site integer :: ifp ! index fates patch - real(r8):: n_perm2 !---------------------------------------------------------------------- - + do s = 1, nsites ifp = 0 - sites(s)%npp = 0.0_r8 + cpatch => sites(s)%oldest_patch do while (associated(cpatch)) ifp = ifp+1 @@ -84,25 +85,15 @@ subroutine AccumulateFluxes_ED(nsites, sites, bc_in, bc_out, dt_time) ccohort%gpp_acc = ccohort%gpp_acc + ccohort%gpp_tstep ccohort%resp_acc = ccohort%resp_acc + ccohort%resp_tstep - ! weighted mean of D13C by gpp - if((ccohort%gpp_acc + ccohort%gpp_tstep) .eq. 0.0_r8) then - ccohort%c13disc_acc = 0.0_r8 + ! weighted mean of D13C by gpp + if((ccohort%gpp_acc + ccohort%gpp_tstep) .eq. 0.0_r8) then + ccohort%c13disc_acc = 0.0_r8 else - ccohort%c13disc_acc = ((ccohort%c13disc_acc * ccohort%gpp_acc) + (ccohort%c13disc_clm * ccohort%gpp_tstep)) / & - (ccohort%gpp_acc + ccohort%gpp_tstep) - endif - - !----- THE FOLLOWING IS ONLY IMPLEMENTED TEMPORARILY FOR B4B reproducibility - !----- ALSO, THERE IS NO REASON TO USE THE ISNEW FLAG HERE - if ((cpatch%area .gt. 0._r8) .and. (cpatch%total_canopy_area .gt. 0._r8)) then - n_perm2 = ccohort%n/AREA - else - n_perm2 = 0.0_r8 - endif - if ( .not. ccohort%isnew ) then - sites(s)%npp = sites(s)%npp + ccohort%npp_tstep * n_perm2 * 1.e3_r8 / dt_time + ccohort%c13disc_acc = ((ccohort%c13disc_acc * ccohort%gpp_acc) + & + (ccohort%c13disc_clm * ccohort%gpp_tstep)) / & + (ccohort%gpp_acc + ccohort%gpp_tstep) endif - + do iv=1,ccohort%nv if(ccohort%year_net_uptake(iv) == 999._r8)then ! note that there were leaves in this layer this year. ccohort%year_net_uptake(iv) = 0._r8 diff --git a/biogeophys/EDBtranMod.F90 b/biogeophys/EDBtranMod.F90 index 2b10f18899..90d2b3f3c3 100644 --- a/biogeophys/EDBtranMod.F90 +++ b/biogeophys/EDBtranMod.F90 @@ -7,7 +7,7 @@ module EDBtranMod use EDPftvarcon , only : EDPftvarcon_inst use FatesConstantsMod , only : tfrz => t_water_freeze_k_1atm - use FatesConstantsMod , only : itrue,ifalse + use FatesConstantsMod , only : itrue,ifalse,nearzero use EDTypesMod , only : ed_site_type, & ed_patch_type, & ed_cohort_type, & @@ -18,6 +18,8 @@ module EDBtranMod numpft use FatesInterfaceMod , only : hlm_use_planthydro use FatesGlobals , only : fates_log + use FatesAllometryMod , only : set_root_fraction + use FatesAllometryMod , only : i_hydro_rootprof_context ! implicit none @@ -115,6 +117,7 @@ subroutine btran_ed( nsites, sites, bc_in, bc_out) real(r8) :: pftgs(maxpft) ! pft weighted stomatal conductance m/s real(r8) :: temprootr real(r8) :: sum_pftgs ! sum of weighted conductances (for normalization) + real(r8), allocatable :: root_resis(:,:) ! Root resistance in each pft x layer !------------------------------------------------------------------------------ associate( & @@ -124,6 +127,8 @@ subroutine btran_ed( nsites, sites, bc_in, bc_out) do s = 1,nsites + allocate(root_resis(numpft,bc_in(s)%nlevsoil)) + bc_out(s)%rootr_pasl(:,:) = 0._r8 ifp = 0 @@ -134,6 +139,10 @@ subroutine btran_ed( nsites, sites, bc_in, bc_out) ! THIS SHOULD REALLY BE A COHORT LOOP ONCE WE HAVE rootfr_ft FOR COHORTS (RGK) do ft = 1,numpft + + call set_root_fraction(sites(s)%rootfrac_scr, ft, sites(s)%zi_soil, & + icontext = i_hydro_rootprof_context) + cpatch%btran_ft(ft) = 0.0_r8 do j = 1,bc_in(s)%nlevsoil @@ -147,26 +156,25 @@ subroutine btran_ed( nsites, sites, bc_in, bc_out) rresis = min( (bc_in(s)%eff_porosity_sl(j)/bc_in(s)%watsat_sl(j))* & (smp_node - smpsc(ft)) / (smpso(ft) - smpsc(ft)), 1._r8) - cpatch%rootr_ft(ft,j) = cpatch%rootfr_ft(ft,j)*rresis + root_resis(ft,j) = sites(s)%rootfrac_scr(j)*rresis ! root water uptake is not linearly proportional to root density, ! to allow proper deep root funciton. Replace with equations from SPA/Newman. FIX(RF,032414) - ! cpatch%rootr_ft(ft,j) = cpatch%rootfr_ft(ft,j)**0.3*rresis_ft(ft,j)/ & - ! sum(cpatch%rootfr_ft(ft,1:nlevsoil)**0.3) - cpatch%btran_ft(ft) = cpatch%btran_ft(ft) + cpatch%rootr_ft(ft,j) + + cpatch%btran_ft(ft) = cpatch%btran_ft(ft) + root_resis(ft,j) else - cpatch%rootr_ft(ft,j) = 0._r8 + root_resis(ft,j) = 0._r8 end if end do !j ! Normalize root resistances to get layer contribution to ET do j = 1,bc_in(s)%nlevsoil - if (cpatch%btran_ft(ft) > 0.0_r8) then - cpatch%rootr_ft(ft,j) = cpatch%rootr_ft(ft,j)/cpatch%btran_ft(ft) + if (cpatch%btran_ft(ft) > nearzero) then + root_resis(ft,j) = root_resis(ft,j)/cpatch%btran_ft(ft) else - cpatch%rootr_ft(ft,j) = 0._r8 + root_resis(ft,j) = 0._r8 end if end do @@ -195,10 +203,10 @@ subroutine btran_ed( nsites, sites, bc_in, bc_out) if( sum_pftgs > 0._r8)then !prevent problem with the first timestep - might fail !bit-retart test as a result? FIX(RF,032414) bc_out(s)%rootr_pasl(ifp,j) = bc_out(s)%rootr_pasl(ifp,j) + & - cpatch%rootr_ft(ft,j) * pftgs(ft)/sum_pftgs + root_resis(ft,j) * pftgs(ft)/sum_pftgs else bc_out(s)%rootr_pasl(ifp,j) = bc_out(s)%rootr_pasl(ifp,j) + & - cpatch%rootr_ft(ft,j) * 1._r8/real(numpft,r8) + root_resis(ft,j) * 1._r8/real(numpft,r8) end if enddo enddo @@ -231,7 +239,9 @@ subroutine btran_ed( nsites, sites, bc_in, bc_out) cpatch => cpatch%younger end do - + + deallocate(root_resis) + end do if(hlm_use_planthydro.eq.itrue) then diff --git a/biogeophys/FatesBstressMod.F90 b/biogeophys/FatesBstressMod.F90 index 88f7d44710..10d6777cc3 100644 --- a/biogeophys/FatesBstressMod.F90 +++ b/biogeophys/FatesBstressMod.F90 @@ -18,6 +18,8 @@ module FatesBstressMod use FatesInterfaceMod , only : hlm_use_planthydro use FatesGlobals , only : fates_log use EDBtranMod , only : check_layer_water + use FatesAllometryMod , only : set_root_fraction + use FatesAllometryMod , only : i_hydro_rootprof_context implicit none private @@ -54,6 +56,7 @@ subroutine btran_sal_stress_fates( nsites, sites, bc_in) integer :: ft ! plant functional type index real(r8) :: salinity_node ! salinity in the soil water [ppt] real(r8) :: rresis ! salinity limitation to transpiration independent + !------------------------------------------------------------------------------ do s = 1,nsites @@ -65,6 +68,10 @@ subroutine btran_sal_stress_fates( nsites, sites, bc_in) do ft = 1,numpft cpatch%bstress_sal_ft(ft) = 0.0_r8 + + call set_root_fraction(sites(s)%rootfrac_scr, ft, sites(s)%zi_soil, & + icontext = i_hydro_rootprof_context) + do j = 1,bc_in(s)%nlevsoil ! Calculations are only relevant where liquid water exists @@ -76,8 +83,7 @@ subroutine btran_sal_stress_fates( nsites, sites, bc_in) rresis = min( 1.244_r8/(1+exp((0.186_r8-salinity_node)/(-0.132_r8))), 1._r8) - cpatch%bstress_sal_ft(ft) = cpatch%bstress_sal_ft(ft)+ & - cpatch%rootfr_ft(ft,j)*rresis + cpatch%bstress_sal_ft(ft) = cpatch%bstress_sal_ft(ft)+sites(s)%rootfrac_scr(j)*rresis end if @@ -88,10 +94,10 @@ subroutine btran_sal_stress_fates( nsites, sites, bc_in) cpatch => cpatch%younger end do - + end do - + return end subroutine btran_sal_stress_fates ! ==================================================================================== diff --git a/biogeophys/FatesPlantHydraulicsMod.F90 b/biogeophys/FatesPlantHydraulicsMod.F90 index 2792d02c7f..15f061e643 100644 --- a/biogeophys/FatesPlantHydraulicsMod.F90 +++ b/biogeophys/FatesPlantHydraulicsMod.F90 @@ -39,8 +39,10 @@ module FatesPlantHydraulicsMod use FatesConstantsMod, only : pi_const use FatesConstantsMod, only : cm2_per_m2 use FatesConstantsMod, only : g_per_kg + use FatesConstantsMod, only : nearzero - use EDParamsMod , only : hydr_kmax_rsurf + use EDParamsMod , only : hydr_kmax_rsurf1 + use EDParamsMod , only : hydr_kmax_rsurf2 use EDTypesMod , only : ed_site_type use EDTypesMod , only : ed_patch_type @@ -53,7 +55,8 @@ module FatesPlantHydraulicsMod use FatesAllometryMod, only : bsap_allom use FatesAllometryMod, only : CrownDepth - + use FatesAllometryMod , only : set_root_fraction + use FatesAllometryMod , only : i_hydro_rootprof_context use FatesHydraulicsMemMod, only: ed_site_hydr_type use FatesHydraulicsMemMod, only: ed_cohort_hydr_type use FatesHydraulicsMemMod, only: n_hypool_leaf @@ -141,6 +144,7 @@ module FatesPlantHydraulicsMod public :: CopyCohortHydraulics public :: FuseCohortHydraulics public :: updateSizeDepTreeHydProps + public :: updateWaterDepTreeHydProps public :: updateSizeDepTreeHydStates public :: initTreeHydStates public :: updateSizeDepRhizHydProps @@ -150,6 +154,7 @@ module FatesPlantHydraulicsMod public :: SavePreviousRhizVolumes public :: UpdateTreeHydrNodes public :: UpdateTreeHydrLenVolCond + public :: UpdateWaterDepTreeHydrCond public :: ConstrainRecruitNumber !------------------------------------------------------------------------------ @@ -325,7 +330,8 @@ subroutine initTreeHydStates(site_p, cc_p, bc_in) ! watsat(c,j), watres(c,j), alpha_VG(c,j), n_VG(c,j), m_VG(c,j), l_VG(c,j), & ! smp) !ccohort_hydr%psi_aroot(j) = smp - ccohort_hydr%psi_aroot(j) = csite%si_hydr%psisoi_liq_innershell(j) + !ccohort_hydr%psi_aroot(j) = csite%si_hydr%psisoi_liq_innershell(j) + ccohort_hydr%psi_aroot(j) = -0.2_r8 !do not assume the equalibrium between soil and root call th_from_psi(ft, 4, ccohort_hydr%psi_aroot(j), ccohort_hydr%th_aroot(j), csite%si_hydr, bc_in ) end do @@ -346,6 +352,7 @@ subroutine initTreeHydStates(site_p, cc_p, bc_in) !hydrostatic equilibrium with the water potential immediately below dz = ccohort_hydr%z_node_ag(n_hypool_ag) - ccohort_hydr%z_node_troot(1) ccohort_hydr%psi_ag(n_hypool_ag) = ccohort_hydr%psi_troot(1) - 1.e-6_r8*denh2o*grav*dz + if (ccohort_hydr%psi_ag(n_hypool_ag)>0.0_r8) ccohort_hydr%psi_ag(n_hypool_ag) = -0.01_r8 call th_from_psi(ft, 2, ccohort_hydr%psi_ag(n_hypool_ag), ccohort_hydr%th_ag(n_hypool_ag), csite%si_hydr, bc_in) do k=n_hypool_ag-1, 1, -1 dz = ccohort_hydr%z_node_ag(k) - ccohort_hydr%z_node_ag(k+1) @@ -543,9 +550,44 @@ subroutine updateSizeDepTreeHydProps(currentSite,ccohort,bc_in) ! volumes, and UpdateTreeHydrNodes is called prior to this. call UpdateTreeHydrLenVolCond(ccohort,nlevsoi_hyd,bc_in) + + end subroutine updateSizeDepTreeHydProps + + ! ===================================================================================== + + subroutine updateWaterDepTreeHydProps(currentSite,ccohort,bc_in) + + + ! DESCRIPTION: Updates absorbing root length (total and its vertical distribution) + ! as well as the consequential change in the size of the 'representative' rhizosphere + ! shell radii, volumes, and compartment volumes of plant tissues + + ! !USES: + use shr_sys_mod , only : shr_sys_abort + + ! ARGUMENTS: + type(ed_site_type) , intent(in) :: currentSite ! Site stuff + type(ed_cohort_type) , intent(inout) :: ccohort ! current cohort pointer + type(bc_in_type) , intent(in) :: bc_in ! Boundary Conditions + + ! Locals + integer :: nlevsoi_hyd ! Number of total soil layers + type(ed_cohort_hydr_type), pointer :: ccohort_hydr + integer :: ft + + nlevsoi_hyd = currentSite%si_hydr%nlevsoi_hyd + ccohort_hydr => ccohort%co_hydr + ft = ccohort%pft + ! This updates plant compartment volumes, lengths and + ! maximum conductances. Make sure for already + ! initialized vegetation, that SavePreviousCompartment + ! volumes, and UpdateTreeHydrNodes is called prior to this. - end subroutine updateSizeDepTreeHydProps + call UpdateWaterDepTreeHydrCond(currentSite,ccohort,nlevsoi_hyd,bc_in) + + + end subroutine updateWaterDepTreeHydProps ! ===================================================================================== @@ -599,6 +641,7 @@ subroutine UpdateTreeHydrLenVolCond(ccohort,nlevsoi_hyd,bc_in) real(r8) :: b_troot_biom ! transporting root biomass in dry wt units [kg/indiv] real(r8) :: v_troot ! transporting root volume [m3/indiv] real(r8) :: rootfr ! mass fraction of roots in each layer [kg/kg] + real(r8), allocatable :: rootfrs(:) ! Vector of root fractions (only used in 1 layer case) [kg/kg] real(r8) :: crown_depth ! Depth of the plant's crown [m] real(r8) :: kmax_node1_nodekplus1(n_hypool_ag) ! cumulative kmax, petiole to node k+1, ! conduit taper effects excluded [kg s-1 MPa-1] @@ -616,7 +659,6 @@ subroutine UpdateTreeHydrLenVolCond(ccohort,nlevsoi_hyd,bc_in) ! hydraulic conductance [kg s-1 MPa-1] real(r8) :: kmax_tot ! total tree (leaf to root tip) ! hydraulic conductance [kg s-1 MPa-1] - real(r8),parameter :: taper_exponent = 1._r8/3._r8 ! Savage et al. (2010) xylem taper exponent [-] ccohort_hydr => ccohort%co_hydr @@ -797,8 +839,12 @@ subroutine UpdateTreeHydrLenVolCond(ccohort,nlevsoi_hyd,bc_in) ccohort_hydr%kmax_treebg_tot = ( 1._r8/kmax_tot - 1._r8/kmax_treeag_tot ) ** (-1._r8) if(nlevsoi_hyd == 1) then - ccohort_hydr%kmax_treebg_layer(:) = ccohort_hydr%kmax_treebg_tot * & - ccohort%patchptr%rootfr_ft(ft,:) + allocate(rootfrs(bc_in%nlevsoil)) + call set_root_fraction(rootfrs(:), ft, bc_in%zi_sisl, & + icontext = i_hydro_rootprof_context) + + ccohort_hydr%kmax_treebg_layer(:) = ccohort_hydr%kmax_treebg_tot * rootfrs(:) + deallocate(rootfrs) else do j=1,nlevsoi_hyd if(j == 1) then @@ -810,10 +856,80 @@ subroutine UpdateTreeHydrLenVolCond(ccohort,nlevsoi_hyd,bc_in) ccohort_hydr%kmax_treebg_layer(j) = rootfr*ccohort_hydr%kmax_treebg_tot end do end if + end if !check for bleaf end subroutine UpdateTreeHydrLenVolCond + + + + !===================================================================================== + subroutine UpdateWaterDepTreeHydrCond(currentSite,ccohort,nlevsoi_hyd,bc_in) + + ! ----------------------------------------------------------------------------------- + ! This subroutine calculates update the conductivity for the soil-root interface, + ! depending on the plant water uptake/loss. + ! we assume that the conductivitity for water uptake is larger than + ! water loss due to composite regulation of resistance the roots + ! hydraulic vs osmostic with and without transpiration + ! Steudle, E. Water uptake by roots: effects of water deficit. + ! J Exp Bot 51, 1531-1542, doi:DOI 10.1093/jexbot/51.350.1531 (2000). + ! ----------------------------------------------------------------------------------- + + ! Arguments + type(ed_site_type) , intent(in) :: currentSite ! Site target + type(ed_cohort_type),intent(inout) :: ccohort ! cohort target + integer,intent(in) :: nlevsoi_hyd ! number of soil hydro layers + type(bc_in_type) , intent(in) :: bc_in ! Boundary Conditions + + type(ed_cohort_hydr_type),pointer :: ccohort_hydr ! Plant hydraulics structure + type(ed_site_hydr_type),pointer :: csite_hydr + + integer :: j,k + real(r8) :: hksat_s ! hksat converted to units of 10^6sec + real(r8) :: kmax_root_surf_total ! maximum conducitivity for total root surface(kg water/Mpa/s) + real(r8) :: kmax_soil_total ! maximum conducitivity for from root surface to soil shell(kg water/Mpa/s) + ! which is equiv to [kg m-1 s-1 MPa-1] + real(r8) :: kmax_root_surf ! maximum conducitivity for unit root surface (kg water/m2 root area/Mpa/s) + + ccohort_hydr => ccohort%co_hydr + csite_hydr => currentSite%si_hydr + k = 1 !only for the first soil shell + do j=1, nlevsoi_hyd + + hksat_s = bc_in%hksat_sisl(j) * 1.e-3_r8 * 1/grav * 1.e6_r8 + if(ccohort_hydr%psi_aroot(j) 1.0_r8) .or. & - ! err_code == 1 .or. err_code == 10) then - ! call dump_cohort(cCohort) - !end if enddo ! Storing mass balance error @@ -951,6 +1060,7 @@ subroutine CopyCohortHydraulics(newCohort, oldCohort) ! quantities indexed by soil layer ncohort_hydr%z_node_aroot = ocohort_hydr%z_node_aroot ncohort_hydr%kmax_treebg_layer = ocohort_hydr%kmax_treebg_layer + ncohort_hydr%kmax_innershell = ocohort_hydr%kmax_innershell ncohort_hydr%v_aroot_layer_init = ocohort_hydr%v_aroot_layer_init ncohort_hydr%v_aroot_layer = ocohort_hydr%v_aroot_layer ncohort_hydr%l_aroot_layer = ocohort_hydr%l_aroot_layer @@ -1318,7 +1428,6 @@ subroutine UpdateH2OVeg(nsites,sites,bc_out) ! ---------------------------------------------------------------------------------- use EDTypesMod, only : AREA - use EDTypesMod , only : dump_cohort ! Arguments integer, intent(in) :: nsites @@ -1609,11 +1718,7 @@ subroutine UpdateSizeDepRhizVolLenCon(currentSite, bc_in) real(r8) :: large_kmax_bound = 1.e4_r8 ! for replacing kmax_bound_shell wherever the ! innermost shell radius is less than the assumed ! absorbing root radius rs1 - real(r8) :: kmax_root_surf ! maximum conducitivity for unit root surface - ! (kg water/m2 root area/Mpa/s) ! 1.e-5_r8 from Rudinger et al 1994 - real(r8) :: kmax_root_surf_total !maximum conducitivity for total root surface(kg water/Mpa/s) - real(r8) :: kmax_soil_total !maximum conducitivity for total root surface(kg water/Mpa/s) integer :: nlevsoi_hyd !----------------------------------------------------------------------- @@ -1633,7 +1738,7 @@ subroutine UpdateSizeDepRhizVolLenCon(currentSite, bc_in) enddo !cohort cPatch => cPatch%older enddo !patch - kmax_root_surf = hydr_kmax_rsurf + csite_hydr%l_aroot_1D = sum( csite_hydr%l_aroot_layer(:)) ! update outer radii of column-level rhizosphere shells (same across patches and cohorts) @@ -1646,6 +1751,9 @@ subroutine UpdateSizeDepRhizVolLenCon(currentSite, bc_in) enddo call shellGeom( csite_hydr%l_aroot_1D, csite_hydr%rs1(1), AREA, sum(bc_in%dz_sisl(1:nlevsoi_hyd)), & csite_hydr%r_out_shell_1D(:), csite_hydr%r_node_shell_1D(:), csite_hydr%v_shell_1D(:)) + + !update the conductitivity for first soil shell is done at subroutine UpdateWaterDepTreeHydrCond + !which is dependant on whether it is water uptake or loss for every 30 minutes do j = 1,csite_hydr%nlevsoi_hyd @@ -1654,50 +1762,8 @@ subroutine UpdateSizeDepRhizVolLenCon(currentSite, bc_in) ! proceed only if the total absorbing root length (site-level) has changed in this layer if( csite_hydr%l_aroot_layer(j) /= csite_hydr%l_aroot_layer_init(j) ) then - do k = 1,nshell - if(k == 1) then - kmax_root_surf_total = kmax_root_surf*2._r8*pi_const *csite_hydr%rs1(j)* & - csite_hydr%l_aroot_layer(j) - if(csite_hydr%r_node_shell(j,k) <= csite_hydr%rs1(j)) then - !csite_hydr%kmax_upper_shell(j,k) = large_kmax_bound - !csite_hydr%kmax_bound_shell(j,k) = large_kmax_bound - !csite_hydr%kmax_lower_shell(j,k) = large_kmax_bound - csite_hydr%kmax_upper_shell(j,k) = kmax_root_surf_total - csite_hydr%kmax_bound_shell(j,k) = kmax_root_surf_total - csite_hydr%kmax_lower_shell(j,k) = kmax_root_surf_total - - else - - kmax_soil_total = 2._r8*pi_const*csite_hydr%l_aroot_layer(j) / & - log(csite_hydr%r_node_shell(j,k)/csite_hydr%rs1(j))*hksat_s - - !csite_hydr%kmax_upper_shell(j,k) = 2._r8*pi_const*csite_hydr%l_aroot_layer(j) / & - ! log(csite_hydr%r_node_shell(j,k)/csite_hydr%rs1(j))*hksat_s - !csite_hydr%kmax_bound_shell(j,k) = 2._r8*pi_const*csite_hydr%l_aroot_layer(j) / & - ! log(csite_hydr%r_node_shell(j,k)/csite_hydr%rs1(j))*hksat_s - !csite_hydr%kmax_lower_shell(j,k) = 2._r8*pi_const*csite_hydr%l_aroot_layer(j) / & - ! log(csite_hydr%r_node_shell(j,k)/csite_hydr%rs1(j))*hksat_s - - csite_hydr%kmax_upper_shell(j,k) = (1._r8/kmax_root_surf_total + & - 1._r8/kmax_soil_total)**(-1._r8) - csite_hydr%kmax_bound_shell(j,k) = (1._r8/kmax_root_surf_total + & - 1._r8/kmax_soil_total)**(-1._r8) - csite_hydr%kmax_lower_shell(j,k) = (1._r8/kmax_root_surf_total + & - 1._r8/kmax_soil_total)**(-1._r8) - end if - if(j == 1) then - if(csite_hydr%r_node_shell(j,k) <= csite_hydr%rs1(j)) then - csite_hydr%kmax_upper_shell_1D(k) = csite_hydr%kmax_upper_shell(1,k) - csite_hydr%kmax_bound_shell_1D(k) = csite_hydr%kmax_bound_shell(1,k) - csite_hydr%kmax_lower_shell_1D(k) = csite_hydr%kmax_lower_shell(1,k) - else - csite_hydr%kmax_upper_shell_1D(k) = csite_hydr%kmax_upper_shell(1,k) - csite_hydr%kmax_bound_shell_1D(k) = csite_hydr%kmax_bound_shell(1,k) - csite_hydr%kmax_lower_shell_1D(k) = csite_hydr%kmax_lower_shell(1,k) - end if - end if - else - csite_hydr%kmax_upper_shell(j,k) = 2._r8*pi_const*csite_hydr%l_aroot_layer(j) / & + do k = 2,nshell + csite_hydr%kmax_upper_shell(j,k) = 2._r8*pi_const*csite_hydr%l_aroot_layer(j) / & log(csite_hydr%r_node_shell(j,k)/csite_hydr%r_out_shell(j,k-1))*hksat_s csite_hydr%kmax_bound_shell(j,k) = 2._r8*pi_const*csite_hydr%l_aroot_layer(j) / & log(csite_hydr%r_node_shell(j,k)/csite_hydr%r_node_shell(j,k-1))*hksat_s @@ -1711,16 +1777,14 @@ subroutine UpdateSizeDepRhizVolLenCon(currentSite, bc_in) csite_hydr%kmax_lower_shell_1D(k) = 2._r8*pi_const*csite_hydr%l_aroot_1D / & log(csite_hydr%r_out_shell_1D( k)/csite_hydr%r_node_shell_1D(k ))*hksat_s end if - end if enddo ! loop over rhizosphere shells end if !has l_aroot_layer changed? enddo ! loop over soil layers - return end subroutine UpdateSizeDepRhizVolLenCon - + ! ===================================================================================== @@ -2199,8 +2263,6 @@ subroutine hydraulics_bc ( nsites, sites,bc_in,bc_out,dtime ) !s ! !USES: use EDTypesMod , only : AREA - use FatesUtilsMod , only : check_var_real - use EDTypesMod , only : dump_cohort ! ARGUMENTS: ! ----------------------------------------------------------------------------------- @@ -2233,7 +2295,7 @@ subroutine hydraulics_bc ( nsites, sites,bc_in,bc_out,dtime ) real(r8), parameter :: small_theta_num = 1.e-7_r8 ! avoids theta values equalling thr or ths [m3 m-3] ! hydraulics timestep adjustments for acceptable water balance error - integer :: maxiter = 1 ! maximum iterations for timestep reduction [-] + integer :: maxiter = 5 ! maximum iterations for timestep reduction [-] integer :: imult = 3 ! iteration index multiplier [-] real(r8) :: we_area_outer ! 1D plant-soil continuum water error [kgh2o m-2 individual-1] @@ -2417,13 +2479,17 @@ subroutine hydraulics_bc ( nsites, sites,bc_in,bc_out,dtime ) do while(associated(ccohort)) ccohort_hydr => ccohort%co_hydr gscan_patch = gscan_patch + ccohort%g_sb_laweight - if (gscan_patch < 0._r8) then - write(fates_log(),*) 'ERROR: negative gscan_patch!' - call endrun(msg=errMsg(sourcefile, __LINE__)) - end if ccohort => ccohort%shorter enddo !cohort + ! The HLM predicted transpiration flux even though no leaves are present? + if(bc_in(s)%qflx_transp_pa(ifp) > 1.e-10_r8 .and. gscan_patchcpatch%tallest do while(associated(ccohort)) ccohort_hydr => ccohort%co_hydr @@ -2435,18 +2501,21 @@ subroutine hydraulics_bc ( nsites, sites,bc_in,bc_out,dtime ) ccohort_hydr%rootuptake = 0._r8 ! Relative transpiration of this cohort from the whole patch -!! qflx_rel_tran_coh = ccohort%g_sb_laweight/gscan_patch - - qflx_tran_veg_patch_coh = bc_in(s)%qflx_transp_pa(ifp) * ccohort%g_sb_laweight/gscan_patch - - qflx_tran_veg_indiv = qflx_tran_veg_patch_coh * cpatch%area* & - min(1.0_r8,cpatch%total_canopy_area/cpatch%area)/ccohort%n !AREA / ccohort%n - ! [mm H2O/cohort/s] = [mm H2O / patch / s] / [cohort/patch] -!! qflx_tran_veg_patch_coh = qflx_trans_patch_vol * qflx_rel_tran_coh + if(ccohort%g_sb_laweight>nearzero) then + qflx_tran_veg_patch_coh = bc_in(s)%qflx_transp_pa(ifp) * ccohort%g_sb_laweight/gscan_patch + + qflx_tran_veg_indiv = qflx_tran_veg_patch_coh * cpatch%area* & + min(1.0_r8,cpatch%total_canopy_area/cpatch%area)/ccohort%n !AREA / ccohort%n + else + qflx_tran_veg_patch_coh = 0._r8 + qflx_tran_veg_indiv = 0._r8 + end if - + + call updateWaterDepTreeHydProps(sites(s),ccohort,bc_in(s)) + if(site_hydr%nlevsoi_hyd > 1) then ! BUCKET APPROXIMATION OF THE SOIL-ROOT HYDRAULIC GRADIENT (weighted average across layers) !call map2d_to_1d_shells(soilstate_inst, waterstate_inst, g, c, rs1(c,1), ccohort_hydr%l_aroot_layer*ccohort%n, & @@ -2516,6 +2585,9 @@ subroutine hydraulics_bc ( nsites, sites,bc_in,bc_out,dtime ) kmax_lower( 1 : n_hypool_ag ) = ccohort_hydr%kmax_lower(:) kmax_upper(( n_hypool_ag+1) ) = ccohort_hydr%kmax_upper_troot if(site_hydr%nlevsoi_hyd == 1) then + site_hydr%kmax_upper_shell_1D(1) = ccohort_hydr%kmax_innershell(1) + site_hydr%kmax_lower_shell_1D(1) = ccohort_hydr%kmax_innershell(1) + site_hydr%kmax_bound_shell_1D(1) = ccohort_hydr%kmax_innershell(1) !! estimate troot-aroot and aroot-radial components as a residual: !! 25% each of total (surface of aroots to leaves) resistance kmax_bound(( n_hypool_ag+1):(n_hypool_ag+2 )) = 2._r8 * ccohort_hydr%kmax_treebg_tot @@ -2645,11 +2717,14 @@ subroutine hydraulics_bc ( nsites, sites,bc_in,bc_out,dtime ) v_node_1l((n_hypool_ag+n_hypool_troot+1) ) = ccohort_hydr%v_aroot_layer(j) v_node_1l((n_hypool_tot-nshell+1):(n_hypool_tot)) = site_hydr%v_shell(j,:) * & ccohort_hydr%l_aroot_layer(j)/bc_in(s)%dz_sisl(j) + site_hydr%kmax_bound_shell(j,1)=ccohort_hydr%kmax_innershell(j) + site_hydr%kmax_upper_shell(j,1)=ccohort_hydr%kmax_innershell(j) + site_hydr%kmax_lower_shell(j,1)=ccohort_hydr%kmax_innershell(j) kmax_bound_1l(:) = 0._r8 kmax_bound_shell_1l(:) = site_hydr%kmax_bound_shell(j,:) * & ccohort_hydr%l_aroot_layer(j) / site_hydr%l_aroot_layer(j) - + ! transporting-to-absorbing root conductance: factor of 2 means one-half of the total ! belowground resistance in layer j kmax_bound_1l((n_hypool_ag+1)) = 2._r8 * ccohort_hydr%kmax_treebg_layer(j) @@ -3408,7 +3483,7 @@ subroutine Hydraulics_1DSolve(cc_p, ft, z_node, v_node, ths_node, thr_node, kmax end if end do if(catch_nan) then - write(fates_log(),*)'EDPlantHydraulics returns nan at k = ', char(index_nan) + write(fates_log(),*)'EDPlantHydraulics returns nan at k = ', index_nan call endrun(msg=errMsg(sourcefile, __LINE__)) end if @@ -3713,7 +3788,7 @@ subroutine flc_from_psi(ft, pm, psi_node, flc_node, site_hydr, bc_in ) bc_in%bsw_sisl(1), & flc_node) case default - write(fates_log(),*) 'ERROR: invalid soil water characteristic function specified, iswc = '//char(iswc) + write(fates_log(),*) 'ERROR: invalid soil water characteristic function specified, iswc = ', iswc call endrun(msg=errMsg(sourcefile, __LINE__)) end select end if @@ -3767,7 +3842,7 @@ subroutine dflcdpsi_from_psi(ft, pm, psi_node, dflcdpsi_node, site_hydr, bc_in ) bc_in%bsw_sisl(1), & dflcdpsi_node) case default - write(fates_log(),*) 'ERROR: invalid soil water characteristic function specified, iswc = '//char(iswc) + write(fates_log(),*) 'ERROR: invalid soil water characteristic function specified, iswc = ', iswc call endrun(msg=errMsg(sourcefile, __LINE__)) end select end if @@ -3815,7 +3890,7 @@ subroutine th_from_psi(ft, pm, psi_node, th_node, site_hydr, bc_in) call psi_from_th(ft, pm, th_node, psi_check ) if(psi_check > -1.e-8_r8) then - write(fates_log(),*)'bisect_pv returned positive value for water potential at pm = ', char(pm) + write(fates_log(),*)'bisect_pv returned positive value for water potential at pm = ', pm call endrun(msg=errMsg(sourcefile, __LINE__)) end if @@ -3846,7 +3921,7 @@ subroutine th_from_psi(ft, pm, psi_node, th_node, site_hydr, bc_in) bc_in%watsat_sisl(1), & th_node) case default - write(fates_log(),*) 'invalid soil water characteristic function specified, iswc = '//char(iswc) + write(fates_log(),*) 'invalid soil water characteristic function specified, iswc = ', iswc call endrun(msg=errMsg(sourcefile, __LINE__)) end select end if @@ -3964,7 +4039,7 @@ subroutine psi_from_th(ft, pm, th_node, psi_node, site_hydr, bc_in) bc_in%bsw_sisl(1), & psi_node) case default - write(fates_log(),*) 'ERROR: invalid soil water characteristic function specified, iswc = '//char(iswc) + write(fates_log(),*) 'ERROR: invalid soil water characteristic function specified, iswc = ', iswc call endrun(msg=errMsg(sourcefile, __LINE__)) end select @@ -4015,7 +4090,7 @@ subroutine dpsidth_from_th(ft, pm, th_node, y, site_hydr, bc_in) bc_in%bsw_sisl(1), & y) case default - write(fates_log(),*) 'ERROR: invalid soil water characteristic function specified, iswc = '//char(iswc) + write(fates_log(),*) 'ERROR: invalid soil water characteristic function specified, iswc = ', iswc call endrun(msg=errMsg(sourcefile, __LINE__)) end select end if diff --git a/biogeophys/FatesPlantRespPhotosynthMod.F90 b/biogeophys/FatesPlantRespPhotosynthMod.F90 index 09840da049..4e003474a3 100644 --- a/biogeophys/FatesPlantRespPhotosynthMod.F90 +++ b/biogeophys/FatesPlantRespPhotosynthMod.F90 @@ -1,3 +1,4 @@ + module FATESPlantRespPhotosynthMod !------------------------------------------------------------------------------------- @@ -34,6 +35,7 @@ module FATESPlantRespPhotosynthMod use EDTypesMod, only : nclmax use EDTypesMod, only : max_nleafage use EDTypesMod, only : do_fates_salinity + use EDParamsMod, only : q10_mr use PRTGenericMod, only : prt_carbon_allom_hyp use PRTGenericMod, only : prt_cnp_flex_allom_hyp use PRTGenericMod, only : all_carbon_elements @@ -44,6 +46,7 @@ module FATESPlantRespPhotosynthMod use PRTGenericMod, only : store_organ use PRTGenericMod, only : repro_organ use PRTGenericMod, only : struct_organ + use EDParamsMod, only : ED_val_bbopt_c3, ED_val_bbopt_c4, ED_val_base_mr_20 ! CIME Globals use shr_log_mod , only : errMsg => shr_log_errMsg @@ -58,7 +61,7 @@ module FATESPlantRespPhotosynthMod !------------------------------------------------------------------------------------- ! maximum stomatal resistance [s/m] (used across several procedures) - real(r8),parameter :: rsmax0 = 2.e4_r8 + real(r8),parameter :: rsmax0 = 2.e8_r8 logical :: debug = .false. @@ -95,7 +98,7 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) use FatesConstantsMod, only : rgas => rgas_J_K_kmol use FatesConstantsMod, only : tfrz => t_water_freeze_k_1atm use FatesParameterDerivedMod, only : param_derived - use EDParamsMod, only : ED_val_bbopt_c3, ED_val_bbopt_c4, ED_val_base_mr_20 + use FatesAllometryMod, only : bleaf use FatesAllometryMod, only : storage_fraction_of_target use FatesAllometryMod, only : set_root_fraction @@ -206,6 +209,8 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) real(r8) :: lai_current ! the LAI in the current leaf layer real(r8) :: cumulative_lai ! the cumulative LAI, top down, to the leaf layer of interest + real(r8), allocatable :: rootfr_ft(:,:) ! Root fractions per depth and PFT + ! ----------------------------------------------------------------------------------- ! Keeping these two definitions in case they need to be added later ! @@ -244,8 +249,8 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) c3psn => EDPftvarcon_inst%c3psn , & slatop => EDPftvarcon_inst%slatop , & ! specific leaf area at top of canopy, ! projected area basis [m^2/gC] - woody => EDPftvarcon_inst%woody , & ! Is vegetation woody or not? - q10 => FatesSynchronizedParamsInst%Q10 ) + woody => EDPftvarcon_inst%woody) ! Is vegetation woody or not? + bbbopt(0) = ED_val_bbopt_c4 bbbopt(1) = ED_val_bbopt_c3 @@ -255,7 +260,21 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) ! Multi-layer parameters scaled by leaf nitrogen profile. ! Loop through each canopy layer to calculate nitrogen profile using ! cumulative lai at the midpoint of the layer - + + + + ! Pre-process some variables that are PFT dependent + ! but not environmentally dependent + ! ------------------------------------------------------------------------ + + allocate(rootfr_ft(numpft, bc_in(s)%nlevsoil)) + + do ft = 1,numpft + call set_root_fraction(rootfr_ft(ft,:), ft, & + bc_in(s)%zi_sisl,icontext = i_hydro_rootprof_context) + end do + + ifp = 0 currentpatch => sites(s)%oldest_patch do while (associated(currentpatch)) @@ -310,28 +329,9 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) gb_mol, & ! out ceair) ! out - ! Part V. Pre-process some variables that are PFT dependent - ! but not environmentally dependent - ! ------------------------------------------------------------------------ - - do ft = 1,numpft - - - - - ! This is probably unnecessary and already calculated - ! ALSO, THIS ROOTING PROFILE IS USED TO CALCULATE RESPIRATION - ! YET IT USES THE PROFILE THAT IS CONSISTENT WITH WATER UPTAKE - ! AND NOT THE PROFILE WE USE FOR DECOMPOSITION - ! SEEMS LIKE THE LATTER WOULD BE MORE APPROPRIATE, RIGHT? (RGK 05-2018) - call set_root_fraction(currentPatch%rootfr_ft(ft,1:bc_in(s)%nlevsoil), ft, & - bc_in(s)%zi_sisl,lowerb=lbound(bc_in(s)%zi_sisl,1), & - icontext = i_hydro_rootprof_context) - - end do !ft - + ! ------------------------------------------------------------------------ ! Part VI: Loop over all leaf layers. ! The concept of leaf layers is a result of the radiative transfer scheme. @@ -393,10 +393,10 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) (hlm_use_planthydro.eq.itrue) .or. & (nleafage > 1) .or. & (hlm_parteh_mode .ne. prt_carbon_allom_hyp ) ) then - - if (hlm_use_planthydro.eq.itrue ) then - - bbb = max (bbbopt(nint(c3psn(ft)))*currentCohort%co_hydr%btran(1), 1._r8) + + if (hlm_use_planthydro.eq.itrue ) then + + bbb = max( cf/rsmax0, bbbopt(nint(c3psn(ft)))*currentCohort%co_hydr%btran(1) ) btran_eff = currentCohort%co_hydr%btran(1) ! dinc_ed is the total vegetation area index of each "leaf" layer @@ -413,7 +413,7 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) else - bbb = max (bbbopt(nint(c3psn(ft)))*currentPatch%btran_ft(ft), 1._r8) + bbb = max( cf/rsmax0, bbbopt(nint(c3psn(ft)))*currentPatch%btran_ft(ft) ) btran_eff = currentPatch%btran_ft(ft) ! For consistency sake, we use total LAI here, and not exposed ! if the plant is under-snow, it will be effectively dormant for @@ -529,7 +529,7 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) currentPatch%psn_z(cl,ft,iv), & ! out rs_z(iv,ft,cl), & ! out anet_av_z(iv,ft,cl), & ! out - c13disc_z(cl,ft,iv)) ! out + c13disc_z(cl,ft,iv)) ! out rate_mask_z(iv,ft,cl) = .true. end if @@ -542,7 +542,7 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) currentCohort%rdark = 0.0_r8 currentCohort%resp_m = 0.0_r8 currentCohort%ts_net_uptake = 0.0_r8 - currentCohort%c13disc_clm = 0.0_r8 + currentCohort%c13disc_clm = 0.0_r8 ! --------------------------------------------------------------- ! Part VII: Transfer leaf flux rates (like maintenance respiration, @@ -557,7 +557,7 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) lmr_z(1:nv,ft,cl), & !in rs_z(1:nv,ft,cl), & !in currentPatch%elai_profile(cl,ft,1:nv), & !in - c13disc_z(cl, ft, 1:nv), & !in + c13disc_z(cl, ft, 1:nv), & !in currentCohort%c_area, & !in currentCohort%n, & !in bc_in(s)%rb_pa(ifp), & !in @@ -565,7 +565,7 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) currentCohort%g_sb_laweight, & !out currentCohort%gpp_tstep, & !out currentCohort%rdark, & !out - currentCohort%c13disc_clm, & !out + currentCohort%c13disc_clm, & !out cohort_eleaf_area) !out ! Net Uptake does not need to be scaled, just transfer directly @@ -638,7 +638,7 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) ! Live stem MR (kgC/plant/s) (above ground sapwood) ! ------------------------------------------------------------------ if (woody(ft) == 1) then - tcwood = q10**((bc_in(s)%t_veg_pa(ifp)-tfrz - 20.0_r8)/10.0_r8) + tcwood = q10_mr**((bc_in(s)%t_veg_pa(ifp)-tfrz - 20.0_r8)/10.0_r8) ! kgC/s = kgN * kgC/kgN/s currentCohort%livestem_mr = live_stem_n * ED_val_base_mr_20 * tcwood * maintresp_reduction_factor else @@ -650,9 +650,9 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) ! ------------------------------------------------------------------ currentCohort%froot_mr = 0._r8 do j = 1,bc_in(s)%nlevsoil - tcsoi = q10**((bc_in(s)%t_soisno_sl(j)-tfrz - 20.0_r8)/10.0_r8) + tcsoi = q10_mr**((bc_in(s)%t_soisno_sl(j)-tfrz - 20.0_r8)/10.0_r8) currentCohort%froot_mr = currentCohort%froot_mr + & - fnrt_n * ED_val_base_mr_20 * tcsoi * currentPatch%rootfr_ft(ft,j) * maintresp_reduction_factor + fnrt_n * ED_val_base_mr_20 * tcsoi * rootfr_ft(ft,j) * maintresp_reduction_factor enddo ! Coarse Root MR (kgC/plant/s) (below ground sapwood) @@ -661,10 +661,10 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) currentCohort%livecroot_mr = 0._r8 do j = 1,bc_in(s)%nlevsoil ! Soil temperature used to adjust base rate of MR - tcsoi = q10**((bc_in(s)%t_soisno_sl(j)-tfrz - 20.0_r8)/10.0_r8) + tcsoi = q10_mr**((bc_in(s)%t_soisno_sl(j)-tfrz - 20.0_r8)/10.0_r8) currentCohort%livecroot_mr = currentCohort%livecroot_mr + & live_croot_n * ED_val_base_mr_20 * tcsoi * & - currentPatch%rootfr_ft(ft,j) * maintresp_reduction_factor + rootfr_ft(ft,j) * maintresp_reduction_factor enddo else currentCohort%livecroot_mr = 0._r8 @@ -794,9 +794,11 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) currentPatch => currentPatch%younger - end do - - end do !site loop + end do + + deallocate(rootfr_ft) + + end do !site loop end associate end subroutine FatesPlantRespPhotosynthDrive @@ -831,7 +833,7 @@ subroutine LeafLayerPhotosynthesis(f_sun_lsl, & ! in psn_out, & ! out rstoma_out, & ! out anet_av_out, & ! out - c13disc_z) ! out + c13disc_z) ! out ! ------------------------------------------------------------------------------------ ! This subroutine calculates photosynthesis and stomatal conductance within each leaf @@ -843,6 +845,7 @@ subroutine LeafLayerPhotosynthesis(f_sun_lsl, & ! in ! ------------------------------------------------------------------------------------ use EDPftvarcon , only : EDPftvarcon_inst + ! Arguments ! ------------------------------------------------------------------------------------ @@ -916,11 +919,20 @@ subroutine LeafLayerPhotosynthesis(f_sun_lsl, & ! in real(r8) :: ai ! intermediate co-limited photosynthesis (umol CO2/m**2/s) real(r8) :: leaf_co2_ppress ! CO2 partial pressure at leaf surface (Pa) real(r8) :: init_co2_inter_c ! First guess intercellular co2 specific to C path + + real(r8), dimension(0:1) :: bbbopt ! Cuticular conductance at full water potential (umol H2O /m2/s) + + + ! Parameters ! ------------------------------------------------------------------------ ! Fraction of light absorbed by non-photosynthetic pigments real(r8),parameter :: fnps = 0.15_r8 + ! For plants with no leaves, a miniscule amount of conductance + ! can happen through the stems, at a partial rate of cuticular conductance + real(r8),parameter :: stem_cuticle_loss_frac = 0.1_r8 + ! empirical curvature parameter for electron transport rate real(r8),parameter :: theta_psii = 0.7_r8 @@ -939,12 +951,16 @@ subroutine LeafLayerPhotosynthesis(f_sun_lsl, & ! in ! empirical curvature parameter for ap photosynthesis co-limitation real(r8),parameter :: theta_ip = 0.999_r8 - + associate( bb_slope => EDPftvarcon_inst%BB_slope) ! slope of BB relationship + ! photosynthetic pathway: 0. = c4, 1. = c3 c3c4_path_index = nint(EDPftvarcon_inst%c3psn(ft)) + bbbopt(0) = ED_val_bbopt_c4 + bbbopt(1) = ED_val_bbopt_c3 + if (c3c4_path_index == 1) then init_co2_inter_c = init_a2l_co2_c3 * can_co2_ppress else @@ -955,22 +971,22 @@ subroutine LeafLayerPhotosynthesis(f_sun_lsl, & ! in ! ---------------------------------------------------------------------------------- if ( parsun_lsl <= 0._r8 ) then ! night time - + anet_av_out = -lmr psn_out = 0._r8 - rstoma_out = min(rsmax0, 1._r8/bbb * cf) - c13disc_z = 0.0_r8 !carbon 13 discrimination in night time carbon flux, note value of 1.0 is used in CLM + + ! The cuticular conductance already factored in maximum resistance as a bound + ! no need to re-bound it + + rstoma_out = cf/bbb + + c13disc_z = 0.0_r8 !carbon 13 discrimination in night time carbon flux, note value of 1.0 is used in CLM else ! day time (a little bit more complicated ...) -! if ( debug ) write(fates_log(),*) 'EDphot 594 ',laisun_lsl -! if ( debug ) write(fates_log(),*) 'EDphot 595 ',laisha_lsl + !is there leaf area? - (NV can be larger than 0 with only stem area if deciduous) + if ( laisun_lsl + laisha_lsl > 0._r8 ) then - !is there leaf area? - (NV can be larger than 0 with only stem area if deciduous) - if ( laisun_lsl + laisha_lsl > 0._r8 ) then - -! if ( debug ) write(fates_log(),*) '600 in laisun, laisha loop ' - !Loop aroun shaded and unshaded leaves psn_out = 0._r8 ! psn is accumulated across sun and shaded leaves. rstoma_out = 0._r8 ! 1/rs is accumulated across sun and shaded leaves. @@ -1120,19 +1136,16 @@ subroutine LeafLayerPhotosynthesis(f_sun_lsl, & ! in ! Convert gs_mol (umol /m**2/s) to gs (m/s) and then to rs (s/m) gs = gs_mol / cf - ! estimate carbon 13 discrimination in leaf level carbon flux Liang WEI and Hang ZHOU 2018, based on + ! estimate carbon 13 discrimination in leaf level carbon + ! flux Liang WEI and Hang ZHOU 2018, based on ! Ubierna and Farquhar, 2014 doi:10.1111/pce.12346, using the simplified model: ! $\Delta ^{13} C = \alpha_s + (b - \alpha_s) \cdot \frac{C_i}{C_a}$ ! just hard code b and \alpha_s for now, might move to parameter set in future ! b = 27.0 alpha_s = 4.4 ! TODO, not considering C4 or CAM right now, may need to address this - ! note co2_inter_c is intracelluar CO2, not intercelluar - c13disc_z = 4.4_r8 + (27.0_r8 - 4.4_r8) * min (can_co2_ppress, max (co2_inter_c, 0._r8)) / can_co2_ppress - - -! if ( debug ) write(fates_log(),*) 'EDPhoto 737 ', psn_out -! if ( debug ) write(fates_log(),*) 'EDPhoto 738 ', agross -! if ( debug ) write(fates_log(),*) 'EDPhoto 739 ', f_sun_lsl + ! note co2_inter_c is intracelluar CO2, not intercelluar + c13disc_z = 4.4_r8 + (27.0_r8 - 4.4_r8) * & + min (can_co2_ppress, max (co2_inter_c, 0._r8)) / can_co2_ppress ! Accumulate total photosynthesis umol/m2 ground/s-1. ! weight per unit sun and sha leaves. @@ -1146,10 +1159,6 @@ subroutine LeafLayerPhotosynthesis(f_sun_lsl, & ! in gstoma = gstoma + & 1._r8/(min(1._r8/gs, rsmax0)) * (1.0_r8-f_sun_lsl) end if - -! if ( debug ) write(fates_log(),*) 'EDPhoto 758 ', psn_out -! if ( debug ) write(fates_log(),*) 'EDPhoto 759 ', agross -! if ( debug ) write(fates_log(),*) 'EDPhoto 760 ', f_sun_lsl ! Make sure iterative solution is correct if (gs_mol < 0._r8) then @@ -1171,19 +1180,25 @@ subroutine LeafLayerPhotosynthesis(f_sun_lsl, & ! in ! This is the stomatal resistance of the leaf layer rstoma_out = 1._r8/gstoma - + else - !No leaf area. This layer is present only because of stems. + + ! No leaf area. This layer is present only because of stems. + ! Net assimilation is zero, not negative because there are + ! no leaves to even respire ! (leaves are off, or have reduced to 0) - psn_out = 0._r8 - rstoma_out = min(rsmax0, 1._r8/bbb * cf) - c13disc_z = 0.0_r8 + psn_out = 0._r8 + anet_av_out = 0._r8 + rstoma_out = min(rsmax0, cf/(stem_cuticle_loss_frac*bbbopt(c3c4_path_index))) + c13disc_z = 0.0_r8 - end if !is there leaf area? + end if !is there leaf area? end if ! night or day + + end associate return end subroutine LeafLayerPhotosynthesis diff --git a/fire/SFMainMod.F90 b/fire/SFMainMod.F90 index 505437634d..c015db7131 100644 --- a/fire/SFMainMod.F90 +++ b/fire/SFMainMod.F90 @@ -15,6 +15,7 @@ module SFMainMod use EDPftvarcon , only : EDPftvarcon_inst + use EDTypesMod , only : element_pos use EDtypesMod , only : ed_site_type use EDtypesMod , only : ed_patch_type use EDtypesMod , only : ed_cohort_type @@ -24,11 +25,13 @@ module SFMainMod use EDTypesMod , only : TW_SF use EDtypesMod , only : LB_SF use EDtypesMod , only : LG_SF - use EDtypesMod , only : NCWD + use FatesLitterMod , only : ncwd use EDtypesMod , only : NFSC use EDtypesMod , only : TR_SF + use FatesLitterMod , only : litter_type 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 @@ -37,7 +40,7 @@ module SFMainMod use PRTGenericMod, only : repro_organ use PRTGenericMod, only : struct_organ use PRTGenericMod, only : SetState - + use FatesInterfaceMod , only : numpft implicit none private @@ -47,9 +50,8 @@ module SFMainMod public :: charecteristics_of_fuel public :: rate_of_spread public :: ground_fuel_consumption - public :: fire_intensity public :: wind_effect - public :: area_burnt + public :: area_burnt_intensity public :: crown_scorching public :: crown_damage public :: cambial_damage_kill @@ -80,7 +82,6 @@ subroutine fire_model( currentSite, bc_in) currentPatch => currentSite%youngest_patch do while(associated(currentPatch)) currentPatch%frac_burnt = 0.0_r8 - currentPatch%AB = 0.0_r8 currentPatch%fire = 0 currentPatch => currentPatch%older enddo @@ -95,8 +96,7 @@ subroutine fire_model( currentSite, bc_in) call charecteristics_of_fuel(currentSite) call rate_of_spread(currentSite) call ground_fuel_consumption(currentSite) - call fire_intensity(currentSite) - call area_burnt(currentSite) + call area_burnt_intensity(currentSite) call crown_scorching(currentSite) call crown_damage(currentSite) call cambial_damage_kill(currentSite) @@ -118,14 +118,14 @@ subroutine fire_danger_index ( currentSite, bc_in) type(ed_site_type) , intent(inout), target :: currentSite type(bc_in_type) , intent(in) :: bc_in - real(r8) :: temp_in_C ! daily averaged temperature in celcius - real(r8) :: rainfall ! daily precip in mm/day - real(r8) :: rh ! daily rh + real(r8) :: temp_in_C ! daily averaged temperature in celcius + real(r8) :: rainfall ! daily precip in mm/day + real(r8) :: rh ! daily rh - real yipsolon; !intermediate varable for dewpoint calculation - real dewpoint; !dewpoint in K - real d_NI; !daily change in Nesterov Index. C^2 - integer :: iofp ! index of oldest the fates patch + real(r8) :: yipsolon !intermediate varable for dewpoint calculation + real(r8) :: dewpoint !dewpoint in K + real(r8) :: d_NI !daily change in Nesterov Index. C^2 + integer :: iofp ! index of oldest the fates patch ! NOTE that the boundary conditions of temperature, precipitation and relative humidity ! are available at the patch level. We are currently using a simplification where the whole site @@ -149,7 +149,7 @@ subroutine fire_danger_index ( currentSite, bc_in) d_NI = 0.0_r8 !check endif endif - currentSite%acc_NI = currentSite%acc_NI + d_NI !Accumulate Nesterov index over the fire season. + currentSite%acc_NI = currentSite%acc_NI + d_NI !Accumulate Nesterov index over the fire season. end subroutine fire_danger_index @@ -164,16 +164,21 @@ subroutine charecteristics_of_fuel ( currentSite ) type(ed_patch_type), pointer :: currentPatch type(ed_cohort_type), pointer :: currentCohort + type(litter_type), pointer :: litt_c - real(r8) timeav_swc real(r8) alpha_FMC(nfsc) ! Relative fuel moisture adjusted per drying ratio real(r8) fuel_moisture(nfsc) ! Scaled moisture content of small litter fuels. real(r8) MEF(nfsc) ! Moisture extinction factor of fuels integer n fuel_moisture(:) = 0.0_r8 + + currentPatch => currentSite%oldest_patch; do while(associated(currentPatch)) + + litt_c => currentPatch%litter(element_pos(carbon12_element)) + ! How much live grass is there? currentPatch%livegrass = 0.0_r8 currentCohort => currentPatch%tallest @@ -189,13 +194,13 @@ subroutine charecteristics_of_fuel ( currentSite ) enddo ! There are SIX fuel classes - ! 1) Leaf litter, 2:5) four CWD_AG pools (twig, s branch, l branch, trunk) and 6) live grass + ! 1:4) four CWD_AG pools (twig, s branch, l branch, trunk), 5) dead leaves and 6) live grass ! NCWD =4 NFSC = 6 - ! dl_sf = 1, tw_sf = 2, lb_sf = 4, tr_sf = 5, lg_sf = 6, + ! tw_sf = 1, lb_sf = 3, tr_sf = 4, dl_sf = 5, lg_sf = 6, - ! zero fire arrays. + ! zero fire arrays. currentPatch%fuel_eff_moist = 0.0_r8 - currentPatch%fuel_bulkd = 0.0_r8 !this is kgBiomass/m2 for use in rate of spread equations + currentPatch%fuel_bulkd = 0.0_r8 !this is kgBiomass/m3 for use in rate of spread equations currentPatch%fuel_sav = 0.0_r8 currentPatch%fuel_frac(:) = 0.0_r8 currentPatch%fuel_mef = 0.0_r8 @@ -203,13 +208,15 @@ subroutine charecteristics_of_fuel ( currentSite ) currentPatch%fuel_frac = 0.0_r8 if(write_sf == itrue)then - if ( hlm_masterproc == itrue ) write(fates_log(),*) ' leaf_litter1 ',currentPatch%leaf_litter - if ( hlm_masterproc == itrue ) write(fates_log(),*) ' leaf_litter2 ',sum(currentPatch%CWD_AG) + if ( hlm_masterproc == itrue ) write(fates_log(),*) ' leaf_litter1 ',sum(litt_c%leaf_fines(:)) + if ( hlm_masterproc == itrue ) write(fates_log(),*) ' leaf_litter2 ',sum(litt_c%ag_cwd(:)) if ( hlm_masterproc == itrue ) write(fates_log(),*) ' leaf_litter3 ',currentPatch%livegrass if ( hlm_masterproc == itrue ) write(fates_log(),*) ' sum fuel', currentPatch%sum_fuel endif - currentPatch%sum_fuel = sum(currentPatch%leaf_litter) + sum(currentPatch%CWD_AG) + currentPatch%livegrass + currentPatch%sum_fuel = sum(litt_c%leaf_fines(:)) + & + sum(litt_c%ag_cwd(:)) + & + currentPatch%livegrass if(write_SF == itrue)then if ( hlm_masterproc == itrue ) write(fates_log(),*) 'sum fuel', currentPatch%sum_fuel,currentPatch%area endif @@ -219,8 +226,8 @@ subroutine charecteristics_of_fuel ( currentSite ) if (currentPatch%sum_fuel > 0.0) then ! Fraction of fuel in litter classes - currentPatch%fuel_frac(dl_sf) = sum(currentPatch%leaf_litter)/ currentPatch%sum_fuel - currentPatch%fuel_frac(tw_sf:tr_sf) = currentPatch%CWD_AG / currentPatch%sum_fuel + currentPatch%fuel_frac(dl_sf) = sum(litt_c%leaf_fines(:))/ currentPatch%sum_fuel + currentPatch%fuel_frac(tw_sf:tr_sf) = litt_c%ag_cwd(:) / currentPatch%sum_fuel if(write_sf == itrue)then if ( hlm_masterproc == itrue ) write(fates_log(),*) 'ff1 ',currentPatch%fuel_frac @@ -230,15 +237,15 @@ subroutine charecteristics_of_fuel ( currentSite ) endif currentPatch%fuel_frac(lg_sf) = currentPatch%livegrass / currentPatch%sum_fuel - MEF(1:nfsc) = 0.524_r8 - 0.066_r8 * log10(SF_val_SAV(1:nfsc)) + MEF(1:nfsc) = 0.524_r8 - 0.066_r8 * log10(SF_val_SAV(1:nfsc)) !--- weighted average of relative moisture content--- - ! Equation 6 in Thonicke et al. 2010. across leaves,twig, small branch, and large branch + ! Equation 6 in Thonicke et al. 2010. across twig, small branch, large branch, and dead leaves ! dead leaves and twigs included in 1hr pool per Thonicke (2010) ! Calculate fuel moisture for trunks to hold value for fuel consumption - alpha_FMC(dl_sf:tr_sf) = SF_val_SAV(dl_sf:tr_sf)/SF_val_drying_ratio + alpha_FMC(tw_sf:dl_sf) = SF_val_SAV(tw_sf:dl_sf)/SF_val_drying_ratio - fuel_moisture(dl_sf:tr_sf) = exp(-1.0_r8 * alpha_FMC(dl_sf:tr_sf) * currentSite%acc_NI) + fuel_moisture(tw_sf:dl_sf) = exp(-1.0_r8 * alpha_FMC(tw_sf:dl_sf) * currentSite%acc_NI) if(write_SF == itrue)then if ( hlm_masterproc == itrue ) write(fates_log(),*) 'ff3 ',currentPatch%fuel_frac @@ -246,26 +253,25 @@ subroutine charecteristics_of_fuel ( currentSite ) if ( hlm_masterproc == itrue ) write(fates_log(),*) 'csa ',currentSite%acc_NI if ( hlm_masterproc == itrue ) write(fates_log(),*) 'sfv ',alpha_FMC endif - ! FIX(RF,032414): needs refactoring. - ! average water content !is this the correct metric? - timeav_swc = sum(currentSite%water_memory(1:numWaterMem)) / real(numWaterMem,r8) - ! Equation B2 in Thonicke et al. 2010 - ! live grass moisture content depends on upper soil layer - fuel_moisture(lg_sf) = max(0.0_r8, 10.0_r8/9._r8 * timeav_swc - 1.0_r8/9.0_r8) + + ! live grass moisture is a function of SAV and changes via Nesterov Index + ! along the same relationship as the 1 hour fuels (live grass has same SAV as dead grass, + ! but retains more moisture with this calculation.) + fuel_moisture(lg_sf) = exp(-1.0_r8 * ((SF_val_SAV(tw_sf)/SF_val_drying_ratio) * currentSite%acc_NI)) - ! Average properties over the first four litter pools (dead leaves, twigs, s branches, l branches) - currentPatch%fuel_bulkd = sum(currentPatch%fuel_frac(dl_sf:lb_sf) * SF_val_FBD(dl_sf:lb_sf)) - currentPatch%fuel_sav = sum(currentPatch%fuel_frac(dl_sf:lb_sf) * SF_val_SAV(dl_sf:lb_sf)) - currentPatch%fuel_mef = sum(currentPatch%fuel_frac(dl_sf:lb_sf) * MEF(dl_sf:lb_sf)) - currentPatch%fuel_eff_moist = sum(currentPatch%fuel_frac(dl_sf:lb_sf) * fuel_moisture(dl_sf:lb_sf)) + ! Average properties over the first three litter pools (twigs, s branches, l branches) + currentPatch%fuel_bulkd = sum(currentPatch%fuel_frac(tw_sf:lb_sf) * SF_val_FBD(tw_sf:lb_sf)) + currentPatch%fuel_sav = sum(currentPatch%fuel_frac(tw_sf:lb_sf) * SF_val_SAV(tw_sf:lb_sf)) + currentPatch%fuel_mef = sum(currentPatch%fuel_frac(tw_sf:lb_sf) * MEF(tw_sf:lb_sf)) + currentPatch%fuel_eff_moist = sum(currentPatch%fuel_frac(tw_sf:lb_sf) * fuel_moisture(tw_sf:lb_sf)) if(write_sf == itrue)then if ( hlm_masterproc == itrue ) write(fates_log(),*) 'ff4 ',currentPatch%fuel_eff_moist endif - ! Add on properties of live grass multiplied by grass fraction. (6) - currentPatch%fuel_bulkd = currentPatch%fuel_bulkd + currentPatch%fuel_frac(lg_sf) * SF_val_FBD(lg_sf) - currentPatch%fuel_sav = currentPatch%fuel_sav + currentPatch%fuel_frac(lg_sf) * SF_val_SAV(lg_sf) - currentPatch%fuel_mef = currentPatch%fuel_mef + currentPatch%fuel_frac(lg_sf) * MEF(lg_sf) - currentPatch%fuel_eff_moist = currentPatch%fuel_eff_moist + currentPatch%fuel_frac(lg_sf) * fuel_moisture(lg_sf) + ! Add on properties of dead leaves and live grass pools (5 & 6) + currentPatch%fuel_bulkd = currentPatch%fuel_bulkd + sum(currentPatch%fuel_frac(dl_sf:lg_sf) * SF_val_FBD(dl_sf:lg_sf)) + currentPatch%fuel_sav = currentPatch%fuel_sav + sum(currentPatch%fuel_frac(dl_sf:lg_sf) * SF_val_SAV(dl_sf:lg_sf)) + currentPatch%fuel_mef = currentPatch%fuel_mef + sum(currentPatch%fuel_frac(dl_sf:lg_sf) * MEF(dl_sf:lg_sf)) + currentPatch%fuel_eff_moist = currentPatch%fuel_eff_moist+ sum(currentPatch%fuel_frac(dl_sf:lg_sf) * fuel_moisture(dl_sf:lg_sf)) ! Correct averaging for the fact that we are not using the trunks pool for fire ROS and intensity (5) ! Consumption of fuel in trunk pool does not influence fire ROS or intensity (Pyne 1996) @@ -274,19 +280,19 @@ subroutine charecteristics_of_fuel ( currentSite ) currentPatch%fuel_mef = currentPatch%fuel_mef * (1.0_r8/(1.0_r8-currentPatch%fuel_frac(tr_sf))) currentPatch%fuel_eff_moist = currentPatch%fuel_eff_moist * (1.0_r8/(1.0_r8-currentPatch%fuel_frac(tr_sf))) - ! Pass litter moisture into the fuel burning routine + ! Pass litter moisture into the fuel burning routine (all fuels: twigs,s branch,l branch,trunk,dead leaves,live grass) ! (wo/me term in Thonicke et al. 2010) - currentPatch%litter_moisture(dl_sf:lb_sf) = fuel_moisture(dl_sf:lb_sf)/MEF(dl_sf:lb_sf) + currentPatch%litter_moisture(tw_sf:lb_sf) = fuel_moisture(tw_sf:lb_sf)/MEF(tw_sf:lb_sf) currentPatch%litter_moisture(tr_sf) = fuel_moisture(tr_sf)/MEF(tr_sf) - currentPatch%litter_moisture(lg_sf) = fuel_moisture(lg_sf)/MEF(lg_sf) - + currentPatch%litter_moisture(dl_sf) = fuel_moisture(dl_sf)/MEF(dl_sf) + currentPatch%litter_moisture(lg_sf) = fuel_moisture(lg_sf)/MEF(lg_sf) + else if(write_SF == itrue)then if ( hlm_masterproc == itrue ) write(fates_log(),*) 'no litter fuel at all',currentPatch%patchno, & - currentPatch%sum_fuel,sum(currentPatch%cwd_ag), & - sum(currentPatch%cwd_bg),sum(currentPatch%leaf_litter) + currentPatch%sum_fuel,sum(litt_c%ag_cwd(:)),sum(litt_c%leaf_fines(:)) endif currentPatch%fuel_sav = sum(SF_val_SAV(1:nfsc))/(nfsc) ! make average sav to avoid crashing code. @@ -334,8 +340,8 @@ subroutine wind_effect ( currentSite, bc_in) type(ed_cohort_type), pointer :: currentCohort real(r8) :: total_grass_area ! per patch,in m2 - real(r8) :: tree_fraction ! site level. no units - real(r8) :: grass_fraction ! site level. no units + real(r8) :: tree_fraction ! site level. no units + real(r8) :: grass_fraction ! site level. no units real(r8) :: bare_fraction ! site level. no units integer :: iofp ! index of oldest fates patch @@ -430,7 +436,8 @@ subroutine rate_of_spread ( currentSite ) real(r8) a_beta ! dummy variable for product of a* beta_ratio for react_v_opt equation real(r8) a,b,c,e ! function of fuel sav - logical,parameter :: debug_windspeed = .false. !for debugging + logical, parameter :: debug_windspeed = .false. !for debugging + real(r8),parameter :: q_dry = 581.0_r8 !heat of pre-ignition of dry fuels (kJ/kg) currentPatch=>currentSite%oldest_patch; @@ -470,9 +477,10 @@ subroutine rate_of_spread ( currentSite ) ! ---heat of pre-ignition--- ! Equation A4 in Thonicke et al. 2010 - ! conversion of Rohtermal (1972) equation 12 in BTU/lb to current kJ/kg + ! Rothermal EQ12= 250 Btu/lb + 1116 Btu/lb * fuel_eff_moist + ! conversion of Rothermal (1972) EQ12 in BTU/lb to current kJ/kg ! q_ig in kJ/kg - q_ig = 581.0_r8 +2594.0_r8 * currentPatch%fuel_eff_moist + q_ig = q_dry +2594.0_r8 * currentPatch%fuel_eff_moist ! ---effective heating number--- ! Equation A3 in Thonicke et al. 2010. @@ -566,12 +574,12 @@ subroutine ground_fuel_consumption ( currentSite ) SF_val_mid_moisture_Coeff, SF_val_mid_moisture_Slope type(ed_site_type) , intent(in), target :: currentSite - type(ed_patch_type), pointer :: currentPatch - - real(r8) :: moist !effective fuel moisture + type(litter_type), pointer :: litt_c ! carbon 12 litter pool + + real(r8) :: moist !effective fuel moisture real(r8) :: tau_b(nfsc) !lethal heating rates for each fuel class (min) - real(r8) :: fc_ground(nfsc) !propn of fuel consumed + real(r8) :: fc_ground(nfsc) !proportion of fuel consumed integer :: c @@ -611,8 +619,10 @@ subroutine ground_fuel_consumption ( currentSite ) currentPatch%burnt_frac_litter = currentPatch%burnt_frac_litter * (1.0_r8-SF_val_miner_total) !---Calculate amount of fuel burnt.--- - FC_ground(dl_sf) = currentPatch%burnt_frac_litter(dl_sf) * sum(currentPatch%leaf_litter) - FC_ground(tw_sf:tr_sf) = currentPatch%burnt_frac_litter(tw_sf:tr_sf) * currentPatch%CWD_AG + + litt_c => currentPatch%litter(element_pos(carbon12_element)) + FC_ground(tw_sf:tr_sf) = currentPatch%burnt_frac_litter(tw_sf:tr_sf) * litt_c%ag_cwd(tw_sf:tr_sf) + FC_ground(dl_sf) = currentPatch%burnt_frac_litter(dl_sf) * sum(litt_c%leaf_fines(:)) FC_ground(lg_sf) = currentPatch%burnt_frac_litter(lg_sf) * currentPatch%livegrass ! Following used for determination of cambial kill follows from Peterson & Ryan (1986) scheme @@ -639,99 +649,75 @@ subroutine ground_fuel_consumption ( currentSite ) end subroutine ground_fuel_consumption + !***************************************************************** - subroutine fire_intensity ( currentSite ) - !***************************************************************** + subroutine area_burnt_intensity ( currentSite ) + !***************************************************************** + !returns the updated currentPatch%FI value for each patch. - !currentPatch%FI average fire intensity of flaming front during day. Backward ROS plays no role here. kJ/m/s or kW/m. + !currentPatch%FI avg fire intensity of flaming front during day. Backward ROS plays no role here. kJ/m/s or kW/m. !currentSite%FDI probability that an ignition will start a fire + !currentSite%NF number of lighting strikes per day per km2 !currentPatch%ROS_front forward ROS (m/min) !currentPatch%TFC_ROS total fuel consumed by flaming front (kgC/m2) use FatesInterfaceMod, only : hlm_use_spitfire - use SFParamsMod, only : SF_val_fdi_alpha,SF_val_fuel_energy, & + use EDParamsMod, only : ED_val_nignitions + use EDParamsMod, only : cg_strikes ! fraction of cloud-to-ground ligtning strikes + use FatesConstantsMod, only : years_per_day + use SFParamsMod, only : SF_val_fdi_alpha,SF_val_fuel_energy, & SF_val_max_durat, SF_val_durat_slope - + type(ed_site_type), intent(inout), target :: currentSite - type(ed_patch_type), pointer :: currentPatch real(r8) ROS !m/s real(r8) W !kgBiomass/m2 + real(r8) lb !length to breadth ratio of fire ellipse (unitless) + real(r8) df !distance fire has travelled forward in m + real(r8) db !distance fire has travelled backward in m + real(r8) AB !daily area burnt in m2 per km2 + + real(r8) size_of_fire !in m2 + real(r8),parameter :: km2_to_m2 = 1000000.0_r8 !area conversion for square km to square m - currentPatch => currentSite%oldest_patch; + ! ---initialize site parameters to zero--- + currentSite%frac_burnt = 0.0_r8 + + + ! Equation 7 from Venevsky et al GCB 2002 (modification of equation 8 in Thonicke et al. 2010) + ! FDI 0.1 = low, 0.3 moderate, 0.75 high, and 1 = extreme ignition potential for alpha 0.000337 + currentSite%FDI = 1.0_r8 - exp(-SF_val_fdi_alpha*currentSite%acc_NI) + + !NF = number of lighting strikes per day per km2 scaled by cloud to ground strikes + currentSite%NF = ED_val_nignitions * years_per_day * cg_strikes + + ! If there are 15 lightning strikes per year, per km2. (approx from NASA product for S.A.) + ! then there are 15 * 1/365 strikes/km2 each day + + currentPatch => currentSite%oldest_patch; do while(associated(currentPatch)) - ROS = currentPatch%ROS_front / 60.0_r8 !m/min to m/sec - W = currentPatch%TFC_ROS / 0.45_r8 !kgC/m2 to kgbiomass/m2 - currentPatch%FI = SF_val_fuel_energy * W * ROS !kj/m/s, or kW/m - if(write_sf == itrue)then - if( hlm_masterproc == itrue ) write(fates_log(),*) 'fire_intensity',currentPatch%fi,W,currentPatch%ROS_front - endif - !'decide_fire' subroutine shortened and put in here... - if (currentPatch%FI >= fire_threshold) then ! 50kW/m is the threshold for a self-sustaining fire - currentPatch%fire = 1 ! Fire... :D + ! ---initialize patch parameters to zero--- + currentPatch%fire = 0 + currentPatch%FD = 0.0_r8 + currentPatch%frac_burnt = 0.0_r8 + + + if (currentSite%NF > 0.0_r8) then - ! Equation 7 from Venevsky et al GCB 2002 (modification of equation 8 in Thonicke et al. 2010) - ! FDI 0.1 = low, 0.3 moderate, 0.75 high, and 1 = extreme ignition potential for alpha 0.000337 - currentSite%FDI = 1.0_r8 - exp(-SF_val_fdi_alpha*currentSite%acc_NI) ! Equation 14 in Thonicke et al. 2010 ! fire duration in minutes - currentPatch%FD = (SF_val_max_durat+1.0_r8) / (1.0_r8 + SF_val_max_durat * & exp(SF_val_durat_slope*currentSite%FDI)) - if(write_SF == itrue)then if ( hlm_masterproc == itrue ) write(fates_log(),*) 'fire duration minutes',currentPatch%fd endif !equation 15 in Arora and Boer CTEM model.Average fire is 1 day long. - !currentPatch%FD = 60.0_r8 * 24.0_r8 !no minutes in a day - else - currentPatch%fire = 0 ! No fire... :-/ - currentPatch%FD = 0.0_r8 - endif - ! FIX(SPM,032414) needs a refactor - ! FIX(RF,032414) : should happen outside of SF loop - doing all spitfire code is inefficient otherwise. - if( hlm_use_spitfire == ifalse )then - currentPatch%fire = 0 !fudge to turn fire off - endif - - currentPatch => currentPatch%younger; - enddo !end patch loop - - end subroutine fire_intensity - - - !***************************************************************** - subroutine area_burnt ( currentSite ) - !***************************************************************** - !currentPatch%AB !daily area burnt (m2) - !currentPatch%NF !Daily number of ignitions (lightning and human-caused), adjusted for size of patch. - - use EDParamsMod, only : ED_val_nignitions - - type(ed_site_type), intent(inout), target :: currentSite - type(ed_patch_type), pointer :: currentPatch - - real lb !length to breadth ratio of fire ellipse - real df !distance fire has travelled forward - real db !distance fire has travelled backward - real patch_area_in_m2 !'actual' patch area as applied to whole grid cell - real(r8) gridarea - real(r8) size_of_fire !in m2 - real(r8),parameter :: km2_to_m2 = 1000000.0_r8 !area conversion for square km to square m - integer g, p - - currentSite%frac_burnt = 0.0_r8 - - currentPatch => currentSite%oldest_patch; - do while(associated(currentPatch)) - currentPatch%AB = 0.0_r8 - currentPatch%frac_burnt = 0.0_r8 - lb = 0.0_r8; db = 0.0_r8; df = 0.0_r8 + !currentPatch%FD = 60.0_r8 * 24.0_r8 !no minutes in a day - if (currentPatch%fire == 1) then + ! The feedback between vegetation structure and ellipse size if turned off for now, ! to reduce the positive feedback in the syste, ! This will also be investigated by William Hoffmans proposal. @@ -754,127 +740,118 @@ subroutine area_burnt ( currentSite ) ! --- calculate area burnt--- if(lb > 0.0_r8) then - - ! INTERF-TODO: - ! THIS SHOULD HAVE THE COLUMN AND LU AREA WEIGHT ALSO, NO? - - gridarea = km2_to_m2 ! 1M m2 in a km2 - - ! NF = number of lighting strikes per day per km2 - currentPatch%NF = ED_val_nignitions * currentPatch%area/area /365 - - ! If there are 15 lightening strickes per year, per km2. (approx from NASA product) - ! then there are 15/365 s/km2 each day. ! Equation 1 in Thonicke et al. 2010 ! To Do: Connect here with the Li & Levis GDP fire suppression algorithm. ! Equation 16 in arora and boer model JGR 2005 - !currentPatch%AB = currentPatch%AB *3.0_r8 + ! AB = AB *3.0_r8 !size of fire = equation 14 Arora and Boer JGR 2005 size_of_fire = ((3.1416_r8/(4.0_r8*lb))*((df+db)**2.0_r8)) - !AB = daily area burnt = size fires in m2 * num ignitions * prob ignition starts fire - ! m2 per km2 per day - currentPatch%AB = size_of_fire * currentPatch%NF * currentSite%FDI - - patch_area_in_m2 = gridarea *currentPatch%area/area + !AB = daily area burnt = size fires in m2 * num ignitions per day per km2 * prob ignition starts fire + !AB = m2 per km2 per day + AB = size_of_fire * currentSite%NF * currentSite%FDI + + !frac_burnt + currentPatch%frac_burnt = (min(0.99_r8, AB / km2_to_m2)) * currentPatch%area/area - currentPatch%frac_burnt = currentPatch%AB / patch_area_in_m2 if(write_SF == itrue)then if ( hlm_masterproc == itrue ) write(fates_log(),*) 'frac_burnt',currentPatch%frac_burnt endif - if (currentPatch%frac_burnt > 1.0_r8 ) then !all of patch burnt. - - currentPatch%frac_burnt = 1.0_r8 ! capping at 1 same as %AB/patch_area_in_m2 + endif ! lb - if ( hlm_masterproc == itrue ) write(fates_log(),*) 'burnt all of patch',currentPatch%patchno - if ( hlm_masterproc == itrue ) write(fates_log(),*) 'ros',currentPatch%ROS_front,currentPatch%FD, & - currentPatch%NF,currentPatch%FI,size_of_fire + ROS = currentPatch%ROS_front / 60.0_r8 !m/min to m/sec + W = currentPatch%TFC_ROS / 0.45_r8 !kgC/m2 to kgbiomass/m2 - endif + ! EQ 15 Thonicke et al 2010 + !units of fire intensity = (kJ/kg)*(kgBiomass/m2)*(m/min)*unitless_fraction + currentPatch%FI = SF_val_fuel_energy * W * ROS * currentPatch%frac_burnt !kj/m/s, or kW/m + + if(write_sf == itrue)then + if( hlm_masterproc == itrue ) write(fates_log(),*) 'fire_intensity',currentPatch%fi,W,currentPatch%ROS_front + endif + !'decide_fire' subroutine + if (currentPatch%FI > fire_threshold) then !track fires greater than kW/m2 energy threshold + currentPatch%fire = 1 ! Fire... :D + + else + currentPatch%fire = 0 ! No fire... :-/ + currentPatch%FD = 0.0_r8 + currentPatch%frac_burnt = 0.0_r8 + endif + + endif! NF ignitions check - endif - endif! fire - currentSite%frac_burnt = currentSite%frac_burnt + currentPatch%frac_burnt * currentPatch%area/area + + ! accumulate frac_burnt % at site level + currentSite%frac_burnt = currentSite%frac_burnt + currentPatch%frac_burnt currentPatch => currentPatch%younger enddo !end patch loop - end subroutine area_burnt + end subroutine area_burnt_intensity + + !***************************************************************** subroutine crown_scorching ( currentSite ) !***************************************************************** - !currentPatch%SH !average scorch height for the patch(m) - !currentPatch%FI average fire intensity of flaming front during day. kW/m. + + !currentPatch%FI average fire intensity of flaming front during day. kW/m. + !currentPatch%SH(pft) scorch height for all cohorts of a given PFT on a given patch (m) type(ed_site_type), intent(in), target :: currentSite - type(ed_patch_type), pointer :: currentPatch + type(ed_patch_type), pointer :: currentPatch type(ed_cohort_type), pointer :: currentCohort - real(r8) :: f_ag_bmass !fraction of a tree cohort's above-ground biomass as a proportion of total patch ag tree biomass. - real(r8) :: tree_ag_biomass !total amount of above-ground tree biomass in patch. kgC/m2 - real(r8) :: leaf_c ! leaf carbon [kg] - real(r8) :: sapw_c ! sapwood carbon [kg] - real(r8) :: struct_c ! structure carbon [kg] + real(r8) :: tree_ag_biomass ! total amount of above-ground tree biomass in patch. kgC/m2 + real(r8) :: leaf_c ! leaf carbon [kg] + real(r8) :: sapw_c ! sapwood carbon [kg] + real(r8) :: struct_c ! structure carbon [kg] + + integer :: i_pft currentPatch => currentSite%oldest_patch; do while(associated(currentPatch)) - + tree_ag_biomass = 0.0_r8 - f_ag_bmass = 0.0_r8 if (currentPatch%fire == 1) then currentCohort => currentPatch%tallest; do while(associated(currentCohort)) if (EDPftvarcon_inst%woody(currentCohort%pft) == 1) then !trees only - + leaf_c = currentCohort%prt%GetState(leaf_organ, all_carbon_elements) sapw_c = currentCohort%prt%GetState(sapw_organ, all_carbon_elements) struct_c = currentCohort%prt%GetState(struct_organ, all_carbon_elements) - + tree_ag_biomass = tree_ag_biomass + & - currentCohort%n * (leaf_c + & - EDPftvarcon_inst%allom_agb_frac(currentCohort%pft)*(sapw_c + struct_c)) + currentCohort%n * (leaf_c + & + EDPftvarcon_inst%allom_agb_frac(currentCohort%pft)*(sapw_c + struct_c)) + endif !trees only - currentCohort=>currentCohort%shorter; - enddo !end cohort loop - !This loop weights the scorch height for the contribution of each cohort to the overall biomass. - - ! does this do anything? I think it might be redundant? RF. - currentPatch%SH = 0.0_r8 - currentCohort => currentPatch%tallest; - do while(associated(currentCohort)) - if (EDPftvarcon_inst%woody(currentCohort%pft) == 1 & - .and. (tree_ag_biomass > 0.0_r8)) then !trees only - - leaf_c = currentCohort%prt%GetState(leaf_organ, all_carbon_elements) - sapw_c = currentCohort%prt%GetState(sapw_organ, all_carbon_elements) - struct_c = currentCohort%prt%GetState(struct_organ, all_carbon_elements) + do i_pft=1,numpft + if (tree_ag_biomass > 0.0_r8 .and. EDPftvarcon_inst%woody(i_pft) == 1) then + + !Equation 16 in Thonicke et al. 2010 !Van Wagner 1973 EQ8 !2/3 Byram (1959) + currentPatch%Scorch_ht(i_pft) = EDPftvarcon_inst%fire_alpha_SH(i_pft) * (currentPatch%FI**0.667_r8) - f_ag_bmass = currentCohort%n * (leaf_c + & - EDPftvarcon_inst%allom_agb_frac(currentCohort%pft)*(sapw_c + struct_c)) & - / tree_ag_biomass - - !equation 16 in Thonicke et al. 2010 if(write_SF == itrue)then - if ( hlm_masterproc == itrue ) write(fates_log(),*) 'currentPatch%SH',currentPatch%SH,f_ag_bmass + if ( hlm_masterproc == itrue ) write(fates_log(),*) 'currentPatch%SH',currentPatch%Scorch_ht(i_pft) endif - !2/3 Byram (1959) - currentPatch%SH = currentPatch%SH + f_ag_bmass * & - EDPftvarcon_inst%fire_alpha_SH(currentCohort%pft) * (currentPatch%FI**0.667_r8) + else + currentPatch%Scorch_ht(i_pft) = 0.0_r8 + endif ! tree biomass + end do - endif !trees only - currentCohort=>currentCohort%shorter; - enddo !end cohort loop endif !fire currentPatch => currentPatch%younger; @@ -906,16 +883,18 @@ subroutine crown_damage ( currentSite ) if (EDPftvarcon_inst%woody(currentCohort%pft) == 1) then !trees only ! Flames lower than bottom of canopy. ! c%hite is height of cohort - if (currentPatch%SH < (currentCohort%hite-currentCohort%hite*EDPftvarcon_inst%crown(currentCohort%pft))) then + if (currentPatch%Scorch_ht(currentCohort%pft) < & + (currentCohort%hite-currentCohort%hite*EDPftvarcon_inst%crown(currentCohort%pft))) then currentCohort%fraction_crown_burned = 0.0_r8 else ! Flames part of way up canopy. ! Equation 17 in Thonicke et al. 2010. ! flames over bottom of canopy but not over top. - if ((currentCohort%hite > 0.0_r8).and.(currentPatch%SH >= & + if ((currentCohort%hite > 0.0_r8).and.(currentPatch%Scorch_ht(currentCohort%pft) >= & (currentCohort%hite-currentCohort%hite*EDPftvarcon_inst%crown(currentCohort%pft)))) then - currentCohort%fraction_crown_burned = (currentPatch%SH-currentCohort%hite*(1.0_r8- & + currentCohort%fraction_crown_burned = (currentPatch%Scorch_ht(currentCohort%pft) - & + currentCohort%hite*(1.0_r8 - & EDPftvarcon_inst%crown(currentCohort%pft)))/(currentCohort%hite* & EDPftvarcon_inst%crown(currentCohort%pft)) @@ -1020,10 +999,10 @@ subroutine post_fire_mortality ( currentSite ) ! Equation 22 in Thonicke et al. 2010. currentCohort%crownfire_mort = EDPftvarcon_inst%crown_kill(currentCohort%pft)*currentCohort%fraction_crown_burned**3.0_r8 ! Equation 18 in Thonicke et al. 2010. - currentCohort%fire_mort = currentCohort%crownfire_mort+currentCohort%cambial_mort- & - (currentCohort%crownfire_mort*currentCohort%cambial_mort) !joint prob. + currentCohort%fire_mort = max(0._r8,min(1.0_r8,currentCohort%crownfire_mort+currentCohort%cambial_mort- & + (currentCohort%crownfire_mort*currentCohort%cambial_mort))) !joint prob. else - currentCohort%fire_mort = 0.0_r8 !I have changed this to zero and made the mode of death removal of leaves... + currentCohort%fire_mort = 0.0_r8 !Set to zero. Grass mode of death is removal of leaves. endif !trees currentCohort => currentCohort%shorter diff --git a/fire/SFParamsMod.F90 b/fire/SFParamsMod.F90 index ecf4751f81..1c9f278c1e 100644 --- a/fire/SFParamsMod.F90 +++ b/fire/SFParamsMod.F90 @@ -3,73 +3,126 @@ module SFParamsMod ! module that deals with reading the SF parameter file ! use FatesConstantsMod , only: r8 => fates_r8 - use EDtypesMod , only: NFSC,NCWD + use EDtypesMod , only: NFSC + use FatesLitterMod , only: ncwd use FatesParametersInterface, only : param_string_length + use FatesGlobals, only : fates_log + use FatesGlobals, only : endrun => fates_endrun + use shr_log_mod , only : errMsg => shr_log_errMsg implicit none + private ! Modules are private by default save - ! private - if we allow this module to be private, it does not allow the protected values below to be - ! seen outside of this module. ! ! this is what the user can use for the actual values ! - real(r8),protected :: SF_val_fdi_a - real(r8),protected :: SF_val_fdi_b - real(r8),protected :: SF_val_fdi_alpha - real(r8),protected :: SF_val_miner_total - real(r8),protected :: SF_val_fuel_energy - real(r8),protected :: SF_val_part_dens - real(r8),protected :: SF_val_miner_damp - real(r8),protected :: SF_val_max_durat - real(r8),protected :: SF_val_durat_slope - real(r8),protected :: SF_val_drying_ratio - real(r8),protected :: SF_val_CWD_frac(NCWD) - real(r8),protected :: SF_val_max_decomp(NFSC) - real(r8),protected :: SF_val_SAV(NFSC) - real(r8),protected :: SF_val_FBD(NFSC) - real(r8),protected :: SF_val_min_moisture(NFSC) - real(r8),protected :: SF_val_mid_moisture(NFSC) - real(r8),protected :: SF_val_low_moisture_Coeff(NFSC) - real(r8),protected :: SF_val_low_moisture_Slope(NFSC) - real(r8),protected :: SF_val_mid_moisture_Coeff(NFSC) - real(r8),protected :: SF_val_mid_moisture_Slope(NFSC) - - character(len=param_string_length),parameter :: SF_name_fdi_a = "fates_fdi_a" - character(len=param_string_length),parameter :: SF_name_fdi_b = "fates_fdi_b" - character(len=param_string_length),parameter :: SF_name_fdi_alpha = "fates_fdi_alpha" - character(len=param_string_length),parameter :: SF_name_miner_total = "fates_miner_total" - character(len=param_string_length),parameter :: SF_name_fuel_energy = "fates_fuel_energy" - character(len=param_string_length),parameter :: SF_name_part_dens = "fates_part_dens" - character(len=param_string_length),parameter :: SF_name_miner_damp = "fates_miner_damp" - character(len=param_string_length),parameter :: SF_name_max_durat = "fates_max_durat" - character(len=param_string_length),parameter :: SF_name_durat_slope = "fates_durat_slope" - character(len=param_string_length),parameter :: SF_name_drying_ratio = "fates_drying_ratio" + + real(r8),protected, public :: SF_val_fdi_a + real(r8),protected, public :: SF_val_fdi_b + real(r8),protected, public :: SF_val_fdi_alpha + real(r8),protected, public :: SF_val_miner_total + real(r8),protected, public :: SF_val_fuel_energy + real(r8),protected, public :: SF_val_part_dens + real(r8),protected, public :: SF_val_miner_damp + real(r8),protected, public :: SF_val_max_durat + real(r8),protected, public :: SF_val_durat_slope + real(r8),protected, public :: SF_val_drying_ratio + real(r8),protected, public :: SF_val_CWD_frac(ncwd) + real(r8),protected, public :: SF_val_max_decomp(NFSC) + real(r8),protected, public :: SF_val_SAV(NFSC) + real(r8),protected, public :: SF_val_FBD(NFSC) + real(r8),protected, public :: SF_val_min_moisture(NFSC) + real(r8),protected, public :: SF_val_mid_moisture(NFSC) + real(r8),protected, public :: SF_val_low_moisture_Coeff(NFSC) + real(r8),protected, public :: SF_val_low_moisture_Slope(NFSC) + real(r8),protected, public :: SF_val_mid_moisture_Coeff(NFSC) + real(r8),protected, public :: SF_val_mid_moisture_Slope(NFSC) + + character(len=param_string_length),parameter :: SF_name_fdi_a = "fates_fire_fdi_a" + character(len=param_string_length),parameter :: SF_name_fdi_b = "fates_fire_fdi_b" + character(len=param_string_length),parameter :: SF_name_fdi_alpha = "fates_fire_fdi_alpha" + character(len=param_string_length),parameter :: SF_name_miner_total = "fates_fire_miner_total" + character(len=param_string_length),parameter :: SF_name_fuel_energy = "fates_fire_fuel_energy" + character(len=param_string_length),parameter :: SF_name_part_dens = "fates_fire_part_dens" + character(len=param_string_length),parameter :: SF_name_miner_damp = "fates_fire_miner_damp" + character(len=param_string_length),parameter :: SF_name_max_durat = "fates_fire_max_durat" + character(len=param_string_length),parameter :: SF_name_durat_slope = "fates_fire_durat_slope" + character(len=param_string_length),parameter :: SF_name_drying_ratio = "fates_fire_drying_ratio" character(len=param_string_length),parameter :: SF_name_CWD_frac = "fates_CWD_frac" character(len=param_string_length),parameter :: SF_name_max_decomp = "fates_max_decomp" - character(len=param_string_length),parameter :: SF_name_SAV = "fates_SAV" - character(len=param_string_length),parameter :: SF_name_FBD = "fates_FBD" - character(len=param_string_length),parameter :: SF_name_min_moisture = "fates_min_moisture" - character(len=param_string_length),parameter :: SF_name_mid_moisture = "fates_mid_moisture" - character(len=param_string_length),parameter :: SF_name_low_moisture_Coeff = "fates_low_moisture_Coeff" - character(len=param_string_length),parameter :: SF_name_low_moisture_Slope = "fates_low_moisture_Slope" - character(len=param_string_length),parameter :: SF_name_mid_moisture_Coeff = "fates_mid_moisture_Coeff" - character(len=param_string_length),parameter :: SF_name_mid_moisture_Slope = "fates_mid_moisture_Slope" + character(len=param_string_length),parameter :: SF_name_SAV = "fates_fire_SAV" + character(len=param_string_length),parameter :: SF_name_FBD = "fates_fire_FBD" + character(len=param_string_length),parameter :: SF_name_min_moisture = "fates_fire_min_moisture" + character(len=param_string_length),parameter :: SF_name_mid_moisture = "fates_fire_mid_moisture" + character(len=param_string_length),parameter :: SF_name_low_moisture_Coeff = "fates_fire_low_moisture_Coeff" + character(len=param_string_length),parameter :: SF_name_low_moisture_Slope = "fates_fire_low_moisture_Slope" + character(len=param_string_length),parameter :: SF_name_mid_moisture_Coeff = "fates_fire_mid_moisture_Coeff" + character(len=param_string_length),parameter :: SF_name_mid_moisture_Slope = "fates_fire_mid_moisture_Slope" + + character(len=*), parameter, private :: sourcefile = & + __FILE__ public :: SpitFireRegisterParams public :: SpitFireReceiveParams + public :: SpitFireCheckParams + - private :: SpitFireParamsInit - private :: SpitFireRegisterScalars - private :: SpitFireReceiveScalars - - private :: SpitFireRegisterNCWD - private :: SpitFireReceiveNCWD - - private :: SpitFireRegisterNFSC - private :: SpitFireReceiveNFSC - contains + + ! ===================================================================================== + + subroutine SpitFireCheckParams(is_master) + + ! ---------------------------------------------------------------------------------- + ! + ! This subroutine performs logical checks on user supplied parameters. It cross + ! compares various parameters and will fail if they don't make sense. + ! Examples: + ! Decomposition rates should not be less than zero or greater than 1 + ! ----------------------------------------------------------------------------------- + + logical, intent(in) :: is_master ! Only log if this is the master proc + + + integer :: c ! debris type loop counter + integer :: corr_id(1) ! This is the bin with largest fraction + ! add/subtract any corrections there + real(r8) :: correction ! This correction ensures that root fractions + ! sum to 1.0 + + + if(.not.is_master) return + + ! Move these checks to initialization + do c = 1,nfsc + if ( SF_val_max_decomp(c) < 0._r8) then + write(fates_log(),*) 'Decomposition rates should be >0' + write(fates_log(),*) 'c = ',c,' SF_val_max_decomp(c) = ',SF_val_max_decomp(c) + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + end do + + ! Check if the CWD fraction sums to unity, if it is not wayyy off, + ! add a small correction to the largest pool. + ! This is important for tight mass conservation + ! checks + + if(abs(1.0_r8 - sum(SF_val_CWD_frac(1:ncwd))) > 1.e-5_r8) then + write(fates_log(),*) 'The CWD fractions from index 1:4 must sum to unity' + write(fates_log(),*) 'SF_val_CWD_frac(1:ncwd) = ',SF_val_CWD_frac(1:ncwd) + write(fates_log(),*) 'error = ',1.0_r8 - sum(SF_val_CWD_frac(1:ncwd)) + call endrun(msg=errMsg(sourcefile, __LINE__)) + else + correction = 1._r8 - sum(SF_val_CWD_frac(1:ncwd)) + corr_id = maxloc(SF_val_CWD_frac(1:ncwd)) + SF_val_CWD_frac(corr_id(1)) = SF_val_CWD_frac(corr_id(1)) + correction + end if + + + return + end subroutine SpitFireCheckParams + !----------------------------------------------------------------------- subroutine SpitFireParamsInit() ! Initialize all parameters to nan to ensure that we get valid @@ -248,6 +301,8 @@ subroutine SpitFireReceiveNCWD(fates_params) call fates_params%RetreiveParameter(name=SF_name_CWD_frac, & data=SF_val_CWD_frac) + + end subroutine SpitFireReceiveNCWD !----------------------------------------------------------------------- diff --git a/functional_unit_testing/allometry/AutoGenVarCon.py b/functional_unit_testing/allometry/AutoGenVarCon.py new file mode 100644 index 0000000000..8879b2b7da --- /dev/null +++ b/functional_unit_testing/allometry/AutoGenVarCon.py @@ -0,0 +1,140 @@ + + +# Walk through lines of a file, if a line contains +# the string of interest (EDPftvarcon_inst), then +# parse the string to find the variable name, and save that +# to the list + + +class ParamType: + + def __init__(self,var_sym,n_dims): + + self.var_sym = var_sym + self.n_dims = n_dims + self.var_name = '' + + + + +def CheckFile(filename,check_str): + file_ptr = file(filename) + var_list = [] + found = False + for line in file_ptr: + if check_str in line: + line_split = line.split() + # substr = [i for i in line_split if check_str in i][0] + substr = line + p1 = substr.find('%')+1 + if(p1>0): + substr=substr[p1:] + p2 = substr.find('(') + p3 = substr.find(')') + # Count the number of commas between p2 and p3 + n_dims = substr[p2:p3].count(',')+1 + if(p2>0): + var_list.append(ParamType(substr[:p2],n_dims)) + + unique_list = [] + for var in var_list: + found = False + for uvar in unique_list: + if (var.var_sym == uvar.var_sym): + found = True + if(not found): + unique_list.append(var) + + return(unique_list) + + + +check_str = 'EDPftvarcon_inst%' +filename = '../../biogeochem/FatesAllometryMod.F90' + +var_list = CheckFile(filename,check_str) + + +# Add symbols here + +var_list.append(ParamType('hgt_min',1)) + + +# Now look through EDPftvarcon.F90 to determine the variable name in file +# that is associated with the variable pointer + +filename = '../../main/EDPftvarcon.F90' + +f = open(filename,"r") +contents = f.readlines() + + +var_name_list = [] +for var in var_list: + for i,line in enumerate(contents): + if (var.var_sym in line) and ('data' in line) and ('=' in line): + var.var_name = contents[i-2].split()[-1].strip('\'') + print("{} {} {}".format(var.var_sym,var.var_name,var.n_dims)) + + +f = open("f90src/AllomUnitWrap.F90_in", "r") +contents = f.readlines() +f.close() + +# Identify where we define the variables, and insert the variable definitions + +for i,str in enumerate(contents): + if 'VARIABLE-DEFINITIONS-HERE' in str: + index0=i + +index=index0+2 +for var in var_list: + if(var.n_dims==1): + contents.insert(index,' real(r8),pointer :: {}(:)\n'.format(var.var_sym)) + elif(var.n_dims==2): + contents.insert(index,' real(r8),pointer :: {}(:,:)\n'.format(var.var_sym)) + else: + print('Incorrect number of dims...') + exit(-2) + index=index+1 + +# Identify where we do the pointer assignments, and insert the pointer assignments + + +for i,str in enumerate(contents): + if 'POINTER-SPECIFICATION-HERE' in str: + index0=i + +index=index0+2 +for ivar,var in enumerate(var_list): + if(var.n_dims==1): + ins_l1='\t allocate(EDPftvarcon_inst%{}(1:numpft))\n'.format(var.var_sym) + ins_l2='\t EDPftvarcon_inst%{}(:) = nan\n'.format(var.var_sym) + ins_l3='\t iv1 = iv1 + 1\n' + ins_l4='\t EDPftvarcon_ptr%var1d(iv1)%var_name = "{}"\n'.format(var.var_name) + ins_l5='\t EDPftvarcon_ptr%var1d(iv1)%var_rp => EDPftvarcon_inst%{}\n'.format(var.var_sym) + ins_l6='\t EDPftvarcon_ptr%var1d(iv1)%vtype = 1\n' + ins_l7='\n' + if(var.n_dims==2): + ins_l1='\t allocate(EDPftvarcon_inst%{}(1:numpft,1))\n'.format(var.var_sym) + ins_l2='\t EDPftvarcon_inst%{}(:,:) = nan\n'.format(var.var_sym) + ins_l3='\t iv2 = iv2 + 1\n' + ins_l4='\t EDPftvarcon_ptr%var2d(iv2)%var_name = "{}"\n'.format(var.var_name) + ins_l5='\t EDPftvarcon_ptr%var2d(iv2)%var_rp => EDPftvarcon_inst%{}\n'.format(var.var_sym) + ins_l6='\t EDPftvarcon_ptr%var2d(iv2)%vtype = 1\n' + ins_l7='\n' + + contents.insert(index,ins_l1) + contents.insert(index+1,ins_l2) + contents.insert(index+2,ins_l3) + contents.insert(index+3,ins_l4) + contents.insert(index+4,ins_l5) + contents.insert(index+5,ins_l6) + contents.insert(index+6,ins_l7) + index=index+7 + + +f = open("f90src/AllomUnitWrap.F90", "w+") +contents = "".join(contents) +f.write(contents) +f.close() diff --git a/functional_unit_testing/allometry/drive_allomtests.py b/functional_unit_testing/allometry/drive_allomtests.py new file mode 100644 index 0000000000..19c6971603 --- /dev/null +++ b/functional_unit_testing/allometry/drive_allomtests.py @@ -0,0 +1,715 @@ +import numpy as np +import math +import matplotlib.pyplot as plt +import matplotlib as mp +import ctypes +from ctypes import * #byref, cdll, c_int, c_double, c_char_p, c_long +import xml.etree.ElementTree as ET +import argparse +import re # This is a heftier string parser +import code # For development: code.interact(local=dict(globals(), **locals())) + + +# ======================================================================================= +# Set some constants. If they are used as constant arguments to the F90 routines, +# define them with their ctype identifiers +# ======================================================================================= + +ndbh = 200 +maxdbh = 50 +ccanopy_trim = c_double(1.0) # Crown Trim (0=0% of target, 1=100% of targ) +csite_spread = c_double(0.0) # Canopy spread (0=closed, 1=open) +cnplant = c_double(1.0) # Number of plants (don't change) +cilayer = c_int(1) # Index of the plant's canopy layer +ccanopy_lai = (2 * c_double)(1.0,1.0) # The LAI of the different canopy layers + # THIS VECTOR MUST MATCH ncanlayer +cdo_reverse = c_bool(0) # DO NOT GET REVERSE CROWN AREA + +# ======================================================================================= +# Setup references to fortran shared libraries +# ======================================================================================= + +allom_const_object = "./include/FatesConstantsMod.o" +allom_wrap_object = "./include/AllomUnitWrap.o" +allom_lib_object = "./include/FatesAllometryMod.o" + +# ============================================================================== +# Instantiate fortran allometry and other libraries +# ============================================================================== + +f90constlib= ctypes.CDLL(allom_const_object,mode=ctypes.RTLD_GLOBAL) +f90wraplib = ctypes.CDLL(allom_wrap_object,mode=ctypes.RTLD_GLOBAL) +f90funclib = ctypes.CDLL(allom_lib_object,mode=ctypes.RTLD_GLOBAL) + +# ======================================================================================= +# Create aliases to all of the different routines, set return types for functions +# ======================================================================================= + +f90_pftalloc = f90wraplib.__edpftvarcon_MOD_edpftvarconalloc #(numpft) +f90_pftset = f90wraplib.__edpftvarcon_MOD_edpftvarconpyset +f90_pftset.argtypes = [POINTER(c_int),POINTER(c_double),POINTER(c_int),c_char_p,c_long] +f90_h2d = f90funclib.__fatesallometrymod_MOD_h2d_allom #(h,ipft,d,dddh) +f90_h = f90funclib.__fatesallometrymod_MOD_h_allom #(d,ipft,h,dhdd) +f90_bagw = f90funclib.__fatesallometrymod_MOD_bagw_allom #(d,ipft,bagw,dbagwdd) +f90_bleaf = f90funclib.__fatesallometrymod_MOD_bleaf #(d,ipft,canopy_trim,bl,dbldd) +f90_bsap = f90funclib.__fatesallometrymod_MOD_bsap_allom #(d,ipft,canopy_trim,asapw,bsap,dbsapdd) +f90_bstore = f90funclib.__fatesallometrymod_MOD_bstore_allom #(d,ipft,canopy_trim,bstore,dbstoredd) +f90_bbgw = f90funclib.__fatesallometrymod_MOD_bbgw_allom #(d,ipft,canopy_trim,bbgw,dbbgwdd) +f90_bfineroot = f90funclib.__fatesallometrymod_MOD_bfineroot #(d,ipft,canopy_trim,bfr,dbfrdd) +f90_bdead = f90funclib.__fatesallometrymod_MOD_bdead_allom #(bagw,bbgw,bsap,ipft,bdead,dbagwdd,dbbgwdd,dbsapdd,dbdeaddd) +f90_carea = f90funclib.__fatesallometrymod_MOD_carea_allom #(d,nplant,site_spread,ipft,c_area)(d,nplant,site_spread,ipft,c_area) +f90_treelai = f90funclib.__fatesallometrymod_MOD_tree_lai #(leaf_c, pft, c_area, nplant, cl, canopy_lai, vcmax25top) +f90_treelai.restype = c_double + + +# This is the object type that holds our parameters +# ======================================================================================= +class parameter: + + def __init__(self,symbol): + + self.dtype = -9 + self.symbol = symbol + self.vals = [] + + def setval(self,val,ipft): + + self.vals[ipft] = val + +# This is just a helper script that generates random colors +# ======================================================================================= +def DiscreteCubeHelix(N): + + base = plt.cm.get_cmap('cubehelix') + np.random.seed(1) + color_list = base(np.random.randint(0,high=255,size=N)) + cmap_name = base.name + str(N) + return base.from_list(cmap_name, color_list, N) + + +# This will look through a CDL file for the provided parameter and determine +# the parameter's type, as well as fill an array with the data +# ======================================================================================= +def CDLParse(file_name,parm): + + fp = open(file_name,"r") + contents = fp.readlines() + fp.close() + + # Look in the file for the parameters + # symbol/name, record the line number + iline=-1 + isfirst = True + for i,line in enumerate(contents): + if(parm.symbol in line): + iline=i + if(isfirst): + dtype = line.split()[0] + if(dtype.strip()=="float" or (dtype.strip()=="double")): + parm.dtype = 0 + elif(dtype.strip()=="char"): + parm.dtype = 1 + isFirst=False + + if(iline==-1): + print('Could not find symbol: {} in file: {}'.format(parm.symbol,file_name)) + exit(2) + else: + search_field=True + line="" + lcount=0 + while(search_field and (lcount<100)): + line+=contents[iline] + if(line.count(';')>0): + search_field=False + else: + search_field=True + lcount=lcount+1 + iline=iline+1 + + # Parse the line + line_split = re.split(',|=',line) + # Remove the variable name entry + del line_split[0] + + # This is for read numbers + if(parm.dtype == 0): + ival=0 + for str0 in line_split: + str="" + isnum=False + for s in str0: + if (s.isdigit() or s=='.'): + str+=s + isnum=True + if(isnum): + parm.vals.append(float(str)) + + # This is a sting + elif(parm.dtype == 1): + for str0 in line_split: + # Loop several times to trim stuff off + for i in range(5): + str0=str0.strip().strip('\"').strip(';').strip() + parm.vals.append(str0) + + return(parm) + + + +# Read in the arguments +# ======================================================================================= + +parser = argparse.ArgumentParser(description='Parse command line arguments to this script.') +parser.add_argument('--fin', '--input', dest='fnamein', type=str, help="Input CDL filename. Required.", required=True) +args = parser.parse_args() + + +# Read in the parameters of interest that are used in the fortran objects. These +# parameters will be passed to the fortran allocation. +# ======================================================================================= + +parms = {} +parms['dbh_maxheight'] = CDLParse(args.fnamein,parameter('fates_allom_dbh_maxheight')) +parms['hmode'] = CDLParse(args.fnamein,parameter('fates_allom_hmode')) +parms['amode'] = CDLParse(args.fnamein,parameter('fates_allom_amode')) +parms['lmode'] = CDLParse(args.fnamein,parameter('fates_allom_lmode')) +parms['smode'] = CDLParse(args.fnamein,parameter('fates_allom_smode')) +parms['cmode'] = CDLParse(args.fnamein,parameter('fates_allom_cmode')) +parms['fmode'] = CDLParse(args.fnamein,parameter('fates_allom_fmode')) +parms['stmode'] = CDLParse(args.fnamein,parameter('fates_allom_stmode')) +parms['cushion'] = CDLParse(args.fnamein,parameter('fates_alloc_storage_cushion')) +parms['d2h1'] = CDLParse(args.fnamein,parameter('fates_allom_d2h1')) +parms['d2h2'] = CDLParse(args.fnamein,parameter('fates_allom_d2h2')) +parms['d2h3'] = CDLParse(args.fnamein,parameter('fates_allom_d2h3')) +parms['agb1'] = CDLParse(args.fnamein,parameter('fates_allom_agb1')) +parms['agb2'] = CDLParse(args.fnamein,parameter('fates_allom_agb2')) +parms['agb3'] = CDLParse(args.fnamein,parameter('fates_allom_agb3')) +parms['agb4'] = CDLParse(args.fnamein,parameter('fates_allom_agb4')) +parms['d2bl1'] = CDLParse(args.fnamein,parameter('fates_allom_d2bl1')) +parms['d2bl2'] = CDLParse(args.fnamein,parameter('fates_allom_d2bl2')) +parms['d2bl3'] = CDLParse(args.fnamein,parameter('fates_allom_d2bl3')) +parms['wood_density'] = CDLParse(args.fnamein,parameter('fates_wood_density')) +parms['c2b'] = CDLParse(args.fnamein,parameter('fates_c2b')) +parms['la_per_sa_int'] = CDLParse(args.fnamein,parameter('fates_allom_la_per_sa_int')) +parms['la_per_sa_slp'] = CDLParse(args.fnamein,parameter('fates_allom_la_per_sa_slp')) +parms['slatop'] = CDLParse(args.fnamein,parameter('fates_leaf_slatop')) +parms['slamax'] = CDLParse(args.fnamein,parameter('fates_leaf_slamax')) +parms['l2fr'] = CDLParse(args.fnamein,parameter('fates_allom_l2fr')) +parms['agb_frac'] = CDLParse(args.fnamein,parameter('fates_allom_agb_frac')) +parms['blca_expnt_diff'] = CDLParse(args.fnamein,parameter('fates_allom_blca_expnt_diff')) +parms['d2ca_coeff_min'] = CDLParse(args.fnamein,parameter('fates_allom_d2ca_coefficient_min')) +parms['d2ca_coeff_max'] = CDLParse(args.fnamein,parameter('fates_allom_d2ca_coefficient_max')) +parms['sai_scaler'] = CDLParse(args.fnamein,parameter('fates_allom_sai_scaler')) + +# Read in the parameters that are not necessary for the F90 allometry algorithms, +# but are useful for these scripts (e.g. the name of the parameter, and minimum height) +# ======================================================================================= + +eparms = {} +eparms['recruit_hgt_min'] = CDLParse(args.fnamein,parameter('fates_recruit_hgt_min')) +eparms['name'] = CDLParse(args.fnamein,parameter('fates_pftname')) +eparms['vcmax25top'] = CDLParse(args.fnamein,parameter('fates_leaf_vcmax25top')) + + +# Determine how many PFTs are here, also check to make sure that all parameters +# have the same number +# ======================================================================================= +numpft=-1 +for key, parm in parms.items(): + if( (len(parm.vals) == numpft) or (numpft==-1) ): + numpft=len(parm.vals) + else: + print('Bad length in PFT parameter') + print('parameter: {}, vals:'.format(parm.symbol),parm.vals) + + +# ============================================================================== +# Allocate fortran PFT arrays +# ============================================================================== + +iret=f90_pftalloc(byref(c_int(numpft))) + +# ============================================================================== +# Populate the Fortran PFT structure +# ============================================================================== + +# First set the arg types +f90_pftset.argtypes = \ + [POINTER(c_int),POINTER(c_double),POINTER(c_int),c_char_p,c_long] + +for ipft in range(numpft): + for key, parm in parms.items(): + #print 'py: sending to F90: {0} = {1}'.format(parm.symbol,parm.vals[ipft]) + iret=f90_pftset(c_int(ipft+1), \ + c_double(parm.vals[ipft]), \ + c_int(0), \ + c_char_p(parm.symbol), \ + c_long(len(parm.symbol))) + + +# ========================================================================= +# Initialize Output Arrays +# ========================================================================= + +blmaxi = np.zeros((numpft,ndbh)) +blmaxd = np.zeros((numpft,ndbh)) +bfrmax = np.zeros((numpft,ndbh)) +hi = np.zeros((numpft,ndbh)) +hd = np.zeros((numpft,ndbh)) +bagwi = np.zeros((numpft,ndbh)) +bagwd = np.zeros((numpft,ndbh)) +dbh = np.zeros((numpft,ndbh)) +bbgw = np.zeros((numpft,ndbh)) +bsapi = np.zeros((numpft,ndbh)) +bsapd = np.zeros((numpft,ndbh)) +asapd = np.zeros((numpft,ndbh)) +bstore = np.zeros((numpft,ndbh)) +bdead = np.zeros((numpft,ndbh)) +dbhe = np.zeros((numpft,ndbh)) +camin = np.zeros((numpft,ndbh)) +ldense = np.zeros((numpft,ndbh)) +treelai = np.zeros((numpft,ndbh)) +blmax_o_dbagwdh = np.zeros((numpft,ndbh)) +blmax_o_dbagwdd = np.zeros((numpft,ndbh)) + + +for ipft in range(numpft): + + print 'py: Solving for pft: {}'.format(ipft+1) + + # Initialize Height #(d,ipft,h,dhdd) + ch_min = c_double(eparms['recruit_hgt_min'].vals[ipft]) + + cd = c_double(-9.0) + cdddh = c_double(-9.0) + cipft = c_int(ipft+1) + cinit = c_int(0) + + # Calculate the minimum dbh + iret=f90_h2d(byref(ch_min),byref(cipft),byref(cd),byref(cdddh)) + + # Generate a vector of diameters (use dbh) + dbh[ipft,:] = np.linspace(cd.value,maxdbh,num=ndbh) + + # Initialize various output vectors + cd = c_double(dbh[ipft,0]) + ch = c_double(-9.0) + cdhdd = c_double(-9.0) + cbagw = c_double(-9.0) + cdbagwdd = c_double(-9.0) + cblmax = c_double(-9.0) + cdblmaxdd = c_double(-9.0) + cbfrmax = c_double(-9.0) + cdbfrmaxdd = c_double(-9.0) + cbbgw = c_double(-9.0) + cdbbgwdd = c_double(-9.0) + cbsap = c_double(-9.0) + cdbsapdd = c_double(-9.0) + cbdead = c_double(-9.0) + cdbdeaddd = c_double(-9.0) + ccamin = c_double(-9.0) + casapw = c_double(-9.0) # Sapwood area + cbstore = c_double(-9.0) + cdbstoredd = c_double(-9.0) + + iret=f90_h(byref(cd),byref(cipft),byref(ch),byref(cdhdd)) + hi[ipft,0] = ch.value + hd[ipft,0] = ch.value + print 'py: initialize h[{},0]={}'.format(ipft+1,ch.value) + + # Initialize AGB #(d,ipft,bagw,dbagwdd) + iret=f90_bagw(byref(cd),byref(cipft),byref(cbagw),byref(cdbagwdd)) + bagwi[ipft,0] = cbagw.value + print 'py: initialize bagwi[{},0]={}'.format(ipft+1,cbagw.value) + + # Initialize bleaf #(d,ipft,canopy_trim,bl,dbldd) + iret=f90_bleaf(byref(cd),byref(cipft),byref(ccanopy_trim),byref(cblmax),byref(cdblmaxdd)) + blmaxi[ipft,0] = cblmax.value + blmaxd[ipft,0] = cblmax.value + print 'py: initialize blmaxi[{},0]={}'.format(ipft+1,cblmax.value) + + # Initialize bstore #(d,ipft,canopy_trim,bstore,dbstoredd) + iret=f90_bstore(byref(cd),byref(cipft),byref(ccanopy_trim),byref(cbstore),byref(cdbstoredd)) + bstore[ipft,0] = cbstore.value + + # calculate crown area (d,nplant,site_spread,ipft,c_area) Using nplant = 1, generates units of m2 + # spread is likely 0.0, which is the value it tends towards when canopies close + # (dbh, nplant, site_spread, ipft, c_area,inverse) + iret= f90_carea(byref(cd),byref(cnplant),byref(csite_spread),byref(cipft),byref(ccamin),byref(cdo_reverse)) + camin[ipft,0] = ccamin.value + ldense[ipft,0] = blmaxi[ipft,0]/camin[ipft,0] + print 'py: initialize careai[{},0]={}'.format(ipft+1,ccamin.value) + + #f90_treelai(leaf_c, pft, c_area, nplant, cl, canopy_lai, vcmax25top) + cvcmax=c_double(eparms['vcmax25top'].vals[ipft]) + treelai[ipft,0]=f90_treelai(byref(cblmax),byref(cipft),byref(ccamin), \ + byref(cnplant),byref(cilayer),byref(ccanopy_lai),byref(cvcmax)) + + # Initialize fine roots #(d,ipft,canopy_trim,bfr,dbfrdd) + iret=f90_bfineroot(byref(cd),byref(cipft),byref(ccanopy_trim), \ + byref(cbfrmax),byref(cdbfrmaxdd)) + bfrmax[ipft,0] = cbfrmax.value + print 'py: initialize bfrmax[{},0]={}'.format(ipft+1,cbfrmax.value) + + # Initialize coarse roots #(d,ipft,bbgw,dbbgwdd) + iret=f90_bbgw(byref(cd),byref(cipft),byref(c_double(1.0)), \ + byref(cbbgw),byref(cdbbgwdd)) + bbgw[ipft,0] = cbbgw.value + print 'py: initialize bbgw[{},0]={}'.format(ipft+1,cbbgw.value) + + + # Initialize bsap (d,ipft,canopy_trim,asapw,bsap,dbsapdd) + iret=f90_bsap(byref(cd),byref(cipft),byref(ccanopy_trim),byref(casapw),byref(cbsap),byref(cdbsapdd)) + bsapi[ipft,0] = cbsap.value + bsapd[ipft,0] = cbsap.value + asapd[ipft,0] = casapw.value + print 'py: initialize bsapi[{},0]={}'.format(ipft+1,cbsap.value) + + # bdead #(bagw,bbgw,bsap,ipft,bdead,dbagwdd,dbbgwdd,dbsapdd,dbdeaddd) + iret=f90_bdead(byref(cbagw),byref(cbbgw),byref(cbsap),byref(cipft), \ + byref(cbdead),byref(cdbagwdd),byref(cdbbgwdd), \ + byref(cdbsapdd),byref(cdbdeaddd)) + + bdead[ipft,0] = cbdead.value + print 'py: initialize bdead[{},0]={}'.format(ipft+1,cbdead.value) + + # the metric that shan't be spoken + blmax_o_dbagwdh[ipft,0] = blmaxi[ipft,0]/(cdbagwdd.value/cdhdd.value) + + # the metric that shan't be spoken + blmax_o_dbagwdd[ipft,0] = blmaxi[ipft,0]/(cdbagwdd.value) + + for idi in range(1,ndbh): + + dp = dbh[ipft,idi-1] # previous position + dc = dbh[ipft,idi] # current position + dd = dc-dp + + cdp = c_double(dp) + cdc = c_double(dc) + cdbhe = c_double(-9.0) + cddedh = c_double(-9.0) + + if(ipft==2): + print("===") + + # integrate height #(d,ipft,h,dhdd) + iret=f90_h(byref(cdc),byref(cipft),byref(ch),byref(cdhdd)) + hi[ipft,idi] = hi[ipft,idi-1] + cdhdd.value*dd + + # diagnosed height + hd[ipft,idi] = ch.value + + # diagnose AGB #(d,h,ipft,bagw,dbagwdd) + iret=f90_bagw(byref(cdc),byref(cipft),byref(cbagw),byref(cdbagwdd)) + bagwd[ipft,idi] = cbagw.value + + # integrate AGB #(d,h,ipft,bagw,dbagwdd) + iret=f90_bagw(byref(cdp),byref(cipft),byref(cbagw),byref(cdbagwdd)) + bagwi[ipft,idi] = bagwi[ipft,idi-1] + cdbagwdd.value*dd + + # diagnose bleaf #(d,ipft,blmax,dblmaxdd) + iret=f90_bleaf(byref(cdc),byref(cipft),byref(c_double(1.0)),byref(cblmax),byref(cdblmaxdd)) + blmaxd[ipft,idi] = cblmax.value + + # bstore #(d,ipft,canopy_trim,bstore,dbstoredd) + iret=f90_bstore(byref(cdc),byref(cipft),byref(ccanopy_trim),byref(cbstore),byref(cdbstoredd)) + bstore[ipft,idi] = cbstore.value + + # calculate crown area (d,nplant,site_spread,ipft,c_area) Using nplant = 1, generates units of m2 + iret= f90_carea(byref(cdc),byref(cnplant),byref(csite_spread),byref(cipft),byref(ccamin),byref(cdo_reverse)) + camin[ipft,idi] = ccamin.value + + #f90_treelai(leaf_c, pft, c_area, nplant, cl, canopy_lai, vcmax25top) + cvcmax=c_double(eparms['vcmax25top'].vals[ipft]) + treelai[ipft,idi]=f90_treelai(byref(cblmax),byref(cipft),byref(ccamin), \ + byref(cnplant),byref(cilayer),byref(ccanopy_lai),byref(cvcmax)) + + # integrate bleaf #(d,ipft,blmax,dblmaxdd) + iret=f90_bleaf(byref(cdp),byref(cipft),byref(c_double(1.0)),byref(cblmax),byref(cdblmaxdd)) + blmaxi[ipft,idi] = blmaxi[ipft,idi-1] + cdblmaxdd.value*dd + + # leaf mass per square meter of crown + ldense[ipft,idi] = blmaxd[ipft,idi]/camin[ipft,idi] + + # integrate bfineroot #(d,ipft,canopy_trim,bfr,dbfrdd) + iret=f90_bfineroot(byref(cdp),byref(cipft),byref(c_double(1.0)),byref(cbfrmax),byref(cdbfrmaxdd)) + bfrmax[ipft,idi] = bfrmax[ipft,idi-1] + cdbfrmaxdd.value*dd + + # integrate bbgw #(d,h,ipft,bbgw,dbbgwdd) + iret=f90_bbgw(byref(cdp),byref(cipft),byref(cbbgw),byref(cdbbgwdd)) + bbgw[ipft,idi] = bbgw[ipft,idi-1] + cdbbgwdd.value*dd + + # diagnose bsap # (d,ipft,canopy_trim,asapw,bsap,dbsapdd) + iret=f90_bsap(byref(cdc),byref(cipft),byref(ccanopy_trim),byref(casapw),byref(cbsap),byref(cdbsapdd)) + bsapd[ipft,idi] = cbsap.value # Biomass + asapd[ipft,idi] = casapw.value # Area + + # integrate bsap + iret=f90_bsap(byref(cdp),byref(cipft),byref(ccanopy_trim),byref(casapw),byref(cbsap),byref(cdbsapdd)) + bsapi[ipft,idi] = bsapi[ipft,idi-1] + cdbsapdd.value*dd + + # the metric that shan't be spoken + # previous t-step derivatives are used for simplicity + if cdhdd.value<0.000001: + blmax_o_dbagwdh[ipft,idi] = None + else: + blmax_o_dbagwdh[ipft,idi] = blmaxi[ipft,idi-1]/(cdbagwdd.value/cdhdd.value) + + # the metric that shan't be spoken + # previous t-step derivatives are used for simplicity + blmax_o_dbagwdd[ipft,idi] = blmaxi[ipft,idi-1]/(cdbagwdd.value) + + # Diagnose bdead (bagw,bbgw,bsap,ipft,bdead,dbagwdd,dbbgwdd,dbsapdd,dbdeaddd) + + iret=f90_bdead(byref(c_double(bagwi[ipft,idi])), \ + byref(c_double(bbgw[ipft,idi])), \ + byref(c_double(bsapi[ipft,idi])), \ + byref(cipft), byref(cbdead), \ + byref(cdbagwdd),byref(cdbbgwdd), \ + byref(cdbsapdd),byref(cdbdeaddd)) + bdead[ipft,idi] = cbdead.value + + +# Create the appropriate number of line-styles, colors and widths +linestyles_base = ['-', '--', '-.', ':'] +linestyles=[] +for i in range(int(math.floor(float(numpft)/float(len(linestyles_base))))): + linestyles.extend(linestyles_base) +for i in range(numpft-len(linestyles)): + linestyles.append(linestyles_base[i]) + +my_colors = DiscreteCubeHelix(numpft) + + +mp.rcParams.update({'font.size': 14}) +mp.rcParams["savefig.directory"] = "" #os.chdir(os.path.dirname(__file__)) + +legfs = 12 +lwidth = 2.0 + +#code.interact(local=dict(globals(), **locals())) + +if(True): + fig0 = plt.figure() + figleg = plt.figure() + ax = fig0.add_subplot(111) + ax.axis("off") + ax.set_axis_off() + proxies = () + for ipft in range(numpft): + proxies = proxies + (mp.lines.Line2D([],[], \ + linestyle=linestyles[ipft], \ + color=my_colors(ipft), \ + label=eparms['name'].vals[ipft], \ + linewidth=lwidth),) + figleg.legend(handles=proxies,fontsize=12,frameon=False,labelspacing=0.25,loc='center') + plt.show(block=False) + plt.close(fig0) + + +if(True): + fig1 = plt.figure() + figleg = plt.figure() + for ipft in range(numpft): + plt.plot(dbh[ipft,:],hi[ipft,:],linestyle=linestyles[ipft],color=my_colors(ipft),linewidth=lwidth) + plt.xlabel('diameter [cm]') + plt.ylabel('height [m]') + plt.title('Integrated Heights') + plt.grid(True) + plt.tight_layout() + +if(False): + fig1_0 = plt.figure() + for ipft in range(numpft): + plt.plot(dbh[ipft,0:15],hi[ipft,0:15],linestyle=linestyles[ipft],color=my_colors(ipft),linewidth=lwidth) + plt.xlabel('diameter [cm]') + plt.ylabel('height [m]') + plt.title('Integrated Heights') + plt.grid(True) + plt.tight_layout() + +if(False): + fig1_1 = plt.figure() + for ipft in range(numpft): + plt.plot(hd[ipft,:],hi[ipft,:],linestyle=linestyles[ipft],color=my_colors(ipft),linewidth=lwidth) + plt.xlabel('height (diagnosed) [m]') + plt.ylabel('height (integrated) [m]') + plt.title('Height') + plt.grid(True) + plt.savefig("plots/hdhi.png") + +if(False): + fig2=plt.figure() + for ipft in range(numpft): + plt.plot(blmaxd[ipft,:],blmaxi[ipft,:],linestyle=linestyles[ipft],color=my_colors(ipft),linewidth=lwidth) + plt.xlabel('diagnosed [kgC]') + plt.ylabel('integrated [kgC]') + plt.title('Maximum Leaf Biomass') + plt.grid(True) + plt.tight_layout() + +if(True): + fig3=plt.figure() + for ipft in range(numpft): + plt.plot(dbh[ipft,:],blmaxi[ipft,:],linestyle=linestyles[ipft],color=my_colors(ipft),linewidth=lwidth) + plt.xlabel('diameter [cm]') + plt.ylabel('mass [kgC]') + plt.title('Maximum Leaf Biomass') + plt.grid(True) + plt.tight_layout() + +if(True): + fig3_1=plt.figure() + for ipft in range(numpft): + plt.plot(dbh[ipft,1:15],blmaxi[ipft,1:15],linestyle=linestyles[ipft],color=my_colors(ipft),linewidth=lwidth) + plt.xlabel('diameter [cm]') + plt.ylabel('mass [kgC]') + plt.title('Maximum Leaf Biomass (saplings)') + plt.grid(True) + plt.tight_layout() + + +if(True): + fig4=plt.figure() + for ipft in range(numpft): + plt.plot(dbh[ipft,:],camin[ipft,:],linestyle=linestyles[ipft],color=my_colors(ipft),linewidth=lwidth) + plt.xlabel('diameter [cm]') + plt.ylabel('[m2] (closed canopy)') + plt.title('Crown Area') + plt.grid(True) + plt.tight_layout() + +if(True): + fig4_1=plt.figure() + for ipft in range(numpft): + plt.plot(dbh[ipft,:],ldense[ipft,:],linestyle=linestyles[ipft],color=my_colors(ipft),linewidth=lwidth) + plt.xlabel('diameter [cm]') + plt.ylabel('[kgC/m2] (closed canopy)') + plt.title('Leaf Mass Per Crown Area') + plt.grid(True) + plt.tight_layout() + + +if(True): + fig6=plt.figure() + for ipft in range(numpft): + plt.plot(dbh[ipft,:],bagwi[ipft,:]/1000,linestyle=linestyles[ipft],color=my_colors(ipft),linewidth=lwidth) + plt.xlabel('diameter [cm]') + plt.ylabel('AGB [MgC]') + plt.title('Above Ground Biomass') + plt.grid(True) + plt.tight_layout() + +if(False): + fig6_1=plt.figure() + for ipft in range(numpft): + plt.plot(bagwd[ipft,:]/1000,bagwi[ipft,:]/1000,linestyle=linestyles[ipft],color=my_colors(ipft),linewidth=lwidth) + plt.xlabel('AGBW deterministic [MgC]') + plt.ylabel('AGBW integrated [MgC]') + plt.title('Above Ground Biomass') + plt.grid(True) + plt.tight_layout() + +if(False): + fig5=plt.figure() + for ipft in range(numpft): + gpmask = np.isfinite(blmax_o_dbagwdh[ipft,:]) + plt.plot(dbh[ipft,gpmask],blmax_o_dbagwdh[ipft,gpmask],linestyle=linestyles[ipft],color=my_colors(ipft),linewidth=lwidth) + plt.xlabel('diameter [cm]') + plt.ylabel('growth potential: bl/(dAGB/dh) [m]') + plt.title('Height Growth Potential') + plt.grid(True) + plt.tight_layout() + +if(False): + fig6=plt.figure() + for ipft in range(numpft): + plt.plot(dbh[ipft,:],blmax_o_dbagwdd[ipft,:],linestyle=linestyles[ipft],color=my_colors(ipft),linewidth=lwidth) + plt.xlabel('diameter [cm]') + plt.ylabel('growth potential: bl/(dAGB/dd) [cm]') + plt.title('Diameter Growth Potential') + plt.grid(True) + plt.tight_layout() + +if(False): + fig7=plt.figure() + for ipft in range(numpft): + plt.plot(bsapd[ipft,:],bsapi[ipft,:],linestyle=linestyles[ipft],color=my_colors(ipft),linewidth=lwidth) + plt.xlabel('deterministic [kgC]') + plt.ylabel('integrated [kgC]') + plt.title('Sapwood Biomass') + plt.grid(True) + plt.tight_layout() + +if(False): + fig7_0=plt.figure() + for ipft in range(numpft): + plt.plot(dbh[ipft,:],bsapd[ipft,:],linestyle=linestyles[ipft],color=my_colors(ipft),linewidth=lwidth) + plt.xlabel('Diameter [cm]') + plt.ylabel('[kgC]') + plt.title('Sapwood Biomass') + plt.grid(True) + plt.tight_layout() + +if(True): + fig7_2=plt.figure(figsize=(8,6)) + # Sapwood + ax = fig7_2.add_subplot(221) + for ipft in range(numpft): + ax.plot(dbh[ipft,:],bsapd[ipft,:]/(bsapd[ipft,:]+blmaxi[ipft,:]+bfrmax[ipft,:]+bstore[ipft,:]), \ + linestyle=linestyles[ipft],color=my_colors(ipft),linewidth=lwidth) + ax.set_xlabel('diameter [cm]') + ax.set_ylabel('[kgC/kgC]') + ax.set_title('Sapwood (fraction of total live)') + ax.grid(True) + # Leaf + ax = fig7_2.add_subplot(222) + for ipft in range(numpft): + ax.plot(dbh[ipft,:],blmaxi[ipft,:]/(bsapd[ipft,:]+blmaxi[ipft,:]+bfrmax[ipft,:]+bstore[ipft,:]), \ + linestyle=linestyles[ipft],color=my_colors(ipft),linewidth=lwidth) + ax.set_xlabel('diameter [cm]') + ax.set_ylabel('[kgC/kgC]') + ax.set_title('Leaf (fraction of total live)') + ax.grid(True) + # Fine Root + ax = fig7_2.add_subplot(223) + for ipft in range(numpft): + ax.plot(dbh[ipft,:],bfrmax[ipft,:]/(bsapd[ipft,:]+blmaxi[ipft,:]+bfrmax[ipft,:]+bstore[ipft,:]), \ + linestyle=linestyles[ipft],color=my_colors(ipft),linewidth=lwidth) + ax.set_xlabel('diameter [cm]') + ax.set_ylabel('[kgC/kgC]') + ax.set_title('Fine-Root (fraction of total live)') + ax.grid(True) + # Storage + ax = fig7_2.add_subplot(224) + for ipft in range(numpft): + ax.plot(dbh[ipft,:],bstore[ipft,:]/(bsapd[ipft,:]+blmaxi[ipft,:]+bfrmax[ipft,:]+bstore[ipft,:]), \ + linestyle=linestyles[ipft],color=my_colors(ipft),linewidth=lwidth) + ax.set_xlabel('diameter [cm]') + ax.set_ylabel('[kgC/kgC]') + ax.set_title('Storage (fraction of total live)') + ax.grid(True) + + plt.tight_layout() + + + +if(True): + fig8=plt.figure() + for ipft in range(numpft): + plt.semilogy(dbh[ipft,:],treelai[ipft,:],linestyle=linestyles[ipft],color=my_colors(ipft),linewidth=lwidth) + plt.xlabel('diameter [cm]') + plt.ylabel('[m2/m2]') + plt.title('In-Crown LAI') + plt.grid(True) + plt.tight_layout() + + +# print(blmaxi[2,:]) +# print(bfrmax[2,:]) +# print(bstore[2,:]) +# print(bsapd[2,:]) + +plt.show() diff --git a/functional_unit_testing/allometry/f90src/AllomUnitWrap.F90_in b/functional_unit_testing/allometry/f90src/AllomUnitWrap.F90_in new file mode 100644 index 0000000000..471314b0bf --- /dev/null +++ b/functional_unit_testing/allometry/f90src/AllomUnitWrap.F90_in @@ -0,0 +1,218 @@ + +! ======================================================================================= +! +! This file is an alternative to key files in the fates +! filesystem. Noteably, we replace fates_r8 and fates_in +! with types that work with "ctypes". This is +! a key step in working with python +! +! We also wrap FatesGlobals to reduce the dependancy +! cascade that it pulls in from shr_log_mod. +! +! ======================================================================================= + +module shr_log_mod + + use iso_c_binding, only : c_char + use iso_c_binding, only : c_int + + contains + + function shr_log_errMsg(source, line) result(ans) + character(kind=c_char,len=*), intent(in) :: source + integer(c_int), intent(in) :: line + character(kind=c_char,len=128) :: ans + + ans = "source: " // trim(source) // " line: " + end function shr_log_errMsg + +end module shr_log_mod + + +module FatesGlobals + + contains + + integer function fates_log() + fates_log = -1 + end function fates_log + + subroutine fates_endrun(msg) + + implicit none + character(len=*), intent(in) :: msg ! string to be printed + + stop + + end subroutine fates_endrun + +end module FatesGlobals + + +module EDTypesMod + + use iso_c_binding, only : r8 => c_double + + integer, parameter :: nclmax = 2 + integer, parameter :: nlevleaf = 30 + real(r8), parameter :: dinc_ed = 1.0_r8 + +end module EDTypesMod + + +module EDPftvarcon + + use iso_c_binding, only : r8 => c_double + use iso_c_binding, only : i4 => c_int + use iso_c_binding, only : c_char + + integer,parameter :: SHR_KIND_CS = 80 ! short char + + type, public :: EDPftvarcon_inst_type + + ! VARIABLE-DEFINITIONS-HERE (DO NOT REMOVE THIS LINE, OR MOVE IT) + + end type EDPftvarcon_inst_type + + type ptr_var1 + real(r8), dimension(:), pointer :: var_rp + integer(i4), dimension(:), pointer :: var_ip + character(len=shr_kind_cs) :: var_name + integer :: vtype + end type ptr_var1 + + type ptr_var2 + real(r8), dimension(:,:), pointer :: var_rp + integer(i4), dimension(:,:), pointer :: var_ip + character(len=shr_kind_cs) :: var_name + integer :: vtype + end type ptr_var2 + + type EDPftvarcon_ptr_type + type(ptr_var1), allocatable :: var1d(:) + type(ptr_var2), allocatable :: var2d(:) + end type EDPftvarcon_ptr_type + + + type(EDPftvarcon_inst_type), public :: EDPftvarcon_inst ! ED ecophysiological constants structure + type(EDPftvarcon_ptr_type), public :: EDPftvarcon_ptr ! Pointer structure for obj-oriented id + + integer :: numparm1d ! Number of different PFT parameters + integer :: numparm2d + integer :: numpft + + logical, parameter :: debug = .true. + +contains + + + subroutine EDPftvarconPySet(ipft,rval,ival,name) + + implicit none + ! Arguments + integer(i4),intent(in) :: ipft + character(kind=c_char,len=*), intent(in) :: name + real(r8),intent(in) :: rval + integer(i4),intent(in) :: ival + ! Locals + logical :: npfound + integer :: ip + integer :: namelen + + namelen = len(trim(name)) + + if(debug) print*,"F90: ARGS: ",trim(name)," IPFT: ",ipft," RVAL: ",rval," IVAL: ",ival + + ip=0 + npfound = .true. + do ip=1,numparm1d + + if (trim(name) == trim(EDPftvarcon_ptr%var1d(ip)%var_name ) ) then + print*,"F90: Found ",trim(name)," in lookup table" + npfound = .false. + if(EDPftvarcon_ptr%var1d(ip)%vtype == 1) then ! real + EDPftvarcon_ptr%var1d(ip)%var_rp(ipft) = rval + elseif(EDPftvarcon_ptr%var1d(ip)%vtype == 2) then ! integer + EDPftvarcon_ptr%var1d(ip)%var_ip(ipft) = ival + else + print*,"F90: STRANGE TYPE" + stop + end if + end if + end do + + if(npfound)then + print*,"F90: The parameter you loaded DNE: ",name(:) + stop + end if + + do ip=1,numparm2d + if (trim(name) == trim(EDPftvarcon_ptr%var2d(ip)%var_name)) then + print*,"F90: Found ",trim(name)," in lookup table" + print*,"BUT... WE AVOID USING 2D VARIABLES FOR NOW..." + print*,"REMOVE THIS TEST" + stop + end if + end do + + + ! Perform a check to see if the target array is being filled + if (trim(name) == 'fates_allom_d2h1') then + if (EDPftvarcon_inst%allom_d2h1(ipft) == rval) then + print*,"F90: POINTER CHECK PASSES:",rval," = ",EDPftvarcon_inst%allom_d2h1(ipft) + else + print*,"F90: POINTER CHECK FAILS:",rval," != ",EDPftvarcon_inst%allom_d2h1(ipft) + stop + end if + end if + + if (trim(name) == 'fates_wood_density' ) then + if (EDPftvarcon_inst%wood_density(ipft) == rval) then + print*,"F90: POINTER CHECK PASSES:",rval," = ",EDPftvarcon_inst%wood_density(ipft) + else + print*,"F90: POINTER CHECK FAILS:",rval," != ",EDPftvarcon_inst%wood_density(ipft) + stop + end if + end if + + return + end subroutine EDPftvarconPySet + + + subroutine EDPftvarconAlloc(numpft_in) + ! + + ! !ARGUMENTS: + integer(i4), intent(in) :: numpft_in + ! LOCALS: + integer :: iv1 ! The parameter incrementer + integer :: iv2 + !------------------------------------------------------------------------ + + numpft = numpft_in + + allocate( EDPftvarcon_ptr%var1d(100)) ! Make this plenty large + allocate( EDPftvarcon_ptr%var2d(100)) + iv1=0 + iv2=0 + + ! POINTER-SPECIFICATION-HERE (DO NOT REMOVE THIS LINE, OR MOVE IT) + +! allocate( EDPftvarcon_inst%allom_dbh_maxheight (1:numpft)); EDPftvarcon_inst%allom_dbh_maxheight (:) = nan +! iv = iv + 1 +! EDPftvarcon_ptr%var1d(iv)%var_name = "fates_allom_dbh_maxheight" +! EDPftvarcon_ptr%var1d(iv)%var_rp => EDPftvarcon_inst%allom_dbh_maxheight +! EDPftvarcon_ptr%var1d(iv)%vtype = 1 + + + numparm1d = iv1 + numparm2d = iv2 + + + print*,"F90: ALLOCATED ",numparm1d," PARAMETERS, FOR ",numpft," PFTs" + + + return + end subroutine EDPftvarconAlloc + +end module EDPftvarcon diff --git a/functional_unit_testing/allometry/include/README b/functional_unit_testing/allometry/include/README new file mode 100644 index 0000000000..bfa612f78d --- /dev/null +++ b/functional_unit_testing/allometry/include/README @@ -0,0 +1 @@ +This holds the place of the include folder \ No newline at end of file diff --git a/functional_unit_testing/allometry/plots/README b/functional_unit_testing/allometry/plots/README new file mode 100644 index 0000000000..c32df9df9a --- /dev/null +++ b/functional_unit_testing/allometry/plots/README @@ -0,0 +1 @@ +Placeholder for the folder \ No newline at end of file diff --git a/functional_unit_testing/allometry/simple_build.sh b/functional_unit_testing/allometry/simple_build.sh new file mode 100755 index 0000000000..a06b9724b0 --- /dev/null +++ b/functional_unit_testing/allometry/simple_build.sh @@ -0,0 +1,57 @@ +#!/bin/bash + +FC='gfortran -g -shared -fPIC' + +# First copy over the FatesConstants file, but change the types of the fates_r8 and fates_int + +old_fates_r8_str=`grep -e integer ../../main/FatesConstantsMod.F90 | grep fates_r8 | sed 's/^[ \t]*//;s/[ \t]*$//'` +new_fates_r8_str='use iso_c_binding, only: fates_r8 => c_double' + +old_fates_int_str=`grep -e integer ../../main/FatesConstantsMod.F90 | grep fates_int | sed 's/^[ \t]*//;s/[ \t]*$//'` +new_fates_int_str='use iso_c_binding, only: fates_int => c_int' + +# Add the new lines (need position change, don't swap) + +sed "/implicit none/i $new_fates_r8_str" ../../main/FatesConstantsMod.F90 > f90src/FatesConstantsMod.F90 +sed -i "/implicit none/i $new_fates_int_str" f90src/FatesConstantsMod.F90 + +# Delete the old lines + +sed -i "/$old_fates_r8_str/d" f90src/FatesConstantsMod.F90 +sed -i "/$old_fates_int_str/d" f90src/FatesConstantsMod.F90 + + +# This re-writes the wrapper so that it uses all the correct parameters +# in FatesAllometryMod.F90 +python AutoGenVarCon.py + + +# Procedure for auto-generating AllomUnitWrap +# 1) scan FatesAllometry and create list of EDPftVarcon_inst variables +# 2) scan EDpftVarcon and get the name of the in-file parameter names associated +# with these variables + + + + +rm -f include/*.o +rm -f include/*.mod + + +# Build the new file with constants + +${FC} -I include/ -J include/ -o include/FatesConstantsMod.o f90src/FatesConstantsMod.F90 + +${FC} -I include/ -J include/ -o include/AllomUnitWrap.o f90src/AllomUnitWrap.F90 + +${FC} -I include/ -J include/ -o include/FatesAllometryMod.o ../../biogeochem/FatesAllometryMod.F90 + + +#${FC} -g -o include/FatesConstantsMod.o ../main/FatesConstantsMod.F90 + +#gfortran -shared -fPIC -g -o include/EDTypesMod.o ../main/EDTypesMod.F90 + + + + +#gfortran diff --git a/functional_unit_testing/parteh/f_wrapper_modules/FatesCohortWrapMod.F90 b/functional_unit_testing/parteh/f_wrapper_modules/FatesCohortWrapMod.F90 index 9907c567b9..78b9bfa271 100644 --- a/functional_unit_testing/parteh/f_wrapper_modules/FatesCohortWrapMod.F90 +++ b/functional_unit_testing/parteh/f_wrapper_modules/FatesCohortWrapMod.F90 @@ -22,13 +22,12 @@ module FatesCohortWrapMod use EDPftvarcon, only : EDPftvarcon_inst - use PRTGenericMod, only : InitPRTVartype use PRTGenericMod, only : prt_vartypes use PRTGenericMod, only : leaf_organ use PRTGenericMod, only : all_carbon_elements use PRTGenericMod, only : carbon12_element use PRTGenericMod, only : nitrogen_element - use PRTGenericMod, only : phosphorous_element + use PRTGenericMod, only : phosphorus_element use PRTGenericMod, only : leaf_organ use PRTGenericMod, only : fnrt_organ use PRTGenericMod, only : sapw_organ @@ -74,12 +73,10 @@ module FatesCohortWrapMod use FatesGlobals , only : fates_log use shr_log_mod , only : errMsg => shr_log_errMsg - - implicit none + private ! Modules are private by default - - type ed_cohort_type + type, public :: ed_cohort_type integer :: pft ! pft number integer :: parteh_model ! The PARTEH allocation hypothesis used @@ -92,14 +89,14 @@ module FatesCohortWrapMod real(r8) :: daily_carbon_gain ! real(r8) :: daily_nitrogen_gain ! - real(r8) :: daily_phosphorous_gain ! + real(r8) :: daily_phosphorus_gain ! real(r8) :: daily_r_grow ! real(r8) :: daily_r_maint ! real(r8) :: daily_r_maint_demand ! real(r8) :: accum_r_maint_deficit ! real(r8) :: carbon_root_exudate ! real(r8) :: nitrogen_root_exudate ! - real(r8) :: phosphorous_root_exudate ! + real(r8) :: phosphorus_root_exudate ! ! Multi-species, multi-pool Reactive Transport @@ -109,10 +106,17 @@ module FatesCohortWrapMod ! Global Instances - type(ed_cohort_type), pointer :: cohort_array(:) - integer :: numcohort + type(ed_cohort_type), pointer, public :: cohort_array(:) + integer, public :: numcohort character(len=*), parameter, private :: sourcefile = __FILE__ + + ! Make necessary procedures public + public :: CohortInitAlloc + public :: CohortPySet + public :: WrapDailyPRT + public :: WrapQueryVars + public :: WrapQueryDiagnostics contains @@ -139,14 +143,14 @@ subroutine CohortInitAlloc(numcohorts) ccohort%ddbhdt = -999.9_r8 ccohort%daily_carbon_gain = -999.9_r8 ccohort%daily_nitrogen_gain = -999.9_r8 - ccohort%daily_phosphorous_gain = -999.9_r8 + ccohort%daily_phosphorus_gain = -999.9_r8 ccohort%daily_r_grow = -999.9_r8 ccohort%daily_r_maint = -999.9_r8 ccohort%daily_r_maint_demand = -999.9_r8 ccohort%accum_r_maint_deficit = -999.9_r8 ccohort%carbon_root_exudate = -999.9_r8 ccohort%nitrogen_root_exudate = -999.9_r8 - ccohort%phosphorous_root_exudate = -999.9_r8 + ccohort%phosphorus_root_exudate = -999.9_r8 end do return @@ -298,18 +302,18 @@ subroutine CohortPySet(ipft,hgt_min,canopy_trim) call SetState(ccohort%prt,struct_organ , nitrogen_element, struct_n) call SetState(ccohort%prt,repro_organ , nitrogen_element, repro_n) - call SetState(ccohort%prt,leaf_organ, phosphorous_element, leaf_p) - call SetState(ccohort%prt,fnrt_organ, phosphorous_element, fnrt_p) - call SetState(ccohort%prt,sapw_organ, phosphorous_element, sapw_p) - call SetState(ccohort%prt,store_organ, phosphorous_element, store_p) - call SetState(ccohort%prt,struct_organ , phosphorous_element, struct_p) - call SetState(ccohort%prt,repro_organ , phosphorous_element, repro_p) + call SetState(ccohort%prt,leaf_organ, phosphorus_element, leaf_p) + call SetState(ccohort%prt,fnrt_organ, phosphorus_element, fnrt_p) + call SetState(ccohort%prt,sapw_organ, phosphorus_element, sapw_p) + call SetState(ccohort%prt,store_organ, phosphorus_element, store_p) + call SetState(ccohort%prt,struct_organ , phosphorus_element, struct_p) + call SetState(ccohort%prt,repro_organ , phosphorus_element, repro_p) ! Register In/Out Boundary Conditions call ccohort%prt%RegisterBCInOut(acnp_bc_inout_id_dbh,bc_rval = ccohort%dbh) call ccohort%prt%RegisterBCInOut(acnp_bc_inout_id_netdc,bc_rval = ccohort%daily_carbon_gain) call ccohort%prt%RegisterBCInOut(acnp_bc_inout_id_netdn,bc_rval = ccohort%daily_nitrogen_gain) - call ccohort%prt%RegisterBCInOut(acnp_bc_inout_id_netdp,bc_rval = ccohort%daily_phosphorous_gain) + call ccohort%prt%RegisterBCInOut(acnp_bc_inout_id_netdp,bc_rval = ccohort%daily_phosphorus_gain) call ccohort%prt%RegisterBCInOut(acnp_bc_inout_id_rmaint_def, bc_rval = ccohort%accum_r_maint_deficit) ! Register Input only BC's @@ -320,7 +324,7 @@ subroutine CohortPySet(ipft,hgt_min,canopy_trim) ! Register Output Boundary Conditions call ccohort%prt%RegisterBCOut(acnp_bc_out_id_rootcexude,bc_rval = ccohort%carbon_root_exudate) call ccohort%prt%RegisterBCOut(acnp_bc_out_id_rootnexude,bc_rval = ccohort%nitrogen_root_exudate) - call ccohort%prt%RegisterBCOut(acnp_bc_out_id_rootpexude,bc_rval = ccohort%phosphorous_root_exudate) + call ccohort%prt%RegisterBCOut(acnp_bc_out_id_rootpexude,bc_rval = ccohort%phosphorus_root_exudate) call ccohort%prt%RegisterBCOut(acnp_bc_out_id_growresp,bc_rval = ccohort%daily_r_grow ) @@ -334,7 +338,7 @@ end subroutine CohortPySet ! ===================================================================================== subroutine WrapDailyPRT(ipft,daily_carbon_gain,canopy_trim,flush_c,drop_frac_c,leaf_status, & - daily_nitrogen_gain, daily_phosphorous_gain,daily_r_maint_demand ) + daily_nitrogen_gain, daily_phosphorus_gain,daily_r_maint_demand ) implicit none ! Arguments @@ -345,7 +349,7 @@ subroutine WrapDailyPRT(ipft,daily_carbon_gain,canopy_trim,flush_c,drop_frac_c,l real(r8),intent(in) :: drop_frac_c integer,intent(in) :: leaf_status real(r8), intent(in), optional :: daily_nitrogen_gain - real(r8), intent(in), optional :: daily_phosphorous_gain + real(r8), intent(in), optional :: daily_phosphorus_gain real(r8), intent(in), optional :: daily_r_maint_demand type(ed_cohort_type), pointer :: ccohort @@ -379,7 +383,7 @@ subroutine WrapDailyPRT(ipft,daily_carbon_gain,canopy_trim,flush_c,drop_frac_c,l prt_global => prt_global_acnp ccohort%daily_carbon_gain = daily_carbon_gain ccohort%daily_nitrogen_gain = daily_nitrogen_gain - ccohort%daily_phosphorous_gain = daily_phosphorous_gain + ccohort%daily_phosphorus_gain = daily_phosphorus_gain ccohort%accum_r_maint_deficit = ccohort%accum_r_maint_deficit + & daily_r_maint_demand @@ -457,7 +461,7 @@ subroutine WrapQueryDiagnostics(ipft, dbh, & leaf_p, fnrt_p, sapw_p, store_p, struct_p, repro_p, & leaf_pturn, fnrt_pturn, sapw_pturn, store_pturn, struct_pturn, & crown_area, & - carbon_root_exudate, nitrogen_root_exudate, phosphorous_root_exudate, & + carbon_root_exudate, nitrogen_root_exudate, phosphorus_root_exudate, & growth_resp ) implicit none @@ -504,7 +508,7 @@ subroutine WrapQueryDiagnostics(ipft, dbh, & real(r8),intent(out) :: carbon_root_exudate real(r8),intent(out) :: nitrogen_root_exudate - real(r8),intent(out) :: phosphorous_root_exudate + real(r8),intent(out) :: phosphorus_root_exudate real(r8),intent(out) :: growth_resp real(r8),intent(out) :: crown_area @@ -549,18 +553,18 @@ subroutine WrapQueryDiagnostics(ipft, dbh, & store_nturn = ccohort%prt%GetTurnover(organ_id=store_organ, species_id=nitrogen_element) struct_nturn = ccohort%prt%GetTurnover(organ_id=struct_organ, species_id=nitrogen_element) - leaf_p = ccohort%prt%GetState(organ_id=leaf_organ, species_id=phosphorous_element) - fnrt_p = ccohort%prt%GetState(organ_id=fnrt_organ, species_id=phosphorous_element) - sapw_p = ccohort%prt%GetState(organ_id=sapw_organ, species_id=phosphorous_element) - store_p = ccohort%prt%GetState(organ_id=store_organ, species_id=phosphorous_element) - struct_p = ccohort%prt%GetState(organ_id=struct_organ, species_id=phosphorous_element) - repro_p = ccohort%prt%GetState(organ_id=repro_organ, species_id=phosphorous_element) + leaf_p = ccohort%prt%GetState(organ_id=leaf_organ, species_id=phosphorus_element) + fnrt_p = ccohort%prt%GetState(organ_id=fnrt_organ, species_id=phosphorus_element) + sapw_p = ccohort%prt%GetState(organ_id=sapw_organ, species_id=phosphorus_element) + store_p = ccohort%prt%GetState(organ_id=store_organ, species_id=phosphorus_element) + struct_p = ccohort%prt%GetState(organ_id=struct_organ, species_id=phosphorus_element) + repro_p = ccohort%prt%GetState(organ_id=repro_organ, species_id=phosphorus_element) - leaf_pturn = ccohort%prt%GetTurnover(organ_id=leaf_organ, species_id=phosphorous_element) - fnrt_pturn = ccohort%prt%GetTurnover(organ_id=fnrt_organ, species_id=phosphorous_element) - sapw_pturn = ccohort%prt%GetTurnover(organ_id=sapw_organ, species_id=phosphorous_element) - store_pturn = ccohort%prt%GetTurnover(organ_id=store_organ, species_id=phosphorous_element) - struct_pturn = ccohort%prt%GetTurnover(organ_id=struct_organ, species_id=phosphorous_element) + leaf_pturn = ccohort%prt%GetTurnover(organ_id=leaf_organ, species_id=phosphorus_element) + fnrt_pturn = ccohort%prt%GetTurnover(organ_id=fnrt_organ, species_id=phosphorus_element) + sapw_pturn = ccohort%prt%GetTurnover(organ_id=sapw_organ, species_id=phosphorus_element) + store_pturn = ccohort%prt%GetTurnover(organ_id=store_organ, species_id=phosphorus_element) + struct_pturn = ccohort%prt%GetTurnover(organ_id=struct_organ, species_id=phosphorus_element) growth_resp = ccohort%daily_r_grow @@ -568,7 +572,7 @@ subroutine WrapQueryDiagnostics(ipft, dbh, & carbon_root_exudate = ccohort%carbon_root_exudate nitrogen_root_exudate = ccohort%nitrogen_root_exudate - phosphorous_root_exudate = ccohort%phosphorous_root_exudate + phosphorus_root_exudate = ccohort%phosphorus_root_exudate return end subroutine WrapQueryDiagnostics diff --git a/functional_unit_testing/parteh/f_wrapper_modules/FatesPARTEHWrapMod.F90 b/functional_unit_testing/parteh/f_wrapper_modules/FatesPARTEHWrapMod.F90 index 1b5b363377..e5f214ebca 100644 --- a/functional_unit_testing/parteh/f_wrapper_modules/FatesPARTEHWrapMod.F90 +++ b/functional_unit_testing/parteh/f_wrapper_modules/FatesPARTEHWrapMod.F90 @@ -22,9 +22,14 @@ module FatesPARTEHWrapMod use iso_c_binding, only : c_char implicit none + private character(len=*), parameter, private :: sourcefile = __FILE__ + ! Make necessary procedures public + + public :: SPMapPyset + contains diff --git a/functional_unit_testing/parteh/f_wrapper_modules/FatesPFTWrapMod.F90 b/functional_unit_testing/parteh/f_wrapper_modules/FatesPFTWrapMod.F90 index f186be1b84..e5a2c25766 100644 --- a/functional_unit_testing/parteh/f_wrapper_modules/FatesPFTWrapMod.F90 +++ b/functional_unit_testing/parteh/f_wrapper_modules/FatesPFTWrapMod.F90 @@ -10,7 +10,10 @@ module EDPftvarcon use iso_c_binding, only : i4 => c_int use iso_c_binding, only : c_char - integer,parameter :: SHR_KIND_CS = 80 ! short char + implicit none + private ! Modules are private by default + + integer,parameter,public :: SHR_KIND_CS = 80 ! short char type, public :: EDPftvarcon_inst_type @@ -106,24 +109,27 @@ module EDPftvarcon end type EDPftvarcon_inst_type - type pftptr_var + type, public :: pftptr_var real(r8), dimension(:), pointer :: rp_1d real(r8), dimension(:,:), pointer :: rp_2d character(len=shr_kind_cs) :: var_name end type pftptr_var - type EDPftvarcon_ptr_type + type, public :: EDPftvarcon_ptr_type type(pftptr_var), allocatable :: var(:) end type EDPftvarcon_ptr_type type(EDPftvarcon_inst_type), public :: EDPftvarcon_inst ! ED ecophysiological constants structure type(EDPftvarcon_ptr_type), public :: EDPftvarcon_ptr ! Pointer structure for obj-oriented id - integer :: numparm ! Number of different PFT parameters - integer :: num_pft ! Number of PFTs - integer :: num_organs ! Number of organs - + integer, public :: numparm ! Number of different PFT parameters + integer, public :: num_pft ! Number of PFTs + integer, public :: num_organs ! Number of organs + ! Make necessary procedures public + public :: EDPftvarconPySet + public :: EDPftvarconAlloc + contains diff --git a/functional_unit_testing/parteh/f_wrapper_modules/FatesWrapMod.F90 b/functional_unit_testing/parteh/f_wrapper_modules/FatesWrapMod.F90 index 31d1d51a2d..ad28d50c55 100644 --- a/functional_unit_testing/parteh/f_wrapper_modules/FatesWrapMod.F90 +++ b/functional_unit_testing/parteh/f_wrapper_modules/FatesWrapMod.F90 @@ -9,51 +9,71 @@ module EDTypesMod use iso_c_binding, only: fates_r8 => c_double use iso_c_binding, only: fates_int => c_int - integer(fates_int), parameter :: nlevleaf = 40 - real(fates_r8), parameter :: dinc_ed = 1.0_fates_r8 - integer(fates_int), parameter :: nclmax = 4 + implicit none + private + + integer(fates_int), parameter, public :: nlevleaf = 40 + real(fates_r8), parameter, public :: dinc_ed = 1.0_fates_r8 + integer(fates_int), parameter, public :: nclmax = 4 end module EDTypesMod module shr_log_mod - use iso_c_binding, only : c_char - use iso_c_binding, only : c_int + use iso_c_binding, only : c_char + use iso_c_binding, only : c_int + + implicit none + private + + ! Make necessary producers public + public :: shr_log_errMsg - contains + contains - function shr_log_errMsg(source, line) result(ans) + function shr_log_errMsg(source, line) result(ans) character(kind=c_char,len=*), intent(in) :: source integer(c_int), intent(in) :: line character(kind=c_char,len=128) :: ans ans = "source: " // trim(source) // " line: " - end function shr_log_errMsg + end function shr_log_errMsg end module shr_log_mod module FatesInterfaceMod use iso_c_binding, only: fates_r8 => c_double - real(fates_r8), parameter :: hlm_freq_day = 1.0_fates_r8/365.0_fates_r8 + + implicit none + private + + real(fates_r8), parameter, public :: hlm_freq_day = 1.0_fates_r8/365.0_fates_r8 end module FatesInterfaceMod module FatesGlobals -contains - - integer function fates_log() - fates_log = 6 ! usually stdout - end function fates_log - - subroutine fates_endrun(msg) + implicit none + private + + ! Make necessary producers public + public :: fates_log + public :: fates_endrun + + contains + + integer function fates_log() + fates_log = 6 ! usually stdout + end function fates_log - implicit none - character(len=*), intent(in) :: msg ! string to be printed - stop - end subroutine fates_endrun + subroutine fates_endrun(msg) + + implicit none + character(len=*), intent(in) :: msg ! string to be printed + stop + end subroutine fates_endrun end module FatesGlobals diff --git a/functional_unit_testing/parteh/py_modules/SyntheticBoundaries.py b/functional_unit_testing/parteh/py_modules/SyntheticBoundaries.py index 27f6ed5edc..0a4d7ed07e 100644 --- a/functional_unit_testing/parteh/py_modules/SyntheticBoundaries.py +++ b/functional_unit_testing/parteh/py_modules/SyntheticBoundaries.py @@ -86,7 +86,7 @@ def DailyCNPFromCArea(presc_npp_p1,presc_nflux_p1, \ # presc_npp_canopy, npp generated per crown area in canopy [kgC/m2/yr] # presc_npp_understory, npp generated per crown area in understory [kgC/m2/yr] # presc_nflux_p1, Nitrogen flux per crown area [kgN/m2/yr] - # presc_pflux_p1, Phosphorous flux per crown area [kgP/m2/yr] + # presc_pflux_p1, Phosphorus flux per crown area [kgP/m2/yr] # ----------------------------------------------------------------------------------- if( (phen_type == 1) or (leaf_status ==2)): diff --git a/main/ChecksBalancesMod.F90 b/main/ChecksBalancesMod.F90 index 044a191fa2..72d9288a51 100644 --- a/main/ChecksBalancesMod.F90 +++ b/main/ChecksBalancesMod.F90 @@ -1,299 +1,244 @@ module ChecksBalancesMod - use shr_kind_mod, only : r8 => shr_kind_r8 - use shr_const_mod, only : SHR_CONST_CDAY - use EDtypesMod, only : ed_site_type,ed_patch_type,ed_cohort_type - use EDTypesMod, only : AREA - use FatesConstantsMod, only : g_per_kg - 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 shr_kind_mod, only : r8 => shr_kind_r8 + use shr_const_mod, only : SHR_CONST_CDAY + 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 : site_massbal_type + use EDTypesMod, only : num_elements + use EDTypesMod, only : element_list + use FatesInterfaceMod, only : numpft + use FatesConstantsMod, only : g_per_kg + use FatesInterfaceMod, only : bc_in_type + use FatesLitterMod, only : litter_type + use FatesLitterMod, only : ncwd + use FatesLitterMod, only : ndcmpy + 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 FatesGlobals, only : fates_log + use shr_log_mod, only : errMsg => shr_log_errMsg + use FatesGlobals, only : endrun => fates_endrun implicit none private - public :: SummarizeNetFluxes - public :: FATES_BGC_Carbon_Balancecheck - public :: SiteCarbonStock + public :: SiteMassStock + public :: PatchMassStock -contains - - !------------------------------------------------------------------------ - - subroutine SummarizeNetFluxes( nsites, sites, bc_in, is_beg_day ) - - ! Summarize the combined production and decomposition fluxes into net fluxes - ! This is done on the fast timestep, and to be called after both daily ED calls and - ! fast BGC calls. Does not include summarization of fast-timestsp productivity calls - ! because these must be summarized prior to daily ED calls - ! - ! Written by Charlie Koven, Feb 2016 - ! - ! !USES: - use FatesInterfaceMod , only : bc_in_type - - use EDtypesMod , only : AREA - ! - implicit none - ! - ! !ARGUMENTS - - integer , intent(in) :: nsites - type(ed_site_type) , intent(inout), target :: sites(nsites) - type(bc_in_type) , intent(in) :: bc_in(nsites) - logical , intent(in) :: is_beg_day - - ! - ! !LOCAL VARIABLES: - integer :: s - - type (ed_patch_type) , pointer :: currentPatch - type (ed_cohort_type) , pointer :: currentCohort - real(r8) :: n_perm2 ! individuals per m2 of the whole column - - do s = 1,nsites - - sites(s)%fire_c_to_atm = 0._r8 ! REMOVE THIS VARIABLE? - sites(s)%ed_litter_stock = 0._r8 - sites(s)%cwd_stock = 0._r8 - sites(s)%biomass_stock = 0._r8 - - ! map ed site-level fire fluxes to clm column fluxes - sites(s)%fire_c_to_atm = sites(s)%total_burn_flux_to_atm / & - ( AREA * SHR_CONST_CDAY * 1.e3_r8) - - currentPatch => sites(s)%oldest_patch - do while(associated(currentPatch)) - - ! map litter, CWD, and seed pools to column level - sites(s)%cwd_stock = sites(s)%cwd_stock + & - (currentPatch%area / AREA) * & - (sum(currentPatch%cwd_ag)+sum(currentPatch%cwd_bg)) * 1.e3_r8 - - sites(s)%ed_litter_stock = sites(s)%ed_litter_stock + & - (currentPatch%area / AREA) * & - (sum(currentPatch%leaf_litter)+sum(currentPatch%root_litter)) * 1.e3_r8 - - currentCohort => currentPatch%tallest - do while(associated(currentCohort)) - ! for quantities that are natively at column level or higher, - ! calculate plant density using whole area (for grid cell averages) - n_perm2 = currentCohort%n/AREA - - ! map biomass pools to column level - sites(s)%biomass_stock = sites(s)%biomass_stock + & - ( currentCohort%prt%GetState(struct_organ,all_carbon_elements) + & - currentCohort%prt%GetState(sapw_organ,all_carbon_elements) + & - currentCohort%prt%GetState(leaf_organ,all_carbon_elements) + & - currentCohort%prt%GetState(fnrt_organ,all_carbon_elements) + & - currentCohort%prt%GetState(store_organ,all_carbon_elements) + & - currentCohort%prt%GetState(repro_organ,all_carbon_elements) ) & - * n_perm2 * g_per_kg - - currentCohort => currentCohort%shorter - enddo !currentCohort - currentPatch => currentPatch%younger - end do ! patch loop - - ! calculate NEP and NBP fluxes - sites(s)%nep = sites(s)%npp - bc_in(s)%tot_het_resp - sites(s)%nbp = sites(s)%npp - ( bc_in(s)%tot_het_resp + sites(s)%fire_c_to_atm ) - - ! FATES stocks - sites(s)%totfatesc = sites(s)%ed_litter_stock + sites(s)%cwd_stock + & - (sum(sites(s)%seed_bank) * 1.e3_r8) + sites(s)%biomass_stock - - ! BGC stocks (used for error checking, totlitc should be zero?) - sites(s)%totbgcc = bc_in(s)%tot_somc + bc_in(s)%tot_litc - - ! Total Ecosystem Carbon Stocks - sites(s)%totecosysc = sites(s)%totfatesc + sites(s)%totbgcc - - end do - - ! in FATES timesteps, because of offset between when ED and BGC reconcile the gain - ! and loss of litterfall carbon, (i.e. FATES reconciles it instantly, while BGC - ! reconciles it incrementally over the subsequent day) calculate the total - ! ED -> BGC flux and keep track of the last day's info for balance checking purposes - if ( is_beg_day ) then - ! - do s = 1,nsites - ! order of operations in the next to lines is quite important ;) - sites(s)%fates_to_bgc_last_ts = sites(s)%fates_to_bgc_this_ts - sites(s)%fates_to_bgc_this_ts = 0._r8 - sites(s)%tot_seed_rain_flux = 0._r8 - - currentPatch => sites(s)%oldest_patch - do while(associated(currentPatch)) - ! - sites(s)%fates_to_bgc_this_ts = sites(s)%fates_to_bgc_this_ts + & - (sum(currentPatch%CWD_AG_out) + sum(currentPatch%CWD_BG_out) + & - sum(currentPatch%leaf_litter_out) + & - sum(currentPatch%root_litter_out)) * & - ( currentPatch%area/AREA ) * 1.e3_r8 / ( 365.0_r8*SHR_CONST_CDAY ) - ! - sites(s)%tot_seed_rain_flux = sites(s)%tot_seed_rain_flux + & - sum(sites(s)%seed_rain_flux) * 1.e3_r8 / ( 365.0_r8*SHR_CONST_CDAY ) - ! - currentPatch => currentPatch%younger - end do !currentPatch - end do - endif - - return - end subroutine SummarizeNetFluxes - - ! ==================================================================================== - - subroutine FATES_BGC_Carbon_Balancecheck(nsites, sites, bc_in, is_beg_day, dtime, nstep) - - ! Integrate in time the fluxes into and out of the ecosystem, and compare these - ! on a daily timestep to the chagne in carbon stocks of the ecosystem - ! - ! Written by Charlie Koven, Feb 2016 - ! - ! !USES: - use FatesInterfaceMod , only : bc_in_type - use EDtypesMod , only : ed_site_type - ! - implicit none - ! - ! !ARGUMENTS - integer , intent(in) :: nsites - type(ed_site_type) , intent(inout), target :: sites(nsites) - type(bc_in_type) , intent(in) :: bc_in(nsites) - logical , intent(in) :: is_beg_day - real(r8) , intent(in) :: dtime ! time-step length (s) - integer , intent(in) :: nstep ! time-step index - - ! !LOCAL VARIABLES: - real(r8) :: error_tolerance = 1.e-6_r8 - integer :: s - - ! TODO: THIS INITIALIZATION SHOULD BE IN AN INITIALIZATION PART OF THE CODE - ! COLD-START PORTION, NSTEP IS >1 FOR RESTARTS RIGHT? (RGK) - if (nstep .le. 1) then - ! when starting up the model, initialize the integrator variables - do s = 1,nsites - sites(s)%totecosysc_old = sites(s)%totecosysc - sites(s)%totfatesc_old = sites(s)%totfatesc - sites(s)%totbgcc_old = sites(s)%totbgcc - sites(s)%nep_timeintegrated = 0._r8 - sites(s)%hr_timeintegrated = 0._r8 - sites(s)%npp_timeintegrated = 0._r8 - ! - ! also initialize the ed-BGC flux variables - sites(s)%fates_to_bgc_this_ts = 0._r8 - sites(s)%fates_to_bgc_last_ts = 0._r8 - ! - sites(s)%cbal_err_fates = 0._r8 - sites(s)%cbal_err_bgc = 0._r8 - sites(s)%cbal_err_tot = 0._r8 - end do - endif - - do s = 1,nsites - sites(s)%nep_timeintegrated = sites(s)%nep_timeintegrated + sites(s)%nep * dtime - sites(s)%hr_timeintegrated = sites(s)%hr_timeintegrated + bc_in(s)%tot_het_resp * dtime - sites(s)%npp_timeintegrated = sites(s)%npp_timeintegrated + sites(s)%npp * dtime - end do - - ! If this is on the dynamics time-step, then we calculate the balance checks - - if ( is_beg_day ) then - - do s = 1,nsites - - ! NBP can only be updated when dynamics level information is available - sites(s)%nbp_integrated = sites(s)%nep_timeintegrated - & - sites(s)%fire_c_to_atm * SHR_CONST_CDAY + & - sites(s)%tot_seed_rain_flux * SHR_CONST_CDAY + character(len=*), parameter, private :: sourcefile = & + __FILE__ - - sites(s)%cbal_err_fates = sites(s)%totfatesc - & - sites(s)%totfatesc_old - & - (sites(s)%npp_timeintegrated + & - sites(s)%tot_seed_rain_flux*SHR_CONST_CDAY - & - sites(s)%fates_to_bgc_this_ts*SHR_CONST_CDAY - & - sites(s)%fire_c_to_atm*SHR_CONST_CDAY) - sites(s)%cbal_err_fates = sites(s)%cbal_err_fates / SHR_CONST_CDAY - - sites(s)%cbal_err_bgc = sites(s)%totbgcc - & - sites(s)%totbgcc_old - & - (sites(s)%fates_to_bgc_last_ts*SHR_CONST_CDAY - & - sites(s)%hr_timeintegrated) - sites(s)%cbal_err_bgc = sites(s)%cbal_err_bgc / SHR_CONST_CDAY - - sites(s)%cbal_err_tot = sites(s)%totecosysc - & - sites(s)%totecosysc_old - & - (sites(s)%nbp_integrated + & - sites(s)%fates_to_bgc_last_ts*SHR_CONST_CDAY - & - sites(s)%fates_to_bgc_this_ts*SHR_CONST_CDAY) - sites(s)%cbal_err_tot = sites(s)%cbal_err_tot / SHR_CONST_CDAY - - ! Send the current to the previous/last - sites(s)%totecosysc_old = sites(s)%totecosysc - sites(s)%totfatesc_old = sites(s)%totfatesc - sites(s)%totbgcc_old = sites(s)%totbgcc - sites(s)%nep_timeintegrated = 0._r8 - sites(s)%npp_timeintegrated = 0._r8 - sites(s)%hr_timeintegrated = 0._r8 - - end do - - endif - - return - end subroutine FATES_BGC_Carbon_Balancecheck +contains - ! ============================================================================================== - - subroutine SiteCarbonStock(currentSite,total_stock,biomass_stock,litter_stock,seed_stock) - + ! ============================================================================================== + + subroutine SiteMassStock(currentSite,el,total_stock,biomass_stock,litter_stock,seed_stock) + type(ed_site_type),intent(inout),target :: currentSite - real(r8),intent(out) :: total_stock - real(r8),intent(out) :: litter_stock - real(r8),intent(out) :: biomass_stock - real(r8),intent(out) :: seed_stock - - type(ed_patch_type), pointer :: currentPatch - type(ed_cohort_type), pointer :: currentCohort - + integer,intent(in) :: el ! This is the element index + ! in FATES (not the parteh global id) + real(r8),intent(out) :: total_stock ! kg + real(r8),intent(out) :: litter_stock ! kg + real(r8),intent(out) :: biomass_stock ! kg + real(r8),intent(out) :: seed_stock ! kg + type(ed_patch_type), pointer :: currentPatch + type(ed_cohort_type), pointer :: currentCohort + real(r8) :: patch_biomass ! kg + real(r8) :: patch_seed ! kg + real(r8) :: patch_litter ! kg + litter_stock = 0.0_r8 biomass_stock = 0.0_r8 - seed_stock = sum(currentSite%seed_bank)*AREA + seed_stock = 0.0_r8 currentPatch => currentSite%oldest_patch do while(associated(currentPatch)) - litter_stock = litter_stock + currentPatch%area * & - (sum(currentPatch%cwd_ag) + & - sum(currentPatch%cwd_bg) + & - sum(currentPatch%leaf_litter) + & - sum(currentPatch%root_litter)) - currentCohort => currentPatch%tallest - do while(associated(currentCohort)) - biomass_stock = biomass_stock + & - (currentCohort%prt%GetState(struct_organ,all_carbon_elements) + & - currentCohort%prt%GetState(sapw_organ,all_carbon_elements) + & - currentCohort%prt%GetState(leaf_organ,all_carbon_elements) + & - currentCohort%prt%GetState(fnrt_organ,all_carbon_elements) + & - currentCohort%prt%GetState(store_organ,all_carbon_elements) + & - currentCohort%prt%GetState(repro_organ,all_carbon_elements) ) & - * currentCohort%n - currentCohort => currentCohort%shorter - enddo !end cohort loop + call PatchMassStock(currentPatch,el,patch_biomass,patch_seed,patch_litter) + litter_stock = litter_stock + patch_litter + biomass_stock = biomass_stock + patch_biomass + seed_stock = seed_stock + patch_seed + currentPatch => currentPatch%younger enddo !end patch loop total_stock = biomass_stock + seed_stock + litter_stock return - end subroutine SiteCarbonStock + end subroutine SiteMassStock + + ! ===================================================================================== + + subroutine PatchMassStock(currentPatch,el,live_stock,seed_stock,litter_stock) + + ! --------------------------------------------------------------------------------- + ! Sum up the mass of the different stocks on a patch for each element + ! --------------------------------------------------------------------------------- + type(ed_patch_type),intent(inout),target :: currentPatch + integer,intent(in) :: el + real(r8),intent(out) :: live_stock + real(r8),intent(out) :: seed_stock + real(r8),intent(out) :: litter_stock + + type(litter_type), pointer :: litt ! litter object + type(ed_cohort_type), pointer :: currentCohort + integer :: element_id + + litt => currentPatch%litter(el) + element_id = element_list(el) + + ! Total non-seed litter in [kg] + litter_stock = currentPatch%area * & + (sum(litt%ag_cwd) + & + sum(litt%bg_cwd) + & + sum(litt%leaf_fines) + & + sum(litt%root_fines)) + + ! Total mass of viable seeds in [kg] + seed_stock = currentPatch%area * & + (sum(litt%seed) + sum(litt%seed_germ)) + + ! Total mass on living plants + live_stock = 0._r8 + currentCohort => currentPatch%tallest + do while(associated(currentCohort)) + live_stock = live_stock + & + (currentCohort%prt%GetState(struct_organ,element_id) + & + currentCohort%prt%GetState(sapw_organ,element_id) + & + currentCohort%prt%GetState(leaf_organ,element_id) + & + currentCohort%prt%GetState(fnrt_organ,element_id) + & + currentCohort%prt%GetState(store_organ,element_id) + & + currentCohort%prt%GetState(repro_organ,element_id) ) & + * currentCohort%n + currentCohort => currentCohort%shorter + enddo !end cohort loop + + return + end subroutine PatchMassStock + + + + ! ===================================================================================== + + subroutine CheckLitterPools(currentSite,bc_in) + + ! ----------------------------------------------------------------------------------- + ! + ! This subroutine checks that the litter pools do not have weird values. + ! Currently, we are only checking for negatives. + ! + ! This is not a carbon balance check. + ! + ! We will usually keep this routine turned off, unless we are actively + ! debugging. + ! + ! ----------------------------------------------------------------------------------- + + + type(ed_site_type), intent(inout), target :: currentSite + type(bc_in_type), intent(in) :: bc_in + + ! Local variables + type(ed_patch_type), pointer :: currentPatch + type(litter_type), pointer :: litt ! Litter object + integer :: el ! Litter element loop index + integer :: element_id ! parteh consistent litter index + integer :: c ! CWD loop index + integer :: ilyr ! soil layer index + integer :: pft ! pft index + integer :: dcmpy ! decomposability index + integer :: numlevsoil ! number of soil layers + + ! We only really run this scheme if we think things are really broken. + ! The balance checks should be our first line of defense that are + ! always on. + + logical, parameter :: do_litter_checks = .true. + + + if(.not.do_litter_checks) return + + numlevsoil = bc_in%nlevsoil + + do el = 1, num_elements + + currentPatch => currentSite%oldest_patch + do while(associated(currentPatch)) + + litt => currentPatch%litter(el) + element_id = litt%element_id + + do c = 1,ncwd + if(litt%ag_cwd(c)<0._r8) then + write(fates_log(),*) 'In pool: ',c + write(fates_log(),*) 'Element id: ',element_id + write(fates_log(),*) 'Negative AG CWD: ',litt%ag_cwd(c) + write(fates_log(),*) 'lat/lon: ',currentSite%lat,currentSite%lon + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + do ilyr = 1,numlevsoil + if(litt%bg_cwd(c,ilyr)<0._r8) then + write(fates_log(),*) 'In pool: ',c + write(fates_log(),*) 'Soil layer: ',ilyr + write(fates_log(),*) 'Element id: ',element_id + write(fates_log(),*) 'Negative BG CWD: ',litt%bg_cwd(c,ilyr) + write(fates_log(),*) 'lat/lon: ',currentSite%lat,currentSite%lon + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + end do + end do + + do pft = 1,numpft + + if(litt%seed(pft)<0._r8) then + write(fates_log(),*) 'For PFT: ',pft + write(fates_log(),*) 'Element id: ',element_id + write(fates_log(),*) 'Negative seed pool: ',litt%seed(pft) + write(fates_log(),*) 'lat/lon: ',currentSite%lat,currentSite%lon + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + + end do + + do dcmpy = 1,ndcmpy + + if(litt%leaf_fines(dcmpy)<0._r8)then + write(fates_log(),*) 'For PFT: ',pft + write(fates_log(),*) 'Element id: ',element_id + write(fates_log(),*) 'Negative leaf fine litter: ',litt%leaf_fines(dcmpy) + write(fates_log(),*) 'lat/lon: ',currentSite%lat,currentSite%lon + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + do ilyr = 1,numlevsoil + if(litt%root_fines(dcmpy,ilyr)<0._r8)then + write(fates_log(),*) 'For PFT: ',dcmpy + write(fates_log(),*) 'Soil layer: ',ilyr + write(fates_log(),*) 'Element id: ',element_id + write(fates_log(),*) 'Negative leaf fine litter: ',litt%root_fines(dcmpy,ilyr) + write(fates_log(),*) 'lat/lon: ',currentSite%lat,currentSite%lon + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + end do + + end do + currentPatch => currentPatch%older + end do + end do + + return + end subroutine CheckLitterPools + diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index bba2cb139f..ed2665f33b 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -15,18 +15,20 @@ module EDInitMod use FatesInterfaceMod , only : hlm_is_restart use EDPftvarcon , only : EDPftvarcon_inst use EDCohortDynamicsMod , only : create_cohort, fuse_cohorts, sort_cohorts + use EDCohortDynamicsMod , only : InitPRTObject use EDPatchDynamicsMod , only : create_patch + use ChecksBalancesMod , only : SiteMassStock use EDTypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type - use EDTypesMod , only : ncwd use EDTypesMod , only : numWaterMem use EDTypesMod , only : num_vegtemp_mem use EDTypesMod , only : maxpft use EDTypesMod , only : AREA use EDTypesMod , only : init_spread_near_bare_ground use EDTypesMod , only : init_spread_inventory - use EDTypesMod , only : first_leaf_aclass use EDTypesMod , only : leaves_on use EDTypesMod , only : leaves_off + use EDTypesMod , only : num_elements + use EDTypesMod , only : element_list use EDTypesMod , only : phen_cstat_nevercold use EDTypesMod , only : phen_cstat_iscold use EDTypesMod , only : phen_dstat_timeoff @@ -38,7 +40,6 @@ module EDInitMod use FatesInterfaceMod , only : hlm_use_inventory_init use FatesInterfaceMod , only : numpft use FatesInterfaceMod , only : nleafage - use ChecksBalancesMod , only : SiteCarbonStock use FatesInterfaceMod , only : nlevsclass use FatesAllometryMod , only : h2d_allom use FatesAllometryMod , only : bagw_allom @@ -49,6 +50,21 @@ module EDInitMod use FatesAllometryMod , only : bdead_allom use FatesAllometryMod , only : bstore_allom + use FatesInterfaceMod, only : hlm_parteh_mode + use PRTGenericMod, only : prt_carbon_allom_hyp + use PRTGenericMod, only : prt_cnp_flex_allom_hyp + use PRTGenericMod, only : prt_vartypes + use PRTGenericMod, only : leaf_organ + use PRTGenericMod, only : fnrt_organ + use PRTGenericMod, only : sapw_organ + use PRTGenericMod, only : store_organ + use PRTGenericMod, only : struct_organ + use PRTGenericMod, only : repro_organ + use PRTGenericMod, only : carbon12_element + use PRTGenericMod, only : nitrogen_element + use PRTGenericMod, only : phosphorus_element + use PRTGenericMod, only : SetState + ! CIME GLOBALS use shr_log_mod , only : errMsg => shr_log_errMsg @@ -72,16 +88,19 @@ module EDInitMod ! ============================================================================ - subroutine init_site_vars( site_in ) + subroutine init_site_vars( site_in, bc_in ) ! ! !DESCRIPTION: ! ! ! !ARGUMENTS - type(ed_site_type), intent(inout) :: site_in + type(ed_site_type), intent(inout) :: site_in + type(bc_in_type),intent(in) :: bc_in ! ! !LOCAL VARIABLES: !---------------------------------------------------------------------- + integer :: el + ! allocate(site_in%term_nindivs_canopy(1:nlevsclass,1:numpft)) allocate(site_in%term_nindivs_ustory(1:nlevsclass,1:numpft)) @@ -93,6 +112,28 @@ subroutine init_site_vars( site_in ) allocate(site_in%fmort_rate_cambial(1:nlevsclass,1:numpft)) allocate(site_in%fmort_rate_crown(1:nlevsclass,1:numpft)) allocate(site_in%growthflux_fusion(1:nlevsclass,1:numpft)) + allocate(site_in%mass_balance(1:num_elements)) + allocate(site_in%flux_diags(1:num_elements)) + + site_in%nlevsoil = bc_in%nlevsoil + allocate(site_in%rootfrac_scr(site_in%nlevsoil)) + allocate(site_in%zi_soil(0:site_in%nlevsoil)) + allocate(site_in%dz_soil(site_in%nlevsoil)) + allocate(site_in%z_soil(site_in%nlevsoil)) + + do el=1,num_elements + allocate(site_in%flux_diags(el)%leaf_litter_input(1:numpft)) + allocate(site_in%flux_diags(el)%root_litter_input(1:numpft)) + end do + + ! Initialize the static soil + ! arrays from the boundary (initial) condition + + + site_in%zi_soil(:) = bc_in%zi_sisl(:) + site_in%dz_soil(:) = bc_in%dz_sisl(:) + site_in%z_soil(:) = bc_in%z_sisl(:) + ! end subroutine init_site_vars @@ -109,13 +150,12 @@ subroutine zero_site( site_in ) type(ed_site_type), intent(inout) :: site_in ! ! !LOCAL VARIABLES: + integer :: el !---------------------------------------------------------------------- site_in%oldest_patch => null() ! pointer to oldest patch at the site site_in%youngest_patch => null() ! pointer to yngest patch at the site - ! DISTURBANCE - site_in%total_burn_flux_to_atm = 0._r8 ! PHENOLOGY @@ -131,16 +171,19 @@ subroutine zero_site( site_in ) site_in%water_memory(:) = nan site_in%vegtemp_memory(:) = nan ! record of last 10 days temperature for senescence model. - ! SEED - site_in%seed_bank(:) = 0._r8 ! 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%frac_burnt = 0.0_r8 ! burn area read in from external file - ! BGC Balance Checks - site_in%fates_to_bgc_this_ts = 0.0_r8 - site_in%fates_to_bgc_last_ts = 0.0_r8 + do el=1,num_elements + ! Zero the state variables used for checking mass conservation + call site_in%mass_balance(el)%ZeroMassBalState() + call site_in%mass_balance(el)%ZeroMassBalFlux() + call site_in%flux_diags(el)%ZeroFluxDiags() + end do + ! termination and recruitment info site_in%term_nindivs_canopy(:,:) = 0._r8 @@ -165,12 +208,6 @@ subroutine zero_site( site_in ) site_in%demotion_carbonflux = 0._r8 site_in%promotion_rate(:) = 0._r8 site_in%promotion_carbonflux = 0._r8 - - ! diagnostic site-level cwd and litter fluxes - site_in%CWD_AG_diagnostic_input_carbonflux(:) = 0._r8 - site_in%CWD_BG_diagnostic_input_carbonflux(:) = 0._r8 - site_in%leaf_litter_diagnostic_input_carbonflux(:) = 0._r8 - site_in%root_litter_diagnostic_input_carbonflux(:) = 0._r8 ! Resources management (logging/harvesting, etc) site_in%resources_management%trunk_product_site = 0.0_r8 @@ -181,7 +218,7 @@ subroutine zero_site( site_in ) end subroutine zero_site ! ============================================================================ - subroutine set_site_properties( nsites, sites) + subroutine set_site_properties( nsites, sites ) ! ! !DESCRIPTION: ! @@ -191,6 +228,7 @@ subroutine set_site_properties( nsites, sites) integer, intent(in) :: nsites type(ed_site_type) , intent(inout), target :: sites(nsites) + ! ! !LOCAL VARIABLES: integer :: s @@ -243,8 +281,9 @@ subroutine set_site_properties( nsites, sites) sites(s)%dstatus = dstat sites(s)%acc_NI = acc_NI + sites(s)%NF = 0.0_r8 sites(s)%frac_burnt = 0.0_r8 - sites(s)%old_stock = 0.0_r8 + end do @@ -253,6 +292,7 @@ subroutine set_site_properties( nsites, sites) return end subroutine set_site_properties + ! ============================================================================ subroutine init_patches( nsites, sites, bc_in) ! @@ -275,10 +315,7 @@ subroutine init_patches( nsites, sites, bc_in) ! ! !LOCAL VARIABLES: integer :: s - real(r8) :: cwd_ag_local(ncwd) - real(r8) :: cwd_bg_local(ncwd) - real(r8) :: leaf_litter_local(maxpft) - real(r8) :: root_litter_local(maxpft) + integer :: el real(r8) :: age !notional age of this patch ! dummy locals @@ -291,11 +328,6 @@ subroutine init_patches( nsites, sites, bc_in) ! List out some nominal patch values that are used for Near Bear Ground initializations ! as well as initializing inventory - ! --------------------------------------------------------------------------------------------- - cwd_ag_local(:) = 0.0_r8 !ED_val_init_litter -- arbitrary value for litter pools. kgC m-2 - cwd_bg_local(:) = 0.0_r8 !ED_val_init_litter - leaf_litter_local(:) = 0.0_r8 - root_litter_local(:) = 0.0_r8 age = 0.0_r8 ! --------------------------------------------------------------------------------------------- @@ -314,13 +346,16 @@ subroutine init_patches( nsites, sites, bc_in) call initialize_sites_by_inventory(nsites,sites,bc_in) + + ! For carbon balance checks, we need to initialize the + ! total carbon stock do s = 1, nsites - - ! For carbon balance checks, we need to initialize the - ! total carbon stock - call SiteCarbonStock(sites(s),sites(s)%old_stock,biomass_stock,litter_stock,seed_stock) - + do el=1,num_elements + call SiteMassStock(sites(s),el,sites(s)%mass_balance(el)%old_stock, & + biomass_stock,litter_stock,seed_stock) + end do enddo + else !FIX(SPM,032414) clean this up...inits out of this loop @@ -342,17 +377,30 @@ subroutine init_patches( nsites, sites, bc_in) sites(s)%oldest_patch => newp ! make new patch... - call create_patch(sites(s), newp, age, AREA, & - cwd_ag_local, cwd_bg_local, leaf_litter_local, & - root_litter_local, bc_in(s)%nlevsoil, primaryforest ) + + call create_patch(sites(s), newp, age, area, primaryforest) + + ! Initialize the litter pools to zero, these + ! pools will be populated by looping over the existing patches + ! and transfering in mass + do el=1,num_elements + call newp%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 sitep => sites(s) call init_cohorts(sitep, newp, bc_in(s)) - + ! For carbon balance checks, we need to initialize the ! total carbon stock - call SiteCarbonStock(sites(s),sites(s)%old_stock,biomass_stock,litter_stock,seed_stock) - + do el=1,num_elements + call SiteMassStock(sites(s),el,sites(s)%mass_balance(el)%old_stock, & + biomass_stock,litter_stock,seed_stock) + end do enddo end if @@ -385,17 +433,27 @@ subroutine init_cohorts( site_in, patch_in, bc_in) ! ! !LOCAL VARIABLES: type(ed_cohort_type),pointer :: temp_cohort - + class(prt_vartypes),pointer :: prt_obj integer :: cstatus integer :: pft - real(r8) :: b_agw ! biomass above ground (non-leaf) [kgC] - real(r8) :: b_bgw ! biomass below ground (non-fineroot) [kgC] - real(r8) :: b_leaf ! biomass in leaves [kgC] - real(r8) :: b_fineroot ! biomass in fine roots [kgC] - real(r8) :: b_sapwood ! biomass in sapwood [kgC] - real(r8) :: b_dead ! biomass in structure (dead) [kgC] - real(r8) :: b_store ! biomass in storage [kgC] - real(r8) :: a_sapwood ! area in sapwood (dummy) [m2] + integer :: iage ! index for leaf age loop + integer :: el ! index for element loop + integer :: element_id ! element index consistent with defs in PRTGeneric + real(r8) :: c_agw ! biomass above ground (non-leaf) [kgC] + real(r8) :: c_bgw ! biomass below ground (non-fineroot) [kgC] + real(r8) :: c_leaf ! biomass in leaves [kgC] + real(r8) :: c_fnrt ! biomass in fine roots [kgC] + real(r8) :: c_sapw ! biomass in sapwood [kgC] + real(r8) :: c_struct ! biomass in structure (dead) [kgC] + real(r8) :: c_store ! biomass in storage [kgC] + real(r8) :: a_sapw ! area in sapwood (dummy) [m2] + real(r8) :: m_struct ! Generic (any element) mass for structure [kg] + real(r8) :: m_leaf ! Generic mass for leaf [kg] + real(r8) :: m_fnrt ! Generic mass for fine-root [kg] + real(r8) :: m_sapw ! Generic mass for sapwood [kg] + real(r8) :: m_store ! Generic mass for storage [kg] + real(r8) :: m_repro ! Generic mass for reproductive tissues [kg] + real(r8) :: stem_drop_fraction integer, parameter :: rstatus = 0 @@ -420,49 +478,127 @@ subroutine init_cohorts( site_in, patch_in, bc_in) temp_cohort%canopy_trim = 1.0_r8 ! Calculate total above-ground biomass from allometry - call bagw_allom(temp_cohort%dbh,pft,b_agw) + call bagw_allom(temp_cohort%dbh,pft,c_agw) ! Calculate coarse root biomass from allometry - call bbgw_allom(temp_cohort%dbh,pft,b_bgw) + call bbgw_allom(temp_cohort%dbh,pft,c_bgw) ! Calculate the leaf biomass from allometry ! (calculates a maximum first, then applies canopy trim) - call bleaf(temp_cohort%dbh,pft,temp_cohort%canopy_trim,b_leaf) + call bleaf(temp_cohort%dbh,pft,temp_cohort%canopy_trim,c_leaf) ! Calculate fine root biomass from allometry ! (calculates a maximum and then trimming value) - call bfineroot(temp_cohort%dbh,pft,temp_cohort%canopy_trim,b_fineroot) + 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_sapwood,b_sapwood) + call bsap_allom(temp_cohort%dbh,pft,temp_cohort%canopy_trim,a_sapw,c_sapw) - call bdead_allom( b_agw, b_bgw, b_sapwood, pft, b_dead ) + call bdead_allom( c_agw, c_bgw, c_sapw, pft, c_struct ) - call bstore_allom(temp_cohort%dbh, pft, temp_cohort%canopy_trim, b_store) + call bstore_allom(temp_cohort%dbh, pft, temp_cohort%canopy_trim, c_store) temp_cohort%laimemory = 0._r8 + temp_cohort%sapwmemory = 0._r8 + temp_cohort%structmemory = 0._r8 cstatus = leaves_on + stem_drop_fraction = EDPftvarcon_inst%phen_stem_drop_fraction(temp_cohort%pft) + if( EDPftvarcon_inst%season_decid(pft) == itrue .and. & any(site_in%cstatus == [phen_cstat_nevercold,phen_cstat_iscold])) then - temp_cohort%laimemory = b_leaf - b_leaf = 0._r8 - cstatus = leaves_off + temp_cohort%laimemory = c_leaf + temp_cohort%sapwmemory = c_sapw * stem_drop_fraction + temp_cohort%structmemory = c_struct * stem_drop_fraction + c_leaf = 0._r8 + c_sapw = (1.0_r8-stem_drop_fraction) * c_sapw + c_struct = (1.0_r8-stem_drop_fraction) * c_struct + cstatus = leaves_off endif if ( EDPftvarcon_inst%stress_decid(pft) == itrue .and. & any(site_in%dstatus == [phen_dstat_timeoff,phen_dstat_moistoff])) then - temp_cohort%laimemory = b_leaf - b_leaf = 0._r8 + temp_cohort%laimemory = c_leaf + temp_cohort%sapwmemory = c_sapw * stem_drop_fraction + temp_cohort%structmemory = c_struct * stem_drop_fraction + c_leaf = 0._r8 + c_sapw = (1.0_r8-stem_drop_fraction) * c_sapw + c_struct = (1.0_r8-stem_drop_fraction) * c_struct cstatus = leaves_off endif if ( debug ) write(fates_log(),*) 'EDInitMod.F90 call create_cohort ' - call create_cohort(site_in, patch_in, pft, temp_cohort%n, temp_cohort%hite, temp_cohort%dbh, & - b_leaf, b_fineroot, b_sapwood, b_dead, b_store, & - temp_cohort%laimemory, cstatus, rstatus, temp_cohort%canopy_trim, 1, & - site_in%spread, first_leaf_aclass, bc_in) + ! -------------------------------------------------------------------------------- + ! Initialize the mass of every element in every organ of the organ + ! -------------------------------------------------------------------------------- + + prt_obj => null() + call InitPRTObject(prt_obj) + + do el = 1,num_elements + + element_id = element_list(el) + + ! If this is carbon12, then the initialization is straight forward + ! otherwise, we use stoichiometric ratios + select case(element_id) + case(carbon12_element) + + m_struct = c_struct + m_leaf = c_leaf + m_fnrt = c_fnrt + m_sapw = c_sapw + m_store = c_store + m_repro = 0._r8 + + case(nitrogen_element) + + m_struct = c_struct*EDPftvarcon_inst%prt_nitr_stoich_p2(pft,struct_organ) + m_leaf = c_leaf*EDPftvarcon_inst%prt_nitr_stoich_p2(pft,leaf_organ) + m_fnrt = c_fnrt*EDPftvarcon_inst%prt_nitr_stoich_p2(pft,fnrt_organ) + m_sapw = c_sapw*EDPftvarcon_inst%prt_nitr_stoich_p2(pft,sapw_organ) + m_store = c_store*EDPftvarcon_inst%prt_nitr_stoich_p2(pft,store_organ) + m_repro = 0._r8 + + case(phosphorus_element) + + m_struct = c_struct*EDPftvarcon_inst%prt_phos_stoich_p2(pft,struct_organ) + m_leaf = c_leaf*EDPftvarcon_inst%prt_phos_stoich_p2(pft,leaf_organ) + m_fnrt = c_fnrt*EDPftvarcon_inst%prt_phos_stoich_p2(pft,fnrt_organ) + m_sapw = c_sapw*EDPftvarcon_inst%prt_phos_stoich_p2(pft,sapw_organ) + m_store = c_store*EDPftvarcon_inst%prt_phos_stoich_p2(pft,store_organ) + m_repro = 0._r8 + end select + + select case(hlm_parteh_mode) + case (prt_carbon_allom_hyp,prt_cnp_flex_allom_hyp ) + + ! Put all of the leaf mass into the first bin + call SetState(prt_obj,leaf_organ, element_id,m_leaf,1) + do iage = 2,nleafage + call SetState(prt_obj,leaf_organ, element_id,0._r8,iage) + end do + + call SetState(prt_obj,fnrt_organ, element_id, m_fnrt) + call SetState(prt_obj,sapw_organ, element_id, m_sapw) + call SetState(prt_obj,store_organ, element_id, m_store) + call SetState(prt_obj,struct_organ, element_id, m_struct) + call SetState(prt_obj,repro_organ, element_id, m_repro) + + case default + write(fates_log(),*) 'Unspecified PARTEH module during create_cohort' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end select + + end do + + call prt_obj%CheckInitialConditions() + + call create_cohort(site_in, patch_in, pft, temp_cohort%n, temp_cohort%hite, & + temp_cohort%dbh, prt_obj, temp_cohort%laimemory, temp_cohort%sapwmemory, & + temp_cohort%structmemory, cstatus, rstatus, temp_cohort%canopy_trim, 1, & + site_in%spread, bc_in) deallocate(temp_cohort) ! get rid of temporary cohort diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index 20aa3b3103..b11de373ed 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -29,33 +29,43 @@ module EDMainMod use EDPatchDynamicsMod , only : fuse_patches use EDPatchDynamicsMod , only : spawn_patches use EDPatchDynamicsMod , only : terminate_patches - use EDPhysiologyMod , only : non_canopy_derivs use EDPhysiologyMod , only : phenology use EDPhysiologyMod , only : recruitment use EDPhysiologyMod , only : trim_canopy + use EDPhysiologyMod , only : SeedIn use EDPhysiologyMod , only : ZeroAllocationRates + use EDPhysiologyMod , only : ZeroLitterFluxes + use EDPhysiologyMod , only : PreDisturbanceLitterFluxes + use EDPhysiologyMod , only : PreDisturbanceIntegrateLitter use EDCohortDynamicsMod , only : UpdateCohortBioPhysRates use SFMainMod , only : fire_model use FatesSizeAgeTypeIndicesMod, only : get_age_class_index - use EDtypesMod , only : ncwd + use FatesLitterMod , only : litter_type + use FatesLitterMod , only : ncwd 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 : site_massbal_type + use EDTypesMod , only : num_elements + use EDTypesMod , only : element_list + use EDTypesMod , only : element_pos use EDTypesMod , only : phen_dstat_moiston use EDTypesMod , only : phen_dstat_timeon use FatesConstantsMod , only : itrue,ifalse use FatesConstantsMod , only : primaryforest, secondaryforest + use FatesConstantsMod , only : nearzero use FatesPlantHydraulicsMod , only : do_growthrecruiteffects use FatesPlantHydraulicsMod , only : updateSizeDepTreeHydProps use FatesPlantHydraulicsMod , only : updateSizeDepTreeHydStates use FatesPlantHydraulicsMod , only : initTreeHydStates use FatesPlantHydraulicsMod , only : updateSizeDepRhizHydProps + use FatesPlantHydraulicsMod , only : AccumulateMortalityWaterStorage use FatesAllometryMod , only : h_allom,tree_sai,tree_lai use FatesPlantHydraulicsMod , only : updateSizeDepRhizHydStates use EDLoggingMortalityMod , only : IsItLoggingTime use FatesGlobals , only : endrun => fates_endrun - use ChecksBalancesMod , only : SiteCarbonStock + use ChecksBalancesMod , only : SiteMassStock use EDMortalityFunctionsMod , only : Mortality_Derivative use PRTGenericMod, only : carbon12_element @@ -87,10 +97,12 @@ module EDMainMod ! !PRIVATE MEMBER FUNCTIONS: private :: ed_integrate_state_variables - private :: ed_total_balance_check + private :: TotalBalanceCheck private :: bypass_dynamics logical :: debug = .false. + + integer, parameter :: final_check_id = -1 character(len=*), parameter, private :: sourcefile = & __FILE__ @@ -113,13 +125,21 @@ subroutine ed_ecosystem_dynamics(currentSite, bc_in) ! ! !LOCAL VARIABLES: type(ed_patch_type), pointer :: currentPatch + integer :: el ! Loop counter for elements + !----------------------------------------------------------------------- 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 - currentSite%flux_in = 0.0_r8 - + + ! Consider moving this towards the end, because some of these + ! are being integrated over the short time-step + + do el = 1,num_elements + call currentSite%mass_balance(el)%ZeroMassBalFlux() + call currentSite%flux_diags(el)%ZeroFluxDiags() + end do ! Call a routine that simply identifies if logging should occur ! This is limited to a global event until more structured event handling is enabled @@ -135,8 +155,11 @@ subroutine ed_ecosystem_dynamics(currentSite, bc_in) ! Zero turnover rates and growth diagnostics call ZeroAllocationRates(currentSite) - - call ed_total_balance_check(currentSite, 0) + ! Zero fluxes in and out of litter pools + call ZeroLitterFluxes(currentSite) + + ! Zero mass balance + call TotalBalanceCheck(currentSite, 0) ! We do not allow phenology while in ST3 mode either, it is hypothetically ! possible to allow this, but we have not plugged in the litter fluxes @@ -169,7 +192,7 @@ subroutine ed_ecosystem_dynamics(currentSite, bc_in) end if !****************************************************************************** - ! Reproduction, Recruitment and Cohort Dynamics : controls cohort organisation + ! Reproduction, Recruitment and Cohort Dynamics : controls cohort organization !****************************************************************************** if(hlm_use_ed_st3.eq.ifalse) then @@ -184,7 +207,7 @@ subroutine ed_ecosystem_dynamics(currentSite, bc_in) end if - call ed_total_balance_check(currentSite,1) + call TotalBalanceCheck(currentSite,1) if( hlm_use_ed_st3.eq.ifalse ) then currentPatch => currentSite%oldest_patch @@ -194,20 +217,20 @@ subroutine ed_ecosystem_dynamics(currentSite, bc_in) call sort_cohorts(currentPatch) ! kills cohorts that are too few - call terminate_cohorts(currentSite, currentPatch, 1) + call terminate_cohorts(currentSite, currentPatch, 1, 10 ) ! fuses similar cohorts call fuse_cohorts(currentSite,currentPatch, bc_in ) ! kills cohorts for various other reasons - call terminate_cohorts(currentSite, currentPatch, 2) + call terminate_cohorts(currentSite, currentPatch, 2, 10 ) currentPatch => currentPatch%younger enddo end if - call ed_total_balance_check(currentSite,2) + call TotalBalanceCheck(currentSite,2) !********************************************************************************* ! Patch dynamics sub-routines: fusion, new patch creation (spwaning), termination. @@ -218,7 +241,7 @@ subroutine ed_ecosystem_dynamics(currentSite, bc_in) call spawn_patches(currentSite, bc_in) end if - call ed_total_balance_check(currentSite,3) + call TotalBalanceCheck(currentSite,3) ! fuse on the spawned patches. if ( hlm_use_ed_st3.eq.ifalse ) then @@ -238,14 +261,14 @@ subroutine ed_ecosystem_dynamics(currentSite, bc_in) end if end if - call ed_total_balance_check(currentSite,4) + call TotalBalanceCheck(currentSite,4) ! kill patches that are too small if ( hlm_use_ed_st3.eq.ifalse ) then call terminate_patches(currentSite) end if - call ed_total_balance_check(currentSite,5) + call TotalBalanceCheck(currentSite,5) end subroutine ed_ecosystem_dynamics @@ -263,33 +286,30 @@ subroutine ed_integrate_state_variables(currentSite, bc_in ) ! ! !LOCAL VARIABLES: + type(site_massbal_type), pointer :: site_cmass type(ed_patch_type) , pointer :: currentPatch type(ed_cohort_type) , pointer :: currentCohort integer :: c ! Counter for litter size class integer :: ft ! Counter for PFT - real(r8) :: small_no ! to circumvent numerical errors that cause negative values of things that can't be negative + integer :: el ! Counter for element type (c,n,p,etc) real(r8) :: cohort_biomass_store ! remembers the biomass in the cohort for balance checking real(r8) :: dbh_old ! dbh of plant before daily PRT [cm] real(r8) :: hite_old ! height of plant before daily PRT [m] logical :: is_drought ! logical for if the plant (site) is in a drought state - real(r8) :: leaf_c real(r8) :: delta_dbh ! correction for dbh real(r8) :: delta_hite ! correction for hite !----------------------------------------------------------------------- - small_no = 0.0000000000_r8 ! Obviously, this is arbitrary. RF - changed to zero - - currentSite%dseed_dt(:) = 0._r8 - currentSite%seed_rain_flux(:) = 0._r8 + ! Set a pointer to this sites carbon12 mass balance + site_cmass => currentSite%mass_balance(element_pos(carbon12_element)) - - currentPatch => currentSite%youngest_patch do while(associated(currentPatch)) + currentPatch%age = currentPatch%age + hlm_freq_day ! FIX(SPM,032414) valgrind 'Conditional jump or move depends on uninitialised value' if( currentPatch%age < 0._r8 )then @@ -319,9 +339,6 @@ subroutine ed_integrate_state_variables(currentSite, bc_in ) ! ----------------------------------------------------------------------------- ! Apply Plant Allocation and Reactive Transport ! ----------------------------------------------------------------------------- - - - ! ----------------------------------------------------------------------------- ! Identify the net carbon gain for this dynamics interval ! Set the available carbon pool, identify allocation portions, and @@ -338,49 +355,37 @@ subroutine ed_integrate_state_variables(currentSite, bc_in ) if (currentCohort%canopy_layer .eq. 1) then currentCohort%npp_acc_hold = EDPftvarcon_inst%prescribed_npp_canopy(ft) & * currentCohort%c_area / currentCohort%n - ! add these for balance checking purposes + currentCohort%npp_acc = currentCohort%npp_acc_hold / hlm_days_per_year + + ! for mass balancing + currentCohort%gpp_acc = currentCohort%npp_acc + currentCohort%resp_acc = 0._r8 + else currentCohort%npp_acc_hold = EDPftvarcon_inst%prescribed_npp_understory(ft) & * currentCohort%c_area / currentCohort%n - ! add these for balance checking purposes + currentCohort%npp_acc = currentCohort%npp_acc_hold / hlm_days_per_year + + ! for mass balancing + currentCohort%gpp_acc = currentCohort%npp_acc + currentCohort%resp_acc = 0._r8 endif else 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) endif - - currentSite%flux_in = currentSite%flux_in + currentCohort%npp_acc * currentCohort%n - - 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, & - currentPatch%canopy_layer_tlai, currentCohort%treelai,currentCohort%vcmax25top,6 ) - ! Conduct Maintenance Turnover (parteh) - call currentCohort%prt%CheckMassConservation(ft,3) + 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) - call currentCohort%prt%CheckMassConservation(ft,4) - - 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, & - currentPatch%canopy_layer_tlai, currentCohort%treelai,currentCohort%vcmax25top,7 ) - ! If the current diameter of a plant is somehow less than what is consistent ! with what is allometrically consistent with the stuctural biomass, then @@ -391,8 +396,16 @@ subroutine ed_integrate_state_variables(currentSite, bc_in ) hite_old = currentCohort%hite dbh_old = currentCohort%dbh - ! Conduct Growth (parteh) + + ! Growth and Allocation (PARTEH) call currentCohort%prt%DailyPRT() + + ! And simultaneously add the input fluxes to mass balance accounting + site_cmass%gpp_acc = site_cmass%gpp_acc + & + currentCohort%gpp_acc * currentCohort%n + site_cmass%aresp_acc = site_cmass%aresp_acc + & + currentCohort%resp_acc * currentCohort%n + call currentCohort%prt%CheckMassConservation(ft,5) ! Update the leaf biophysical rates based on proportion of leaf @@ -401,19 +414,6 @@ subroutine ed_integrate_state_variables(currentSite, bc_in ) ! routine is also called following fusion call UpdateCohortBioPhysRates(currentCohort) - 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, & - currentPatch%canopy_layer_tlai, currentCohort%treelai,currentCohort%vcmax25top,3 ) - - ! Transfer all reproductive tissues into seed production - call PRTReproRelease(currentCohort%prt,repro_organ,carbon12_element, & - 1.0_r8, currentCohort%seed_prod) - currentCohort%seed_prod = currentCohort%seed_prod / hlm_freq_day - ! This cohort has grown, it is no longer "new" currentCohort%isnew = .false. @@ -437,81 +437,64 @@ subroutine ed_integrate_state_variables(currentSite, bc_in ) call updateSizeDepTreeHydProps(currentSite,currentCohort, bc_in) call updateSizeDepTreeHydStates(currentSite,currentCohort) end if - + currentCohort => currentCohort%taller + end do - enddo - - call non_canopy_derivs( currentSite, currentPatch, bc_in) - - !update state variables simultaneously according to derivatives for this time period. - - ! first update the litter variables that are tracked at the patch level - do c = 1,ncwd - currentPatch%cwd_ag(c) = currentPatch%cwd_ag(c) + currentPatch%dcwd_ag_dt(c)* hlm_freq_day - currentPatch%cwd_bg(c) = currentPatch%cwd_bg(c) + currentPatch%dcwd_bg_dt(c)* hlm_freq_day - enddo + currentPatch => currentPatch%older + end do + + + ! When plants die, the water goes with them. This effects + ! the water balance. + + if( hlm_use_planthydro == itrue ) then + currentPatch => currentSite%youngest_patch + do while(associated(currentPatch)) + currentCohort => currentPatch%shortest + do while(associated(currentCohort)) + call AccumulateMortalityWaterStorage(currentSite,currentCohort,& + -1.0_r8 * currentCohort%dndt * hlm_freq_day) + currentCohort => currentCohort%taller + end do + currentPatch => currentPatch%older + end do + end if + - do ft = 1,numpft - currentPatch%leaf_litter(ft) = currentPatch%leaf_litter(ft) + & - currentPatch%dleaf_litter_dt(ft)* hlm_freq_day - currentPatch%root_litter(ft) = currentPatch%root_litter(ft) + & - currentPatch%droot_litter_dt(ft)* hlm_freq_day - enddo + ! With growth and mortality rates now calculated we can determine the seed rain + ! fluxes. However, because this is potentially a cross-patch mixing model + ! we will calculate this as a group - do c = 1,ncwd - if(currentPatch%cwd_ag(c) currentSite%youngest_patch + do while(associated(currentPatch)) + + call PreDisturbanceLitterFluxes( currentSite, currentPatch, bc_in) + + call PreDisturbanceIntegrateLitter(currentPatch ) - ! update cohort number. This needs to happen after the CWD_input and seed_input calculations as they + + ! Update cohort number. + ! This needs to happen after the CWD_input and seed_input calculations as they ! assume the pre-mortality currentCohort%n. + + currentCohort => currentPatch%shortest do while(associated(currentCohort)) - currentCohort%n = max(small_no,currentCohort%n + currentCohort%dndt * hlm_freq_day ) + currentCohort%n = max(0._r8,currentCohort%n + currentCohort%dndt * hlm_freq_day ) currentCohort => currentCohort%taller enddo currentPatch => currentPatch%older + enddo - enddo - - ! at the site level, update the seed bank mass - do ft = 1,numpft - currentSite%seed_bank(ft) = currentSite%seed_bank(ft) + currentSite%dseed_dt(ft)*hlm_freq_day - enddo - - ! Check for negative values. Write out warning to show carbon balance. - do ft = 1,numpft - if(currentSite%seed_bank(ft) currentSite%oldest_patch do while(associated(currentPatch)) + + ! Is termination really needed here? + ! Canopy_structure just called it several times! (rgk) + call terminate_cohorts(currentSite, currentPatch, 1, 11) + call terminate_cohorts(currentSite, currentPatch, 2, 11) - ! Is termination really needed here? canopy_structure just called it several times! (rgk) - call terminate_cohorts(currentSite, currentPatch, 1) - call terminate_cohorts(currentSite, currentPatch, 2) - - ! FIX(SPM,040314) why is this needed for BFB restarts? Look into this at some point - cohort_number = count_cohorts(currentPatch) - if ( debug ) then - write(fates_log(),*) 'tempCount ',cohort_number - endif - - ! Note (RF) - ! This breaks the balance check, but if we leave it out, then - ! the first new patch that isn't fused has no cohorts at the end of the spawn process - ! and so there are radiation errors instead. - ! Fixing this would likely require a re-work of how seed germination works which would be tricky. - if(currentPatch%countcohorts < 1)then - !write(fates_log(),*) 'ED: calling recruitment for no cohorts',currentSite%clmgcell,currentPatch%patchno - !call recruitment(1, currentSite, currentPatch) - ! write(fates_log(),*) 'patch empty',currentPatch%area,currentPatch%age - endif + ! This cohort count is used in the photosynthesis loop + call count_cohorts(currentPatch) - currentPatch => currentPatch%younger + currentPatch => currentPatch%younger enddo ! FIX(RF,032414). This needs to be monthly, not annual @@ -584,34 +552,39 @@ subroutine ed_update_site( currentSite, bc_in ) end subroutine ed_update_site !-------------------------------------------------------------------------------! - subroutine ed_total_balance_check (currentSite, call_index ) + + subroutine TotalBalanceCheck (currentSite, call_index ) + ! ! !DESCRIPTION: - ! This routine looks at the carbon in and out of the ED model and compares it to - ! the change in total carbon stocks. + ! This routine looks at the mass flux in and out of the FATES and compares it to + ! the change in total stocks (states). ! Fluxes in are NPP. Fluxes out are decay of CWD and litter into SOM pools. - ! ed_allsites_inst%flux_out and ed_allsites_inst%flux_in are set where they occur - ! in the code. ! ! !ARGUMENTS: type(ed_site_type) , intent(inout) :: currentSite integer , intent(in) :: call_index ! ! !LOCAL VARIABLES: - real(r8) :: biomass_stock ! total biomass in KgC/site - real(r8) :: litter_stock ! total litter in KgC/site - real(r8) :: seed_stock ! total seed mass in KgC/site - real(r8) :: total_stock ! total ED carbon in KgC/site + type(site_massbal_type),pointer :: site_mass + real(r8) :: biomass_stock ! total biomass in Kg/site + real(r8) :: litter_stock ! total litter in Kg/site + real(r8) :: seed_stock ! total seed mass in Kg/site + real(r8) :: total_stock ! total ED carbon in Kg/site real(r8) :: change_in_stock ! Change since last time we set ed_allsites_inst%old_stock in this routine. KgC/site real(r8) :: error ! How much carbon did we gain or lose (should be zero!) real(r8) :: error_frac ! Error as a fraction of total biomass real(r8) :: net_flux ! Difference between recorded fluxes in and out. KgC/site - real(r8) :: leaf_c - real(r8) :: fnrt_c - real(r8) :: sapw_c - real(r8) :: store_c - real(r8) :: struct_c - real(r8) :: repro_c + real(r8) :: flux_in ! mass flux into fates control volume + real(r8) :: flux_out ! mass flux out of fates control volume + real(r8) :: leaf_m ! Mass in leaf tissues kg + real(r8) :: fnrt_m ! "" fine root + real(r8) :: sapw_m ! "" sapwood + real(r8) :: store_m ! "" storage + real(r8) :: struct_m ! "" structure + real(r8) :: repro_m ! "" reproduction + + integer :: el ! loop counter for element types ! nb. There is no time associated with these variables ! because this routine can be called between any two @@ -621,101 +594,128 @@ subroutine ed_total_balance_check (currentSite, call_index ) type(ed_patch_type) , pointer :: currentPatch type(ed_cohort_type) , pointer :: currentCohort + type(litter_type), pointer :: litt + logical, parameter :: print_cohorts = .false. ! Set to true if you want + ! to print cohort data + ! upon fail (lots of text) !----------------------------------------------------------------------- change_in_stock = 0.0_r8 - - call SiteCarbonStock(currentSite,total_stock,biomass_stock,litter_stock,seed_stock) - - - change_in_stock = total_stock - currentSite%old_stock - - net_flux = currentSite%flux_in - currentSite%flux_out - error = abs(net_flux - change_in_stock) - - if(change_in_stock>0.0)then - error_frac = error/abs(total_stock) - else - error_frac = 0.0_r8 - end if - - ! ----------------------------------------------------------------------------------- - ! Terms: - ! %flux_in: accumulates npp over all cohorts, - ! currentSite%flux_in = currentSite%flux_in + & - ! currentCohort%npp_acc * currentCohort%n - ! %flux_out: coarse woody debris going into fragmentation pools: - ! currentSite%flux_out + sum(currentPatch%leaf_litter_out) * & - ! currentPatch%area *hlm_freq_day!kgC/site/day - ! burn fractions: - ! currentSite%flux_out = currentSite%flux_out + & - ! burned_litter * new_patch%area !kG/site/day - ! ----------------------------------------------------------------------------------- - if ( error_frac > 10e-6_r8 ) then - write(fates_log(),*) 'carbon balance error detected' - write(fates_log(),*) 'error fraction relative to biomass stock:',error_frac - write(fates_log(),*) 'call index: ',call_index - write(fates_log(),*) 'flux in (npp): ',currentSite%flux_in - write(fates_log(),*) 'flux out (fragmentation/harvest): ',currentSite%flux_out - write(fates_log(),*) 'net: ',net_flux - write(fates_log(),*) 'dstock: ',change_in_stock - write(fates_log(),*) 'error=net_flux-dstock:', error - write(fates_log(),*) 'biomass', biomass_stock - write(fates_log(),*) 'litter',litter_stock - write(fates_log(),*) 'seeds',seed_stock - write(fates_log(),*) 'previous total',currentSite%old_stock - - write(fates_log(),*) 'lat lon',currentSite%lat,currentSite%lon + ! Loop through the number of elements in the system + + do el = 1, num_elements - ! If this is the first day of simulation, carbon balance reports but does not end the run - if( int(hlm_current_year*10000 + hlm_current_month*100 + hlm_current_day).ne.hlm_reference_date ) then + call SiteMassStock(currentSite,el,total_stock,biomass_stock,litter_stock,seed_stock) - change_in_stock = 0.0_r8 - biomass_stock = 0.0_r8 - litter_stock = 0.0_r8 - - seed_stock = sum(currentSite%seed_bank)*AREA - currentPatch => currentSite%oldest_patch - do while(associated(currentPatch)) - write(fates_log(),*) '---------------------------------------' - write(fates_log(),*) currentPatch%area , sum(currentPatch%cwd_ag), sum(currentPatch%cwd_bg) - write(fates_log(),*) sum(currentPatch%leaf_litter),sum(currentPatch%root_litter) - write(fates_log(),*)'---' - currentCohort => currentPatch%tallest - do while(associated(currentCohort)) - write(fates_log(),*) 'pft: ',currentCohort%pft - write(fates_log(),*) 'dbh: ',currentCohort%dbh - leaf_c = currentCohort%prt%GetState(leaf_organ,all_carbon_elements) - struct_c = currentCohort%prt%GetState(struct_organ,all_carbon_elements) - store_c = currentCohort%prt%GetState(store_organ,all_carbon_elements) - fnrt_c = currentCohort%prt%GetState(fnrt_organ,all_carbon_elements) - repro_c = currentCohort%prt%GetState(repro_organ,all_carbon_elements) - sapw_c = currentCohort%prt%GetState(sapw_organ,all_carbon_elements) - - write(fates_log(),*) 'lc: ',leaf_c,' dc: ',struct_c,' stc: ',store_c - write(fates_log(),*) 'fc: ',fnrt_c,' rc: ',repro_c,' sac: ',sapw_c - write(fates_log(),*) 'N plant: ',currentCohort%n - currentCohort => currentCohort%shorter - enddo !end cohort loop - currentPatch => currentPatch%younger - enddo !end patch loop - write(fates_log(),*) 'aborting on date:',hlm_current_year,hlm_current_month,hlm_current_day - call endrun(msg=errMsg(sourcefile, __LINE__)) + site_mass => currentSite%mass_balance(el) + + change_in_stock = total_stock - site_mass%old_stock + + flux_in = site_mass%seed_in + & + site_mass%net_root_uptake + & + site_mass%gpp_acc + & + site_mass%flux_generic_in + & + site_mass%patch_resize_err + + flux_out = site_mass%wood_product + & + site_mass%burn_flux_to_atm + & + site_mass%seed_out + & + site_mass%flux_generic_out + & + site_mass%frag_out + & + site_mass%aresp_acc + + net_flux = flux_in - flux_out + error = abs(net_flux - change_in_stock) + + if(change_in_stock>0.0)then + error_frac = error/abs(total_stock) + else + error_frac = 0.0_r8 end if - endif + if ( error_frac > 10e-6_r8 ) then + write(fates_log(),*) 'mass balance error detected' + write(fates_log(),*) 'element type (see PRTGenericMod.F90): ',element_list(el) + write(fates_log(),*) 'error fraction relative to biomass stock: ',error_frac + write(fates_log(),*) 'call index: ',call_index + write(fates_log(),*) 'Element index (PARTEH global):',element_list(el) + write(fates_log(),*) 'net: ',net_flux + write(fates_log(),*) 'dstock: ',change_in_stock + write(fates_log(),*) 'seed_in: ',site_mass%seed_in + write(fates_log(),*) 'net_root_uptake: ',site_mass%net_root_uptake + write(fates_log(),*) 'gpp_acc: ',site_mass%gpp_acc + write(fates_log(),*) 'flux_generic_in: ',site_mass%flux_generic_in + write(fates_log(),*) 'wood_product: ',site_mass%wood_product + write(fates_log(),*) 'error from patch resizing: ',site_mass%patch_resize_err + write(fates_log(),*) 'burn_flux_to_atm: ',site_mass%burn_flux_to_atm + write(fates_log(),*) 'seed_out: ',site_mass%seed_out + write(fates_log(),*) 'flux_generic_out: ',site_mass%flux_generic_out + write(fates_log(),*) 'frag_out: ',site_mass%frag_out + write(fates_log(),*) 'aresp_acc: ',site_mass%aresp_acc + write(fates_log(),*) 'error=net_flux-dstock:', error + write(fates_log(),*) 'biomass', biomass_stock + write(fates_log(),*) 'litter',litter_stock + write(fates_log(),*) 'seeds',seed_stock + write(fates_log(),*) 'previous total',site_mass%old_stock + write(fates_log(),*) 'lat lon',currentSite%lat,currentSite%lon + + ! If this is the first day of simulation, carbon balance reports but does not end the run +! if(( hlm_current_year*10000 + hlm_current_month*100 + hlm_current_day).ne.hlm_reference_date) then + + currentPatch => currentSite%oldest_patch + do while(associated(currentPatch)) + litt => currentPatch%litter(el) + write(fates_log(),*) '---------------------------------------' + write(fates_log(),*) 'patch area: ',currentPatch%area + write(fates_log(),*) 'AG CWD: ', sum(litt%ag_cwd) + write(fates_log(),*) 'BG CWD (by layer): ', sum(litt%bg_cwd,dim=1) + write(fates_log(),*) 'leaf litter:',sum(litt%leaf_fines) + write(fates_log(),*) 'root litter (by layer): ',sum(litt%root_fines,dim=1) + write(fates_log(),*) 'dist mode: ',currentPatch%disturbance_mode + write(fates_log(),*) 'anthro_disturbance_label: ',currentPatch%anthro_disturbance_label + if(print_cohorts)then + write(fates_log(),*) '---- Biomass by cohort and organ -----' + currentCohort => currentPatch%tallest + do while(associated(currentCohort)) + write(fates_log(),*) 'pft: ',currentCohort%pft + write(fates_log(),*) 'dbh: ',currentCohort%dbh + leaf_m = currentCohort%prt%GetState(leaf_organ,element_list(el)) + struct_m = currentCohort%prt%GetState(struct_organ,element_list(el)) + store_m = currentCohort%prt%GetState(store_organ,element_list(el)) + fnrt_m = currentCohort%prt%GetState(fnrt_organ,element_list(el)) + repro_m = currentCohort%prt%GetState(repro_organ,element_list(el)) + sapw_m = currentCohort%prt%GetState(sapw_organ,element_list(el)) + write(fates_log(),*) 'leaf: ',leaf_m,' structure: ',struct_m,' store: ',store_m + write(fates_log(),*) 'fineroot: ',fnrt_m,' repro: ',repro_m,' sapwood: ',sapw_m + write(fates_log(),*) 'num plant: ',currentCohort%n + currentCohort => currentCohort%shorter + enddo !end cohort loop + end if + currentPatch => currentPatch%younger + enddo !end patch loop + write(fates_log(),*) 'aborting on date:',hlm_current_year,hlm_current_month,hlm_current_day + call endrun(msg=errMsg(sourcefile, __LINE__)) + !end if + + endif - currentSite%flux_in = 0.0_r8 - currentSite%flux_out = 0.0_r8 - currentSite%old_stock = total_stock + ! This is the last check of the sequence, where we update our total + ! error check and the final fates stock + if(call_index == final_check_id) then + site_mass%old_stock = total_stock + site_mass%err_fates = net_flux - change_in_stock + call site_mass%ZeroMassBalFlux() + end if - end subroutine ed_total_balance_check + end do + + end subroutine TotalBalanceCheck - ! ===================================================================================== + ! ===================================================================================== - subroutine bypass_dynamics(currentSite) + subroutine bypass_dynamics(currentSite) ! ---------------------------------------------------------------------------------- ! If dynamics are bypassed, various fluxes, rates and flags need to be set diff --git a/main/EDParamsMod.F90 b/main/EDParamsMod.F90 index f94cdccad2..986151a8fe 100644 --- a/main/EDParamsMod.F90 +++ b/main/EDParamsMod.F90 @@ -1,123 +1,150 @@ module EDParamsMod + ! ! module that deals with reading the ED parameter file ! - + + use FatesConstantsMod, only : r8 => fates_r8 + use FatesConstantsMod, only : nearzero use FatesParametersInterface, only : param_string_length use FatesGlobals , only : fates_log use FatesGlobals , only : endrun => fates_endrun ! CIME Globals use shr_log_mod , only : errMsg => shr_log_errMsg - use shr_kind_mod , only: r8 => shr_kind_r8 implicit none + private save - ! private - if we allow this module to be private, it does not allow the protected values below to be - ! seen outside of this module. ! ! this is what the user can use for the actual values ! - real(r8),protected :: fates_mortality_disturbance_fraction ! the fraction of canopy mortality that results in disturbance - real(r8),protected :: ED_val_comp_excln - real(r8),protected :: ED_val_init_litter - real(r8),protected :: ED_val_nignitions - real(r8),protected :: ED_val_understorey_death - real(r8),protected :: ED_val_cwd_fcel - real(r8),protected :: ED_val_cwd_flig - real(r8),protected :: ED_val_bbopt_c3 - real(r8),protected :: ED_val_bbopt_c4 - real(r8),protected :: ED_val_base_mr_20 - real(r8),protected :: ED_val_phen_drought_threshold - real(r8),protected :: ED_val_phen_doff_time - real(r8),protected :: ED_val_phen_a - real(r8),protected :: ED_val_phen_b - real(r8),protected :: ED_val_phen_c - real(r8),protected :: ED_val_phen_chiltemp - real(r8),protected :: ED_val_phen_mindayson - real(r8),protected :: ED_val_phen_ncolddayslim - real(r8),protected :: ED_val_phen_coldtemp - real(r8),protected :: ED_val_cohort_fusion_tol - real(r8),protected :: ED_val_patch_fusion_tol - real(r8),protected :: ED_val_canopy_closure_thresh ! site-level canopy closure point where trees take on forest (narrow) versus savannah (wide) crown allometry + real(r8),protected, public :: fates_mortality_disturbance_fraction ! the fraction of canopy mortality that results in disturbance + real(r8),protected, public :: ED_val_comp_excln + 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_cwd_fcel + real(r8),protected, public :: ED_val_cwd_flig + real(r8),protected, public :: ED_val_bbopt_c3 + real(r8),protected, public :: ED_val_bbopt_c4 + real(r8),protected, public :: ED_val_base_mr_20 + real(r8),protected, public :: ED_val_phen_drought_threshold + real(r8),protected, public :: ED_val_phen_doff_time + real(r8),protected, public :: ED_val_phen_a + real(r8),protected, public :: ED_val_phen_b + real(r8),protected, public :: ED_val_phen_c + real(r8),protected, public :: ED_val_phen_chiltemp + real(r8),protected, public :: ED_val_phen_mindayson + real(r8),protected, public :: ED_val_phen_ncolddayslim + real(r8),protected, public :: ED_val_phen_coldtemp + real(r8),protected, public :: ED_val_cohort_fusion_tol + real(r8),protected, public :: ED_val_patch_fusion_tol + real(r8),protected, public :: ED_val_canopy_closure_thresh ! site-level canopy closure point where trees take on forest (narrow) versus savannah (wide) crown allometry + + logical,protected, public :: active_crown_fire ! flag, 1=active crown fire 0=no active crown fire + character(len=param_string_length),parameter :: fates_name_active_crown_fire = "fates_fire_active_crown_fire" + + real(r8), protected, public :: cg_strikes ! fraction of cloud to ground lightning strikes (0-1) + character(len=param_string_length),parameter :: fates_name_cg_strikes="fates_fire_cg_strikes" + + real(r8),protected,public :: q10_mr ! Q10 for respiration rate (for soil fragmenation and plant respiration) (unitless) + real(r8),protected,public :: q10_froz ! Q10 for frozen-soil respiration rates (for soil fragmentation) (unitless) ! two special parameters whose size is defined in the parameter file - real(r8),protected,allocatable :: ED_val_history_sizeclass_bin_edges(:) - real(r8),protected,allocatable :: ED_val_history_ageclass_bin_edges(:) - real(r8),protected,allocatable :: ED_val_history_height_bin_edges(:) - - character(len=param_string_length),parameter :: ED_name_mort_disturb_frac = "fates_mort_disturb_frac" - character(len=param_string_length),parameter :: ED_name_comp_excln = "fates_comp_excln" - character(len=param_string_length),parameter :: ED_name_init_litter = "fates_init_litter" - character(len=param_string_length),parameter :: ED_name_nignitions = "fates_fire_nignitions" - character(len=param_string_length),parameter :: ED_name_understorey_death = "fates_mort_understorey_death" - character(len=param_string_length),parameter :: ED_name_cwd_fcel= "fates_cwd_fcel" - character(len=param_string_length),parameter :: ED_name_cwd_flig= "fates_cwd_flig" - character(len=param_string_length),parameter :: ED_name_bbopt_c3= "fates_bbopt_c3" - character(len=param_string_length),parameter :: ED_name_bbopt_c4= "fates_bbopt_c4" - character(len=param_string_length),parameter :: ED_name_base_mr_20= "fates_base_mr_20" - character(len=param_string_length),parameter :: ED_name_phen_drought_threshold= "fates_phen_drought_threshold" - character(len=param_string_length),parameter :: ED_name_phen_doff_time= "fates_phen_doff_time" - character(len=param_string_length),parameter :: ED_name_phen_a= "fates_phen_a" - character(len=param_string_length),parameter :: ED_name_phen_b= "fates_phen_b" - character(len=param_string_length),parameter :: ED_name_phen_c= "fates_phen_c" - character(len=param_string_length),parameter :: ED_name_phen_chiltemp= "fates_phen_chiltemp" - character(len=param_string_length),parameter :: ED_name_phen_mindayson= "fates_phen_mindayson" - character(len=param_string_length),parameter :: ED_name_phen_ncolddayslim= "fates_phen_ncolddayslim" - character(len=param_string_length),parameter :: ED_name_phen_coldtemp= "fates_phen_coldtemp" - character(len=param_string_length),parameter :: ED_name_cohort_fusion_tol= "fates_cohort_fusion_tol" - character(len=param_string_length),parameter :: ED_name_patch_fusion_tol= "fates_patch_fusion_tol" - character(len=param_string_length),parameter :: ED_name_canopy_closure_thresh= "fates_canopy_closure_thresh" + real(r8),protected,allocatable,public :: ED_val_history_sizeclass_bin_edges(:) + real(r8),protected,allocatable,public :: ED_val_history_ageclass_bin_edges(:) + real(r8),protected,allocatable,public :: ED_val_history_height_bin_edges(:) + + + character(len=param_string_length),parameter,public :: ED_name_mort_disturb_frac = "fates_mort_disturb_frac" + character(len=param_string_length),parameter,public :: ED_name_comp_excln = "fates_comp_excln" + 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_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_bbopt_c3= "fates_bbopt_c3" + character(len=param_string_length),parameter,public :: ED_name_bbopt_c4= "fates_bbopt_c4" + character(len=param_string_length),parameter,public :: ED_name_base_mr_20= "fates_base_mr_20" + character(len=param_string_length),parameter,public :: ED_name_phen_drought_threshold= "fates_phen_drought_threshold" + character(len=param_string_length),parameter,public :: ED_name_phen_doff_time= "fates_phen_doff_time" + character(len=param_string_length),parameter,public :: ED_name_phen_a= "fates_phen_a" + character(len=param_string_length),parameter,public :: ED_name_phen_b= "fates_phen_b" + character(len=param_string_length),parameter,public :: ED_name_phen_c= "fates_phen_c" + character(len=param_string_length),parameter,public :: ED_name_phen_chiltemp= "fates_phen_chiltemp" + character(len=param_string_length),parameter,public :: ED_name_phen_mindayson= "fates_phen_mindayson" + character(len=param_string_length),parameter,public :: ED_name_phen_ncolddayslim= "fates_phen_ncolddayslim" + character(len=param_string_length),parameter,public :: ED_name_phen_coldtemp= "fates_phen_coldtemp" + character(len=param_string_length),parameter,public :: ED_name_cohort_fusion_tol= "fates_cohort_size_fusion_tol" + character(len=param_string_length),parameter,public :: ED_name_patch_fusion_tol= "fates_patch_fusion_tol" + character(len=param_string_length),parameter,public :: ED_name_canopy_closure_thresh= "fates_canopy_closure_thresh" + + ! Resistance to active crown fire + + + character(len=param_string_length),parameter :: fates_name_q10_mr="fates_q10_mr" + character(len=param_string_length),parameter :: fates_name_q10_froz="fates_q10_froz" + ! non-scalar parameter names - character(len=param_string_length),parameter :: ED_name_history_sizeclass_bin_edges= "fates_history_sizeclass_bin_edges" - character(len=param_string_length),parameter :: ED_name_history_ageclass_bin_edges= "fates_history_ageclass_bin_edges" - character(len=param_string_length),parameter :: ED_name_history_height_bin_edges= "fates_history_height_bin_edges" + 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" ! Hydraulics Control Parameters (ONLY RELEVANT WHEN USE_FATES_HYDR = TRUE) ! ---------------------------------------------------------------------------------------------- - real(r8),protected :: hydr_kmax_rsurf ! maximum conducitivity for unit root surface (kg water/m2 root area/Mpa/s) - character(len=param_string_length),parameter :: hydr_name_kmax_rsurf = "fates_hydr_kmax_rsurf" + real(r8),protected,public :: hydr_kmax_rsurf1 ! maximum conducitivity for unit root surface + ! soil to root direction (kg water/m2 root area/Mpa/s) + character(len=param_string_length),parameter,public :: hydr_name_kmax_rsurf1 = "fates_hydr_kmax_rsurf1" - real(r8),protected :: hydr_psi0 ! sapwood water potential at saturation (MPa) - character(len=param_string_length),parameter :: hydr_name_psi0 = "fates_hydr_psi0" + real(r8),protected,public :: hydr_kmax_rsurf2 ! maximum conducitivity for unit root surface + ! root to soil direciton (kg water/m2 root area/Mpa/s) + character(len=param_string_length),parameter,public :: hydr_name_kmax_rsurf2 = "fates_hydr_kmax_rsurf2" + + real(r8),protected,public :: hydr_psi0 ! sapwood water potential at saturation (MPa) + character(len=param_string_length),parameter,public :: hydr_name_psi0 = "fates_hydr_psi0" - real(r8),protected :: hydr_psicap ! sapwood water potential at which capillary reserves exhausted (MPa) - character(len=param_string_length),parameter :: hydr_name_psicap = "fates_hydr_psicap" + real(r8),protected,public :: hydr_psicap ! sapwood water potential at which capillary reserves exhausted (MPa) + character(len=param_string_length),parameter,public :: hydr_name_psicap = "fates_hydr_psicap" !Soil BGC parameters, mostly used for testing FATES when not coupled to the dynamics bgc hlm ! ---------------------------------------------------------------------------------------------- - real(r8),protected :: bgc_soil_salinity ! site-level soil salinity for FATES when not coupled to dynamic soil BGC of salinity - character(len=param_string_length),parameter :: bgc_name_soil_salinity= "fates_soil_salinity" + 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) ! ---------------------------------------------------------------------------------------------- - real(r8),protected :: logging_dbhmin ! Minimum dbh at which logging is applied (cm) - character(len=param_string_length),parameter :: logging_name_dbhmin = "fates_logging_dbhmin" + real(r8),protected,public :: logging_dbhmin ! Minimum dbh at which logging is applied (cm) + character(len=param_string_length),parameter,public :: logging_name_dbhmin = "fates_logging_dbhmin" - real(r8),protected :: logging_collateral_frac ! Ratio of collateral mortality to direct logging mortality - character(len=param_string_length),parameter :: logging_name_collateral_frac = "fates_logging_collateral_frac" + real(r8),protected,public :: logging_collateral_frac ! Ratio of collateral mortality to direct logging mortality + character(len=param_string_length),parameter,public :: logging_name_collateral_frac = "fates_logging_collateral_frac" - real(r8),protected :: logging_coll_under_frac ! Fraction of understory plants that die when logging disturbance + real(r8),protected,public :: logging_coll_under_frac ! Fraction of understory plants that die when logging disturbance ! is generated - character(len=param_string_length),parameter :: logging_name_coll_under_frac = "fates_logging_coll_under_frac" + character(len=param_string_length),parameter,public :: logging_name_coll_under_frac = "fates_logging_coll_under_frac" - real(r8),protected :: logging_direct_frac ! Fraction of stems logged per event - character(len=param_string_length),parameter :: logging_name_direct_frac = "fates_logging_direct_frac" + real(r8),protected,public :: logging_direct_frac ! Fraction of stems logged per event + character(len=param_string_length),parameter,public :: logging_name_direct_frac = "fates_logging_direct_frac" - real(r8),protected :: logging_mechanical_frac ! Fraction of stems logged per event - character(len=param_string_length),parameter :: logging_name_mechanical_frac = "fates_logging_mechanical_frac" + real(r8),protected,public :: logging_mechanical_frac ! Fraction of stems logged per event + character(len=param_string_length),parameter,public :: logging_name_mechanical_frac = "fates_logging_mechanical_frac" - real(r8),protected :: logging_event_code ! Code that options how logging events are structured - character(len=param_string_length),parameter :: logging_name_event_code = "fates_logging_event_code" + real(r8),protected,public :: logging_event_code ! Code that options how logging events are structured + character(len=param_string_length),parameter,public :: logging_name_event_code = "fates_logging_event_code" - real(r8),protected :: logging_dbhmax_infra ! "Tree diameter, above which infrastructure from logging does not impact damage or mortality. - character(len=param_string_length),parameter :: logging_name_dbhmax_infra = "fates_logging_dbhmax_infra" + real(r8),protected,public :: logging_dbhmax_infra ! "Tree diameter, above which infrastructure from logging does not impact damage or mortality. + character(len=param_string_length),parameter,public :: logging_name_dbhmax_infra = "fates_logging_dbhmax_infra" + real(r8),protected,public :: logging_export_frac ! "fraction of trunk product being shipped offsite, the + ! leftovers will be left onsite as large CWD + character(len=param_string_length),parameter,public :: logging_name_export_frac ="fates_logging_export_frac" + public :: FatesParamsInit public :: FatesRegisterParams public :: FatesReceiveParams @@ -156,8 +183,9 @@ subroutine FatesParamsInit() ED_val_cohort_fusion_tol = nan ED_val_patch_fusion_tol = nan ED_val_canopy_closure_thresh = nan - - hydr_kmax_rsurf = nan + hydr_kmax_rsurf1 = nan + hydr_kmax_rsurf2 = nan + hydr_psi0 = nan hydr_psicap = nan @@ -169,6 +197,9 @@ subroutine FatesParamsInit() logging_mechanical_frac = nan logging_event_code = nan logging_dbhmax_infra = nan + logging_export_frac = nan + q10_mr = nan + q10_froz = nan end subroutine FatesParamsInit @@ -178,119 +209,131 @@ subroutine FatesRegisterParams(fates_params) ! indicate whether they are fates parameters or host parameters ! that need to be synced with host values. - use FatesParametersInterface, only : fates_parameters_type, dimension_name_scalar1d, dimension_shape_1d + 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 + use FatesParametersInterface, only : dimension_name_history_height_bins, dimension_shape_scalar implicit none class(fates_parameters_type), intent(inout) :: fates_params - character(len=param_string_length), parameter :: dim_names(1) = (/dimension_name_scalar1d/) + character(len=param_string_length), parameter :: dim_names_scalar(1) = (/dimension_name_scalar/) character(len=param_string_length), parameter :: dim_names_sizeclass(1) = (/dimension_name_history_size_bins/) 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/) call FatesParamsInit() - call fates_params%RegisterParameter(name=ED_name_mort_disturb_frac, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + call fates_params%RegisterParameter(name=ED_name_mort_disturb_frac, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) - call fates_params%RegisterParameter(name=ED_name_comp_excln, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + call fates_params%RegisterParameter(name=ED_name_comp_excln, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) - call fates_params%RegisterParameter(name=ED_name_init_litter, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + call fates_params%RegisterParameter(name=ED_name_init_litter, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) - call fates_params%RegisterParameter(name=ED_name_nignitions, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + call fates_params%RegisterParameter(name=ED_name_nignitions, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) - call fates_params%RegisterParameter(name=ED_name_understorey_death, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + 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_cwd_fcel, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + call fates_params%RegisterParameter(name=ED_name_cwd_fcel, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) - call fates_params%RegisterParameter(name=ED_name_cwd_flig, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + call fates_params%RegisterParameter(name=ED_name_cwd_flig, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) - call fates_params%RegisterParameter(name=ED_name_bbopt_c3, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + call fates_params%RegisterParameter(name=ED_name_bbopt_c3, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) - call fates_params%RegisterParameter(name=ED_name_bbopt_c4, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + call fates_params%RegisterParameter(name=ED_name_bbopt_c4, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) - call fates_params%RegisterParameter(name=ED_name_base_mr_20, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + call fates_params%RegisterParameter(name=ED_name_base_mr_20, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) - call fates_params%RegisterParameter(name=ED_name_phen_drought_threshold, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + call fates_params%RegisterParameter(name=ED_name_phen_drought_threshold, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) - call fates_params%RegisterParameter(name=ED_name_phen_doff_time, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + call fates_params%RegisterParameter(name=ED_name_phen_doff_time, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) - call fates_params%RegisterParameter(name=ED_name_phen_a, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + call fates_params%RegisterParameter(name=ED_name_phen_a, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) - call fates_params%RegisterParameter(name=ED_name_phen_b, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + call fates_params%RegisterParameter(name=ED_name_phen_b, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) - call fates_params%RegisterParameter(name=ED_name_phen_c, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + call fates_params%RegisterParameter(name=ED_name_phen_c, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) - call fates_params%RegisterParameter(name=ED_name_phen_chiltemp, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + call fates_params%RegisterParameter(name=ED_name_phen_chiltemp, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) - call fates_params%RegisterParameter(name=ED_name_phen_mindayson, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + call fates_params%RegisterParameter(name=ED_name_phen_mindayson, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) - call fates_params%RegisterParameter(name=ED_name_phen_ncolddayslim, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + call fates_params%RegisterParameter(name=ED_name_phen_ncolddayslim, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) - call fates_params%RegisterParameter(name=ED_name_phen_coldtemp, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + call fates_params%RegisterParameter(name=ED_name_phen_coldtemp, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) - call fates_params%RegisterParameter(name=ED_name_cohort_fusion_tol, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + call fates_params%RegisterParameter(name=ED_name_cohort_fusion_tol, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) - call fates_params%RegisterParameter(name=ED_name_patch_fusion_tol, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + call fates_params%RegisterParameter(name=ED_name_patch_fusion_tol, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) - call fates_params%RegisterParameter(name=ED_name_canopy_closure_thresh, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + call fates_params%RegisterParameter(name=ED_name_canopy_closure_thresh, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) - call fates_params%RegisterParameter(name=hydr_name_kmax_rsurf, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + call fates_params%RegisterParameter(name=hydr_name_kmax_rsurf1, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) + + call fates_params%RegisterParameter(name=hydr_name_kmax_rsurf2, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) - call fates_params%RegisterParameter(name=hydr_name_psi0, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + call fates_params%RegisterParameter(name=hydr_name_psi0, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) - call fates_params%RegisterParameter(name=hydr_name_psicap, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + call fates_params%RegisterParameter(name=hydr_name_psicap, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) - call fates_params%RegisterParameter(name=bgc_name_soil_salinity, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + 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_1d, & - dimension_names=dim_names) + call fates_params%RegisterParameter(name=logging_name_dbhmin, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) - call fates_params%RegisterParameter(name=logging_name_collateral_frac, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + call fates_params%RegisterParameter(name=logging_name_collateral_frac, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) - call fates_params%RegisterParameter(name=logging_name_coll_under_frac, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + call fates_params%RegisterParameter(name=logging_name_coll_under_frac, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) - call fates_params%RegisterParameter(name=logging_name_direct_frac, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + call fates_params%RegisterParameter(name=logging_name_direct_frac, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) - call fates_params%RegisterParameter(name=logging_name_mechanical_frac, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + call fates_params%RegisterParameter(name=logging_name_mechanical_frac, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) - call fates_params%RegisterParameter(name=logging_name_event_code, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + call fates_params%RegisterParameter(name=logging_name_event_code, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) - call fates_params%RegisterParameter(name=logging_name_dbhmax_infra, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + call fates_params%RegisterParameter(name=logging_name_dbhmax_infra, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) + + call fates_params%RegisterParameter(name=logging_name_export_frac, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) + + call fates_params%RegisterParameter(name=fates_name_q10_mr, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) + + call fates_params%RegisterParameter(name=fates_name_q10_froz, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) ! non-scalar parameters call fates_params%RegisterParameter(name=ED_name_history_sizeclass_bin_edges, dimension_shape=dimension_shape_1d, & @@ -302,6 +345,12 @@ subroutine FatesRegisterParams(fates_params) call fates_params%RegisterParameter(name=ED_name_history_height_bin_edges, dimension_shape=dimension_shape_1d, & dimension_names=dim_names_height) + call fates_params%RegisterParameter(name=fates_name_active_crown_fire, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) + + call fates_params%RegisterParameter(name=fates_name_cg_strikes, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) + end subroutine FatesRegisterParams @@ -314,6 +363,9 @@ subroutine FatesReceiveParams(fates_params) class(fates_parameters_type), intent(inout) :: fates_params + real(r8) :: active_crown_fire_real !Local temp to transfer real data in file + + call fates_params%RetreiveParameter(name=ED_name_mort_disturb_frac, & data=fates_mortality_disturbance_fraction) @@ -380,8 +432,11 @@ subroutine FatesReceiveParams(fates_params) call fates_params%RetreiveParameter(name=ED_name_canopy_closure_thresh, & data=ED_val_canopy_closure_thresh) - call fates_params%RetreiveParameter(name=hydr_name_kmax_rsurf, & - data=hydr_kmax_rsurf) + call fates_params%RetreiveParameter(name=hydr_name_kmax_rsurf1, & + data=hydr_kmax_rsurf1) + + call fates_params%RetreiveParameter(name=hydr_name_kmax_rsurf2, & + data=hydr_kmax_rsurf2) call fates_params%RetreiveParameter(name=hydr_name_psi0, & data=hydr_psi0) @@ -413,6 +468,22 @@ subroutine FatesReceiveParams(fates_params) call fates_params%RetreiveParameter(name=logging_name_dbhmax_infra, & data=logging_dbhmax_infra) + call fates_params%RetreiveParameter(name=logging_name_export_frac, & + data=logging_export_frac) + + call fates_params%RetreiveParameter(name=fates_name_q10_mr, & + data=q10_mr) + + call fates_params%RetreiveParameter(name=fates_name_q10_froz, & + data=q10_froz) + + call fates_params%RetreiveParameter(name=fates_name_active_crown_fire, & + data=active_crown_fire_real) + active_crown_fire = (abs(active_crown_fire_real-1.0_r8) fates_endrun - + use FatesLitterMod, only : ilabile,icellulose,ilignin use PRTGenericMod, only : prt_cnp_flex_allom_hyp use PRTGenericMod, only : prt_carbon_allom_hyp use PRTGenericMod, only : num_organ_types @@ -35,7 +35,6 @@ module EDPftvarcon !ED specific variables. type, public :: EDPftvarcon_type - real(r8), allocatable :: pft_used(:) ! Switch to turn on and off PFTs real(r8), allocatable :: freezetol(:) ! minimum temperature tolerance real(r8), allocatable :: wood_density(:) ! wood density g cm^-3 ... real(r8), allocatable :: hgt_min(:) ! sapling height m @@ -51,7 +50,7 @@ module EDPftvarcon real(r8), allocatable :: bark_scaler(:) ! scaler from dbh to bark thickness. For fire model. real(r8), allocatable :: crown_kill(:) ! scaler on fire death. For fire model. real(r8), allocatable :: initd(:) ! initial seedling density - real(r8), allocatable :: seed_rain(:) ! seeds that come from outside the gridbox. + real(r8), allocatable :: seed_suppl(:) ! seeds that come from outside the gridbox. real(r8), allocatable :: BB_slope(:) ! ball berry slope parameter real(r8), allocatable :: seed_alloc_mature(:) ! fraction of carbon balance allocated to @@ -109,8 +108,9 @@ module EDPftvarcon real(r8), allocatable :: vcmaxse(:) real(r8), allocatable :: jmaxse(:) real(r8), allocatable :: tpuse(:) - real(r8), allocatable :: germination_timescale(:) - real(r8), allocatable :: seed_decay_turnover(:) + real(r8), allocatable :: germination_rate(:) ! Fraction of seed mass germinating per year (yr-1) + real(r8), allocatable :: seed_decay_rate(:) ! Fraction of seed mass (both germinated and + ! ungerminated), decaying per year (yr-1) real(r8), allocatable :: trim_limit(:) ! Limit to reductions in leaf area w stress (m2/m2) real(r8), allocatable :: trim_inc(:) ! Incremental change in trimming function (m2/m2) @@ -195,14 +195,59 @@ module EDPftvarcon real(r8), allocatable :: prt_nitr_stoich_p1(:,:) ! Parameter 1 for nitrogen stoichiometry (pft x organ) real(r8), allocatable :: prt_nitr_stoich_p2(:,:) ! Parameter 2 for nitrogen stoichiometry (pft x organ) - real(r8), allocatable :: prt_phos_stoich_p1(:,:) ! Parameter 1 for phosphorous stoichiometry (pft x organ) - real(r8), allocatable :: prt_phos_stoich_p2(:,:) ! Parameter 2 for phosphorous stoichiometry (pft x organ) + real(r8), allocatable :: prt_phos_stoich_p1(:,:) ! Parameter 1 for phosphorus stoichiometry (pft x organ) + real(r8), allocatable :: prt_phos_stoich_p2(:,:) ! Parameter 2 for phosphorus stoichiometry (pft x organ) real(r8), allocatable :: prt_alloc_priority(:,:) ! Allocation priority for each organ (pft x organ) [integer 0-6] + ! Nutrient Aquisition parameters + + real(r8), allocatable :: prescribed_nuptake(:) ! Nitrogen uptake flux per unit crown area + ! (negative implies fraction of NPP) kgN/m2/yr + + real(r8), allocatable :: prescribed_puptake(:) ! Phosphorus uptake flux per unit crown area + ! (negative implies fraction of NPP) kgP/m2/yr + + ! (NONE OF THESE ARE ACTIVE YET - PLACEHOLDERS ONLY!!!!!) + + ! Nutrient Aquisition (ECA & RD) +! real(r8), allocatable :: decompmicc(:) ! microbial decomposer biomass gC/m3 + ! on root surface + + ! ECA Parameters: See Zhu et al. Multiple soil nutrient competition between plants, + ! microbes, and mineral surfaces: model development, parameterization, + ! and example applications in several tropical forests. Biogeosciences, + ! 13, pp.341-363, 2016. + ! KM: Michaeles-Menten half-saturation constants for ECA (plant–enzyme affinity) + ! VMAX: Product of the reaction-rate and enzyme abundance for each PFT in ECA + ! Note*: units of [gC] is grams carbon of fine-root + + real(r8), allocatable :: eca_km_nh4(:) ! half-saturation constant for plant nh4 uptake [gN/m3] + real(r8), allocatable :: eca_vmax_nh4(:) ! maximum production rate for plant nh4 uptake [gN/gC/s] + real(r8), allocatable :: eca_km_no3(:) ! half-saturation constant for plant no3 uptake [gN/m3] + real(r8), allocatable :: eca_vmax_no3(:) ! maximum production rate for plant no3 uptake [gN/gC/s] + real(r8), allocatable :: eca_km_p(:) ! half-saturation constant for plant p uptake [gP/m3] + real(r8), allocatable :: eca_vmax_p(:) ! maximum production rate for plant p uptake [gP/gC/s] + real(r8), allocatable :: eca_km_ptase(:) ! half-saturation constant for biochemical P production [gP/m3] + real(r8), allocatable :: eca_vmax_ptase(:) ! maximum production rate for biochemical P prod [gP/m2/s] + real(r8), allocatable :: eca_alpha_ptase(:) ! Fraction of min P generated from ptase activity + ! that is immediately sent to the plant [/] + real(r8), allocatable :: eca_lambda_ptase(:) ! critical value for Ptase that incurs + ! biochemical production, fraction based how much + ! more in need a plant is for P versus N [/] + + + real(r8), allocatable :: nfix1(:) ! nitrogen fixation parameter 1 (in file, but not used yet) + real(r8), allocatable :: nfix2(:) ! nitrogen fixation parameter 2 (in file, but not used yet) + + ! Turnover related things real(r8), allocatable :: phenflush_fraction(:) ! Maximum fraction of storage carbon used to flush leaves ! on bud-burst [kgC/kgC] + real(r8), allocatable :: phen_cold_size_threshold(:) ! stem/leaf drop occurs on DBH size of decidious non-woody + ! (coastal grass) plants larger than the threshold value + real(r8), allocatable :: phen_stem_drop_fraction(:) ! Fraction of stem dropped/senescened for decidious + ! non-woody (grass) plants real(r8), allocatable :: senleaf_long_fdrought(:) ! Multiplication factor for leaf longevity of senescent ! leaves during drought( 1.0 indicates no change) @@ -213,7 +258,7 @@ module EDPftvarcon 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) - real(r8), allocatable :: turnover_phos_retrans(:,:) ! phosphorous re-translocation fraction (pft x organ) + real(r8), allocatable :: turnover_phos_retrans(:,:) ! phosphorus re-translocation fraction (pft x organ) ! Parameters dimensioned by PFT and leaf age real(r8), allocatable :: leaf_long(:,:) ! Leaf turnover time (longevity) (pft x age-class) @@ -271,6 +316,7 @@ module EDPftvarcon ! !PUBLIC MEMBER FUNCTIONS: public :: FatesReportPFTParams public :: FatesCheckParams + public :: GetDecompyFrac !----------------------------------------------------------------------- contains @@ -345,10 +391,6 @@ subroutine Register_PFT(this, fates_params) !X! call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & !X! dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'fates_pft_used' - call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'fates_seed_dbh_repro_threshold' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) @@ -389,7 +431,7 @@ 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_seed_rain' + name = 'fates_seed_suppl' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) @@ -665,7 +707,7 @@ subroutine Register_PFT(this, fates_params) name = 'fates_mort_bmort' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - + name = 'fates_mort_scalar_coldstress' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) @@ -722,11 +764,11 @@ 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_seed_germination_timescale' + name = 'fates_seed_germination_rate' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'fates_seed_decay_turnover' + name = 'fates_seed_decay_rate' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) @@ -761,8 +803,77 @@ subroutine Register_PFT(this, fates_params) name = 'fates_phenflush_fraction' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_phen_cold_size_threshold' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_phen_stem_drop_fraction' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + ! Nutrient competition parameters + +! name = 'fates_eca_decompmicc' +! call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & +! dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_eca_km_nh4' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_eca_vmax_nh4' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_eca_km_no3' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_eca_vmax_no3' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + name = 'fates_eca_km_p' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_eca_vmax_p' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_eca_km_ptase' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_eca_vmax_ptase' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_eca_alpha_ptase' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_eca_lambda_ptase' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_nfix1' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_nfix2' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_prescribed_nuptake' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_prescribed_puptake' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + end subroutine Register_PFT !----------------------------------------------------------------------- @@ -781,10 +892,6 @@ subroutine Receive_PFT(this, fates_params) !X! call fates_params%RetreiveParameter(name=name, & !X! data=this%) - name = 'fates_pft_used' - call fates_params%RetreiveParameterAllocate(name=name, & - data=this%pft_used) - name = 'fates_seed_dbh_repro_threshold' call fates_params%RetreiveParameterAllocate(name=name, & data=this%dbh_repro_threshold) @@ -825,9 +932,9 @@ subroutine Receive_PFT(this, fates_params) call fates_params%RetreiveParameterAllocate(name=name, & data=this%initd) - name = 'fates_seed_rain' + name = 'fates_seed_suppl' call fates_params%RetreiveParameterAllocate(name=name, & - data=this%seed_rain) + data=this%seed_suppl) name = 'fates_leaf_BB_slope' call fates_params%RetreiveParameterAllocate(name=name, & @@ -1100,7 +1207,7 @@ subroutine Receive_PFT(this, fates_params) name = 'fates_mort_bmort' call fates_params%RetreiveParameterAllocate(name=name, & data=this%bmort) - + name = 'fates_mort_scalar_coldstress' call fates_params%RetreiveParameterAllocate(name=name, & data=this%mort_scalar_coldstress) @@ -1157,13 +1264,13 @@ subroutine Receive_PFT(this, fates_params) call fates_params%RetreiveParameterAllocate(name=name, & data=this%tpuse) - name = 'fates_seed_germination_timescale' + name = 'fates_seed_germination_rate' call fates_params%RetreiveParameterAllocate(name=name, & - data=this%germination_timescale) + data=this%germination_rate) - name = 'fates_seed_decay_turnover' + name = 'fates_seed_decay_rate' call fates_params%RetreiveParameterAllocate(name=name, & - data=this%seed_decay_turnover) + data=this%seed_decay_rate) name = 'fates_branch_turnover' call fates_params%RetreiveParameterAllocate(name=name, & @@ -1196,7 +1303,85 @@ subroutine Receive_PFT(this, fates_params) name = 'fates_phenflush_fraction' call fates_params%RetreiveParameterAllocate(name=name, & data=this%phenflush_fraction) + + name = 'fates_phen_cold_size_threshold' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%phen_cold_size_threshold) + + name = 'fates_phen_stem_drop_fraction' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%phen_stem_drop_fraction) + + name = 'fates_phen_cold_size_threshold' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%phen_cold_size_threshold) + + name = 'fates_phen_stem_drop_fraction' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%phen_stem_drop_fraction) + +! name = 'fates_eca_decompmicc' +! call fates_params%RetreiveParameterAllocate(name=name, & +! data=this%eca_decompmicc) + + name = 'fates_eca_km_nh4' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%eca_km_nh4) + + name = 'fates_eca_vmax_nh4' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%eca_vmax_nh4) + + name = 'fates_eca_km_no3' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%eca_km_no3) + + name = 'fates_eca_vmax_no3' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%eca_vmax_no3) + + name = 'fates_eca_km_p' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%eca_km_p) + + name = 'fates_eca_vmax_p' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%eca_vmax_p) + + name = 'fates_eca_km_ptase' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%eca_km_ptase) + + name = 'fates_eca_vmax_ptase' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%eca_vmax_ptase) + + name = 'fates_eca_alpha_ptase' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%eca_alpha_ptase) + + name = 'fates_eca_lambda_ptase' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%eca_lambda_ptase) + + name = 'fates_nfix1' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%nfix1) + + name = 'fates_nfix2' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%nfix2) + + name = 'fates_prescribed_nuptake' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%prescribed_nuptake) + + name = 'fates_prescribed_puptake' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%prescribed_puptake) + + end subroutine Receive_PFT !----------------------------------------------------------------------- @@ -1705,7 +1890,7 @@ subroutine FatesReportPFTParams(is_master) integer :: npft,ipft - npft = size(EDPftvarcon_inst%pft_used,1) + npft = size(EDPftvarcon_inst%evergreen,1) if(debug_report .and. is_master) then @@ -1717,7 +1902,6 @@ subroutine FatesReportPFTParams(is_master) end if write(fates_log(),*) '----------- FATES PFT Parameters -----------------' - write(fates_log(),fmt0) 'pft_used = ',EDPftvarcon_inst%pft_used write(fates_log(),fmt0) 'dbh max height = ',EDPftvarcon_inst%allom_dbh_maxheight write(fates_log(),fmt0) 'dbh mature = ',EDPftvarcon_inst%dbh_repro_threshold write(fates_log(),fmt0) 'freezetol = ',EDPftvarcon_inst%freezetol @@ -1732,7 +1916,7 @@ subroutine FatesReportPFTParams(is_master) write(fates_log(),fmt0) 'bark_scaler = ',EDPftvarcon_inst%bark_scaler write(fates_log(),fmt0) 'crown_kill = ',EDPftvarcon_inst%crown_kill write(fates_log(),fmt0) 'initd = ',EDPftvarcon_inst%initd - write(fates_log(),fmt0) 'seed_rain = ',EDPftvarcon_inst%seed_rain + write(fates_log(),fmt0) 'seed_suppl = ',EDPftvarcon_inst%seed_suppl write(fates_log(),fmt0) 'BB_slope = ',EDPftvarcon_inst%BB_slope write(fates_log(),fmt0) 'root_long = ',EDPftvarcon_inst%root_long write(fates_log(),fmt0) 'senleaf_long_fdrought = ',EDPftvarcon_inst%senleaf_long_fdrought @@ -1762,7 +1946,7 @@ subroutine FatesReportPFTParams(is_master) write(fates_log(),fmt0) 'grperc = ',EDPftvarcon_inst%grperc write(fates_log(),fmt0) 'c2b = ',EDPftvarcon_inst%c2b write(fates_log(),fmt0) 'bmort = ',EDPftvarcon_inst%bmort - write(fates_log(),fmt0) 'mort_scalar_coldstress = ',EDPftvarcon_inst%mort_scalar_coldstress + write(fates_log(),fmt0) 'mort_scalar_coldstress = ',EDPftvarcon_inst%mort_scalar_coldstress write(fates_log(),fmt0) 'mort_scalar_cstarvation = ',EDPftvarcon_inst%mort_scalar_cstarvation write(fates_log(),fmt0) 'mort_scalar_hydrfailure = ',EDPftvarcon_inst%mort_scalar_hydrfailure write(fates_log(),fmt0) 'hf_sm_threshold = ',EDPftvarcon_inst%hf_sm_threshold @@ -1776,8 +1960,8 @@ subroutine FatesReportPFTParams(is_master) write(fates_log(),fmt0) 'vcmaxse = ',EDPftvarcon_inst%vcmaxse write(fates_log(),fmt0) 'jmaxse = ',EDPftvarcon_inst%jmaxse write(fates_log(),fmt0) 'tpuse = ',EDPftvarcon_inst%tpuse - write(fates_log(),fmt0) 'germination_timescale = ',EDPftvarcon_inst%germination_timescale - write(fates_log(),fmt0) 'seed_decay_turnover = ',EDPftvarcon_inst%seed_decay_turnover + write(fates_log(),fmt0) 'germination_rate = ',EDPftvarcon_inst%germination_rate + write(fates_log(),fmt0) 'seed_decay_rate = ',EDPftvarcon_inst%seed_decay_rate write(fates_log(),fmt0) 'branch_turnover = ',EDPftvarcon_inst%branch_turnover write(fates_log(),fmt0) 'trim_limit = ',EDPftvarcon_inst%trim_limit write(fates_log(),fmt0) 'trim_inc = ',EDPftvarcon_inst%trim_inc @@ -1786,6 +1970,8 @@ subroutine FatesReportPFTParams(is_master) write(fates_log(),fmt0) 'taul = ',EDPftvarcon_inst%taul write(fates_log(),fmt0) 'taus = ',EDPftvarcon_inst%taus write(fates_log(),fmt0) 'phenflush_fraction',EDpftvarcon_inst%phenflush_fraction + write(fates_log(),fmt0) 'phen_cold_size_threshold = ',EDPftvarcon_inst%phen_cold_size_threshold + write(fates_log(),fmt0) 'phen_stem_drop_fraction',EDpftvarcon_inst%phen_stem_drop_fraction write(fates_log(),fmt0) 'rootprof_beta = ',EDPftvarcon_inst%rootprof_beta write(fates_log(),fmt0) 'fire_alpha_SH = ',EDPftvarcon_inst%fire_alpha_SH write(fates_log(),fmt0) 'allom_hmode = ',EDPftvarcon_inst%allom_hmode @@ -1875,7 +2061,7 @@ subroutine FatesCheckParams(is_master, parteh_mode) integer :: iage ! leaf age class index integer :: norgans ! size of the plant organ dimension - npft = size(EDPftvarcon_inst%pft_used,1) + npft = size(EDPftvarcon_inst%evergreen,1) ! Prior to performing checks copy grperc to the ! organ dimensioned version @@ -1916,6 +2102,7 @@ subroutine FatesCheckParams(is_master, parteh_mode) call endrun(msg=errMsg(sourcefile, __LINE__)) end if + do ipft = 1,npft @@ -2002,6 +2189,16 @@ subroutine FatesCheckParams(is_master, parteh_mode) write(fates_log(),*) ' Aborting' call endrun(msg=errMsg(sourcefile, __LINE__)) end if + if ( ( EDPftvarcon_inst%phen_stem_drop_fraction(ipft) < 0.0_r8 ) .or. & + ( EDPFtvarcon_inst%phen_stem_drop_fraction(ipft) > 1 ) ) then + write(fates_log(),*) ' Deciduous non-wood plants must keep 0-100% of their stems' + write(fates_log(),*) ' during the deciduous period.' + write(fates_log(),*) ' PFT#: ',ipft + write(fates_log(),*) ' evergreen flag: (shold be 0):',int(EDPftvarcon_inst%evergreen(ipft)) + write(fates_log(),*) ' phen_stem_drop_fraction: ', EDPFtvarcon_inst%phen_stem_drop_fraction(ipft) + write(fates_log(),*) ' Aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if end if @@ -2409,7 +2606,52 @@ subroutine FatesCheckParams(is_master, parteh_mode) return end subroutine FatesCheckParams + ! ===================================================================================== + + function GetDecompyFrac(pft,organ_id,dcmpy) result(decompy_frac) + + ! This simple routine matches the correct decomposibility pool's + ! material fraction with the pft parameter data. + + integer, intent(in) :: pft + integer, intent(in) :: organ_id + integer, intent(in) :: dcmpy + real(r8) :: decompy_frac + + ! Decomposability for leaves + if(organ_id == leaf_organ)then + select case(dcmpy) + case(ilabile) + decompy_frac=EDPftvarcon_inst%lf_flab(pft) + case(icellulose) + decompy_frac=EDPftvarcon_inst%lf_fcel(pft) + case(ilignin) + decompy_frac=EDPftvarcon_inst%lf_flig(pft) + case default + write(fates_log(),*) 'Unknown decompositiblity pool index: ',dcmpy + call endrun(msg=errMsg(sourcefile, __LINE__)) + end select + ! Decomposability for fine-roots + elseif(organ_id == fnrt_organ) then + select case(dcmpy) + case(ilabile) + decompy_frac=EDPftvarcon_inst%fr_flab(pft) + case(icellulose) + decompy_frac=EDPftvarcon_inst%fr_fcel(pft) + case(ilignin) + decompy_frac=EDPftvarcon_inst%fr_flig(pft) + case default + write(fates_log(),*) 'Unknown decompositiblity pool index: ',dcmpy + call endrun(msg=errMsg(sourcefile, __LINE__)) + end select + else + write(fates_log(),*) 'Unknown parteh organ index: ',organ_id + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + return + end function GetDecompyFrac end module EDPftvarcon diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 633e365678..9e3db3d910 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -4,37 +4,40 @@ module EDTypesMod use FatesConstantsMod, only : ifalse use FatesConstantsMod, only : itrue use FatesGlobals, only : fates_log - use shr_infnan_mod, only : nan => shr_infnan_nan, assignment(=) use FatesHydraulicsMemMod, only : ed_cohort_hydr_type use FatesHydraulicsMemMod, only : ed_site_hydr_type use PRTGenericMod, only : prt_vartypes use PRTGenericMod, only : leaf_organ, fnrt_organ, sapw_organ use PRTGenericMod, only : repro_organ, store_organ, struct_organ use PRTGenericMod, only : all_carbon_elements + use PRTGenericMod, only : num_organ_types + use FatesLitterMod, only : litter_type + use FatesLitterMod, only : ncwd use FatesConstantsMod, only : n_anthro_disturbance_categories implicit none + private ! By default everything is private save - integer, parameter :: maxPatchesPerSite = 14 ! maximum number of patches to live on a site - integer, parameter :: maxPatchesPerSite_by_disttype(n_anthro_disturbance_categories) = & + 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, parameter :: maxCohortsPerPatch = 100 ! maximum number of cohorts per patch + integer, parameter, public :: maxCohortsPerPatch = 100 ! maximum number of cohorts per patch - integer, parameter :: nclmax = 2 ! Maximum number of canopy layers - integer, parameter :: ican_upper = 1 ! Nominal index for the upper canopy - integer, parameter :: ican_ustory = 2 ! Nominal index for diagnostics that refer - ! to understory layers (all layers that - ! are not the top canopy layer) - - integer, parameter :: nlevleaf = 30 ! number of leaf layers in canopy layer - integer, parameter :: maxpft = 15 ! maximum number of PFTs allowed - ! the parameter file may determine that fewer - ! are used, but this helps allocate scratch - ! space and output arrays. + 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 + ! are not the top canopy layer) + + integer, parameter, public :: nlevleaf = 30 ! number of leaf layers in canopy layer + integer, parameter, public :: maxpft = 15 ! maximum number of PFTs allowed + ! the parameter file may determine that fewer + ! are used, but this helps allocate scratch + ! space and output arrays. - integer, parameter :: max_nleafage = 4 ! This is the maximum number of leaf age pools, - ! used for allocating scratch space + integer, parameter, public :: max_nleafage = 4 ! This is the maximum number of leaf age pools, + ! used for allocating scratch space ! ------------------------------------------------------------------------------------- ! Radiation parameters @@ -43,48 +46,47 @@ module EDTypesMod ! ------------------------------------------------------------------------------------- - integer, parameter :: n_rad_stream_types = 2 ! The number of radiation streams used (direct/diffuse) + integer, parameter, public :: n_rad_stream_types = 2 ! The number of radiation streams used (direct/diffuse) - integer, parameter :: idirect = 1 ! This is the array index for direct radiation - integer, parameter :: idiffuse = 2 ! This is the array index for diffuse radiation + integer, parameter, public :: idirect = 1 ! This is the array index for direct radiation + integer, parameter, public :: idiffuse = 2 ! This is the array index for diffuse radiation ! TODO: we use this cp_maxSWb only because we have a static array q(size=2) of ! land-ice abledo for vis and nir. This should be a parameter, which would ! get us on track to start using multi-spectral or hyper-spectral (RGK 02-2017) - integer, parameter :: maxSWb = 2 ! maximum number of broad-bands in the - ! shortwave spectrum cp_numSWb <= cp_maxSWb - ! this is just for scratch-array purposes - ! if cp_numSWb is larger than this value - ! simply bump this number up as needed - - integer, parameter :: ivis = 1 ! This is the array index for short-wave - ! radiation in the visible spectrum, as expected - ! in boundary condition files and parameter - ! files. This will be compared with - ! the HLM's expectation in FatesInterfaceMod - integer, parameter :: inir = 2 ! This is the array index for short-wave - ! radiation in the near-infrared spectrum, as expected - ! in boundary condition files and parameter - ! files. This will be compared with - ! the HLM's expectation in FatesInterfaceMod - - integer, parameter :: ipar = ivis ! The photosynthetically active band - ! can be approximated to be equal to the visible band - - - integer, parameter :: leaves_on = 2 ! Flag specifying that a deciduous plant has leaves - ! and should be allocating to them as well - - integer, parameter :: leaves_off = 1 ! Flag specifying that a deciduous plant has dropped - ! its leaves and should not be trying to allocate - ! towards any growth. + integer, parameter, public :: maxSWb = 2 ! maximum number of broad-bands in the + ! shortwave spectrum cp_numSWb <= cp_maxSWb + ! this is just for scratch-array purposes + ! if cp_numSWb is larger than this value + ! simply bump this number up as needed + + integer, parameter, public :: ivis = 1 ! This is the array index for short-wave + ! radiation in the visible spectrum, as expected + ! in boundary condition files and parameter + ! files. This will be compared with + ! the HLM's expectation in FatesInterfaceMod + integer, parameter, public :: inir = 2 ! This is the array index for short-wave + ! radiation in the near-infrared spectrum, as expected + ! in boundary condition files and parameter + ! files. This will be compared with + ! the HLM's expectation in FatesInterfaceMod + + integer, parameter, public :: ipar = ivis ! The photosynthetically active band + ! can be approximated to be equal to the visible band + + + integer, parameter, public :: leaves_on = 2 ! Flag specifying that a deciduous plant has leaves + ! and should be allocating to them as well + integer, parameter, public :: leaves_off = 1 ! Flag specifying that a deciduous plant has dropped + ! its leaves and should not be trying to allocate + ! towards any growth. ! Flag to turn on/off salinity effects on the effective "btran" ! btran stress function. - logical, parameter :: do_fates_salinity = .false. + logical, parameter, public :: do_fates_salinity = .false. ! This is the community level amount of spread expected in nearly-bare-ground @@ -97,93 +99,103 @@ module EDTypesMod ! A value of 0 means that they have the least amount of spread for their ! size and PFT. - real(r8), parameter :: init_spread_near_bare_ground = 1.0_r8 - real(r8), parameter :: init_spread_inventory = 0.0_r8 + real(r8), parameter, public :: init_spread_near_bare_ground = 1.0_r8 + real(r8), parameter, public :: init_spread_inventory = 0.0_r8 ! MODEL PARAMETERS - real(r8), parameter :: AREA = 10000.0_r8 ! Notional area of simulated forest m2 - real(r8), parameter :: AREA_INV = 1.0e-4_r8 ! Inverse of the notion area (faster math) - integer, parameter :: numWaterMem = 10 ! watermemory saved as site level var + real(r8), parameter, public :: area = 10000.0_r8 ! Notional area of simulated forest m2 + real(r8), parameter, public :: area_inv = 1.0e-4_r8 ! Inverse of the notion area (faster math) + + integer, parameter, public :: numWaterMem = 10 ! watermemory saved as site level var + + integer, parameter, public :: numlevsoil_max = 30 ! This is scratch space used for static arrays + ! The actual number of soil layers should not exceed this + ! BIOLOGY/BIOGEOCHEMISTRY - integer , parameter :: num_vegtemp_mem = 10 ! Window of time over which we track temp for cold sensecence (days) - real(r8), parameter :: dinc_ed = 1.0_r8 ! size of VAI bins (LAI+SAI) [CHANGE THIS NAME WITH NEXT INTERFACE + integer , parameter, public :: num_vegtemp_mem = 10 ! Window of time over which we track temp for cold sensecence (days) + real(r8), parameter, public :: dinc_ed = 1.0_r8 ! size of VAI bins (LAI+SAI) [CHANGE THIS NAME WITH NEXT INTERFACE ! UPDATE] - integer , parameter :: N_DIST_TYPES = 3 ! Disturbance Modes 1) tree-fall, 2) fire, 3) logging - integer , parameter :: dtype_ifall = 1 ! index for naturally occuring tree-fall generated event - integer , parameter :: dtype_ifire = 2 ! index for fire generated disturbance event - integer , parameter :: dtype_ilog = 3 ! index for logging generated disturbance event - + integer , parameter, public :: N_DIST_TYPES = 3 ! Disturbance Modes 1) tree-fall, 2) fire, 3) logging + integer , parameter, public :: dtype_ifall = 1 ! index for naturally occuring tree-fall generated event + integer , parameter, public :: dtype_ifire = 2 ! index for fire generated disturbance event + integer , parameter, public :: dtype_ilog = 3 ! index for logging generated disturbance event ! Phenology status flag definitions (cold type is cstat, dry type is dstat) - integer, parameter :: phen_cstat_nevercold = 0 ! This (location/plant) has not experienced a cold period over a large number + integer, parameter, public :: phen_cstat_nevercold = 0 ! This (location/plant) has not experienced a cold period over a large number ! of days, leaves are dropped and flagged as non-cold region - integer, parameter :: phen_cstat_iscold = 1 ! This (location/plant) is in a cold-state where leaves should have fallen - integer, parameter :: phen_cstat_notcold = 2 ! This site is in a warm-state where leaves are allowed to flush + integer, parameter, public :: phen_cstat_iscold = 1 ! This (location/plant) is in a cold-state where leaves should have fallen + integer, parameter, public :: phen_cstat_notcold = 2 ! This site is in a warm-state where leaves are allowed to flush - integer, parameter :: phen_dstat_timeoff = 0 ! Leaves off due to time exceedance (drought phenology) - integer, parameter :: phen_dstat_moistoff = 1 ! Leaves off due to moisture avail (drought phenology) - integer, parameter :: phen_dstat_moiston = 2 ! Leaves on due to moisture avail (drought phenology) - integer, parameter :: phen_dstat_timeon = 3 ! Leaves on due to time exceedance (drought phenology) + integer, parameter, public :: phen_dstat_timeoff = 0 ! Leaves off due to time exceedance (drought phenology) + integer, parameter, public :: phen_dstat_moistoff = 1 ! Leaves off due to moisture avail (drought phenology) + integer, parameter, public :: phen_dstat_moiston = 2 ! Leaves on due to moisture avail (drought phenology) + integer, parameter, public :: phen_dstat_timeon = 3 ! Leaves on due to time exceedance (drought phenology) ! SPITFIRE - integer, parameter :: NCWD = 4 ! number of coarse woody debris pools (twig,s branch,l branch, trunk) - integer , parameter :: NFSC = NCWD+2 ! number fuel size classes (4 cwd size classes, leaf litter, and grass) - integer, parameter :: lg_sf = 6 ! array index of live grass pool for spitfire - integer, parameter :: dl_sf = 1 ! array index of dead leaf pool for spitfire (dead grass and dead leaves) - integer, parameter :: tw_sf = 2 ! array index of twig pool for spitfire - integer, parameter :: tr_sf = 5 ! array index of dead trunk pool for spitfire - integer, parameter :: lb_sf = 4 ! array index of large branch pool for spitfire - real(r8), parameter :: fire_threshold = 50.0_r8 ! threshold for fires that spread or go out. KWm-2 (Pyne 1986) + + integer, parameter, public :: NFSC = NCWD+2 ! number fuel size classes (4 cwd size classes, leaf litter, and grass) + integer, parameter, public :: tw_sf = 1 ! array index of twig pool for spitfire + integer, parameter, public :: lb_sf = 3 ! array index of large branch pool for spitfire + integer, parameter, public :: tr_sf = 4 ! array index of dead trunk pool for spitfire + integer, parameter, public :: dl_sf = 5 ! array index of dead leaf pool for spitfire (dead grass and dead leaves) + integer, parameter, public :: lg_sf = 6 ! array index of live grass pool for spitfire + + real(r8), parameter, public :: fire_threshold = 50.0_r8 ! threshold for fires that spread or go out. KWm-2 (Pyne 1986) ! PATCH FUSION - real(r8), parameter :: force_patchfuse_min_biomass = 0.005_r8 ! min biomass (kg / m2 patch area) below which to force-fuse patches - integer , parameter :: N_DBH_BINS = 6 ! no. of dbh bins used when comparing patches - real(r8), parameter :: patchfusion_dbhbin_loweredges(N_DBH_BINS) = & - (/0._r8, 5._r8, 20._r8, 50._r8, 100._r8, 150._r8/) ! array of bin lower edges for comparing patches - real(r8), parameter :: patch_fusion_tolerance_relaxation_increment = 1.1_r8 ! amount by which to increment patch fusion threshold - real(r8), parameter :: max_age_of_second_oldest_patch = 200._r8 ! age in years above which to combine all patches + real(r8), parameter, public :: force_patchfuse_min_biomass = 0.005_r8 ! min biomass (kg / m2 patch area) below which to force-fuse patches + integer , parameter, public :: N_DBH_BINS = 6 ! no. of dbh bins used when comparing patches + real(r8), parameter, public :: patchfusion_dbhbin_loweredges(N_DBH_BINS) = & + (/0._r8, 5._r8, 20._r8, 50._r8, 100._r8, 150._r8/) ! array of bin lower edges for comparing patches + real(r8), parameter, public :: patch_fusion_tolerance_relaxation_increment = 1.1_r8 ! amount by which to increment patch fusion threshold + real(r8), parameter, public :: max_age_of_second_oldest_patch = 200._r8 ! age in years above which to combine all patches ! COHORT FUSION - real(r8), parameter :: HITEMAX = 30.0_r8 ! max dbh value used in hgt profile comparison - integer , parameter :: N_HITE_BINS = 60 ! no. of hite bins used to distribute LAI + real(r8), parameter, public :: HITEMAX = 30.0_r8 ! max dbh value used in hgt profile comparison + integer , parameter, public :: N_HITE_BINS = 60 ! no. of hite bins used to distribute LAI ! COHORT TERMINATION - real(r8), parameter :: min_npm2 = 1.0E-7_r8 ! minimum cohort number density per m2 before termination - real(r8), parameter :: min_patch_area = 0.01_r8 ! smallest allowable patch area before termination - real(r8), parameter :: min_patch_area_forced = 0.0001_r8 ! patch termination will not fuse the youngest patch - ! if the area is less than min_patch_area. - ! however, it is allowed to fuse the youngest patch - ! if the fusion area is less than min_patch_area_forced + 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. + ! however, it is allowed to fuse the youngest patch + ! if the fusion area is less than min_patch_area_forced - real(r8), parameter :: min_nppatch = min_npm2*min_patch_area ! minimum number of cohorts per patch (min_npm2*min_patch_area) - real(r8), parameter :: min_n_safemath = 1.0E-12_r8 ! in some cases, we want to immediately remove super small - ! number densities of cohorts to prevent FPEs + 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 + ! number densities of cohorts to prevent FPEs character*4 yearchar ! special mode to cause PFTs to create seed mass of all currently-existing PFTs - logical, parameter :: homogenize_seed_pfts = .false. + logical, parameter, public :: homogenize_seed_pfts = .false. - ! Leaf age class initialization schemes - integer, parameter :: nan_leaf_aclass = 0 ! initialize leaf age classes as undefined - ! (used when copying) - integer, parameter :: equal_leaf_aclass = 1 ! initialize leaf age classes equal - ! (used for inventory initialization) - integer, parameter :: first_leaf_aclass = 2 ! initialize leaf age classes as all in - ! youngest class (used for recruitment) + ! Global identifiers for which elements we are using (apply mostly to litter) + + integer, public :: num_elements ! This is the number of elements in this simulation + ! e.g. (C,N,P,K, etc) + integer, allocatable, public :: element_list(:) ! This vector holds the element ids that are found + ! in PRTGenericMod.F90. examples are carbon12_element + ! nitrogen_element, etc. - !************************************ + integer, public :: element_pos(num_organ_types) ! This is the reverse lookup + ! for element types. Pick an element + ! global index, and it gives you + ! the position in the element_list + + !************************************ !** COHORT type structure ** !************************************ - type ed_cohort_type + type, public :: ed_cohort_type ! POINTERS type (ed_cohort_type) , pointer :: taller => null() ! pointer to next tallest cohort @@ -204,10 +216,13 @@ module EDTypesMod real(r8) :: hite ! height: meters integer :: indexnumber ! unique number for each cohort. (within clump?) real(r8) :: laimemory ! target leaf biomass- set from previous year: kGC per indiv + 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.) real(r8) :: canopy_layer_yesterday ! recent canopy status of cohort ! (1 = canopy, 2 = understorey, etc.) ! real to be conservative during fusion + real(r8) :: lai ! leaf area index of cohort: m2 leaf area of entire cohort per m2 of canopy area of a patch real(r8) :: sai ! stem area index of cohort: m2 leaf area of entire cohort per m2 of canopy area of a patch real(r8) :: g_sb_laweight ! Total conductance (stomata+boundary layer) of the cohort, weighted by its leaf area [m/s]*[m2] @@ -295,11 +310,6 @@ module EDTypesMod ! (below ground) real(r8) :: froot_mr ! Live fine root maintenance respiration: kgC/indiv/s - ! ALLOCATION - - real(r8) :: seed_prod ! reproduction seed and clonal: KgC/indiv/year - - !MORTALITY real(r8) :: dmort ! proportional mortality rate. (year-1) @@ -315,7 +325,10 @@ module EDTypesMod real(r8) :: lmort_collateral ! collaterally damaged rate fraction /per logging activity real(r8) :: lmort_infra ! mechanically damaged rate fraction /per logging activity real(r8) :: l_degrad ! rate of trees that are not killed but suffer from forest degradation - ! (i.e. they are moved to newly-anthro-disturbed secondary forest patch). fraction /per logging activity + ! (i.e. they are moved to newly-anthro-disturbed secondary + ! forest patch). fraction /per logging activity + + real(r8) :: seed_prod ! diagnostic seed production rate [kgC/plant/day] ! NITROGEN POOLS ! ---------------------------------------------------------------------------------- @@ -329,12 +342,13 @@ module EDTypesMod real(r8) :: dhdt ! time derivative of height : m/year real(r8) :: ddbhdt ! time derivative of dbh : cm/year real(r8) :: dbdeaddt ! time derivative of dead biomass : KgC/year - real(r8) :: dbstoredt ! time derivative of stored biomass : KgC/year ! FIRE real(r8) :: fraction_crown_burned ! proportion of crown affected by fire:- - real(r8) :: cambial_mort ! probability that trees dies due to cambial char (conditional on the tree being subjected to the fire) - real(r8) :: crownfire_mort ! probability of tree post-fire mortality due to crown scorch (conditional on the tree being subjected to the fire) + real(r8) :: cambial_mort ! probability that trees dies due to cambial char + ! (conditional on the tree being subjected to the fire) + real(r8) :: crownfire_mort ! probability of tree post-fire mortality + ! due to crown scorch (conditional on the tree being subjected to the fire) real(r8) :: fire_mort ! post-fire mortality from cambial and crown damage assuming two are independent:- ! Hydraulics @@ -342,15 +356,11 @@ module EDTypesMod end type ed_cohort_type - - - - !************************************ !** Patch type structure ** !************************************ - type ed_patch_type + type, public :: ed_patch_type ! POINTERS type (ed_cohort_type), pointer :: tallest => null() ! pointer to patch's tallest cohort @@ -375,25 +385,25 @@ module EDTypesMod real(r8) :: canopy_layer_tlai(nclmax) ! total leaf area index of each canopy layer ! used to determine attenuation of parameters during ! photosynthesis m2 veg / m2 of canopy area (patch without bare ground) - real(r8) :: total_canopy_area ! area that is covered by vegetation : m2 - real(r8) :: total_tree_area ! area that is covered by woody vegetation : m2 - real(r8) :: zstar ! height of smallest canopy tree -- only meaningful in "strict PPA" mode - - real(r8) :: c_stomata ! Mean stomatal conductance of all leaves in the patch [umol/m2/s] - real(r8) :: c_lblayer ! Mean boundary layer conductance of all leaves in the patch [umol/m2/s] - - ! UNITS for the ai profiles - ! [ m2 leaf / m2 contributing crown footprints] - real(r8) :: tlai_profile(nclmax,maxpft,nlevleaf) ! total leaf area in each canopy layer, pft, and leaf layer. - real(r8) :: elai_profile(nclmax,maxpft,nlevleaf) ! exposed leaf area in each canopy layer, pft, and leaf layer - real(r8) :: tsai_profile(nclmax,maxpft,nlevleaf) ! total stem area in each canopy layer, pft, and leaf layer - real(r8) :: esai_profile(nclmax,maxpft,nlevleaf) ! exposed stem area in each canopy layer, pft, and leaf layer + real(r8) :: total_canopy_area ! area that is covered by vegetation : m2 + real(r8) :: total_tree_area ! area that is covered by woody vegetation : m2 + real(r8) :: zstar ! height of smallest canopy tree -- only meaningful in "strict PPA" mode + + real(r8) :: c_stomata ! Mean stomatal conductance of all leaves in the patch [umol/m2/s] + real(r8) :: c_lblayer ! Mean boundary layer conductance of all leaves in the patch [umol/m2/s] + + ! UNITS for the ai profiles + ! [ m2 leaf / m2 contributing crown footprints] + real(r8) :: tlai_profile(nclmax,maxpft,nlevleaf) ! total leaf area in each canopy layer, pft, and leaf layer. + real(r8) :: elai_profile(nclmax,maxpft,nlevleaf) ! exposed leaf area in each canopy layer, pft, and leaf layer + real(r8) :: tsai_profile(nclmax,maxpft,nlevleaf) ! total stem area in each canopy layer, pft, and leaf layer + real(r8) :: esai_profile(nclmax,maxpft,nlevleaf) ! exposed stem area in each canopy layer, pft, and leaf layer real(r8) :: layer_height_profile(nclmax,maxpft,nlevleaf) - real(r8) :: canopy_area_profile(nclmax,maxpft,nlevleaf) ! fraction of crown area per canopy area in each layer - ! they will sum to 1.0 in the fully closed canopy layers - ! but only in leaf-layers that contain contributions - ! from all cohorts that donate to canopy_area + real(r8) :: canopy_area_profile(nclmax,maxpft,nlevleaf) ! fraction of crown area per canopy area in each layer + ! they will sum to 1.0 in the fully closed canopy layers + ! but only in leaf-layers that contain contributions + ! from all cohorts that donate to canopy_area ! layer, pft, and leaf layer:- @@ -403,27 +413,27 @@ module EDTypesMod !RADIATION FLUXES - logical :: solar_zenith_flag ! integer flag specifying daylight (based on zenith angle) - real(r8) :: solar_zenith_angle ! solar zenith angle (radians) + logical :: solar_zenith_flag ! integer flag specifying daylight (based on zenith angle) + real(r8) :: solar_zenith_angle ! solar zenith angle (radians) - real(r8) :: gnd_alb_dif(maxSWb) ! ground albedo for diffuse rad, both bands (fraction) - real(r8) :: gnd_alb_dir(maxSWb) ! ground albedo for direct rad, both bands (fraction) + real(r8) :: gnd_alb_dif(maxSWb) ! ground albedo for diffuse rad, both bands (fraction) + real(r8) :: gnd_alb_dir(maxSWb) ! ground albedo for direct rad, both bands (fraction) - real(r8) :: fabd_sun_z(nclmax,maxpft,nlevleaf) ! sun fraction of direct light absorbed by each canopy + real(r8) :: fabd_sun_z(nclmax,maxpft,nlevleaf) ! sun fraction of direct light absorbed by each canopy ! layer, pft, and leaf layer:- - real(r8) :: fabd_sha_z(nclmax,maxpft,nlevleaf) ! shade fraction of direct light absorbed by each canopy + real(r8) :: fabd_sha_z(nclmax,maxpft,nlevleaf) ! shade fraction of direct light absorbed by each canopy ! layer, pft, and leaf layer:- - real(r8) :: fabi_sun_z(nclmax,maxpft,nlevleaf) ! sun fraction of indirect light absorbed by each canopy + real(r8) :: fabi_sun_z(nclmax,maxpft,nlevleaf) ! sun fraction of indirect light absorbed by each canopy ! layer, pft, and leaf layer:- - real(r8) :: fabi_sha_z(nclmax,maxpft,nlevleaf) ! shade fraction of indirect light absorbed by each canopy + real(r8) :: fabi_sha_z(nclmax,maxpft,nlevleaf) ! shade fraction of indirect light absorbed by each canopy ! layer, pft, and leaf layer:- - real(r8) :: ed_laisun_z(nclmax,maxpft,nlevleaf) ! amount of LAI in the sun in each canopy layer, + real(r8) :: ed_laisun_z(nclmax,maxpft,nlevleaf) ! amount of LAI in the sun in each canopy layer, ! pft, and leaf layer. m2/m2 - real(r8) :: ed_laisha_z(nclmax,maxpft,nlevleaf) ! amount of LAI in the shade in each canopy layer, - real(r8) :: ed_parsun_z(nclmax,maxpft,nlevleaf) ! PAR absorbed in the sun in each canopy layer, - real(r8) :: ed_parsha_z(nclmax,maxpft,nlevleaf) ! PAR absorbed in the shade in each canopy layer, - real(r8) :: f_sun(nclmax,maxpft,nlevleaf) ! fraction of leaves in the sun in each canopy layer, pft, + real(r8) :: ed_laisha_z(nclmax,maxpft,nlevleaf) ! amount of LAI in the shade in each canopy layer, + real(r8) :: ed_parsun_z(nclmax,maxpft,nlevleaf) ! PAR absorbed in the sun in each canopy layer, + real(r8) :: ed_parsha_z(nclmax,maxpft,nlevleaf) ! PAR absorbed in the shade in each canopy layer, + real(r8) :: f_sun(nclmax,maxpft,nlevleaf) ! fraction of leaves in the sun in each canopy layer, pft, ! radiation profiles for comparison against observations @@ -462,18 +472,11 @@ module EDTypesMod real(r8),allocatable :: sabs_dif(:) ! fraction of incoming diffuse radiation that is absorbed by the canopy - !SEED BANK - real(r8) :: seeds_in(maxpft) ! seed production KgC/m2/year - real(r8) :: seed_decay(maxpft) ! seed decay in KgC/m2/year - real(r8) :: seed_germination(maxpft) ! germination rate of seed pool in KgC/m2/year - ! PHOTOSYNTHESIS real(r8) :: psn_z(nclmax,maxpft,nlevleaf) ! carbon assimilation in each canopy layer, pft, and leaf layer. umolC/m2/s ! ROOTS - real(r8), allocatable :: rootfr_ft(:,:) ! root fraction of each PFT in each soil layer:- - real(r8), allocatable :: rootr_ft(:,:) ! fraction of water taken from each PFT and soil layer:- real(r8) :: btran_ft(maxpft) ! btran calculated seperately for each PFT:- real(r8) :: bstress_sal_ft(maxpft) ! bstress from salinity calculated seperately for each PFT:- @@ -483,33 +486,16 @@ module EDTypesMod ! 2) fire: fraction/day ! 3) logging mortatliy real(r8) :: disturbance_rate ! larger effective disturbance rate: fraction/day + integer :: disturbance_mode ! index identifying which disturbance was applied + ! can be one of: dtype_ifall, dtype_ilog or dtype_ifire real(r8) :: fract_ldist_not_harvested ! fraction of logged area that is canopy trees that weren't harvested - ! LITTER AND COARSE WOODY DEBRIS - ! Pools of litter (non respiring) - real(r8) :: cwd_ag(ncwd) ! above ground coarse wood debris litter that does not respire. KgC/m2 - real(r8) :: cwd_bg(ncwd) ! below ground coarse wood debris litter that does not respire. KgC/m2 - real(r8) :: leaf_litter(maxpft) ! above ground leaf litter that does not respire. KgC/m2 - real(r8) :: root_litter(maxpft) ! below ground fine root litter that does not respire. KgC/m2 - ! Fluxes of litter (non respiring) - real(r8) :: fragmentation_scaler ! Scale rate of litter fragmentation. 0 to 1. - real(r8) :: cwd_ag_in(ncwd) ! Flux into CWD_AG from turnover and mortality KgC/m2/y - real(r8) :: cwd_bg_in(ncwd) ! Flux into cwd_bg from root turnover and mortality KgC/m2/y - real(r8) :: cwd_ag_out(ncwd) ! Flux out of AG CWD into AG litter KgC/m2/y - real(r8) :: cwd_bg_out(ncwd) ! Flux out of BG CWD into BG litter KgC/m2/ + ! Litter and Coarse Woody Debris + type(litter_type), pointer :: litter(:) ! Litter (leaf,fnrt,CWD and seeds) for different elements - real(r8) :: leaf_litter_in(maxpft) ! Flux in to AG leaf litter from leaf turnover and mortality KgC/m2/y - real(r8) :: leaf_litter_out(maxpft) ! Flux out of AG leaf litter from fragmentation KgC/m2/y - real(r8) :: root_litter_in(maxpft) ! Flux in to BG root litter from leaf turnover and mortality KgC/m2/y - real(r8) :: root_litter_out(maxpft) ! Flux out of BG root from fragmentation KgC/m2/y - - ! Derivatives of litter (non respiring) - real(r8) :: dcwd_AG_dt(ncwd) ! rate of change of above ground CWD in each size class: KgC/m2/year. - real(r8) :: dcwd_BG_dt(ncwd) ! rate of change of below ground CWD in each size class: KgC/m2/year. - real(r8) :: dleaf_litter_dt(maxpft) ! rate of change of leaf litter in each size class: KgC/m2/year. - real(r8) :: droot_litter_dt(maxpft) ! rate of change of root litter in each size class: KgC/m2/year. + real(r8) :: fragmentation_scaler ! Scale rate of litter fragmentation. 0 to 1. real(r8) :: repro(maxpft) ! allocation to reproduction per PFT : KgC/m2 @@ -535,11 +521,9 @@ module EDTypesMod real(r8) :: fi ! average fire intensity of flaming front: kj/m/s or kw/m integer :: fire ! Is there a fire? 1=yes 0=no real(r8) :: fd ! fire duration: mins - real(r8) :: nf ! number of fires initiated daily: n/gridcell/day - real(r8) :: sh ! average scorch height: m ! FIRE EFFECTS - real(r8) :: ab ! area burnt: m2/day + real(r8) :: scorch_ht(maxpft) ! scorch height: m real(r8) :: frac_burnt ! fraction burnt: frac gridcell/day real(r8) :: tfc_ros ! total fuel consumed - no trunks. KgC/m2/day real(r8) :: burnt_frac_litter(nfsc) ! fraction of each litter pool burned:- @@ -556,24 +540,105 @@ module EDTypesMod !** Resources management type ** ! YX !************************************ - type ed_resources_management_type + type, public :: ed_resources_management_type real(r8) :: trunk_product_site ! Actual trunk product at site level KgC/site !debug variables - real(r8) :: delta_litter_stock - real(r8) :: delta_biomass_stock - real(r8) :: delta_individual + real(r8) :: delta_litter_stock ! kgC/site = kgC/ha + real(r8) :: delta_biomass_stock ! kgC/site + real(r8) :: delta_individual ! end type ed_resources_management_type + ! ===================================================================================== + + type, public :: site_fluxdiags_type + + ! ---------------------------------------------------------------------------------- + ! Diagnostics for fluxes into the litter pool from plants + ! these fluxes are the total from + ! (1) turnover from living plants + ! (2) mass transfer from non-disturbance inducing mortality events + ! (3) mass transfer from disturbance inducing mortality events + ! [kg / ha / day] + ! --------------------------------------------------------------------------------- + + real(r8) :: cwd_ag_input(1:ncwd) + real(r8) :: cwd_bg_input(1:ncwd) + real(r8),allocatable :: leaf_litter_input(:) + real(r8),allocatable :: root_litter_input(:) + + contains + + procedure :: ZeroFluxDiags + + end type site_fluxdiags_type + + ! ==================================================================================== + + type, public :: site_massbal_type + + ! ---------------------------------------------------------------------------------- + ! This type is used for accounting purposes to ensure that we are not + ! loosing or creating mass. This type is supposed to be allocated for each element + ! we simulate (e.g. carbon12_element, etc) + ! Note that the unit of "site", is nominally equivalent to 1 hectare + ! + ! This set of mass checks are for INCREMENTAL checks during the dynamics step. + ! ---------------------------------------------------------------------------------- + + real(r8) :: old_stock ! remember biomass stock from last time [Kg/site] + real(r8) :: err_fates ! Total mass balance error for FATES processes [kg/site] + + + ! ---------------------------------------------------------------------------------- + ! Group 3: Components of the total site level mass fluxes + ! ---------------------------------------------------------------------------------- + + real(r8) :: gpp_acc ! Accumulated gross primary productivity [kg/site/day] + real(r8) :: aresp_acc ! Accumulated autotrophic respiration [kg/site/day] + real(r8) :: net_root_uptake ! Net uptake of carbon or nutrients through the roots [kg/site/day] + ! (if carbon most likely exudation, if even active) + + real(r8) :: seed_in ! Total mass of external seed rain into fates site [kg/site/day] + ! This is from external grid-cells or from user parameterization + ! (user param seed rain, or dispersal model) + real(r8) :: seed_out ! Total mass of seeds exported outside of fates site [kg/site/day] + ! (this is not used currently, placeholder, rgk feb-2019) + + real(r8) :: frag_out ! Litter and coarse woody debris fragmentation flux [kg/site/day] + + real(r8) :: wood_product ! Total mass exported as wood product [kg/site/day] + real(r8) :: burn_flux_to_atm ! Total mass burned and exported to the atmosphere [kg/site/day] + + real(r8) :: flux_generic_in ! Used for prescribed or artificial input fluxes + ! and initialization [kg/site/day] + real(r8) :: flux_generic_out ! Used for prescribed or artificial output fluxes + ! for instance when prescribed physiology is on + real(r8) :: patch_resize_err ! This is the amount of mass gained (or loss when negative) + ! due to re-sizing patches when area math starts to lose + ! precision + + contains + + procedure :: ZeroMassBalState + procedure :: ZeroMassBalFlux + + end type site_massbal_type + + + + + + !************************************ !** Site type structure ** !************************************ - type ed_site_type + type, public :: ed_site_type ! POINTERS type (ed_patch_type), pointer :: oldest_patch => null() ! pointer to oldest patch at the site @@ -587,43 +652,14 @@ module EDTypesMod ! INDICES real(r8) :: lat ! latitude: degrees real(r8) :: lon ! longitude: degrees - - ! CARBON BALANCE - real(r8) :: flux_in ! for carbon balance purpose. C coming into biomass pool: KgC/site - real(r8) :: flux_out ! for carbon balance purpose. C leaving ED pools KgC/site - real(r8) :: old_stock ! for accounting purposes, remember biomass stock from last time: KgC/site - real(r8) :: npp ! used for calculating NEP and NBP during BGC summarization phase - real(r8) :: nep ! Net ecosystem production, i.e. fast-timescale carbon balance that - ! does not include disturbance [gC/m2/s] - real(r8) :: nbp ! Net biosphere production, i.e. slow-timescale carbon balance that - ! integrates to total carbon change [gC/m2/s] - real(r8) :: tot_seed_rain_flux ! [gC/m2/s] total flux of carbon from seed rain - real(r8) :: fire_c_to_atm ! total fire carbon loss to atmosphere [gC/m2/s] - real(r8) :: ed_litter_stock ! litter in [gC/m2] - real(r8) :: cwd_stock ! coarse woody debris [gC/m2] - real(r8) :: biomass_stock ! total biomass at the column level in [gC / m2] - real(r8) :: totfatesc ! Total FATES carbon at the site, including vegetation, CWD, seeds, - ! and FATES portion of litter [gC/m2] - real(r8) :: totbgcc ! Total BGC carbon at the site, including litter, and soil pools [gC/m2] - real(r8) :: totecosysc ! Total ecosystem C at the site, including vegetation, - ! CWD, litter (from HLM and FATES), and soil pools [gC/m2] - - real(r8) :: totfatesc_old ! Total FATES C at the site from last call to balance check [gC/m2] - real(r8) :: totbgcc_old ! Total BGC C at the site from last call to balance check [gC/m2] - real(r8) :: totecosysc_old ! Total ecosystem C at the site from last call to balance check [gC/m2] - real(r8) :: fates_to_bgc_this_ts ! total flux of carbon from FATES to BGC models on current timestep [gC/m2/s] - real(r8) :: fates_to_bgc_last_ts ! total flux of carbon from FATES to BGC models on previous timestep [gC/m2/s] + ! Mass Balance (allocation for each element) - real(r8) :: cbal_err_fates ! [gC/m2/s] total carbon balance error for FATES processes - real(r8) :: cbal_err_bgc ! [gC/m2/s] total carbon balance error for BGC (HLM) processes - real(r8) :: cbal_err_tot ! [gC/m2/s] total carbon balance error for all land processes + type(site_massbal_type), pointer :: mass_balance(:) - real(r8) :: nep_timeintegrated ! Net ecosystem production accumulated over model time-steps [gC/m2] - real(r8) :: hr_timeintegrated ! Heterotrophic respiration accumulated over model time-steps [gC/m2] - real(r8) :: npp_timeintegrated ! Net primary production accumulated over model time-steps [gC/m2] - real(r8) :: nbp_integrated ! Net biosphere production accumulated over model time-steps [gC/m2] + ! Flux diagnostics (allocation for each element) + type(site_fluxdiags_type), pointer :: flux_diags(:) ! PHENOLOGY real(r8) :: grow_deg_days ! Phenology growing degree days @@ -648,49 +684,67 @@ module EDTypesMod real(r8) :: water_memory(numWaterMem) ! last 10 days of soil moisture memory... - !SEED BANK - real(r8) :: seed_bank(maxpft) ! seed pool in KgC/m2 - real(r8) :: dseed_dt(maxpft) ! change in seed pool in KgC/m2/year - real(r8) :: seed_rain_flux(maxpft) ! flux of seeds from exterior KgC/m2/year (needed for C balance purposes) ! FIRE real(r8) :: wind ! daily wind in m/min for Spitfire units real(r8) :: acc_ni ! daily nesterov index accumulating over time. real(r8) :: fdi ! daily probability an ignition event will start a fire - real(r8) :: frac_burnt ! fraction of soil burnt in this day. - real(r8) :: total_burn_flux_to_atm ! total carbon burnt to the atmosphere in this day. KgC/site - real(r8) :: cwd_ag_burned(ncwd) - real(r8) :: leaf_litter_burned(maxpft) + real(r8) :: NF ! daily ignitions in km2 + real(r8) :: frac_burnt ! fraction of area burnt in this day. ! PLANT HYDRAULICS type(ed_site_hydr_type), pointer :: si_hydr + + ! Soil Layering + + integer :: nlevsoil ! Number of soil layers in this site + real(r8), allocatable :: zi_soil(:) ! interface level below a "z" level (m) + ! this contains a zero index for surface. + real(r8), allocatable :: dz_soil(:) ! layer thickness (m) + real(r8), allocatable :: z_soil(:) ! layer depth (m) + real(r8), allocatable :: rootfrac_scr(:) ! This is just allocated scratch space to hold + ! root fractions. Since root fractions may be dependant + ! on cohort properties, and we do not want to store this infromation + ! on each cohort, we do not keep root fractions in + ! memory, and instead calculate them on demand. + ! This array is allocated over the number of soil + ! layers for each site, and save allocating deallocating. + ! NOTE: THIS SCRATCH SPACE WOULD NOT BE THREAD-SAFE + ! IF WE FORK ON PATCHES + ! DIAGNOSTICS + ! TERMINATION, RECRUITMENT, DEMOTION, and DISTURBANCE real(r8), allocatable :: term_nindivs_canopy(:,:) ! number of canopy individuals that were in cohorts which ! were terminated this timestep, on size x pft real(r8), allocatable :: term_nindivs_ustory(:,:) ! number of understory individuals that were in cohorts which ! were terminated this timestep, on size x pft + real(r8) :: term_carbonflux_canopy ! carbon flux from live to dead pools associated ! 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 - + ! with 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) :: 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) :: 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 - real(r8) :: demotion_carbonflux ! biomass of demoted individuals from canopy to understory [kgC/ha/day] + real(r8), allocatable :: promotion_rate(:) ! rate of individuals promoted from understory to canopy per FATES timestep - real(r8) :: promotion_carbonflux ! biomass of promoted individuals from understory to canopy [kgC/ha/day] + real(r8), allocatable :: imort_rate(:,:) ! rate of individuals killed due to impact mortality per year. on size x pft array - real(r8) :: imort_carbonflux ! biomass of individuals killed due to impact mortality per year. [kgC/ha/day] + real(r8), allocatable :: fmort_rate_canopy(:,:) ! rate of canopy individuals killed due to fire mortality per year. ! on size x pft array (1:nlevsclass,1:numpft) real(r8), allocatable :: fmort_rate_ustory(:,:) ! rate of understory individuals killed due to fire mortality per year. ! on size x pft array (1:nlevsclass,1:numpft) - 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), allocatable :: fmort_rate_cambial(:,:) ! rate of individuals killed due to fire mortality ! from cambial damage per year. on size x pft array real(r8), allocatable :: fmort_rate_crown(:,:) ! rate of individuals killed due to fire mortality @@ -700,19 +754,66 @@ module EDTypesMod ! due to fusion in a given day. on size x pft array - ! some diagnostic-only (i.e. not resolved by ODE solver) flux of carbon to CWD and litter pools from termination and canopy mortality - real(r8) :: CWD_AG_diagnostic_input_carbonflux(1:ncwd) ! diagnostic flux to AG CWD [kg C / m2 / yr] - real(r8) :: CWD_BG_diagnostic_input_carbonflux(1:ncwd) ! diagnostic flux to BG CWD [kg C / m2 / yr] - real(r8) :: leaf_litter_diagnostic_input_carbonflux(1:maxpft) ! diagnostic flux to AG litter [kg C / m2 / yr] - real(r8) :: root_litter_diagnostic_input_carbonflux(1:maxpft) ! diagnostic flux to BG litter [kg C / m2 / yr] + ! Canopy Spread real(r8) :: spread ! dynamic canopy allometric term [unitless] end type ed_site_type + ! Make public necessary subroutines and functions + public :: val_check_ed_vars + public :: dump_site + public :: dump_patch + public :: dump_cohort + public :: dump_cohort_hydr contains + + + subroutine ZeroFluxDiags(this) + + class(site_fluxdiags_type) :: this + + this%cwd_ag_input(:) = 0._r8 + this%cwd_bg_input(:) = 0._r8 + this%leaf_litter_input(:) = 0._r8 + this%root_litter_input(:) = 0._r8 + + return + end subroutine ZeroFluxDiags + + ! ===================================================================================== + + subroutine ZeroMassBalState(this) + + class(site_massbal_type) :: this + + this%old_stock = 0._r8 + this%err_fates = 0._r8 + + return + end subroutine ZeroMassBalState + + subroutine ZeroMassBalFlux(this) + + class(site_massbal_type) :: this + + this%gpp_acc = 0._r8 + this%aresp_acc = 0._r8 + this%net_root_uptake = 0._r8 + this%seed_in = 0._r8 + this%seed_out = 0._r8 + this%frag_out = 0._r8 + this%wood_product = 0._r8 + this%burn_flux_to_atm = 0._r8 + this%flux_generic_in = 0._r8 + this%flux_generic_out = 0._r8 + this%patch_resize_err = 0._r8 + + return + end subroutine ZeroMassBalFlux + ! ===================================================================================== @@ -808,6 +909,9 @@ subroutine dump_patch(cpatch) type(ed_patch_type),intent(in),target :: cpatch + ! locals + integer :: el ! element loop counting index + write(fates_log(),*) '----------------------------------------' write(fates_log(),*) ' Dumping Patch Information ' write(fates_log(),*) ' (omitting arrays) ' @@ -829,6 +933,16 @@ subroutine dump_patch(cpatch) write(fates_log(),*) 'pa%c_lblayer = ',cpatch%c_lblayer write(fates_log(),*) 'pa%disturbance_rate = ',cpatch%disturbance_rate write(fates_log(),*) '----------------------------------------' + do el = 1,num_elements + write(fates_log(),*) 'element id: ',element_list(el) + write(fates_log(),*) 'seed mass: ',sum(cpatch%litter(el)%seed) + write(fates_log(),*) 'seed germ mass: ',sum(cpatch%litter(el)%seed_germ) + write(fates_log(),*) 'leaf fines(pft): ',sum(cpatch%litter(el)%leaf_fines) + write(fates_log(),*) 'root fines(pft,sl): ',sum(cpatch%litter(el)%root_fines) + write(fates_log(),*) 'ag_cwd(c): ',sum(cpatch%litter(el)%ag_cwd) + write(fates_log(),*) 'bg_cwd(c,sl): ',sum(cpatch%litter(el)%bg_cwd) + end do + return end subroutine dump_patch @@ -848,6 +962,8 @@ subroutine dump_cohort(ccohort) write(fates_log(),*) 'co%dbh = ', ccohort%dbh write(fates_log(),*) 'co%hite = ', ccohort%hite write(fates_log(),*) 'co%laimemory = ', ccohort%laimemory + write(fates_log(),*) 'co%sapwmemory = ', ccohort%sapwmemory + write(fates_log(),*) 'co%structmemory = ', ccohort%structmemory write(fates_log(),*) 'leaf carbon = ', ccohort%prt%GetState(leaf_organ,all_carbon_elements) write(fates_log(),*) 'fineroot carbon = ', ccohort%prt%GetState(fnrt_organ,all_carbon_elements) @@ -885,7 +1001,6 @@ subroutine dump_cohort(ccohort) 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%seed_prod = ', ccohort%seed_prod write(fates_log(),*) 'co%treelai = ', ccohort%treelai write(fates_log(),*) 'co%treesai = ', ccohort%treesai write(fates_log(),*) 'co%c_area = ', ccohort%c_area @@ -898,7 +1013,6 @@ subroutine dump_cohort(ccohort) write(fates_log(),*) 'co%dhdt = ', ccohort%dhdt write(fates_log(),*) 'co%ddbhdt = ', ccohort%ddbhdt write(fates_log(),*) 'co%dbdeaddt = ', ccohort%dbdeaddt - write(fates_log(),*) 'co%dbstoredt = ', ccohort%dbstoredt write(fates_log(),*) 'co%fraction_crown_burned = ', ccohort%fraction_crown_burned write(fates_log(),*) 'co%fire_mort = ', ccohort%fire_mort write(fates_log(),*) 'co%crownfire_mort = ', ccohort%crownfire_mort diff --git a/main/FatesConstantsMod.F90 b/main/FatesConstantsMod.F90 index bff05b7e1c..3f8aaafc57 100644 --- a/main/FatesConstantsMod.F90 +++ b/main/FatesConstantsMod.F90 @@ -3,41 +3,40 @@ module FatesConstantsMod ! this module must have the parameter attribute. implicit none - - public + private ! Modules are private by default ! kinds - integer, parameter :: fates_r8 = selected_real_kind(12) ! 8 byte real - integer, parameter :: fates_int = selected_int_kind(8) ! 4 byte int + integer, parameter, public :: fates_r8 = selected_real_kind(12) ! 8 byte real + integer, parameter, public :: fates_int = selected_int_kind(8) ! 4 byte int ! string lengths - integer, parameter :: fates_avg_flag_length = 3 - integer, parameter :: fates_short_string_length = 32 - integer, parameter :: fates_long_string_length = 199 + integer, parameter, public :: fates_avg_flag_length = 3 + integer, parameter, public :: fates_short_string_length = 32 + integer, parameter, public :: fates_long_string_length = 199 ! Used to initialize and test unset integers - integer, parameter :: fates_unset_int = -9999 + integer, parameter, public :: fates_unset_int = -9999 ! Used to initialize and test unset r8s - real(fates_r8), parameter :: fates_unset_r8 = -1.e36_fates_r8 + real(fates_r8), parameter, public :: fates_unset_r8 = -1.e36_fates_r8 ! Integer equivalent of true (in case some compilers dont auto convert) - integer, parameter :: itrue = 1 + integer, parameter, public :: itrue = 1 ! Integer equivalent of false (in case come compilers dont auto convert) - integer, parameter :: ifalse = 0 + integer, parameter, public :: ifalse = 0 ! Labels for patch disturbance history - integer, parameter :: n_anthro_disturbance_categories = 2 - integer, parameter :: primaryforest = 1 - integer, parameter :: secondaryforest = 2 + integer, parameter, public :: n_anthro_disturbance_categories = 2 + integer, parameter, public :: primaryforest = 1 + integer, parameter, public :: secondaryforest = 2 ! Error Tolerances ! Allowable error in carbon allocations, should be applied to estimates ! of carbon conservation in units of kgC/plant. This gives an effective ! error tolerance of 1 microgram. - real(fates_r8), parameter :: calloc_abs_error = 1.0e-9_fates_r8 + real(fates_r8), parameter, public :: calloc_abs_error = 1.0e-9_fates_r8 ! Rounding errors seem to hover around 1e-15 for the gnu compiler ! when not applying compiler directives for safe math. An example @@ -48,95 +47,99 @@ module FatesConstantsMod ! This value here is used as an error expectation comparison ! for multiplication/division procedures, also allowing for 3 orders ! of magnitude of buffer error (ie instead of 1e-15) - real(fates_r8), parameter :: rsnbl_math_prec = 1.0e-12_fates_r8 + real(fates_r8), parameter, public :: rsnbl_math_prec = 1.0e-12_fates_r8 ! This is the precision of 8byte reals (~1e-308) - real(fates_r8), parameter :: tinyr8 = tiny(1.0_fates_r8) + real(fates_r8), parameter, public :: tinyr8 = tiny(1.0_fates_r8) ! We mostly use this in place of logical comparisons ! between reals with zero, as the chances are their ! precisions are preventing perfect zero in comparison - real(fates_r8), parameter :: nearzero = 1.0e-30_fates_r8 + real(fates_r8), parameter, public :: nearzero = 1.0e-30_fates_r8 ! Unit conversion constants: ! Conversion factor umols of Carbon -> kg of Carbon (1 mol = 12g) ! We do not use umolC_per_kg because it is a non-terminating decimal - real(fates_r8), parameter :: umolC_to_kgC = 12.0E-9_fates_r8 + + real(fates_r8), parameter, public :: umolC_to_kgC = 12.0E-9_fates_r8 + + ! Conversion factor: miligrams per kilogram + real(fates_r8), parameter, public :: mg_per_kg = 1.0e6_fates_r8 ! Conversion factor: grams per kilograms - real(fates_r8), parameter :: g_per_kg = 1000.0_fates_r8 + real(fates_r8), parameter, public :: g_per_kg = 1000.0_fates_r8 ! Conversion factor: miligrams per grams - real(fates_r8), parameter :: mg_per_g = 1000.0_fates_r8 + real(fates_r8), parameter, public :: mg_per_g = 1000.0_fates_r8 ! Conversion factor: kilograms per Megagram - real(fates_r8), parameter :: kg_per_Megag = 1000.0_fates_r8 + real(fates_r8), parameter, public :: kg_per_Megag = 1000.0_fates_r8 ! Conversion factor: micromoles per milimole - real(fates_r8), parameter :: umol_per_mmol = 1000.0_fates_r8 + real(fates_r8), parameter, public :: umol_per_mmol = 1000.0_fates_r8 ! Conversion factor: milimoles per mole - real(fates_r8), parameter :: mmol_per_mol = 1000.0_fates_r8 + real(fates_r8), parameter, public :: mmol_per_mol = 1000.0_fates_r8 ! Conversion factor: micromoles per mole - real(fates_r8), parameter :: umol_per_mol = 1.0E6_fates_r8 + real(fates_r8), parameter, public :: umol_per_mol = 1.0E6_fates_r8 ! Conversion factor: umols per kilomole - real(fates_r8), parameter :: umol_per_kmol = 1.0E9_fates_r8 + real(fates_r8), parameter, public :: umol_per_kmol = 1.0E9_fates_r8 ! Conversion factor: m2 per ha - real(fates_r8), parameter :: m2_per_ha = 1.0e4_fates_r8 + real(fates_r8), parameter, public :: m2_per_ha = 1.0e4_fates_r8 ! Conversion factor: cm2 per m2 - real(fates_r8), parameter :: cm2_per_m2 = 10000.0_fates_r8 + real(fates_r8), parameter, public :: cm2_per_m2 = 10000.0_fates_r8 ! Conversion factor :: ha per m2 - real(fates_r8), parameter :: ha_per_m2 = 1.0e-4_fates_r8 + real(fates_r8), parameter, public :: ha_per_m2 = 1.0e-4_fates_r8 ! Conversion: seconds per minute - real(fates_r8), parameter :: sec_per_min = 60.0_fates_r8 + real(fates_r8), parameter, public :: sec_per_min = 60.0_fates_r8 ! Conversion: seconds per day - real(fates_r8), parameter :: sec_per_day = 86400.0_fates_r8 + real(fates_r8), parameter, public :: sec_per_day = 86400.0_fates_r8 ! Conversion: days per second - real(fates_r8), parameter :: days_per_sec = 1.0_fates_r8/86400.0_fates_r8 + real(fates_r8), parameter, public :: days_per_sec = 1.0_fates_r8/86400.0_fates_r8 ! Conversion: days per year. assume HLM uses 365 day calendar. ! If we need to link to 365.25-day-calendared HLM, rewire to pass through interface - real(fates_r8), parameter :: days_per_year = 365.00_fates_r8 + real(fates_r8), parameter, public :: days_per_year = 365.00_fates_r8 ! Conversion: years per day. assume HLM uses 365 day calendar. ! If we need to link to 365.25-day-calendared HLM, rewire to pass through interface - real(fates_r8), parameter :: years_per_day = 1.0_fates_r8/365.00_fates_r8 + real(fates_r8), parameter, public :: years_per_day = 1.0_fates_r8/365.00_fates_r8 ! Physical constants ! universal gas constant [J/K/kmol] - real(fates_r8), parameter :: rgas_J_K_kmol = 8314.4598_fates_r8 + real(fates_r8), parameter, public :: rgas_J_K_kmol = 8314.4598_fates_r8 ! freezing point of water at 1 atm (K) - real(fates_r8), parameter :: t_water_freeze_k_1atm = 273.15_fates_r8 + real(fates_r8), parameter, public :: t_water_freeze_k_1atm = 273.15_fates_r8 ! freezing point of water at triple point (K) - real(fates_r8), parameter :: t_water_freeze_k_triple = 273.16_fates_r8 + real(fates_r8), parameter, public :: t_water_freeze_k_triple = 273.16_fates_r8 ! Density of fresh liquid water (kg/m3) - real(fates_r8), parameter :: dens_fresh_liquid_water = 1.0E3_fates_r8 + real(fates_r8), parameter, public :: dens_fresh_liquid_water = 1.0E3_fates_r8 ! Gravity constant on earth [m/s] - real(fates_r8), parameter :: grav_earth = 9.8_fates_r8 + real(fates_r8), parameter, public :: grav_earth = 9.8_fates_r8 ! For numerical inquiry - real(fates_r8), parameter :: fates_huge = huge(g_per_kg) + real(fates_r8), parameter, public :: fates_huge = huge(g_per_kg) - real(fates_r8), parameter :: fates_tiny = tiny(g_per_kg) + real(fates_r8), parameter, public :: fates_tiny = tiny(g_per_kg) ! Geometric Constants ! PI - real(fates_r8), parameter :: pi_const = 3.14159265359_fates_r8 + real(fates_r8), parameter, public :: pi_const = 3.14159265359_fates_r8 end module FatesConstantsMod diff --git a/main/FatesGlobals.F90 b/main/FatesGlobals.F90 index 3d4d561c7a..260b3a9313 100644 --- a/main/FatesGlobals.F90 +++ b/main/FatesGlobals.F90 @@ -7,13 +7,16 @@ module FatesGlobals use FatesConstantsMod , only : r8 => fates_r8 implicit none + private ! By default everything is private + integer :: fates_log_ + logical :: fates_global_verbose_ + + ! Make public necessary subroutines and functions public :: FatesGlobalsInit public :: fates_log public :: fates_global_verbose - - integer, private :: fates_log_ - logical, private :: fates_global_verbose_ + public :: fates_endrun contains diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index f9821b45f4..d5ab89a2d7 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -6,12 +6,23 @@ module FatesHistoryInterfaceMod use FatesConstantsMod , only : fates_long_string_length use FatesConstantsMod , only : itrue,ifalse use FatesConstantsMod , only : calloc_abs_error + use FatesConstantsMod , only : mg_per_kg use FatesGlobals , only : fates_log use FatesGlobals , only : endrun => fates_endrun use EDTypesMod , only : nclmax use EDTypesMod , only : ican_upper + use EDTypesMod , only : element_pos + use EDTypesMod , only : num_elements + use EDTypesMod , only : site_fluxdiags_type + use EDtypesMod , only : ed_site_type + use EDtypesMod , only : ed_cohort_type + use EDtypesMod , only : ed_patch_type + use EDtypesMod , only : AREA + use EDtypesMod , only : AREA_INV use EDTypesMod , only : numWaterMem use EDTypesMod , only : num_vegtemp_mem + use EDTypesMod , only : site_massbal_type + use EDTypesMod , only : element_list use FatesIODimensionsMod , only : fates_io_dimension_type use FatesIOVariableKindMod , only : fates_io_variable_kind_type use FatesHistoryVariableType , only : fates_history_variable_type @@ -24,6 +35,7 @@ module FatesHistoryInterfaceMod use EDParamsMod , only : ED_val_phen_coldtemp use FatesInterfaceMod , only : nlevsclass, nlevage use FatesInterfaceMod , only : nlevheight + use FatesInterfaceMod , only : bc_in_type use FatesInterfaceMod , only : hlm_model_day ! FIXME(bja, 2016-10) need to remove CLM dependancy @@ -38,14 +50,17 @@ module FatesHistoryInterfaceMod use FatesConstantsMod , only : sec_per_day use FatesConstantsMod , only : days_per_year use FatesConstantsMod , only : years_per_day + use FatesLitterMod , only : litter_type use FatesConstantsMod , only : secondaryforest use PRTGenericMod , only : leaf_organ, fnrt_organ, sapw_organ use PRTGenericMod , only : struct_organ, store_organ, repro_organ use PRTGenericMod , only : all_carbon_elements + use PRTGenericMod , only : carbon12_element implicit none + private ! By default everything is private ! These variables hold the index of the history output structure so we don't ! have to constantly do name lookup when we want to populate the dataset @@ -117,385 +132,387 @@ module FatesHistoryInterfaceMod ! Indices to 1D Patch variables - integer, private :: ih_trimming_pa - integer, private :: ih_area_plant_pa - integer, private :: ih_area_treespread_pa - integer, private :: ih_nesterov_fire_danger_pa - integer, private :: ih_spitfire_ROS_pa - integer, private :: ih_effect_wspeed_pa - integer, private :: ih_TFC_ROS_pa - integer, private :: ih_fire_intensity_pa - integer, private :: ih_fire_area_pa - integer, private :: ih_scorch_height_pa - integer, private :: ih_fire_fuel_bulkd_pa - integer, private :: ih_fire_fuel_eff_moist_pa - integer, private :: ih_fire_fuel_sav_pa - integer, private :: ih_fire_fuel_mef_pa - integer, private :: ih_sum_fuel_pa - integer, private :: ih_litter_in_si - integer, private :: ih_litter_out_pa - - integer, private :: ih_daily_temp - integer, private :: ih_daily_rh - integer, private :: ih_daily_prec - integer, private :: ih_seed_bank_si - integer, private :: ih_seeds_in_pa - integer, private :: ih_seed_decay_pa - integer, private :: ih_seed_germination_pa - integer, private :: ih_bstore_pa - integer, private :: ih_bdead_pa - integer, private :: ih_balive_pa - integer, private :: ih_bleaf_pa - integer, private :: ih_bsapwood_pa - integer, private :: ih_bfineroot_pa - integer, private :: ih_btotal_pa - integer, private :: ih_agb_pa - integer, private :: ih_npp_pa - integer, private :: ih_gpp_pa - integer, private :: ih_aresp_pa - integer, private :: ih_maint_resp_pa - integer, private :: ih_growth_resp_pa - integer, private :: ih_ar_canopy_pa - integer, private :: ih_gpp_canopy_pa - integer, private :: ih_ar_understory_pa - integer, private :: ih_gpp_understory_pa - integer, private :: ih_canopy_biomass_pa - integer, private :: ih_understory_biomass_pa - + integer :: ih_trimming_pa + integer :: ih_area_plant_pa + integer :: ih_area_treespread_pa + integer :: ih_nesterov_fire_danger_pa + integer :: ih_spitfire_ROS_pa + integer :: ih_effect_wspeed_pa + integer :: ih_TFC_ROS_pa + integer :: ih_fire_intensity_pa + integer :: ih_fire_area_pa + integer :: ih_fire_fuel_bulkd_pa + integer :: ih_fire_fuel_eff_moist_pa + integer :: ih_fire_fuel_sav_pa + integer :: ih_fire_fuel_mef_pa + integer :: ih_sum_fuel_pa + + integer :: ih_cwd_elcwd + + integer :: ih_litter_in_si ! carbon only + integer :: ih_litter_out_si ! carbon only + integer :: ih_seed_bank_si ! carbon only + integer :: ih_seeds_in_si ! carbon only + + integer :: ih_litter_in_elem + integer :: ih_litter_out_elem + integer :: ih_seed_bank_elem + integer :: ih_seeds_in_local_elem + integer :: ih_seeds_in_extern_elem + integer :: ih_seed_decay_elem + integer :: ih_seed_germ_elem + + integer :: ih_fines_ag_elem + integer :: ih_fines_bg_elem + integer :: ih_cwd_ag_elem + integer :: ih_cwd_bg_elem + + integer :: ih_daily_temp + integer :: ih_daily_rh + integer :: ih_daily_prec + + integer :: ih_bstore_pa + integer :: ih_bdead_pa + integer :: ih_balive_pa + integer :: ih_bleaf_pa + integer :: ih_bsapwood_pa + integer :: ih_bfineroot_pa + integer :: ih_btotal_pa + integer :: ih_agb_pa + integer :: ih_npp_pa + integer :: ih_gpp_pa + integer :: ih_aresp_pa + integer :: ih_maint_resp_pa + integer :: ih_growth_resp_pa + integer :: ih_ar_canopy_pa + integer :: ih_gpp_canopy_pa + integer :: ih_ar_understory_pa + integer :: ih_gpp_understory_pa + integer :: ih_canopy_biomass_pa + integer :: ih_understory_biomass_pa + ! Indices to site by size-class by age variables - integer, private :: ih_nplant_si_scag - integer, private :: ih_nplant_canopy_si_scag - integer, private :: ih_nplant_understory_si_scag - integer, private :: ih_ddbh_canopy_si_scag - integer, private :: ih_ddbh_understory_si_scag - integer, private :: ih_mortality_canopy_si_scag - integer, private :: ih_mortality_understory_si_scag + integer :: ih_nplant_si_scag + integer :: ih_nplant_canopy_si_scag + integer :: ih_nplant_understory_si_scag + integer :: ih_ddbh_canopy_si_scag + integer :: ih_ddbh_understory_si_scag + integer :: ih_mortality_canopy_si_scag + integer :: ih_mortality_understory_si_scag ! Indices to site by size-class by age by pft variables - integer, private :: ih_nplant_si_scagpft + integer :: ih_nplant_si_scagpft ! Indices to site by patch age by pft variables - integer, private :: ih_biomass_si_agepft - integer, private :: ih_npp_si_agepft + integer :: ih_biomass_si_agepft + integer :: ih_npp_si_agepft + integer :: ih_scorch_height_si_agepft ! Indices to (site) variables - integer, private :: ih_nep_si - integer, private :: ih_nep_timeintegrated_si - integer, private :: ih_npp_timeintegrated_si - integer, private :: ih_hr_timeintegrated_si - integer, private :: ih_nbp_si - integer, private :: ih_npp_si - integer, private :: ih_c_stomata_si - integer, private :: ih_c_lblayer_si - integer, private :: ih_fire_c_to_atm_si - integer, private :: ih_totecosysc_si - integer, private :: ih_totecosysc_old_si - integer, private :: ih_totedc_si - integer, private :: ih_totedc_old_si - integer, private :: ih_totbgcc_si - integer, private :: ih_totbgcc_old_si - integer, private :: ih_biomass_stock_si - integer, private :: ih_litter_stock_si - integer, private :: ih_cwd_stock_si - integer, private :: ih_cbal_err_fates_si - integer, private :: ih_cbal_err_bgc_si - integer, private :: ih_cbal_err_tot_si - integer, private :: ih_npatches_si - integer, private :: ih_ncohorts_si - integer, private :: ih_demotion_carbonflux_si - integer, private :: ih_promotion_carbonflux_si - integer, private :: ih_canopy_mortality_carbonflux_si - integer, private :: ih_understory_mortality_carbonflux_si - integer, private :: ih_canopy_spread_si - integer, private :: ih_npp_leaf_si - integer, private :: ih_npp_seed_si - integer, private :: ih_npp_stem_si - integer, private :: ih_npp_froot_si - integer, private :: ih_npp_croot_si - integer, private :: ih_npp_stor_si - integer, private :: ih_leaf_mr_si - integer, private :: ih_froot_mr_si - integer, private :: ih_livestem_mr_si - integer, private :: ih_livecroot_mr_si - integer, private :: ih_fraction_secondary_forest_si - integer, private :: ih_biomass_secondary_forest_si - integer, private :: ih_woodproduct_si - integer, private :: ih_h2oveg_si - integer, private :: ih_h2oveg_dead_si - integer, private :: ih_h2oveg_recruit_si - integer, private :: ih_h2oveg_growturn_err_si - integer, private :: ih_h2oveg_pheno_err_si - integer, private :: ih_h2oveg_hydro_err_si - - integer, private :: ih_site_cstatus_si - integer, private :: ih_site_dstatus_si - integer, private :: ih_gdd_si - integer, private :: ih_site_nchilldays_si - integer, private :: ih_site_ncolddays_si - integer, private :: ih_cleafoff_si - integer, private :: ih_cleafon_si - integer, private :: ih_dleafoff_si - integer, private :: ih_dleafon_si - integer, private :: ih_meanliqvol_si - - - integer, private :: ih_nplant_si_scpf - integer, private :: ih_gpp_si_scpf - integer, private :: ih_npp_totl_si_scpf - integer, private :: ih_npp_leaf_si_scpf - integer, private :: ih_npp_seed_si_scpf - integer, private :: ih_npp_fnrt_si_scpf - integer, private :: ih_npp_bgsw_si_scpf - integer, private :: ih_npp_bgdw_si_scpf - integer, private :: ih_npp_agsw_si_scpf - integer, private :: ih_npp_agdw_si_scpf - integer, private :: ih_npp_stor_si_scpf + + integer :: ih_nep_si + integer :: ih_npp_si + + integer :: ih_c_stomata_si + integer :: ih_c_lblayer_si + + integer :: ih_fire_c_to_atm_si + + + integer :: ih_cbal_err_fates_si + integer :: ih_err_fates_si + + integer :: ih_npatches_si + integer :: ih_ncohorts_si + integer :: ih_demotion_carbonflux_si + integer :: ih_promotion_carbonflux_si + integer :: ih_canopy_mortality_carbonflux_si + integer :: ih_understory_mortality_carbonflux_si + integer :: ih_canopy_spread_si + integer :: ih_npp_leaf_si + integer :: ih_npp_seed_si + integer :: ih_npp_stem_si + integer :: ih_npp_froot_si + integer :: ih_npp_croot_si + integer :: ih_npp_stor_si + integer :: ih_leaf_mr_si + integer :: ih_froot_mr_si + integer :: ih_livestem_mr_si + integer :: ih_livecroot_mr_si + integer :: ih_fraction_secondary_forest_si + integer :: ih_biomass_secondary_forest_si + integer :: ih_woodproduct_si + integer :: ih_h2oveg_si + integer :: ih_h2oveg_dead_si + integer :: ih_h2oveg_recruit_si + integer :: ih_h2oveg_growturn_err_si + integer :: ih_h2oveg_pheno_err_si + integer :: ih_h2oveg_hydro_err_si + + integer :: ih_site_cstatus_si + integer :: ih_site_dstatus_si + integer :: ih_gdd_si + integer :: ih_site_nchilldays_si + integer :: ih_site_ncolddays_si + integer :: ih_cleafoff_si + integer :: ih_cleafon_si + integer :: ih_dleafoff_si + integer :: ih_dleafon_si + integer :: ih_meanliqvol_si + + + integer :: ih_nplant_si_scpf + integer :: ih_gpp_si_scpf + integer :: ih_npp_totl_si_scpf + integer :: ih_npp_leaf_si_scpf + integer :: ih_npp_seed_si_scpf + integer :: ih_npp_fnrt_si_scpf + integer :: ih_npp_bgsw_si_scpf + integer :: ih_npp_bgdw_si_scpf + integer :: ih_npp_agsw_si_scpf + integer :: ih_npp_agdw_si_scpf + integer :: ih_npp_stor_si_scpf - integer, private :: ih_bstor_canopy_si_scpf - integer, private :: ih_bstor_understory_si_scpf - integer, private :: ih_bleaf_canopy_si_scpf - integer, private :: ih_bleaf_understory_si_scpf - integer, private :: ih_mortality_canopy_si_scpf - integer, private :: ih_mortality_understory_si_scpf - integer, private :: ih_nplant_canopy_si_scpf - integer, private :: ih_nplant_understory_si_scpf - integer, private :: ih_ddbh_canopy_si_scpf - integer, private :: ih_ddbh_understory_si_scpf - integer, private :: ih_gpp_canopy_si_scpf - integer, private :: ih_gpp_understory_si_scpf - integer, private :: ih_ar_canopy_si_scpf - integer, private :: ih_ar_understory_si_scpf - - integer, private :: ih_ddbh_si_scpf - integer, private :: ih_growthflux_si_scpf - integer, private :: ih_growthflux_fusion_si_scpf - integer, private :: ih_ba_si_scpf - integer, private :: ih_m1_si_scpf - integer, private :: ih_m2_si_scpf - integer, private :: ih_m3_si_scpf - integer, private :: ih_m4_si_scpf - integer, private :: ih_m5_si_scpf - integer, private :: ih_m6_si_scpf - integer, private :: ih_m7_si_scpf - integer, private :: ih_m8_si_scpf - integer, private :: ih_crownfiremort_si_scpf - integer, private :: ih_cambialfiremort_si_scpf - - - integer, private :: ih_ar_si_scpf - integer, private :: ih_ar_grow_si_scpf - integer, private :: ih_ar_maint_si_scpf - integer, private :: ih_ar_darkm_si_scpf - integer, private :: ih_ar_agsapm_si_scpf - integer, private :: ih_ar_crootm_si_scpf - integer, private :: ih_ar_frootm_si_scpf + integer :: ih_bstor_canopy_si_scpf + integer :: ih_bstor_understory_si_scpf + integer :: ih_bleaf_canopy_si_scpf + integer :: ih_bleaf_understory_si_scpf + integer :: ih_mortality_canopy_si_scpf + integer :: ih_mortality_understory_si_scpf + integer :: ih_nplant_canopy_si_scpf + integer :: ih_nplant_understory_si_scpf + integer :: ih_ddbh_canopy_si_scpf + integer :: ih_ddbh_understory_si_scpf + integer :: ih_gpp_canopy_si_scpf + integer :: ih_gpp_understory_si_scpf + integer :: ih_ar_canopy_si_scpf + integer :: ih_ar_understory_si_scpf + + integer :: ih_ddbh_si_scpf + integer :: ih_growthflux_si_scpf + integer :: ih_growthflux_fusion_si_scpf + integer :: ih_ba_si_scpf + integer :: ih_m1_si_scpf + integer :: ih_m2_si_scpf + integer :: ih_m3_si_scpf + integer :: ih_m4_si_scpf + integer :: ih_m5_si_scpf + integer :: ih_m6_si_scpf + integer :: ih_m7_si_scpf + integer :: ih_m8_si_scpf + integer :: ih_crownfiremort_si_scpf + integer :: ih_cambialfiremort_si_scpf + + + integer :: ih_ar_si_scpf + integer :: ih_ar_grow_si_scpf + integer :: ih_ar_maint_si_scpf + integer :: ih_ar_darkm_si_scpf + integer :: ih_ar_agsapm_si_scpf + integer :: ih_ar_crootm_si_scpf + integer :: ih_ar_frootm_si_scpf - integer, private :: ih_c13disc_si_scpf + integer :: ih_c13disc_si_scpf ! indices to (site x scls [size class bins]) variables - integer, private :: ih_ba_si_scls - integer, private :: ih_nplant_si_scls - integer, private :: ih_nplant_canopy_si_scls - integer, private :: ih_nplant_understory_si_scls - integer, private :: ih_lai_canopy_si_scls - integer, private :: ih_lai_understory_si_scls - integer, private :: ih_sai_canopy_si_scls - integer, private :: ih_sai_understory_si_scls - integer, private :: ih_mortality_canopy_si_scls - integer, private :: ih_mortality_understory_si_scls - integer, private :: ih_demotion_rate_si_scls - integer, private :: ih_promotion_rate_si_scls - integer, private :: ih_trimming_canopy_si_scls - integer, private :: ih_trimming_understory_si_scls - integer, private :: ih_crown_area_canopy_si_scls - integer, private :: ih_crown_area_understory_si_scls - integer, private :: ih_ddbh_canopy_si_scls - integer, private :: ih_ddbh_understory_si_scls - integer, private :: ih_agb_si_scls - integer, private :: ih_biomass_si_scls + integer :: ih_ba_si_scls + integer :: ih_nplant_si_scls + integer :: ih_nplant_canopy_si_scls + integer :: ih_nplant_understory_si_scls + integer :: ih_lai_canopy_si_scls + integer :: ih_lai_understory_si_scls + integer :: ih_sai_canopy_si_scls + integer :: ih_sai_understory_si_scls + integer :: ih_mortality_canopy_si_scls + integer :: ih_mortality_understory_si_scls + integer :: ih_demotion_rate_si_scls + integer :: ih_promotion_rate_si_scls + integer :: ih_trimming_canopy_si_scls + integer :: ih_trimming_understory_si_scls + integer :: ih_crown_area_canopy_si_scls + integer :: ih_crown_area_understory_si_scls + integer :: ih_ddbh_canopy_si_scls + integer :: ih_ddbh_understory_si_scls + integer :: ih_agb_si_scls + integer :: ih_biomass_si_scls ! mortality vars - integer, private :: ih_m1_si_scls - integer, private :: ih_m2_si_scls - integer, private :: ih_m3_si_scls - integer, private :: ih_m4_si_scls - integer, private :: ih_m5_si_scls - integer, private :: ih_m6_si_scls - integer, private :: ih_m7_si_scls - integer, private :: ih_m8_si_scls + integer :: ih_m1_si_scls + integer :: ih_m2_si_scls + integer :: ih_m3_si_scls + integer :: ih_m4_si_scls + integer :: ih_m5_si_scls + integer :: ih_m6_si_scls + integer :: ih_m7_si_scls + integer :: ih_m8_si_scls ! lots of non-default diagnostics for understanding canopy versus understory carbon balances - integer, private :: ih_rdark_canopy_si_scls - integer, private :: ih_livestem_mr_canopy_si_scls - integer, private :: ih_livecroot_mr_canopy_si_scls - integer, private :: ih_froot_mr_canopy_si_scls - integer, private :: ih_resp_g_canopy_si_scls - integer, private :: ih_resp_m_canopy_si_scls - integer, private :: ih_leaf_md_canopy_si_scls - integer, private :: ih_root_md_canopy_si_scls - integer, private :: ih_carbon_balance_canopy_si_scls - integer, private :: ih_bstore_md_canopy_si_scls - integer, private :: ih_bdead_md_canopy_si_scls - integer, private :: ih_bsw_md_canopy_si_scls - integer, private :: ih_seed_prod_canopy_si_scls - integer, private :: ih_npp_leaf_canopy_si_scls - integer, private :: ih_npp_fnrt_canopy_si_scls - integer, private :: ih_npp_sapw_canopy_si_scls - integer, private :: ih_npp_dead_canopy_si_scls - integer, private :: ih_npp_seed_canopy_si_scls - integer, private :: ih_npp_stor_canopy_si_scls - - integer, private :: ih_rdark_understory_si_scls - integer, private :: ih_livestem_mr_understory_si_scls - integer, private :: ih_livecroot_mr_understory_si_scls - integer, private :: ih_froot_mr_understory_si_scls - integer, private :: ih_resp_g_understory_si_scls - integer, private :: ih_resp_m_understory_si_scls - integer, private :: ih_leaf_md_understory_si_scls - integer, private :: ih_root_md_understory_si_scls - integer, private :: ih_carbon_balance_understory_si_scls - integer, private :: ih_bsw_md_understory_si_scls - integer, private :: ih_bdead_md_understory_si_scls - integer, private :: ih_bstore_md_understory_si_scls - integer, private :: ih_seed_prod_understory_si_scls - integer, private :: ih_npp_leaf_understory_si_scls - integer, private :: ih_npp_fnrt_understory_si_scls - integer, private :: ih_npp_sapw_understory_si_scls - integer, private :: ih_npp_dead_understory_si_scls - integer, private :: ih_npp_seed_understory_si_scls - integer, private :: ih_npp_stor_understory_si_scls - - integer, private :: ih_yesterdaycanopylevel_canopy_si_scls - integer, private :: ih_yesterdaycanopylevel_understory_si_scls + integer :: ih_rdark_canopy_si_scls + integer :: ih_livestem_mr_canopy_si_scls + integer :: ih_livecroot_mr_canopy_si_scls + integer :: ih_froot_mr_canopy_si_scls + integer :: ih_resp_g_canopy_si_scls + integer :: ih_resp_m_canopy_si_scls + integer :: ih_leaf_md_canopy_si_scls + integer :: ih_root_md_canopy_si_scls + integer :: ih_carbon_balance_canopy_si_scls + integer :: ih_bstore_md_canopy_si_scls + integer :: ih_bdead_md_canopy_si_scls + integer :: ih_bsw_md_canopy_si_scls + integer :: ih_seed_prod_canopy_si_scls + integer :: ih_npp_leaf_canopy_si_scls + integer :: ih_npp_fnrt_canopy_si_scls + integer :: ih_npp_sapw_canopy_si_scls + integer :: ih_npp_dead_canopy_si_scls + integer :: ih_npp_seed_canopy_si_scls + integer :: ih_npp_stor_canopy_si_scls + + integer :: ih_rdark_understory_si_scls + integer :: ih_livestem_mr_understory_si_scls + integer :: ih_livecroot_mr_understory_si_scls + integer :: ih_froot_mr_understory_si_scls + integer :: ih_resp_g_understory_si_scls + integer :: ih_resp_m_understory_si_scls + integer :: ih_leaf_md_understory_si_scls + integer :: ih_root_md_understory_si_scls + integer :: ih_carbon_balance_understory_si_scls + integer :: ih_bsw_md_understory_si_scls + integer :: ih_bdead_md_understory_si_scls + integer :: ih_bstore_md_understory_si_scls + integer :: ih_seed_prod_understory_si_scls + integer :: ih_npp_leaf_understory_si_scls + integer :: ih_npp_fnrt_understory_si_scls + integer :: ih_npp_sapw_understory_si_scls + integer :: ih_npp_dead_understory_si_scls + integer :: ih_npp_seed_understory_si_scls + integer :: ih_npp_stor_understory_si_scls + + integer :: ih_yesterdaycanopylevel_canopy_si_scls + integer :: ih_yesterdaycanopylevel_understory_si_scls ! indices to (site x pft) variables - integer, private :: ih_biomass_si_pft - integer, private :: ih_leafbiomass_si_pft - integer, private :: ih_storebiomass_si_pft - integer, private :: ih_nindivs_si_pft - integer, private :: ih_recruitment_si_pft - integer, private :: ih_mortality_si_pft - integer, private :: ih_crownarea_si_pft + integer :: ih_biomass_si_pft + integer :: ih_leafbiomass_si_pft + integer :: ih_storebiomass_si_pft + integer :: ih_nindivs_si_pft + integer :: ih_recruitment_si_pft + integer :: ih_mortality_si_pft + integer :: ih_crownarea_si_pft ! indices to (site x patch-age) variables - integer, private :: ih_area_si_age - integer, private :: ih_lai_si_age - integer, private :: ih_canopy_area_si_age - integer, private :: ih_gpp_si_age - integer, private :: ih_npp_si_age - integer, private :: ih_ncl_si_age - integer, private :: ih_npatches_si_age - integer, private :: ih_zstar_si_age - integer, private :: ih_biomass_si_age - integer, private :: ih_c_stomata_si_age - integer, private :: ih_c_lblayer_si_age - integer, private :: ih_agesince_anthrodist_si_age - integer, private :: ih_secondaryforest_area_si_age + integer :: ih_area_si_age + integer :: ih_lai_si_age + integer :: ih_canopy_area_si_age + integer :: ih_gpp_si_age + integer :: ih_npp_si_age + integer :: ih_ncl_si_age + integer :: ih_npatches_si_age + integer :: ih_zstar_si_age + integer :: ih_biomass_si_age + integer :: ih_c_stomata_si_age + integer :: ih_c_lblayer_si_age + integer :: ih_agesince_anthrodist_si_age + integer :: ih_secondaryforest_area_si_age ! indices to (site x height) variables - integer, private :: ih_canopy_height_dist_si_height - integer, private :: ih_leaf_height_dist_si_height + integer :: ih_canopy_height_dist_si_height + integer :: ih_leaf_height_dist_si_height ! Indices to hydraulics variables - integer, private :: ih_errh2o_scpf - integer, private :: ih_tran_scpf - integer, private :: ih_rootuptake_scpf - integer, private :: ih_h2osoi_si_scagpft ! hijacking the scagpft dimension instead of creating a new shsl dimension - integer, private :: ih_rootuptake01_scpf - integer, private :: ih_rootuptake02_scpf - integer, private :: ih_rootuptake03_scpf - integer, private :: ih_rootuptake04_scpf - integer, private :: ih_rootuptake05_scpf - integer, private :: ih_rootuptake06_scpf - integer, private :: ih_rootuptake07_scpf - integer, private :: ih_rootuptake08_scpf - integer, private :: ih_rootuptake09_scpf - integer, private :: ih_rootuptake10_scpf - integer, private :: ih_sapflow_scpf - integer, private :: ih_iterh1_scpf - integer, private :: ih_iterh2_scpf - integer, private :: ih_supsub_scpf - integer, private :: ih_ath_scpf - integer, private :: ih_tth_scpf - integer, private :: ih_sth_scpf - integer, private :: ih_lth_scpf - integer, private :: ih_awp_scpf - integer, private :: ih_twp_scpf - integer, private :: ih_swp_scpf - integer, private :: ih_lwp_scpf - integer, private :: ih_aflc_scpf - integer, private :: ih_tflc_scpf - integer, private :: ih_sflc_scpf - integer, private :: ih_lflc_scpf - integer, private :: ih_btran_scpf + integer :: ih_errh2o_scpf + integer :: ih_tran_scpf + integer :: ih_rootuptake_scpf + integer :: ih_h2osoi_si_scagpft ! hijacking the scagpft dimension instead of creating a new shsl dimension + integer :: ih_rootuptake01_scpf + integer :: ih_rootuptake02_scpf + integer :: ih_rootuptake03_scpf + integer :: ih_rootuptake04_scpf + integer :: ih_rootuptake05_scpf + integer :: ih_rootuptake06_scpf + integer :: ih_rootuptake07_scpf + integer :: ih_rootuptake08_scpf + integer :: ih_rootuptake09_scpf + integer :: ih_rootuptake10_scpf + integer :: ih_sapflow_scpf + integer :: ih_iterh1_scpf + integer :: ih_iterh2_scpf + integer :: ih_supsub_scpf + integer :: ih_ath_scpf + integer :: ih_tth_scpf + integer :: ih_sth_scpf + integer :: ih_lth_scpf + integer :: ih_awp_scpf + integer :: ih_twp_scpf + integer :: ih_swp_scpf + integer :: ih_lwp_scpf + integer :: ih_aflc_scpf + integer :: ih_tflc_scpf + integer :: ih_sflc_scpf + integer :: ih_lflc_scpf + integer :: ih_btran_scpf ! indices to (site x fuel class) variables - integer, private :: ih_litter_moisture_si_fuel + integer :: ih_litter_moisture_si_fuel ! indices to (site x cwd size class) variables - integer, private :: ih_cwd_ag_si_cwdsc - integer, private :: ih_cwd_bg_si_cwdsc - integer, private :: ih_cwd_ag_in_si_cwdsc - integer, private :: ih_cwd_bg_in_si_cwdsc - integer, private :: ih_cwd_ag_out_si_cwdsc - integer, private :: ih_cwd_bg_out_si_cwdsc + integer :: ih_cwd_ag_si_cwdsc + integer :: ih_cwd_bg_si_cwdsc + integer :: ih_cwd_ag_in_si_cwdsc + integer :: ih_cwd_bg_in_si_cwdsc + integer :: ih_cwd_ag_out_si_cwdsc + integer :: ih_cwd_bg_out_si_cwdsc ! indices to (site x [canopy layer x leaf layer]) variables - integer, private :: ih_parsun_z_si_cnlf - integer, private :: ih_parsha_z_si_cnlf - integer, private :: ih_laisun_z_si_cnlf - integer, private :: ih_laisha_z_si_cnlf - integer, private :: ih_fabd_sun_si_cnlf - integer, private :: ih_fabd_sha_si_cnlf - integer, private :: ih_fabi_sun_si_cnlf - integer, private :: ih_fabi_sha_si_cnlf - integer, private :: ih_ts_net_uptake_si_cnlf - integer, private :: ih_crownarea_si_cnlf - integer, private :: ih_parprof_dir_si_cnlf - integer, private :: ih_parprof_dif_si_cnlf + integer :: ih_parsun_z_si_cnlf + integer :: ih_parsha_z_si_cnlf + integer :: ih_laisun_z_si_cnlf + integer :: ih_laisha_z_si_cnlf + integer :: ih_fabd_sun_si_cnlf + integer :: ih_fabd_sha_si_cnlf + integer :: ih_fabi_sun_si_cnlf + integer :: ih_fabi_sha_si_cnlf + integer :: ih_ts_net_uptake_si_cnlf + integer :: ih_crownarea_si_cnlf + integer :: ih_parprof_dir_si_cnlf + integer :: ih_parprof_dif_si_cnlf ! indices to (site x [canopy layer x leaf layer x pft]) variables - integer, private :: ih_parsun_z_si_cnlfpft - integer, private :: ih_parsha_z_si_cnlfpft - integer, private :: ih_laisun_z_si_cnlfpft - integer, private :: ih_laisha_z_si_cnlfpft - integer, private :: ih_fabd_sun_si_cnlfpft - integer, private :: ih_fabd_sha_si_cnlfpft - integer, private :: ih_fabi_sun_si_cnlfpft - integer, private :: ih_fabi_sha_si_cnlfpft - integer, private :: ih_parprof_dir_si_cnlfpft - integer, private :: ih_parprof_dif_si_cnlfpft + integer :: ih_parsun_z_si_cnlfpft + integer :: ih_parsha_z_si_cnlfpft + integer :: ih_laisun_z_si_cnlfpft + integer :: ih_laisha_z_si_cnlfpft + integer :: ih_fabd_sun_si_cnlfpft + integer :: ih_fabd_sha_si_cnlfpft + integer :: ih_fabi_sun_si_cnlfpft + integer :: ih_fabi_sha_si_cnlfpft + integer :: ih_parprof_dir_si_cnlfpft + integer :: ih_parprof_dif_si_cnlfpft ! indices to (site x canopy layer) variables - integer, private :: ih_parsun_top_si_can - integer, private :: ih_parsha_top_si_can - integer, private :: ih_laisun_top_si_can - integer, private :: ih_laisha_top_si_can - integer, private :: ih_fabd_sun_top_si_can - integer, private :: ih_fabd_sha_top_si_can - integer, private :: ih_fabi_sun_top_si_can - integer, private :: ih_fabi_sha_top_si_can - integer, private :: ih_crownarea_si_can + integer :: ih_parsun_top_si_can + integer :: ih_parsha_top_si_can + integer :: ih_laisun_top_si_can + integer :: ih_laisha_top_si_can + integer :: ih_fabd_sun_top_si_can + integer :: ih_fabd_sha_top_si_can + integer :: ih_fabi_sun_top_si_can + integer :: ih_fabi_sha_top_si_can + integer :: ih_crownarea_si_can ! The number of variable dim/kind types we have defined (static) - integer, parameter :: fates_history_num_dimensions = 16 - integer, parameter :: fates_history_num_dim_kinds = 18 - ! These flags are used to help specify what to do with non-fates - ! locations in the host model - integer, parameter :: zero_flag = 0 - integer, parameter :: ignore_flag = 1 + integer, parameter, public :: fates_history_num_dimensions = 50 + integer, parameter, public :: fates_history_num_dim_kinds = 50 - ! This structure is allocated by thread, and must be calculated after the FATES ! sites are allocated, and their mapping to the HLM is identified. This structure ! is not combined with iovar_bounds, because that one is multi-instanced. This ! structure is used more during the update phase, wherease _bounds is used ! more for things like flushing - type iovar_map_type + type, public :: iovar_map_type integer, allocatable :: site_index(:) ! maps site indexes to the HIO site position integer, allocatable :: patch1_index(:) ! maps site index to the HIO patch 1st position end type iovar_map_type @@ -519,42 +536,51 @@ module FatesHistoryInterfaceMod type(iovar_map_type), pointer :: iovar_map(:) + !! THESE WERE EXPLICITLY PRIVATE WHEN TYPE WAS PUBLIC integer, private :: patch_index_, column_index_, levgrnd_index_, levscpf_index_ 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 :: levscagpft_index_, levagepft_index_ integer, private :: levheight_index_ + integer, private :: levelem_index_, levelpft_index_ + integer, private :: levelcwd_index_, levelage_index_ + contains - procedure, public :: Init - procedure, public :: SetThreadBoundsEach - procedure, public :: initialize_history_vars - procedure, public :: assemble_history_output_types + procedure :: Init + procedure :: SetThreadBoundsEach + procedure :: initialize_history_vars + procedure :: assemble_history_output_types - procedure, public :: update_history_dyn - procedure, public :: update_history_prod - procedure, public :: update_history_cbal - procedure, public :: update_history_hydraulics + procedure :: update_history_dyn + procedure :: update_history_prod + procedure :: update_history_cbal + procedure :: update_history_hydraulics ! 'get' methods used by external callers to access private read only data - procedure, public :: num_history_vars - procedure, public :: patch_index - procedure, public :: column_index - procedure, public :: levgrnd_index - procedure, public :: levscpf_index - procedure, public :: levscls_index - procedure, public :: levpft_index - procedure, public :: levage_index - procedure, public :: levfuel_index - procedure, public :: levcwdsc_index - procedure, public :: levcan_index - procedure, public :: levcnlf_index - procedure, public :: levcnlfpft_index - procedure, public :: levscag_index - procedure, public :: levscagpft_index - procedure, public :: levagepft_index - procedure, public :: levheight_index + + procedure :: num_history_vars + procedure :: patch_index + procedure :: column_index + procedure :: levgrnd_index + procedure :: levscpf_index + procedure :: levscls_index + procedure :: levpft_index + procedure :: levage_index + procedure :: levfuel_index + procedure :: levcwdsc_index + procedure :: levcan_index + procedure :: levcnlf_index + procedure :: levcnlfpft_index + procedure :: levscag_index + procedure :: levscagpft_index + procedure :: levagepft_index + procedure :: levheight_index + procedure :: levelem_index + procedure :: levelpft_index + procedure :: levelcwd_index + procedure :: levelage_index ! private work functions procedure, private :: define_history_vars @@ -579,10 +605,16 @@ module FatesHistoryInterfaceMod procedure, private :: set_levscagpft_index procedure, private :: set_levagepft_index procedure, private :: set_levheight_index + + procedure, private :: set_levelem_index + procedure, private :: set_levelpft_index + procedure, private :: set_levelcwd_index + procedure, private :: set_levelage_index + end type fates_history_interface_type - character(len=*), parameter, private :: sourcefile = & + character(len=*), parameter :: sourcefile = & __FILE__ contains @@ -598,6 +630,8 @@ subroutine Init(this, num_threads, fates_bounds) use FatesIODimensionsMod, only : levcan, levcnlf, levcnlfpft use FatesIODimensionsMod, only : fates_bounds_type use FatesIODimensionsMod, only : levheight + use FatesIODimensionsMod, only : levelem, levelpft + use FatesIODimensionsMod, only : levelcwd, levelage implicit none @@ -686,6 +720,26 @@ subroutine Init(this, num_threads, fates_bounds) call this%set_levheight_index(dim_count) call this%dim_bounds(dim_count)%Init(levheight, num_threads, & fates_bounds%height_begin, fates_bounds%height_end) + + dim_count = dim_count + 1 + call this%set_levelem_index(dim_count) + call this%dim_bounds(dim_count)%Init(levelem, num_threads, & + fates_bounds%elem_begin, fates_bounds%elem_end) + + dim_count = dim_count + 1 + call this%set_levelpft_index(dim_count) + call this%dim_bounds(dim_count)%Init(levelpft, num_threads, & + fates_bounds%elpft_begin, fates_bounds%elpft_end) + + dim_count = dim_count + 1 + call this%set_levelcwd_index(dim_count) + call this%dim_bounds(dim_count)%Init(levelcwd, num_threads, & + fates_bounds%elcwd_begin, fates_bounds%elcwd_end) + + dim_count = dim_count + 1 + call this%set_levelage_index(dim_count) + call this%dim_bounds(dim_count)%Init(levelage, num_threads, & + fates_bounds%elage_begin, fates_bounds%elage_end) ! FIXME(bja, 2016-10) assert(dim_count == FatesHistorydimensionmod::num_dimension_types) @@ -772,6 +826,27 @@ subroutine SetThreadBoundsEach(this, thread_index, thread_bounds) index = this%levheight_index() call this%dim_bounds(index)%SetThreadBounds(thread_index, & thread_bounds%height_begin, thread_bounds%height_end) + + index = this%levelem_index() + call this%dim_bounds(index)%SetThreadBounds(thread_index, & + thread_bounds%elem_begin, thread_bounds%elem_end) + + index = this%levelpft_index() + call this%dim_bounds(index)%SetThreadBounds(thread_index, & + thread_bounds%elpft_begin, thread_bounds%elpft_end) + + index = this%levelcwd_index() + call this%dim_bounds(index)%SetThreadBounds(thread_index, & + thread_bounds%elcwd_begin, thread_bounds%elcwd_end) + + index = this%levelage_index() + call this%dim_bounds(index)%SetThreadBounds(thread_index, & + thread_bounds%elage_begin, thread_bounds%elage_end) + + + + + end subroutine SetThreadBoundsEach @@ -785,6 +860,8 @@ subroutine assemble_history_output_types(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_height_r8 + use FatesIOVariableKindMod, only : site_elem_r8, site_elpft_r8 + use FatesIOVariableKindMod, only : site_elcwd_r8, site_elage_r8 implicit none @@ -844,6 +921,19 @@ subroutine assemble_history_output_types(this) call this%set_dim_indices(site_height_r8, 1, this%column_index()) call this%set_dim_indices(site_height_r8, 2, this%levheight_index()) + call this%set_dim_indices(site_elem_r8, 1, this%column_index()) + call this%set_dim_indices(site_elem_r8, 2, this%levelem_index()) + + call this%set_dim_indices(site_elpft_r8, 1, this%column_index()) + call this%set_dim_indices(site_elpft_r8, 2, this%levelpft_index()) + + call this%set_dim_indices(site_elcwd_r8, 1, this%column_index()) + call this%set_dim_indices(site_elcwd_r8, 2, this%levelcwd_index()) + + call this%set_dim_indices(site_elage_r8, 1, this%column_index()) + call this%set_dim_indices(site_elage_r8, 2, this%levelage_index()) + + end subroutine assemble_history_output_types ! =================================================================================== @@ -1110,9 +1200,68 @@ integer function levheight_index(this) class(fates_history_interface_type), intent(in) :: this levheight_index = this%levheight_index_ end function levheight_index - ! ====================================================================================== + ! ====================================================================================== + subroutine set_levelem_index(this, index) + implicit none + class(fates_history_interface_type), intent(inout) :: this + integer, intent(in) :: index + this%levelem_index_ = index + end subroutine set_levelem_index + + integer function levelem_index(this) + implicit none + class(fates_history_interface_type), intent(in) :: this + levelem_index = this%levelem_index_ + end function levelem_index + + ! ====================================================================================== + + subroutine set_levelpft_index(this, index) + implicit none + class(fates_history_interface_type), intent(inout) :: this + integer, intent(in) :: index + this%levelpft_index_ = index + end subroutine set_levelpft_index + + integer function levelpft_index(this) + implicit none + class(fates_history_interface_type), intent(in) :: this + levelpft_index = this%levelpft_index_ + end function levelpft_index + + ! ====================================================================================== + + subroutine set_levelcwd_index(this, index) + implicit none + class(fates_history_interface_type), intent(inout) :: this + integer, intent(in) :: index + this%levelcwd_index_ = index + end subroutine set_levelcwd_index + + integer function levelcwd_index(this) + implicit none + class(fates_history_interface_type), intent(in) :: this + levelcwd_index = this%levelcwd_index_ + end function levelcwd_index + + ! ====================================================================================== + + subroutine set_levelage_index(this, index) + implicit none + class(fates_history_interface_type), intent(inout) :: this + integer, intent(in) :: index + this%levelage_index_ = index + end subroutine set_levelage_index + + integer function levelage_index(this) + implicit none + class(fates_history_interface_type), intent(in) :: this + levelage_index = this%levelage_index_ + end function levelage_index + + ! ====================================================================================== subroutine flush_hvars(this,nc,upfreq_in) @@ -1207,7 +1356,9 @@ 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_height_r8 - + use FatesIOVariableKindMod, only : site_elem_r8, site_elpft_r8 + use FatesIOVariableKindMod, only : site_elcwd_r8, site_elage_r8 + implicit none ! Arguments @@ -1288,60 +1439,75 @@ subroutine init_dim_kinds_maps(this) index = index + 1 call this%dim_kinds(index)%Init(site_height_r8, 2) + ! site x elemenet + index = index + 1 + call this%dim_kinds(index)%Init(site_elem_r8, 2) + + ! site x element x pft + index = index + 1 + call this%dim_kinds(index)%Init(site_elpft_r8, 2) + + ! site x element x cwd + index = index + 1 + call this%dim_kinds(index)%Init(site_elcwd_r8, 2) + + ! site x element x age + index = index + 1 + call this%dim_kinds(index)%Init(site_elage_r8, 2) + + ! FIXME(bja, 2016-10) assert(index == fates_history_num_dim_kinds) end subroutine init_dim_kinds_maps ! ======================================================================= - subroutine update_history_cbal(this,nc,nsites,sites) + + subroutine update_history_cbal(this,nc,nsites,sites,bc_in) use EDtypesMod , only : ed_site_type - + + ! Arguments class(fates_history_interface_type) :: this integer , intent(in) :: nc ! clump index integer , intent(in) :: nsites type(ed_site_type) , intent(inout), target :: sites(nsites) + type(bc_in_type) , intent(in) :: bc_in(nsites) ! Locals integer :: s ! The local site index integer :: io_si ! The site index of the IO array + type(ed_cohort_type), pointer :: ccohort ! current cohort + type(ed_patch_type) , pointer :: cpatch ! current patch - - associate( hio_nep_si => this%hvars(ih_nep_si)%r81d, & - hio_nbp_si => this%hvars(ih_nbp_si)%r81d, & - hio_fire_c_to_atm_si => this%hvars(ih_fire_c_to_atm_si)%r81d, & - hio_totecosysc_si => this%hvars(ih_totecosysc_si)%r81d, & - hio_cbal_err_fates_si => this%hvars(ih_cbal_err_fates_si)%r81d, & - hio_cbal_err_bgc_si => this%hvars(ih_cbal_err_bgc_si)%r81d, & - hio_cbal_err_tot_si => this%hvars(ih_cbal_err_tot_si)%r81d, & - hio_biomass_stock_si => this%hvars(ih_biomass_stock_si)%r81d, & - hio_litter_stock_si => this%hvars(ih_litter_stock_si)%r81d, & - hio_cwd_stock_si => this%hvars(ih_cwd_stock_si)%r81d ) - - ! --------------------------------------------------------------------------------- - ! Flush arrays to values defined by %flushval (see registry entry in - ! subroutine define_history_vars() - ! --------------------------------------------------------------------------------- - call this%flush_hvars(nc,upfreq_in=3) - + associate( hio_nep_si => this%hvars(ih_nep_si)%r81d ) + + ! --------------------------------------------------------------------------------- + ! Flush arrays to values defined by %flushval (see registry entry in + ! subroutine define_history_vars() + ! --------------------------------------------------------------------------------- + + call this%flush_hvars(nc,upfreq_in=3) - do s = 1,nsites - + do s = 1,nsites + io_si = this%iovar_map(nc)%site_index(s) - hio_nep_si(io_si) = sites(s)%nep - hio_nbp_si(io_si) = sites(s)%nbp - hio_fire_c_to_atm_si(io_si) = sites(s)%fire_c_to_atm - hio_totecosysc_si(io_si) = sites(s)%totecosysc - hio_cbal_err_fates_si(io_si) = sites(s)%cbal_err_fates - hio_cbal_err_bgc_si(io_si) = sites(s)%cbal_err_bgc - hio_cbal_err_tot_si(io_si) = sites(s)%cbal_err_tot - hio_biomass_stock_si(io_si) = sites(s)%biomass_stock - hio_litter_stock_si(io_si) = sites(s)%ed_litter_stock - hio_cwd_stock_si(io_si) = sites(s)%cwd_stock - - end do - + hio_nep_si(io_si) = -bc_in(s)%tot_het_resp ! (gC/m2/s) + + cpatch => sites(s)%oldest_patch + do while(associated(cpatch)) + ccohort => cpatch%shortest + do while(associated(ccohort)) + + ! Add up the total Net Ecosystem Production + ! for this timestep. [gC/m2/s] + hio_nep_si(io_si) = hio_nep_si(io_si) + & + (ccohort%gpp_tstep - ccohort%resp_tstep) * g_per_kg * ccohort%n * area_inv + ccohort => ccohort%taller + end do + cpatch => cpatch%younger + end do + end do end associate end subroutine update_history_cbal @@ -1356,13 +1522,9 @@ subroutine update_history_dyn(this,nc,nsites,sites) ! after Ecosystem Dynamics have been processed. ! --------------------------------------------------------------------------------- - use EDtypesMod , only : ed_site_type - use EDtypesMod , only : ed_cohort_type - use EDtypesMod , only : ed_patch_type - use EDtypesMod , only : AREA - use EDtypesMod , only : AREA_INV + use EDtypesMod , only : nfsc - use EDtypesMod , only : ncwd + use FatesLitterMod , only : ncwd use EDtypesMod , only : ican_upper use EDtypesMod , only : ican_ustory use FatesSizeAgeTypeIndicesMod, only : get_sizeage_class_index @@ -1381,6 +1543,12 @@ subroutine update_history_dyn(this,nc,nsites,sites) type(ed_site_type) , intent(inout), target :: sites(nsites) ! Locals + type(litter_type), pointer :: litt_c ! Pointer to the carbon12 litter pool + type(litter_type), pointer :: litt ! Generic pointer to any litter pool + type(site_fluxdiags_type), pointer :: flux_diags + type(site_fluxdiags_type), pointer :: flux_diags_c + type(site_massbal_type), pointer :: site_mass + integer :: s ! The local site index integer :: io_si ! The site index of the IO array integer :: ipa, ipa2 ! The local "I"ndex of "PA"tches @@ -1390,6 +1558,8 @@ subroutine update_history_dyn(this,nc,nsites,sites) integer :: lb1,ub1,lb2,ub2 ! IO array bounds for the calling thread integer :: ivar ! index of IO variable object vector integer :: ft ! functional type index + integer :: cwd + integer :: elcwd, elpft ! combined index of element and pft or cwd integer :: i_scpf,i_pft,i_scls ! iterators for scpf, pft, and scls dims integer :: i_cwd,i_fuel ! iterators for cwd and fuel dims integer :: iscag ! size-class x age index @@ -1398,7 +1568,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) integer :: ican, ileaf, cnlf_indx ! iterators for leaf and canopy level integer :: height_bin_max, height_bin_min ! which height bin a given cohort's canopy is in integer :: i_heightbin ! iterator for height bins - integer :: i_tmem ! iterator for veg temp bins + integer :: el ! Loop index for elements integer :: model_day_int ! integer model day from reference integer :: ageclass_since_anthrodist ! what is the equivalent age class for ! time-since-anthropogenic-disturbance of secondary forest @@ -1434,6 +1604,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) real(r8) :: fnrt_c_net_alloc real(r8) :: struct_c_net_alloc real(r8) :: repro_c_net_alloc + real(r8) :: area_frac type(ed_patch_type),pointer :: cpatch type(ed_cohort_type),pointer :: ccohort @@ -1460,18 +1631,23 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_effect_wspeed_pa => this%hvars(ih_effect_wspeed_pa)%r81d, & hio_fire_intensity_pa => this%hvars(ih_fire_intensity_pa)%r81d, & hio_fire_area_pa => this%hvars(ih_fire_area_pa)%r81d, & - hio_scorch_height_pa => this%hvars(ih_scorch_height_pa)%r81d, & hio_fire_fuel_bulkd_pa => this%hvars(ih_fire_fuel_bulkd_pa)%r81d, & hio_fire_fuel_eff_moist_pa => this%hvars(ih_fire_fuel_eff_moist_pa)%r81d, & hio_fire_fuel_sav_pa => this%hvars(ih_fire_fuel_sav_pa)%r81d, & hio_fire_fuel_mef_pa => this%hvars(ih_fire_fuel_mef_pa)%r81d, & hio_sum_fuel_pa => this%hvars(ih_sum_fuel_pa)%r81d, & hio_litter_in_si => this%hvars(ih_litter_in_si)%r81d, & - hio_litter_out_pa => this%hvars(ih_litter_out_pa)%r81d, & + hio_litter_out_si => this%hvars(ih_litter_out_si)%r81d, & hio_seed_bank_si => this%hvars(ih_seed_bank_si)%r81d, & - hio_seeds_in_pa => this%hvars(ih_seeds_in_pa)%r81d, & - hio_seed_decay_pa => this%hvars(ih_seed_decay_pa)%r81d, & - hio_seed_germination_pa => this%hvars(ih_seed_germination_pa)%r81d, & + hio_seeds_in_si => this%hvars(ih_seeds_in_si)%r81d, & + hio_litter_in_elem => this%hvars(ih_litter_in_elem)%r82d, & + hio_litter_out_elem => this%hvars(ih_litter_out_elem)%r82d, & + hio_seed_bank_elem => this%hvars(ih_seed_bank_elem)%r82d, & + hio_seeds_in_local_elem => this%hvars(ih_seeds_in_local_elem)%r82d, & + hio_seed_in_extern_elem => this%hvars(ih_seeds_in_extern_elem)%r82d, & + hio_seed_decay_elem => this%hvars(ih_seed_decay_elem)%r82d, & + hio_seed_germ_elem => this%hvars(ih_seed_germ_elem)%r82d, & + hio_bstore_pa => this%hvars(ih_bstore_pa)%r81d, & hio_bdead_pa => this%hvars(ih_bdead_pa)%r81d, & hio_balive_pa => this%hvars(ih_balive_pa)%r81d, & @@ -1498,7 +1674,6 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_npp_froot_si => this%hvars(ih_npp_froot_si)%r81d, & hio_npp_croot_si => this%hvars(ih_npp_croot_si)%r81d, & hio_npp_stor_si => this%hvars(ih_npp_stor_si)%r81d, & - hio_bstor_canopy_si_scpf => this%hvars(ih_bstor_canopy_si_scpf)%r82d, & hio_bstor_understory_si_scpf => this%hvars(ih_bstor_understory_si_scpf)%r82d, & hio_bleaf_canopy_si_scpf => this%hvars(ih_bleaf_canopy_si_scpf)%r82d, & @@ -1532,6 +1707,8 @@ subroutine update_history_dyn(this,nc,nsites,sites) 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_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, & @@ -1540,9 +1717,12 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_m6_si_scls => this%hvars(ih_m6_si_scls)%r82d, & hio_m7_si_scls => this%hvars(ih_m7_si_scls)%r82d, & hio_m8_si_scls => this%hvars(ih_m8_si_scls)%r82d, & - hio_c13disc_si_scpf => this%hvars(ih_c13disc_si_scpf)%r82d, & - - + hio_c13disc_si_scpf => this%hvars(ih_c13disc_si_scpf)%r82d, & + hio_cwd_elcwd => this%hvars(ih_cwd_elcwd)%r82d, & + hio_cwd_ag_elem => this%hvars(ih_cwd_ag_elem)%r82d, & + hio_cwd_bg_elem => this%hvars(ih_cwd_bg_elem)%r82d, & + hio_fines_ag_elem => this%hvars(ih_fines_bg_elem)%r82d, & + hio_fines_bg_elem => this%hvars(ih_fines_ag_elem)%r82d, & hio_ba_si_scls => this%hvars(ih_ba_si_scls)%r82d, & hio_agb_si_scls => this%hvars(ih_agb_si_scls)%r82d, & hio_biomass_si_scls => this%hvars(ih_biomass_si_scls)%r82d, & @@ -1594,6 +1774,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_nplant_si_scagpft => this%hvars(ih_nplant_si_scagpft)%r82d, & hio_npp_si_agepft => this%hvars(ih_npp_si_agepft)%r82d, & hio_biomass_si_agepft => this%hvars(ih_biomass_si_agepft)%r82d, & + hio_scorch_height_si_agepft => this%hvars(ih_scorch_height_si_agepft)%r82d, & hio_yesterdaycanopylevel_canopy_si_scls => this%hvars(ih_yesterdaycanopylevel_canopy_si_scls)%r82d, & hio_yesterdaycanopylevel_understory_si_scls => this%hvars(ih_yesterdaycanopylevel_understory_si_scls)%r82d, & hio_area_si_age => this%hvars(ih_area_si_age)%r82d, & @@ -1635,7 +1816,9 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_cleafon_si => this%hvars(ih_cleafon_si)%r81d, & hio_dleafoff_si => this%hvars(ih_dleafoff_si)%r81d, & hio_dleafon_si => this%hvars(ih_dleafoff_si)%r81d, & - hio_meanliqvol_si => this%hvars(ih_meanliqvol_si)%r81d ) + hio_meanliqvol_si => this%hvars(ih_meanliqvol_si)%r81d, & + hio_cbal_err_fates_si => this%hvars(ih_cbal_err_fates_si)%r81d, & + hio_err_fates_si => this%hvars(ih_err_fates_si)%r82d ) ! --------------------------------------------------------------------------------- @@ -1663,8 +1846,20 @@ subroutine update_history_dyn(this,nc,nsites,sites) ! Set trimming on the soil patch to 1.0 hio_trimming_pa(io_soipa) = 1.0_r8 - ! The seed bank is a site level variable - hio_seed_bank_si(io_si) = sum(sites(s)%seed_bank) * g_per_kg + ! Total carbon model error [kgC/day -> mgC/day] + hio_cbal_err_fates_si(io_si) = & + sites(s)%mass_balance(element_pos(carbon12_element))%err_fates * mg_per_kg + + ! Total carbon lost to atmosphere from burning (kgC/site/day -> gC/m2/s) + hio_fire_c_to_atm_si(io_si) = & + sites(s)%mass_balance(element_pos(carbon12_element))%burn_flux_to_atm * & + g_per_kg * ha_per_m2 * days_per_sec + + ! Total model error [kg/day -> mg/day] (all elements) + do el = 1, num_elements + site_mass => sites(s)%mass_balance(el) + hio_err_fates_si(io_si,el) = site_mass%err_fates * mg_per_kg + end do hio_canopy_spread_si(io_si) = sites(s)%spread @@ -1746,6 +1941,15 @@ subroutine update_history_dyn(this,nc,nsites,sites) + cpatch%area * AREA_INV endif + do i_pft = 1,numpft + ! for scorch height, weight the value by patch area within any given age calss (in the event that there is + ! more than one patch per age class. + iagepft = cpatch%age_class + (i_pft-1) * nlevage + hio_scorch_height_si_agepft(io_si,iagepft) = hio_scorch_height_si_agepft(io_si,iagepft) + & + cpatch%Scorch_ht(i_pft) * cpatch%area + + end do + ccohort => cpatch%shortest do while(associated(ccohort)) @@ -1907,12 +2111,10 @@ subroutine update_history_dyn(this,nc,nsites,sites) (1._r8-EDPftvarcon_inst%allom_agb_frac(ccohort%pft)) hio_npp_stor_si(io_si) = hio_npp_stor_si(io_si) + store_c_net_alloc * n_perm2 - - associate( scpf => ccohort%size_by_pft_class, & scls => ccohort%size_class ) - - gpp_cached = hio_gpp_si_scpf(io_si,scpf) + + gpp_cached = hio_gpp_si_scpf(io_si,scpf) hio_gpp_si_scpf(io_si,scpf) = hio_gpp_si_scpf(io_si,scpf) + & n_perm2*ccohort%gpp_acc_hold ! [kgC/m2/yr] @@ -2013,8 +2215,6 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_biomass_si_agepft(io_si,iagepft) = hio_biomass_si_agepft(io_si,iagepft) + & total_c * ccohort%n * AREA_INV - - ! update SCPF/SCLS- and canopy/subcanopy- partitioned quantities if (ccohort%canopy_layer .eq. 1) then hio_nplant_canopy_si_scag(io_si,iscag) = hio_nplant_canopy_si_scag(io_si,iscag) + ccohort%n @@ -2034,7 +2234,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) 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%n + & - (ccohort%lmort_direct + ccohort%lmort_collateral + ccohort%lmort_infra) * & + (ccohort%lmort_direct + ccohort%lmort_collateral + ccohort%lmort_infra) * & ccohort%n * sec_per_day * days_per_year hio_nplant_canopy_si_scpf(io_si,scpf) = hio_nplant_canopy_si_scpf(io_si,scpf) + ccohort%n @@ -2059,7 +2259,7 @@ 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%n + & + (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%frmort) * ccohort%n + & (ccohort%lmort_direct + ccohort%lmort_collateral + ccohort%lmort_infra) * & ccohort%n * sec_per_day * days_per_year @@ -2120,7 +2320,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) 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%n + & - (ccohort%lmort_direct + ccohort%lmort_collateral + ccohort%lmort_infra) * & + (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 @@ -2146,7 +2346,7 @@ 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%n + & + (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%frmort) * ccohort%n + & (ccohort%lmort_direct + ccohort%lmort_collateral + ccohort%lmort_infra) * & ccohort%n * sec_per_day * days_per_year @@ -2245,7 +2445,6 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_tfc_ros_pa(io_pa) = cpatch%TFC_ROS hio_fire_intensity_pa(io_pa) = cpatch%FI hio_fire_area_pa(io_pa) = cpatch%frac_burnt - hio_scorch_height_pa(io_pa) = cpatch%SH hio_fire_fuel_bulkd_pa(io_pa) = cpatch%fuel_bulkd hio_fire_fuel_eff_moist_pa(io_pa) = cpatch%fuel_eff_moist hio_fire_fuel_sav_pa(io_pa) = cpatch%fuel_sav @@ -2256,39 +2455,25 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_litter_moisture_si_fuel(io_si, i_fuel) = hio_litter_moisture_si_fuel(io_si, i_fuel) + & cpatch%litter_moisture(i_fuel) * cpatch%area * AREA_INV end do - ! Update Litter Flux Variables - ! put litter_in flux onto site level variable so as to be able to append site-level - ! distubance-related input flux after patch loop - hio_litter_in_si(io_si) = hio_litter_in_si(io_si) + & - (sum(cpatch%CWD_AG_in) +sum(cpatch%leaf_litter_in) + sum(cpatch%root_litter_in)) & - * g_per_kg * cpatch%area * AREA_INV * years_per_day * days_per_sec - ! keep litter_out at patch level - hio_litter_out_pa(io_pa) = (sum(cpatch%CWD_AG_out)+sum(cpatch%leaf_litter_out) & - + sum(cpatch%root_litter_out)) & - * g_per_kg * patch_scaling_scalar * years_per_day * days_per_sec - - hio_seeds_in_pa(io_pa) = sum(cpatch%seeds_in) * & - g_per_kg * patch_scaling_scalar * years_per_day * days_per_sec - hio_seed_decay_pa(io_pa) = sum(cpatch%seed_decay) * & - g_per_kg * patch_scaling_scalar * years_per_day * days_per_sec - hio_seed_germination_pa(io_pa) = sum(cpatch%seed_germination) * & - g_per_kg * patch_scaling_scalar * years_per_day * days_per_sec + ! Update Litter Flux Variables - + litt_c => cpatch%litter(element_pos(carbon12_element)) + flux_diags_c => sites(s)%flux_diags(element_pos(carbon12_element)) + do i_cwd = 1, ncwd - hio_cwd_ag_si_cwdsc(io_si, i_cwd) = hio_cwd_ag_si_cwdsc(io_si, i_cwd) + & - cpatch%CWD_AG(i_cwd)*cpatch%area * AREA_INV * g_per_kg - hio_cwd_bg_si_cwdsc(io_si, i_cwd) = hio_cwd_bg_si_cwdsc(io_si, i_cwd) + & - cpatch%CWD_BG(i_cwd)*cpatch%area * AREA_INV * g_per_kg - hio_cwd_ag_in_si_cwdsc(io_si, i_cwd) = hio_cwd_ag_in_si_cwdsc(io_si, i_cwd) + & - cpatch%CWD_AG_IN(i_cwd)*cpatch%area * AREA_INV * g_per_kg - hio_cwd_bg_in_si_cwdsc(io_si, i_cwd) = hio_cwd_bg_in_si_cwdsc(io_si, i_cwd) + & - cpatch%CWD_BG_IN(i_cwd)*cpatch%area * AREA_INV * g_per_kg - hio_cwd_ag_out_si_cwdsc(io_si, i_cwd) = hio_cwd_ag_out_si_cwdsc(io_si, i_cwd) + & - cpatch%CWD_AG_OUT(i_cwd)*cpatch%area * AREA_INV * g_per_kg - hio_cwd_bg_out_si_cwdsc(io_si, i_cwd) = hio_cwd_bg_out_si_cwdsc(io_si, i_cwd) + & - cpatch%CWD_BG_OUT(i_cwd)*cpatch%area * AREA_INV * g_per_kg + + hio_cwd_ag_si_cwdsc(io_si, i_cwd) = hio_cwd_ag_si_cwdsc(io_si, i_cwd) + & + litt_c%ag_cwd(i_cwd)*cpatch%area * AREA_INV * g_per_kg + hio_cwd_bg_si_cwdsc(io_si, i_cwd) = hio_cwd_bg_si_cwdsc(io_si, i_cwd) + & + sum(litt_c%bg_cwd(i_cwd,:)) * cpatch%area * AREA_INV * g_per_kg + + hio_cwd_ag_out_si_cwdsc(io_si, i_cwd) = hio_cwd_ag_out_si_cwdsc(io_si, i_cwd) + & + litt_c%ag_cwd_frag(i_cwd)*cpatch%area * AREA_INV * g_per_kg + + hio_cwd_bg_out_si_cwdsc(io_si, i_cwd) = hio_cwd_bg_out_si_cwdsc(io_si, i_cwd) + & + sum(litt_c%bg_cwd_frag(i_cwd,:)) * cpatch%area * AREA_INV * g_per_kg + end do ipa = ipa + 1 @@ -2300,6 +2485,11 @@ subroutine update_history_dyn(this,nc,nsites,sites) if (hio_area_si_age(io_si, ipa2) .gt. tiny) then hio_lai_si_age(io_si, ipa2) = hio_lai_si_age(io_si, ipa2) / (hio_area_si_age(io_si, ipa2)*AREA) hio_ncl_si_age(io_si, ipa2) = hio_ncl_si_age(io_si, ipa2) / (hio_area_si_age(io_si, ipa2)*AREA) + do i_pft = 1, numpft + iagepft = ipa2 + (i_pft-1) * nlevage + hio_scorch_height_si_agepft(io_si, iagepft) = & + hio_scorch_height_si_agepft(io_si, iagepft) / (hio_area_si_age(io_si, ipa2)*AREA) + enddo else hio_lai_si_age(io_si, ipa2) = 0._r8 hio_ncl_si_age(io_si, ipa2) = 0._r8 @@ -2432,11 +2622,142 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_m4_si_scpf(io_si,i_scpf) + & hio_m5_si_scpf(io_si,i_scpf) + & hio_m6_si_scpf(io_si,i_scpf) + & - hio_m7_si_scpf(io_si,i_scpf) + & + hio_m7_si_scpf(io_si,i_scpf) + & hio_m8_si_scpf(io_si,i_scpf) end do end do + + ! ------------------------------------------------------------------------------ + ! Some carbon only litter diagnostics (legacy) + ! ------------------------------------------------------------------------------ + + flux_diags => sites(s)%flux_diags(element_pos(carbon12_element)) + + hio_litter_in_si(io_si) = (sum(flux_diags%cwd_ag_input(:)) + & + sum(flux_diags%cwd_bg_input(:)) + & + sum(flux_diags%leaf_litter_input(:)) + & + sum(flux_diags%root_litter_input(:))) * & + g_per_kg * AREA_INV * days_per_sec + + hio_litter_out_si(io_si) = 0._r8 + hio_seed_bank_si(io_si) = 0._r8 + hio_seeds_in_si(io_si) = 0._r8 + + cpatch => sites(s)%oldest_patch + do while(associated(cpatch)) + + litt => cpatch%litter(element_pos(carbon12_element)) + + area_frac = cpatch%area * AREA_INV + + ! Sum up all output fluxes (fragmentation) kgC/m2/day -> gC/m2/s + hio_litter_out_si(io_si) = hio_litter_out_si(io_si) + & + (sum(litt%leaf_fines_frag(:)) + & + sum(litt%root_fines_frag(:,:)) + & + sum(litt%ag_cwd_frag(:)) + & + sum(litt%bg_cwd_frag(:,:))) * & + area_frac * g_per_kg * days_per_sec + + ! Sum up total seed bank (germinated and ungerminated) + hio_seed_bank_si(io_si) = hio_seed_bank_si(io_si) + & + (sum(litt%seed(:))+sum(litt%seed_germ(:))) * & + area_frac * g_per_kg * days_per_sec + + ! Sum up the input flux into the seed bank (local and external) + hio_seeds_in_si(io_si) = hio_seeds_in_si(io_si) + & + (sum(litt%seed_in_local(:)) + sum(litt%seed_in_extern(:))) * & + area_frac * g_per_kg * days_per_sec + + cpatch => cpatch%younger + end do + + + ! ------------------------------------------------------------------------------ + ! Diagnostics discretized by element type + ! ------------------------------------------------------------------------------ + + hio_cwd_elcwd(io_si,:) = 0._r8 + + + do el = 1, num_elements + + flux_diags => sites(s)%flux_diags(el) + + ! Sum up all input litter fluxes (above below, fines, cwd) + hio_litter_in_elem(io_si, el) = hio_litter_in_elem(io_si, el) + & + sum(flux_diags%cwd_ag_input(:)) + & + sum(flux_diags%cwd_bg_input(:)) + & + sum(flux_diags%leaf_litter_input(:)) + & + sum(flux_diags%root_litter_input(:)) + + hio_cwd_ag_elem(io_si,el) = 0._r8 + hio_cwd_bg_elem(io_si,el) = 0._r8 + hio_fines_ag_elem(io_si,el) = 0._r8 + hio_fines_bg_elem(io_si,el) = 0._r8 + + hio_seed_bank_elem(io_si,el) = 0._r8 + hio_seed_germ_elem(io_si,el) = 0._r8 + hio_seed_decay_elem(io_si,el) = 0._r8 + hio_seeds_in_local_elem(io_si,el) = 0._r8 + hio_seed_in_extern_elem(io_si,el) = 0._r8 + + cpatch => sites(s)%oldest_patch + do while(associated(cpatch)) + + litt => cpatch%litter(el) + + area_frac = cpatch%area * AREA_INV + + ! Sum up all output fluxes (fragmentation) + hio_litter_out_elem(io_si,el) = hio_litter_out_elem(io_si,el) + & + (sum(litt%leaf_fines_frag(:)) + & + sum(litt%root_fines_frag(:,:)) + & + sum(litt%ag_cwd_frag(:)) + & + sum(litt%bg_cwd_frag(:,:))) * area_frac + + hio_seed_bank_elem(io_si,el) = hio_seed_bank_elem(io_si,el) + & + sum(litt%seed(:)) * area_frac + + hio_seed_germ_elem(io_si,el) = hio_seed_germ_elem(io_si,el) + & + sum(litt%seed_germ(:)) * area_frac + + hio_seed_decay_elem(io_si,el) = hio_seed_decay_elem(io_si,el) + & + sum(litt%seed_decay(:)) * area_frac + + hio_seeds_in_local_elem(io_si,el) = hio_seeds_in_local_elem(io_si,el) + & + sum(litt%seed_in_local(:)) * area_frac + + hio_seed_in_extern_elem(io_si,el) = hio_seed_in_extern_elem(io_si,el) + & + sum(litt%seed_in_extern(:)) * area_frac + + ! Litter State Variables + hio_cwd_ag_elem(io_si,el) = hio_cwd_ag_elem(io_si,el) + & + sum(litt%ag_cwd(:)) * area_frac + + hio_cwd_bg_elem(io_si,el) = hio_cwd_bg_elem(io_si,el) + & + sum(litt%bg_cwd(:,:)) * area_frac + + hio_fines_ag_elem(io_si,el) = hio_fines_ag_elem(io_si,el) + & + sum(litt%leaf_fines(:)) * area_frac + + hio_fines_bg_elem(io_si,el) = hio_fines_bg_elem(io_si,el) + & + sum(litt%root_fines(:,:)) * area_frac + + + do cwd=1,ncwd + elcwd = (el-1)*ncwd+cwd + hio_cwd_elcwd(io_si,elcwd) = hio_cwd_elcwd(io_si,elcwd) + & + (litt%ag_cwd(cwd) + sum(litt%bg_cwd(cwd,:))) * area_frac + + end do + + + cpatch => cpatch%younger + end do + + end do + ! pass demotion rates and associated carbon fluxes to history do i_scls = 1,nlevsclass @@ -2460,22 +2781,24 @@ subroutine update_history_dyn(this,nc,nsites,sites) sites(s)%term_carbonflux_canopy = 0._r8 sites(s)%term_carbonflux_ustory = 0._r8 ! + ! add the site-level disturbance-associated cwd and litter input fluxes to thir respective flux fields + do i_cwd = 1, ncwd - hio_cwd_ag_in_si_cwdsc(io_si, i_cwd) = hio_cwd_ag_in_si_cwdsc(io_si, i_cwd) + & - sites(s)%CWD_AG_diagnostic_input_carbonflux(i_cwd) * g_per_kg - hio_cwd_bg_in_si_cwdsc(io_si, i_cwd) = hio_cwd_bg_in_si_cwdsc(io_si, i_cwd) + & - sites(s)%CWD_BG_diagnostic_input_carbonflux(i_cwd) * g_per_kg + hio_cwd_ag_in_si_cwdsc(io_si, i_cwd) = hio_cwd_ag_in_si_cwdsc(io_si, i_cwd) + & + flux_diags_c%cwd_ag_input(i_cwd) * g_per_kg + + hio_cwd_bg_in_si_cwdsc(io_si, i_cwd) = hio_cwd_bg_in_si_cwdsc(io_si, i_cwd) + & + flux_diags_c%cwd_bg_input(i_cwd) * g_per_kg + end do - hio_litter_in_si(io_si) = hio_litter_in_si(io_si) + & - (sum(sites(s)%leaf_litter_diagnostic_input_carbonflux) + & - sum(sites(s)%root_litter_diagnostic_input_carbonflux)) * g_per_kg * days_per_sec * years_per_day + ! and reset the disturbance-related field buffers - sites(s)%CWD_AG_diagnostic_input_carbonflux(:) = 0._r8 - sites(s)%CWD_BG_diagnostic_input_carbonflux(:) = 0._r8 - sites(s)%leaf_litter_diagnostic_input_carbonflux(:) = 0._r8 - sites(s)%root_litter_diagnostic_input_carbonflux(:) = 0._r8 - + + do el = 1, num_elements + call sites(s)%flux_diags(el)%ZeroFluxDiags() + end do + enddo ! site loop end associate @@ -2492,12 +2815,6 @@ subroutine update_history_prod(this,nc,nsites,sites,dt_tstep) ! after rapid timescale productivity calculations (gpp and respiration). ! --------------------------------------------------------------------------------- - use EDtypesMod , only : ed_site_type, & - ed_cohort_type, & - ed_patch_type, & - AREA, & - AREA_INV - use EDTypesMod , only : nclmax, nlevleaf ! ! Arguments @@ -2920,11 +3237,6 @@ subroutine update_history_hydraulics(this,nc,nsites,sites,dt_tstep) ! after rapid timescale productivity calculations (gpp and respiration). ! --------------------------------------------------------------------------------- - use EDtypesMod , only : ed_site_type, & - ed_cohort_type, & - ed_patch_type, & - AREA - use FatesHydraulicsMemMod, only : ed_cohort_hydr_type, nshell use EDTypesMod , only : maxpft @@ -3346,6 +3658,9 @@ 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_scagpft_r8, site_agepft_r8 + use FatesIOVariableKindMod, only : site_elem_r8, site_elpft_r8 + use FatesIOVariableKindMod, only : site_elcwd_r8, site_elage_r8 + implicit none @@ -3587,7 +3902,7 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_effect_wspeed_pa ) - call this%set_history_var(vname='FIRE_TFC_ROS', units='none', & + call this%set_history_var(vname='FIRE_TFC_ROS', units='kgC/m2', & long ='total fuel consumed', use_default='active', & avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_TFC_ROS_pa ) @@ -3598,21 +3913,16 @@ subroutine define_history_vars(this, initialize_variables) ivar=ivar, initialize=initialize_variables, index = ih_fire_intensity_pa ) call this%set_history_var(vname='FIRE_AREA', units='fraction', & - long='spitfire fire area:m2', use_default='active', & + long='spitfire fire area burn fraction', use_default='active', & avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_fire_area_pa ) - call this%set_history_var(vname='SCORCH_HEIGHT', units='m', & - long='spitfire fire area:m2', use_default='active', & - avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & - ivar=ivar, initialize=initialize_variables, index = ih_scorch_height_pa ) - call this%set_history_var(vname='fire_fuel_mef', units='m', & long='spitfire fuel moisture', use_default='active', & avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_fire_fuel_mef_pa ) - call this%set_history_var(vname='fire_fuel_bulkd', units='m', & + call this%set_history_var(vname='fire_fuel_bulkd', units='kg biomass/m3', & long='spitfire fuel bulk density', use_default='active', & avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_fire_fuel_bulkd_pa ) @@ -3622,7 +3932,7 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_fire_fuel_eff_moist_pa ) - call this%set_history_var(vname='fire_fuel_sav', units='m', & + call this%set_history_var(vname='fire_fuel_sav', units='per m', & long='spitfire fuel surface/volume ', use_default='active', & avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_fire_fuel_sav_pa ) @@ -3647,8 +3957,8 @@ subroutine define_history_vars(this, initialize_variables) call this%set_history_var(vname='LITTER_OUT', units='gC m-2 s-1', & long='FATES litter flux out', use_default='active', & - avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & - ivar=ivar, initialize=initialize_variables, index = ih_litter_out_pa ) + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_litter_out_si ) call this%set_history_var(vname='SEED_BANK', units='gC m-2', & long='Total Seed Mass of all PFTs', use_default='active', & @@ -3657,18 +3967,45 @@ subroutine define_history_vars(this, initialize_variables) call this%set_history_var(vname='SEEDS_IN', units='gC m-2 s-1', & long='Seed Production Rate', use_default='active', & - avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & - ivar=ivar, initialize=initialize_variables, index = ih_seeds_in_pa ) + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_seeds_in_si ) + + call this%set_history_var(vname='LITTER_IN_ELEM', units='kg m-2 d-1', & + long='FATES litter flux in', use_default='active', & + avgflag='A', vtype=site_elem_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_litter_in_elem ) + + call this%set_history_var(vname='LITTER_OUT_ELEM', units='kg m-2 d-1', & + long='FATES litter flux out (fragmentation only)', use_default='active', & + avgflag='A', vtype=site_elem_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_litter_out_elem ) + + call this%set_history_var(vname='SEED_BANK_ELEM', units='kg m-2', & + long='Total Seed Mass of all PFTs', use_default='active', & + avgflag='A', vtype=site_elem_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_seed_bank_elem ) + + call this%set_history_var(vname='SEEDS_IN_LOCAL_ELEM', units='kg m-2 d-1', & + long='Within Site Seed Production Rate', use_default='active', & + avgflag='A', vtype=site_elem_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_seeds_in_local_elem ) + + call this%set_history_var(vname='SEEDS_IN_EXTERN_ELEM', units='kg m-2 d-1', & + long='External Seed Influx Rate', use_default='active', & + avgflag='A', vtype=site_elem_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_seeds_in_extern_elem ) + + call this%set_history_var(vname='SEED_GERM_ELEM', units='kg m-2 d-1', & + long='Seed mass converted into new cohorts', use_default='active', & + avgflag='A', vtype=site_elem_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_seed_germ_elem ) + + call this%set_history_var(vname='SEED_DECAY', units='kg m-2 d-1', & + long='Seed mass decay', use_default='active', & + avgflag='A', vtype=site_elem_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_seed_decay_elem ) - call this%set_history_var(vname='SEED_GERMINATION', units='gC m-2 s-1', & - long='Seed mass converted into new cohorts', use_default='active', & - avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & - ivar=ivar, initialize=initialize_variables, index = ih_seed_germination_pa ) - call this%set_history_var(vname='SEED_DECAY', units='gC m-2 s-1', & - long='Seed mass decay', use_default='active', & - avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & - ivar=ivar, initialize=initialize_variables, index = ih_seed_decay_pa ) call this%set_history_var(vname='ED_bstore', units='gC m-2', & long='Storage biomass', use_default='active', & @@ -4073,6 +4410,12 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=site_agepft_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_biomass_si_agepft ) + call this%set_history_var(vname='SCORCH_HEIGHT',units = 'm', & + long='SPITFIRE Flame Scorch Height (calculated per PFT in each patch age bin)', & + use_default='active', & + avgflag='A', vtype=site_agepft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_scorch_height_si_agepft ) + ! Carbon Flux (grid dimension x scpf) (THESE ARE DEFAULT INACTIVE!!! ! (BECAUSE THEY TAKE UP SPACE!!! @@ -4718,47 +5061,43 @@ subroutine define_history_vars(this, initialize_variables) call this%set_history_var(vname='Fire_Closs', units='gC/m^2/s', & long='ED/SPitfire Carbon loss to atmosphere', use_default='active', & avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, & - upfreq=3, ivar=ivar, initialize=initialize_variables, index = ih_fire_c_to_atm_si ) - - call this%set_history_var(vname='NBP', units='gC/m^2/s', & - long='net biosphere production', use_default='active', & - avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, & - upfreq=3, ivar=ivar, initialize=initialize_variables, index = ih_nbp_si ) + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_fire_c_to_atm_si ) - call this%set_history_var(vname='TOTECOSYSC', units='gC/m^2', & - long='total ecosystem carbon', use_default='active', & + call this%set_history_var(vname='CBALANCE_ERROR_FATES', units='mgC/day', & + long='total carbon error, FATES', use_default='active', & avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, & - upfreq=3, ivar=ivar, initialize=initialize_variables, index = ih_totecosysc_si ) - - call this%set_history_var(vname='CBALANCE_ERROR_ED', units='gC/m^2/s', & - long='total carbon balance error on ED side', use_default='active', & - avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, & - upfreq=3, ivar=ivar, initialize=initialize_variables, index = ih_cbal_err_fates_si ) - - call this%set_history_var(vname='CBALANCE_ERROR_BGC', units='gC/m^2/s', & - long='total carbon balance error on HLMs BGC side', use_default='active', & - avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, & - upfreq=3, ivar=ivar, initialize=initialize_variables, index = ih_cbal_err_bgc_si ) - - call this%set_history_var(vname='CBALANCE_ERROR_TOTAL', units='gC/m^2/s', & - long='total carbon balance error total', use_default='active', & - avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, & - upfreq=3, ivar=ivar, initialize=initialize_variables, index = ih_cbal_err_tot_si ) - - call this%set_history_var(vname='BIOMASS_STOCK_COL', units='gC/m^2', & - long='total ED biomass carbon at the column level', use_default='active', & - avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, & - upfreq=3, ivar=ivar, initialize=initialize_variables, index = ih_biomass_stock_si ) - - call this%set_history_var(vname='ED_LITTER_STOCK_COL', units='gC/m^2', & - long='total ED litter carbon at the column level', use_default='active', & - avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, & - upfreq=3, ivar=ivar, initialize=initialize_variables, index = ih_litter_stock_si ) - - call this%set_history_var(vname='CWD_STOCK_COL', units='gC/m^2', & - long='total CWD carbon at the column level', use_default='active', & - avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, & - upfreq=3, ivar=ivar, initialize=initialize_variables, index = ih_cwd_stock_si ) + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_cbal_err_fates_si ) + + call this%set_history_var(vname='ERROR_FATES', units='mg/day', & + long='total error, FATES mass-balance', use_default='active', & + avgflag='A', vtype=site_elem_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_err_fates_si ) + + + call this%set_history_var(vname='LITTER_FINES_AG_ELEM', units='kg/m^2', & + long='mass of above ground litter in fines (leaves,nonviable seed)', use_default='active', & + avgflag='A', vtype=site_elem_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_fines_ag_elem ) + + call this%set_history_var(vname='LITTER_FINES_BG_ELEM', units='kg/m^2', & + long='mass of below ground litter in fines (fineroots)', use_default='active', & + avgflag='A', vtype=site_elem_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_fines_bg_elem ) + + call this%set_history_var(vname='LITTER_CWD_BG_ELEM', units='kg/m^2', & + long='mass of below ground litter in CWD (coarse roots)', use_default='active', & + avgflag='A', vtype=site_elem_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_cwd_bg_elem ) + + call this%set_history_var(vname='LITTER_CWD_AG_ELEM', units='kg/m^2', & + long='mass of above ground litter in CWD (trunks/branches/twigs)', use_default='active', & + avgflag='A', vtype=site_elem_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_cwd_ag_elem ) + + call this%set_history_var(vname='LITTER_CWD', units='kg/m^2', & + long='total mass of litter in CWD', use_default='active', & + avgflag='A', vtype=site_elcwd_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_cwd_elcwd ) ! organ-partitioned NPP / allocation fluxes call this%set_history_var(vname='NPP_LEAF', units='kgC/m2/yr', & diff --git a/main/FatesHistoryVariableType.F90 b/main/FatesHistoryVariableType.F90 index 8bdc5b2442..41451f0615 100644 --- a/main/FatesHistoryVariableType.F90 +++ b/main/FatesHistoryVariableType.F90 @@ -1,14 +1,29 @@ module FatesHistoryVariableType use FatesConstantsMod, only : r8 => fates_r8 - use FatesGlobals, only : fates_log + use FatesGlobals, only : fates_log + use FatesIODimensionsMod, only : fates_io_dimension_type use FatesIOVariableKindMod, only : fates_io_variable_kind_type + use FatesIOVariableKindMod, only : patch_r8, patch_ground_r8, patch_size_pft_r8 + use FatesIOVariableKindMod, only : site_r8, site_ground_r8, site_size_pft_r8 + use FatesIOVariableKindMod, only : site_size_r8, site_pft_r8, site_age_r8 + use FatesIOVariableKindMod, only : site_height_r8, patch_int + 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_elem_r8, site_elpft_r8 + use FatesIOVariableKindMod, only : site_elcwd_r8, site_elage_r8 + use FatesIOVariableKindMod, only : iotype_index implicit none + private ! By default everything is private + + ! Make public necessary subroutines and functions + ! This type is instanteated in the HLM-FATES interface (clmfates_interfaceMod.F90) - type fates_history_variable_type + type, public :: fates_history_variable_type character(len=32) :: vname character(len=24) :: units character(len=128) :: long @@ -31,8 +46,8 @@ module FatesHistoryVariableType integer, pointer :: int2d(:,:) integer, pointer :: int3d(:,:,:) contains - procedure, public :: Init - procedure, public :: Flush + procedure :: Init + procedure :: Flush procedure, private :: GetBounds end type fates_history_variable_type @@ -41,16 +56,7 @@ module FatesHistoryVariableType subroutine Init(this, vname, units, long, use_default, & vtype, avgflag, flushval, upfreq, num_dim_kinds, dim_kinds, dim_bounds) - use FatesIODimensionsMod, only : fates_io_dimension_type - use FatesIOVariableKindMod, only : patch_r8, patch_ground_r8, patch_size_pft_r8 - use FatesIOVariableKindMod, only : site_r8, site_ground_r8, site_size_pft_r8 - use FatesIOVariableKindMod, only : site_size_r8, site_pft_r8, site_age_r8 - use FatesIOVariableKindMod, only : site_height_r8 - 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 : iotype_index implicit none @@ -171,6 +177,22 @@ subroutine Init(this, vname, units, long, use_default, & allocate(this%r82d(lb1:ub1, lb2:ub2)) this%r82d(:,:) = flushval + case(site_elem_r8) + allocate(this%r82d(lb1:ub1, lb2:ub2)) + this%r82d(:,:) = flushval + + case(site_elpft_r8) + allocate(this%r82d(lb1:ub1, lb2:ub2)) + this%r82d(:,:) = flushval + + case(site_elcwd_r8) + allocate(this%r82d(lb1:ub1, lb2:ub2)) + this%r82d(:,:) = flushval + + case(site_elage_r8) + allocate(this%r82d(lb1:ub1, lb2:ub2)) + this%r82d(:,:) = flushval + case default write(fates_log(),*) 'Incompatible vtype passed to set_history_var' write(fates_log(),*) 'vtype = ',trim(vtype),' ?' @@ -235,15 +257,7 @@ subroutine GetBounds(this, thread, dim_bounds, dim_kinds, lb1, ub1, lb2, ub2) end subroutine GetBounds subroutine Flush(this, thread, dim_bounds, dim_kinds) - - use FatesIODimensionsMod, only : fates_io_dimension_type - use FatesIOVariableKindMod, only : patch_r8, patch_ground_r8, patch_size_pft_r8 - use FatesIOVariableKindMod, only : site_r8, site_ground_r8, site_size_pft_r8, patch_int - use FatesIOVariableKindMod, only : site_size_r8, site_pft_r8, site_age_r8 - use FatesIOVariableKindMod, only : site_height_r8 - 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 + implicit none @@ -295,6 +309,14 @@ subroutine Flush(this, thread, dim_bounds, dim_kinds) this%r82d(lb1:ub1, lb2:ub2) = this%flushval case(patch_int) this%int1d(lb1:ub1) = nint(this%flushval) + case(site_elem_r8) + this%r82d(lb1:ub1, lb2:ub2) = this%flushval + case(site_elpft_r8) + this%r82d(lb1:ub1, lb2:ub2) = this%flushval + case(site_elcwd_r8) + this%r82d(lb1:ub1, lb2:ub2) = this%flushval + case(site_elage_r8) + this%r82d(lb1:ub1, lb2:ub2) = this%flushval case default write(fates_log(),*) 'fates history variable type undefined while flushing history variables' stop diff --git a/main/FatesHydraulicsMemMod.F90 b/main/FatesHydraulicsMemMod.F90 index fad1790e03..32dcc16432 100644 --- a/main/FatesHydraulicsMemMod.F90 +++ b/main/FatesHydraulicsMemMod.F90 @@ -7,6 +7,7 @@ module FatesHydraulicsMemMod use EDParamsMod , only : hydr_psicap implicit none + private ! Number of soil layers for indexing cohort fine root quanitities ! NOTE: The hydraulics code does have some capacity to run a single soil @@ -15,67 +16,66 @@ module FatesHydraulicsMemMod ! communications with the LSM. Please do not set nlevsoi_hyd_max ! to 1 unless you are developing and testing. - - integer, parameter :: nlevsoi_hyd_max = 40 + integer, parameter, public :: nlevsoi_hyd_max = 40 ! number of distinct types of plant porous media (leaf, stem, troot, aroot) - integer, parameter :: n_porous_media = 4 + integer, parameter, public :: n_porous_media = 4 - integer, parameter :: n_hypool_leaf = 1 - integer, parameter :: n_hypool_stem = 1 - integer, parameter :: n_hypool_troot = 1 - integer, parameter :: n_hypool_aroot = 1 - integer, parameter :: nshell = 5 + integer, parameter, public :: n_hypool_leaf = 1 + integer, parameter, public :: n_hypool_stem = 1 + integer, parameter, public :: n_hypool_troot = 1 + integer, parameter, public :: n_hypool_aroot = 1 + integer, parameter, public :: nshell = 5 ! number of aboveground plant water storage nodes - integer, parameter :: n_hypool_ag = n_hypool_leaf+n_hypool_stem + integer, parameter, public :: n_hypool_ag = n_hypool_leaf+n_hypool_stem ! total number of water storage nodes - integer, parameter :: n_hypool_tot = n_hypool_ag + n_hypool_troot + n_hypool_aroot + nshell + integer, parameter, public :: n_hypool_tot = n_hypool_ag + n_hypool_troot + n_hypool_aroot + nshell ! vector indexing the type of porous medium over an arbitrary number of plant pools - integer, parameter,dimension(n_hypool_tot) :: porous_media = (/1,2,3,4,5,5,5,5,5/) + integer, parameter, public, dimension(n_hypool_tot) :: porous_media = (/1,2,3,4,5,5,5,5,5/) ! number of previous timestep's leaf water potential to be retained - integer, parameter :: numLWPmem = 4 + integer, parameter, public :: numLWPmem = 4 ! mirror of nlevcan, hard-set for simplicity, remove nlevcan_hyd on a rainy day ! Note (RGK): uscing nclmax causes annoying circular dependency (this needs EDTypes, EDTypes needs this) ! way around that: dynamic allocation, or just keep this, but set the value high - integer, parameter :: nlevcan_hyd = 2 + integer, parameter, public :: nlevcan_hyd = 2 ! Mean fine root radius expected in the bulk soil - real(r8), parameter :: fine_root_radius_const = 0.001_r8 + real(r8), parameter, public :: fine_root_radius_const = 0.001_r8 ! Constant parameters (for time being, C2B is constant, ! slated for addition to parameter file (RGK 08-2017)) ! Carbon 2 biomass ratio - real(r8), parameter :: C2B = 2.0_r8 + real(r8), parameter, public :: C2B = 2.0_r8 ! P-V curve: total RWC @ which elastic drainage begins [-] - real(r8), parameter,dimension(n_porous_media) :: rwcft = (/1.0_r8,0.958_r8,0.958_r8,0.958_r8/) + real(r8), parameter, public, dimension(n_porous_media) :: rwcft = (/1.0_r8,0.958_r8,0.958_r8,0.958_r8/) ! P-V curve: total RWC @ which capillary reserves exhausted - real(r8), parameter,dimension(n_porous_media) :: rwccap = (/1.0_r8,0.947_r8,0.947_r8,0.947_r8/) + real(r8), parameter, public, dimension(n_porous_media) :: rwccap = (/1.0_r8,0.947_r8,0.947_r8,0.947_r8/) ! Derived parameters ! ---------------------------------------------------------------------------------------------- ! P-V curve: slope of capillary region of curve - real(r8), dimension(n_porous_media) :: cap_slp + real(r8), public, dimension(n_porous_media) :: cap_slp ! P-V curve: intercept of capillary region of curve - real(r8), dimension(n_porous_media) :: cap_int + real(r8), public, dimension(n_porous_media) :: cap_int ! P-V curve: correction for nonzero psi0x - real(r8), dimension(n_porous_media) :: cap_corr + real(r8), public, dimension(n_porous_media) :: cap_corr !temporatory variables - real(r8) :: cohort_recruit_water_layer(nlevsoi_hyd_max) ! the recruit water requirement for a + real(r8), public :: cohort_recruit_water_layer(nlevsoi_hyd_max) ! the recruit water requirement for a ! single individual at different layer (kg H2o/m2) - real(r8) :: recruit_water_avail_layer(nlevsoi_hyd_max) ! the recruit water avaibility from soil (kg H2o/m2) + real(r8), public :: recruit_water_avail_layer(nlevsoi_hyd_max) ! the recruit water avaibility from soil (kg H2o/m2) - type ed_site_hydr_type + type, public :: ed_site_hydr_type ! Plant Hydraulics @@ -130,6 +130,7 @@ module FatesHydraulicsMemMod real(r8),allocatable :: psisoi_liq_innershell(:) ! Matric potential of the inner rhizosphere shell (MPa) + real(r8),allocatable :: recruit_w_uptake(:) ! recruitment water uptake (kg H2o/m2/s) @@ -184,7 +185,7 @@ module FatesHydraulicsMemMod !end type ed_patch_hydr_type - type ed_cohort_hydr_type + type, public :: ed_cohort_hydr_type ! BC...PLANT HYDRAULICS - "constants" that change with size. ! Heights are referenced to soil surface (+ = above; - = below) @@ -211,6 +212,8 @@ module FatesHydraulicsMemMod real(r8),allocatable :: v_aroot_layer_init(:) ! previous day's volume of absorbing roots by soil layer [m3] real(r8),allocatable :: v_aroot_layer(:) ! volume of absorbing roots by soil layer [m3] real(r8),allocatable :: l_aroot_layer(:) ! length of absorbing roots by soil layer [m] + + real(r8),allocatable :: kmax_innershell(:) ! Maximum hydraulic conductivity of the inner rhizosphere shell (kg s-1 MPa-1) ! BC PLANT HYDRAULICS - state variables real(r8) :: th_ag(n_hypool_ag) ! water in aboveground compartments [kgh2o/indiv] @@ -286,6 +289,9 @@ module FatesHydraulicsMemMod end type ed_cohort_hydr_type + ! Make public necessary subroutines and functions + public :: InitHydraulicsDerived + contains subroutine AllocateHydrCohortArrays(this,nlevsoil_hydr) @@ -307,6 +313,7 @@ subroutine AllocateHydrCohortArrays(this,nlevsoil_hydr) allocate(this%flc_min_aroot(1:nlevsoil_hydr)) allocate(this%errh2o_growturn_aroot(1:nlevsoil_hydr)) allocate(this%errh2o_pheno_aroot(1:nlevsoil_hydr)) + allocate(this%kmax_innershell(1:nlevsoil_hydr)) return end subroutine AllocateHydrCohortArrays @@ -329,6 +336,7 @@ subroutine DeallocateHydrCohortArrays(this) deallocate(this%flc_min_aroot) deallocate(this%errh2o_growturn_aroot) deallocate(this%errh2o_pheno_aroot) + deallocate(this%kmax_innershell) return end subroutine DeallocateHydrCohortArrays diff --git a/main/FatesIODimensionsMod.F90 b/main/FatesIODimensionsMod.F90 index 8c27ac3e13..152a951e63 100644 --- a/main/FatesIODimensionsMod.F90 +++ b/main/FatesIODimensionsMod.F90 @@ -3,27 +3,33 @@ module FatesIODimensionsMod use FatesConstantsMod, only : fates_short_string_length implicit none + private ! The following dimension names must be replicated in ! CLM/ALMs histFileMod.F90 and - character(*), parameter :: cohort = 'cohort' ! matches clm_varcon - character(*), parameter :: patch = 'patch' ! matches clm_varcon - character(*), parameter :: column = 'column' ! matches clm_varcon - character(*), parameter :: levgrnd = 'levgrnd' ! matches clm_varcon - character(*), parameter :: levscag = 'fates_levscag' ! matches histFileMod - character(*), parameter :: levscagpft = 'fates_levscagpf' ! matches histFileMod - character(*), parameter :: levagepft = 'fates_levagepft' ! matches histFileMod - character(*), parameter :: levscpf = 'fates_levscpf' ! matches histFileMod - character(*), parameter :: levscls = 'fates_levscls' ! matches histFileMod - character(*), parameter :: levpft = 'fates_levpft' ! matches histFileMod - character(*), parameter :: levage = 'fates_levage' ! matches histFileMod - character(*), parameter :: levheight = 'fates_levheight' ! matches histFileMod - character(*), parameter :: levfuel = 'fates_levfuel' ! matches histFileMod - character(*), parameter :: levcwdsc = 'fates_levcwdsc' ! matches histFileMod - character(*), parameter :: levcan = 'fates_levcan' ! matches histFileMod - character(*), parameter :: levcnlf = 'fates_levcnlf' ! matches histFileMod - character(*), parameter :: levcnlfpft = 'fates_levcnlfpf' ! matches histFileMod + character(*), parameter, public :: cohort = 'cohort' ! matches clm_varcon + character(*), parameter, public :: patch = 'patch' ! matches clm_varcon + character(*), parameter, public :: column = 'column' ! matches clm_varcon + character(*), parameter, public :: levgrnd = 'levgrnd' ! matches clm_varcon + character(*), parameter, public :: levscag = 'fates_levscag' ! matches histFileMod + character(*), parameter, public :: levscagpft = 'fates_levscagpf' ! matches histFileMod + character(*), parameter, public :: levagepft = 'fates_levagepft' ! matches histFileMod + character(*), parameter, public :: levscpf = 'fates_levscpf' ! matches histFileMod + character(*), parameter, public :: levscls = 'fates_levscls' ! matches histFileMod + character(*), parameter, public :: levpft = 'fates_levpft' ! matches histFileMod + character(*), parameter, public :: levage = 'fates_levage' ! matches histFileMod + character(*), parameter, public :: levheight = 'fates_levheight' ! matches histFileMod + character(*), parameter, public :: levfuel = 'fates_levfuel' ! matches histFileMod + character(*), parameter, public :: levcwdsc = 'fates_levcwdsc' ! matches histFileMod + 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 :: levelem = 'fates_levelem' + character(*), parameter, public :: levelpft = 'fates_levelpft' + character(*), parameter, public :: levelcwd = 'fates_levelcwd' + character(*), parameter, public :: levelage = 'fates_levelage' ! patch = This is a structure that records where FATES patch boundaries ! on each thread point to in the host IO array, this structure @@ -76,6 +82,12 @@ module FatesIODimensionsMod ! number of patch age x pft + ! levelem = This records the boundaries for the number of elements + ! levelpft = This records the boundaries for elements x pft + ! levelcwd = This records the boundaries for element x cwd + ! levelage = This records the boundaries for element x age + + type, public :: fates_bounds_type integer :: patch_begin integer :: patch_end @@ -111,27 +123,31 @@ module FatesIODimensionsMod integer :: cnlf_end integer :: cnlfpft_begin integer :: cnlfpft_end + integer :: elem_begin + integer :: elem_end + integer :: elpft_begin + integer :: elpft_end + integer :: elcwd_begin + integer :: elcwd_end + integer :: elage_begin + integer :: elage_end end type fates_bounds_type ! This structure is not allocated by thread, but the upper and lower boundaries ! of the dimension for each thread is saved in the clump_ entry - type fates_io_dimension_type + type, public :: fates_io_dimension_type character(len=fates_short_string_length) :: name integer :: lower_bound integer :: upper_bound integer, allocatable :: clump_lower_bound(:) ! lower bound of thread's portion of HIO array integer, allocatable :: clump_upper_bound(:) ! upper bound of thread's portion of HIO array contains - procedure, public :: Init - procedure, public :: SetThreadBounds + procedure :: Init + procedure :: SetThreadBounds end type fates_io_dimension_type - - - - contains ! ===================================================================================== diff --git a/main/FatesIOVariableKindMod.F90 b/main/FatesIOVariableKindMod.F90 index 8394d55f3b..7d6ae688c3 100644 --- a/main/FatesIOVariableKindMod.F90 +++ b/main/FatesIOVariableKindMod.F90 @@ -5,32 +5,40 @@ module FatesIOVariableKindMod use FatesIODimensionsMod, only : fates_io_dimension_type implicit none + private ! FIXME(bja, 2016-10) do these need to be strings, or can they be integer enumerations? ! FIXME(rgk, 2016-11) these should probably be moved to varkindmod? - character(*), parameter :: patch_r8 = 'PA_R8' - character(*), parameter :: patch_ground_r8 = 'PA_GRND_R8' - character(*), parameter :: patch_size_pft_r8 = 'PA_SCPF_R8' - character(*), parameter :: site_r8 = 'SI_R8' - character(*), parameter :: site_int = 'SI_INT' - character(*), parameter :: site_ground_r8 = 'SI_GRND_R8' - character(*), parameter :: site_size_pft_r8 = 'SI_SCPF_R8' - character(*), parameter :: site_size_r8 = 'SI_SCLS_R8' - character(*), parameter :: patch_int = 'PA_INT' - character(*), parameter :: cohort_r8 = 'CO_R8' - character(*), parameter :: cohort_int = 'CO_INT' - character(*), parameter :: site_pft_r8 = 'SI_PFT_R8' - character(*), parameter :: site_age_r8 = 'SI_AGE_R8' - character(*), parameter :: site_height_r8 = 'SI_HEIGHT_R8' - character(*), parameter :: site_fuel_r8 = 'SI_FUEL_R8' - character(*), parameter :: site_cwdsc_r8 = 'SI_CWDSC_R8' - character(*), parameter :: site_can_r8 = 'SI_CAN_R8' - character(*), parameter :: site_cnlf_r8 = 'SI_CNLF_R8' - character(*), parameter :: site_cnlfpft_r8 = 'SI_CNLFPFT_R8' - character(*), parameter :: site_scag_r8 = 'SI_SCAG_R8' - character(*), parameter :: site_scagpft_r8 = 'SI_SCAGPFT_R8' - character(*), parameter :: site_agepft_r8 = 'SI_AGEPFT_R8' + character(*), parameter, public :: patch_r8 = 'PA_R8' + character(*), parameter, public :: patch_ground_r8 = 'PA_GRND_R8' + character(*), parameter, public :: patch_size_pft_r8 = 'PA_SCPF_R8' + character(*), parameter, public :: site_r8 = 'SI_R8' + character(*), parameter, public :: site_int = 'SI_INT' + character(*), parameter, public :: site_ground_r8 = 'SI_GRND_R8' + character(*), parameter, public :: site_size_pft_r8 = 'SI_SCPF_R8' + character(*), parameter, public :: site_size_r8 = 'SI_SCLS_R8' + character(*), parameter, public :: patch_int = 'PA_INT' + character(*), parameter, public :: cohort_r8 = 'CO_R8' + character(*), parameter, public :: cohort_int = 'CO_INT' + character(*), parameter, public :: site_pft_r8 = 'SI_PFT_R8' + character(*), parameter, public :: site_age_r8 = 'SI_AGE_R8' + character(*), parameter, public :: site_height_r8 = 'SI_HEIGHT_R8' + character(*), parameter, public :: site_fuel_r8 = 'SI_FUEL_R8' + character(*), parameter, public :: site_cwdsc_r8 = 'SI_CWDSC_R8' + 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_scag_r8 = 'SI_SCAG_R8' + character(*), parameter, public :: site_scagpft_r8 = 'SI_SCAGPFT_R8' + character(*), parameter, public :: site_agepft_r8 = 'SI_AGEPFT_R8' + + ! Element, and multiplexed element dimensions + character(*), parameter, public :: site_elem_r8 = 'SI_ELEM_R8' + character(*), parameter, public :: site_elpft_r8 = 'SI_ELEMPFT_R8' + character(*), parameter, public :: site_elcwd_r8 = 'SI_ELEMCWD_R8' + character(*), parameter, public :: site_elage_r8 = 'SI_ELEMAGE_R8' + ! NOTE(RGK, 2016) %active is not used yet. Was intended as a check on the HLM->FATES ! control parameter passing to ensure all active dimension types received all @@ -38,7 +46,7 @@ module FatesIOVariableKindMod ! passing functions.. ! This structure is not multi-threaded - type fates_io_variable_kind_type + type, public :: fates_io_variable_kind_type character(len=fates_long_string_length) :: name ! String labelling this IO type integer :: ndims ! number of dimensions in this IO type integer, allocatable :: dimsize(:) ! The size of each dimension @@ -48,13 +56,14 @@ module FatesIOVariableKindMod contains - procedure, public :: Init - procedure, public :: set_active - procedure, public :: is_active + procedure :: Init + procedure :: set_active + procedure :: is_active end type fates_io_variable_kind_type - + ! Make necessary functions public + public :: iotype_index contains diff --git a/main/FatesIntegratorsMod.F90 b/main/FatesIntegratorsMod.F90 index 5171180184..8da6109777 100644 --- a/main/FatesIntegratorsMod.F90 +++ b/main/FatesIntegratorsMod.F90 @@ -3,8 +3,11 @@ module FatesIntegratorsMod use FatesConstantsMod, only : r8 => fates_r8 implicit none - integer, parameter :: max_states = 20 + private + + integer, parameter, public :: max_states = 20 + ! Make public necessary subroutines and functions public :: RKF45 public :: Euler diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index b080894d38..0254c89123 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -19,20 +19,29 @@ module FatesInterfaceMod use EDTypesMod , only : nlevleaf use EDTypesMod , only : maxpft use EDTypesMod , only : do_fates_salinity - use EDTypesMod , only : ncwd use EDTypesMod , only : numWaterMem + use EDTypesMod , only : numlevsoil_max + use EDTypesMod , only : num_elements + use EDTypesMod , only : element_list + use EDTypesMod , only : element_pos use FatesConstantsMod , only : r8 => fates_r8 use FatesConstantsMod , only : itrue,ifalse use FatesGlobals , only : fates_global_verbose use FatesGlobals , only : fates_log use FatesGlobals , only : endrun => fates_endrun + use FatesLitterMod , only : ncwd + use FatesLitterMod , only : ndcmpy use EDPftvarcon , only : FatesReportPFTParams use EDPftvarcon , only : FatesCheckParams use EDPftvarcon , only : EDPftvarcon_inst + use SFParamsMod , only : SpitFireCheckParams use EDParamsMod , only : FatesReportParams use EDParamsMod , only : bgc_soil_salinity use PRTGenericMod , only : prt_carbon_allom_hyp use PRTGenericMod , only : prt_cnp_flex_allom_hyp + use PRTGenericMod , only : carbon12_element + use PRTGenericMod , only : nitrogen_element + use PRTGenericMod , only : phosphorus_element use PRTAllometricCarbonMod, only : InitPRTGlobalAllometricCarbon ! use PRTAllometricCNPMod, only : InitPRTGlobalAllometricCNP @@ -45,15 +54,6 @@ module FatesInterfaceMod private ! By default everything is private - public :: FatesInterfaceInit - public :: set_fates_ctrlparms - public :: SetFatesTime - public :: set_fates_global_elements - public :: FatesReportParameters - public :: InitPARTEHGlobals - public :: allocate_bcin - public :: allocate_bcout - character(len=*), parameter, private :: sourcefile = & __FILE__ @@ -210,6 +210,7 @@ module FatesInterfaceMod integer , public, allocatable :: fates_hdim_levfuel(:) ! fire fuel class dimension integer , public, allocatable :: fates_hdim_levcwdsc(:) ! cwd class dimension integer , public, allocatable :: fates_hdim_levcan(:) ! canopy-layer dimension + integer , public, allocatable :: fates_hdim_levelem(:) ! element dimension integer , public, allocatable :: fates_hdim_canmap_levcnlf(:) ! canopy-layer map into the canopy-layer x leaf-layer dim integer , public, allocatable :: fates_hdim_lfmap_levcnlf(:) ! leaf-layer map into the can-layer x leaf-layer dimension integer , public, allocatable :: fates_hdim_canmap_levcnlfpf(:) ! can-layer map into the can-layer x pft x leaf-layer dim @@ -222,6 +223,14 @@ module FatesInterfaceMod integer , public, allocatable :: fates_hdim_pftmap_levscagpft(:) ! map of pft into size-class x patch age x pft dimension integer , public, allocatable :: fates_hdim_agmap_levagepft(:) ! map of patch-age into patch age x pft dimension integer , public, allocatable :: fates_hdim_pftmap_levagepft(:) ! map of pft into patch age x pft dimension + + integer , public, allocatable :: fates_hdim_elmap_levelpft(:) ! map of elements in the element x pft dimension + integer , public, allocatable :: fates_hdim_elmap_levelcwd(:) ! map of elements in the element x cwd dimension + integer , public, allocatable :: fates_hdim_elmap_levelage(:) ! map of elements in the element x age dimension + integer , public, allocatable :: fates_hdim_pftmap_levelpft(:) ! map of pfts in the element x pft dimension + integer , public, allocatable :: fates_hdim_cwdmap_levelcwd(:) ! map of cwds in the element x cwd dimension + integer , public, allocatable :: fates_hdim_agemap_levelage(:) ! map of ages in the element x age dimension + ! ------------------------------------------------------------------------------------ ! DYNAMIC BOUNDARY CONDITIONS @@ -290,11 +299,17 @@ module FatesInterfaceMod real(r8),allocatable :: dz_sisl(:) ! layer thickness (m) real(r8),allocatable :: z_sisl(:) ! layer depth (m) - - - ! Decomposition Layer Structure - real(r8), allocatable :: dz_decomp_sisl(:) + real(r8), allocatable :: dz_decomp_sisl(:) ! This should match dz_sisl(), unless + ! only one layer is chosen, in that + ! case, it has its own depth, which + ! has traditionally been 1 meter + + integer,allocatable :: decomp_id(:) ! The decomposition layer index that each + ! soil layer maps to. This will either + ! be equivalent (ie integer ascending) + ! Or, all will be 1. + ! Vegetation Dynamics ! --------------------------------------------------------------------------------- @@ -512,19 +527,18 @@ module FatesInterfaceMod real(r8), allocatable :: ftii_parb(:,:) - ! litterfall fluxes of C from FATES patches to BGC columns - - ! total labile litter coming from ED. gC/m3/s - real(r8), allocatable :: FATES_c_to_litr_lab_c_col(:) - - !total cellulose litter coming from ED. gC/m3/s - real(r8), allocatable :: FATES_c_to_litr_cel_c_col(:) + ! Mass fluxes to BGC from fragmentation of litter into decomposing pools - !total lignin litter coming from ED. gC/m3/s - real(r8), allocatable :: FATES_c_to_litr_lig_c_col(:) - + real(r8), allocatable :: litt_flux_cel_c_si(:) ! cellulose carbon litter, fates->BGC g/m3/s + real(r8), allocatable :: litt_flux_lig_c_si(:) ! lignan carbon litter, fates->BGC g/m3/s + real(r8), allocatable :: litt_flux_lab_c_si(:) ! labile carbon litter, fates->BGC g/m3/s + real(r8), allocatable :: litt_flux_cel_n_si(:) ! cellulose nitrogen litter, fates->BGC g/m3/s + real(r8), allocatable :: litt_flux_lig_n_si(:) ! lignan nitrogen litter, fates->BGC g/m3/s + real(r8), allocatable :: litt_flux_lab_n_si(:) ! labile nitrogen litter, fates->BGC g/m3/s + real(r8), allocatable :: litt_flux_cel_p_si(:) ! cellulose phosphorus litter, fates->BGC g/m3/s + real(r8), allocatable :: litt_flux_lig_p_si(:) ! lignan phosphorus litter, fates->BGC g/m3/s + real(r8), allocatable :: litt_flux_lab_p_si(:) ! labile phosphorus litter, fates->BGC g/m3/s - ! Canopy Structure real(r8), allocatable :: elai_pa(:) ! exposed leaf area index @@ -597,8 +611,16 @@ module FatesInterfaceMod end type fates_interface_type - - + + ! Make public necessary subroutines and functions + public :: FatesInterfaceInit + public :: set_fates_ctrlparms + public :: SetFatesTime + public :: set_fates_global_elements + public :: FatesReportParameters + public :: InitPARTEHGlobals + public :: allocate_bcin + public :: allocate_bcout contains @@ -655,12 +677,57 @@ subroutine allocate_bcin(bc_in, nlevsoil_in, nlevdecomp_in) bc_in%nlevsoil = nlevsoil_in + + if(nlevsoil_in > numlevsoil_max) then + write(fates_log(), *) 'The number of soil layers imposed by the host model' + write(fates_log(), *) 'is larger than what we have allocated in our static' + write(fates_log(), *) 'arrays. Please increase the size of numlevsoil_max' + write(fates_log(), *) 'found in EDTypesMod.F90' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + if( (nlevsoil_in*ndcmpy) > fates_maxElementsPerPatch .or. & + (nlevsoil_in*ncwd) > fates_maxElementsPerPatch) then + write(fates_log(), *) 'The restart files require that space is allocated' + write(fates_log(), *) 'to accomodate the multi-dimensional patch arrays' + write(fates_log(), *) 'that are nlevsoil*numpft and nlevsoil*ncwd' + write(fates_log(), *) 'fates_maxElementsPerPatch = ',fates_maxElementsPerPatch + write(fates_log(), *) 'nlevsoil = ',nlevsoil_in + write(fates_log(), *) 'dcmpy = ',ndcmpy + write(fates_log(), *) 'ncwd = ',ncwd + write(fates_log(), *) 'numpft*nlevsoil = ',nlevsoil_in*numpft + write(fates_log(), *) 'ncwd*nlevsoil = ',ncwd * nlevsoil_in + write(fates_log(), *) 'To increase max_elements, change numlevsoil_max' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + bc_in%nlevdecomp = nlevdecomp_in + + if (hlm_use_vertsoilc == itrue) then + if(bc_in%nlevdecomp .ne. bc_in%nlevsoil) then + write(fates_log(), *) 'The host has signaled a vertically resolved' + write(fates_log(), *) 'soil decomposition model. Therefore, the ' + write(fates_log(), *) 'total number of soil layers should equal the' + write(fates_log(), *) 'total number of decomposition layers.' + write(fates_log(), *) 'nlevdecomp: ',bc_in%nlevdecomp + write(fates_log(), *) 'nlevsoil: ',bc_in%nlevsoil + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + else + if(bc_in%nlevdecomp .ne. 1)then + write(fates_log(), *) 'The host has signaled a non-vertically resolved' + write(fates_log(), *) 'soil decomposition model. Therefore, the ' + write(fates_log(), *) 'total number of decomposition layers should be 1.' + write(fates_log(), *) 'nlevdecomp: ',bc_in%nlevdecomp + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + end if + allocate(bc_in%zi_sisl(0:nlevsoil_in)) allocate(bc_in%dz_sisl(nlevsoil_in)) allocate(bc_in%z_sisl(nlevsoil_in)) - + allocate(bc_in%decomp_id(nlevsoil_in)) allocate(bc_in%dz_decomp_sisl(nlevdecomp_in)) ! Vegetation Dynamics @@ -683,7 +750,7 @@ subroutine allocate_bcin(bc_in, nlevsoil_in, nlevdecomp_in) !BGC if(do_fates_salinity) then - allocate(bc_in%salinity_sl(nlevsoil_in)) + allocate(bc_in%salinity_sl(nlevsoil_in)) endif ! Photosynthesis @@ -756,10 +823,29 @@ subroutine allocate_bcout(bc_out, nlevsoil_in, nlevdecomp_in) allocate(bc_out%ftid_parb(maxPatchesPerSite,hlm_numSWb)) allocate(bc_out%ftii_parb(maxPatchesPerSite,hlm_numSWb)) - ! biogeochemistry - allocate(bc_out%FATES_c_to_litr_lab_c_col(nlevdecomp_in)) - allocate(bc_out%FATES_c_to_litr_cel_c_col(nlevdecomp_in)) - allocate(bc_out%FATES_c_to_litr_lig_c_col(nlevdecomp_in)) + ! Fates -> BGC fragmentation mass fluxes + select case(hlm_parteh_mode) + case(prt_carbon_allom_hyp) + allocate(bc_out%litt_flux_cel_c_si(nlevdecomp_in)) + allocate(bc_out%litt_flux_lig_c_si(nlevdecomp_in)) + allocate(bc_out%litt_flux_lab_c_si(nlevdecomp_in)) + case(prt_cnp_flex_allom_hyp) + allocate(bc_out%litt_flux_cel_c_si(nlevdecomp_in)) + allocate(bc_out%litt_flux_lig_c_si(nlevdecomp_in)) + allocate(bc_out%litt_flux_lab_c_si(nlevdecomp_in)) + allocate(bc_out%litt_flux_cel_n_si(nlevdecomp_in)) + allocate(bc_out%litt_flux_lig_n_si(nlevdecomp_in)) + allocate(bc_out%litt_flux_lab_n_si(nlevdecomp_in)) + allocate(bc_out%litt_flux_cel_p_si(nlevdecomp_in)) + allocate(bc_out%litt_flux_lig_p_si(nlevdecomp_in)) + allocate(bc_out%litt_flux_lab_p_si(nlevdecomp_in)) + case default + write(fates_log(), *) 'An unknown parteh hypothesis was passed' + write(fates_log(), *) 'to the site level output boundary conditions' + write(fates_log(), *) 'hlm_parteh_mode: ',hlm_parteh_mode + call endrun(msg=errMsg(sourcefile, __LINE__)) + end select + ! Canopy Structure allocate(bc_out%elai_pa(maxPatchesPerSite)) @@ -793,14 +879,6 @@ subroutine zero_bcs(this,s) integer, intent(in) :: s ! Input boundaries - ! Warning: these "z" type variables - ! are written only once at the beginning - ! so THIS ROUTINE SHOULD NOT BE CALLED AFTER - ! INITIALIZATION - this%bc_in(s)%zi_sisl(:) = 0.0_r8 - this%bc_in(s)%dz_sisl(:) = 0.0_r8 - this%bc_in(s)%z_sisl(:) = 0.0_r8 - this%bc_in(s)%dz_decomp_sisl = 0.0_r8 this%bc_in(s)%t_veg24_si = 0.0_r8 this%bc_in(s)%t_veg24_pa(:) = 0.0_r8 @@ -851,9 +929,30 @@ subroutine zero_bcs(this,s) this%bc_out(s)%rootr_pasl(:,:) = 0.0_r8 this%bc_out(s)%btran_pa(:) = 0.0_r8 - this%bc_out(s)%FATES_c_to_litr_lab_c_col(:) = 0.0_r8 - this%bc_out(s)%FATES_c_to_litr_cel_c_col(:) = 0.0_r8 - this%bc_out(s)%FATES_c_to_litr_lig_c_col(:) = 0.0_r8 + ! Fates -> BGC fragmentation mass fluxes + select case(hlm_parteh_mode) + case(prt_carbon_allom_hyp) + this%bc_out(s)%litt_flux_cel_c_si(:) = 0._r8 + this%bc_out(s)%litt_flux_lig_c_si(:) = 0._r8 + this%bc_out(s)%litt_flux_lab_c_si(:) = 0._r8 + case(prt_cnp_flex_allom_hyp) + this%bc_out(s)%litt_flux_cel_c_si(:) = 0._r8 + this%bc_out(s)%litt_flux_lig_c_si(:) = 0._r8 + this%bc_out(s)%litt_flux_lab_c_si(:) = 0._r8 + this%bc_out(s)%litt_flux_cel_n_si(:) = 0._r8 + this%bc_out(s)%litt_flux_lig_n_si(:) = 0._r8 + this%bc_out(s)%litt_flux_lab_n_si(:) = 0._r8 + this%bc_out(s)%litt_flux_cel_p_si(:) = 0._r8 + this%bc_out(s)%litt_flux_lig_p_si(:) = 0._r8 + this%bc_out(s)%litt_flux_lab_p_si(:) = 0._r8 + case default + write(fates_log(), *) 'An unknown parteh hypothesis was passed' + write(fates_log(), *) 'while zeroing output boundary conditions' + write(fates_log(), *) 'hlm_parteh_mode: ',hlm_parteh_mode + call endrun(msg=errMsg(sourcefile, __LINE__)) + end select + + this%bc_out(s)%rssun_pa(:) = 0.0_r8 this%bc_out(s)%rssha_pa(:) = 0.0_r8 @@ -984,7 +1083,7 @@ subroutine set_fates_global_elements(use_fates) ! These values are used to define the restart file allocations and general structure ! of memory for the cohort arrays - fates_maxElementsPerPatch = max(maxCohortsPerPatch, numpft, ncwd ) + fates_maxElementsPerPatch = max(maxCohortsPerPatch, ndcmpy*numlevsoil_max ,ncwd*numlevsoil_max) if (maxPatchesPerSite * fates_maxElementsPerPatch < numWaterMem) then write(fates_log(), *) 'By using such a tiny number of maximum patches and maximum cohorts' @@ -1059,7 +1158,6 @@ end subroutine set_fates_global_elements subroutine fates_history_maps use EDTypesMod, only : NFSC - use EDTypesMod, only : NCWD use EDTypesMod, only : nclmax use EDTypesMod, only : nlevleaf use EDParamsMod, only : ED_val_history_sizeclass_bin_edges @@ -1083,6 +1181,7 @@ subroutine fates_history_maps integer :: ileaf integer :: iage integer :: iheight + integer :: iel allocate( fates_hdim_levsclass(1:nlevsclass )) allocate( fates_hdim_pfmap_levscpf(1:nlevsclass*numpft)) @@ -1094,6 +1193,7 @@ subroutine fates_history_maps allocate( fates_hdim_levheight(1:nlevheight )) allocate( fates_hdim_levcan(nclmax)) + allocate( fates_hdim_levelem(num_elements)) allocate( fates_hdim_canmap_levcnlf(nlevleaf*nclmax)) allocate( fates_hdim_lfmap_levcnlf(nlevleaf*nclmax)) allocate( fates_hdim_canmap_levcnlfpf(nlevleaf*nclmax*numpft)) @@ -1107,6 +1207,14 @@ subroutine fates_history_maps allocate( fates_hdim_agmap_levagepft(nlevage * numpft)) allocate( fates_hdim_pftmap_levagepft(nlevage * numpft)) + allocate( fates_hdim_elmap_levelpft(num_elements*numpft)) + allocate( fates_hdim_elmap_levelcwd(num_elements*ncwd)) + allocate( fates_hdim_elmap_levelage(num_elements*nlevage)) + allocate( fates_hdim_pftmap_levelpft(num_elements*numpft)) + allocate( fates_hdim_cwdmap_levelcwd(num_elements*ncwd)) + allocate( fates_hdim_agemap_levelage(num_elements*nlevage)) + + ! Fill the IO array of plant size classes fates_hdim_levsclass(:) = ED_val_history_sizeclass_bin_edges(:) fates_hdim_levage(:) = ED_val_history_ageclass_bin_edges(:) @@ -1132,6 +1240,39 @@ subroutine fates_history_maps fates_hdim_levcan(ican) = ican end do + ! Make an element array, each index is the PARTEH global identifier index + + do iel = 1, num_elements + fates_hdim_levelem(iel) = element_list(iel) + end do + + i = 0 + do iel = 1, num_elements + do ipft=1,numpft + i = i+1 + fates_hdim_elmap_levelpft(i) = iel + fates_hdim_pftmap_levelpft(i) = ipft + end do + end do + + i = 0 + do iel = 1, num_elements + do icwd = 1, ncwd + i = i+1 + fates_hdim_elmap_levelcwd(i) = iel + fates_hdim_cwdmap_levelcwd(i) = icwd + end do + end do + + i = 0 + do iel = 1, num_elements + do iage=1,nlevage + i = i+1 + fates_hdim_elmap_levelage(i) = iel + fates_hdim_agemap_levelage(i) = iage + end do + end do + ! Fill the IO arrays that match pft and size class to their combined array i=0 do ipft=1,numpft @@ -1640,7 +1781,8 @@ subroutine FatesReportParameters(masterproc) call FatesReportPFTParams(masterproc) call FatesReportParams(masterproc) call FatesCheckParams(masterproc,hlm_parteh_mode) - + call SpitFireCheckParams(masterproc) + return end subroutine FatesReportParameters @@ -1650,14 +1792,34 @@ subroutine InitPARTEHGlobals() ! Initialize the Plant Allocation and Reactive Transport ! global functions and mapping tables + ! Also associate the elements defined in PARTEH with a list in FATES + ! "element_list" is useful because it allows the fates side of the code + ! to loop through elements, and call the correct PARTEH interfaces + ! automatically. select case(hlm_parteh_mode) case(prt_carbon_allom_hyp) + num_elements = 1 + allocate(element_list(num_elements)) + element_list(1) = carbon12_element + element_pos(:) = 0 + element_pos(carbon12_element) = 1 + call InitPRTGlobalAllometricCarbon() case(prt_cnp_flex_allom_hyp) + num_elements = 3 + allocate(element_list(num_elements)) + element_list(1) = carbon12_element + element_list(2) = nitrogen_element + element_list(3) = phosphorus_element + element_pos(:) = 0 + element_pos(carbon12_element) = 1 + element_pos(nitrogen_element) = 2 + element_pos(phosphorus_element) = 3 + !call InitPRTGlobalAllometricCNP() write(fates_log(),*) 'You specified the allometric CNP mode' write(fates_log(),*) 'with relaxed target stoichiometry.' diff --git a/main/FatesInventoryInitMod.F90 b/main/FatesInventoryInitMod.F90 index e7d45f1708..acde01b651 100644 --- a/main/FatesInventoryInitMod.F90 +++ b/main/FatesInventoryInitMod.F90 @@ -30,21 +30,38 @@ module FatesInventoryInitMod use FatesGlobals , only : fates_log use FatesInterfaceMod, only : bc_in_type use FatesInterfaceMod, only : hlm_inventory_ctrl_file + use FatesInterfaceMod, only : nleafage + use FatesLitterMod , only : litter_type 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 : equal_leaf_aclass use EDTypesMod , only : leaves_on use EDTypesMod , only : leaves_off + use EDTypesMod , only : num_elements + use EDTypesMod , only : element_list use EDTypesMod , only : phen_cstat_nevercold use EDTypesMod , only : phen_cstat_iscold use EDTypesMod , only : phen_dstat_timeoff use EDTypesMod , only : phen_dstat_moistoff use EDPftvarcon , only : EDPftvarcon_inst + use FatesInterfaceMod, only : hlm_parteh_mode + use EDCohortDynamicsMod, only : InitPRTObject + use PRTGenericMod, only : prt_carbon_allom_hyp + use PRTGenericMod, only : prt_cnp_flex_allom_hyp + use PRTGenericMod, only : prt_vartypes + use PRTGenericMod, only : leaf_organ + use PRTGenericMod, only : fnrt_organ + use PRTGenericMod, only : sapw_organ + use PRTGenericMod, only : store_organ + use PRTGenericMod, only : struct_organ + use PRTGenericMod, only : repro_organ + use PRTGenericMod, only : carbon12_element + use PRTGenericMod, only : nitrogen_element + use PRTGenericMod, only : phosphorus_element + use PRTGenericMod, only : SetState use FatesConstantsMod, only : primaryforest - implicit none private @@ -73,6 +90,9 @@ module FatesInventoryInitMod ! defined in model memory and a physical ! site listed in the file + logical, parameter :: do_inventory_out = .false. + + public :: initialize_sites_by_inventory contains @@ -84,14 +104,13 @@ subroutine initialize_sites_by_inventory(nsites,sites,bc_in) ! !USES: use shr_file_mod, only : shr_file_getUnit use shr_file_mod, only : shr_file_freeUnit - use EDTypesMod, only : nclmax - use EDTypesMod, only : maxpft - use EDTypesMod, only : ncwd + use FatesConstantsMod, only : nearzero use EDPatchDynamicsMod, only : create_patch use EDPatchDynamicsMod, only : fuse_patches use EDCohortDynamicsMod, only : fuse_cohorts use EDCohortDynamicsMod, only : sort_cohorts use EDcohortDynamicsMod, only : count_cohorts + use EDPatchDynamicsMod, only : patch_pft_size_profile ! Arguments integer, intent(in) :: nsites @@ -104,6 +123,8 @@ subroutine initialize_sites_by_inventory(nsites,sites,bc_in) type(ed_cohort_type), pointer :: currentcohort type(ed_patch_type), pointer :: newpatch type(ed_patch_type), pointer :: olderpatch + type(ed_patch_type), pointer :: head_of_unsorted_patch_list + type(ed_patch_type), pointer :: next_in_unsorted_patch_list integer :: sitelist_file_unit ! fortran file unit for site list integer :: pss_file_unit ! fortran file unit for the pss file integer :: css_file_unit ! fortran file unit for the css file @@ -114,20 +135,18 @@ subroutine initialize_sites_by_inventory(nsites,sites,bc_in) character(len=line_strlen) :: header_str ! large string for whole lines real(r8) :: age_init ! dummy value for creating a patch real(r8) :: area_init ! dummy value for creating a patch - real(r8) :: cwd_ag_init(ncwd) ! dummy value for creating a patch - real(r8) :: cwd_bg_init(ncwd) ! dummy value for creating a patch - real(r8) :: leaf_litter_init(maxpft) ! dummy value for creating a patch - real(r8) :: root_litter_init(maxpft) ! dummy value for creating a patch integer :: s ! site index integer :: ipa ! patch index integer :: total_cohorts ! cohort counter for error checking integer, allocatable :: inv_format_list(:) ! list of format specs character(len=path_strlen), allocatable :: inv_css_list(:) ! list of css file names character(len=path_strlen), allocatable :: inv_pss_list(:) ! list of pss file names + real(r8), allocatable :: inv_lat_list(:) ! list of lat coords real(r8), allocatable :: inv_lon_list(:) ! list of lon coords integer :: invsite ! index of inventory site ! closest to actual site + integer :: el ! loop counter for number of elements character(len=patchname_strlen) :: patch_name ! patch ID string in the file integer :: npatches ! number of patches found in PSS type(pp_array), allocatable :: patch_pointer_vec(:) ! vector of pointers to patch LL @@ -135,13 +154,12 @@ subroutine initialize_sites_by_inventory(nsites,sites,bc_in) real(r8) :: basal_area_postf ! basal area before fusion (m2/ha) real(r8) :: basal_area_pref ! basal area after fusion (m2/ha) - real(r8), parameter :: max_ba_diff = 1.0e-2 ! 1% is the maximum allowable - ! change in BA due to fusion - ! I. Load the inventory list file, do some file handle checks ! ------------------------------------------------------------------------------------------ sitelist_file_unit = shr_file_getUnit() + + inquire(file=trim(hlm_inventory_ctrl_file),exist=lexist,opened=lopen) if( .not.lexist ) then ! The inventory file list DNE write(fates_log(), *) 'An inventory Initialization was requested.' @@ -256,14 +274,9 @@ subroutine initialize_sites_by_inventory(nsites,sites,bc_in) age_init = 0.0_r8 area_init = 0.0_r8 - cwd_ag_init(:) = 0.0_r8 - cwd_bg_init(:) = 0.0_r8 - leaf_litter_init(:) = 0.0_r8 - root_litter_init(:) = 0.0_r8 - call create_patch(sites(s), newpatch, age_init, area_init, & - cwd_ag_init, cwd_bg_init, & - leaf_litter_init, root_litter_init, bc_in(s)%nlevsoil, primaryforest ) + call create_patch(sites(s), newpatch, age_init, area_init, primaryforest ) + if( inv_format_list(invsite) == 1 ) then call set_inventory_edpatch_type1(newpatch,pss_file_unit,ipa,ios,patch_name) @@ -371,6 +384,84 @@ subroutine initialize_sites_by_inventory(nsites,sites,bc_in) deallocate(patch_pointer_vec,patch_name_vec) + ! now that we've read in the patch and cohort info, check to see if there is any real age info + if ( abs(sites(s)%youngest_patch%age - sites(s)%oldest_patch%age) <= nearzero .and. & + associated(sites(s)%youngest_patch%older) ) then + + ! so there are at least two patches and the oldest and youngest are the same age. + ! this means that sorting by age wasn't very useful. try sorting by total biomass instead + + ! first calculate the biomass in each patch. simplest way is to use the patch fusion criteria + currentpatch => sites(s)%youngest_patch + do while(associated(currentpatch)) + call patch_pft_size_profile(currentPatch) + currentPatch => currentpatch%older + enddo + + ! now we need to sort them. + ! first generate a new head of the linked list. + head_of_unsorted_patch_list => sites(s)%youngest_patch%older + + ! reset the site-level patch linked list, keeping only the youngest patch. + sites(s)%youngest_patch%older => null() + sites(s)%youngest_patch%younger => null() + sites(s)%oldest_patch => sites(s)%youngest_patch + + ! loop through each patch in the unsorted LL, peel it off, + ! and insert it into the new, sorted LL + do while(associated(head_of_unsorted_patch_list)) + + ! first keep track of the next patch in the old (unsorted) linked list + next_in_unsorted_patch_list => head_of_unsorted_patch_list%older + + ! check the two end-cases + + ! Youngest Patch + if(sum(head_of_unsorted_patch_list%pft_agb_profile(:,:)) <= & + sum(sites(s)%youngest_patch%pft_agb_profile(:,:)))then + head_of_unsorted_patch_list%older => sites(s)%youngest_patch + head_of_unsorted_patch_list%younger => null() + sites(s)%youngest_patch%younger => head_of_unsorted_patch_list + sites(s)%youngest_patch => head_of_unsorted_patch_list + + ! Oldest Patch + else if(sum(head_of_unsorted_patch_list%pft_agb_profile(:,:)) > & + sum(sites(s)%oldest_patch%pft_agb_profile(:,:)))then + head_of_unsorted_patch_list%older => null() + head_of_unsorted_patch_list%younger => sites(s)%oldest_patch + sites(s)%oldest_patch%older => head_of_unsorted_patch_list + sites(s)%oldest_patch => head_of_unsorted_patch_list + + ! Somewhere in the middle + else + currentpatch => sites(s)%youngest_patch + do while(associated(currentpatch)) + olderpatch => currentpatch%older + if(associated(currentpatch%older)) then + if(sum(head_of_unsorted_patch_list%pft_agb_profile(:,:)) >= & + sum(currentpatch%pft_agb_profile(:,:)) .and. & + sum(head_of_unsorted_patch_list%pft_agb_profile(:,:)) < & + sum(olderpatch%pft_agb_profile(:,:))) then + ! Set the new patches pointers + head_of_unsorted_patch_list%older => currentpatch%older + head_of_unsorted_patch_list%younger => currentpatch + ! Fix the patch's older pointer + currentpatch%older => head_of_unsorted_patch_list + ! Fix the older patch's younger pointer + olderpatch%younger => head_of_unsorted_patch_list + ! Exit the loop once head sorted to avoid later re-sort + exit + end if + end if + currentPatch => olderpatch + enddo + end if + + ! now work through to the next element in the unsorted linked list + head_of_unsorted_patch_list => next_in_unsorted_patch_list + end do + endif + ! Report Basal Area (as a check on if things were read in) ! ------------------------------------------------------------------------------ basal_area_pref = 0.0_r8 @@ -403,7 +494,10 @@ subroutine initialize_sites_by_inventory(nsites,sites,bc_in) ! Perform Cohort Fusion call fuse_cohorts(sites(s), currentpatch,bc_in(s)) call sort_cohorts(currentpatch) - total_cohorts = total_cohorts + count_cohorts(currentpatch) + + ! This calculates %countcohorts + call count_cohorts(currentpatch) + total_cohorts = total_cohorts + currentPatch%countcohorts currentPatch => currentpatch%older enddo @@ -431,25 +525,20 @@ subroutine initialize_sites_by_inventory(nsites,sites,bc_in) end do currentPatch => currentpatch%older enddo - + write(fates_log(),*) '-------------------------------------------------------' write(fates_log(),*) 'Basal Area from inventory, AFTER fusion' write(fates_log(),*) 'Lat: ',sites(s)%lat,' Lon: ',sites(s)%lon write(fates_log(),*) basal_area_postf,' [m2/ha]' write(fates_log(),*) '-------------------------------------------------------' - - ! Check to see if the fusion process has changed too much - ! We are sensitive to fusion in inventories because we may be asking for a massive amount - ! of fusion. For instance some init files are directly from inventory, where a cohort - ! is synomomous with a single plant. - - if( abs(basal_area_postf-basal_area_pref)/basal_area_pref > max_ba_diff ) then - write(fates_log(),*) 'Inventory Fusion Changed total biomass beyond reasonable limit' - call endrun(msg=errMsg(sourcefile, __LINE__)) - end if - end do + ! If this is flagged as true, the post-fusion inventory will be written to file + ! in the run directory. + if(do_inventory_out)then + call write_inventory_type1(sites(s)) + end if + end do deallocate(inv_format_list, inv_pss_list, inv_css_list, inv_lat_list, inv_lon_list) return @@ -650,7 +739,6 @@ subroutine set_inventory_edpatch_type1(newpatch,pss_file_unit,ipa,ios,patch_name use FatesSizeAgeTypeIndicesMod, only: get_age_class_index use EDtypesMod, only: AREA - use EDTypesMod, only: ncwd use SFParamsMod , only : SF_val_CWD_frac ! Arguments @@ -661,6 +749,8 @@ subroutine set_inventory_edpatch_type1(newpatch,pss_file_unit,ipa,ios,patch_name character(len=patchname_strlen),intent(out) :: patch_name ! unique string identifier of patch ! Locals + type(litter_type),pointer :: litt + integer :: el ! index for elements real(r8) :: p_time ! Time patch was recorded real(r8) :: p_trk ! Land Use index (see above descriptions) character(len=patchname_strlen) :: p_name ! unique string identifier of patch @@ -719,16 +809,18 @@ subroutine set_inventory_edpatch_type1(newpatch,pss_file_unit,ipa,ios,patch_name ! first hack solution. (RGK 06-2017) ! ---------------------------------------------------------------------- - do icwd = 1, ncwd - newpatch%cwd_ag(icwd) = 0.0_r8 - newpatch%cwd_bg(icwd) = 0.0_r8 + do el=1,num_elements + litt => newpatch%litter(el) + + call litt%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 - - newpatch%leaf_litter(:) = 0.0_r8 - newpatch%root_litter(:) = 0.0_r8 - - return end subroutine set_inventory_edpatch_type1 @@ -782,6 +874,7 @@ subroutine set_inventory_edcohort_type1(csite,bc_in,css_file_unit,npatches, & integer,intent(out) :: ios ! Return flag ! Locals + class(prt_vartypes), pointer :: prt_obj real(r8) :: c_time ! Time patch was recorded character(len=patchname_strlen) :: p_name ! The patch associated with this cohort character(len=cohortname_strlen) :: c_name ! cohort index @@ -800,17 +893,26 @@ subroutine set_inventory_edcohort_type1(csite,bc_in,css_file_unit,npatches, & type(ed_patch_type), pointer :: cpatch ! current patch pointer type(ed_cohort_type), pointer :: temp_cohort ! temporary patch (needed for allom funcs) integer :: ipa ! patch idex + integer :: iage + integer :: el + integer :: element_id logical :: matched_patch ! check if cohort was matched w/ patch - real(r8) :: b_agw ! biomass above ground non-leaf [kgC] - real(r8) :: b_bgw ! biomass below ground non-leaf [kgC] - real(r8) :: b_leaf ! biomass in leaves [kgC] - real(r8) :: b_fineroot ! biomass in fine roots [kgC] - real(r8) :: b_sapwood ! biomass in sapwood [kgC] - real(r8) :: b_dead + real(r8) :: b_agw ! biomass above ground non-leaf [kgC] + real(r8) :: b_bgw ! biomass below ground non-leaf [kgC] + real(r8) :: b_leaf ! biomass in leaves [kgC] + real(r8) :: b_fnrt ! biomass in fine roots [kgC] + real(r8) :: b_sapw ! biomass in sapwood [kgC] + real(r8) :: b_struct real(r8) :: b_store - real(r8) :: a_sapwood ! area of sapwood at reference height [m2] - integer :: i_pft, ncohorts_to_create - + real(r8) :: a_sapw ! area of sapwood at reference height [m2] + real(r8) :: m_struct ! Generic (any element) mass for structure [kg] + real(r8) :: m_leaf ! Generic mass for leaf [kg] + real(r8) :: m_fnrt ! Generic mass for fine-root [kg] + real(r8) :: m_sapw ! Generic mass for sapwood [kg] + real(r8) :: m_store ! Generic mass for storage [kg] + 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)' @@ -899,79 +1001,237 @@ subroutine set_inventory_edcohort_type1(csite,bc_in,css_file_unit,npatches, & do i_pft = 1,ncohorts_to_create allocate(temp_cohort) ! A temporary cohort is needed because we want to make - ! use of the allometry functions - ! Don't need to allocate leaf age classes (not used) if (c_pft .ne. 0 ) then - ! normal case: assign each cohort to its specified PFT - temp_cohort%pft = c_pft + ! normal case: assign each cohort to its specified PFT + temp_cohort%pft = c_pft else - ! special case, make an identical cohort for each PFT - temp_cohort%pft = i_pft + ! special case, make an identical cohort for each PFT + temp_cohort%pft = i_pft endif - + temp_cohort%n = c_nplant * cpatch%area / real(ncohorts_to_create,r8) temp_cohort%dbh = c_dbh call h_allom(c_dbh,temp_cohort%pft,temp_cohort%hite) temp_cohort%canopy_trim = 1.0_r8 - ! Calculate total above-ground biomass from allometry call bagw_allom(temp_cohort%dbh,temp_cohort%pft,b_agw) ! Calculate coarse root biomass from allometry call bbgw_allom(temp_cohort%dbh,temp_cohort%pft,b_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,b_leaf) - + ! Calculate fine root biomass - call bfineroot(temp_cohort%dbh,temp_cohort%pft,temp_cohort%canopy_trim,b_fineroot) - + call bfineroot(temp_cohort%dbh,temp_cohort%pft,temp_cohort%canopy_trim,b_fnrt) + ! Calculate sapwood biomass - call bsap_allom(temp_cohort%dbh,temp_cohort%pft,temp_cohort%canopy_trim, a_sapwood, b_sapwood) - - call bdead_allom( b_agw, b_bgw, b_sapwood, temp_cohort%pft, b_dead ) - + call bsap_allom(temp_cohort%dbh,temp_cohort%pft,temp_cohort%canopy_trim, a_sapw, b_sapw) + + call bdead_allom( b_agw, b_bgw, b_sapw, temp_cohort%pft, b_struct ) + call bstore_allom(temp_cohort%dbh, temp_cohort%pft, temp_cohort%canopy_trim, b_store) - + temp_cohort%laimemory = 0._r8 + temp_cohort%sapwmemory = 0._r8 + temp_cohort%structmemory = 0._r8 cstatus = leaves_on - + + stem_drop_fraction = EDPftvarcon_inst%phen_stem_drop_fraction(temp_cohort%pft) if( EDPftvarcon_inst%season_decid(temp_cohort%pft) == itrue .and. & any(csite%cstatus == [phen_cstat_nevercold,phen_cstat_iscold])) then temp_cohort%laimemory = b_leaf + temp_cohort%sapwmemory = b_sapw * stem_drop_fraction + temp_cohort%structmemory = b_struct * stem_drop_fraction b_leaf = 0._r8 + b_sapw = (1._r8 - stem_drop_fraction) * b_sapw + b_struct = (1._r8 - stem_drop_fraction) * b_struct cstatus = leaves_off endif - + if ( EDPftvarcon_inst%stress_decid(temp_cohort%pft) == itrue .and. & any(csite%dstatus == [phen_dstat_timeoff,phen_dstat_moistoff])) then temp_cohort%laimemory = b_leaf + temp_cohort%sapwmemory = b_sapw * stem_drop_fraction + temp_cohort%structmemory = b_struct * stem_drop_fraction b_leaf = 0._r8 + b_sapw = (1._r8 - stem_drop_fraction) * b_sapw + b_struct = (1._r8 - stem_drop_fraction) * b_struct cstatus = leaves_off endif + + prt_obj => null() + call InitPRTObject(prt_obj) + + do el = 1,num_elements + + element_id = element_list(el) + + ! If this is carbon12, then the initialization is straight forward + ! otherwise, we use stoichiometric ratios + select case(element_id) + case(carbon12_element) + + m_struct = b_struct + m_leaf = b_leaf + m_fnrt = b_fnrt + m_sapw = b_sapw + m_store = b_store + m_repro = 0._r8 + + case(nitrogen_element) + + m_struct = b_struct*EDPftvarcon_inst%prt_nitr_stoich_p1(temp_cohort%pft,struct_organ) + m_leaf = b_leaf*EDPftvarcon_inst%prt_nitr_stoich_p1(temp_cohort%pft,leaf_organ) + m_fnrt = b_fnrt*EDPftvarcon_inst%prt_nitr_stoich_p1(temp_cohort%pft,fnrt_organ) + m_sapw = b_sapw*EDPftvarcon_inst%prt_nitr_stoich_p1(temp_cohort%pft,sapw_organ) + m_store = b_store*EDPftvarcon_inst%prt_nitr_stoich_p1(temp_cohort%pft,store_organ) + m_repro = 0._r8 + + case(phosphorus_element) + + m_struct = b_struct*EDPftvarcon_inst%prt_phos_stoich_p1(temp_cohort%pft,struct_organ) + m_leaf = b_leaf*EDPftvarcon_inst%prt_phos_stoich_p1(temp_cohort%pft,leaf_organ) + m_fnrt = b_fnrt*EDPftvarcon_inst%prt_phos_stoich_p1(temp_cohort%pft,fnrt_organ) + m_sapw = b_sapw*EDPftvarcon_inst%prt_phos_stoich_p1(temp_cohort%pft,sapw_organ) + m_store = b_store*EDPftvarcon_inst%prt_phos_stoich_p1(temp_cohort%pft,store_organ) + m_repro = 0._r8 + end select + + select case(hlm_parteh_mode) + case (prt_carbon_allom_hyp,prt_cnp_flex_allom_hyp ) + + ! Equally distribute leaf mass into available age-bins + do iage = 1,nleafage + call SetState(prt_obj,leaf_organ, element_id,m_leaf/real(nleafage,r8),iage) + end do + + call SetState(prt_obj,fnrt_organ, element_id, m_fnrt) + call SetState(prt_obj,sapw_organ, element_id, m_sapw) + call SetState(prt_obj,store_organ, element_id, m_store) + call SetState(prt_obj,struct_organ, element_id, m_struct) + call SetState(prt_obj,repro_organ, element_id, m_repro) + + case default + write(fates_log(),*) 'Unspecified PARTEH module during inventory intitialization' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end select + + end do - ! Since spread is a canopy level calculation, we need to provide an initial guess here. - if( debug_inv) then - write(fates_log(),*) 'calling create_cohort: ', temp_cohort%pft, temp_cohort%n, & - temp_cohort%hite, temp_cohort%dbh, & - b_leaf, b_fineroot, b_sapwood, b_dead, b_store, & - temp_cohort%laimemory, cstatus, rstatus, temp_cohort%canopy_trim, & - 1, csite%spread - endif + call prt_obj%CheckInitialConditions() - call create_cohort(csite, cpatch, temp_cohort%pft, temp_cohort%n, temp_cohort%hite, & - temp_cohort%dbh, b_leaf, b_fineroot, b_sapwood, b_dead, b_store, & - temp_cohort%laimemory, cstatus, rstatus, temp_cohort%canopy_trim, & - 1, csite%spread, equal_leaf_aclass, bc_in) + ! 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%dbh, & + prt_obj, temp_cohort%laimemory, temp_cohort%sapwmemory, temp_cohort%structmemory, & + cstatus, rstatus, temp_cohort%canopy_trim, 1, csite%spread, bc_in) deallocate(temp_cohort) ! get rid of temporary cohort + end do return end subroutine set_inventory_edcohort_type1 + ! ==================================================================================== + + subroutine write_inventory_type1(currentSite) + + ! -------------------------------------------------------------------------------- + ! This subroutine writes the cohort/patch inventory type files in the "type 1" + ! format. Note that for compatibility with ED2, we chose an old type that has + ! both extra unused fields and is missing fields from FATES. THis is not + ! a recommended file type for restarting a run. + ! The files will have a lat/long tag added to their name, and will be + ! generated in the run folder. + ! -------------------------------------------------------------------------------- + + use shr_file_mod, only : shr_file_getUnit + use shr_file_mod, only : shr_file_freeUnit + + ! Arguments + type(ed_site_type), target :: currentSite + + ! Locals + type(ed_patch_type), pointer :: currentpatch + type(ed_cohort_type), pointer :: currentcohort + + character(len=128) :: pss_name_out ! output file string + character(len=128) :: css_name_out ! output file string + integer :: pss_file_out + integer :: css_file_out + integer :: ilat_int,ilat_dec ! for output string parsing + integer :: ilon_int,ilon_dec ! for output string parsing + character(len=32) :: patch_str + character(len=32) :: cohort_str + integer :: ipatch + integer :: icohort + character(len=1) :: ilat_sign,ilon_sign + + ! Generate pss/css file name based on the location of the site + ilat_int = abs(int(currentSite%lat)) + ilat_dec = int(100000*(abs(currentSite%lat) - real(ilat_int,r8))) + ilon_int = abs(int(currentSite%lon)) + ilon_dec = int(100000*(abs(currentSite%lon) - real(ilon_int,r8))) + + if(currentSite%lat>=0._r8)then + ilat_sign = 'N' + else + ilat_sign = 'S' + end if + if(currentSite%lon>=0._r8)then + ilon_sign = 'E' + else + ilon_sign = 'W' + end if + + write(pss_name_out,'(A8,I2.2,A1,I5.5,A1,A1,I3.3,A1,I5.5,A1,A4)') & + 'pss_out_',ilat_int,'.',ilat_dec,ilat_sign,'_',ilon_int,'.',ilon_dec,ilon_sign,'.txt' + write(css_name_out,'(A8,I2.2,A1,I5.5,A1,A1,I3.3,A1,I5.5,A1,A4)') & + 'css_out_',ilat_int,'.',ilat_dec,ilat_sign,'_',ilon_int,'.',ilon_dec,ilon_sign,'.txt' + + pss_file_out = shr_file_getUnit() + css_file_out = shr_file_getUnit() + + open(unit=pss_file_out,file=trim(pss_name_out), status='UNKNOWN',action='WRITE',form='FORMATTED') + open(unit=css_file_out,file=trim(css_name_out), status='UNKNOWN',action='WRITE',form='FORMATTED') + + write(pss_file_out,*) 'time patch trk age area water fsc stsc stsl ssc psc msn fsn' + write(css_file_out,*) 'time patch cohort dbh hite pft nplant bdead alive Avgrg' + + ipatch=0 + currentpatch => currentSite%youngest_patch + do while(associated(currentpatch)) + ipatch=ipatch+1 + + write(patch_str,'(A7,i4.4,A)') '' + + write(pss_file_out,*) '0000 ',trim(patch_str),' 2 ',currentPatch%age,currentPatch%area/AREA, & + '0.0000 0.0000 0.0000 0.0000 0.0000 0.0000 0.0000 0.0000' + + icohort=0 + currentcohort => currentpatch%tallest + do while(associated(currentcohort)) + icohort=icohort+1 + write(cohort_str,'(A7,i4.4,A)') '' + write(css_file_out,*) '0000 ',trim(patch_str),' ',trim(cohort_str), & + currentCohort%dbh,0.0,currentCohort%pft,currentCohort%n/currentPatch%area,0.0,0.0,0.0 + + currentcohort => currentcohort%shorter + end do + currentPatch => currentpatch%older + enddo + + close(css_file_out) + close(pss_file_out) + + call shr_file_freeUnit(css_file_out) + call shr_file_freeUnit(pss_file_out) + + end subroutine write_inventory_type1 + end module FatesInventoryInitMod diff --git a/main/FatesParameterDerivedMod.F90 b/main/FatesParameterDerivedMod.F90 index 15fc287b0c..36e528f939 100644 --- a/main/FatesParameterDerivedMod.F90 +++ b/main/FatesParameterDerivedMod.F90 @@ -14,7 +14,10 @@ module FatesParameterDerivedMod use FatesConstantsMod, only : g_per_kg use FatesInterfaceMod, only : nleafage - type param_derived_type + implicit none + private + + type, public :: param_derived_type real(r8), allocatable :: jmax25top(:,:) ! canopy top: maximum electron transport ! rate at 25C (umol electrons/m**2/s) @@ -29,7 +32,7 @@ module FatesParameterDerivedMod end type param_derived_type - type(param_derived_type) :: param_derived + type(param_derived_type), public :: param_derived contains @@ -57,7 +60,6 @@ subroutine Init(this,numpft) ! local variables integer :: ft ! pft index integer :: iage ! leaf age class index - real(r8) :: lnc ! leaf N concentration (gN leaf/m^2) associate( vcmax25top => EDPftvarcon_inst%vcmax25top ) diff --git a/main/FatesParametersInterface.F90 b/main/FatesParametersInterface.F90 index c863542808..fa3843cb31 100644 --- a/main/FatesParametersInterface.F90 +++ b/main/FatesParametersInterface.F90 @@ -7,6 +7,7 @@ module FatesParametersInterface use FatesGlobals, only : fates_log implicit none + private ! Modules are private by default integer, parameter, public :: max_params = 250 integer, parameter, public :: max_dimensions = 2 @@ -20,7 +21,6 @@ module FatesParametersInterface ! Dimensions in the fates namespace: character(len=*), parameter, public :: dimension_name_scalar = '' - character(len=*), parameter, public :: dimension_name_scalar1d = 'fates_scalar' character(len=*), parameter, public :: dimension_name_pft = 'fates_pft' character(len=*), parameter, public :: dimension_name_segment = 'fates_segment' character(len=*), parameter, public :: dimension_name_cwd = 'fates_NCWD' @@ -38,7 +38,7 @@ module FatesParametersInterface ! Dimensions in the host namespace: character(len=*), parameter, public :: dimension_name_host_allpfts = 'allpfts' - type, private :: parameter_type + type :: parameter_type character(len=param_string_length) :: name logical :: sync_with_host integer :: dimension_shape @@ -53,19 +53,21 @@ module FatesParametersInterface type(parameter_type), private :: parameters(max_params) contains - procedure, public :: Init - procedure, public :: Destroy - procedure, public :: RegisterParameter - generic, public :: RetreiveParameter => RetreiveParameterScalar, RetreiveParameter1D, RetreiveParameter2D - generic, public :: RetreiveParameterAllocate => RetreiveParameter1DAllocate, RetreiveParameter2DAllocate - generic, public :: SetData => SetDataScalar, SetData1D, SetData2D - procedure, public :: GetUsedDimensions - procedure, public :: SetDimensionSizes - procedure, public :: GetMaxDimensionSize - procedure, public :: GetMetaData - procedure, public :: num_params - procedure, public :: FindIndex - + ! Public functions + procedure :: Init + procedure :: Destroy + procedure :: RegisterParameter + generic :: RetreiveParameter => RetreiveParameterScalar, RetreiveParameter1D, RetreiveParameter2D + generic :: RetreiveParameterAllocate => RetreiveParameter1DAllocate, RetreiveParameter2DAllocate + generic :: SetData => SetDataScalar, SetData1D, SetData2D + procedure :: GetUsedDimensions + procedure :: SetDimensionSizes + procedure :: GetMaxDimensionSize + procedure :: GetMetaData + procedure :: num_params + procedure :: FindIndex + + ! Private functions procedure, private :: RetreiveParameterScalar procedure, private :: RetreiveParameter1D procedure, private :: RetreiveParameter2D diff --git a/main/FatesRestartInterfaceMod.F90 b/main/FatesRestartInterfaceMod.F90 index 4129136ef5..4d7c07794c 100644 --- a/main/FatesRestartInterfaceMod.F90 +++ b/main/FatesRestartInterfaceMod.F90 @@ -1,41 +1,47 @@ module FatesRestartInterfaceMod - use FatesConstantsMod , only : r8 => fates_r8 - use FatesConstantsMod , only : fates_avg_flag_length - use FatesConstantsMod , only : fates_short_string_length - use FatesConstantsMod , only : fates_long_string_length - use FatesConstantsMod , only : itrue - use FatesConstantsMod , only : ifalse - use FatesConstantsMod , only : primaryforest - use FatesGlobals , only : fates_log - use FatesGlobals , only : endrun => fates_endrun - use FatesIODimensionsMod, only : fates_io_dimension_type - use FatesIOVariableKindMod, only : fates_io_variable_kind_type + use FatesConstantsMod, only : r8 => fates_r8 + use FatesConstantsMod, only : fates_avg_flag_length + use FatesConstantsMod, only : fates_short_string_length + use FatesConstantsMod, only : fates_long_string_length + use FatesConstantsMod, only : itrue + use FatesConstantsMod, only : ifalse + use FatesConstantsMod, only : fates_unset_r8 + use FatesConstantsMod, only : primaryforest + use FatesGlobals, only : fates_log + use FatesGlobals, only : endrun => fates_endrun + use FatesIODimensionsMod, only : fates_io_dimension_type + use FatesIOVariableKindMod, only : fates_io_variable_kind_type use FatesRestartVariableMod, only : fates_restart_variable_type - use FatesInterfaceMod, only : bc_in_type - use FatesInterfaceMod, only : bc_out_type - use FatesInterfaceMod, only : hlm_use_planthydro - use FatesInterfaceMod, only : fates_maxElementsPerSite - use EDCohortDynamicsMod, only : UpdateCohortBioPhysRates - use FatesHydraulicsMemMod, only : nshell - use FatesHydraulicsMemMod, only : n_hypool_ag - use FatesHydraulicsMemMod, only : n_hypool_troot - use FatesHydraulicsMemMod, only : nlevsoi_hyd_max - use PRTGenericMod, only : prt_global - use EDCohortDynamicsMod, only : nan_cohort - use EDCohortDynamicsMod, only : zero_cohort - use EDCohortDynamicsMod, only : InitPRTCohort - use FatesPlantHydraulicsMod, only : InitHydrCohort - use FatesInterfaceMod, only : nlevsclass - use PRTGenericMod, only : prt_global - + use FatesInterfaceMod, only : bc_in_type + use FatesInterfaceMod, only : bc_out_type + use FatesInterfaceMod, only : hlm_use_planthydro + use FatesInterfaceMod, only : fates_maxElementsPerSite + use EDCohortDynamicsMod, only : UpdateCohortBioPhysRates + use FatesHydraulicsMemMod, only : nshell + use FatesHydraulicsMemMod, only : n_hypool_ag + use FatesHydraulicsMemMod, only : n_hypool_troot + use FatesHydraulicsMemMod, only : nlevsoi_hyd_max + use PRTGenericMod, only : prt_global + use EDCohortDynamicsMod, only : nan_cohort + use EDCohortDynamicsMod, only : zero_cohort + use EDCohortDynamicsMod, only : InitPRTObject + use EDCohortDynamicsMod, only : InitPRTBoundaryConditions + use FatesPlantHydraulicsMod, only : InitHydrCohort + use FatesInterfaceMod, only : nlevsclass + use FatesLitterMod, only : litter_type + use FatesLitterMod, only : ncwd + use FatesLitterMod, only : ndcmpy + use PRTGenericMod, only : prt_global + use EDTypesMod, only : num_elements ! CIME GLOBALS use shr_log_mod , only : errMsg => shr_log_errMsg implicit none + private ! Modules are private by default ! ------------------------------------------------------------ ! A note on variable naming conventions. @@ -65,146 +71,138 @@ module FatesRestartInterfaceMod ! Indices to the restart variable object - integer, private :: ir_npatch_si - integer, private :: ir_oldstock_si - integer, private :: ir_cd_status_si - integer, private :: ir_dd_status_si - integer, private :: ir_nchill_days_si - integer, private :: ir_ncold_days_si - integer, private :: ir_leafondate_si - integer, private :: ir_leafoffdate_si - integer, private :: ir_dleafondate_si - integer, private :: ir_dleafoffdate_si - integer, private :: ir_acc_ni_si - integer, private :: ir_gdd_si - integer, private :: ir_nep_timeintegrated_si - integer, private :: ir_npp_timeintegrated_si - integer, private :: ir_hr_timeintegrated_si - integer, private :: ir_cbal_error_fates_si - integer, private :: ir_cbal_error_bgc_si - integer, private :: ir_cbal_error_total_si - integer, private :: ir_totecosysc_old_si - integer, private :: ir_totfatesc_old_si - integer, private :: ir_totbgcc_old_si - integer, private :: ir_fates_to_bgc_this_ts_si - integer, private :: ir_fates_to_bgc_last_ts_si - integer, private :: ir_seedrainflux_si - integer, private :: ir_trunk_product_si - integer, private :: ir_ncohort_pa - - integer, private :: ir_canopy_layer_co - integer, private :: ir_canopy_layer_yesterday_co - integer, private :: ir_canopy_trim_co - integer, private :: ir_size_class_lasttimestep_co - integer, private :: ir_dbh_co - integer, private :: ir_g_sb_laweight_co - integer, private :: ir_height_co - integer, private :: ir_laimemory_co - integer, private :: ir_nplant_co - integer, private :: ir_gpp_acc_co - integer, private :: ir_npp_acc_co - integer, private :: ir_resp_acc_co - integer, private :: ir_gpp_acc_hold_co - integer, private :: ir_npp_acc_hold_co - integer, private :: ir_resp_acc_hold_co - - integer, private :: ir_bmort_co - integer, private :: ir_hmort_co - integer, private :: ir_cmort_co - integer, private :: ir_frmort_co - - !Logging - integer, private :: ir_lmort_direct_co - integer, private :: ir_lmort_collateral_co - integer, private :: ir_lmort_infra_co + + integer :: ir_npatch_si + integer :: ir_cd_status_si + integer :: ir_dd_status_si + integer :: ir_nchill_days_si + integer :: ir_ncold_days_si + integer :: ir_leafondate_si + integer :: ir_leafoffdate_si + integer :: ir_dleafondate_si + integer :: ir_dleafoffdate_si + integer :: ir_acc_ni_si + integer :: ir_gdd_si + integer :: ir_trunk_product_si + integer :: ir_ncohort_pa + integer :: ir_canopy_layer_co + integer :: ir_canopy_layer_yesterday_co + integer :: ir_canopy_trim_co + integer :: ir_size_class_lasttimestep_co + integer :: ir_dbh_co + integer :: ir_g_sb_laweight_co + integer :: ir_height_co + integer :: ir_laimemory_co + integer :: ir_sapwmemory_co + integer :: ir_structmemory_co + integer :: ir_nplant_co + integer :: ir_gpp_acc_co + integer :: ir_npp_acc_co + integer :: ir_resp_acc_co + integer :: ir_gpp_acc_hold_co + integer :: ir_npp_acc_hold_co + integer :: ir_resp_acc_hold_co + integer :: ir_bmort_co + integer :: ir_hmort_co + integer :: ir_cmort_co + integer :: ir_frmort_co + + !Logging + integer :: ir_lmort_direct_co + integer :: ir_lmort_collateral_co + integer :: ir_lmort_infra_co ! Radiation - integer, private :: ir_solar_zenith_flag_pa - integer, private :: ir_solar_zenith_angle_pa - - integer, private :: ir_ddbhdt_co - integer, private :: ir_resp_tstep_co - integer, private :: ir_pft_co - integer, private :: ir_status_co - integer, private :: ir_isnew_co - integer, private :: ir_cwd_ag_pacw - integer, private :: ir_cwd_bg_pacw - - integer, private :: ir_gnd_alb_dif_pasb - integer, private :: ir_gnd_alb_dir_pasb - - integer, private :: ir_leaf_litter_paft - integer, private :: ir_root_litter_paft - integer, private :: ir_leaf_litter_in_paft - integer, private :: ir_root_litter_in_paft - - integer, private :: ir_livegrass_pa - integer, private :: ir_age_pa - integer, private :: ir_area_pa - integer, private :: ir_agesinceanthrodist_pa - integer, private :: ir_patchdistturbcat_pa - + integer :: ir_solar_zenith_flag_pa + integer :: ir_solar_zenith_angle_pa + integer :: ir_gnd_alb_dif_pasb + integer :: ir_gnd_alb_dir_pasb + + + integer :: ir_ddbhdt_co + integer :: ir_resp_tstep_co + integer :: ir_pft_co + integer :: ir_status_co + integer :: ir_isnew_co + + ! Litter + integer :: ir_agcwd_litt + integer :: ir_bgcwd_litt + integer :: ir_leaf_litt + integer :: ir_fnrt_litt + integer :: ir_seed_litt + integer :: ir_seedgerm_litt + integer :: ir_seed_prod_co + integer :: ir_livegrass_pa + integer :: ir_age_pa + integer :: ir_area_pa + integer :: ir_agesinceanthrodist_pa + integer :: ir_patchdistturbcat_pa + ! Site level - integer, private :: ir_watermem_siwm - integer, private :: ir_vegtempmem_sitm - integer, private :: ir_seed_bank_sift - integer, private :: ir_spread_si - integer, private :: ir_recrate_sift - integer, private :: ir_fmortrate_cano_siscpf - integer, private :: ir_fmortrate_usto_siscpf - integer, private :: ir_imortrate_siscpf - integer, private :: ir_fmortrate_crown_siscpf - integer, private :: ir_fmortrate_cambi_siscpf - integer, private :: ir_termnindiv_cano_siscpf - integer, private :: ir_termnindiv_usto_siscpf - integer, private :: ir_growflx_fusion_siscpf - integer, private :: ir_demorate_sisc - integer, private :: ir_promrate_sisc - integer, private :: ir_termcflux_cano_si - integer, private :: ir_termcflux_usto_si - integer, private :: ir_democflux_si - integer, private :: ir_promcflux_si - integer, private :: ir_imortcflux_si - integer, private :: ir_fmortcflux_cano_si - integer, private :: ir_fmortcflux_usto_si - - - - integer, private :: ir_prt_base ! Base index for all PRT variables + integer :: ir_watermem_siwm + integer :: ir_vegtempmem_sitm + integer :: ir_seed_bank_sift + integer :: ir_spread_si + integer :: ir_recrate_sift + integer :: ir_fmortrate_cano_siscpf + integer :: ir_fmortrate_usto_siscpf + integer :: ir_imortrate_siscpf + integer :: ir_fmortrate_crown_siscpf + integer :: ir_fmortrate_cambi_siscpf + integer :: ir_termnindiv_cano_siscpf + integer :: ir_termnindiv_usto_siscpf + integer :: ir_growflx_fusion_siscpf + integer :: ir_demorate_sisc + integer :: ir_promrate_sisc + integer :: ir_termcflux_cano_si + integer :: ir_termcflux_usto_si + integer :: ir_democflux_si + integer :: ir_promcflux_si + integer :: ir_imortcflux_si + integer :: ir_fmortcflux_cano_si + integer :: ir_fmortcflux_usto_si + integer :: ir_cwdagin_flxdg + integer :: ir_cwdbgin_flxdg + integer :: ir_leaflittin_flxdg + integer :: ir_rootlittin_flxdg + integer :: ir_oldstock_mbal + integer :: ir_errfates_mbal + integer :: ir_prt_base ! Base index for all PRT variables + ! Hydraulic indices - integer, private :: ir_hydro_th_ag_covec - integer, private :: ir_hydro_th_troot_covec - integer, private :: ir_hydro_th_aroot_covec - integer, private :: ir_hydro_liqvol_shell_si - integer, private :: ir_hydro_err_growturn_aroot_covec - integer, private :: ir_hydro_err_growturn_ag_covec - integer, private :: ir_hydro_err_growturn_troot_covec - integer, private :: ir_hydro_recruit_si - integer, private :: ir_hydro_dead_si - integer, private :: ir_hydro_growturn_err_si - integer, private :: ir_hydro_pheno_err_si - integer, private :: ir_hydro_hydro_err_si + integer :: ir_hydro_th_ag_covec + integer :: ir_hydro_th_troot_covec + integer :: ir_hydro_th_aroot_covec + integer :: ir_hydro_liqvol_shell_si + integer :: ir_hydro_err_growturn_aroot_covec + integer :: ir_hydro_err_growturn_ag_covec + integer :: ir_hydro_err_growturn_troot_covec + integer :: ir_hydro_recruit_si + integer :: ir_hydro_dead_si + integer :: ir_hydro_growturn_err_si + integer :: ir_hydro_pheno_err_si + integer :: ir_hydro_hydro_err_si ! The number of variable dim/kind types we have defined (static) - integer, parameter :: fates_restart_num_dimensions = 2 !(cohort,column) - integer, parameter :: fates_restart_num_dim_kinds = 4 !(cohort-int,cohort-r8,site-int,site-r8) + integer, parameter, public :: fates_restart_num_dimensions = 2 !(cohort,column) + integer, parameter, public :: fates_restart_num_dim_kinds = 4 !(cohort-int,cohort-r8,site-int,site-r8) ! integer constants for storing logical data - integer, parameter :: old_cohort = 0 - integer, parameter :: new_cohort = 1 + integer, parameter, public :: old_cohort = 0 + integer, parameter, public :: new_cohort = 1 - real(r8), parameter :: flushinvalid = -9999.0 - real(r8), parameter :: flushzero = 0.0 - real(r8), parameter :: flushone = 1.0 + real(r8), parameter, public :: flushinvalid = -9999.0 + real(r8), parameter, public :: flushzero = 0.0 + real(r8), parameter, public :: flushone = 1.0 - ! Local debug flag - logical, parameter :: debug=.false. + logical, parameter, public :: debug=.false. - character(len=*), parameter, private :: sourcefile = & + character(len=*), parameter :: sourcefile = & __FILE__ ! This structure is allocated by thread, and must be calculated after the FATES @@ -212,7 +210,7 @@ module FatesRestartInterfaceMod ! is not combined with iovar_bounds, because that one is multi-instanced. This ! structure is used more during the update phase, wherease _bounds is used ! more for things like flushing - type restart_map_type + type, public :: restart_map_type integer, allocatable :: site_index(:) ! maps site indexes to the HIO site position integer, allocatable :: cohort1_index(:) ! maps site index to the HIO cohort 1st position end type restart_map_type @@ -241,17 +239,19 @@ module FatesRestartInterfaceMod contains - procedure, public :: Init - procedure, public :: SetThreadBoundsEach - procedure, public :: assemble_restart_output_types - procedure, public :: initialize_restart_vars - procedure, public :: num_restart_vars - procedure, public :: column_index - procedure, public :: cohort_index - procedure, public :: set_restart_vectors - procedure, public :: create_patchcohort_structure - procedure, public :: get_restart_vectors - procedure, public :: update_3dpatch_radiation + ! public functions + procedure :: Init + procedure :: SetThreadBoundsEach + procedure :: assemble_restart_output_types + procedure :: initialize_restart_vars + procedure :: num_restart_vars + procedure :: column_index + procedure :: cohort_index + procedure :: set_restart_vectors + procedure :: create_patchcohort_structure + procedure :: get_restart_vectors + procedure :: update_3dpatch_radiation + ! private work functions procedure, private :: init_dim_kinds_maps procedure, private :: set_dim_indices @@ -555,11 +555,6 @@ subroutine define_restart_vars(this, initialize_variables) long_name='Total number of FATES patches per column', units='none', flushval = flushinvalid, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_npatch_si ) - call this%set_restart_var(vname='fates_old_stock', vtype=site_r8, & - long_name='biomass stock in each site (previous step)', units='kgC/site', & - flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_oldstock_si ) - call this%set_restart_var(vname='fates_cold_dec_status', vtype=site_int, & long_name='status flag for cold deciduous plants', units='unitless', flushval = flushinvalid, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_cd_status_si ) @@ -600,64 +595,6 @@ subroutine define_restart_vars(this, initialize_variables) long_name='growing degree days at each site', units='degC days', flushval = flushzero, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_gdd_si ) - call this%set_restart_var(vname='fates_nep_timeintegrated_site', vtype=site_r8, & - long_name='NEP integrated over model time-steps', units='gc/m2', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_nep_timeintegrated_si ) - - call this%set_restart_var(vname='fates_npp_timeintegrated_site', vtype=site_r8, & - long_name='NPP integrated over model time-steps', units='gc/m2', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_npp_timeintegrated_si ) - - call this%set_restart_var(vname='fates_hr_timeintegrated_site', vtype=site_r8, & - long_name='heterotrophic respiration integrated over model time-steps', & - units='gc/m2', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_hr_timeintegrated_si ) - - call this%set_restart_var(vname='fates_cbal_err_fatesite', vtype=site_r8, & - long_name='the carbon accounting error for FATES processes', & - units='gC/m2/s', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_cbal_error_fates_si ) - - call this%set_restart_var(vname='fates_cbal_err_bgcsite', vtype=site_r8, & - long_name='the carbon accounting error for (fates relevant) BGC processes', & - units='gC/m2/s', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_cbal_error_bgc_si ) - - call this%set_restart_var(vname='fates_cbal_err_totsite', vtype=site_r8, & - long_name='the carbon accounting error for fates and bgc processes', & - units='gC/m2/s', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_cbal_error_total_si ) - - call this%set_restart_var(vname='fates_totecosysc_old_site', vtype=site_r8, & - long_name='total ecosystem carbon above and below ground (previous time-step)', & - units='gC/m2', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_totecosysc_old_si ) - - call this%set_restart_var(vname='fates_totfatesc_old_site', vtype=site_r8, & - long_name='total carbon tracked in FATES, (previous time-step)', & - units='gc/m2', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_totfatesc_old_si ) - - call this%set_restart_var(vname='fates_totbgcc_old_site', vtype=site_r8, & - long_name='total carbon tracked in the BGC module', & - units='gc/m2', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_totbgcc_old_si ) - - call this%set_restart_var(vname='fates_to_bgc_this_edts_col', vtype=site_r8, & - long_name='total flux of carbon from FATES to BGC models on current timestep', & - units='gC/m2/s', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_fates_to_bgc_this_ts_si ) - - call this%set_restart_var(vname='fates_to_bgc_last_edts_col', vtype=site_r8, & - long_name='total flux of carbon from FATES to BGC models on previous timestep', & - units='gC/m2/s', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_fates_to_bgc_last_ts_si ) - - call this%set_restart_var(vname='fates_seed_rain_flux_site', vtype=site_r8, & - long_name='flux of seeds from exterior', & - units='kgC/m2/year', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_seedrainflux_si ) - call this%set_restart_var(vname='fates_trunk_product_site', vtype=site_r8, & long_name='Accumulate trunk product flux at site', & units='kgC/m2', flushval = flushzero, & @@ -689,6 +626,11 @@ subroutine define_restart_vars(this, initialize_variables) ! 1D cohort Variables ! ----------------------------------------------------------------------------------- + call this%set_restart_var(vname='fates_seed_prod', vtype=cohort_r8, & + 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 ) @@ -718,6 +660,16 @@ subroutine define_restart_vars(this, initialize_variables) units='kgC/indiv', flushval = flushzero, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_laimemory_co ) + call this%set_restart_var(vname='fates_sapwmemory', vtype=cohort_r8, & + long_name='ed cohort - target sapwood biomass set from prev year', & + units='kgC/indiv', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_sapwmemory_co ) + + call this%set_restart_var(vname='fates_structmemory', vtype=cohort_r8, & + long_name='ed cohort - target structural biomass set from prev year', & + units='kgC/indiv', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_structmemory_co ) + call this%set_restart_var(vname='fates_nplant', vtype=cohort_r8, & long_name='ed cohort - number of plants in the cohort', & units='/patch', flushval = flushzero, & @@ -819,16 +771,6 @@ subroutine define_restart_vars(this, initialize_variables) ! Mixed dimension variables using the cohort vector ! ----------------------------------------------------------------------------------- - call this%set_restart_var(vname='fates_cwd_ag', vtype=cohort_r8, & - long_name='coarse woody debris above ground (non-respiring), by patch x cw class', & - units='kgC/m2', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_cwd_ag_pacw ) - - call this%set_restart_var(vname='fates_cwd_bg', vtype=cohort_r8, & - long_name='coarse woody debris below ground (non-respiring), by patch x cw class', & - units='kgC/m2', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_cwd_bg_pacw ) - call this%set_restart_var(vname='fates_gnd_alb_dif', vtype=cohort_r8, & long_name='ground albedo of diffuse radiation vis and ir', & units='fraction', flushval = flushzero, & @@ -839,31 +781,6 @@ subroutine define_restart_vars(this, initialize_variables) units='fraction', flushval = flushzero, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_gnd_alb_dir_pasb ) - call this%set_restart_var(vname='fates_leaf_litter', vtype=cohort_r8, & - long_name='leaf litter, by patch x pft (non-respiring)', & - units='kgC/m2', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_leaf_litter_paft ) - - call this%set_restart_var(vname='fates_root_litter', vtype=cohort_r8, & - long_name='root litter, by patch x pft (non-respiring)', & - units='kgC/m2', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_root_litter_paft ) - - call this%set_restart_var(vname='fates_leaf_litter_in', vtype=cohort_r8, & - long_name='leaf litter flux from turnover and mort, by patch x pft', & - units='kgC/m2', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_leaf_litter_in_paft ) - - call this%set_restart_var(vname='fates_root_litter_in', vtype=cohort_r8, & - long_name='root litter flux from turnover and mort, by patch x pft', & - units='kgC/m2', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_root_litter_in_paft ) - - call this%set_restart_var(vname='fates_seed_bank', vtype=cohort_r8, & - long_name='seed pool for each functional type, by site x pft', & - units='kgC/m2/year', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_seed_bank_sift ) - call this%set_restart_var(vname='fates_spread', vtype=site_r8, & long_name='dynamic ratio of dbh to canopy area, by patch x canopy-layer', & units='cm/m2', flushval = flushzero, & @@ -892,7 +809,79 @@ subroutine define_restart_vars(this, initialize_variables) long_name='are of the ED patch', units='m2', flushval = flushzero, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_area_pa ) + + ! Site Level Diagnostics over multiple nutrients + + + ! Patch Level Litter Pools are potentially multi-element + + call this%RegisterCohortVector(symbol_base='fates_ag_cwd', vtype=cohort_r8, & + long_name_base='above ground CWD', & + units='kg/m2', veclength=num_elements, flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_agcwd_litt) + + call this%RegisterCohortVector(symbol_base='fates_bg_cwd', vtype=cohort_r8, & + long_name_base='below ground CWD', & + units='kg/m2', veclength=num_elements, flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_bgcwd_litt) + + call this%RegisterCohortVector(symbol_base='fates_leaf_fines', vtype=cohort_r8, & + long_name_base='above ground leaf litter', & + units='kg/m2', veclength=num_elements, flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_leaf_litt) + + call this%RegisterCohortVector(symbol_base='fates_fnrt_fines', vtype=cohort_r8, & + long_name_base='fine root litter', & + units='kg/m2', veclength=num_elements, flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_fnrt_litt) + + call this%RegisterCohortVector(symbol_base='fates_seed', vtype=cohort_r8, & + long_name_base='seed bank (non-germinated)', & + units='kg/m2', veclength=num_elements, flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_seed_litt) + + call this%RegisterCohortVector(symbol_base='fates_seedgerm', vtype=cohort_r8, & + long_name_base='seed bank (germinated)', & + units='kg/m2', veclength=num_elements, flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_seedgerm_litt) + + + ! Site level flux diagnostics for each element + + call this%RegisterCohortVector(symbol_base='fates_cwdagin', vtype=cohort_r8, & + long_name_base='Input flux of AG CWD', & + units='kg/ha', veclength=num_elements, flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_cwdagin_flxdg) + + call this%RegisterCohortVector(symbol_base='fates_cwdbgin', vtype=cohort_r8, & + long_name_base='Input flux of BG CWD', & + units='kg/ha', veclength=num_elements, flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_cwdbgin_flxdg) + + call this%RegisterCohortVector(symbol_base='fates_leaflittin', vtype=cohort_r8, & + long_name_base='Input flux of leaf litter', & + units='kg/ha', veclength=num_elements, flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_leaflittin_flxdg) + + call this%RegisterCohortVector(symbol_base='fates_rootlittin', vtype=cohort_r8, & + long_name_base='Input flux of root litter', & + units='kg/ha', veclength=num_elements, flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_rootlittin_flxdg) + + ! Site level Mass Balance State Accounting + + call this%RegisterCohortVector(symbol_base='fates_oldstock', vtype=site_r8, & + long_name_base='Previous total mass of all fates state variables', & + units='kg/ha', veclength=num_elements, flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_oldstock_mbal) + + call this%RegisterCohortVector(symbol_base='fates_errfates', vtype=site_r8, & + long_name_base='Previous total mass of error fates state variables', & + units='kg/ha', veclength=num_elements, flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_errfates_mbal) + + ! Only register hydraulics restart variables if it is turned on! if(hlm_use_planthydro==itrue) then @@ -1098,7 +1087,7 @@ subroutine define_restart_vars(this, initialize_variables) end subroutine define_restart_vars ! ===================================================================================== - + subroutine DefinePRTRestartVars(this,initialize_variables,ivar) ! ---------------------------------------------------------------------------------- @@ -1401,7 +1390,6 @@ subroutine set_restart_vectors(this,nc,nsites,sites) use EDTypesMod, only : ed_site_type use EDTypesMod, only : ed_cohort_type use EDTypesMod, only : ed_patch_type - use EDTypesMod, only : ncwd use EDTypesMod, only : maxSWb use EDTypesMod, only : numWaterMem use EDTypesMod, only : num_vegtemp_mem @@ -1413,7 +1401,8 @@ subroutine set_restart_vectors(this,nc,nsites,sites) type(ed_site_type) , intent(inout), target :: sites(nsites) ! Locals - integer :: s ! The local site index + integer :: s ! The local site index + type(litter_type), pointer :: litt ! pointer to patch's litter object ! ---------------------------------------------------------------------------------- ! The following group of integers indicate the positional index (idx) @@ -1428,11 +1417,16 @@ subroutine set_restart_vectors(this,nc,nsites,sites) integer :: io_idx_co ! cohort index integer :: io_idx_pa_pft ! each pft within each patch (pa_pft) integer :: io_idx_pa_cwd ! each cwd class within each patch (pa_cwd) + integer :: io_idx_pa_cwsl ! each cwd x soil layer + integer :: io_idx_pa_dcsl ! each decomposability x soil layer + integer :: io_idx_pa_dc ! each decomposability index integer :: io_idx_pa_ib ! each SW band (vis/ir) per patch (pa_ib) integer :: io_idx_si_wmem ! each water memory class within each site integer :: io_idx_si_lyr_shell ! site - layer x shell index integer :: io_idx_si_scpf ! each size-class x pft index within site integer :: io_idx_si_sc ! each size-class index within site + 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 ! Some counters (for checking mostly) @@ -1441,11 +1435,15 @@ subroutine set_restart_vectors(this,nc,nsites,sites) integer :: cohortsperpatch ! number of cohorts per patch integer :: ft ! functional type index + integer :: el ! element loop index + integer :: ilyr ! soil layer index + integer :: nlevsoil ! total soil layers in patch of interest integer :: k,j,i ! indices to the radiation matrix integer :: ir_prt_var ! loop counter for var x position integer :: i_var ! loop counter for PRT variables integer :: i_pos ! loop counter for discrete PRT positions integer :: i_scls ! loop counter for size-class + integer :: i_cwd ! loop counter for cwd integer :: i_pft ! loop counter for pft type(fates_restart_variable_type) :: rvar @@ -1454,7 +1452,6 @@ subroutine set_restart_vectors(this,nc,nsites,sites) associate( rio_npatch_si => this%rvars(ir_npatch_si)%int1d, & - rio_old_stock_si => this%rvars(ir_oldstock_si)%r81d, & rio_cd_status_si => this%rvars(ir_cd_status_si)%int1d, & rio_dd_status_si => this%rvars(ir_dd_status_si)%int1d, & rio_nchill_days_si => this%rvars(ir_nchill_days_si)%int1d, & @@ -1465,18 +1462,6 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_dleafoffdate_si => this%rvars(ir_dleafoffdate_si)%int1d, & rio_acc_ni_si => this%rvars(ir_acc_ni_si)%r81d, & rio_gdd_si => this%rvars(ir_gdd_si)%r81d, & - rio_nep_timeintegrated_si => this%rvars(ir_nep_timeintegrated_si)%r81d, & - rio_npp_timeintegrated_si => this%rvars(ir_npp_timeintegrated_si)%r81d, & - rio_hr_timeintegrated_si => this%rvars(ir_hr_timeintegrated_si)%r81d, & - rio_cbal_err_fates_si => this%rvars(ir_cbal_error_fates_si)%r81d, & - rio_cbal_err_bgc_si => this%rvars(ir_cbal_error_bgc_si)%r81d, & - rio_cbal_err_tot_si => this%rvars(ir_cbal_error_total_si)%r81d, & - rio_totecosysc_old_si => this%rvars(ir_totecosysc_old_si)%r81d, & - rio_totfatesc_old_si => this%rvars(ir_totfatesc_old_si)%r81d, & - rio_totbgcc_old_si => this%rvars(ir_totbgcc_old_si)%r81d, & - rio_fates_to_bgc_this_ts_si => this%rvars(ir_fates_to_bgc_this_ts_si)%r81d, & - rio_fates_to_bgc_last_ts_si => this%rvars(ir_fates_to_bgc_last_ts_si)%r81d, & - rio_seedrainflux_si => this%rvars(ir_seedrainflux_si)%r81d, & rio_trunk_product_si => this%rvars(ir_trunk_product_si)%r81d, & rio_ncohort_pa => this%rvars(ir_ncohort_pa)%int1d, & rio_solar_zenith_flag_pa => this%rvars(ir_solar_zenith_flag_pa)%int1d, & @@ -1484,11 +1469,14 @@ subroutine set_restart_vectors(this,nc,nsites,sites) 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_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, & rio_dbh_co => this%rvars(ir_dbh_co)%r81d, & rio_g_sb_laweight_co => this%rvars(ir_g_sb_laweight_co)%r81d, & rio_height_co => this%rvars(ir_height_co)%r81d, & rio_laimemory_co => this%rvars(ir_laimemory_co)%r81d, & + rio_sapwmemory_co => this%rvars(ir_sapwmemory_co)%r81d, & + rio_structmemory_co => this%rvars(ir_structmemory_co)%r81d, & rio_nplant_co => this%rvars(ir_nplant_co)%r81d, & rio_gpp_acc_co => this%rvars(ir_gpp_acc_co)%r81d, & rio_npp_acc_co => this%rvars(ir_npp_acc_co)%r81d, & @@ -1508,15 +1496,8 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_pft_co => this%rvars(ir_pft_co)%int1d, & rio_status_co => this%rvars(ir_status_co)%int1d, & rio_isnew_co => this%rvars(ir_isnew_co)%int1d, & - rio_cwd_ag_pacw => this%rvars(ir_cwd_ag_pacw)%r81d, & - rio_cwd_bg_pacw => this%rvars(ir_cwd_bg_pacw)%r81d, & rio_gnd_alb_dif_pasb => this%rvars(ir_gnd_alb_dif_pasb)%r81d, & rio_gnd_alb_dir_pasb => this%rvars(ir_gnd_alb_dir_pasb)%r81d, & - rio_leaf_litter_paft => this%rvars(ir_leaf_litter_paft)%r81d, & - rio_root_litter_paft => this%rvars(ir_root_litter_paft)%r81d, & - rio_leaf_litter_in_paft => this%rvars(ir_leaf_litter_in_paft)%r81d, & - rio_root_litter_in_paft => this%rvars(ir_root_litter_in_paft)%r81d, & - rio_seed_bank_sift => this%rvars(ir_seed_bank_sift)%r81d, & rio_spread_si => this%rvars(ir_spread_si)%r81d, & rio_livegrass_pa => this%rvars(ir_livegrass_pa)%r81d, & rio_age_pa => this%rvars(ir_age_pa)%r81d, & @@ -1564,8 +1545,6 @@ subroutine set_restart_vectors(this,nc,nsites,sites) io_idx_co_1st = this%restart_map(nc)%cohort1_index(s) io_idx_co = io_idx_co_1st - io_idx_pa_pft = io_idx_co_1st - io_idx_pa_cwd = io_idx_co_1st io_idx_pa_ib = io_idx_co_1st io_idx_si_wmem = io_idx_co_1st io_idx_si_vtmem = io_idx_co_1st @@ -1577,12 +1556,34 @@ subroutine set_restart_vectors(this,nc,nsites,sites) io_idx_si_sc = io_idx_co_1st - ! write seed_bank info(site-level, but PFT-resolved) + ! recruitment rate do i_pft = 1,numpft - rio_seed_bank_sift(io_idx_co_1st+i_pft-1) = sites(s)%seed_bank(i_pft) rio_recrate_sift(io_idx_co_1st+i_pft-1) = sites(s)%recruitment_rate(i_pft) end do + do el = 1, num_elements + + io_idx_si_cwd = io_idx_co_1st + io_idx_si_pft = io_idx_co_1st + + do i_cwd=1,ncwd + this%rvars(ir_cwdagin_flxdg+el-1)%r81d(io_idx_si_cwd) = sites(s)%flux_diags(el)%cwd_ag_input(i_cwd) + this%rvars(ir_cwdbgin_flxdg+el-1)%r81d(io_idx_si_cwd) = sites(s)%flux_diags(el)%cwd_bg_input(i_cwd) + io_idx_si_cwd = io_idx_si_cwd + 1 + end do + + do i_pft=1,numpft + this%rvars(ir_leaflittin_flxdg+el-1)%r81d(io_idx_si_pft) = sites(s)%flux_diags(el)%leaf_litter_input(i_pft) + this%rvars(ir_rootlittin_flxdg+el-1)%r81d(io_idx_si_pft) = sites(s)%flux_diags(el)%root_litter_input(i_pft) + io_idx_si_pft = io_idx_si_pft + 1 + end do + + this%rvars(ir_oldstock_mbal+el-1)%r81d(io_idx_si) = sites(s)%mass_balance(el)%old_stock + this%rvars(ir_errfates_mbal+el-1)%r81d(io_idx_si) = sites(s)%mass_balance(el)%err_fates + + end do + + ! canopy spread term rio_spread_si(io_idx_si) = sites(s)%spread @@ -1671,10 +1672,13 @@ 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_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 rio_dbh_co(io_idx_co) = ccohort%dbh rio_height_co(io_idx_co) = ccohort%hite rio_laimemory_co(io_idx_co) = ccohort%laimemory + rio_sapwmemory_co(io_idx_co) = ccohort%sapwmemory + rio_structmemory_co(io_idx_co) = ccohort%structmemory rio_g_sb_laweight_co(io_idx_co)= ccohort%g_sb_laweight rio_nplant_co(io_idx_co) = ccohort%n @@ -1740,24 +1744,50 @@ subroutine set_restart_vectors(this,nc,nsites,sites) write(fates_log(),*) 'offsetNumCohorts III ' & ,io_idx_co,cohortsperpatch endif - ! - ! deal with patch level fields of arrays here - ! - ! these are arrays of length numpft, each patch contains one - ! vector so we increment - do i = 1,numpft - rio_leaf_litter_paft(io_idx_pa_pft) = cpatch%leaf_litter(i) - rio_root_litter_paft(io_idx_pa_pft) = cpatch%root_litter(i) - rio_leaf_litter_in_paft(io_idx_pa_pft) = cpatch%leaf_litter_in(i) - rio_root_litter_in_paft(io_idx_pa_pft) = cpatch%root_litter_in(i) - io_idx_pa_pft = io_idx_pa_pft + 1 - end do - - do i = 1,ncwd ! ncwd currently 4 - rio_cwd_ag_pacw(io_idx_pa_cwd) = cpatch%cwd_ag(i) - rio_cwd_bg_pacw(io_idx_pa_cwd) = cpatch%cwd_bg(i) - io_idx_pa_cwd = io_idx_pa_cwd + 1 + + ! -------------------------------------------------------------------------- + ! Send litter to the restart arrays + ! Each element has its own variable, so we have to make sure + ! we keep re-setting this + ! -------------------------------------------------------------------------- + + do el = 0, num_elements-1 + + io_idx_pa_pft = io_idx_co_1st + io_idx_pa_cwd = io_idx_co_1st + io_idx_pa_cwsl = io_idx_co_1st + io_idx_pa_dcsl = io_idx_co_1st + io_idx_pa_dc = io_idx_co_1st + + litt => cpatch%litter(el+1) + + do i = 1,numpft + this%rvars(ir_seed_litt+el)%r81d(io_idx_pa_pft) = litt%seed(i) + this%rvars(ir_seedgerm_litt+el)%r81d(io_idx_pa_pft) = litt%seed_germ(i) + io_idx_pa_pft = io_idx_pa_pft + 1 + end do + + + do i = 1,ndcmpy + this%rvars(ir_leaf_litt+el)%r81d(io_idx_pa_dc) = litt%leaf_fines(i) + io_idx_pa_dc = io_idx_pa_dc + 1 + do ilyr=1,sites(s)%nlevsoil + this%rvars(ir_fnrt_litt+el)%r81d(io_idx_pa_dcsl) = litt%root_fines(i,ilyr) + io_idx_pa_dcsl = io_idx_pa_dcsl + 1 + end do + end do + + do i = 1,ncwd + this%rvars(ir_agcwd_litt+el)%r81d(io_idx_pa_cwd) = litt%ag_cwd(i) + io_idx_pa_cwd = io_idx_pa_cwd + 1 + do ilyr=1,sites(s)%nlevsoil + this%rvars(ir_bgcwd_litt+el)%r81d(io_idx_pa_cwsl) = litt%bg_cwd(i,ilyr) + io_idx_pa_cwsl = io_idx_pa_cwsl + 1 + end do + end do + end do + do i = 1,maxSWb rio_gnd_alb_dif_pasb(io_idx_pa_ib) = cpatch%gnd_alb_dif(i) @@ -1818,32 +1848,18 @@ subroutine set_restart_vectors(this,nc,nsites,sites) 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_old_stock_si(io_idx_si) = sites(s)%old_stock 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 rio_ncold_days_si(io_idx_si) = sites(s)%ncolddays rio_leafondate_si(io_idx_si) = sites(s)%cleafondate rio_leafoffdate_si(io_idx_si) = sites(s)%cleafoffdate + rio_dleafondate_si(io_idx_si) = sites(s)%dleafondate rio_dleafoffdate_si(io_idx_si) = sites(s)%dleafoffdate rio_acc_ni_si(io_idx_si) = sites(s)%acc_NI rio_gdd_si(io_idx_si) = sites(s)%grow_deg_days - ! Carbon Balance and Checks - rio_nep_timeintegrated_si(io_idx_si) = sites(s)%nep_timeintegrated - rio_npp_timeintegrated_si(io_idx_si) = sites(s)%npp_timeintegrated - rio_hr_timeintegrated_si(io_idx_si) = sites(s)%hr_timeintegrated - rio_totecosysc_old_si(io_idx_si) = sites(s)%totecosysc_old - rio_totfatesc_old_si(io_idx_si) = sites(s)%totfatesc_old - rio_totbgcc_old_si(io_idx_si) = sites(s)%totbgcc_old - rio_cbal_err_fates_si(io_idx_si) = sites(s)%cbal_err_fates - rio_cbal_err_bgc_si(io_idx_si) = sites(s)%cbal_err_bgc - rio_cbal_err_tot_si(io_idx_si) = sites(s)%cbal_err_tot - rio_fates_to_bgc_this_ts_si(io_idx_si) = sites(s)%fates_to_bgc_this_ts - rio_fates_to_bgc_last_ts_si(io_idx_si) = sites(s)%fates_to_bgc_last_ts - rio_seedrainflux_si(io_idx_si) = sites(s)%tot_seed_rain_flux - ! Accumulated trunk product rio_trunk_product_si(io_idx_si) = sites(s)%resources_management%trunk_product_site ! set numpatches for this column @@ -1910,15 +1926,12 @@ subroutine create_patchcohort_structure(this, nc, nsites, sites, bc_in) use EDTypesMod, only : ed_site_type use EDTypesMod, only : ed_cohort_type use EDTypesMod, only : ed_patch_type - use EDTypesMod, only : ncwd use EDTypesMod, only : maxSWb - use EDTypesMod, only : nan_leaf_aclass use FatesInterfaceMod, only : fates_maxElementsPerPatch use EDTypesMod, only : maxpft use EDTypesMod, only : area use EDPatchDynamicsMod, only : zero_patch - use EDCohortDynamicsMod, only : create_cohort use EDInitMod, only : zero_site use EDInitMod, only : init_site_vars use EDPatchDynamicsMod, only : create_patch @@ -1938,11 +1951,6 @@ subroutine create_patchcohort_structure(this, nc, nsites, sites, bc_in) type(ed_patch_type) , pointer :: newp type(ed_cohort_type), pointer :: new_cohort type(ed_cohort_type), pointer :: prev_cohort - real(r8) :: cwd_ag_local(ncwd) - real(r8) :: cwd_bg_local(ncwd) - real(r8) :: leaf_litter_local(maxpft) - real(r8) :: root_litter_local(maxpft) - real(r8) :: patch_age integer :: cohortstatus integer :: s ! site index integer :: idx_pa ! local patch index @@ -1951,17 +1959,9 @@ subroutine create_patchcohort_structure(this, nc, nsites, sites, bc_in) real(r8) :: site_spread ! site sprea dummy var (0-1) integer :: fto integer :: ft + integer :: el ! element loop counter integer, parameter :: recruitstatus = 0 - - ! Dummy arguments used for calling create patch, these will be overwritten before - ! run-time. Just used now for allocation. - cwd_ag_local(:) = 0.0_r8 - cwd_bg_local(:) = 0.0_r8 - leaf_litter_local(:) = 0.0_r8 - root_litter_local(:) = 0.0_r8 - patch_age = 0.0_r8 - ! ---------------------------------------------------------------------------------- ! We really only need the counts for the number of patches per site ! and the number of cohorts per patch. These values tell us how much @@ -1975,8 +1975,8 @@ subroutine create_patchcohort_structure(this, nc, nsites, sites, bc_in) io_idx_si = this%restart_map(nc)%site_index(s) io_idx_co_1st = this%restart_map(nc)%cohort1_index(s) - - call init_site_vars( sites(s) ) + + call init_site_vars( sites(s), bc_in(s) ) call zero_site( sites(s) ) if ( rio_npatch_si(io_idx_si)<0 .or. rio_npatch_si(io_idx_si) > 10000 ) then @@ -2000,15 +2000,25 @@ subroutine create_patchcohort_structure(this, nc, nsites, sites, bc_in) allocate(newp) ! make new patch - call create_patch(sites(s), newp, patch_age, area, & - cwd_ag_local, cwd_bg_local, & - leaf_litter_local, root_litter_local,bc_in(s)%nlevsoil, primaryforest) + call create_patch(sites(s), newp, fates_unset_r8, fates_unset_r8, primaryforest ) + + ! Initialize the litter pools to zero, these + ! pools will be populated by looping over the existing patches + ! and transfering in mass + do el=1,num_elements + call newp%litter(el)%InitConditions(init_leaf_fines=fates_unset_r8, & + init_root_fines=fates_unset_r8, & + init_ag_cwd=fates_unset_r8, & + init_bg_cwd=fates_unset_r8, & + init_seed=fates_unset_r8, & + init_seed_germ=fates_unset_r8) + end do ! give this patch a unique patch number newp%patchno = idx_pa - ! Iterate over the number of cohorts + ! Iterate over the number of cohorts ! the file says are associated with this patch ! we are just allocating space here, so we do ! a simple list filling routine @@ -2038,9 +2048,13 @@ subroutine create_patchcohort_structure(this, nc, nsites, sites, bc_in) ! Every cohort added takes over as shortest newp%shortest => new_cohort + + ! Initialize the PARTEH object and point to the + ! correct boundary condition fields + new_cohort%prt => null() + call InitPRTObject(new_cohort%prt) + call InitPRTBoundaryConditions(new_cohort) - ! Initialize the PRT environment (allocate/choose hypothesis only) - call InitPRTCohort(new_cohort) ! Allocate hydraulics arrays if( hlm_use_planthydro.eq.itrue ) then @@ -2104,7 +2118,6 @@ subroutine get_restart_vectors(this, nc, nsites, sites) use EDTypesMod, only : ed_site_type use EDTypesMod, only : ed_cohort_type use EDTypesMod, only : ed_patch_type - use EDTypesMod, only : ncwd use EDTypesMod, only : maxSWb use FatesInterfaceMod, only : numpft use FatesInterfaceMod, only : fates_maxElementsPerPatch @@ -2124,7 +2137,7 @@ subroutine get_restart_vectors(this, nc, nsites, sites) ! LL pointers type(ed_patch_type),pointer :: cpatch ! current patch type(ed_cohort_type),pointer :: ccohort ! current cohort - + type(litter_type), pointer :: litt ! litter object on the current patch ! loop indices integer :: s, i, j, k @@ -2141,25 +2154,33 @@ subroutine get_restart_vectors(this, nc, nsites, sites) integer :: io_idx_co ! cohort index integer :: io_idx_pa_pft ! each pft within each patch (pa_pft) integer :: io_idx_pa_cwd ! each cwd class within each patch (pa_cwd) + integer :: io_idx_pa_cwsl ! each cwd x soil layer + integer :: io_idx_pa_dcsl ! each decomposability x soil layer + integer :: io_idx_pa_dc ! each decomposability index integer :: io_idx_pa_ib ! each SW radiation band per patch (pa_ib) integer :: io_idx_si_wmem ! each water memory class within each site integer :: io_idx_si_vtmem ! counter for vegetation temp memory integer :: io_idx_si_lyr_shell ! site - layer x shell index integer :: io_idx_si_scpf ! each size-class x pft index within site integer :: io_idx_si_sc ! each size-class index within site + integer :: io_idx_si_cwd + integer :: io_idx_si_pft ! Some counters (for checking mostly) integer :: totalcohorts ! total cohort count on this thread (diagnostic) integer :: patchespersite ! number of patches per site integer :: cohortsperpatch ! number of cohorts per patch + integer :: el ! loop counter for elements + integer :: nlevsoil ! number of soil layers + integer :: ilyr ! soil layer loop counter integer :: ir_prt_var ! loop counter for var x position + integer :: i_cwd ! loop counter for cwd integer :: i_var ! loop counter for PRT variables integer :: i_pos ! loop counter for discrete PRT positions integer :: i_pft ! loop counter for pft integer :: i_scls ! loop counter for size-class associate( rio_npatch_si => this%rvars(ir_npatch_si)%int1d, & - rio_old_stock_si => this%rvars(ir_oldstock_si)%r81d, & rio_cd_status_si => this%rvars(ir_cd_status_si)%int1d, & rio_dd_status_si => this%rvars(ir_dd_status_si)%int1d, & rio_nchill_days_si => this%rvars(ir_nchill_days_si)%int1d, & @@ -2170,18 +2191,6 @@ subroutine get_restart_vectors(this, nc, nsites, sites) rio_dleafoffdate_si => this%rvars(ir_dleafoffdate_si)%int1d, & rio_acc_ni_si => this%rvars(ir_acc_ni_si)%r81d, & rio_gdd_si => this%rvars(ir_gdd_si)%r81d, & - rio_nep_timeintegrated_si => this%rvars(ir_nep_timeintegrated_si)%r81d, & - rio_npp_timeintegrated_si => this%rvars(ir_npp_timeintegrated_si)%r81d, & - rio_hr_timeintegrated_si => this%rvars(ir_hr_timeintegrated_si)%r81d, & - rio_cbal_err_fates_si => this%rvars(ir_cbal_error_fates_si)%r81d, & - rio_cbal_err_bgc_si => this%rvars(ir_cbal_error_bgc_si)%r81d, & - rio_cbal_err_tot_si => this%rvars(ir_cbal_error_total_si)%r81d, & - rio_totecosysc_old_si => this%rvars(ir_totecosysc_old_si)%r81d, & - rio_totfatesc_old_si => this%rvars(ir_totfatesc_old_si)%r81d, & - rio_totbgcc_old_si => this%rvars(ir_totbgcc_old_si)%r81d, & - rio_fates_to_bgc_this_ts_si => this%rvars(ir_fates_to_bgc_this_ts_si)%r81d, & - rio_fates_to_bgc_last_ts_si => this%rvars(ir_fates_to_bgc_last_ts_si)%r81d, & - rio_seedrainflux_si => this%rvars(ir_seedrainflux_si)%r81d, & rio_trunk_product_si => this%rvars(ir_trunk_product_si)%r81d, & rio_ncohort_pa => this%rvars(ir_ncohort_pa)%int1d, & rio_solar_zenith_flag_pa => this%rvars(ir_solar_zenith_flag_pa)%int1d, & @@ -2189,11 +2198,14 @@ subroutine get_restart_vectors(this, nc, nsites, sites) 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_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, & rio_dbh_co => this%rvars(ir_dbh_co)%r81d, & rio_g_sb_laweight_co => this%rvars(ir_g_sb_laweight_co)%r81d, & rio_height_co => this%rvars(ir_height_co)%r81d, & rio_laimemory_co => this%rvars(ir_laimemory_co)%r81d, & + rio_sapwmemory_co => this%rvars(ir_sapwmemory_co)%r81d, & + rio_structmemory_co => this%rvars(ir_structmemory_co)%r81d, & rio_nplant_co => this%rvars(ir_nplant_co)%r81d, & rio_gpp_acc_co => this%rvars(ir_gpp_acc_co)%r81d, & rio_npp_acc_co => this%rvars(ir_npp_acc_co)%r81d, & @@ -2213,15 +2225,8 @@ subroutine get_restart_vectors(this, nc, nsites, sites) rio_pft_co => this%rvars(ir_pft_co)%int1d, & rio_status_co => this%rvars(ir_status_co)%int1d, & rio_isnew_co => this%rvars(ir_isnew_co)%int1d, & - rio_cwd_ag_pacw => this%rvars(ir_cwd_ag_pacw)%r81d, & - rio_cwd_bg_pacw => this%rvars(ir_cwd_bg_pacw)%r81d, & rio_gnd_alb_dif_pasb => this%rvars(ir_gnd_alb_dif_pasb)%r81d, & rio_gnd_alb_dir_pasb => this%rvars(ir_gnd_alb_dir_pasb)%r81d, & - rio_leaf_litter_paft => this%rvars(ir_leaf_litter_paft)%r81d, & - rio_root_litter_paft => this%rvars(ir_root_litter_paft)%r81d, & - rio_leaf_litter_in_paft => this%rvars(ir_leaf_litter_in_paft)%r81d, & - rio_root_litter_in_paft => this%rvars(ir_root_litter_in_paft)%r81d, & - rio_seed_bank_sift => this%rvars(ir_seed_bank_sift)%r81d, & rio_spread_si => this%rvars(ir_spread_si)%r81d, & rio_livegrass_pa => this%rvars(ir_livegrass_pa)%r81d, & rio_age_pa => this%rvars(ir_age_pa)%r81d, & @@ -2258,8 +2263,6 @@ subroutine get_restart_vectors(this, nc, nsites, sites) io_idx_co_1st = this%restart_map(nc)%cohort1_index(s) io_idx_co = io_idx_co_1st - io_idx_pa_pft = io_idx_co_1st - io_idx_pa_cwd = io_idx_co_1st io_idx_pa_ib = io_idx_co_1st io_idx_si_wmem = io_idx_co_1st io_idx_si_vtmem = io_idx_co_1st @@ -2272,16 +2275,37 @@ subroutine get_restart_vectors(this, nc, nsites, sites) ! read seed_bank info(site-level, but PFT-resolved) do i_pft = 1,numpft - sites(s)%seed_bank(i_pft) = rio_seed_bank_sift(io_idx_co_1st+i_pft-1) sites(s)%recruitment_rate(i_pft) = rio_recrate_sift(io_idx_co_1st+i_pft-1) enddo + + ! Mass balance and diagnostics across elements at the site level + do el = 1, num_elements + + io_idx_si_cwd = io_idx_co_1st + io_idx_si_pft = io_idx_co_1st + + do i_cwd=1,ncwd + sites(s)%flux_diags(el)%cwd_ag_input(i_cwd) = this%rvars(ir_cwdagin_flxdg+el-1)%r81d(io_idx_si_cwd) + sites(s)%flux_diags(el)%cwd_bg_input(i_cwd) = this%rvars(ir_cwdbgin_flxdg+el-1)%r81d(io_idx_si_cwd) + io_idx_si_cwd = io_idx_si_cwd + 1 + end do + + do i_pft=1,numpft + sites(s)%flux_diags(el)%leaf_litter_input(i_pft) = this%rvars(ir_leaflittin_flxdg+el-1)%r81d(io_idx_si_pft) + sites(s)%flux_diags(el)%root_litter_input(i_pft) = this%rvars(ir_rootlittin_flxdg+el-1)%r81d(io_idx_si_pft) + io_idx_si_pft = io_idx_si_pft + 1 + end do + + sites(s)%mass_balance(el)%old_stock = this%rvars(ir_oldstock_mbal+el-1)%r81d(io_idx_si) + sites(s)%mass_balance(el)%err_fates = this%rvars(ir_errfates_mbal+el-1)%r81d(io_idx_si) + + end do + sites(s)%spread = rio_spread_si(io_idx_si) ! Perform a check on the number of patches per site patchespersite = 0 - - cpatch => sites(s)%oldest_patch do while(associated(cpatch)) @@ -2339,11 +2363,14 @@ 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%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) ccohort%dbh = rio_dbh_co(io_idx_co) ccohort%g_sb_laweight= rio_g_sb_laweight_co(io_idx_co) ccohort%hite = rio_height_co(io_idx_co) ccohort%laimemory = rio_laimemory_co(io_idx_co) + ccohort%sapwmemory = rio_sapwmemory_co(io_idx_co) + ccohort%structmemory= rio_structmemory_co(io_idx_co) ccohort%n = rio_nplant_co(io_idx_co) ccohort%gpp_acc = rio_gpp_acc_co(io_idx_co) ccohort%npp_acc = rio_npp_acc_co(io_idx_co) @@ -2408,13 +2435,6 @@ subroutine get_restart_vectors(this, nc, nsites, sites) call endrun(msg=errMsg(sourcefile, __LINE__)) end if - - ! FIX(SPM,032414) move to init if you can...or make a new init function - cpatch%leaf_litter(:) = 0.0_r8 - cpatch%root_litter(:) = 0.0_r8 - cpatch%leaf_litter_in(:) = 0.0_r8 - cpatch%root_litter_in(:) = 0.0_r8 - ! ! deal with patch level fields here ! @@ -2435,27 +2455,52 @@ subroutine get_restart_vectors(this, nc, nsites, sites) write(fates_log(),*) 'CVTL III ' & ,io_idx_co,cohortsperpatch endif - - ! - ! deal with patch level fields of arrays here - ! - ! these are arrays of length numpft, each patch contains one - ! vector so we increment - - do i = 1,numpft - cpatch%leaf_litter(i) = rio_leaf_litter_paft(io_idx_pa_pft) - cpatch%root_litter(i) = rio_root_litter_paft(io_idx_pa_pft) - cpatch%leaf_litter_in(i) = rio_leaf_litter_in_paft(io_idx_pa_pft) - cpatch%root_litter_in(i) = rio_root_litter_in_paft(io_idx_pa_pft) - io_idx_pa_pft = io_idx_pa_pft + 1 - enddo - - do i = 1,ncwd ! ncwd currently 4 - cpatch%cwd_ag(i) = rio_cwd_ag_pacw(io_idx_pa_cwd) - cpatch%cwd_bg(i) = rio_cwd_bg_pacw(io_idx_pa_cwd) - io_idx_pa_cwd = io_idx_pa_cwd + 1 - enddo + ! -------------------------------------------------------------------------- + ! Pull litter from the restart arrays + ! Each element has its own variable, so we have to make sure + ! we keep re-setting this + ! -------------------------------------------------------------------------- + + do el = 0, num_elements-1 + + io_idx_pa_pft = io_idx_co_1st + io_idx_pa_cwd = io_idx_co_1st + io_idx_pa_cwsl = io_idx_co_1st + io_idx_pa_dcsl = io_idx_co_1st + io_idx_pa_dc = io_idx_co_1st + + litt => cpatch%litter(el+1) + nlevsoil = size(litt%bg_cwd,dim=2) + + do i = 1,numpft + litt%seed(i) = this%rvars(ir_seed_litt+el)%r81d(io_idx_pa_pft) + litt%seed_germ(i) = this%rvars(ir_seedgerm_litt+el)%r81d(io_idx_pa_pft) + io_idx_pa_pft = io_idx_pa_pft + 1 + end do + + do i = 1,ndcmpy + litt%leaf_fines(i) = this%rvars(ir_leaf_litt+el)%r81d(io_idx_pa_dc) + io_idx_pa_dc = io_idx_pa_dc + 1 + do ilyr=1,nlevsoil + litt%root_fines(i,ilyr) = this%rvars(ir_fnrt_litt+el)%r81d(io_idx_pa_dcsl) + io_idx_pa_dcsl = io_idx_pa_dcsl + 1 + end do + end do + + do i = 1,ncwd + + litt%ag_cwd(i) = this%rvars(ir_agcwd_litt+el)%r81d(io_idx_pa_cwd) + io_idx_pa_cwd = io_idx_pa_cwd + 1 + + do ilyr=1,nlevsoil + litt%bg_cwd(i,ilyr) = this%rvars(ir_bgcwd_litt+el)%r81d(io_idx_pa_cwsl) + io_idx_pa_cwsl = io_idx_pa_cwsl + 1 + end do + end do + + end do + do i = 1,maxSWb cpatch%gnd_alb_dif(i) = rio_gnd_alb_dif_pasb(io_idx_pa_ib) cpatch%gnd_alb_dir(i) = rio_gnd_alb_dir_pasb(io_idx_pa_ib) @@ -2559,7 +2604,6 @@ subroutine get_restart_vectors(this, nc, nsites, sites) 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)%old_stock = rio_old_stock_si(io_idx_si) ! Site level phenology status flags @@ -2574,19 +2618,6 @@ subroutine get_restart_vectors(this, nc, nsites, sites) sites(s)%acc_NI = rio_acc_ni_si(io_idx_si) sites(s)%grow_deg_days = rio_gdd_si(io_idx_si) - ! Carbon Balance and Checks - sites(s)%nep_timeintegrated = rio_nep_timeintegrated_si(io_idx_si) - sites(s)%npp_timeintegrated = rio_npp_timeintegrated_si(io_idx_si) - sites(s)%hr_timeintegrated = rio_hr_timeintegrated_si(io_idx_si) - sites(s)%totecosysc_old = rio_totecosysc_old_si(io_idx_si) - sites(s)%totfatesc_old = rio_totfatesc_old_si(io_idx_si) - sites(s)%totbgcc_old = rio_totbgcc_old_si(io_idx_si) - sites(s)%cbal_err_fates = rio_cbal_err_fates_si(io_idx_si) - sites(s)%cbal_err_bgc = rio_cbal_err_bgc_si(io_idx_si) - sites(s)%cbal_err_tot = rio_cbal_err_tot_si(io_idx_si) - sites(s)%fates_to_bgc_this_ts = rio_fates_to_bgc_this_ts_si(io_idx_si) - sites(s)%fates_to_bgc_last_ts = rio_fates_to_bgc_last_ts_si(io_idx_si) - sites(s)%tot_seed_rain_flux = rio_seedrainflux_si(io_idx_si) sites(s)%resources_management%trunk_product_site = rio_trunk_product_si(io_idx_si) end do diff --git a/main/FatesRestartVariableType.F90 b/main/FatesRestartVariableType.F90 index 48152adf7f..48152ec955 100644 --- a/main/FatesRestartVariableType.F90 +++ b/main/FatesRestartVariableType.F90 @@ -5,10 +5,11 @@ module FatesRestartVariableMod use FatesIOVariableKindMod, only : fates_io_variable_kind_type implicit none + private ! Modules are private by default ! This type is instanteated in the HLM-FATES interface (clmfates_interfaceMod.F90) - type fates_restart_variable_type + type, public :: fates_restart_variable_type character(len=32) :: vname character(len=24) :: units character(len=128) :: long @@ -23,9 +24,14 @@ module FatesRestartVariableMod real(r8), pointer :: r81d(:) integer, pointer :: int1d(:) contains - procedure, public :: Init - procedure, public :: Flush + + ! Public restart type functions + procedure :: Init + procedure :: Flush + + ! Private restart type functions procedure, private :: GetBounds + end type fates_restart_variable_type contains diff --git a/main/FatesSizeAgeTypeIndicesMod.F90 b/main/FatesSizeAgeTypeIndicesMod.F90 index aa14f9c9b6..383621a55e 100644 --- a/main/FatesSizeAgeTypeIndicesMod.F90 +++ b/main/FatesSizeAgeTypeIndicesMod.F90 @@ -9,6 +9,16 @@ module FatesSizeAgeTypeIndicesMod use EDParamsMod, only : ED_val_history_height_bin_edges implicit none + private ! Modules are private by default + + ! Make public necessary subroutines and functions + public :: get_age_class_index + public :: get_sizeage_class_index + public :: sizetype_class_index + public :: get_size_class_index + public :: get_height_index + public :: get_sizeagepft_class_index + public :: get_agepft_class_index contains diff --git a/main/FatesSynchronizedParamsMod.F90 b/main/FatesSynchronizedParamsMod.F90 index 57c6143934..7f35b8eeec 100644 --- a/main/FatesSynchronizedParamsMod.F90 +++ b/main/FatesSynchronizedParamsMod.F90 @@ -1,29 +1,43 @@ module FatesSynchronizedParamsMod + ! NOTE: We currently do NOT use any "shared" or syncronized parameters + ! between FATES and its hosts. We previously shared q10 values. + ! I will leave these values commented out instead of deleted + ! to serve as a template for the possibility of future parameters. + ! RGK 05-2019 + + !----------------------------------------------------------------------- ! ! !USES: use FatesConstantsMod, only : r8 => fates_r8 + implicit none + private ! Modules are private by default ! FatesSynchronizedParamsInst. PGI wants the type decl. public but the instance ! is indeed protected. A generic private statement at the start of the module ! overrides the protected functionality with PGI type, public :: FatesSynchronizedParamsType - real(r8) :: Q10 ! temperature dependence - real(r8) :: froz_q10 ! separate q10 for frozen soil respiration rates +! real(r8) :: Q10 ! temperature dependence +! real(r8) :: froz_q10 ! separate q10 for frozen soil respiration rates contains - procedure, public :: RegisterParams - procedure, public :: ReceiveParams + + ! Public member functions + procedure :: RegisterParams + procedure :: ReceiveParams + + ! Private member functions procedure, private :: Init procedure, private :: RegisterParamsScalar procedure, private :: ReceiveParamsScalar + end type FatesSynchronizedParamsType type(FatesSynchronizedParamsType), public :: FatesSynchronizedParamsInst - character(len=*), parameter, private :: sourcefile = & + character(len=*), parameter :: sourcefile = & __FILE__ !----------------------------------------------------------------------- @@ -40,8 +54,8 @@ subroutine Init(this) class(FatesSynchronizedParamsType), intent(inout) :: this - this%Q10 = nan - this%froz_q10 = nan +! this%Q10 = nan +! this%froz_q10 = nan end subroutine Init @@ -96,13 +110,6 @@ subroutine RegisterParamsScalar(this, fates_params) call this%Init() - name = 'q10_mr' - call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names, sync_with_host=.true.) - - name = 'froz_q10' - call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names, sync_with_host=.true.) end subroutine RegisterParamsScalar @@ -118,13 +125,13 @@ subroutine ReceiveParamsScalar(this, fates_params) character(len=param_string_length) :: name - name = 'q10_mr' - call fates_params%RetreiveParameter(name=name, & - data=this%Q10) +! name = 'q10_mr' +! call fates_params%RetreiveParameter(name=name, & +! data=this%Q10) - name = 'froz_q10' - call fates_params%RetreiveParameter(name=name, & - data=this%froz_q10) +! name = 'froz_q10' +! call fates_params%RetreiveParameter(name=name, & +! data=this%froz_q10) end subroutine ReceiveParamsScalar diff --git a/main/FatesUtilsMod.F90 b/main/FatesUtilsMod.F90 index fa48eef8d9..20416e16d6 100644 --- a/main/FatesUtilsMod.F90 +++ b/main/FatesUtilsMod.F90 @@ -6,6 +6,13 @@ module FatesUtilsMod use FatesConstantsMod, only : r8 => fates_r8 use FatesGlobals, only : fates_log + implicit none + private ! Modules are private by default + + ! Make public necessary subroutines and functions + public :: check_hlm_list + public :: check_var_real + contains diff --git a/parameter_files/fates_params_default.cdl b/parameter_files/fates_params_default.cdl index 39787c469f..7de15e60bc 100644 --- a/parameter_files/fates_params_default.cdl +++ b/parameter_files/fates_params_default.cdl @@ -4,666 +4,693 @@ dimensions: fates_history_age_bins = 7 ; fates_history_height_bins = 6 ; fates_history_size_bins = 13 ; + fates_history_coage_bins = 1 ; fates_hydr_organs = 4 ; fates_leafage_class = 1 ; fates_litterclass = 6 ; fates_pft = 12 ; fates_prt_organs = 6 ; - fates_scalar = 1 ; fates_string_length = 60 ; fates_variants = 2 ; variables: - float fates_history_height_bin_edges(fates_history_height_bins) ; + double fates_history_ageclass_bin_edges(fates_history_age_bins) ; + fates_history_ageclass_bin_edges:units = "yr" ; + fates_history_ageclass_bin_edges:long_name = "Lower edges for age class bins used in age-resolved patch history output" ; + double fates_history_coageclass_bin_edges(fates_history_coage_bins) ; + fates_history_coageclass_bin_edges:units = "years" ; + fates_history_coageclass_bin_edges:long_name = "Lower edges for cohort age class bins used in cohort age resolved history output" ; + double fates_history_height_bin_edges(fates_history_height_bins) ; fates_history_height_bin_edges:units = "m" ; fates_history_height_bin_edges:long_name = "Lower edges for height bins used in height-resolved history output" ; - float fates_history_sizeclass_bin_edges(fates_history_size_bins) ; + 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" ; - float fates_history_ageclass_bin_edges(fates_history_age_bins) ; - fates_history_ageclass_bin_edges:units = "yr" ; - fates_history_ageclass_bin_edges:long_name = "Lower edges for age class bins used in age-resolved patch history output" ; - float fates_base_mr_20(fates_scalar) ; - fates_base_mr_20:units = "gC/gN/s" ; - fates_base_mr_20:long_name = "Base maintenance respiration rate for plant tissues, using Ryan 1991" ; - float fates_bbopt_c3(fates_scalar) ; - fates_bbopt_c3:units = "umol H2O/m**2/s" ; - fates_bbopt_c3:long_name = "Ball-Berry minimum unstressed leaf conductance for C3" ; - float fates_bbopt_c4(fates_scalar) ; - fates_bbopt_c4:units = "umol H2O/m**2/s" ; - fates_bbopt_c4:long_name = "Ball-Berry minimum unstressed leaf conductance for C4" ; - float fates_canopy_closure_thresh(fates_scalar) ; - fates_canopy_closure_thresh:units = "unitless" ; - fates_canopy_closure_thresh:long_name = "tree canopy coverage at which crown area allometry changes from savanna to forest value" ; - float fates_cohort_fusion_tol(fates_scalar) ; - fates_cohort_fusion_tol:units = "unitless" ; - fates_cohort_fusion_tol:long_name = "minimum fraction in difference in dbh between cohorts" ; - float fates_comp_excln(fates_scalar) ; - fates_comp_excln:units = "none" ; - fates_comp_excln:long_name = "weighting factor (exponent on dbh) for canopy layer exclusion and promotion" ; - float fates_cwd_fcel(fates_scalar) ; - fates_cwd_fcel:units = "unitless" ; - fates_cwd_fcel:long_name = "Cellulose fraction for CWD" ; - float fates_cwd_flig(fates_scalar) ; - fates_cwd_flig:units = "unitless" ; - fates_cwd_flig:long_name = "Lignin fraction of coarse woody debris" ; - float fates_fire_nignitions(fates_scalar) ; - fates_fire_nignitions:units = "/m2 (?)" ; - fates_fire_nignitions:long_name = "number of daily ignitions (nfires = nignitions*FDI*area_scaling)" ; - float fates_hydr_kmax_rsurf(fates_scalar) ; - fates_hydr_kmax_rsurf:units = "kg water/m2 root area/Mpa/s" ; - fates_hydr_kmax_rsurf:long_name = "maximum conducitivity for unit root surface" ; - float fates_hydr_psi0(fates_scalar) ; - fates_hydr_psi0:units = "MPa" ; - fates_hydr_psi0:long_name = "sapwood water potential at saturation" ; - float fates_hydr_psicap(fates_scalar) ; - fates_hydr_psicap:units = "MPa" ; - fates_hydr_psicap:long_name = "sapwood water potential at which capillary reserves exhausted" ; - float fates_init_litter(fates_scalar) ; - fates_init_litter:units = "NA" ; - fates_init_litter:long_name = "Initialization value for litter pool in cold-start (NOT USED)" ; - float fates_logging_coll_under_frac(fates_scalar) ; - fates_logging_coll_under_frac:units = "fraction" ; - fates_logging_coll_under_frac:long_name = "Fraction of stems killed in the understory when logging generates disturbance" ; - float fates_logging_collateral_frac(fates_scalar) ; - fates_logging_collateral_frac:units = "fraction" ; - fates_logging_collateral_frac:long_name = "Fraction of large stems in upperstory that die from logging collateral damage" ; - float fates_logging_dbhmax_infra(fates_scalar) ; - fates_logging_dbhmax_infra:units = "cm" ; - fates_logging_dbhmax_infra:long_name = "Tree diameter, above which infrastructure from logging does not impact damage or mortality." ; - float fates_logging_dbhmin(fates_scalar) ; - fates_logging_dbhmin:units = "cm" ; - fates_logging_dbhmin:long_name = "Minimum dbh at which logging is applied" ; - float fates_logging_direct_frac(fates_scalar) ; - fates_logging_direct_frac:units = "fraction" ; - fates_logging_direct_frac:long_name = "Fraction of stems logged directly per event" ; - float fates_logging_event_code(fates_scalar) ; - fates_logging_event_code:units = "unitless" ; - fates_logging_event_code:long_name = "Integer code that options how logging events are structured" ; - float fates_logging_mechanical_frac(fates_scalar) ; - fates_logging_mechanical_frac:units = "fraction" ; - fates_logging_mechanical_frac:long_name = "Fraction of stems killed due infrastructure an other mechanical means" ; - float fates_mort_disturb_frac(fates_scalar) ; - fates_mort_disturb_frac:units = "fraction" ; - fates_mort_disturb_frac:long_name = "fraction of canopy mortality that results in disturbance (i.e. transfer of area from new to old patch)" ; - float fates_mort_understorey_death(fates_scalar) ; - fates_mort_understorey_death:units = "fraction" ; - fates_mort_understorey_death:long_name = "fraction of plants in understorey cohort impacted by overstorey tree-fall" ; - float fates_patch_fusion_tol(fates_scalar) ; - fates_patch_fusion_tol:units = "unitless" ; - fates_patch_fusion_tol:long_name = "minimum fraction in difference in profiles between patches" ; - float fates_phen_a(fates_scalar) ; - fates_phen_a:units = "none" ; - fates_phen_a:long_name = "GDD accumulation function, intercept parameter: gdd_thesh = a + b exp(c*ncd)" ; - float fates_phen_b(fates_scalar) ; - fates_phen_b:units = "none" ; - fates_phen_b:long_name = "GDD accumulation function, multiplier parameter: gdd_thesh = a + b exp(c*ncd)" ; - float fates_phen_c(fates_scalar) ; - fates_phen_c:units = "none" ; - fates_phen_c:long_name = "GDD accumulation function, exponent parameter: gdd_thesh = a + b exp(c*ncd)" ; - float fates_phen_chiltemp(fates_scalar) ; - fates_phen_chiltemp:units = "degrees C" ; - fates_phen_chiltemp:long_name = "chilling day counting threshold" ; - float fates_phen_coldtemp(fates_scalar) ; - fates_phen_coldtemp:units = "degrees C" ; - fates_phen_coldtemp:long_name = "temperature exceedance to flag a cold-day for temperature leaf drop" ; - float fates_phen_doff_time(fates_scalar) ; - fates_phen_doff_time:units = "days" ; - fates_phen_doff_time:long_name = "day threshold compared against days since leaves became off-allometry" ; - float fates_phen_drought_threshold(fates_scalar) ; - fates_phen_drought_threshold:units = "m3/m3" ; - fates_phen_drought_threshold:long_name = "liquid volume in soil layer, threashold for drought phenology" ; - float fates_phen_mindayson(fates_scalar) ; - fates_phen_mindayson:units = "days" ; - fates_phen_mindayson:long_name = "day threshold compared against days since leaves became on-allometry" ; - float fates_phen_ncolddayslim(fates_scalar) ; - fates_phen_ncolddayslim:units = "days" ; - fates_phen_ncolddayslim:long_name = "day threshold exceedance for temperature leaf-drop" ; - float fates_soil_salinity(fates_scalar) ; - fates_soil_salinity:units = "ppt" ; - fates_soil_salinity:long_name = "soil salinity used for model when not coupled to dynamic soil salinity" ; char fates_pftname(fates_pft, fates_string_length) ; fates_pftname:units = "unitless - string" ; fates_pftname:long_name = "Description of plant type" ; char fates_prt_organ_name(fates_prt_organs, fates_string_length) ; fates_prt_organ_name:units = "unitless - string" ; fates_prt_organ_name:long_name = "Plant organ name (order must match PRTGenericMod.F90)" ; - float fates_alloc_storage_cushion(fates_pft) ; + double fates_alloc_storage_cushion(fates_pft) ; fates_alloc_storage_cushion:units = "fraction" ; fates_alloc_storage_cushion:long_name = "maximum size of storage C pool, relative to maximum size of leaf C pool" ; - float fates_allom_agb1(fates_pft) ; + double fates_allom_agb1(fates_pft) ; fates_allom_agb1:units = "variable" ; fates_allom_agb1:long_name = "Parameter 1 for agb allometry" ; - float fates_allom_agb2(fates_pft) ; + double fates_allom_agb2(fates_pft) ; fates_allom_agb2:units = "variable" ; fates_allom_agb2:long_name = "Parameter 2 for agb allometry" ; - float fates_allom_agb3(fates_pft) ; + double fates_allom_agb3(fates_pft) ; fates_allom_agb3:units = "variable" ; fates_allom_agb3:long_name = "Parameter 3 for agb allometry" ; - float fates_allom_agb4(fates_pft) ; + double fates_allom_agb4(fates_pft) ; fates_allom_agb4:units = "variable" ; fates_allom_agb4:long_name = "Parameter 4 for agb allometry" ; - float fates_allom_agb_frac(fates_pft) ; + double fates_allom_agb_frac(fates_pft) ; fates_allom_agb_frac:units = "fraction" ; fates_allom_agb_frac:long_name = "Fraction of woody biomass that is above ground" ; - float fates_allom_amode(fates_pft) ; + double fates_allom_amode(fates_pft) ; fates_allom_amode:units = "index" ; - fates_allom_amode:long_name = "AGB allometry function index" ; - float fates_allom_blca_expnt_diff(fates_pft) ; + fates_allom_amode:long_name = "AGB allometry function index." ; + fates_allom_amode:possible_values = "1: Saldarriaga 1998; 2: 2 parameter power law; 3: Chave 2014" ; + double fates_allom_blca_expnt_diff(fates_pft) ; fates_allom_blca_expnt_diff:units = "unitless" ; fates_allom_blca_expnt_diff:long_name = "difference between allometric DBH:bleaf and DBH:crown area exponents" ; - float fates_allom_cmode(fates_pft) ; + double fates_allom_cmode(fates_pft) ; fates_allom_cmode:units = "index" ; - fates_allom_cmode:long_name = "coarse root biomass allometry function index" ; - float fates_allom_d2bl1(fates_pft) ; + fates_allom_cmode:long_name = "coarse root biomass allometry function index." ; + fates_allom_cmode:possible_values = "1: Constant fraction on AGB" ; + double fates_allom_d2bl1(fates_pft) ; fates_allom_d2bl1:units = "variable" ; fates_allom_d2bl1:long_name = "Parameter 1 for d2bl allometry" ; - float fates_allom_d2bl2(fates_pft) ; + double fates_allom_d2bl2(fates_pft) ; fates_allom_d2bl2:units = "variable" ; fates_allom_d2bl2:long_name = "Parameter 2 for d2bl allometry" ; - float fates_allom_d2bl3(fates_pft) ; + double fates_allom_d2bl3(fates_pft) ; fates_allom_d2bl3:units = "unitless" ; fates_allom_d2bl3:long_name = "Parameter 3 for d2bl allometry" ; - float fates_allom_d2ca_coefficient_max(fates_pft) ; + double fates_allom_d2ca_coefficient_max(fates_pft) ; fates_allom_d2ca_coefficient_max:units = "m2 cm^(-1/beta)" ; fates_allom_d2ca_coefficient_max:long_name = "max (savanna) dbh to area multiplier factor where: area = n*d2ca_coeff*dbh^beta" ; - float fates_allom_d2ca_coefficient_min(fates_pft) ; + double fates_allom_d2ca_coefficient_min(fates_pft) ; fates_allom_d2ca_coefficient_min:units = "m2 cm^(-1/beta)" ; fates_allom_d2ca_coefficient_min:long_name = "min (forest) dbh to area multiplier factor where: area = n*d2ca_coeff*dbh^beta" ; - float fates_allom_d2h1(fates_pft) ; + double fates_allom_d2h1(fates_pft) ; fates_allom_d2h1:units = "variable" ; fates_allom_d2h1:long_name = "Parameter 1 for d2h allometry (intercept, or c)" ; - float fates_allom_d2h2(fates_pft) ; + double fates_allom_d2h2(fates_pft) ; fates_allom_d2h2:units = "variable" ; fates_allom_d2h2:long_name = "Parameter 2 for d2h allometry (slope, or m)" ; - float fates_allom_d2h3(fates_pft) ; + double fates_allom_d2h3(fates_pft) ; fates_allom_d2h3:units = "variable" ; fates_allom_d2h3:long_name = "Parameter 3 for d2h allometry (optional)" ; - float fates_allom_dbh_maxheight(fates_pft) ; + double fates_allom_dbh_maxheight(fates_pft) ; fates_allom_dbh_maxheight:units = "cm" ; fates_allom_dbh_maxheight:long_name = "the diameter (if any) corresponding to maximum height, diameters may increase beyond this" ; - float fates_allom_fmode(fates_pft) ; + double fates_allom_fmode(fates_pft) ; fates_allom_fmode:units = "index" ; - fates_allom_fmode:long_name = "fine root biomass allometry function index" ; - float fates_allom_frbstor_repro(fates_pft) ; + fates_allom_fmode:long_name = "fine root biomass allometry function index." ; + fates_allom_fmode:possible_values = "1: constant fraction of trimmed bleaf; 2: constant fraction of untrimmed bleaf." ; + double fates_allom_frbstor_repro(fates_pft) ; fates_allom_frbstor_repro:units = "fraction" ; fates_allom_frbstor_repro:long_name = "fraction of bstore goes to reproduction after plant dies" ; - float fates_allom_hmode(fates_pft) ; + double fates_allom_hmode(fates_pft) ; fates_allom_hmode:units = "index" ; - fates_allom_hmode:long_name = "height allometry function index" ; - float fates_allom_l2fr(fates_pft) ; + fates_allom_hmode:long_name = "height allometry function index." ; + fates_allom_hmode:possible_values = "1: O'Brien 1995; 2: Poorter 2006; 3: 2 parameter power law; 4: Chave 2014; 5: Martinez-Cano 2019." ; + double fates_allom_l2fr(fates_pft) ; fates_allom_l2fr:units = "gC/gC" ; fates_allom_l2fr:long_name = "Allocation parameter: fine root C per leaf C" ; - float fates_allom_la_per_sa_int(fates_pft) ; + double fates_allom_la_per_sa_int(fates_pft) ; fates_allom_la_per_sa_int:units = "m2/cm2" ; fates_allom_la_per_sa_int:long_name = "Leaf area per sapwood area, intercept" ; - float fates_allom_la_per_sa_slp(fates_pft) ; + double fates_allom_la_per_sa_slp(fates_pft) ; fates_allom_la_per_sa_slp:units = "m2/cm2/m" ; fates_allom_la_per_sa_slp:long_name = "Leaf area per sapwood area rate of change with height, slope (optional)" ; - float fates_allom_lmode(fates_pft) ; + double fates_allom_lmode(fates_pft) ; fates_allom_lmode:units = "index" ; - fates_allom_lmode:long_name = "leaf biomass allometry function index" ; - float fates_allom_sai_scaler(fates_pft) ; + fates_allom_lmode:long_name = "leaf biomass allometry function index." ; + fates_allom_lmode:possible_values = "1: Saldarriaga 1998 (capped-dbh power law); 2: generic power law; 3: generic capped-dbh power law." ; + double fates_allom_sai_scaler(fates_pft) ; fates_allom_sai_scaler:units = "m2/m2" ; fates_allom_sai_scaler:long_name = "allometric ratio of SAI per LAI" ; - float fates_allom_smode(fates_pft) ; + double fates_allom_smode(fates_pft) ; fates_allom_smode:units = "index" ; - fates_allom_smode:long_name = "sapwood allometry function index" ; - float fates_allom_stmode(fates_pft) ; + fates_allom_smode:long_name = "sapwood allometry function index." ; + fates_allom_smode:possible_values = "1: sapwood area proportional to leaf area based on target leaf biomass" ; + double fates_allom_stmode(fates_pft) ; fates_allom_stmode:units = "index" ; - fates_allom_stmode:long_name = "storage allometry function index" ; - float fates_branch_turnover(fates_pft) ; - fates_branch_turnover:units = "yr-1" ; + fates_allom_stmode:long_name = "storage allometry function index." ; + fates_allom_stmode:possible_values = "1: target storage proportional to trimmed maximum leaf biomass." ; + double fates_branch_turnover(fates_pft) ; + fates_branch_turnover:units = "yr" ; fates_branch_turnover:long_name = "turnover time of branches" ; - float fates_c2b(fates_pft) ; + double fates_c2b(fates_pft) ; fates_c2b:units = "ratio" ; fates_c2b:long_name = "Carbon to biomass multiplier of bulk structural tissues" ; - float fates_displar(fates_pft) ; + double fates_displar(fates_pft) ; fates_displar:units = "unitless" ; fates_displar:long_name = "Ratio of displacement height to canopy top height" ; - float fates_fire_alpha_SH(fates_pft) ; + double fates_eca_alpha_ptase(fates_pft) ; + fates_eca_alpha_ptase:units = "g/m3" ; + fates_eca_alpha_ptase:long_name = "fraction of P from ptase activity sent directly to plant (ECA)" ; + double fates_eca_decompmicc(fates_pft) ; + fates_eca_decompmicc:units = "gC/m3" ; + fates_eca_decompmicc:long_name = "mean soil microbial decomposer biomass (ECA)" ; + double fates_eca_km_nh4(fates_pft) ; + fates_eca_km_nh4:units = "gN/m3" ; + fates_eca_km_nh4:long_name = "half-saturation constant for plant nh4 uptake (ECA)" ; + double fates_eca_km_no3(fates_pft) ; + fates_eca_km_no3:units = "gN/m3" ; + fates_eca_km_no3:long_name = "half-saturation constant for plant no3 uptake (ECA)" ; + double fates_eca_km_p(fates_pft) ; + fates_eca_km_p:units = "gP/m3" ; + fates_eca_km_p:long_name = "half-saturation constant for plant p uptake (ECA)" ; + double fates_eca_km_ptase(fates_pft) ; + fates_eca_km_ptase:units = "gP/m3" ; + fates_eca_km_ptase:long_name = "half-saturation constant for biochemical P (ECA)" ; + double fates_eca_lambda_ptase(fates_pft) ; + fates_eca_lambda_ptase:units = "g/m3" ; + fates_eca_lambda_ptase:long_name = "critical value for biochemical production (ECA)" ; + double fates_eca_vmax_nh4(fates_pft) ; + fates_eca_vmax_nh4:units = "gN/gC/s" ; + fates_eca_vmax_nh4:long_name = "maximum production rate for plant nh4 uptake (ECA)" ; + double fates_eca_vmax_no3(fates_pft) ; + fates_eca_vmax_no3:units = "gN/gC/s" ; + fates_eca_vmax_no3:long_name = "maximum production rate for plant no3 uptake (ECA)" ; + double fates_eca_vmax_p(fates_pft) ; + fates_eca_vmax_p:units = "gP/gC/s" ; + fates_eca_vmax_p:long_name = "maximum production rate for plant p uptake (ECA)" ; + double fates_eca_vmax_ptase(fates_pft) ; + fates_eca_vmax_ptase:units = "gP/m2/s" ; + fates_eca_vmax_ptase:long_name = "maximum production rate for biochemical P (per m2) (ECA)" ; + double fates_fire_alpha_SH(fates_pft) ; fates_fire_alpha_SH:units = "NA" ; fates_fire_alpha_SH:long_name = "spitfire parameter, alpha scorch height, Equation 16 Thonicke et al 2010" ; - float fates_fire_bark_scaler(fates_pft) ; + double fates_fire_bark_scaler(fates_pft) ; fates_fire_bark_scaler:units = "fraction" ; fates_fire_bark_scaler:long_name = "the thickness of a cohorts bark as a fraction of its dbh" ; - float fates_fire_crown_depth_frac(fates_pft) ; + double fates_fire_crown_depth_frac(fates_pft) ; fates_fire_crown_depth_frac:units = "fraction" ; fates_fire_crown_depth_frac:long_name = "the depth of a cohorts crown as a fraction of its height" ; - float fates_fire_crown_kill(fates_pft) ; + double fates_fire_crown_kill(fates_pft) ; fates_fire_crown_kill:units = "NA" ; fates_fire_crown_kill:long_name = "fire parameter, see equation 22 in Thonicke et al 2010" ; - float fates_fr_fcel(fates_pft) ; + double fates_fr_fcel(fates_pft) ; fates_fr_fcel:units = "fraction" ; fates_fr_fcel:long_name = "Fine root litter cellulose fraction" ; - float fates_fr_flab(fates_pft) ; + double fates_fr_flab(fates_pft) ; fates_fr_flab:units = "fraction" ; fates_fr_flab:long_name = "Fine root litter labile fraction" ; - float fates_fr_flig(fates_pft) ; + double fates_fr_flig(fates_pft) ; fates_fr_flig:units = "fraction" ; fates_fr_flig:long_name = "Fine root litter lignin fraction" ; - float fates_grperc(fates_pft) ; + double fates_grperc(fates_pft) ; fates_grperc:units = "unitless" ; fates_grperc:long_name = "Growth respiration factor" ; - float fates_hydr_avuln_gs(fates_pft) ; + double fates_hydr_avuln_gs(fates_pft) ; fates_hydr_avuln_gs:units = "unitless" ; fates_hydr_avuln_gs:long_name = "shape parameter for stomatal control of water vapor exiting leaf" ; - float fates_hydr_avuln_node(fates_hydr_organs, fates_pft) ; + double fates_hydr_avuln_node(fates_hydr_organs, fates_pft) ; fates_hydr_avuln_node:units = "unitless" ; fates_hydr_avuln_node:long_name = "xylem vulnerability curve shape parameter" ; - float fates_hydr_epsil_node(fates_hydr_organs, fates_pft) ; + double fates_hydr_epsil_node(fates_hydr_organs, fates_pft) ; fates_hydr_epsil_node:units = "MPa" ; fates_hydr_epsil_node:long_name = "bulk elastic modulus" ; - float fates_hydr_fcap_node(fates_hydr_organs, fates_pft) ; + double fates_hydr_fcap_node(fates_hydr_organs, fates_pft) ; fates_hydr_fcap_node:units = "unitless" ; fates_hydr_fcap_node:long_name = "fraction of (1-resid_node) that is capillary in source" ; - float fates_hydr_kmax_node(fates_hydr_organs, fates_pft) ; + double fates_hydr_kmax_node(fates_hydr_organs, fates_pft) ; fates_hydr_kmax_node:units = "kgMPa/m/s" ; fates_hydr_kmax_node:long_name = "maximum xylem conductivity per unit conducting xylem area" ; - float fates_hydr_p50_gs(fates_pft) ; + double fates_hydr_p50_gs(fates_pft) ; fates_hydr_p50_gs:units = "MPa" ; fates_hydr_p50_gs:long_name = "water potential at 50% loss of stomatal conductance" ; - float fates_hydr_p50_node(fates_hydr_organs, fates_pft) ; + double fates_hydr_p50_node(fates_hydr_organs, fates_pft) ; fates_hydr_p50_node:units = "MPa" ; fates_hydr_p50_node:long_name = "xylem water potential at 50% loss of conductivity" ; - float fates_hydr_p_taper(fates_pft) ; + double fates_hydr_p_taper(fates_pft) ; fates_hydr_p_taper:units = "unitless" ; fates_hydr_p_taper:long_name = "xylem taper exponent" ; - float fates_hydr_pinot_node(fates_hydr_organs, fates_pft) ; + double fates_hydr_pinot_node(fates_hydr_organs, fates_pft) ; fates_hydr_pinot_node:units = "MPa" ; fates_hydr_pinot_node:long_name = "osmotic potential at full turgor" ; - float fates_hydr_pitlp_node(fates_hydr_organs, fates_pft) ; + double fates_hydr_pitlp_node(fates_hydr_organs, fates_pft) ; fates_hydr_pitlp_node:units = "MPa" ; fates_hydr_pitlp_node:long_name = "turgor loss point" ; - float fates_hydr_resid_node(fates_hydr_organs, fates_pft) ; + double fates_hydr_resid_node(fates_hydr_organs, fates_pft) ; fates_hydr_resid_node:units = "fraction" ; fates_hydr_resid_node:long_name = "residual fraction" ; - float fates_hydr_rfrac_stem(fates_pft) ; + double fates_hydr_rfrac_stem(fates_pft) ; fates_hydr_rfrac_stem:units = "fraction" ; fates_hydr_rfrac_stem:long_name = "fraction of total tree resistance from troot to canopy" ; - float fates_hydr_rs2(fates_pft) ; + double fates_hydr_rs2(fates_pft) ; fates_hydr_rs2:units = "m" ; fates_hydr_rs2:long_name = "absorbing root radius" ; - float fates_hydr_srl(fates_pft) ; + double fates_hydr_srl(fates_pft) ; fates_hydr_srl:units = "m g-1" ; fates_hydr_srl:long_name = "specific root length" ; - float fates_hydr_thetas_node(fates_hydr_organs, fates_pft) ; + double fates_hydr_thetas_node(fates_hydr_organs, fates_pft) ; fates_hydr_thetas_node:units = "cm3/cm3" ; fates_hydr_thetas_node:long_name = "saturated water content" ; - float fates_leaf_BB_slope(fates_pft) ; + double fates_leaf_BB_slope(fates_pft) ; fates_leaf_BB_slope:units = "unitless" ; fates_leaf_BB_slope:long_name = "stomatal slope parameter, as per Ball-Berry" ; - float fates_leaf_c3psn(fates_pft) ; + double fates_leaf_c3psn(fates_pft) ; fates_leaf_c3psn:units = "flag" ; fates_leaf_c3psn:long_name = "Photosynthetic pathway (1=c3, 0=c4)" ; - float fates_leaf_clumping_index(fates_pft) ; + double fates_leaf_clumping_index(fates_pft) ; fates_leaf_clumping_index:units = "fraction (0-1)" ; fates_leaf_clumping_index:long_name = "factor describing how much self-occlusion of leaf scattering elements decreases light interception" ; - float fates_leaf_diameter(fates_pft) ; + double fates_leaf_diameter(fates_pft) ; fates_leaf_diameter:units = "m" ; fates_leaf_diameter:long_name = "Characteristic leaf dimension" ; - float fates_leaf_jmaxha(fates_pft) ; + double fates_leaf_jmaxha(fates_pft) ; fates_leaf_jmaxha:units = "J/mol" ; fates_leaf_jmaxha:long_name = "activation energy for jmax" ; - float fates_leaf_jmaxhd(fates_pft) ; + double fates_leaf_jmaxhd(fates_pft) ; fates_leaf_jmaxhd:units = "J/mol" ; fates_leaf_jmaxhd:long_name = "deactivation energy for jmax" ; - float fates_leaf_jmaxse(fates_pft) ; + double fates_leaf_jmaxse(fates_pft) ; fates_leaf_jmaxse:units = "J/mol/K" ; fates_leaf_jmaxse:long_name = "entropy term for jmax" ; - float fates_leaf_long(fates_leafage_class, fates_pft) ; + double fates_leaf_long(fates_leafage_class, fates_pft) ; fates_leaf_long:units = "yr" ; fates_leaf_long:long_name = "Leaf longevity (ie turnover timescale)" ; - float fates_leaf_slamax(fates_pft) ; + double fates_leaf_slamax(fates_pft) ; fates_leaf_slamax:units = "m^2/gC" ; fates_leaf_slamax:long_name = "Maximum Specific Leaf Area (SLA), even if under a dense canopy" ; - float fates_leaf_slatop(fates_pft) ; + double fates_leaf_slatop(fates_pft) ; fates_leaf_slatop:units = "m^2/gC" ; fates_leaf_slatop:long_name = "Specific Leaf Area (SLA) at top of canopy, projected area basis" ; - float fates_leaf_stor_priority(fates_pft) ; + double fates_leaf_stor_priority(fates_pft) ; fates_leaf_stor_priority:units = "unitless" ; fates_leaf_stor_priority:long_name = "factor governing priority of replacing storage with NPP" ; - float fates_leaf_tpuha(fates_pft) ; + double fates_leaf_tpuha(fates_pft) ; fates_leaf_tpuha:units = "J/mol" ; fates_leaf_tpuha:long_name = "activation energy for tpu" ; - float fates_leaf_tpuhd(fates_pft) ; + double fates_leaf_tpuhd(fates_pft) ; fates_leaf_tpuhd:units = "J/mol" ; fates_leaf_tpuhd:long_name = "deactivation energy for tpu" ; - float fates_leaf_tpuse(fates_pft) ; + double fates_leaf_tpuse(fates_pft) ; fates_leaf_tpuse:units = "J/mol/K" ; fates_leaf_tpuse:long_name = "entropy term for tpu" ; - float fates_leaf_vcmax25top(fates_leafage_class, fates_pft) ; + double fates_leaf_vcmax25top(fates_leafage_class, fates_pft) ; fates_leaf_vcmax25top:units = "umol CO2/m^2/s" ; fates_leaf_vcmax25top:long_name = "maximum carboxylation rate of Rub. at 25C, canopy top" ; - float fates_leaf_vcmaxha(fates_pft) ; + double fates_leaf_vcmaxha(fates_pft) ; fates_leaf_vcmaxha:units = "J/mol" ; fates_leaf_vcmaxha:long_name = "activation energy for vcmax" ; - float fates_leaf_vcmaxhd(fates_pft) ; + double fates_leaf_vcmaxhd(fates_pft) ; fates_leaf_vcmaxhd:units = "J/mol" ; fates_leaf_vcmaxhd:long_name = "deactivation energy for vcmax" ; - float fates_leaf_vcmaxse(fates_pft) ; + double fates_leaf_vcmaxse(fates_pft) ; fates_leaf_vcmaxse:units = "J/mol/K" ; fates_leaf_vcmaxse:long_name = "entropy term for vcmax" ; - float fates_leaf_xl(fates_pft) ; + double fates_leaf_xl(fates_pft) ; fates_leaf_xl:units = "unitless" ; fates_leaf_xl:long_name = "Leaf/stem orientation index" ; - float fates_lf_fcel(fates_pft) ; + double fates_lf_fcel(fates_pft) ; fates_lf_fcel:units = "fraction" ; fates_lf_fcel:long_name = "Leaf litter cellulose fraction" ; - float fates_lf_flab(fates_pft) ; + double fates_lf_flab(fates_pft) ; fates_lf_flab:units = "fraction" ; fates_lf_flab:long_name = "Leaf litter labile fraction" ; - float fates_lf_flig(fates_pft) ; + double fates_lf_flig(fates_pft) ; fates_lf_flig:units = "fraction" ; fates_lf_flig:long_name = "Leaf litter lignin fraction" ; - float fates_maintresp_reduction_curvature(fates_pft) ; + double fates_maintresp_reduction_curvature(fates_pft) ; fates_maintresp_reduction_curvature:units = "unitless (0-1)" ; fates_maintresp_reduction_curvature:long_name = "curvature of MR reduction as f(carbon storage), 1=linear, 0=very curved" ; - float fates_maintresp_reduction_intercept(fates_pft) ; + double fates_maintresp_reduction_intercept(fates_pft) ; fates_maintresp_reduction_intercept:units = "unitless (0-1)" ; fates_maintresp_reduction_intercept:long_name = "intercept of MR reduction as f(carbon storage), 0=no throttling, 1=max throttling" ; - float fates_mort_bmort(fates_pft) ; + double fates_mort_bmort(fates_pft) ; fates_mort_bmort:units = "1/yr" ; fates_mort_bmort:long_name = "background mortality rate" ; - float fates_mort_freezetol(fates_pft) ; + double fates_mort_freezetol(fates_pft) ; fates_mort_freezetol:units = "NA" ; fates_mort_freezetol:long_name = "minimum temperature tolerance (NOT USED)" ; - float fates_mort_hf_flc_threshold(fates_pft) ; + double fates_mort_hf_flc_threshold(fates_pft) ; fates_mort_hf_flc_threshold:units = "fraction" ; fates_mort_hf_flc_threshold:long_name = "plant fractional loss of conductivity at which drought mortality begins for hydraulic model" ; - float fates_mort_hf_sm_threshold(fates_pft) ; + double fates_mort_hf_sm_threshold(fates_pft) ; fates_mort_hf_sm_threshold:units = "unitless" ; fates_mort_hf_sm_threshold:long_name = "soil moisture (btran units) at which drought mortality begins for non-hydraulic model" ; - float fates_mort_scalar_coldstress(fates_pft) ; + double fates_mort_ip_age_senescence(fates_pft) ; + fates_mort_ip_age_senescence:units = "years" ; + fates_mort_ip_age_senescence:long_name = "Mortality cohort age senescence inflection point" ; + double fates_mort_ip_size_senescence(fates_pft) ; + fates_mort_ip_size_senescence:units = "dbh cm" ; + fates_mort_ip_size_senescence:long_name = "Mortality dbh senescence inflection point" ; + double fates_mort_r_age_senescence(fates_pft) ; + fates_mort_r_age_senescence:units = "mortality rate year^-1" ; + fates_mort_r_age_senescence:long_name = "Mortality age senescence rate of change" ; + double fates_mort_r_size_senescence(fates_pft) ; + fates_mort_r_size_senescence:units = "mortality rate dbh^-1" ; + fates_mort_r_size_senescence:long_name = "Mortality dbh senescence rate of change" ; + double fates_mort_scalar_coldstress(fates_pft) ; fates_mort_scalar_coldstress:units = "1/yr" ; fates_mort_scalar_coldstress:long_name = "maximum mortality rate from cold stress" ; - float fates_mort_scalar_cstarvation(fates_pft) ; + double fates_mort_scalar_cstarvation(fates_pft) ; fates_mort_scalar_cstarvation:units = "1/yr" ; fates_mort_scalar_cstarvation:long_name = "maximum mortality rate from carbon starvation" ; - float fates_mort_scalar_hydrfailure(fates_pft) ; + double fates_mort_scalar_hydrfailure(fates_pft) ; fates_mort_scalar_hydrfailure:units = "1/yr" ; fates_mort_scalar_hydrfailure:long_name = "maximum mortality rate from hydraulic failure" ; - float fates_pft_used(fates_pft) ; - fates_pft_used:units = "0 = off (dont use), 1 = on (use)" ; - fates_pft_used:long_name = "Switch to turn on and off PFTs (also see fates_initd for cold-start)" ; - float fates_phen_evergreen(fates_pft) ; + double fates_nfix1(fates_pft) ; + fates_nfix1:units = "NA" ; + fates_nfix1:long_name = "place-holder for future n-fixation parameter (NOT IMPLEMENTED)" ; + double fates_nfix2(fates_pft) ; + fates_nfix2:units = "NA" ; + fates_nfix2:long_name = "place-holder for future n-fixation parameter (NOT IMPLEMENTED)" ; + double fates_phen_cold_size_threshold(fates_pft) ; + fates_phen_cold_size_threshold:units = "cm" ; + fates_phen_cold_size_threshold:long_name = "the dbh size above which will lead to phenology-related stem and leaf drop" ; + double fates_phen_evergreen(fates_pft) ; fates_phen_evergreen:units = "logical flag" ; fates_phen_evergreen:long_name = "Binary flag for evergreen leaf habit" ; - float fates_phen_season_decid(fates_pft) ; + double fates_phen_season_decid(fates_pft) ; fates_phen_season_decid:units = "logical flag" ; fates_phen_season_decid:long_name = "Binary flag for seasonal-deciduous leaf habit" ; - float fates_phen_stress_decid(fates_pft) ; + double fates_phen_stem_drop_fraction(fates_pft) ; + fates_phen_stem_drop_fraction:units = "fraction" ; + fates_phen_stem_drop_fraction:long_name = "fraction of stems to drop for non-woody species during drought/cold" ; + double fates_phen_stress_decid(fates_pft) ; fates_phen_stress_decid:units = "logical flag" ; fates_phen_stress_decid:long_name = "Binary flag for stress-deciduous leaf habit" ; - float fates_phenflush_fraction(fates_pft) ; + double fates_phenflush_fraction(fates_pft) ; fates_phenflush_fraction:units = "fraction" ; fates_phenflush_fraction:long_name = "Upon bud-burst, the maximum fraction of storage carbon used for flushing leaves" ; - float fates_prescribed_mortality_canopy(fates_pft) ; + double fates_prescribed_mortality_canopy(fates_pft) ; fates_prescribed_mortality_canopy:units = "1/yr" ; fates_prescribed_mortality_canopy:long_name = "mortality rate of canopy trees for prescribed physiology mode" ; - float fates_prescribed_mortality_understory(fates_pft) ; + double fates_prescribed_mortality_understory(fates_pft) ; fates_prescribed_mortality_understory:units = "1/yr" ; fates_prescribed_mortality_understory:long_name = "mortality rate of understory trees for prescribed physiology mode" ; - float fates_prescribed_npp_canopy(fates_pft) ; - fates_prescribed_npp_canopy:units = "gC / m^2 / yr" ; + double fates_prescribed_npp_canopy(fates_pft) ; + fates_prescribed_npp_canopy:units = "kgC / m^2 / yr" ; fates_prescribed_npp_canopy:long_name = "NPP per unit crown area of canopy trees for prescribed physiology mode" ; - float fates_prescribed_npp_understory(fates_pft) ; - fates_prescribed_npp_understory:units = "gC / m^2 / yr" ; + double fates_prescribed_npp_understory(fates_pft) ; + fates_prescribed_npp_understory:units = "kgC / m^2 / yr" ; fates_prescribed_npp_understory:long_name = "NPP per unit crown area of understory trees for prescribed physiology mode" ; - float fates_prescribed_recruitment(fates_pft) ; + double fates_prescribed_nuptake(fates_pft) ; + fates_prescribed_nuptake:units = "kgN/m^2/yr" ; + fates_prescribed_nuptake:long_name = "Nitrogen uptake flux per unit crown area (negative implies fraction of NPP)" ; + double fates_prescribed_puptake(fates_pft) ; + fates_prescribed_puptake:units = "kgP/m^2/yr" ; + fates_prescribed_puptake:long_name = "Phosphorus uptake flux per unit crown area (negative implies fraction of NPP)" ; + double fates_prescribed_recruitment(fates_pft) ; fates_prescribed_recruitment:units = "n/yr" ; fates_prescribed_recruitment:long_name = "recruitment rate for prescribed physiology mode" ; - float fates_prt_alloc_priority(fates_prt_organs, fates_pft) ; + double fates_prt_alloc_priority(fates_prt_organs, fates_pft) ; fates_prt_alloc_priority:units = "index (0-fates_prt_organs)" ; fates_prt_alloc_priority:long_name = "Priority order for allocation" ; - float fates_prt_nitr_stoich_p1(fates_prt_organs, fates_pft) ; + double fates_prt_nitr_stoich_p1(fates_prt_organs, fates_pft) ; fates_prt_nitr_stoich_p1:units = "(gN/gC)" ; fates_prt_nitr_stoich_p1:long_name = "nitrogen stoichiometry, parameter 1" ; - float fates_prt_nitr_stoich_p2(fates_prt_organs, fates_pft) ; + double fates_prt_nitr_stoich_p2(fates_prt_organs, fates_pft) ; fates_prt_nitr_stoich_p2:units = "(gN/gC)" ; fates_prt_nitr_stoich_p2:long_name = "nitrogen stoichiometry, parameter 2" ; - float fates_prt_phos_stoich_p1(fates_prt_organs, fates_pft) ; + double fates_prt_phos_stoich_p1(fates_prt_organs, fates_pft) ; fates_prt_phos_stoich_p1:units = "(gP/gC)" ; fates_prt_phos_stoich_p1:long_name = "phosphorous stoichiometry, parameter 1" ; - float fates_prt_phos_stoich_p2(fates_prt_organs, fates_pft) ; + double fates_prt_phos_stoich_p2(fates_prt_organs, fates_pft) ; fates_prt_phos_stoich_p2:units = "(gP/gC)" ; fates_prt_phos_stoich_p2:long_name = "phosphorous stoichiometry, parameter 2" ; - float fates_recruit_hgt_min(fates_pft) ; + double fates_recruit_hgt_min(fates_pft) ; fates_recruit_hgt_min:units = "m" ; fates_recruit_hgt_min:long_name = "the minimum height (ie starting height) of a newly recruited plant" ; - float fates_recruit_initd(fates_pft) ; + double fates_recruit_initd(fates_pft) ; fates_recruit_initd:units = "stems/m2" ; fates_recruit_initd:long_name = "initial seedling density for a cold-start near-bare-ground simulation" ; - float fates_rholnir(fates_pft) ; + double fates_rholnir(fates_pft) ; fates_rholnir:units = "fraction" ; fates_rholnir:long_name = "Leaf reflectance: near-IR" ; - float fates_rholvis(fates_pft) ; + double fates_rholvis(fates_pft) ; fates_rholvis:units = "fraction" ; fates_rholvis:long_name = "Leaf reflectance: visible" ; - float fates_rhosnir(fates_pft) ; + double fates_rhosnir(fates_pft) ; fates_rhosnir:units = "fraction" ; fates_rhosnir:long_name = "Stem reflectance: near-IR" ; - float fates_rhosvis(fates_pft) ; + double fates_rhosvis(fates_pft) ; fates_rhosvis:units = "fraction" ; fates_rhosvis:long_name = "Stem reflectance: visible" ; - float fates_root_long(fates_pft) ; + double fates_root_long(fates_pft) ; fates_root_long:units = "yr" ; fates_root_long:long_name = "root longevity (alternatively, turnover time)" ; - float fates_roota_par(fates_pft) ; + double fates_roota_par(fates_pft) ; fates_roota_par:units = "1/m" ; fates_roota_par:long_name = "CLM rooting distribution parameter" ; - float fates_rootb_par(fates_pft) ; + double fates_rootb_par(fates_pft) ; fates_rootb_par:units = "1/m" ; fates_rootb_par:long_name = "CLM rooting distribution parameter" ; - float fates_rootprof_beta(fates_variants, fates_pft) ; + double fates_rootprof_beta(fates_variants, fates_pft) ; fates_rootprof_beta:units = "unitless" ; fates_rootprof_beta:long_name = "Rooting beta parameter, for C and N vertical discretization (NOT USED BY DEFAULT)" ; - float fates_seed_alloc(fates_pft) ; + double fates_seed_alloc(fates_pft) ; fates_seed_alloc:units = "fraction" ; fates_seed_alloc:long_name = "fraction of available carbon balance allocated to seeds" ; - float fates_seed_alloc_mature(fates_pft) ; + double fates_seed_alloc_mature(fates_pft) ; fates_seed_alloc_mature:units = "fraction" ; fates_seed_alloc_mature:long_name = "fraction of available carbon balance allocated to seeds in mature plants (adds to fates_seed_alloc)" ; - float fates_seed_dbh_repro_threshold(fates_pft) ; + double fates_seed_dbh_repro_threshold(fates_pft) ; fates_seed_dbh_repro_threshold:units = "cm" ; fates_seed_dbh_repro_threshold:long_name = "the diameter (if any) where the plant will start extra clonal allocation to the seed pool" ; - float fates_seed_decay_turnover(fates_pft) ; - fates_seed_decay_turnover:units = "1/yr" ; - fates_seed_decay_turnover:long_name = "turnover time for seeds with respect to germination" ; - float fates_seed_germination_timescale(fates_pft) ; - fates_seed_germination_timescale:units = "1/yr" ; - fates_seed_germination_timescale:long_name = "turnover time for seeds with respect to decay" ; - float fates_seed_rain(fates_pft) ; - fates_seed_rain:units = "KgC/m2/yr" ; - fates_seed_rain:long_name = "External seed rain from outside site (non-mass conserving)" ; - float fates_senleaf_long_fdrought(fates_pft) ; + double fates_seed_decay_rate(fates_pft) ; + fates_seed_decay_rate:units = "yr-1" ; + fates_seed_decay_rate:long_name = "fraction of seeds that decay per year" ; + double fates_seed_germination_rate(fates_pft) ; + fates_seed_germination_rate:units = "yr-1" ; + fates_seed_germination_rate:long_name = "fraction of seeds that germinate per year" ; + double fates_seed_suppl(fates_pft) ; + fates_seed_suppl:units = "KgC/m2/yr" ; + fates_seed_suppl:long_name = "Supplemental external seed rain source term (non-mass conserving)" ; + double fates_senleaf_long_fdrought(fates_pft) ; fates_senleaf_long_fdrought:units = "unitless[0-1]" ; fates_senleaf_long_fdrought:long_name = "multiplication factor for leaf longevity of senescent leaves during drought" ; - float fates_smpsc(fates_pft) ; + double fates_smpsc(fates_pft) ; fates_smpsc:units = "mm" ; fates_smpsc:long_name = "Soil water potential at full stomatal closure" ; - float fates_smpso(fates_pft) ; + double fates_smpso(fates_pft) ; fates_smpso:units = "mm" ; fates_smpso:long_name = "Soil water potential at full stomatal opening" ; - float fates_taulnir(fates_pft) ; + double fates_taulnir(fates_pft) ; fates_taulnir:units = "fraction" ; fates_taulnir:long_name = "Leaf transmittance: near-IR" ; - float fates_taulvis(fates_pft) ; + double fates_taulvis(fates_pft) ; fates_taulvis:units = "fraction" ; fates_taulvis:long_name = "Leaf transmittance: visible" ; - float fates_tausnir(fates_pft) ; + double fates_tausnir(fates_pft) ; fates_tausnir:units = "fraction" ; fates_tausnir:long_name = "Stem transmittance: near-IR" ; - float fates_tausvis(fates_pft) ; + double fates_tausvis(fates_pft) ; fates_tausvis:units = "fraction" ; fates_tausvis:long_name = "Stem transmittance: visible" ; - float fates_trim_inc(fates_pft) ; + double fates_trim_inc(fates_pft) ; fates_trim_inc:units = "m2/m2" ; fates_trim_inc:long_name = "Arbitrary incremental change in trimming function." ; - float fates_trim_limit(fates_pft) ; + double fates_trim_limit(fates_pft) ; fates_trim_limit:units = "m2/m2" ; fates_trim_limit:long_name = "Arbitrary limit to reductions in leaf area with stress" ; - float fates_turnover_carb_retrans(fates_prt_organs, fates_pft) ; + double fates_turnover_carb_retrans(fates_prt_organs, fates_pft) ; fates_turnover_carb_retrans:units = "-" ; fates_turnover_carb_retrans:long_name = "retranslocation fraction of carbon in turnover" ; - float fates_turnover_nitr_retrans(fates_prt_organs, fates_pft) ; + double fates_turnover_nitr_retrans(fates_prt_organs, fates_pft) ; fates_turnover_nitr_retrans:units = "-" ; fates_turnover_nitr_retrans:long_name = "retranslocation fraction of nitrogen in turnover" ; - float fates_turnover_phos_retrans(fates_prt_organs, fates_pft) ; + double fates_turnover_phos_retrans(fates_prt_organs, fates_pft) ; fates_turnover_phos_retrans:units = "-" ; fates_turnover_phos_retrans:long_name = "retranslocation fraction of phosphorous in turnover, parameter 1" ; - float fates_turnover_retrans_mode(fates_pft) ; + double fates_turnover_retrans_mode(fates_pft) ; fates_turnover_retrans_mode:units = "index" ; - fates_turnover_retrans_mode:long_name = "retranslocation method for leaf/fineroot turnover" ; - float fates_wood_density(fates_pft) ; + fates_turnover_retrans_mode:long_name = "retranslocation method for leaf/fineroot turnover." ; + fates_turnover_retrans_mode:possible_values = "1: constant fraction." ; + double fates_wood_density(fates_pft) ; fates_wood_density:units = "g/cm3" ; fates_wood_density:long_name = "mean density of woody tissue in plant" ; - float fates_woody(fates_pft) ; + double fates_woody(fates_pft) ; fates_woody:units = "logical flag" ; fates_woody:long_name = "Binary woody lifeform flag" ; - float fates_z0mr(fates_pft) ; + double fates_z0mr(fates_pft) ; fates_z0mr:units = "unitless" ; fates_z0mr:long_name = "Ratio of momentum roughness length to canopy top height" ; - float fates_FBD(fates_litterclass) ; - fates_FBD:units = "NA" ; - fates_FBD:long_name = "spitfire parameter related to fuel bulk density, see SFMain.F90" ; - float fates_low_moisture_Coeff(fates_litterclass) ; - fates_low_moisture_Coeff:units = "NA" ; - fates_low_moisture_Coeff:long_name = "spitfire parameter, equation B1 Thonicke et al 2010" ; - float fates_low_moisture_Slope(fates_litterclass) ; - fates_low_moisture_Slope:units = "NA" ; - fates_low_moisture_Slope:long_name = "spitfire parameter, equation B1 Thonicke et al 2010" ; - float fates_max_decomp(fates_litterclass) ; - fates_max_decomp:units = "kgC/m2/yr ?" ; + double fates_fire_FBD(fates_litterclass) ; + fates_fire_FBD:units = "NA" ; + fates_fire_FBD:long_name = "spitfire parameter related to fuel bulk density, see SFMain.F90" ; + double fates_fire_low_moisture_Coeff(fates_litterclass) ; + fates_fire_low_moisture_Coeff:units = "NA" ; + fates_fire_low_moisture_Coeff:long_name = "spitfire parameter, equation B1 Thonicke et al 2010" ; + double fates_fire_low_moisture_Slope(fates_litterclass) ; + fates_fire_low_moisture_Slope:units = "NA" ; + fates_fire_low_moisture_Slope:long_name = "spitfire parameter, equation B1 Thonicke et al 2010" ; + double fates_fire_mid_moisture(fates_litterclass) ; + fates_fire_mid_moisture:units = "NA" ; + fates_fire_mid_moisture:long_name = "spitfire litter moisture threshold to be considered medium dry" ; + double fates_fire_mid_moisture_Coeff(fates_litterclass) ; + fates_fire_mid_moisture_Coeff:units = "NA" ; + fates_fire_mid_moisture_Coeff:long_name = "spitfire parameter, equation B1 Thonicke et al 2010" ; + double fates_fire_mid_moisture_Slope(fates_litterclass) ; + fates_fire_mid_moisture_Slope:units = "NA" ; + fates_fire_mid_moisture_Slope:long_name = "spitfire parameter, equation B1 Thonicke et al 2010" ; + double fates_fire_min_moisture(fates_litterclass) ; + fates_fire_min_moisture:units = "NA" ; + fates_fire_min_moisture:long_name = "spitfire litter moisture threshold to be considered very dry" ; + double fates_fire_SAV(fates_litterclass) ; + fates_fire_SAV:units = "NA" ; + fates_fire_SAV:long_name = "spitfire parameter related to surface area to volume ratio, see SFMain.F90" ; + double fates_max_decomp(fates_litterclass) ; + fates_max_decomp:units = "yr-1" ; fates_max_decomp:long_name = "maximum rate of litter & CWD transfer from non-decomposing class into decomposing class" ; - float fates_mid_moisture(fates_litterclass) ; - fates_mid_moisture:units = "NA" ; - fates_mid_moisture:long_name = "spitfire litter moisture threshold to be considered medium dry" ; - float fates_mid_moisture_Coeff(fates_litterclass) ; - fates_mid_moisture_Coeff:units = "NA" ; - fates_mid_moisture_Coeff:long_name = "spitfire parameter, equation B1 Thonicke et al 2010" ; - float fates_mid_moisture_Slope(fates_litterclass) ; - fates_mid_moisture_Slope:units = "NA" ; - fates_mid_moisture_Slope:long_name = "spitfire parameter, equation B1 Thonicke et al 2010" ; - float fates_min_moisture(fates_litterclass) ; - fates_min_moisture:units = "NA" ; - fates_min_moisture:long_name = "spitfire litter moisture threshold to be considered very dry" ; - float fates_SAV(fates_litterclass) ; - fates_SAV:units = "NA" ; - fates_SAV:long_name = "spitfire parameter related to surface area to volume ratio, see SFMain.F90" ; - float fates_CWD_frac(fates_NCWD) ; + double fates_CWD_frac(fates_NCWD) ; fates_CWD_frac:units = "fraction" ; fates_CWD_frac:long_name = "fraction of woody (bdead+bsw) biomass destined for CWD pool" ; - float fates_drying_ratio ; - fates_drying_ratio:units = "NA" ; - fates_drying_ratio:long_name = "spitfire parameter, fire drying ratio for fuel moisture, alpha_FMC EQ 6 Thonicke et al 2010" ; - float fates_durat_slope ; - fates_durat_slope:units = "NA" ; - fates_durat_slope:long_name = "spitfire parameter, fire max duration slope, Equation 14 Thonicke et al 2010" ; - float fates_fdi_a ; - fates_fdi_a:units = "NA" ; - fates_fdi_a:long_name = "spitfire parameter (unknown) " ; - float fates_fdi_alpha ; - fates_fdi_alpha:units = "NA" ; - fates_fdi_alpha:long_name = "spitfire parameter, EQ 7 Venevsky et al. GCB 2002,(modified EQ 8 Thonicke et al. 2010) " ; - float fates_fdi_b ; - fates_fdi_b:units = "NA" ; - fates_fdi_b:long_name = "spitfire parameter (unknown) " ; - float fates_fuel_energy ; - fates_fuel_energy:units = "kJ/kg" ; - fates_fuel_energy:long_name = "pitfire parameter, heat content of fuel" ; - float fates_max_durat ; - fates_max_durat:units = "minutes" ; - fates_max_durat:long_name = "spitfire parameter, fire maximum duration, Equation 14 Thonicke et al 2010" ; - float fates_miner_damp ; - fates_miner_damp:units = "NA" ; - fates_miner_damp:long_name = "spitfire parameter, mineral-dampening coefficient EQ A1 Thonicke et al 2010 " ; - float fates_miner_total ; - fates_miner_total:units = "fraction" ; - fates_miner_total:long_name = "spitfire parameter, total mineral content, Table A1 Thonicke et al 2010" ; - float fates_part_dens ; - fates_part_dens:units = "kg/m2" ; - fates_part_dens:long_name = "spitfire parameter, oven dry particle density, Table A1 Thonicke et al 2010" ; + double fates_base_mr_20 ; + fates_base_mr_20:units = "gC/gN/s" ; + fates_base_mr_20:long_name = "Base maintenance respiration rate for plant tissues, using Ryan 1991" ; + double fates_bbopt_c3 ; + fates_bbopt_c3:units = "umol H2O/m**2/s" ; + fates_bbopt_c3:long_name = "Ball-Berry minimum unstressed leaf conductance for C3" ; + double fates_bbopt_c4 ; + fates_bbopt_c4:units = "umol H2O/m**2/s" ; + fates_bbopt_c4:long_name = "Ball-Berry minimum unstressed leaf conductance for C4" ; + double fates_canopy_closure_thresh ; + fates_canopy_closure_thresh:units = "unitless" ; + fates_canopy_closure_thresh:long_name = "tree canopy coverage at which crown area allometry changes from savanna to forest value" ; + double fates_cohort_age_fusion_tol ; + fates_cohort_age_fusion_tol:units = "unitless" ; + fates_cohort_age_fusion_tol:long_name = "minimum fraction in differece in cohort age between cohorts. 0 or _ implies functionality is turned off." ; + double fates_cohort_size_fusion_tol ; + fates_cohort_size_fusion_tol:units = "unitless" ; + fates_cohort_size_fusion_tol:long_name = "minimum fraction in difference in dbh between cohorts" ; + double fates_comp_excln ; + fates_comp_excln:units = "none" ; + fates_comp_excln:long_name = "IF POSITIVE: weighting factor (exponent on dbh) for canopy layer exclusion and promotion, IF NEGATIVE: switch to use deterministic height sorting" ; + double fates_cwd_fcel ; + fates_cwd_fcel:units = "unitless" ; + fates_cwd_fcel:long_name = "Cellulose fraction for CWD" ; + double fates_cwd_flig ; + fates_cwd_flig:units = "unitless" ; + fates_cwd_flig:long_name = "Lignin fraction of coarse woody debris" ; + double fates_fire_active_crown_fire ; + fates_fire_active_crown_fire:units = "0 or 1" ; + fates_fire_active_crown_fire:long_name = "flag, 1=active crown fire 0=no active crown fire" ; + double fates_fire_cg_strikes ; + fates_fire_cg_strikes:units = "fraction (0-1)" ; + fates_fire_cg_strikes:long_name = "fraction of cloud to ground lightning strikes" ; + double fates_fire_drying_ratio ; + fates_fire_drying_ratio:units = "NA" ; + fates_fire_drying_ratio:long_name = "spitfire parameter, fire drying ratio for fuel moisture, alpha_FMC EQ 6 Thonicke et al 2010" ; + double fates_fire_durat_slope ; + fates_fire_durat_slope:units = "NA" ; + fates_fire_durat_slope:long_name = "spitfire parameter, fire max duration slope, Equation 14 Thonicke et al 2010" ; + double fates_fire_fdi_a ; + fates_fire_fdi_a:units = "NA" ; + fates_fire_fdi_a:long_name = "spitfire parameter, fire danger index, EQ 5 Thonicke et al 2010" ; + double fates_fire_fdi_alpha ; + fates_fire_fdi_alpha:units = "NA" ; + fates_fire_fdi_alpha:long_name = "spitfire parameter, EQ 7 Venevsky et al. GCB 2002,(modified EQ 8 Thonicke et al. 2010) " ; + double fates_fire_fdi_b ; + fates_fire_fdi_b:units = "NA" ; + fates_fire_fdi_b:long_name = "spitfire parameter, fire danger index, EQ 5 Thonicke et al 2010 " ; + double fates_fire_fuel_energy ; + fates_fire_fuel_energy:units = "kJ/kg" ; + fates_fire_fuel_energy:long_name = "spitfire parameter, heat content of fuel" ; + double fates_fire_max_durat ; + fates_fire_max_durat:units = "minutes" ; + fates_fire_max_durat:long_name = "spitfire parameter, fire maximum duration, Equation 14 Thonicke et al 2010" ; + double fates_fire_miner_damp ; + fates_fire_miner_damp:units = "NA" ; + fates_fire_miner_damp:long_name = "spitfire parameter, mineral-dampening coefficient EQ A1 Thonicke et al 2010 " ; + double fates_fire_miner_total ; + fates_fire_miner_total:units = "fraction" ; + fates_fire_miner_total:long_name = "spitfire parameter, total mineral content, Table A1 Thonicke et al 2010" ; + double fates_fire_nignitions ; + fates_fire_nignitions:units = "ignitions per year per km2" ; + fates_fire_nignitions:long_name = "number of annual ignitions per square km" ; + double fates_fire_part_dens ; + fates_fire_part_dens:units = "kg/m2" ; + fates_fire_part_dens:long_name = "spitfire parameter, oven dry particle density, Table A1 Thonicke et al 2010" ; + double fates_hydr_kmax_rsurf1 ; + fates_hydr_kmax_rsurf1:units = "kg water/m2 root area/Mpa/s" ; + fates_hydr_kmax_rsurf1:long_name = "maximum conducitivity for unit root surface (into root)" ; + double fates_hydr_kmax_rsurf2 ; + fates_hydr_kmax_rsurf2:units = "kg water/m2 root area/Mpa/s" ; + fates_hydr_kmax_rsurf2:long_name = "maximum conducitivity for unit root surface (out of root)" ; + double fates_hydr_psi0 ; + fates_hydr_psi0:units = "MPa" ; + fates_hydr_psi0:long_name = "sapwood water potential at saturation" ; + double fates_hydr_psicap ; + fates_hydr_psicap:units = "MPa" ; + fates_hydr_psicap:long_name = "sapwood water potential at which capillary reserves exhausted" ; + double fates_init_litter ; + fates_init_litter:units = "NA" ; + fates_init_litter:long_name = "Initialization value for litter pool in cold-start (NOT USED)" ; + double fates_logging_coll_under_frac ; + fates_logging_coll_under_frac:units = "fraction" ; + fates_logging_coll_under_frac:long_name = "Fraction of stems killed in the understory when logging generates disturbance" ; + double fates_logging_collateral_frac ; + fates_logging_collateral_frac:units = "fraction" ; + fates_logging_collateral_frac:long_name = "Fraction of large stems in upperstory that die from logging collateral damage" ; + double fates_logging_dbhmax_infra ; + fates_logging_dbhmax_infra:units = "cm" ; + fates_logging_dbhmax_infra:long_name = "Tree diameter, above which infrastructure from logging does not impact damage or mortality." ; + double fates_logging_dbhmin ; + fates_logging_dbhmin:units = "cm" ; + fates_logging_dbhmin:long_name = "Minimum dbh at which logging is applied" ; + double fates_logging_direct_frac ; + fates_logging_direct_frac:units = "fraction" ; + fates_logging_direct_frac:long_name = "Fraction of stems logged directly per event" ; + double fates_logging_event_code ; + fates_logging_event_code:units = "unitless" ; + fates_logging_event_code:long_name = "Integer code that options how logging events are structured" ; + double fates_logging_export_frac ; + fates_logging_export_frac:units = "fraction" ; + fates_logging_export_frac:long_name = "fraction of trunk product being shipped offsite, the leftovers will be left onsite as large CWD" ; + double fates_logging_mechanical_frac ; + fates_logging_mechanical_frac:units = "fraction" ; + fates_logging_mechanical_frac:long_name = "Fraction of stems killed due infrastructure an other mechanical means" ; + double fates_mort_disturb_frac ; + fates_mort_disturb_frac:units = "fraction" ; + fates_mort_disturb_frac:long_name = "fraction of canopy mortality that results in disturbance (i.e. transfer of area from new to old patch)" ; + double fates_mort_understorey_death ; + fates_mort_understorey_death:units = "fraction" ; + fates_mort_understorey_death:long_name = "fraction of plants in understorey cohort impacted by overstorey tree-fall" ; + double fates_patch_fusion_tol ; + fates_patch_fusion_tol:units = "unitless" ; + fates_patch_fusion_tol:long_name = "minimum fraction in difference in profiles between patches" ; + double fates_phen_a ; + fates_phen_a:units = "none" ; + fates_phen_a:long_name = "GDD accumulation function, intercept parameter: gdd_thesh = a + b exp(c*ncd)" ; + double fates_phen_b ; + fates_phen_b:units = "none" ; + fates_phen_b:long_name = "GDD accumulation function, multiplier parameter: gdd_thesh = a + b exp(c*ncd)" ; + double fates_phen_c ; + fates_phen_c:units = "none" ; + fates_phen_c:long_name = "GDD accumulation function, exponent parameter: gdd_thesh = a + b exp(c*ncd)" ; + double fates_phen_chiltemp ; + fates_phen_chiltemp:units = "degrees C" ; + fates_phen_chiltemp:long_name = "chilling day counting threshold" ; + double fates_phen_coldtemp ; + fates_phen_coldtemp:units = "degrees C" ; + fates_phen_coldtemp:long_name = "temperature exceedance to flag a cold-day for temperature leaf drop" ; + double fates_phen_doff_time ; + fates_phen_doff_time:units = "days" ; + fates_phen_doff_time:long_name = "day threshold compared against days since leaves became off-allometry" ; + double fates_phen_drought_threshold ; + fates_phen_drought_threshold:units = "m3/m3" ; + fates_phen_drought_threshold:long_name = "liquid volume in soil layer, threashold for drought phenology" ; + double fates_phen_mindayson ; + fates_phen_mindayson:units = "days" ; + fates_phen_mindayson:long_name = "day threshold compared against days since leaves became on-allometry" ; + double fates_phen_ncolddayslim ; + fates_phen_ncolddayslim:units = "days" ; + fates_phen_ncolddayslim:long_name = "day threshold exceedance for temperature leaf-drop" ; + double fates_q10_froz ; + fates_q10_froz:units = "unitless" ; + fates_q10_froz:long_name = "Q10 for frozen-soil respiration rates" ; + double fates_q10_mr ; + fates_q10_mr:units = "unitless" ; + fates_q10_mr:long_name = "Q10 for maintenance respiration" ; + double fates_soil_salinity ; + fates_soil_salinity:units = "ppt" ; + fates_soil_salinity:long_name = "soil salinity used for model when not coupled to dynamic soil salinity" ; // global attributes: - :history = "This file was made from FatesPFTIndexSwapper.py \n", - " Input File = fates_params_14pft.nc \n", - " Indices = [1, 2, 4, 5, 6, 7, 9, 10, 11, 12, 13, 14] \n", - " Migrating in parameters from hydro file, and discussion \n", - " See NGEET/fates issue 444" ; + :history = "This parameter file is maintained in version control\n", + "See https://github.com/NGEET/fates/blob/master/parameter_files/fates_params_default.cdl \n", + "For changes, use git blame \n", + "" ; data: - 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, - 80, 90, 100 ; - fates_history_ageclass_bin_edges = 0, 1, 2, 5, 10, 20, 50 ; - fates_base_mr_20 = 2.52e-06 ; - - fates_bbopt_c3 = 10000 ; - - fates_bbopt_c4 = 40000 ; - - fates_canopy_closure_thresh = 0.8 ; - - fates_cohort_fusion_tol = 0.08 ; - - fates_comp_excln = 3 ; - - fates_cwd_fcel = 0.76 ; - - fates_cwd_flig = 0.24 ; + fates_history_coageclass_bin_edges = _ ; - fates_fire_nignitions = 15 ; - - fates_hydr_kmax_rsurf = 20.0 ; - - fates_hydr_psi0 = 0 ; - - fates_hydr_psicap = -0.6 ; - - fates_init_litter = 0.05 ; - - fates_logging_coll_under_frac = 0.55983 ; - - fates_logging_collateral_frac = 0.05 ; - - fates_logging_dbhmax_infra = 35 ; - - fates_logging_dbhmin = 50 ; - - fates_logging_direct_frac = 0.15 ; - - fates_logging_event_code = -30 ; - - fates_logging_mechanical_frac = 0.05 ; - - fates_mort_disturb_frac = 1 ; - - fates_mort_understorey_death = 0.55983 ; - - fates_patch_fusion_tol = 0.05 ; - - fates_phen_a = -68 ; - - fates_phen_b = 638 ; - - fates_phen_c = -0.01 ; - - fates_phen_chiltemp = 5 ; - - fates_phen_coldtemp = 7.5 ; - - fates_phen_doff_time = 100 ; - - fates_phen_drought_threshold = 0.15 ; - - fates_phen_mindayson = 30 ; - - fates_phen_ncolddayslim = 5 ; + fates_history_height_bin_edges = 0, 0.1, 0.3, 1, 3, 10 ; - fates_soil_salinity = 0.4 ; + fates_history_sizeclass_bin_edges = 0, 5, 10, 15, 20, 30, 40, 50, 60, 70, + 80, 90, 100 ; fates_pftname = "broadleaf_evergreen_tropical_tree ", @@ -747,7 +774,8 @@ data: fates_allom_l2fr = 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 ; - fates_allom_la_per_sa_int = 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8; + fates_allom_la_per_sa_int = 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, + 0.8, 0.8, 0.8 ; fates_allom_la_per_sa_slp = 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ; @@ -767,6 +795,28 @@ data: fates_displar = 0.67, 0.67, 0.67, 0.67, 0.67, 0.67, 0.67, 0.67, 0.67, 0.67, 0.67, 0.67 ; + fates_eca_alpha_ptase = _, _, _, _, _, _, _, _, _, _, _, _ ; + + fates_eca_decompmicc = _, _, _, _, _, _, _, _, _, _, _, _ ; + + fates_eca_km_nh4 = _, _, _, _, _, _, _, _, _, _, _, _ ; + + fates_eca_km_no3 = _, _, _, _, _, _, _, _, _, _, _, _ ; + + fates_eca_km_p = _, _, _, _, _, _, _, _, _, _, _, _ ; + + fates_eca_km_ptase = _, _, _, _, _, _, _, _, _, _, _, _ ; + + fates_eca_lambda_ptase = _, _, _, _, _, _, _, _, _, _, _, _ ; + + fates_eca_vmax_nh4 = _, _, _, _, _, _, _, _, _, _, _, _ ; + + fates_eca_vmax_no3 = _, _, _, _, _, _, _, _, _, _, _, _ ; + + fates_eca_vmax_p = _, _, _, _, _, _, _, _, _, _, _, _ ; + + fates_eca_vmax_ptase = _, _, _, _, _, _, _, _, _, _, _, _ ; + fates_fire_alpha_SH = 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2 ; @@ -834,10 +884,14 @@ data: 0.333, 0.333, 0.333, 0.333 ; fates_hydr_pinot_node = - -1.465984, -1.465984, -1.465984, -1.465984, -1.465984, -1.465984, -1.465984, -1.465984, -1.465984, -1.465984,-1.465984, -1.465984, - -1.22807, -1.22807, -1.22807, -1.22807, -1.22807, -1.22807, -1.22807, -1.22807, -1.22807, -1.22807, -1.22807, -1.22807, - -1.22807, -1.22807, -1.22807, -1.22807, -1.22807, -1.22807, -1.22807, -1.22807, -1.22807, -1.22807, -1.22807, -1.22807, - -1.043478, -1.043478, -1.043478, -1.043478, -1.043478, -1.043478, -1.043478, -1.043478,-1.043478, -1.043478, -1.043478, -1.043478 ; + -1.465984, -1.465984, -1.465984, -1.465984, -1.465984, -1.465984, + -1.465984, -1.465984, -1.465984, -1.465984, -1.465984, -1.465984, + -1.22807, -1.22807, -1.22807, -1.22807, -1.22807, -1.22807, -1.22807, + -1.22807, -1.22807, -1.22807, -1.22807, -1.22807, + -1.22807, -1.22807, -1.22807, -1.22807, -1.22807, -1.22807, -1.22807, + -1.22807, -1.22807, -1.22807, -1.22807, -1.22807, + -1.043478, -1.043478, -1.043478, -1.043478, -1.043478, -1.043478, + -1.043478, -1.043478, -1.043478, -1.043478, -1.043478, -1.043478 ; fates_hydr_pitlp_node = -1.67, -1.67, -1.67, -1.67, -1.67, -1.67, -1.67, -1.67, -1.67, -1.67, @@ -887,7 +941,8 @@ data: fates_leaf_jmaxse = 495, 495, 495, 495, 495, 495, 495, 495, 495, 495, 495, 495 ; - fates_leaf_long = 1.5, 4, 1.0, 1.5, 1.0, 1.0, 1.5, 1.0, 1.0, 1.0, 1.0, 1.0 ; + fates_leaf_long = + 1.5, 4, 1, 1.5, 1, 1, 1.5, 1, 1, 1, 1, 1 ; fates_leaf_slamax = 0.0954, 0.0954, 0.0954, 0.0954, 0.0954, 0.0954, 0.012, 0.03, 0.03, 0.03, 0.03, 0.03 ; @@ -906,7 +961,8 @@ data: fates_leaf_tpuse = 490, 490, 490, 490, 490, 490, 490, 490, 490, 490, 490, 490 ; - fates_leaf_vcmax25top = 50, 65, 39, 62, 41, 58, 62, 54, 54, 78, 78, 78 ; + fates_leaf_vcmax25top = + 50, 65, 39, 62, 41, 58, 62, 54, 54, 78, 78, 78 ; fates_leaf_vcmaxha = 65330, 65330, 65330, 65330, 65330, 65330, 65330, 65330, 65330, 65330, 65330, 65330 ; @@ -945,6 +1001,14 @@ data: fates_mort_hf_sm_threshold = 1e-06, 1e-06, 1e-06, 1e-06, 1e-06, 1e-06, 1e-06, 1e-06, 1e-06, 1e-06, 1e-06, 1e-06 ; + fates_mort_ip_age_senescence = _, _, _, _, _, _, _, _, _, _, _, _ ; + + fates_mort_ip_size_senescence = _, _, _, _, _, _, _, _, _, _, _, _ ; + + fates_mort_r_age_senescence = _, _, _, _, _, _, _, _, _, _, _, _ ; + + fates_mort_r_size_senescence = _, _, _, _, _, _, _, _, _, _, _, _ ; + fates_mort_scalar_coldstress = 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3 ; fates_mort_scalar_cstarvation = 0.6, 0.6, 0.6, 0.6, 0.6, 0.6, 0.6, 0.6, 0.6, @@ -953,12 +1017,18 @@ data: fates_mort_scalar_hydrfailure = 0.6, 0.6, 0.6, 0.6, 0.6, 0.6, 0.6, 0.6, 0.6, 0.6, 0.6, 0.6 ; - fates_pft_used = 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 ; + fates_nfix1 = _, _, _, _, _, _, _, _, _, _, _, _ ; + + fates_nfix2 = _, _, _, _, _, _, _, _, _, _, _, _ ; + + fates_phen_cold_size_threshold = 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ; fates_phen_evergreen = 1, 1, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0 ; fates_phen_season_decid = 0, 0, 1, 0, 0, 1, 0, 0, 1, 1, 0, 0 ; + fates_phen_stem_drop_fraction = 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ; + fates_phen_stress_decid = 0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 1, 1 ; fates_phenflush_fraction = _, _, 0.5, _, 0.5, 0.5, _, 0.5, 0.5, 0.5, 0.5, 0.5 ; @@ -975,6 +1045,10 @@ data: fates_prescribed_npp_understory = 0.03125, 0.03125, 0.03125, 0.03125, 0.03125, 0.03125, 0.03125, 0.03125, 0.03125, 0.03125, 0.03125, 0.03125 ; + fates_prescribed_nuptake = _, _, _, _, _, _, _, _, _, _, _, _ ; + + fates_prescribed_puptake = _, _, _, _, _, _, _, _, _, _, _, _ ; + fates_prescribed_recruitment = 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02 ; @@ -990,8 +1064,10 @@ data: 0.033, 0.029, 0.04, 0.033, 0.04, 0.04, 0.033, 0.04, 0.04, 0.04, 0.04, 0.04, 0.024, 0.024, 0.024, 0.024, 0.024, 0.024, 0.024, 0.024, 0.024, 0.024, 0.024, 0.024, - 1.0e-8, 1.0e-8, 1.0e-8, 1.0e-8, 1.0e-8, 1.0e-8, 1.0e-8, 1.0e-8, 1.0e-8, 1.0e-8, 1.0e-8, 1.0e-8, - 1.0e-8, 1.0e-8, 1.0e-8, 1.0e-8, 1.0e-8, 1.0e-8, 1.0e-8, 1.0e-8, 1.0e-8, 1.0e-8, 1.0e-8, 1.0e-8, + 1e-08, 1e-08, 1e-08, 1e-08, 1e-08, 1e-08, 1e-08, 1e-08, 1e-08, 1e-08, + 1e-08, 1e-08, + 1e-08, 1e-08, 1e-08, 1e-08, 1e-08, 1e-08, 1e-08, 1e-08, 1e-08, 1e-08, + 1e-08, 1e-08, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.0047, 0.0047, 0.0047, 0.0047, 0.0047, 0.0047, 0.0047, 0.0047, 0.0047, 0.0047, 0.0047, 0.0047 ; @@ -1005,12 +1081,17 @@ data: _, _, _, _, _, _, _, _, _, _, _, _ ; fates_prt_phos_stoich_p1 = - _, _, _, _, _, _, _, _, _, _, _, _, - _, _, _, _, _, _, _, _, _, _, _, _, - _, _, _, _, _, _, _, _, _, _, _, _, - _, _, _, _, _, _, _, _, _, _, _, _, - _, _, _, _, _, _, _, _, _, _, _, _, - _, _, _, _, _, _, _, _, _, _, _, _ ; + 0.0033, 0.0029, 0.004, 0.0033, 0.004, 0.004, 0.0033, 0.004, 0.004, 0.004, + 0.004, 0.004, + 0.0024, 0.0024, 0.0024, 0.0024, 0.0024, 0.0024, 0.0024, 0.0024, 0.0024, + 0.0024, 0.0024, 0.0024, + 1e-09, 1e-09, 1e-09, 1e-09, 1e-09, 1e-09, 1e-09, 1e-09, 1e-09, 1e-09, + 1e-09, 1e-09, + 1e-09, 1e-09, 1e-09, 1e-09, 1e-09, 1e-09, 1e-09, 1e-09, 1e-09, 1e-09, + 1e-09, 1e-09, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0.00047, 0.00047, 0.00047, 0.00047, 0.00047, 0.00047, 0.00047, 0.00047, + 0.00047, 0.00047, 0.00047, 0.00047 ; fates_prt_phos_stoich_p2 = _, _, _, _, _, _, _, _, _, _, _, _, @@ -1020,10 +1101,11 @@ data: _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _ ; - fates_recruit_hgt_min = 1.3, 1.3, 1.3, 1.3, 1.3, 1.3, 0.75, 0.75, - 0.75, 0.125, 0.125, 0.125 ; + fates_recruit_hgt_min = 1.3, 1.3, 1.3, 1.3, 1.3, 1.3, 0.75, 0.75, 0.75, + 0.125, 0.125, 0.125 ; - fates_recruit_initd = 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2 ; + fates_recruit_initd = 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, + 0.2 ; fates_rholnir = 0.45, 0.35, 0.35, 0.45, 0.45, 0.45, 0.35, 0.45, 0.45, 0.35, 0.35, 0.35 ; @@ -1054,13 +1136,13 @@ data: fates_seed_dbh_repro_threshold = 150, 90, 90, 90, 90, 90, 3, 3, 2, 1.47, 1.47, 1.47 ; - fates_seed_decay_turnover = 0.51, 0.51, 0.51, 0.51, 0.51, 0.51, 0.51, 0.51, + fates_seed_decay_rate = 0.51, 0.51, 0.51, 0.51, 0.51, 0.51, 0.51, 0.51, 0.51, 0.51, 0.51, 0.51 ; - fates_seed_germination_timescale = 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, - 0.5, 0.5, 0.5, 0.5 ; + fates_seed_germination_rate = 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, + 0.5, 0.5, 0.5 ; - fates_seed_rain = 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_seed_suppl = 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ; fates_senleaf_long_fdrought = 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 ; @@ -1088,7 +1170,8 @@ data: fates_trim_limit = 0.3, 0.3, 0.3, 0.3, 0.3, 0.3, 0.3, 0.3, 0.3, 0.3, 0.3, 0.3 ; fates_turnover_carb_retrans = - 0.025, 0.025, 0.025, 0.025, 0.025, 0.025, 0.025, 0.025, 0.025, 0.025, 0.025, 0.025, + 0.025, 0.025, 0.025, 0.025, 0.025, 0.025, 0.025, 0.025, 0.025, 0.025, + 0.025, 0.025, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, @@ -1121,43 +1204,123 @@ data: fates_z0mr = 0.055, 0.055, 0.055, 0.055, 0.055, 0.055, 0.055, 0.055, 0.055, 0.055, 0.055, 0.055 ; - fates_FBD = 4, 15.4, 16.8, 19.6, 999, 4 ; + fates_fire_FBD = 15.4, 16.8, 19.6, 999, 4, 4 ; - fates_low_moisture_Coeff = 1.15, 1.12, 1.09, 0.98, 0.8, 1.15 ; + fates_fire_low_moisture_Coeff = 1.12, 1.09, 0.98, 0.8, 1.15, 1.15 ; - fates_low_moisture_Slope = 0.62, 0.62, 0.72, 0.85, 0.8, 0.62 ; + fates_fire_low_moisture_Slope = 0.62, 0.72, 0.85, 0.8, 0.62, 0.62 ; - fates_max_decomp = 1, 0.52, 0.383, 0.383, 0.19, 999 ; + fates_fire_mid_moisture = 0.72, 0.51, 0.38, 1, 0.8, 0.8 ; - fates_mid_moisture = 0.8, 0.72, 0.51, 0.38, 1, 0.8 ; + fates_fire_mid_moisture_Coeff = 2.35, 1.47, 1.06, 0.8, 3.2, 3.2 ; - fates_mid_moisture_Coeff = 3.2, 2.35, 1.47, 1.06, 0.8, 3.2 ; + fates_fire_mid_moisture_Slope = 2.35, 1.47, 1.06, 0.8, 3.2, 3.2 ; - fates_mid_moisture_Slope = 3.2, 2.35, 1.47, 1.06, 0.8, 3.2 ; + fates_fire_min_moisture = 0.18, 0.12, 0, 0, 0.24, 0.24 ; - fates_min_moisture = 0.24, 0.18, 0.12, 0, 0, 0.24 ; + fates_fire_SAV = 13, 3.58, 0.98, 0.2, 66, 66 ; - fates_SAV = 66, 13, 3.58, 0.98, 0.2, 66 ; + fates_max_decomp = 0.52, 0.383, 0.383, 0.19, 1, 999 ; fates_CWD_frac = 0.045, 0.075, 0.21, 0.67 ; - fates_drying_ratio = 13000 ; + fates_base_mr_20 = 2.52e-06 ; + + fates_bbopt_c3 = 10000 ; + + fates_bbopt_c4 = 40000 ; + + fates_canopy_closure_thresh = 0.8 ; + + fates_cohort_age_fusion_tol = _ ; + + fates_cohort_size_fusion_tol = 0.08 ; + + fates_comp_excln = 3 ; + + fates_cwd_fcel = 0.76 ; + + fates_cwd_flig = 0.24 ; + + fates_fire_active_crown_fire = 0 ; + + fates_fire_cg_strikes = 0.2 ; + + fates_fire_drying_ratio = 66000 ; + + fates_fire_durat_slope = -11.06 ; + + fates_fire_fdi_a = 17.62 ; + + fates_fire_fdi_alpha = 0.00037 ; + + fates_fire_fdi_b = 243.12 ; + + fates_fire_fuel_energy = 18000 ; + + fates_fire_max_durat = 240 ; + + fates_fire_miner_damp = 0.41739 ; + + fates_fire_miner_total = 0.055 ; + + fates_fire_nignitions = 15 ; + + fates_fire_part_dens = 513 ; + + fates_hydr_kmax_rsurf1 = 20 ; + + fates_hydr_kmax_rsurf2 = 0.0001 ; + + fates_hydr_psi0 = 0 ; + + fates_hydr_psicap = -0.6 ; + + fates_init_litter = 0.05 ; + + fates_logging_coll_under_frac = 0.55983 ; + + fates_logging_collateral_frac = 0.05 ; + + fates_logging_dbhmax_infra = 35 ; + + fates_logging_dbhmin = 50 ; + + fates_logging_direct_frac = 0.15 ; + + fates_logging_event_code = -30 ; + + fates_logging_export_frac = 0.8 ; + + fates_logging_mechanical_frac = 0.05 ; - fates_durat_slope = -11.06 ; + fates_mort_disturb_frac = 1 ; + + fates_mort_understorey_death = 0.55983 ; + + fates_patch_fusion_tol = 0.05 ; + + fates_phen_a = -68 ; + + fates_phen_b = 638 ; - fates_fdi_a = 17.62 ; + fates_phen_c = -0.01 ; - fates_fdi_alpha = 0.00037 ; + fates_phen_chiltemp = 5 ; - fates_fdi_b = 243.12 ; + fates_phen_coldtemp = 7.5 ; - fates_fuel_energy = 18000 ; + fates_phen_doff_time = 100 ; - fates_max_durat = 240 ; + fates_phen_drought_threshold = 0.15 ; - fates_miner_damp = 0.41739 ; + fates_phen_mindayson = 90 ; - fates_miner_total = 0.055 ; + fates_phen_ncolddayslim = 5 ; + + fates_q10_froz = 1.5 ; - fates_part_dens = 513 ; + fates_q10_mr = 1.5 ; + + fates_soil_salinity = 0.4 ; } diff --git a/parteh/PRTAllometricCarbonMod.F90 b/parteh/PRTAllometricCarbonMod.F90 index 7e35811d3b..2ab3877d03 100644 --- a/parteh/PRTAllometricCarbonMod.F90 +++ b/parteh/PRTAllometricCarbonMod.F90 @@ -91,7 +91,8 @@ 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, parameter :: num_bc_in = 2 ! Number of input boundary condition + 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 ! THere are no purely output boundary conditions integer, parameter :: num_bc_out = 0 ! Number of purely output boundary condtions @@ -353,6 +354,7 @@ subroutine DailyPRTAllometricCarbon(this) integer :: i_var ! index for iterating state variables integer :: i_age ! index for iterating leaf ages integer :: nleafage ! number of leaf age classifications + integer :: leaf_status ! are leaves on (2) or off (1) real(r8) :: leaf_age_flux ! carbon mass flux between leaf age classification pools @@ -398,6 +400,7 @@ 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 intgr_params(:) = un_initialized intgr_params(ac_bc_in_id_ctrim) = this%bc_in(ac_bc_in_id_ctrim)%rval @@ -456,7 +459,11 @@ subroutine DailyPRTAllometricCarbon(this) call bdead_allom( target_agw_c, target_bgw_c, target_sapw_c, ipft, target_struct_c) ! Target leaf biomass according to allometry and trimming - call bleaf(dbh,ipft,canopy_trim,target_leaf_c) + if(leaf_status==2) then + call bleaf(dbh,ipft,canopy_trim,target_leaf_c) + else + target_leaf_c = 0._r8 + end if ! Target fine-root biomass and deriv. according to allometry and trimming [kgC, kgC/cm] call bfineroot(dbh,ipft,canopy_trim,target_fnrt_c) @@ -689,8 +696,13 @@ subroutine DailyPRTAllometricCarbon(this) c_pool(struct_c_id) = struct_c c_pool(repro_c_id) = repro_c c_pool(dbh_id) = dbh - - c_mask(leaf_c_id) = grow_leaf + + ! Only grow leaves if we are in a "leaf-on" status + if(leaf_status==2) then + c_mask(leaf_c_id) = grow_leaf + else + c_mask(leaf_c_id) = .false. + end if c_mask(fnrt_c_id) = grow_fnrt c_mask(sapw_c_id) = grow_sapw c_mask(store_c_id) = grow_store @@ -928,6 +940,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)) + call bleaf(dbh,ipft,canopy_trim,ct_leaf,ct_dleafdd) call bfineroot(dbh,ipft,canopy_trim,ct_fnrt,ct_dfnrtdd) diff --git a/parteh/PRTGenericMod.F90 b/parteh/PRTGenericMod.F90 index e82c93240d..76e45336b1 100644 --- a/parteh/PRTGenericMod.F90 +++ b/parteh/PRTGenericMod.F90 @@ -31,18 +31,19 @@ module PRTGenericMod implicit none + private ! Modules are private by default - integer, parameter :: maxlen_varname = 128 - integer, parameter :: maxlen_varsymbol = 32 - integer, parameter :: maxlen_varunits = 32 - integer, parameter :: len_baseunit = 6 + integer, parameter, public :: maxlen_varname = 128 + integer, parameter, public :: maxlen_varsymbol = 32 + integer, parameter, public :: maxlen_varunits = 32 + integer, parameter, public :: len_baseunit = 6 ! We use this parameter as the value for which we set un-initialized values - real(r8), parameter :: un_initialized = -9.9e32_r8 + real(r8), parameter, public :: un_initialized = -9.9e32_r8 ! We use this parameter as the value for which we check un-initialized values - real(r8), parameter :: check_initialized = -8.8e32_r8 + real(r8), parameter, public :: check_initialized = -8.8e32_r8 ! ------------------------------------------------------------------------------------- @@ -52,16 +53,16 @@ module PRTGenericMod ! This assumption cannot be broken! ! ------------------------------------------------------------------------------------- - character(len=len_baseunit), parameter :: mass_unit = 'kg' - character(len=len_baseunit), parameter :: mass_rate_unit = 'kg/day' + character(len=len_baseunit), parameter, public :: mass_unit = 'kg' + character(len=len_baseunit), parameter, public :: mass_rate_unit = 'kg/day' ! ------------------------------------------------------------------------------------- ! Allocation Hypothesis Types ! These should each have their own module ! ------------------------------------------------------------------------------------- - integer, parameter :: prt_carbon_allom_hyp = 1 - integer, parameter :: prt_cnp_flex_allom_hyp = 2 ! Still under development + integer, parameter, public :: prt_carbon_allom_hyp = 1 + integer, parameter, public :: prt_cnp_flex_allom_hyp = 2 ! Still under development ! ------------------------------------------------------------------------------------- @@ -70,14 +71,14 @@ module PRTGenericMod ! in each hypothesis to organs that acknowledged in the calling model ! ------------------------------------------------------------------------------------- - integer, parameter :: num_organ_types = 6 - integer, parameter :: all_organs = 0 ! index for all organs - integer, parameter :: leaf_organ = 1 ! index for leaf organs - integer, parameter :: fnrt_organ = 2 ! index for fine-root organs - integer, parameter :: sapw_organ = 3 ! index for sapwood organs - integer, parameter :: store_organ = 4 ! index for storage organs - integer, parameter :: repro_organ = 5 ! index for reproductive organs - integer, parameter :: struct_organ = 6 ! index for structure (dead) organs + integer, parameter, public :: num_organ_types = 6 + integer, parameter, public :: all_organs = 0 ! index for all organs + integer, parameter, public :: leaf_organ = 1 ! index for leaf organs + integer, parameter, public :: fnrt_organ = 2 ! index for fine-root organs + integer, parameter, public :: sapw_organ = 3 ! index for sapwood organs + integer, parameter, public :: store_organ = 4 ! index for storage organs + integer, parameter, public :: repro_organ = 5 ! index for reproductive organs + integer, parameter, public :: struct_organ = 6 ! index for structure (dead) organs ! ------------------------------------------------------------------------------------- ! Element types @@ -85,7 +86,7 @@ module PRTGenericMod ! to the element that are acknowledged in the calling model ! ------------------------------------------------------------------------------------- - integer, parameter :: num_element_types = 6 ! Total number of unique element + integer, parameter, public :: num_element_types = 6 ! Total number of unique element ! curently recognized by PARTEH ! should be max index in list below @@ -94,36 +95,37 @@ module PRTGenericMod ! element. At the time of writing this, we are very far away from ! creating allocation schemes that even use potassium. - integer, parameter :: all_carbon_elements = 0 - integer, parameter :: carbon12_element = 1 - integer, parameter :: carbon13_element = 2 - integer, parameter :: carbon14_element = 3 - integer, parameter :: nitrogen_element = 4 - integer, parameter :: phosphorous_element = 5 - integer, parameter :: potassium_element = 6 + integer, parameter, public :: all_carbon_elements = 0 + integer, parameter, public :: carbon12_element = 1 + integer, parameter, public :: carbon13_element = 2 + integer, parameter, public :: carbon14_element = 3 + integer, parameter, public :: nitrogen_element = 4 + integer, parameter, public :: phosphorus_element = 5 + integer, parameter, public :: potassium_element = 6 + ! The following elements are just placeholders. In the future ! if someone wants to develope an allocation hypothesis ! that uses nickel, we can just uncomment it from this list - ! integer, parameter :: calcium_element = 7 - ! integer, parameter :: magnesium_element = 8 - ! integer, parameter :: sulfur_element = 9 - ! integer, parameter :: chlorine_element = 10 - ! integer, parameter :: iron_element = 11 - ! integer, parameter :: manganese_element = 12 - ! integer, parameter :: zinc_element = 13 - ! integer, parameter :: copper_element = 14 - ! integer, parameter :: boron_element = 15 - ! integer, parameter :: molybdenum_element = 16 - ! integer, parameter :: nickel_element = 17 + ! integer, parameter, public :: calcium_element = 7 + ! integer, parameter, public :: magnesium_element = 8 + ! integer, parameter, public :: sulfur_element = 9 + ! integer, parameter, public :: chlorine_element = 10 + ! integer, parameter, public :: iron_element = 11 + ! integer, parameter, public :: manganese_element = 12 + ! integer, parameter, public :: zinc_element = 13 + ! integer, parameter, public :: copper_element = 14 + ! integer, parameter, public :: boron_element = 15 + ! integer, parameter, public :: molybdenum_element = 16 + ! integer, parameter, public :: nickel_element = 17 ! We have some lists of elements or lists of organs, such as ! a list of all carbon elements. To keep routines simple ! we set a global to the maximum list size for scratch arrays. - integer, parameter :: max_spec_per_group = 3 ! we may query these lists + integer, parameter, public :: max_spec_per_group = 3 ! we may query these lists ! the carbon elements are the biggest list ! right now @@ -131,7 +133,7 @@ module PRTGenericMod ! List of all carbon elements, the special index "all_carbon_elements" ! implies the following list of carbon organs - integer, parameter, dimension(3) :: carbon_elements_list = & + integer, parameter, dimension(3), public :: carbon_elements_list = & [carbon12_element, carbon13_element, carbon14_element] @@ -160,7 +162,7 @@ module PRTGenericMod ! ! ------------------------------------------------------------------------------------- - type prt_vartype + type, public :: prt_vartype real(r8),allocatable :: val(:) ! Instantaneous state variable [kg] real(r8),allocatable :: val0(:) ! State variable at the beginning @@ -189,7 +191,7 @@ module PRTGenericMod ! output only, and input-output. ! ------------------------------------------------------------------------------------- - type prt_bctype + type, public :: prt_bctype real(r8), pointer :: rval integer, pointer :: ival @@ -213,15 +215,15 @@ module PRTGenericMod ! all the different modules. ! ------------------------------------------------------------------------------------- - type prt_vartypes + type, public :: prt_vartypes type(prt_vartype),allocatable :: variables(:) ! The state variables and fluxes type(prt_bctype), allocatable :: bc_inout(:) ! These boundaries may be changed type(prt_bctype), allocatable :: bc_in(:) ! These are protected type(prt_bctype), allocatable :: bc_out(:) ! These are overwritten real(r8) :: ode_opt_step - - contains + + contains ! These are extendable procedures that have specialized ! content in each of the different hypotheses @@ -270,7 +272,7 @@ module PRTGenericMod ! the variables for any given hypothesis ! ------------------------------------------------------------------------------------- - type :: state_descriptor_type + type, public :: state_descriptor_type character(len=maxlen_varname) :: longname character(len=maxlen_varsymbol) :: symbol integer :: organ_id ! global id for organ @@ -289,7 +291,7 @@ module PRTGenericMod ! element, the number of unique variables is capped at the number of elements ! per each organ. - type organ_map_type + type, public :: organ_map_type integer, dimension(1:num_element_types) :: var_id integer :: num_vars end type organ_map_type @@ -302,7 +304,7 @@ module PRTGenericMod ! world. ! ! - ! | carbon | nitrogen | phosphorous | .... | + ! | carbon | nitrogen | phosphorus | .... | ! ------------------------------------------ ! leaf | | | | | ! fine-root | | | | | @@ -315,7 +317,7 @@ module PRTGenericMod ! ! ------------------------------------------------------------------------------------- - type prt_global_type + type, public :: prt_global_type ! Note that index 0 is reserved for "all" or "irrelevant" character(len=maxlen_varname) :: hyp_name @@ -355,8 +357,11 @@ module PRTGenericMod end type prt_global_type - type(prt_global_type),pointer :: prt_global + type(prt_global_type),pointer,public :: prt_global + ! Make necessary procedures public + public :: GetCoordVal + public :: SetState contains diff --git a/parteh/PRTLossFluxesMod.F90 b/parteh/PRTLossFluxesMod.F90 index a47b613862..a805d58a96 100644 --- a/parteh/PRTLossFluxesMod.F90 +++ b/parteh/PRTLossFluxesMod.F90 @@ -13,7 +13,7 @@ module PRTLossFluxesMod use PRTGenericMod, only : carbon13_element use PRTGenericMod, only : carbon14_element use PRTGenericMod, only : nitrogen_element - use PRTGenericMod, only : phosphorous_element + use PRTGenericMod, only : phosphorus_element use PRTGenericMod, only : un_initialized use PRTGenericMod, only : check_initialized use PRTGenericMod, only : num_organ_types @@ -108,7 +108,8 @@ subroutine PRTPhenologyFlush(prt, ipft, organ_id, c_store_transfer_frac) ! If other organs should be desired (like seasonality of fine-roots) ! those parameters and clauses need to be added - if(organ_id .ne. leaf_organ) then + !if(organ_id .ne. leaf_organ) then + if(organ_id .ne. leaf_organ .AND. EDPftvarcon_inst%woody(ipft) == itrue) then write(fates_log(),*) 'Deciduous drop and re-flushing only allowed in leaves' write(fates_log(),*) ' leaf_organ: ',leaf_organ write(fates_log(),*) ' organ: ',organ_id @@ -117,7 +118,7 @@ subroutine PRTPhenologyFlush(prt, ipft, organ_id, c_store_transfer_frac) end if if(prt_global%hyp_id .le. 2) then - i_leaf_pos = 1 + i_leaf_pos = 1 ! also used for sapwood and structural for grass i_store_pos = 1 ! hypothesis 1/2 only have ! 1 storage pool else @@ -222,14 +223,14 @@ subroutine PRTPhenologyFlush(prt, ipft, organ_id, c_store_transfer_frac) if( element_id == nitrogen_element ) then target_stoich = EDPftvarcon_inst%prt_nitr_stoich_p1(ipft,organ_id) - else if( element_id == phosphorous_element ) then + else if( element_id == phosphorus_element ) then target_stoich = EDPftvarcon_inst%prt_phos_stoich_p1(ipft,organ_id) else - write(fates_log(),*) ' Trying to calculate nutrient flushing target' - write(fates_log(),*) ' for element that DNE' - write(fates_log(),*) ' organ: ',organ_id,' element: ',element_id - write(fates_log(),*) 'Exiting' - call endrun(msg=errMsg(__FILE__, __LINE__)) + write(fates_log(),*) ' Trying to calculate nutrient flushing target' + write(fates_log(),*) ' for element that DNE' + write(fates_log(),*) ' organ: ',organ_id,' element: ',element_id + write(fates_log(),*) 'Exiting' + call endrun(msg=errMsg(__FILE__, __LINE__)) end if ! Loop over all of the coordinate ids @@ -245,25 +246,24 @@ subroutine PRTPhenologyFlush(prt, ipft, organ_id, c_store_transfer_frac) mass_transfer = min(sp_demand, prt%variables(i_store)%val(i_store_pos)) ! Increment the pool of interest - prt%variables(i_var)%net_alloc(i_pos) = & - prt%variables(i_var)%net_alloc(i_pos) + mass_transfer + prt%variables(i_var)%net_alloc(i_pos) = & + prt%variables(i_var)%net_alloc(i_pos) + mass_transfer ! Update the pool - prt%variables(i_var)%val(i_pos) = & - prt%variables(i_var)%val(i_pos) + mass_transfer + prt%variables(i_var)%val(i_pos) = & + prt%variables(i_var)%val(i_pos) + mass_transfer ! Increment the store pool allocation diagnostic prt%variables(i_store)%net_alloc(i_store_pos) = & - prt%variables(i_store)%net_alloc(i_store_pos) - mass_transfer + prt%variables(i_store)%net_alloc(i_store_pos) - mass_transfer ! Update the store pool - prt%variables(i_store)%val(i_store_pos) = & - prt%variables(i_store)%val(i_store_pos) - mass_transfer - + prt%variables(i_store)%val(i_store_pos) = & + prt%variables(i_store)%val(i_store_pos) - mass_transfer end do - end if + end if end do @@ -317,7 +317,7 @@ subroutine PRTBurnLosses(prt, organ_id, mass_fraction) + burned_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) & + prt%variables(i_var)%val(i_pos) = prt%variables(i_var)%val(i_pos) & - burned_mass end do @@ -362,8 +362,8 @@ subroutine PRTReproRelease(prt, organ_id, element_id, mass_fraction, mass_out) ! tissues (ie seeds, flowers, etc). but now we just have 1. if (organ_id .ne. repro_organ) then - write(fates_log(),*) 'Reproductive tissue releases were called for a non-reproductive' - write(fates_log(),*) 'organ.' + write(fates_log(),*) 'Reproductive tissue releases were called' + write(fates_log(),*) 'for a non-reproductive organ.' call endrun(msg=errMsg(__FILE__, __LINE__)) end if @@ -421,7 +421,8 @@ subroutine PRTDeciduousTurnover(prt,ipft,organ_id,mass_fraction) ! If other organs should be desired (like seasonality of fine-roots) ! those parameters and clauses need to be added - if(organ_id .ne. leaf_organ) then + !if(organ_id .ne. leaf_organ) then + if(organ_id .ne. leaf_organ .AND. EDPftvarcon_inst%woody(ipft) == itrue) then write(fates_log(),*) 'Deciduous drop and re-flushing only allowed in leaves' write(fates_log(),*) ' leaf_organ: ',leaf_organ write(fates_log(),*) ' organ: ',organ_id @@ -478,16 +479,18 @@ subroutine DeciduousTurnoverSimpleRetranslocation(prt,ipft,organ_id,mass_fractio associate(organ_map => prt_global%organ_map) - if( (organ_id == store_organ) .or. & - (organ_id == struct_organ) .or. & - (organ_id == sapw_organ)) then - - write(fates_log(),*) 'Deciduous turnover (leaf drop, etc)' - write(fates_log(),*) ' was specified for an unexpected organ' - write(fates_log(),*) ' organ: ',organ_id - write(fates_log(),*) 'Exiting' - call endrun(msg=errMsg(__FILE__, __LINE__)) - + if((organ_id == store_organ) .or. & + (organ_id == struct_organ) .or. & + (organ_id == sapw_organ)) then + + if (EDPftvarcon_inst%woody(ipft) == itrue) then + write(fates_log(),*) 'Deciduous turnover (leaf drop, etc)' + write(fates_log(),*) ' was specified for an unexpected organ' + write(fates_log(),*) ' organ: ',organ_id + write(fates_log(),*) 'Exiting' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + end if if(prt_global%hyp_id .le. 2) then @@ -513,7 +516,7 @@ subroutine DeciduousTurnoverSimpleRetranslocation(prt,ipft,organ_id,mass_fractio retrans = EDPftvarcon_inst%turnover_carb_retrans(ipft,organ_id) else if( element_id == nitrogen_element ) then retrans = EDPftvarcon_inst%turnover_nitr_retrans(ipft,organ_id) - else if( element_id == phosphorous_element ) then + else if( element_id == phosphorus_element ) then retrans = EDPftvarcon_inst%turnover_phos_retrans(ipft,organ_id) else write(fates_log(),*) 'Please add a new re-translocation clause to your ' @@ -700,7 +703,7 @@ subroutine MaintTurnoverSimpleRetranslocation(prt,ipft,is_drought) retrans = EDPftvarcon_inst%turnover_carb_retrans(ipft,organ_id) else if( element_id == nitrogen_element ) then retrans = EDPftvarcon_inst%turnover_nitr_retrans(ipft,organ_id) - else if( element_id == phosphorous_element ) then + else if( element_id == phosphorus_element ) then retrans = EDPftvarcon_inst%turnover_phos_retrans(ipft,organ_id) else write(fates_log(),*) 'Please add a new re-translocation clause to your ' diff --git a/tools/FatesPFTIndexSwapper.py b/tools/FatesPFTIndexSwapper.py index 63825b6784..091ffc30ce 100755 --- a/tools/FatesPFTIndexSwapper.py +++ b/tools/FatesPFTIndexSwapper.py @@ -25,13 +25,13 @@ prt_dim_name = 'fates_prt_organs' -class timetype: - +class timetype: + # This is time, like the thing that always goes forward and cant be seen # or touched, insert creative riddle here def __init__(self,ntimes): - + self.year = -9*np.ones((ntimes)) self.month = -9*np.ones((ntimes)) # This is a floating point decimal day @@ -111,7 +111,7 @@ def interp_args(argv): if (output_fname == "none"): print("You must specify an output file:\n\n") usage() - sys.exit(2) + sys.exit(2) if (donor_pft_indices_str == ''): print("You must specify at least one donor pft index!\n\n") @@ -120,7 +120,7 @@ def interp_args(argv): else: donor_pft_indices = [] for strpft in donor_pft_indices_str.split(','): - donor_pft_indices.append(int(strpft)) + donor_pft_indices.append(int(strpft)) return (input_fname,output_fname,donor_pft_indices) @@ -141,7 +141,7 @@ def main(argv): # Open the netcdf files fp_out = netcdf.netcdf_file(output_fname, 'w') - + fp_in = netcdf.netcdf_file(input_fname, 'r') for key, value in sorted(fp_in.dimensions.iteritems()): @@ -155,10 +155,10 @@ def main(argv): for key, value in sorted(fp_in.variables.iteritems()): print('Creating Variable: ',key) # code.interact(local=locals()) - - + + in_var = fp_in.variables.get(key) - + # Idenfity if this variable has pft dimension pft_dim_found = -1 @@ -166,7 +166,7 @@ def main(argv): pft_dim_len = len(fp_in.variables.get(key).dimensions) for idim, name in enumerate(fp_in.variables.get(key).dimensions): - # Manipulate data + # Manipulate data if(name==pft_dim_name): pft_dim_found = idim if(name==prt_dim_name): @@ -176,13 +176,13 @@ def main(argv): # Copy over the input data # Tedious, but I have to permute through all combinations of dimension position if( pft_dim_len == 0 ): - out_var = fp_out.createVariable(key,'f',(fp_in.variables.get(key).dimensions)) + out_var = fp_out.createVariable(key,'d',(fp_in.variables.get(key).dimensions)) out_var.assignValue(float(fp_in.variables.get(key).data)) elif( (pft_dim_found==-1) & (prt_dim_found==-1) ): - out_var = fp_out.createVariable(key,'f',(fp_in.variables.get(key).dimensions)) + out_var = fp_out.createVariable(key,'d',(fp_in.variables.get(key).dimensions)) out_var[:] = in_var[:] elif( (pft_dim_found==0) & (pft_dim_len==1) ): # 1D fates_pft - out_var = fp_out.createVariable(key,'f',(fp_in.variables.get(key).dimensions)) + out_var = fp_out.createVariable(key,'d',(fp_in.variables.get(key).dimensions)) tmp_out = np.zeros([num_pft_out]) for id,ipft in enumerate(donor_pft_indices): tmp_out[id] = fp_in.variables.get(key).data[ipft-1] @@ -190,8 +190,8 @@ def main(argv): # 2D hydro_organ - fates_pft # or.. prt_organ - fates_pft - elif( (pft_dim_found==1) & (pft_dim_len==2) ): - out_var = fp_out.createVariable(key,'f',(fp_in.variables.get(key).dimensions)) + elif( (pft_dim_found==1) & (pft_dim_len==2) ): + out_var = fp_out.createVariable(key,'d',(fp_in.variables.get(key).dimensions)) dim2_len = fp_in.dimensions.get(fp_in.variables.get(key).dimensions[0]) tmp_out = np.zeros([dim2_len,num_pft_out]) for id,ipft in enumerate(donor_pft_indices): @@ -206,7 +206,7 @@ def main(argv): for id,ipft in enumerate(donor_pft_indices): out_var[id] = fp_in.variables.get(key).data[ipft-1] - + elif( (prt_dim_found==0) & (pft_dim_len==2) ): # fates_prt_organs - string_length out_var = fp_out.createVariable(key,'c',(fp_in.variables.get(key).dimensions)) out_var[:] = in_var[:] @@ -240,14 +240,6 @@ def main(argv): # ======================================================================================= # This is the actual call to main - + if __name__ == "__main__": main(sys.argv) - - - - - - - - diff --git a/tools/modify_fates_paramfile.py b/tools/modify_fates_paramfile.py index e79240035d..c3cfa649fb 100755 --- a/tools/modify_fates_paramfile.py +++ b/tools/modify_fates_paramfile.py @@ -86,10 +86,6 @@ def main(): npft_file = var.shape[i] pftdim = i otherdimpresent = False - elif var.dimensions[i] == 'fates_scalar': - npft_file = None - pftdim = None - otherdimpresent = False elif var.dimensions[i] in ['fates_history_age_bins','fates_history_size_bins','fates_history_height_bins','fates_NCWD','fates_litterclass','fates_leafage_class','fates_prt_organs','fates_hydr_organs','fates_variants']: otherdimpresent = True otherdimname = var.dimensions[i] diff --git a/tools/ncvarsort.py b/tools/ncvarsort.py index 6c56703d68..3f0f3a3a47 100755 --- a/tools/ncvarsort.py +++ b/tools/ncvarsort.py @@ -4,7 +4,7 @@ # --input or --fin: input filename. # --output or --fout: output filename. If missing, will assume its directly modifying the input file, and will prompt unless -O is specified -from scipy.io import netcdf as nc +import netCDF4 as nc import sys import os import argparse @@ -19,11 +19,12 @@ def main(): parser.add_argument('--fin', '--input', dest='fnamein', type=str, help="Input filename. Required.", required=True) parser.add_argument('--fout','--output', dest='fnameout', type=str, help="Output filename. Required.", required=True) parser.add_argument('--O','--overwrite', dest='overwrite', help="If present, automatically overwrite the output file.", action="store_true") + parser.add_argument('--debug', dest='debug', help="If present, output more diagnostics", action="store_true") # args = parser.parse_args() # # open the input dataset - dsin = nc.netcdf_file(args.fnamein, 'r') + dsin = nc.Dataset(args.fnamein, 'r') # # make empty lists to hold the variable names in. the first of these is a list of sub-lists, # one for each type of variable (based on dimensionality). @@ -32,10 +33,11 @@ def main(): varnames_list_sorted = [] # # sort the variables by dimensionality, but mix the PFT x other dimension in with the regular PFT-indexed variables - dimtype_sortorder_dict = {(u'fates_history_height_bins',):0, - (u'fates_history_size_bins',):1, - (u'fates_history_age_bins',):2, - (u'fates_scalar',):3, + dimtype_sortorder_dict = { + (u'fates_history_age_bins',):0, + (u'fates_history_coage_bins',):1, + (u'fates_history_height_bins',):2, + (u'fates_history_size_bins',):3, (u'fates_pft', u'fates_string_length'):4, (u'fates_prt_organs', u'fates_string_length'):5, (u'fates_pft',):6, @@ -59,6 +61,10 @@ def main(): varnames_list[i] = sorted(varnames_list[i], key=lambda L: (L.lower(), L)) varnames_list_sorted.extend(varnames_list[i]) # + # write list of variables in ourput order + if args.debug: + print(varnames_list_sorted) + # # open the output filename, deleting it if it exists already. if os.path.isfile(args.fnameout): if args.fnameout == args.fnamein: @@ -69,12 +75,12 @@ def main(): else: raise ValueError('Output file already exists and overwrite flag not specified for filename: '+args.fnameout) # - dsout = nc.netcdf_file(args.fnameout, "w") + dsout = nc.Dataset(args.fnameout, "w") # #Copy dimensions for dname, the_dim in dsin.dimensions.iteritems(): - print dname, the_dim - dsout.createDimension(dname, the_dim ) + print dname, the_dim.size + dsout.createDimension(dname, the_dim.size ) # print # @@ -89,26 +95,14 @@ def main(): for i in range(len(varnames_list_sorted)): v_name = varnames_list_sorted[i] varin = dsin.variables[v_name] - outVar = dsout.createVariable(v_name, varin.data.dtype, varin.dimensions) + outVar = dsout.createVariable(v_name, varin.datatype, varin.dimensions) print v_name # - try: - outVar.units = varin.units - except: - print('----------no units!-----------') - try: - outVar.long_name = varin.long_name - except: - print('----------no long name!---------') - # - # copy data from input file to output file + outVar.setncatts({k: varin.getncattr(k) for k in varin.ncattrs()}) + outVar[:] = varin[:] # - try: - outVar[:] = varin[:] - except: - # handle the case where there is a scalar - outVar.assignValue(varin.data) - # + # copy global attributes + dsout.setncatts({k: dsin.getncattr(k) for k in dsin.ncattrs()})# # # close the output file dsin.close()