From 2aba6931e1c9788fe72530e13693fced0e03559f Mon Sep 17 00:00:00 2001 From: Chonggang Xu Date: Tue, 3 Jul 2018 14:50:33 -0600 Subject: [PATCH 01/52] resolve the bug of copy_cohort when hyraulic structure is not initialized put the copy_cohort after InitHydrCohort --- biogeochem/EDCanopyStructureMod.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/biogeochem/EDCanopyStructureMod.F90 b/biogeochem/EDCanopyStructureMod.F90 index 4c5985fe15..24f96edfa3 100644 --- a/biogeochem/EDCanopyStructureMod.F90 +++ b/biogeochem/EDCanopyStructureMod.F90 @@ -480,11 +480,11 @@ subroutine DemoteFromLayer(currentSite,currentPatch,i_lyr) ! remains in the upper-story. The original is the one ! demoted to the understory - allocate(copyc) - call copy_cohort(currentCohort, copyc) + allocate(copyc) if( hlm_use_planthydro.eq.itrue ) then call InitHydrCohort(currentSite,copyc) endif + call copy_cohort(currentCohort, copyc) newarea = currentCohort%c_area - cc_loss copyc%n = currentCohort%n*newarea/currentCohort%c_area @@ -807,11 +807,11 @@ subroutine PromoteIntoLayer(currentSite,currentPatch,i_lyr) elseif ( cc_gain > nearzero .and. cc_gain < currentCohort%c_area) then allocate(copyc) - call copy_cohort(currentCohort, copyc) !makes an identical copy... if( hlm_use_planthydro.eq.itrue ) then call InitHydrCohort(CurrentSite,copyc) endif - + call copy_cohort(currentCohort, copyc) !makes an identical copy... + newarea = currentCohort%c_area - cc_gain !new area of existing cohort call carea_allom(currentCohort%dbh,currentCohort%n,currentSite%spread, & From e9ddb66231c99927b08c6e9496f232c78ef12e57 Mon Sep 17 00:00:00 2001 From: Chonggang Xu Date: Fri, 24 Aug 2018 09:37:51 -0600 Subject: [PATCH 02/52] resolve a sapwood area bug for plant hydyraulics --- biogeophys/FatesPlantHydraulicsMod.F90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/biogeophys/FatesPlantHydraulicsMod.F90 b/biogeophys/FatesPlantHydraulicsMod.F90 index 98ff027ad6..c0b616f614 100644 --- a/biogeophys/FatesPlantHydraulicsMod.F90 +++ b/biogeophys/FatesPlantHydraulicsMod.F90 @@ -375,7 +375,9 @@ subroutine updateSizeDepTreeHydProps(currentSite,cc_p,bc_in) b_stem_biom = b_stem_carb * C2B ! kg DM v_stem = b_stem_biom / (EDPftvarcon_inst%wood_density(FT)*1.e3_r8) !BOC...may be needed for testing/comparison w/ v_sapwood a_leaf_tot = b_canopy_carb * sla * 1.e3_r8 / 1.e4_r8 ! m2 leaf = kg leaf DM * cm2/g * 1000g/1kg * 1m2/10000cm2 - a_sapwood = a_leaf_tot / EDPftvarcon_inst%allom_latosa_int(FT)*1.e-4_r8 ! m2 sapwood = m2 leaf * cm2 sapwood/m2 leaf *1.0e-4m2 + !a_sapwood = a_leaf_tot / EDPftvarcon_inst%allom_latosa_int(FT)*1.e-4_r8 ! m2 sapwood = m2 leaf * cm2 sapwood/m2 leaf *1.0e-4m2 + ! applying Calvo-Alvarado allometry here since using realistic sapwood area in the rest of the model causes trees to die + a_sapwood = a_leaf_tot / ( 0.001_r8 + 0.025_r8 * cCohort%hite ) * 1.e-4_r8 v_sapwood = a_sapwood * z_stem ccohort_hydr%v_ag(n_hypool_leaf+1:n_hypool_ag) = v_sapwood / n_hypool_stem From 857d8733d3d90b5b965ccf0d18750e6ff02bf53c Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Tue, 18 Sep 2018 15:19:14 -0700 Subject: [PATCH 03/52] Added parteh into FATES folder system. Functional unit tests for carbon pass. Not hooked into FATES though. --- .gitignore | 51 + .../parteh/PartehDriver.py | 707 +++++++++++ functional_unit_testing/parteh/bld/README | 1 + .../parteh/build_fortran_objects.sh | 44 + .../f_wrapper_modules/FatesCohortWrapMod.F90 | 540 ++++++++ .../f_wrapper_modules/FatesPARTEHWrapMod.F90 | 62 + .../f_wrapper_modules/FatesPFTWrapMod.F90 | 583 +++++++++ .../parteh/f_wrapper_modules/FatesWrapMod.F90 | 59 + .../parteh/parteh_controls_defaults.xml | 118 ++ .../parteh/parteh_controls_smoketests.xml | 158 +++ .../parteh/parteh_controls_variable_netc.xml | 131 ++ .../py_modules/PartehInterpretParameters.py | 153 +++ .../parteh/py_modules/PartehTypes.py | 184 +++ .../parteh/py_modules/SyntheticBoundaries.py | 127 ++ main/FatesIntegratorsMod.F90 | 197 ++- parteh/PRTAllometricCarbonMod.F90 | 983 +++++++++++++++ parteh/PRTGenericMod.F90 | 1101 +++++++++++++++++ 17 files changed, 5097 insertions(+), 102 deletions(-) create mode 100644 .gitignore create mode 100644 functional_unit_testing/parteh/PartehDriver.py create mode 100644 functional_unit_testing/parteh/bld/README create mode 100755 functional_unit_testing/parteh/build_fortran_objects.sh create mode 100644 functional_unit_testing/parteh/f_wrapper_modules/FatesCohortWrapMod.F90 create mode 100644 functional_unit_testing/parteh/f_wrapper_modules/FatesPARTEHWrapMod.F90 create mode 100644 functional_unit_testing/parteh/f_wrapper_modules/FatesPFTWrapMod.F90 create mode 100644 functional_unit_testing/parteh/f_wrapper_modules/FatesWrapMod.F90 create mode 100644 functional_unit_testing/parteh/parteh_controls_defaults.xml create mode 100644 functional_unit_testing/parteh/parteh_controls_smoketests.xml create mode 100644 functional_unit_testing/parteh/parteh_controls_variable_netc.xml create mode 100644 functional_unit_testing/parteh/py_modules/PartehInterpretParameters.py create mode 100644 functional_unit_testing/parteh/py_modules/PartehTypes.py create mode 100644 functional_unit_testing/parteh/py_modules/SyntheticBoundaries.py create mode 100644 parteh/PRTAllometricCarbonMod.F90 create mode 100644 parteh/PRTGenericMod.F90 diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000000..7ee0dc8765 --- /dev/null +++ b/.gitignore @@ -0,0 +1,51 @@ +# Compiled source # +################### +*.com +*.class +*.dll +*.exe +*.o +*.so +*.mod +*.pyc +*.pdf + +# Packages # +############ +# it's better to unpack these files and commit the raw source +# git has its own built in compression methods +*.7z +*.dmg +*.gz +*.iso +*.jar +*.rar +*.tar +*.zip +*.nc + +# Logs and databases # +###################### +*.log +*.sql +*.out +*.sqlite + +# OS generated files # +###################### +.DS_Store +.DS_Store? +._* +.Spotlight-V100 +.Trashes +ehthumbs.db +Thumbs.db + +# Latex/Tex files # +*.aux +*.dvi +*.toc + + +# Old Files +*~ \ No newline at end of file diff --git a/functional_unit_testing/parteh/PartehDriver.py b/functional_unit_testing/parteh/PartehDriver.py new file mode 100644 index 0000000000..2a96925782 --- /dev/null +++ b/functional_unit_testing/parteh/PartehDriver.py @@ -0,0 +1,707 @@ +# ======================================================================================= +# +## @package PARTEH (Plant Allocatoin and Reactive Transport Exensible Hypotheses +# +# For usage: $python PartehDriver.py --help +# +# This script is designed to run PARTEH offline (ie not coupled with an ecosystem model). +# It will interpret user input, and provide synthetic initial conditions and boundary +# conditions to the plant. +# +# Step 1) Read in User arguments +# 1a) Define simulation conditions (initial conditions,timing,parameters,etc) +# 1b) Define state variables +# 1c) Define fluxes terms (and their forms) +# 1d) Define source-sink (boundary conditions) terms +# Step 2) Cycle through flux terms, perform allocations and determine construction of Dx/Dt +# Step 3) Initialize Simulation +# Step 4) Time-step simulation +# 4a) calculate derivative +# 4b) Integrate (either internally or via numerical integration package) +# +# ======================================================================================= + +import matplotlib as mpl +#mpl.use('Agg') +import matplotlib.pyplot as plt +from datetime import datetime +#from matplotlib.backends.backend_pdf import PdfPages +import platform +import numpy as np +import os +import sys +import getopt +import code # For development: code.interact(local=locals()) +import time +import imp +import ctypes +from ctypes import * +from operator import add + +PartehInterpretParameters = imp.load_source('PartehInterpretParameters', \ + 'py_modules/PartehInterpretParameters.py') +PartehTypes = imp.load_source('PartehTypes', 'py_modules/PartehTypes.py') +SyntheticBoundaries = imp.load_source('SyntheticBoundaries','py_modules/SyntheticBoundaries.py') + +from PartehInterpretParameters import load_xml + +f90_fates_wrap_obj_name = 'bld/FatesWrapMod.o' +f90_fates_integrators_obj_name = 'bld/FatesIntegratorsMod.o' +f90_fates_partehwrap_obj_name = 'bld/FatesPARTEHWrapMod.o' +f90_fates_parteh_generic_obj_name = 'bld/PRTGenericMod.o' +f90_fates_pftwrap_obj_name = 'bld/FatesPFTWrapMod.o' +f90_fates_parteh_callom_obj_name = 'bld/PRTAllometricCarbonMod.o' +#f90_fates_parteh_cnpallom_obj_name = 'bld/PRTAllometricCNPMod.o' +f90_fates_cohortwrap_obj_name = 'bld/FatesCohortWrapMod.o' +f90_fates_allom_obj_name = 'bld/FatesAllometryMod.o' + +# ======================================================================================= +# Some Global Parmaeters + +## The name of the xml file containing site data (should not change) +xml_file = '' + + +# ======================================================================================== +# ======================================================================================== +# Main +# ======================================================================================== +# ======================================================================================== + + +def main(argv): + + # First check to make sure python 2.7 is being used + version = platform.python_version() + verlist = version.split('.') + + if( not ((verlist[0] == '2') & (verlist[1] == '7') & (int(verlist[2])>=15) ) ): + print("The PARTEH driver mus be run with python 2.7") + print(" with tertiary version >=15.") + print(" your version is {}".format(version)) + print(" exiting...") + sys.exit(2) + + + # Retrieve the name and path to the xml control file + # from the input arguments + xml_file = interp_args(argv) + + # Initialize the time structure + time_control = PartehTypes.timetype() + + # Initialize the parameter structure + parameters = PartehTypes.param_type() + + # This loads the dictionaries of, and lists of objects that + # define the variables, parameters and forms that govern the + # system of equations and solution + load_xml(xml_file,time_control,parameters) + + # ----------------------------------------------------------------------------------- + # + # We may be calling fortran, if so, we need to initialize the modules + # This includes building the library objects, calling those objects + # and possibly allocating memory in those objects. The fortran libraries + # and functions are held inside globally defined objects fates_f90_obj + # + # ----------------------------------------------------------------------------------- + + # Define the F90 objects + # These must be loaded according to the module dependency order + # Note that these calls instantiate the modules + f90_fates_wrap_obj = ctypes.CDLL(f90_fates_wrap_obj_name,mode=ctypes.RTLD_GLOBAL) + f90_fates_integrators_obj = ctypes.CDLL(f90_fates_integrators_obj_name,mode=ctypes.RTLD_GLOBAL) + f90_fates_pftwrap_obj = ctypes.CDLL(f90_fates_pftwrap_obj_name,mode=ctypes.RTLD_GLOBAL) + f90_fates_parteh_generic_obj = ctypes.CDLL(f90_fates_parteh_generic_obj_name,mode=ctypes.RTLD_GLOBAL) + f90_fates_allom_obj = ctypes.CDLL(f90_fates_allom_obj_name,mode=ctypes.RTLD_GLOBAL) + f90_fates_parteh_callom_obj = ctypes.CDLL(f90_fates_parteh_callom_obj_name,mode=ctypes.RTLD_GLOBAL) + #f90_fates_parteh_cnpallom_obj = ctypes.CDLL(f90_fates_parteh_cnpallom_obj_name,mode=ctypes.RTLD_GLOBAL) + f90_fates_partehwrap_obj = ctypes.CDLL(f90_fates_partehwrap_obj_name,mode=ctypes.RTLD_GLOBAL) + f90_fates_cohortwrap_obj = ctypes.CDLL(f90_fates_cohortwrap_obj_name,mode=ctypes.RTLD_GLOBAL) + + # Initialize the PARTEH instance + iret=f90_fates_partehwrap_obj.__fatespartehwrapmod_MOD_spmappyset() #byref(c_int(parameters.prt_model))) + + # Allocate the PFT and ORGAN arrays (leaf+root+sap+store+structure+repro = 6) + max_num_organs = 6 + iret=f90_fates_pftwrap_obj.__edpftvarcon_MOD_edpftvarconalloc(byref(c_int(parameters.num_pfts)), \ + byref(c_int(max_num_organs))) + + + + # Loop through each pft and pft's parameters and pass them to the fortran object + # Also, some parameters may be arrays (like organ number) + for pft_idx,pft_obj in enumerate(parameters.parteh_pfts): + for par_idx, par_key in enumerate(pft_obj.param_dic.iterkeys()): + pval = pft_obj.param_dic[par_key] + print("{} {} {}".format(par_idx,par_key,pval)) + + # The dictionary of parameters is populated with lists of floats, even + # scalars are single entry lists + + if( len(pval)==1 ): + iret = f90_fates_pftwrap_obj.__edpftvarcon_MOD_edpftvarconpyset(byref(c_int(pft_idx+1)), \ + byref(c_int(0)), \ + byref(c_double(pval[0])), \ + c_char_p(par_key.strip()), \ + c_long(len(par_key.strip()))) + else: + for i2d in range(len(pval)): + iret = f90_fates_pftwrap_obj.__edpftvarcon_MOD_edpftvarconpyset(byref(c_int(pft_idx+1)), \ + byref(c_int(i2d+1)), \ + byref(c_double(pval[i2d])), \ + c_char_p(par_key.strip()), \ + c_long(len(par_key.strip()))) + + # Allocate the cohort array (We create on cohort per PFT) + iret=f90_fates_cohortwrap_obj.__fatescohortwrapmod_MOD_cohortinitalloc(byref(c_int(parameters.num_pfts))) + + for pft_idx, pft_obj in enumerate(parameters.parteh_pfts): + hgt_min = pft_obj.param_dic['fates_recruit_hgt_min'] + init_canopy_trim = 1.0 + iret=f90_fates_cohortwrap_obj.__fatescohortwrapmod_MOD_cohortpyset(byref(c_int(pft_idx+1)), \ + byref(c_double(hgt_min[0])), \ + byref(c_double(init_canopy_trim))) #, \ + # byref(c_int(parameters.prt_model))) + + # Initialize diagnostics + diagnostics = [] + for pft_idx, pft_obj in enumerate(parameters.parteh_pfts): + diagnostics.append(PartehTypes.diagnostics_type()) + + + # -------------------------------------------------------------------------------- + # Time Initialization + # -------------------------------------------------------------------------------- + time_control.ResetTime() + + # -------------------------------------------------------------------------------- + # Time integration (outer) loop + # -------------------------------------------------------------------------------- + while (time_control.sim_complete != True): + + print('Simulating Date: {}'.format(time_control.datetime.item())) + + # Start the integration substep loop + endtime = time_control.datetime+np.timedelta64(int(time_control.dt_fullstep),'s') + + for pft_idx, pft_obj in enumerate(parameters.parteh_pfts): + + + # Generate the boundary condition for the current time-step + # --------------------------------------------------------------------------- + + # First lets query this pft-cohort and return a smattering of indices + leaf_area = c_double(0.0) + agb = c_double(0.0) + crown_area = c_double(0.0) + dbh = c_double(0.0) + leaf_c = c_double(0.0) + fnrt_c = c_double(0.0) + sapw_c = c_double(0.0) + store_c = c_double(0.0) + struct_c = c_double(0.0) + repro_c = c_double(0.0) + root_c_exudate = c_double(0.0) + growth_resp = c_double(0.0) + leaf_cturn = c_double(0.0) + fnrt_cturn = c_double(0.0) + sapw_cturn = c_double(0.0) + store_cturn = c_double(0.0) + struct_cturn = c_double(0.0) + + leaf_n = c_double(0.0) + fnrt_n = c_double(0.0) + sapw_n = c_double(0.0) + store_n = c_double(0.0) + struct_n = c_double(0.0) + repro_n = c_double(0.0) + root_n_exudate = c_double(0.0) + leaf_nturn = c_double(0.0) + fnrt_nturn = c_double(0.0) + sapw_nturn = c_double(0.0) + store_nturn = c_double(0.0) + struct_nturn = c_double(0.0) + + leaf_p = c_double(0.0) + fnrt_p = c_double(0.0) + sapw_p = c_double(0.0) + store_p = c_double(0.0) + struct_p = c_double(0.0) + repro_p = c_double(0.0) + root_p_exudate = c_double(0.0) + leaf_pturn = c_double(0.0) + fnrt_pturn = c_double(0.0) + sapw_pturn = c_double(0.0) + store_pturn = c_double(0.0) + struct_pturn = c_double(0.0) + + iret=f90_fates_cohortwrap_obj.__fatescohortwrapmod_MOD_wrapqueryvars(byref(c_int(pft_idx+1)), \ + byref(leaf_area), \ + byref(crown_area), \ + byref(agb), \ + byref(store_c)) + + # if(parameters.boundary_method=="DailyCFromUnitGPPAR"): + # net_daily_c = SyntheticBoundaries.DailyCFromUnitGPPAR(leaf_area.value,agb.value) + + if(parameters.boundary_method=="DailyCFromCArea"): + + presc_npp_p1 = parameters.boundary_pfts[pft_idx].param_dic['fates_prescribed_npp_p1'] + + net_daily_c = SyntheticBoundaries.DailyCFromCArea(presc_npp_p1, \ + crown_area.value) + net_daily_n = 0.0 + net_daily_p = 0.0 + r_maint_demand = 0.0 + + + elif(parameters.boundary_method=="DailyCNPFromCArea"): + + presc_npp_p1 = parameters.boundary_pfts[pft_idx].param_dic['fates_prescribed_npp_p1'] + presc_nflux_p1 = parameters.boundary_pfts[pft_idx].param_dic['fates_prescribed_nflux_p1'] + presc_pflux_p1 = parameters.boundary_pfts[pft_idx].param_dic['fates_prescribed_pflux_p1'] + + net_daily_c, net_daily_n, net_daily_p = SyntheticBoundaries.DailyCNPFromCArea(presc_npp_p1, \ + presc_nflux_p1, \ + presc_pflux_p1, \ + crown_area.value) + r_maint_demand = 0.0 + + + elif(parameters.boundary_method=="DailyCNPFromStorageSinWaveNoMaint"): + + presc_npp_amp = parameters.boundary_pfts[pft_idx].param_dic['fates_prescribed_npp_amp'] + presc_npp_p1 = parameters.boundary_pfts[pft_idx].param_dic['fates_prescribed_npp_p1'] + presc_nflux_p1 = parameters.boundary_pfts[pft_idx].param_dic['fates_prescribed_nflux_p1'] + presc_pflux_p1 = parameters.boundary_pfts[pft_idx].param_dic['fates_prescribed_pflux_p1'] + + + doy = time_control.datetime.astype(object).timetuple().tm_yday + + net_daily_c, net_daily_n, net_daily_p = SyntheticBoundaries.DailyCNPFromStorageSinWave(doy,\ + store_c.value,\ + presc_npp_p1, \ + presc_nflux_p1, \ + presc_pflux_p1, \ + crown_area.value, \ + presc_npp_amp ) + r_maint_demand = 0.0 + + else: + print("An unknown boundary method was specified\n") + print("type: {} ? ... quitting.".format(parameters.boundary_method)) + exit() + + + # This function will pass in all boundary conditions, some will be dummy arguments + init_canopy_trim = 1.0 + iret=f90_fates_cohortwrap_obj.__fatescohortwrapmod_MOD_wrapdailyprt(byref(c_int(pft_idx+1)), \ + byref(c_double(net_daily_c)), \ + byref(c_double(net_daily_n)), \ + byref(c_double(net_daily_p)), \ + byref(c_double(init_canopy_trim)), \ + byref(c_double(r_maint_demand))) + + + # This function will retrieve diagnostics + iret=f90_fates_cohortwrap_obj.__fatescohortwrapmod_MOD_wrapquerydiagnostics(byref(c_int(pft_idx+1)), \ + byref(dbh), \ + byref(leaf_c), \ + byref(fnrt_c), \ + byref(sapw_c), \ + byref(store_c), \ + byref(struct_c), \ + byref(repro_c), \ + byref(leaf_cturn), \ + byref(fnrt_cturn), \ + byref(sapw_cturn), \ + byref(store_cturn), \ + byref(struct_cturn), \ + byref(leaf_n), \ + byref(fnrt_n), \ + byref(sapw_n), \ + byref(store_n), \ + byref(struct_n), \ + byref(repro_n), \ + byref(leaf_nturn), \ + byref(fnrt_nturn), \ + byref(sapw_nturn), \ + byref(store_nturn), \ + byref(struct_nturn), \ + byref(leaf_p), \ + byref(fnrt_p), \ + byref(sapw_p), \ + byref(store_p), \ + byref(struct_p), \ + byref(repro_p), \ + byref(leaf_pturn), \ + byref(fnrt_pturn), \ + byref(sapw_pturn), \ + byref(store_pturn), \ + byref(struct_pturn), \ + byref(crown_area), \ + byref(root_c_exudate), \ + byref(root_n_exudate), \ + byref(root_p_exudate), \ + byref(growth_resp)) + + + diagnostics[pft_idx].dates.append(time_control.datetime.astype(datetime)) + diagnostics[pft_idx].dbh.append(dbh.value) + diagnostics[pft_idx].leaf_c.append(leaf_c.value) + diagnostics[pft_idx].fnrt_c.append(fnrt_c.value) + diagnostics[pft_idx].sapw_c.append(sapw_c.value) + diagnostics[pft_idx].store_c.append(store_c.value) + diagnostics[pft_idx].struct_c.append(struct_c.value) + diagnostics[pft_idx].repro_c.append(repro_c.value) + diagnostics[pft_idx].leaf_cturn.append(leaf_cturn.value) + diagnostics[pft_idx].fnrt_cturn.append(fnrt_cturn.value) + diagnostics[pft_idx].sapw_cturn.append(sapw_cturn.value) + diagnostics[pft_idx].store_cturn.append(store_cturn.value) + diagnostics[pft_idx].struct_cturn.append(struct_cturn.value) + diagnostics[pft_idx].dailyc.append(net_daily_c) + diagnostics[pft_idx].crown_area.append(crown_area.value) + + diagnostics[pft_idx].growth_resp.append(growth_resp.value) + + diagnostics[pft_idx].leaf_n.append(leaf_n.value) + diagnostics[pft_idx].fnrt_n.append(fnrt_n.value) + diagnostics[pft_idx].sapw_n.append(sapw_n.value) + diagnostics[pft_idx].store_n.append(store_n.value) + diagnostics[pft_idx].struct_n.append(struct_n.value) + diagnostics[pft_idx].repro_n.append(repro_n.value) + diagnostics[pft_idx].leaf_nturn.append(leaf_nturn.value) + diagnostics[pft_idx].fnrt_nturn.append(fnrt_nturn.value) + diagnostics[pft_idx].sapw_nturn.append(sapw_nturn.value) + diagnostics[pft_idx].store_nturn.append(store_nturn.value) + diagnostics[pft_idx].struct_nturn.append(struct_nturn.value) + + diagnostics[pft_idx].leaf_p.append(leaf_p.value) + diagnostics[pft_idx].fnrt_p.append(fnrt_p.value) + diagnostics[pft_idx].sapw_p.append(sapw_p.value) + diagnostics[pft_idx].store_p.append(store_p.value) + diagnostics[pft_idx].struct_p.append(struct_p.value) + diagnostics[pft_idx].repro_p.append(repro_p.value) + diagnostics[pft_idx].leaf_pturn.append(leaf_pturn.value) + diagnostics[pft_idx].fnrt_pturn.append(fnrt_pturn.value) + diagnostics[pft_idx].sapw_pturn.append(sapw_pturn.value) + diagnostics[pft_idx].store_pturn.append(store_pturn.value) + diagnostics[pft_idx].struct_pturn.append(struct_pturn.value) + + diagnostics[pft_idx].root_c_exudate.append(root_c_exudate.value) + diagnostics[pft_idx].root_n_exudate.append(root_n_exudate.value) + diagnostics[pft_idx].root_p_exudate.append(root_p_exudate.value) + + + # We don't have a fancy time integrator so we simply update with + # a full step + + time_control.UpdateTime() + + # --------------------------------------------------------------------------- + # Timestep complete, check the time + # --------------------------------------------------------------------------- + # time_control.CheckFullStepTime(endtime) + + +# fig0, ax = plt.subplots() +# for ipft in range(parameters.num_pfts): +# ax.plot_date(diagnostics[0].dates,diagnostics[0].dbh) +# ax.set_xlim(diagnostics[0].dates[0],diagnostics[0].dates[-1]) + +# plt.show() +# code.interact(local=locals()) + + + linestyles = ['-','-.','--','-',':','-.','--',':','-','-.','--',':' ] + + + + + fig1, ((ax1, ax2, ax3, ax4), (ax5, ax6, ax7, ax8)) = plt.subplots(2, 4 , sharex='col') #, sharey='row') + fig1.set_size_inches(12, 6) + for ipft in range(parameters.num_pfts): + ax1.plot_date(diagnostics[ipft].dates,diagnostics[ipft].struct_c,linestyles[ipft],label=parameters.parteh_pfts[ipft].name) + ax1.set_title('Structural\n Carbon') + ax1.legend(loc='upper left') + ax1.set_ylabel('[kg C]') + ax1.grid(True) + + for ipft in range(parameters.num_pfts): + ax2.plot_date(diagnostics[ipft].dates,diagnostics[ipft].leaf_c,linestyles[ipft]) + ax2.set_title('Leaf\n Carbon') + ax2.grid(True) + + for ipft in range(parameters.num_pfts): + ax3.plot_date(diagnostics[ipft].dates,diagnostics[ipft].fnrt_c,linestyles[ipft]) + ax3.set_title('Fineroot\n Carbon') + ax3.grid(True) + + for ipft in range(parameters.num_pfts): + ax4.plot_date(diagnostics[ipft].dates,diagnostics[ipft].sapw_c,linestyles[ipft]) + ax4.set_title('Sapwood\n Carbon') + ax4.set_ylabel('[kg C]') + ax4.grid(True) + + for ipft in range(parameters.num_pfts): + ax5.plot_date(diagnostics[ipft].dates,diagnostics[ipft].store_c,linestyles[ipft]) + ax5.set_title('Storage\n Carbon') + ax5.set_xlabel('Year') + ax5.grid(True) + + for ipft in range(parameters.num_pfts): + ax6.plot_date(diagnostics[ipft].dates,diagnostics[ipft].repro_c,linestyles[ipft]) + ax6.set_title('Integrated\n Reproductive\n Carbon') + ax6.set_xlabel('Year') + ax6.grid(True) + + for ipft in range(parameters.num_pfts): + ax7.plot_date(diagnostics[ipft].dates,np.cumsum(diagnostics[ipft].root_c_exudate),linestyles[ipft]) + ax7.set_title('Integrated\n Exudated\n Carbon') + ax7.set_xlabel('Year') + ax7.grid(True) + + for ipft in range(parameters.num_pfts): + ax8.plot_date(diagnostics[ipft].dates,np.cumsum(diagnostics[ipft].growth_resp),linestyles[ipft]) + ax8.set_title('Integrated\n Growth\n Respiration') + ax8.set_xlabel('Year') + ax8.grid(True) + + + + + + plt.tight_layout() + + # Plant proportions + # --------------------------------------------------------------------------------- + fig2, ( (ax1,ax2),(ax3,ax4) ) = plt.subplots(2,2) + fig2.set_size_inches(7, 6) + for ipft in range(parameters.num_pfts): + ax1.plot_date(diagnostics[ipft].dates,diagnostics[ipft].dbh,linestyles[ipft],label=parameters.parteh_pfts[ipft].name) + ax1.set_xlabel('Date') + ax1.set_title('DBH [cm]') + ax1.legend(loc='upper left') + ax1.grid(True) + + for ipft in range(parameters.num_pfts): + ax2.plot_date(diagnostics[ipft].dates,diagnostics[ipft].crown_area,linestyles[ipft]) + ax2.set_xlabel('Date') + ax2.set_title('Crown Area [m2]') + ax2.grid(True) + + for ipft in range(parameters.num_pfts): + ax3.plot(diagnostics[ipft].dbh,1000.0*np.array(diagnostics[ipft].dailyc)) + + ax3.set_xlabel('DBH [cm]') + ax3.set_title('Daily Carbon Gain [g]') + ax3.grid(True) + + for ipft in range(parameters.num_pfts): + ax4.plot(diagnostics[ipft].dbh,diagnostics[ipft].crown_area) + ax4.set_xlabel('DBH [cm]') + ax4.set_title('Crown Area [m2]') + ax4.grid(True) + + + + + + + + plt.tight_layout() + + + # Error (bias) + # --------------------------------------------------------------------------------- + + fig4 = plt.figure() + for ipft in range(parameters.num_pfts): + + total_plant_carbon0 = np.array(diagnostics[ipft].struct_c[0]) + \ + np.array(diagnostics[ipft].leaf_c[0]) + \ + np.array(diagnostics[ipft].fnrt_c[0]) + \ + np.array(diagnostics[ipft].sapw_c[0]) + \ + np.array(diagnostics[ipft].store_c[0]) + \ + np.array(diagnostics[ipft].repro_c[0]) + + total_plant_carbon = np.array(diagnostics[ipft].struct_c) + \ + np.array(diagnostics[ipft].leaf_c) + \ + np.array(diagnostics[ipft].fnrt_c) + \ + np.array(diagnostics[ipft].sapw_c) + \ + np.array(diagnostics[ipft].store_c) + \ + np.array(diagnostics[ipft].repro_c) + + integrated_plant_turnover = np.cumsum(diagnostics[ipft].struct_cturn) + \ + np.cumsum(diagnostics[ipft].leaf_cturn) + \ + np.cumsum(diagnostics[ipft].fnrt_cturn) + \ + np.cumsum(diagnostics[ipft].sapw_cturn) + \ + np.cumsum(diagnostics[ipft].store_cturn) + + + plt.plot(np.cumsum(diagnostics[ipft].dailyc), \ + (np.cumsum(diagnostics[ipft].dailyc) - \ + (total_plant_carbon + \ + integrated_plant_turnover - \ + total_plant_carbon0 ) ) / total_plant_carbon ) + + plt.xlabel('Integrated Daily Carbon Gain [kg]') + plt.ylabel('Integrated Bias [kg]') + plt.grid(True) + + # Plot out the input fluxes + + fig5= plt.figure() + for ipft in range(parameters.num_pfts): + plt.plot_date(diagnostics[ipft].dates,diagnostics[ipft].dailyc,linestyles[ipft],label=parameters.parteh_pfts[ipft].name) + + plt.xlabel('Date') + plt.ylabel('Daily Carbon Flux') + plt.grid(True) + plt.legend(loc='upper left') + + + # Special Focus plots for a PFT of interest + + figs = {} + for ipft in range(parameters.num_pfts): + figs[ipft], (ax1, ax2, ax3) = plt.subplots(1, 3) + + figs[ipft].set_size_inches(8, 4) + ax1.stackplot(np.cumsum(diagnostics[ipft].dailyc), \ + np.array(diagnostics[ipft].struct_c)+np.cumsum(diagnostics[ipft].struct_cturn), \ + np.array(diagnostics[ipft].leaf_c)+np.cumsum(diagnostics[ipft].leaf_cturn), \ + np.array(diagnostics[ipft].fnrt_c)+np.cumsum(diagnostics[ipft].fnrt_cturn), \ + np.array(diagnostics[ipft].sapw_c)+np.cumsum(diagnostics[ipft].sapw_cturn), \ + np.array(diagnostics[ipft].store_c)+np.cumsum(diagnostics[ipft].store_cturn), \ + np.array(diagnostics[ipft].repro_c), \ + labels = ["Struct","Leaf","FRoot","Sapw","Storage","Repro"]) + ax1.set_title('Allocated Mass \nby Pool [kg]') + ax1.grid(True) + + ax2.stackplot(np.cumsum(diagnostics[ipft].dailyc), \ + np.cumsum(diagnostics[ipft].struct_cturn), \ + np.cumsum(diagnostics[ipft].leaf_cturn), \ + np.cumsum(diagnostics[ipft].fnrt_cturn), \ + np.cumsum(diagnostics[ipft].sapw_cturn), \ + np.cumsum(diagnostics[ipft].store_cturn), \ + np.array(diagnostics[ipft].repro_c), \ + labels = ["Struct","Leaf","FRoot","Sapw","Storage","Repro"] ) + ax2.legend(loc=2) + ax2.grid(True) + ax2.set_xlabel('Integrated Daily\n Carbon Gain [kg]') + ax2.set_title('Integrated Turnover\n by Pool [kg]') + + + #code.interact(local=locals()) + npp_leaf = np.array(diagnostics[ipft].leaf_c[1:]) - \ + np.array(diagnostics[ipft].leaf_c[0:-1]) + \ + np.array(diagnostics[ipft].leaf_cturn[1:]) + npp_fnrt = np.array(diagnostics[ipft].fnrt_c[1:]) - \ + np.array(diagnostics[ipft].fnrt_c[0:-1]) + \ + np.array(diagnostics[ipft].fnrt_cturn[1:]) + npp_sapw = np.array(diagnostics[ipft].sapw_c[1:]) - \ + np.array(diagnostics[ipft].sapw_c[0:-1]) + \ + np.array(diagnostics[ipft].sapw_cturn[1:]) + npp_store = np.array(diagnostics[ipft].store_c[1:]) - \ + np.array(diagnostics[ipft].store_c[0:-1]) + \ + np.array(diagnostics[ipft].store_cturn[1:]) + npp_struct = np.array(diagnostics[ipft].struct_c[1:]) - \ + np.array(diagnostics[ipft].struct_c[0:-1]) + \ + np.array(diagnostics[ipft].struct_cturn[1:]) + npp_repro = np.array(diagnostics[ipft].repro_c[1:]) - \ + np.array(diagnostics[ipft].repro_c[0:-1]) + + ax3.stackplot(np.cumsum(diagnostics[ipft].dailyc[1:]), \ + npp_struct, npp_leaf, npp_fnrt, npp_sapw, npp_store, npp_repro) + + ax3.grid(True) + ax3.set_title('Daily NPP \nby Pool [kg]') + + plt.figtext(0.1,0.05,"PFT: {}".format(ipft+1),bbox={'facecolor':'red', 'alpha':0.5, 'pad':10}, fontsize=15) + + + plt.tight_layout() + + + plt.show() + + print('\nSimulation Complete \nThank You Come Again') + #exit(0) + + + +# ======================================================================================= + + + +def usage(): + print('') + print('=======================================================================') + print('') + print(' python PartehDriver.py --help --xmlfile=') + print('') + print(' This is a driver script for PARTEH') + print(' (Plant Allocation and Reactive Transport Extensible Hypotheses)') + print(' Only 1 option is currently relevent, and that is a path to the ') + print(' XML file that controls this simulation. ') + print('') + print(' Arguments:') + print('') + print(' -h --help ') + print(' print this help message') + print('') + print(' --xmlfile = ') + print(' the relative or full file path to the xml file that controls') + print(' this simulation.') + print('') + +def interp_args(argv): + + argv.pop(0) # The script itself is the first argument, forget it + + ## File path to the xml control card + xmlfile = '' + + try: + opts, args = getopt.getopt(argv, 'h',["help","xmlfile="]) + + except getopt.GetoptError as err: + print('Argument error, see usage') + usage() + sys.exit(2) + + + if(len(opts)==0): + print('\n\n') + print('No arguments were specified') + print('Exiting, see Usage below') + print('\n\n') + usage() + sys.exit(0) + + for o, a in opts: + if o in ("-h", "--help"): + usage() + sys.exit(0) + elif o in ("--xmlfile"): + xmlfile = a.strip() + if(not os.path.isfile(xmlfile)): + print('\n\n') + print('The XML control file could not be found') + print(' via argument --xmlfile') + print(' xmlfile = ',xmlfile) + print('\n\n') + usage() + sys.exit(0) + else: + assert False, "unhandled option" + + return(xmlfile) +# ======================================================================================= +# This is the actual call to main + +if __name__ == "__main__": + main(sys.argv) diff --git a/functional_unit_testing/parteh/bld/README b/functional_unit_testing/parteh/bld/README new file mode 100644 index 0000000000..044ed8e494 --- /dev/null +++ b/functional_unit_testing/parteh/bld/README @@ -0,0 +1 @@ +shared object fortran modules are compiled and placed in this directory \ No newline at end of file diff --git a/functional_unit_testing/parteh/build_fortran_objects.sh b/functional_unit_testing/parteh/build_fortran_objects.sh new file mode 100755 index 0000000000..27cd07c65b --- /dev/null +++ b/functional_unit_testing/parteh/build_fortran_objects.sh @@ -0,0 +1,44 @@ +#!/bin/bash + +# Path to FATES src + +FATES_SRC=../../ + +F_OPTS="-shared -fPIC -g -ffpe-trap=zero,overflow,underflow -fbacktrace -fbounds-check" + +MOD_FLAG="-J" + +rm -f bld/*.o +rm -f bld/*.mod + +gfortran $F_OPTS $MOD_FLAG bld/ -o bld/FatesConstants.o ${FATES_SRC}/main/FatesConstantsMod.F90 + +# Generic Integration routines (all native types except defined constants) +gfortran $F_OPTS $MOD_FLAG bld/ -I bld/ -o bld/FatesIntegratorsMod.o ${FATES_SRC}/main/FatesIntegratorsMod.F90 + +# Support Modules, fairly trivial contents +gfortran $F_OPTS $MOD_FLAG bld/ -I bld/ -o bld/FatesWrapMod.o f_wrapper_modules/FatesWrapMod.F90 + +# This defines and fills the global pft parameter structures (stripped down from fates version) +gfortran $F_OPTS $MOD_FLAG bld/ -I bld/ -o bld/FatesPFTWrapMod.o f_wrapper_modules/FatesPFTWrapMod.F90 + +# Allometry Module, take this from FATES directly +gfortran $F_OPTS $MOD_FLAG bld/ -I bld/ -o bld/FatesAllometryMod.o ${FATES_SRC}/biogeochem/FatesAllometryMod.F90 + +# The Generic (parent) PARTEH module +gfortran $F_OPTS $MOD_FLAG bld/ -I bld/ -o bld/PRTGenericMod.o ${FATES_SRC}/parteh/PRTGenericMod.F90 + +# The carbon-only PARTEH module +gfortran $F_OPTS $MOD_FLAG bld/ -I bld/ -o bld/PRTAllometricCarbonMod.o ${FATES_SRC}/parteh/PRTAllometricCarbonMod.F90 + +# The CNP allometric target model +#gfortran $F_OPTS $MOD_FLAG bld/ -I bld/ -o FModules/PRTAllometricCNPMod.o FModules/PRTAllometricCNPMod.F90 + +# Initialize PARTEH instance and mapping functions +gfortran $F_OPTS $MOD_FLAG bld/ -I bld/ bld/PRTGenericMod.o bld/PRTAllometricCarbonMod.o -o bld/FatesPARTEHWrapMod.o f_wrapper_modules/FatesPARTEHWrapMod.F90 + +# The cohort instances and initialization +gfortran $F_OPTS $MOD_FLAG bld/ -I bld/ -o bld/FatesCohortWrapMod.o f_wrapper_modules/FatesCohortWrapMod.F90 + + + diff --git a/functional_unit_testing/parteh/f_wrapper_modules/FatesCohortWrapMod.F90 b/functional_unit_testing/parteh/f_wrapper_modules/FatesCohortWrapMod.F90 new file mode 100644 index 0000000000..1bcb5acee5 --- /dev/null +++ b/functional_unit_testing/parteh/f_wrapper_modules/FatesCohortWrapMod.F90 @@ -0,0 +1,540 @@ +! ======================================================================================= +! +! This is the wrapper module that provides FATES data structures +! +! ======================================================================================= + +module FatesCohortWrapMod + + use iso_c_binding, only : r8 => c_double + use iso_c_binding, only : i4 => c_int + use iso_c_binding, only : c_char + use FatesAllometryMod, only : bleaf + use FatesAllometryMod, only : bfineroot + use FatesAllometryMod, only : bsap_allom + use FatesAllometryMod, only : bagw_allom + use FatesAllometryMod, only : bbgw_allom + use FatesAllometryMod, only : bdead_allom + use FatesAllometryMod, only : bstore_allom + use FatesAllometryMod, only : h2d_allom + use FatesAllometryMod, only : tree_lai + use FatesAllometryMod, only : carea_allom + + use EDPftvarcon, only : EDPftvarcon_inst + + use PRTGenericMod, only : InitPRTVartype + use PRTGenericMod, only : prt_vartypes + use PRTGenericMod, only : leaf_organ + use PRTGenericMod, only : all_carbon_species + use PRTGenericMod, only : carbon12_species + use PRTGenericMod, only : nitrogen_species + use PRTGenericMod, only : phosphorous_species + use PRTGenericMod, only : leaf_organ + use PRTGenericMod, only : fnrt_organ + use PRTGenericMod, only : sapw_organ + use PRTGenericMod, only : store_organ + use PRTGenericMod, only : repro_organ + use PRTGenericMod, only : struct_organ + use PRTGenericMod, only : carbon12_species + use PRTGenericMod, only : SetState + + use PRTAllometricCarbonMod, only : callom_prt_vartypes + use PRTAllometricCarbonMod, only : ac_bc_inout_id_netdc + use PRTAllometricCarbonMod, only : ac_bc_in_id_pft + use PRTAllometricCarbonMod, only : ac_bc_in_id_ctrim + use PRTAllometricCarbonMod, only : ac_bc_inout_id_dbh + +! use PRTAllometricCNPMod, only : cnp_allom_prt_vartypes +! use PRTAllometricCNPMod, only : acnp_bc_inout_id_dbh +! use PRTAllometricCNPMod, only : acnp_bc_inout_id_netdc +! use PRTAllometricCNPMod, only : acnp_bc_inout_id_rmaint_def +! use PRTAllometricCNPMod, only : acnp_bc_inout_id_netdn +! use PRTAllometricCNPMod, only : acnp_bc_inout_id_netdp + +! use PRTAllometricCNPMod, only : acnp_bc_in_id_ctrim +! use PRTAllometricCNPMod, only : acnp_bc_in_id_pft + +! use PRTAllometricCNPMod, only : acnp_bc_out_id_rootcexude +! use PRTAllometricCNPMod, only : acnp_bc_out_id_rootnexude +! use PRTAllometricCNPMod, only : acnp_bc_out_id_rootpexude +! use PRTAllometricCNPMod, only : acnp_bc_out_id_growresp + + + use FatesConstantsMod , only : nearzero + + use EDTypesMod , only : nclmax + + use FatesGlobals , only : endrun => fates_endrun + use FatesGlobals , only : fates_log + use shr_log_mod , only : errMsg => shr_log_errMsg + + + + implicit none + + + type ed_cohort_type + + integer :: pft ! pft number + integer :: parteh_model ! The PARTEH allocation hypothesis used + real(r8) :: dbh ! dbh: cm + + real(r8) :: canopy_trim ! Trimming function for the canopy + + real(r8) :: dhdt ! time derivative of height : m/year + real(r8) :: ddbhdt ! time derivative of dbh : cm/year + + real(r8) :: daily_carbon_gain ! + real(r8) :: daily_nitrogen_gain ! + real(r8) :: daily_phosphorous_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 ! + + + ! Multi-species, multi-pool Reactive Transport + class(prt_vartypes), pointer :: prt + + end type ed_cohort_type + + ! Global Instances + + type(ed_cohort_type), pointer :: cohort_array(:) + integer :: numcohort + + character(len=*), parameter, private :: sourcefile = __FILE__ + +contains + + subroutine CohortInitAlloc(numcohorts) + + ! Arguments + integer(i4), intent(in) :: numcohorts + + ! Locals + integer(i4) :: ico + type(ed_cohort_type), pointer :: ccohort + + + allocate(cohort_array(numcohorts)) + + do ico = 1,numcohorts + ccohort => cohort_array(ico) + ccohort%parteh_model = -1 + ccohort%pft = -9 + ccohort%dbh = -999.9_r8 + ccohort%canopy_trim = -999.9_r8 + ccohort%dhdt = -999.9_r8 + 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_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 + end do + + return + end subroutine CohortInitAlloc + + ! ===================================================================================== + + subroutine CohortPySet(ipft,hgt_min,canopy_trim) + + implicit none + ! Arguments + integer(i4),intent(in) :: ipft + real(r8),intent(in) :: hgt_min + real(r8),intent(in) :: canopy_trim + + ! Locals + + type(ed_cohort_type), pointer :: ccohort ! Current cohort + real(r8) :: leaf_c + real(r8) :: fnrt_c + real(r8) :: sapw_c + real(r8) :: agw_c + real(r8) :: bgw_c + real(r8) :: struct_c + real(r8) :: repro_c + real(r8) :: store_c + + real(r8) :: sapw_area ! dummy area cross-sec + + real(r8) :: leaf_n + real(r8) :: fnrt_n + real(r8) :: sapw_n + real(r8) :: struct_n + real(r8) :: repro_n + real(r8) :: store_n + real(r8) :: leaf_p + real(r8) :: fnrt_p + real(r8) :: sapw_p + real(r8) :: struct_p + real(r8) :: repro_p + real(r8) :: store_p + + + class(callom_prt_vartypes), pointer :: callom_prt +! class(cnp_allom_prt_vartypes), pointer :: cnpallom_prt + + + ccohort => cohort_array(ipft) + + + ccohort%pft = int(ipft) + ccohort%parteh_model = int(EDPftvarcon_inst%parteh_model(ipft)) + + call h2d_allom(hgt_min,ipft,ccohort%dbh) + ccohort%canopy_trim = canopy_trim + + + ! Use allometry to compute initial values + + ! Leaf biomass (carbon) + call bleaf(ccohort%dbh, ipft, canopy_trim, leaf_c) + + ! Fine-root biomass (carbon) + call bfineroot(ccohort%dbh, ipft, canopy_trim, fnrt_c) + + ! Sapwood biomass (carbon) + call bsap_allom(ccohort%dbh, ipft, canopy_trim, sapw_area, sapw_c) + + ! Above ground woody biomass (carbon) + call bagw_allom(ccohort%dbh, ipft, agw_c) + + ! Below ground woody biomass (carbon) + call bbgw_allom(ccohort%dbh, ipft, bgw_c) + + ! Total structural biomass (carbon) + call bdead_allom(agw_c, bgw_c, sapw_c, ipft, struct_c) + + ! Target storage carbon [kgC,kgC/cm] + call bstore_allom(ccohort%dbh, ipft, canopy_trim, store_c) + + repro_c = 0.0_r8 + + + select case(ccohort%parteh_model) + case (1) + + allocate(callom_prt) + ccohort%prt => callom_prt + +! case(2) + +! allocate(cnpallom_prt) +! ccohort%prt => cnpallom_prt + + case DEFAULT + write(fates_log(),*) 'You specified an unknown PRT module' + write(fates_log(),*) 'Aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end select + + call ccohort%prt%InitPRTVartype() + + select case(ccohort%parteh_model) + case (1) + + call SetState(ccohort%prt,leaf_organ, carbon12_species, leaf_c) + call SetState(ccohort%prt,fnrt_organ, carbon12_species, fnrt_c) + call SetState(ccohort%prt,sapw_organ, carbon12_species, sapw_c) + call SetState(ccohort%prt,store_organ, carbon12_species, store_c) + call SetState(ccohort%prt,struct_organ , carbon12_species, struct_c) + call SetState(ccohort%prt,repro_organ , carbon12_species, repro_c) + + call ccohort%prt%RegisterBCInOut(ac_bc_inout_id_dbh,bc_rval = ccohort%dbh) + call ccohort%prt%RegisterBCInOut(ac_bc_inout_id_netdc,bc_rval = ccohort%daily_carbon_gain) + + call ccohort%prt%RegisterBCIn(ac_bc_in_id_pft,bc_ival = ccohort%pft) + call ccohort%prt%RegisterBCIn(ac_bc_in_id_ctrim,bc_rval = ccohort%canopy_trim) + +! case (2) + + ! Initializing with the target stoichiometric ratios + ! (OR you can initialize with the minimum ratios too.... p2) + !leaf_n = leaf_c * EDPftvarcon_inst%parteh_n_stoich_p1(ipft,leaf_organ) + !fnrt_n = fnrt_c * EDPftvarcon_inst%parteh_n_stoich_p1(ipft,fnrt_organ) + !sapw_n = sapw_c * EDPftvarcon_inst%parteh_n_stoich_p1(ipft,sapw_organ) + !store_n = store_c * EDPftvarcon_inst%parteh_n_stoich_p1(ipft,store_organ) + !struct_n = struct_c * EDPftvarcon_inst%parteh_n_stoich_p1(ipft,struct_organ) + !repro_n = repro_c * EDPftvarcon_inst%parteh_n_stoich_p1(ipft,repro_organ) + + !leaf_p = leaf_c * EDPftvarcon_inst%parteh_p_stoich_p1(ipft,leaf_organ) + !fnrt_p = fnrt_c * EDPftvarcon_inst%parteh_p_stoich_p1(ipft,fnrt_organ) + !sapw_p = sapw_c * EDPftvarcon_inst%parteh_p_stoich_p1(ipft,sapw_organ) + !store_p = store_c * EDPftvarcon_inst%parteh_p_stoich_p1(ipft,store_organ) + !struct_p = struct_c * EDPftvarcon_inst%parteh_p_stoich_p1(ipft,struct_organ) + !repro_p = repro_c * EDPftvarcon_inst%parteh_p_stoich_p1(ipft,repro_organ) + + !ccohort%accum_r_maint_deficit = 0.0_r8 + + !call SetState(ccohort%prt,leaf_organ, carbon12_species, leaf_c) + !call SetState(ccohort%prt,fnrt_organ, carbon12_species, fnrt_c) + !call SetState(ccohort%prt,sapw_organ, carbon12_species, sapw_c) + !call SetState(ccohort%prt,store_organ, carbon12_species, store_c) + !call SetState(ccohort%prt,struct_organ , carbon12_species, struct_c) + !call SetState(ccohort%prt,repro_organ , carbon12_species, repro_c) + + !call SetState(ccohort%prt,leaf_organ, nitrogen_species, leaf_n) + !call SetState(ccohort%prt,fnrt_organ, nitrogen_species, fnrt_n) + !call SetState(ccohort%prt,sapw_organ, nitrogen_species, sapw_n) + !call SetState(ccohort%prt,store_organ, nitrogen_species, store_n) + !call SetState(ccohort%prt,struct_organ , nitrogen_species, struct_n) + !call SetState(ccohort%prt,repro_organ , nitrogen_species, repro_n) + + !call SetState(ccohort%prt,leaf_organ, phosphorous_species, leaf_p) + !call SetState(ccohort%prt,fnrt_organ, phosphorous_species, fnrt_p) + !call SetState(ccohort%prt,sapw_organ, phosphorous_species, sapw_p) + !call SetState(ccohort%prt,store_organ, phosphorous_species, store_p) + !call SetState(ccohort%prt,struct_organ , phosphorous_species, struct_p) + !call SetState(ccohort%prt,repro_organ , phosphorous_species, 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_rmaint_def, bc_rval = ccohort%accum_r_maint_deficit) + + ! Register Input only BC's + !call ccohort%prt%RegisterBCIn(acnp_bc_in_id_pft,bc_ival = ccohort%pft) + !call ccohort%prt%RegisterBCIn(acnp_bc_in_id_ctrim,bc_rval = ccohort%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_growresp,bc_rval = ccohort%daily_r_grow ) + + + end select + + call ccohort%prt%CheckInitialConditions() + + + end subroutine CohortPySet + + ! ===================================================================================== + + subroutine WrapDailyPRT(ipft,daily_carbon_gain,daily_nitrogen_gain, & + daily_phosphorous_gain,canopy_trim,daily_r_maint_demand) + + implicit none + ! Arguments + integer(i4),intent(in) :: ipft + real(r8),intent(in) :: daily_carbon_gain + real(r8),intent(in) :: canopy_trim + real(r8), intent(in), optional :: daily_nitrogen_gain + real(r8), intent(in), optional :: daily_phosphorous_gain + real(r8), intent(in), optional :: daily_r_maint_demand + + type(ed_cohort_type), pointer :: ccohort + + + ccohort => cohort_array(ipft) + + ! Zero the rate of change and the turnover arrays + + call ccohort%prt%ZeroRates() + + + select case(int(ccohort%parteh_model)) + case (1) + + ccohort%daily_carbon_gain = daily_carbon_gain + + call ccohort%prt%DailyPRT() + + ccohort%daily_r_grow = 0.0_r8 + ccohort%carbon_root_exudate = 0.0_r8 + + case (2) + + ccohort%daily_carbon_gain = daily_carbon_gain + ccohort%daily_nitrogen_gain = daily_nitrogen_gain + ccohort%daily_phosphorous_gain = daily_phosphorous_gain + ccohort%accum_r_maint_deficit = ccohort%accum_r_maint_deficit + & + daily_r_maint_demand + + call ccohort%prt%DailyPRT() + + + case DEFAULT + write(fates_log(),*) 'You specified an unknown PRT module' + write(fates_log(),*) 'Aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end select + + + + + return + end subroutine WrapDailyPRT + + ! ===================================================================================== + + subroutine WrapQueryVars(ipft,leaf_area,crown_area,agb,store_c) + + implicit none + ! Arguments + integer(i4),intent(in) :: ipft + real(r8),intent(out) :: leaf_area + real(r8),intent(out) :: crown_area + real(r8),intent(out) :: agb + real(r8),intent(out) :: store_c + + real(r8) :: leaf_c + type(ed_cohort_type), pointer :: ccohort + + real(r8),parameter :: nplant = 1.0_r8 + real(r8),parameter :: site_spread = 1.0_r8 + integer, parameter :: status_coh = 2 + real(r8), parameter, dimension(nclmax) :: canopy_lai = [0.0_r8,0.0_r8,0.0_r8,0.0_r8] + integer, parameter :: cl1 = 1 + + ccohort => cohort_array(ipft) + + leaf_c = ccohort%prt%GetState(leaf_organ, all_carbon_species ) + store_c = ccohort%prt%GetState(store_organ, all_carbon_species ) + + call carea_allom(ccohort%dbh,nplant,site_spread,ipft,crown_area) + + leaf_area = crown_area*tree_lai(leaf_c, ipft, crown_area, nplant, cl1, canopy_lai) + + call bagw_allom(ccohort%dbh,ipft,agb) + + + return + end subroutine WrapQueryVars + + + subroutine WrapQueryDiagnostics(ipft, dbh, & + leaf_c, fnrt_c, sapw_c, store_c, struct_c, repro_c, & + leaf_cturn, fnrt_cturn, sapw_cturn, store_cturn, struct_cturn, & + leaf_n, fnrt_n, sapw_n, store_n, struct_n, repro_n, & + leaf_nturn, fnrt_nturn, sapw_nturn, store_nturn, struct_nturn, & + 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, & + growth_resp ) + + implicit none + ! Arguments + integer(i4),intent(in) :: ipft + real(r8),intent(out) :: dbh + + real(r8),intent(out) :: leaf_c + real(r8),intent(out) :: fnrt_c + real(r8),intent(out) :: sapw_c + real(r8),intent(out) :: store_c + real(r8),intent(out) :: struct_c + real(r8),intent(out) :: repro_c + real(r8),intent(out) :: leaf_cturn + real(r8),intent(out) :: fnrt_cturn + real(r8),intent(out) :: sapw_cturn + real(r8),intent(out) :: store_cturn + real(r8),intent(out) :: struct_cturn + + real(r8),intent(out) :: leaf_n + real(r8),intent(out) :: fnrt_n + real(r8),intent(out) :: sapw_n + real(r8),intent(out) :: store_n + real(r8),intent(out) :: struct_n + real(r8),intent(out) :: repro_n + real(r8),intent(out) :: leaf_nturn + real(r8),intent(out) :: fnrt_nturn + real(r8),intent(out) :: sapw_nturn + real(r8),intent(out) :: store_nturn + real(r8),intent(out) :: struct_nturn + + real(r8),intent(out) :: leaf_p + real(r8),intent(out) :: fnrt_p + real(r8),intent(out) :: sapw_p + real(r8),intent(out) :: store_p + real(r8),intent(out) :: struct_p + real(r8),intent(out) :: repro_p + real(r8),intent(out) :: leaf_pturn + real(r8),intent(out) :: fnrt_pturn + real(r8),intent(out) :: sapw_pturn + real(r8),intent(out) :: store_pturn + real(r8),intent(out) :: struct_pturn + + + 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) :: growth_resp + + real(r8),intent(out) :: crown_area + type(ed_cohort_type), pointer :: ccohort + real(r8),parameter :: nplant = 1.0_r8 + real(r8),parameter :: site_spread = 1.0_r8 + + ccohort => cohort_array(ipft) + dbh = ccohort%dbh + + leaf_c = ccohort%prt%GetState(organ_id=leaf_organ, species_id=all_carbon_species) + fnrt_c = ccohort%prt%GetState(organ_id=fnrt_organ, species_id=all_carbon_species) + sapw_c = ccohort%prt%GetState(organ_id=sapw_organ, species_id=all_carbon_species) + store_c = ccohort%prt%GetState(organ_id=store_organ, species_id=all_carbon_species) + struct_c = ccohort%prt%GetState(organ_id=struct_organ, species_id=all_carbon_species) + repro_c = ccohort%prt%GetState(organ_id=repro_organ, species_id=all_carbon_species) + + leaf_cturn = ccohort%prt%GetTurnover(organ_id=leaf_organ, species_id=all_carbon_species) + fnrt_cturn = ccohort%prt%GetTurnover(organ_id=fnrt_organ, species_id=all_carbon_species) + sapw_cturn = ccohort%prt%GetTurnover(organ_id=sapw_organ, species_id=all_carbon_species) + store_cturn = ccohort%prt%GetTurnover(organ_id=store_organ, species_id=all_carbon_species) + struct_cturn = ccohort%prt%GetTurnover(organ_id=struct_organ, species_id=all_carbon_species) + + leaf_n = ccohort%prt%GetState(organ_id=leaf_organ, species_id=nitrogen_species) + fnrt_n = ccohort%prt%GetState(organ_id=fnrt_organ, species_id=nitrogen_species) + sapw_n = ccohort%prt%GetState(organ_id=sapw_organ, species_id=nitrogen_species) + store_n = ccohort%prt%GetState(organ_id=store_organ, species_id=nitrogen_species) + struct_n = ccohort%prt%GetState(organ_id=struct_organ, species_id=nitrogen_species) + repro_n = ccohort%prt%GetState(organ_id=repro_organ, species_id=nitrogen_species) + + leaf_nturn = ccohort%prt%GetTurnover(organ_id=leaf_organ, species_id=nitrogen_species) + fnrt_nturn = ccohort%prt%GetTurnover(organ_id=fnrt_organ, species_id=nitrogen_species) + sapw_nturn = ccohort%prt%GetTurnover(organ_id=sapw_organ, species_id=nitrogen_species) + store_nturn = ccohort%prt%GetTurnover(organ_id=store_organ, species_id=nitrogen_species) + struct_nturn = ccohort%prt%GetTurnover(organ_id=struct_organ, species_id=nitrogen_species) + + leaf_p = ccohort%prt%GetState(organ_id=leaf_organ, species_id=phosphorous_species) + fnrt_p = ccohort%prt%GetState(organ_id=fnrt_organ, species_id=phosphorous_species) + sapw_p = ccohort%prt%GetState(organ_id=sapw_organ, species_id=phosphorous_species) + store_p = ccohort%prt%GetState(organ_id=store_organ, species_id=phosphorous_species) + struct_p = ccohort%prt%GetState(organ_id=struct_organ, species_id=phosphorous_species) + repro_p = ccohort%prt%GetState(organ_id=repro_organ, species_id=phosphorous_species) + + leaf_pturn = ccohort%prt%GetTurnover(organ_id=leaf_organ, species_id=phosphorous_species) + fnrt_pturn = ccohort%prt%GetTurnover(organ_id=fnrt_organ, species_id=phosphorous_species) + sapw_pturn = ccohort%prt%GetTurnover(organ_id=sapw_organ, species_id=phosphorous_species) + store_pturn = ccohort%prt%GetTurnover(organ_id=store_organ, species_id=phosphorous_species) + struct_pturn = ccohort%prt%GetTurnover(organ_id=struct_organ, species_id=phosphorous_species) + + growth_resp = ccohort%daily_r_grow + + call carea_allom(ccohort%dbh,nplant,site_spread,ipft,crown_area) + + carbon_root_exudate = ccohort%carbon_root_exudate + nitrogen_root_exudate = ccohort%nitrogen_root_exudate + phosphorous_root_exudate = ccohort%phosphorous_root_exudate + + return + end subroutine WrapQueryDiagnostics + + + + +end module FatesCohortWrapMod diff --git a/functional_unit_testing/parteh/f_wrapper_modules/FatesPARTEHWrapMod.F90 b/functional_unit_testing/parteh/f_wrapper_modules/FatesPARTEHWrapMod.F90 new file mode 100644 index 0000000000..2e14f18959 --- /dev/null +++ b/functional_unit_testing/parteh/f_wrapper_modules/FatesPARTEHWrapMod.F90 @@ -0,0 +1,62 @@ +! ======================================================================================= +! +! This is the wrapper module that provides callable functions +! so that PARTEH fortran data structures can be intsantiated from python +! Half of the instantiation will occur by binding inherited data structures +! to cohorts, but the other half is the creation of a mapping table, +! of which we have only 1 per instance. That happens here. +! +! Note: In FATES, the equivalent routine would probably live in FatesInterfaceMod.F90 +! +! ======================================================================================= + +module FatesPARTEHWrapMod + + use PRTAllometricCarbonMod, only : InitPRTInstanceAC + !! use PRTAllometricCNPMod, only : InitPRTInstanceACNP + use FatesGlobals , only : endrun => fates_endrun + use FatesGlobals , only : fates_log + use shr_log_mod , only : errMsg => shr_log_errMsg + use iso_c_binding, only : r8 => c_double + use iso_c_binding, only : i4 => c_int + use iso_c_binding, only : c_char + + implicit none + + character(len=*), parameter, private :: sourcefile = __FILE__ + +contains + + + subroutine SPMapPyset() !prt_mode) + + + ! Update... Instantiate all of them? + +! integer(i4), intent(in) :: prt_mode + +! select case(int(prt_mode)) +! case (1) + + call InitPRTInstanceAC() + +! case(2) + +!! call InitPRTInstanceACNP() + +! case DEFAULT +! write(fates_log(),*) 'You specified an unknown PRT module' +! write(fates_log(),*) 'Aborting' +! call endrun(msg=errMsg(sourcefile, __LINE__)) + + +! end select + + end subroutine SPMapPyset + + + + + + +end module FatesPARTEHWrapMod diff --git a/functional_unit_testing/parteh/f_wrapper_modules/FatesPFTWrapMod.F90 b/functional_unit_testing/parteh/f_wrapper_modules/FatesPFTWrapMod.F90 new file mode 100644 index 0000000000..03b1b54613 --- /dev/null +++ b/functional_unit_testing/parteh/f_wrapper_modules/FatesPFTWrapMod.F90 @@ -0,0 +1,583 @@ +! ======================================================================================= +! +! This is the wrapper module that provides FATES data structures +! +! ======================================================================================= + +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 + + real(r8), pointer :: parteh_model(:) ! The PARTEH model to use + + real(r8), pointer :: prescribed_npp_canopy(:) ! this is only for the special + ! prescribed_physiology_mode + real(r8), pointer :: prescribed_npp_understory(:) ! this is only for the special + ! prescribed_physiology_mode + real(r8), pointer :: seed_alloc(:) + real(r8), pointer :: seed_alloc_mature(:) + real(r8), pointer :: dbh_repro_threshold(:) + real(r8), pointer :: evergreen(:) + real(r8), pointer :: woody(:) + real(r8), pointer :: hgt_min(:) + real(r8), pointer :: allom_hmode(:) + real(r8), pointer :: allom_amode(:) + real(r8), pointer :: allom_lmode(:) + real(r8), pointer :: allom_smode(:) + real(r8), pointer :: allom_stmode(:) + real(r8), pointer :: allom_cmode(:) + real(r8), pointer :: allom_fmode(:) + real(r8), pointer :: allom_d2h1(:) + real(r8), pointer :: allom_d2h2(:) + real(r8), pointer :: allom_d2h3(:) + real(r8), pointer :: allom_dbh_maxheight(:) + real(r8), pointer :: allom_agb1(:) + real(r8), pointer :: allom_agb2(:) + real(r8), pointer :: allom_agb3(:) + real(r8), pointer :: allom_agb4(:) + real(r8), pointer :: allom_d2bl1(:) + real(r8), pointer :: allom_d2bl2(:) + real(r8), pointer :: allom_d2bl3(:) + real(r8), pointer :: wood_density(:) + real(r8), pointer :: cushion(:) + real(r8), pointer :: c2b(:) + real(r8), pointer :: vcmax25top(:) + !real(r8), pointer :: allom_la_per_sa_int(:) + !real(r8), pointer :: allom_la_per_sa_slp(:) + real(r8), pointer :: allom_latosa_int(:) + real(r8), pointer :: allom_latosa_slp(:) + real(r8), pointer :: slatop(:) + real(r8), pointer :: slamax(:) + real(r8), pointer :: allom_l2fr(:) + real(r8), pointer :: allom_agb_frac(:) + real(r8), pointer :: allom_blca_expnt_diff(:) + real(r8), pointer :: allom_d2ca_coefficient_min(:) + real(r8), pointer :: allom_d2ca_coefficient_max(:) + real(r8), pointer :: allom_sai_scaler(:) + real(r8), pointer :: branch_turnover(:) + real(r8), pointer :: leaf_long(:) + real(r8), pointer :: root_long(:) + real(r8), pointer :: leaf_stor_priority(:) + real(r8), pointer :: roota_par(:) + real(r8), pointer :: rootb_par(:) + real(r8), pointer :: rootprof_beta(:,:) + + + + ! This array matches organ indices in the parameter file + ! with global indices in PRTGeneric. The basic global + ! indices are leaf = 1 + ! fine-root = 2 + ! sapwood = 3 + ! storage = 4 + ! reproduction = 5 + ! structural = 6 + ! But, its possible that some organs may be added in + ! the future, and then all hypotheses will not use the same + ! set, or some hypotheses will sub-divide. + + ! These arrays hold the stoichiometric parameters + ! The arrays are dimensioned by PFT X ORGAN + ! Different formulations may use these parameters differently + + ! Hypothesis 1: Unused [na] + + + real(r8), pointer :: parteh_unit_gr_resp(:,:) + real(r8), pointer :: parteh_n_stoich_p1(:,:) + real(r8), pointer :: parteh_n_stoich_p2(:,:) + real(r8), pointer :: parteh_p_stoich_p1(:,:) + real(r8), pointer :: parteh_p_stoich_p2(:,:) + real(r8), pointer :: parteh_c_alloc_priority(:,:) + + ! THese are new, but not necessarily PARTEH labeled + real(r8), pointer :: turnover_retrans_mode(:) + real(r8), pointer :: turnover_retrans_leaf_n_p1(:) + real(r8), pointer :: turnover_retrans_leaf_p_p1(:) + real(r8), pointer :: turnover_retrans_fnrt_n_p1(:) + real(r8), pointer :: turnover_retrans_fnrt_p_p1(:) + + + end type EDPftvarcon_inst_type + + type 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(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 + + +contains + + + subroutine EDPftvarconPySet(ipft,i2d,rval,name) + + implicit none + ! Arguments + integer(i4),intent(in) :: ipft + integer(i4),intent(in) :: i2d ! Second dimension index + ! if this is >0, use it + character(kind=c_char,len=*), intent(in) :: name + real(r8),intent(in) :: rval + + ! Locals + logical :: npfound + integer :: ip + integer :: namelen + + namelen = len(trim(name)) + + ip=0 + npfound = .false. + do ip=1,numparm + if (trim(name) == trim(EDPftvarcon_ptr%var(ip)%var_name ) ) then + if(i2d==0) then + EDPftvarcon_ptr%var(ip)%rp_1d(ipft) = rval + else + EDPftvarcon_ptr%var(ip)%rp_2d(ipft,i2d) = rval + end if + npfound = .true. + end if + end do + + if(.not.npfound)then + print*,"Could not find parameter passed in from python driver" + print*,"registerred in the fortran wrapper" + print*,"--",trim(name),"--" + stop + end if + + ! Performa a check to see if the target array is being filled + + if (trim(name) == 'fates_wood_density' ) then + if (EDPftvarcon_inst%wood_density(ipft) .ne. rval) then + print*,"F90: POINTER CHECK FAILS:",rval," != ",EDPftvarcon_inst%wood_density(ipft) + stop + end if + end if + + return + end subroutine EDPftvarconPySet + + ! ==================================================================================== + + subroutine EDPftvarconAlloc(numpft_in, numorgans_in) + + ! !ARGUMENTS: + integer(i4), intent(in) :: numpft_in + integer(i4), intent(in) :: numorgans_in + + ! LOCALS: + integer :: iv ! The parameter incrementer + integer, parameter :: n_beta_dims = 1 + !------------------------------------------------------------------------ + + num_pft = numpft_in + num_organs = numorgans_in + + allocate( EDPftvarcon_ptr%var (100) ) ! Make this plenty large + + iv=0 + + allocate( EDPftvarcon_inst%parteh_model(1:num_pft)); + EDPftvarcon_inst%parteh_model (:) = nan + iv = iv + 1 + EDPftvarcon_ptr%var(iv)%var_name = "parteh_model" + EDPftvarcon_ptr%var(iv)%rp_1d => EDPftvarcon_inst%parteh_model + + + allocate( EDPftvarcon_inst%dbh_repro_threshold(1:num_pft)); + EDPftvarcon_inst%dbh_repro_threshold (:) = nan + iv = iv + 1 + EDPftvarcon_ptr%var(iv)%var_name = "fates_dbh_repro_threshold" + EDPftvarcon_ptr%var(iv)%rp_1d => EDPftvarcon_inst%dbh_repro_threshold + + + allocate( EDPftvarcon_inst%prescribed_npp_canopy(1:num_pft)); + EDPftvarcon_inst%prescribed_npp_canopy (:) = nan + iv = iv + 1 + EDPftvarcon_ptr%var(iv)%var_name = "fates_prescribed_npp_canopy" + EDPftvarcon_ptr%var(iv)%rp_1d => EDPftvarcon_inst%prescribed_npp_canopy + + allocate( EDPftvarcon_inst%prescribed_npp_understory(1:num_pft)); + EDPftvarcon_inst%prescribed_npp_understory (:) = nan + iv = iv + 1 + EDPftvarcon_ptr%var(iv)%var_name = "fates_prescribed_npp_understory" + EDPftvarcon_ptr%var(iv)%rp_1d => EDPftvarcon_inst%prescribed_npp_understory + + allocate( EDPftvarcon_inst%seed_alloc(1:num_pft)); + EDPftvarcon_inst%seed_alloc (:) = nan + iv = iv + 1 + EDPftvarcon_ptr%var(iv)%var_name = "fates_seed_alloc" + EDPftvarcon_ptr%var(iv)%rp_1d => EDPftvarcon_inst%seed_alloc + + + allocate( EDPftvarcon_inst%seed_alloc_mature(1:num_pft)); + EDPftvarcon_inst%seed_alloc_mature(:) = nan + iv = iv + 1 + EDPftvarcon_ptr%var(iv)%var_name = "fates_seed_alloc_mature" + EDPftvarcon_ptr%var(iv)%rp_1d => EDPftvarcon_inst%seed_alloc_mature + + allocate( EDPftvarcon_inst%evergreen(1:num_pft)); + EDPftvarcon_inst%evergreen (:) = nan + iv = iv + 1 + EDPftvarcon_ptr%var(iv)%var_name = "fates_phen_evergreen" + EDPftvarcon_ptr%var(iv)%rp_1d => EDPftvarcon_inst%evergreen + + allocate( EDPftvarcon_inst%woody(1:num_pft)); + EDPftvarcon_inst%woody (:) = nan + iv = iv + 1 + EDPftvarcon_ptr%var(iv)%var_name = "fates_woody" + EDPftvarcon_ptr%var(iv)%rp_1d => EDPftvarcon_inst%woody + + allocate( EDPftvarcon_inst%hgt_min(1:num_pft)); + EDPftvarcon_inst%hgt_min (:) = nan + iv = iv + 1 + EDPftvarcon_ptr%var(iv)%var_name = "fates_recruit_hgt_min" + EDPftvarcon_ptr%var(iv)%rp_1d => EDPftvarcon_inst%hgt_min + + allocate( EDPftvarcon_inst%allom_dbh_maxheight(1:num_pft)); + EDPftvarcon_inst%allom_dbh_maxheight (:) = nan + iv = iv + 1 + EDPftvarcon_ptr%var(iv)%var_name = "fates_allom_dbh_maxheight" + EDPftvarcon_ptr%var(iv)%rp_1d => EDPftvarcon_inst%allom_dbh_maxheight + + allocate( EDPftvarcon_inst%allom_hmode(1:num_pft)); + EDPftvarcon_inst%allom_hmode(:) = nan + iv = iv + 1 + EDPftvarcon_ptr%var(iv)%var_name = "fates_allom_hmode" + EDPftvarcon_ptr%var(iv)%rp_1d => EDPftvarcon_inst%allom_hmode + + allocate( EDPftvarcon_inst%allom_amode(1:num_pft)); + EDPftvarcon_inst%allom_amode(:) = nan + iv = iv + 1 + EDPftvarcon_ptr%var(iv)%var_name = "fates_allom_amode" + EDPftvarcon_ptr%var(iv)%rp_1d => EDPftvarcon_inst%allom_amode + + allocate( EDPftvarcon_inst%allom_lmode(1:num_pft)); + EDPftvarcon_inst%allom_lmode(:) = nan + iv = iv + 1 + EDPftvarcon_ptr%var(iv)%var_name = "fates_allom_lmode" + EDPftvarcon_ptr%var(iv)%rp_1d => EDPftvarcon_inst%allom_lmode + + allocate( EDPftvarcon_inst%allom_smode(1:num_pft)); + EDPftvarcon_inst%allom_smode(:) = nan + iv = iv + 1 + EDPftvarcon_ptr%var(iv)%var_name = "fates_allom_smode" + EDPftvarcon_ptr%var(iv)%rp_1d => EDPftvarcon_inst%allom_smode + + allocate( EDPftvarcon_inst%allom_stmode(1:num_pft)); + EDPftvarcon_inst%allom_stmode(:) = nan + iv = iv + 1 + EDPftvarcon_ptr%var(iv)%var_name = "fates_allom_stmode" + EDPftvarcon_ptr%var(iv)%rp_1d => EDPftvarcon_inst%allom_stmode + + allocate( EDPftvarcon_inst%allom_cmode(1:num_pft)); + EDPftvarcon_inst%allom_cmode(:) = nan + iv = iv + 1 + EDPftvarcon_ptr%var(iv)%var_name = "fates_allom_cmode" + EDPftvarcon_ptr%var(iv)%rp_1d => EDPftvarcon_inst%allom_cmode + + allocate( EDPftvarcon_inst%allom_fmode(1:num_pft)); + EDPftvarcon_inst%allom_fmode(:) = nan + iv = iv + 1 + EDPftvarcon_ptr%var(iv)%var_name = "fates_allom_fmode" + EDPftvarcon_ptr%var(iv)%rp_1d => EDPftvarcon_inst%allom_fmode + + allocate( EDPftvarcon_inst%allom_d2h1(1:num_pft)); + EDPftvarcon_inst%allom_d2h1(:) = nan + iv = iv + 1 + EDPftvarcon_ptr%var(iv)%var_name = "fates_allom_d2h1" + EDPftvarcon_ptr%var(iv)%rp_1d => EDPftvarcon_inst%allom_d2h1 + + allocate( EDPftvarcon_inst%allom_d2h2(1:num_pft)); + EDPftvarcon_inst%allom_d2h2(:) = nan + iv = iv + 1 + EDPftvarcon_ptr%var(iv)%var_name = "fates_allom_d2h2" + EDPftvarcon_ptr%var(iv)%rp_1d => EDPftvarcon_inst%allom_d2h2 + + allocate( EDPftvarcon_inst%allom_d2h3(1:num_pft)); + EDPftvarcon_inst%allom_d2h3(:) = nan + iv = iv + 1 + EDPftvarcon_ptr%var(iv)%var_name = "fates_allom_d2h3" + EDPftvarcon_ptr%var(iv)%rp_1d => EDPftvarcon_inst%allom_d2h3 + + allocate( EDPftvarcon_inst%allom_agb1(1:num_pft)); + EDPftvarcon_inst%allom_agb1(:) = nan + iv = iv + 1 + EDPftvarcon_ptr%var(iv)%var_name = "fates_allom_agb1" + EDPftvarcon_ptr%var(iv)%rp_1d => EDPftvarcon_inst%allom_agb1 + + allocate( EDPftvarcon_inst%allom_agb2(1:num_pft)); + EDPftvarcon_inst%allom_agb2(:) = nan + iv = iv + 1 + EDPftvarcon_ptr%var(iv)%var_name = "fates_allom_agb2" + EDPftvarcon_ptr%var(iv)%rp_1d => EDPftvarcon_inst%allom_agb2 + + allocate( EDPftvarcon_inst%allom_agb3(1:num_pft)); + EDPftvarcon_inst%allom_agb3(:) = nan + iv = iv + 1 + EDPftvarcon_ptr%var(iv)%var_name = "fates_allom_agb3" + EDPftvarcon_ptr%var(iv)%rp_1d => EDPftvarcon_inst%allom_agb3 + + allocate( EDPftvarcon_inst%allom_agb4(1:num_pft)); + EDPftvarcon_inst%allom_agb4(:) = nan + iv = iv + 1 + EDPftvarcon_ptr%var(iv)%var_name = "fates_allom_agb4" + EDPftvarcon_ptr%var(iv)%rp_1d => EDPftvarcon_inst%allom_agb4 + + allocate( EDPftvarcon_inst%allom_d2bl1(1:num_pft)); + EDPftvarcon_inst%allom_d2bl1(:) = nan + iv = iv + 1 + EDPftvarcon_ptr%var(iv)%var_name = "fates_allom_d2bl1" + EDPftvarcon_ptr%var(iv)%rp_1d => EDPftvarcon_inst%allom_d2bl1 + + allocate( EDPftvarcon_inst%allom_d2bl2(1:num_pft)); + EDPftvarcon_inst%allom_d2bl2(:) = nan + iv = iv + 1 + EDPftvarcon_ptr%var(iv)%var_name = "fates_allom_d2bl2" + EDPftvarcon_ptr%var(iv)%rp_1d => EDPftvarcon_inst%allom_d2bl2 + + allocate( EDPftvarcon_inst%allom_d2bl3(1:num_pft)); + EDPftvarcon_inst%allom_d2bl3(:) = nan + iv = iv + 1 + EDPftvarcon_ptr%var(iv)%var_name = "fates_allom_d2bl3" + EDPftvarcon_ptr%var(iv)%rp_1d => EDPftvarcon_inst%allom_d2bl3 + + allocate( EDPftvarcon_inst%cushion(1:num_pft)); + EDPftvarcon_inst%cushion(:) = nan + iv = iv + 1 + EDPftvarcon_ptr%var(iv)%var_name = "fates_cushion" + EDPftvarcon_ptr%var(iv)%rp_1d => EDPftvarcon_inst%cushion + + allocate( EDPftvarcon_inst%wood_density(1:num_pft)); + EDPftvarcon_inst%wood_density(:) = nan + iv = iv + 1 + EDPftvarcon_ptr%var(iv)%var_name = "fates_wood_density" + EDPftvarcon_ptr%var(iv)%rp_1d => EDPftvarcon_inst%wood_density + + allocate( EDPftvarcon_inst%c2b(1:num_pft)); + EDPftvarcon_inst%c2b(:) = nan + iv = iv + 1 + EDPftvarcon_ptr%var(iv)%var_name = "fates_c2b" + EDPftvarcon_ptr%var(iv)%rp_1d => EDPftvarcon_inst%c2b + + allocate( EDPftvarcon_inst%vcmax25top(1:num_pft)); + EDPftvarcon_inst%vcmax25top(:) = nan + iv = iv + 1 + EDPftvarcon_ptr%var(iv)%var_name = "fates_vcmax25top" + EDPftvarcon_ptr%var(iv)%rp_1d => EDPftvarcon_inst%vcmax25top + +! allocate( EDPftvarcon_inst%allom_la_per_sa_int(1:num_pft)); +! EDPftvarcon_inst%allom_la_per_sa_int(:) = nan +! iv = iv + 1 +! EDPftvarcon_ptr%var(iv)%var_name = "fates_allom_la_per_sa_int" +! EDPftvarcon_ptr%var(iv)%rp_1d => EDPftvarcon_inst%allom_la_per_sa_int + +! allocate( EDPftvarcon_inst%allom_la_per_sa_slp(1:num_pft)); +! EDPftvarcon_inst%allom_la_per_sa_slp(:) = nan +! iv = iv + 1 +! EDPftvarcon_ptr%var(iv)%var_name = "fates_allom_la_per_sa_slp" +! EDPftvarcon_ptr%var(iv)%rp_1d => EDPftvarcon_inst%allom_la_per_sa_slp + + allocate( EDPftvarcon_inst%allom_latosa_int(1:num_pft)); + EDPftvarcon_inst%allom_latosa_int(:) = nan + iv = iv + 1 + EDPftvarcon_ptr%var(iv)%var_name = "fates_allom_latosa_int" + EDPftvarcon_ptr%var(iv)%rp_1d => EDPftvarcon_inst%allom_latosa_int + + allocate( EDPftvarcon_inst%allom_latosa_slp(1:num_pft)); + EDPftvarcon_inst%allom_latosa_slp(:) = nan + iv = iv + 1 + EDPftvarcon_ptr%var(iv)%var_name = "fates_allom_latosa_slp" + EDPftvarcon_ptr%var(iv)%rp_1d => EDPftvarcon_inst%allom_latosa_slp + + allocate( EDPftvarcon_inst%slatop(1:num_pft)); + EDPftvarcon_inst%slatop(:) = nan + iv = iv + 1 + EDPftvarcon_ptr%var(iv)%var_name = "fates_slatop" + EDPftvarcon_ptr%var(iv)%rp_1d => EDPftvarcon_inst%slatop + + allocate( EDPftvarcon_inst%slamax(1:num_pft)); + EDPftvarcon_inst%slamax(:) = nan + iv = iv + 1 + EDPftvarcon_ptr%var(iv)%var_name = "fates_slamax" + EDPftvarcon_ptr%var(iv)%rp_1d => EDPftvarcon_inst%slamax + + + allocate( EDPftvarcon_inst%allom_l2fr(1:num_pft)); + EDPftvarcon_inst%allom_l2fr(:) = nan + iv = iv + 1 + EDPftvarcon_ptr%var(iv)%var_name = "fates_allom_l2fr" + EDPftvarcon_ptr%var(iv)%rp_1d => EDPftvarcon_inst%allom_l2fr + + allocate( EDPftvarcon_inst%allom_agb_frac(1:num_pft)); + EDPftvarcon_inst%allom_agb_frac(:) = nan + iv = iv + 1 + EDPftvarcon_ptr%var(iv)%var_name = "fates_allom_agb_frac" + EDPftvarcon_ptr%var(iv)%rp_1d => EDPftvarcon_inst%allom_agb_frac + + allocate( EDPftvarcon_inst%allom_sai_scaler(1:num_pft)); + EDPftvarcon_inst%allom_sai_scaler(:) = nan + iv = iv + 1 + EDPftvarcon_ptr%var(iv)%var_name = "fates_allom_sai_scaler" + EDPftvarcon_ptr%var(iv)%rp_1d => EDPftvarcon_inst%allom_sai_scaler + + allocate( EDPftvarcon_inst%allom_blca_expnt_diff(1:num_pft)); + EDPftvarcon_inst%allom_blca_expnt_diff(:) = nan + iv = iv + 1 + EDPftvarcon_ptr%var(iv)%var_name = "fates_allom_blca_expnt_diff" + EDPftvarcon_ptr%var(iv)%rp_1d => EDPftvarcon_inst%allom_blca_expnt_diff + + allocate( EDPftvarcon_inst%allom_d2ca_coefficient_min(1:num_pft)); + EDPftvarcon_inst%allom_d2ca_coefficient_min(:) = nan + iv = iv + 1 + EDPftvarcon_ptr%var(iv)%var_name = "fates_allom_d2ca_coefficient_min" + EDPftvarcon_ptr%var(iv)%rp_1d => EDPftvarcon_inst%allom_d2ca_coefficient_min + + allocate( EDPftvarcon_inst%allom_d2ca_coefficient_max(1:num_pft)); + EDPftvarcon_inst%allom_d2ca_coefficient_max(:) = nan + iv = iv + 1 + EDPftvarcon_ptr%var(iv)%var_name = "fates_allom_d2ca_coefficient_max" + EDPftvarcon_ptr%var(iv)%rp_1d => EDPftvarcon_inst%allom_d2ca_coefficient_max + + allocate( EDPftvarcon_inst%branch_turnover(1:num_pft)); + EDPftvarcon_inst%branch_turnover(:) = nan + iv = iv + 1 + EDPftvarcon_ptr%var(iv)%var_name = "fates_branch_turnover" + EDPftvarcon_ptr%var(iv)%rp_1d => EDPftvarcon_inst%branch_turnover + + allocate( EDPftvarcon_inst%leaf_long(1:num_pft)); + EDPftvarcon_inst%leaf_long(:) = nan + iv = iv + 1 + EDPftvarcon_ptr%var(iv)%var_name = "fates_leaf_long" + EDPftvarcon_ptr%var(iv)%rp_1d => EDPftvarcon_inst%leaf_long + + allocate( EDPftvarcon_inst%root_long(1:num_pft)); + EDPftvarcon_inst%root_long(:) = nan + iv = iv + 1 + EDPftvarcon_ptr%var(iv)%var_name = "fates_root_long" + EDPftvarcon_ptr%var(iv)%rp_1d => EDPftvarcon_inst%root_long + + allocate( EDPftvarcon_inst%leaf_stor_priority(1:num_pft)); + EDPftvarcon_inst%leaf_stor_priority(:) = nan + iv = iv + 1 + EDPftvarcon_ptr%var(iv)%var_name = "fates_leaf_stor_priority" + EDPftvarcon_ptr%var(iv)%rp_1d => EDPftvarcon_inst%leaf_stor_priority + + allocate( EDPftvarcon_inst%roota_par(1:num_pft)); + EDPftvarcon_inst%roota_par(:) = nan + iv = iv + 1 + EDPftvarcon_ptr%var(iv)%var_name = "fates_roota_par" + EDPftvarcon_ptr%var(iv)%rp_1d => EDPftvarcon_inst%roota_par + + allocate( EDPftvarcon_inst%rootb_par(1:num_pft)); + EDPftvarcon_inst%rootb_par(:) = nan + iv = iv + 1 + EDPftvarcon_ptr%var(iv)%var_name = "fates_rootb_par" + EDPftvarcon_ptr%var(iv)%rp_1d => EDPftvarcon_inst%rootb_par + + + allocate( EDPftvarcon_inst%parteh_n_stoich_p1(1:num_pft,1:num_organs)); + EDPftvarcon_inst%parteh_n_stoich_p1(:,:) = nan + iv = iv + 1 + EDPftvarcon_ptr%var(iv)%var_name = "fates_parteh_n_stoich_p1" + EDPftvarcon_ptr%var(iv)%rp_2d => EDPftvarcon_inst%parteh_n_stoich_p1 + + + allocate( EDPftvarcon_inst%parteh_p_stoich_p1(1:num_pft,1:num_organs)); + EDPftvarcon_inst%parteh_p_stoich_p1(:,:) = nan + iv = iv + 1 + EDPftvarcon_ptr%var(iv)%var_name = "fates_parteh_p_stoich_p1" + EDPftvarcon_ptr%var(iv)%rp_2d => EDPftvarcon_inst%parteh_p_stoich_p1 + + + allocate( EDPftvarcon_inst%parteh_n_stoich_p2(1:num_pft,1:num_organs)); + EDPftvarcon_inst%parteh_n_stoich_p2(:,:) = nan + iv = iv + 1 + EDPftvarcon_ptr%var(iv)%var_name = "fates_parteh_n_stoich_p2" + EDPftvarcon_ptr%var(iv)%rp_2d => EDPftvarcon_inst%parteh_n_stoich_p2 + + + allocate( EDPftvarcon_inst%parteh_p_stoich_p2(1:num_pft,1:num_organs)); + EDPftvarcon_inst%parteh_p_stoich_p2(:,:) = nan + iv = iv + 1 + EDPftvarcon_ptr%var(iv)%var_name = "fates_parteh_p_stoich_p2" + EDPftvarcon_ptr%var(iv)%rp_2d => EDPftvarcon_inst%parteh_p_stoich_p2 + + + allocate( EDPftvarcon_inst%parteh_unit_gr_resp(1:num_pft,1:num_organs)); + EDPftvarcon_inst%parteh_unit_gr_resp(:,:) = nan + iv = iv + 1 + EDPftvarcon_ptr%var(iv)%var_name = "fates_parteh_unit_gr_resp" + EDPftvarcon_ptr%var(iv)%rp_2d => EDPftvarcon_inst%parteh_unit_gr_resp + + + allocate( EDPftvarcon_inst%parteh_c_alloc_priority(1:num_pft,1:num_organs)); + EDPftvarcon_inst%parteh_c_alloc_priority(:,:) = nan + iv = iv + 1 + EDPftvarcon_ptr%var(iv)%var_name = "fates_parteh_c_alloc_priority" + EDPftvarcon_ptr%var(iv)%rp_2d => EDPftvarcon_inst%parteh_c_alloc_priority + + allocate( EDPftvarcon_inst%turnover_retrans_mode(1:num_pft) ) + EDPftvarcon_inst%turnover_retrans_mode(:) = nan + iv = iv + 1 + EDPftvarcon_ptr%var(iv)%var_name = "fates_turnover_retrans_mode" + EDPftvarcon_ptr%var(iv)%rp_1d => EDPftvarcon_inst%turnover_retrans_mode + + allocate( EDPftvarcon_inst%turnover_retrans_leaf_n_p1(1:num_pft) ) + EDPftvarcon_inst%turnover_retrans_leaf_n_p1(:) = nana + iv = iv + 1 + EDPftvarcon_ptr%var(iv)%var_name = "fates_turnover_retrans_leaf_n_p1" + EDPftvarcon_ptr%var(iv)%rp_1d => EDPftvarcon_inst%turnover_retrans_leaf_n_p1 + + allocate( EDPftvarcon_inst%turnover_retrans_leaf_p_p1(1:num_pft) ) + EDPftvarcon_inst%turnover_retrans_leaf_p_p1(:) = nana + iv = iv + 1 + EDPftvarcon_ptr%var(iv)%var_name = "fates_turnover_retrans_leaf_p_p1" + EDPftvarcon_ptr%var(iv)%rp_1d => EDPftvarcon_inst%turnover_retrans_leaf_p_p1 + + allocate( EDPftvarcon_inst%turnover_retrans_fnrt_n_p1(1:num_pft) ) + EDPftvarcon_inst%turnover_retrans_fnrt_n_p1(:) = nana + iv = iv + 1 + EDPftvarcon_ptr%var(iv)%var_name = "fates_turnover_retrans_fnrt_n_p1" + EDPftvarcon_ptr%var(iv)%rp_1d => EDPftvarcon_inst%turnover_retrans_fnrt_n_p1 + + allocate( EDPftvarcon_inst%turnover_retrans_fnrt_p_p1(1:num_pft) ) + EDPftvarcon_inst%turnover_retrans_fnrt_p_p1(:) = nana + iv = iv + 1 + EDPftvarcon_ptr%var(iv)%var_name = "fates_turnover_retrans_fnrt_p_p1" + EDPftvarcon_ptr%var(iv)%rp_1d => EDPftvarcon_inst%turnover_retrans_fnrt_p_p1 + + + ! We should gracefully fail if rootprof_beta is requested + allocate( EDPftvarcon_inst%rootprof_beta(1:num_pft,n_beta_dims)); + EDPftvarcon_inst%rootprof_beta(:,:) = nan + + + numparm = iv + + print*,"F90: ALLOCATED ",numparm," PARAMETERS, FOR ",num_pft," PFTs" + + + return + end subroutine EDPftvarconAlloc + +end module EDPftvarcon diff --git a/functional_unit_testing/parteh/f_wrapper_modules/FatesWrapMod.F90 b/functional_unit_testing/parteh/f_wrapper_modules/FatesWrapMod.F90 new file mode 100644 index 0000000000..31d1d51a2d --- /dev/null +++ b/functional_unit_testing/parteh/f_wrapper_modules/FatesWrapMod.F90 @@ -0,0 +1,59 @@ +! ======================================================================================= +! +! This is the wrapper module that provides FATES data structures +! +! ======================================================================================= + +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 + +end module EDTypesMod + + +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 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 + +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 + character(len=*), intent(in) :: msg ! string to be printed + stop + end subroutine fates_endrun + +end module FatesGlobals diff --git a/functional_unit_testing/parteh/parteh_controls_defaults.xml b/functional_unit_testing/parteh/parteh_controls_defaults.xml new file mode 100644 index 0000000000..5359213212 --- /dev/null +++ b/functional_unit_testing/parteh/parteh_controls_defaults.xml @@ -0,0 +1,118 @@ + + + + + + + + + + + 0 + + + + + + + + + 86400 + 1500-01-01 + 1520-01-01 + 0.001 + + + + + + + + + AllometricCNP + + + DailyCNPFromStorageSinWaveNoMaint + + + + + + + Carbon Only, constant NPP + Carbon Only, 120% sin NPP + + + + leaf + fine root + sapwood + storage + reproductive + structural + + + + 1 , 1 + 1 , 1 + 0.2 , 0.2 + 0.2 , 0.2 + 30.0 , 30.0 + 1.0 , 1.0 + 1.5 , 1.5 + 50.0 , 50.0 + 5 , 5 + 3 , 3 + 1 , 1 + 1 , 1 + 1 , 1 + 1 , 1 + 1 , 1 + 57.6 , 57.6 + 0.74 , 0.74 + 21.6 , 21.6 + 0.0673 , 0.0673 + 0.976 , 0.976 + -999.9 , -999.9 + -999.9 , -999.9 + 0.07 , 0.07 + 1.3 , 1.3 + 0.55 , 0.55 + 2.0 , 2.0 + 0.7 , 0.7 + 2.0 , 2.0 + 1.00 , 1.00 + 0.0 , 0.0 + 0.012 , 0.012 + 0.012 , 0.012 + 1.0 , 1.0 + 0.65 , 0.65 + 0.1 , 0.1 + 0.0 , 0.0 + 0.33 , 0.33 + 0.65 , 0.65 + 300.0 , 300.0 + 1.5 , 1.5 + 1.5 , 1.5 + 0.5 , 0.5 + 50.0 , 50.0 + + 1,1 + -9,-9 + -9,-9 + -9,-9 + -9,-9 + + + + + 0.4, 0.4 + -9.9, -9.9 + -9.9, -9.9 + 0.0, 1.2 + + + + + + diff --git a/functional_unit_testing/parteh/parteh_controls_smoketests.xml b/functional_unit_testing/parteh/parteh_controls_smoketests.xml new file mode 100644 index 0000000000..895511e0de --- /dev/null +++ b/functional_unit_testing/parteh/parteh_controls_smoketests.xml @@ -0,0 +1,158 @@ + + + + + + + + + + + 0 + + + + + + + + + 86400 + 1500-01-01 + 1600-01-01 + 0.001 + + + + + + + + + AllometricCNP + + + DailyCNPFromCArea + + + + + + + Carbon Only + CNP, 10x nutrient + CNP, 0 nutrient, p1=p2=0 + CNP, 0.5 equiv N + CNP, 0.5 equiv P + + + + leaf + fine root + sapwood + storage + reproductive + structural + + + + 1 , 2 , 2 , 2 , 2 + 1 , 1 , 1 , 1 , 1 + 0.2 , 0.2 , 0.2 , 0.2 , 0.2 + 0.2 , 0.2, 0.2, 0.2, 0.2 + 30.0 , 30.0 , 30.0, 30.0 , 30.0 + 1.0 , 1.0 , 1.0, 1.0 , 1.0 + 1.5 , 1.5 , 1.5, 1.5 , 1.5 + 50.0 , 50.0 , 50.0, 50.0 , 50.0 + 5 , 5 , 5, 5 , 5 + 3 , 3 , 3, 3 , 3 + 1 , 1 , 1, 1 , 1 + 1 , 1 , 1, 1 , 1 + 1 , 1 , 1, 1 , 1 + 1 , 1 , 1, 1 , 1 + 1 , 1 , 1, 1 , 1 + 57.6 , 57.6 , 57.6, 57.6 , 57.6 + 0.74 , 0.74 , 0.74, 0.74 , 0.74 + 21.6 , 21.6 , 21.6, 21.6 , 21.6 + 0.0673 , 0.0673 , 0.0673, 0.0673 , 0.0673 + 0.976 , 0.976 , 0.976, 0.976 , 0.976 + -999.9 , -999.9 , -999.9, -999.9 , -999.9 + -999.9 , -999.9 , -999.9, -999.9 , -999.9 + 0.07 , 0.07 , 0.07, 0.07 , 0.07 + 1.3 , 1.3 , 1.3, 1.3 , 1.3 + 0.55 , 0.55 , 0.55 , 0.55 , 0.55 + 2.0 , 2.0 , 2.0, 2.0 , 2.0 + 0.7 , 0.7 , 0.7, 0.7 , 0.7 + 2.0 , 2.0 , 2.0, 2.0 , 2.0 + 1.00 , 1.00 , 1.00 , 1.00 , 1.00 + 0.0 , 0.0 , 0.0, 0.0 , 0.0 + 0.012 , 0.012 , 0.012, 0.012 , 0.012 + 0.012 , 0.012 , 0.012, 0.012 , 0.012 + 1.0 , 1.0 , 1.0, 1.0 , 1.0 + 0.65 , 0.65 , 0.65 , 0.65 , 0.65 + 0.1 , 0.1 , 0.1, 0.1 , 0.1 + 0.0 , 0.0 , 0.0, 0.0 , 0.0 + 0.33 , 0.33 , 0.33, 0.33 , 0.33 + 0.65 , 0.65 , 0.65, 0.65 , 0.65 + 300.0 , 300.0 , 300.0, 300.0 , 300.0 + 1.5 , 1.5 ,1.5, 1.5 ,1.5 + 1.5 , 1.5 ,1.5, 1.5 ,1.5 + 0.5 , 0.5 ,0.5, 0.5 ,0.5 + 50.0 , 50.0 , 50.0 , 50.0 , 50.0 + + + + + 1,1,1,1,1 + -9,0,0.25,0.25,0.25 + -9,0,0.25,0.25,0.25 + -9,0,0.25,0.25,0.25 + -9,0,0.25,0.25,0.25 + + -9,-9,-9,-9,-9,-9, + 0.05,0.05,0.05,0.05,0.05,0.05, + 0,0,0,0,0,0, + 0.05,0.05,0.05,0.05,0.05,0.05, + 0.05,0.05,0.05,0.05,0.05,0.05 + + -9,-9,-9,-9,-9,-9, + 0.05,0.05,0.05,0.05,0.05,0.05, + 0,0,0,0,0,0, + 0.05,0.05,0.05,0.05,0.05,0.05, + 0.05,0.05,0.05,0.05,0.05,0.05 + -9,-9,-9,-9,-9,-9, + 0.05,0.05,0.05,0.05,0.05,0.05, + 0,0,0,0,0,0, + 0.05,0.05,0.05,0.05,0.05,0.05, + 0.05,0.05,0.05,0.05,0.05,0.05 + -9,-9,-9,-9,-9,-9, + 0.05,0.05,0.05,0.05,0.05,0.05, + 0,0,0,0,0,0, + 0.05,0.05,0.05,0.05,0.05,0.05, + 0.05,0.05,0.05,0.05,0.05,0.05 + + -9,-9,-9,-9,-9,-9, + 1,1,2,2,0,3, + 1,1,2,2,0,3, + 1,1,2,2,0,3, + 1,1,2,2,0,3 + + -9,-9,-9,-9,-9,-9, + 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, + 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, + 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, + 0.01, 0.01, 0.01, 0.01, 0.01, 0.01 + + + + + + 0.4, 0.4, 0.4, 0.4, 0.4 + -9.9, 40.0, 0.0, 0.01, 40.0 + -9.9, 40.0, 0.0, 40.0, 0.01 + + + + + + diff --git a/functional_unit_testing/parteh/parteh_controls_variable_netc.xml b/functional_unit_testing/parteh/parteh_controls_variable_netc.xml new file mode 100644 index 0000000000..f31ad26bf6 --- /dev/null +++ b/functional_unit_testing/parteh/parteh_controls_variable_netc.xml @@ -0,0 +1,131 @@ + + + + + + + + + + + 0 + + + + + + + + + 86400 + 1500-01-01 + 1520-01-01 + 0.001 + + + + + + + + + AllometricCNP + + + DailyCNPFromStorageSinWaveNoMaint + + + + + + + Carbon Only + CNP w/ p1=p2=0 + CNP w/ p1=p2=0, 120% sin NPP + + + + leaf + fine root + sapwood + storage + reproductive + structural + + + + 1 , 2 , 2 + 1 , 1, 1 + 0.2 , 0.2, 0.2 + 0.2 , 0.2 , 0.2 + 30.0 , 30.0 , 30.0 + 1.0 , 1.0, 1.0 + 1.5 , 1.5 , 1.5 + 50.0 , 50.0 , 50.0 + 5 , 5 , 5 + 3 , 3 , 3 + 1 , 1 , 1 + 1 , 1 , 1 + 1 , 1 , 1 + 1 , 1 , 1 + 1 , 1 , 1 + 57.6 , 57.6 , 57.6 + 0.74 , 0.74 , 0.74 + 21.6 , 21.6 , 21.6 + 0.0673 , 0.0673 , 0.0673 + 0.976 , 0.976 , 0.976 + -999.9 , -999.9 , -999.9 + -999.9 , -999.9, -999.9 + 0.07 , 0.07 , 0.07 + 1.3 , 1.3 , 1.3 + 0.55 , 0.55 , 0.55 + 2.0 , 2.0 , 2.0 + 0.7 , 0.7 , 0.7 + 2.0 , 2.0 , 2.0 + 1.00 , 1.00 , 1.00 + 0.0 , 0.0 , 0.0 + 0.012 , 0.012 , 0.012 + 0.012 , 0.012 , 0.012 + 1.0 , 1.0 , 1.0 + 0.65 , 0.65 , 0.65 + 0.1 , 0.1 , 0.1 + 0.0 , 0.0 , 0.0 + 0.33 , 0.33 , 0.33 + 0.65 , 0.65 , 0.65 + 300.0 , 300.0 , 300.0 + 1.5 , 1.5 , 1.5 + 1.5 , 1.5 , 1.5 + 0.5 , 0.5 , 0.5 + 50.0 , 50.0 , 50.0 + + 1,1,1 + -9,0.25, 0.25 + -9,0.25, 0.25 + -9,0.25, 0.25 + -9,0.25, 0.25 + + + 0,0,0,0,0,0,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05 + 0,0,0,0,0,0,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05 + + 0,0,0,0,0,0,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05 + 0,0,0,0,0,0,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05 + + 1,1,2,2,0,3,1,1,2,2,0,3,1,1,2,2,0,3 + + 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01 + + + + + + 0.4, 0.4, 0.4 + -9.9, 40.0, 40.0 + -9.9, 40.0, 40.0 + 1.2, 1.2, 0.0 + + + + + + diff --git a/functional_unit_testing/parteh/py_modules/PartehInterpretParameters.py b/functional_unit_testing/parteh/py_modules/PartehInterpretParameters.py new file mode 100644 index 0000000000..ce9dc0d7ce --- /dev/null +++ b/functional_unit_testing/parteh/py_modules/PartehInterpretParameters.py @@ -0,0 +1,153 @@ +import numpy as np +import os +import sys +import getopt +import code # For development: code.interact(local=locals()) +import time +import imp +PartehTypes = imp.load_source('PartehTypes', 'py_modules/PartehTypes.py') + + +# ======================================================================================== +# Interpret the XML file + +def load_xml(xmlfile, time_control, parameters ): + + import xml.etree.ElementTree as et + + + xmlroot = et.parse(xmlfile).getroot() + print("\nOpenend: "+xmlfile) + + + + # Time control + # ----------------------------------------------------------------------------------- + + elem = xmlroot.find('time_control') + date_start_str = elem.find('date_start').text + date_stop_str = elem.find('date_stop').text + timestep_str = elem.find('timestep_sec').text + max_trunc_err_str = elem.find('max_trunc_error').text + time_control.InitializeTime(date_start_str,date_stop_str,timestep_str,max_trunc_err_str) + + # PARTEH model parameters + + # Read in the hypothesis we are testing + + hypotheses = ('AllometricCarbon','AllometricCNP') + + hypothesis_root = xmlroot.find('hypothesis') + parameters.hypothesis = hypothesis_root.text.strip() + + try: + parameters.prt_model = hypotheses.index(parameters.hypothesis) + 1 + except ValueError: + print('Attempted to identify PARTEH model type: {}'.format(parameters.hypothesis)) + print('Not in the list: {}'.format(hypotheses)) + exit(1) + + boundary_c_check = {} + boundary_c_check['AllometricCarbon']=['DailyCFromCArea'] + boundary_c_check['AllometricCNP']=['DailyCNPFromCArea','DailyCNPFromStorageSinWaveNoMaint'] + + boundary_root = xmlroot.find('boundary_formulation') + parameters.boundary_method = boundary_root.text.strip() + + if ( not any(x in parameters.boundary_method for x in boundary_c_check[parameters.hypothesis]) ): + print("A boundary condition formulation was not associated\n") + print(" with your hypothesis in the XML. Exiting.") + print("hypothesis: {}".format(parameters.hypothesis)) + print("boundary formulation: {}".format(parameters.boundary_method)) + exit(2) + + parameters_root = xmlroot.find('parameters') + + + # PFT parameters for PARTEH Internals + # ----------------------------------------------------------------------------------- + + pft_names_root = parameters_root.find('pft_names') + for pft_idx, pft_elem in enumerate(pft_names_root.iter('pft_par')): + + pft_name = pft_elem.text.strip() + + # Intialize the pft's dictionary of parameters + parameters.parteh_pfts.append(PartehTypes.pft_type(pft_name)) + + # Initialize the pft's parameters for the boundary conditions + parameters.boundary_pfts.append(PartehTypes.pft_type(pft_name)) + + parameters.num_pfts = len(parameters.parteh_pfts) + + + # Simply generate a list of organ names as strings + organ_names_root = parameters_root.find('organ_names') + for organ_idx, organ_elem in enumerate(organ_names_root.iter('organ_par')): + organ_name = organ_elem.text.strip() + parameters.parteh_organs.append(organ_name) + + parameters.num_organs = len(parameters.parteh_organs) + + # Load up all pft parameters that are specific to the PARTEH hypothesis + # ----------------------------------------------------------------------------------- + + for ptype_idx, ptype_elem in enumerate(parameters_root.iter('parteh_parameters')): + + for par_idx, par_elem in enumerate(ptype_elem.iter('pft_par')): + + pft_param_name = par_elem.attrib['name'].strip() + pft_param_val = par_elem.text.strip() + pft_vector = [float(i) for i in pft_param_val.split(',')] + if (len(pft_vector) != parameters.num_pfts): + print('parameter was given no value?') + print('{} is: {}'.format(pft_param_name,pft_param_val)) + print('exiting') + exit(1) + + for idx, value in enumerate(pft_vector): + # Note that dictionary entries are always lists + parameters.parteh_pfts[idx].param_dic[pft_param_name] = [value] + + for par_idx, par_elem in enumerate(ptype_elem.iter('pft_organ_par')): + + param_name = par_elem.attrib['name'].strip() + param_val = par_elem.text.strip() + param_vector = [float(i) for i in param_val.split(',')] + if (len(param_vector) != parameters.num_pfts*parameters.num_organs ): + print('parameter was given incorrect number of values?') + print('Expected size: {}, Total elements: {}'.format(parameters.num_pfts*parameters.num_organs,len(param_vector))) + print('{} is: {}'.format(param_name,param_val)) + print('exiting') + exit(1) + + for idx in range(parameters.num_pfts): + idl = idx*parameters.num_organs + idh = idl + parameters.num_organs + parameters.parteh_pfts[idx].param_dic[param_name] = param_vector[idl:idh] + + + # Load up all the pft parameters that are specific to the Boundary Condition method + # Must add a check to see if all correct parameters are loaded + # ----------------------------------------------------------------------------------- + + for ptype_idx, ptype_elem in enumerate(parameters_root.iter('boundary_parameters')): + + for par_idx, par_elem in enumerate(ptype_elem.iter('pft_par')): + + pft_param_name = par_elem.attrib['name'].strip() + pft_param_val = par_elem.text.strip() + pft_vector = [float(i) for i in pft_param_val.split(',')] + if (len(pft_vector) != parameters.num_pfts): + print('parameter was given no value?') + print('{} is: {}'.format(pft_param_name,pft_param_val)) + print('exiting') + exit(1) + + for idx,value in enumerate(pft_vector): + parameters.boundary_pfts[idx].param_dic[pft_param_name] = value + + + + print("\n\n Completed Interpreting: "+xmlfile) + print("\n Found {} PFT(s)".format(parameters.num_pfts)) diff --git a/functional_unit_testing/parteh/py_modules/PartehTypes.py b/functional_unit_testing/parteh/py_modules/PartehTypes.py new file mode 100644 index 0000000000..1be558385a --- /dev/null +++ b/functional_unit_testing/parteh/py_modules/PartehTypes.py @@ -0,0 +1,184 @@ +import numpy as np +import os +import sys +import getopt +import code # For development: code.interact(local=locals()) +import time + + +# ======================================================================================= +# +# Global Parameters +# +# ======================================================================================= + + +os.environ['TZ'] = 'UTC' +time.tzset() + +time_precision = 1.0e-10 # Acceptable time error for the + # adaptive time-stepper + +class param_type: + + def __init__(self): + + # Initialize the list of parameters + + self.hypothesis = "" + + self.boundary_method = "" + + # These are passed to the PARTEH Fortran code + # This is a list + self.parteh_pfts = [] + + # This is a list of the organ names + # These names must be consistent + # with the indices provided in the parameter file + # and that those indices should match the global + # indices in PRTGenericMod.F90 + self.parteh_organs = [] + + # These are used in the boundary conditions + self.boundary_pfts = [] + + # Save the number of pfts (as a convencience) + self.numpfts = -9 + + # Add other parameter groups as we go + +class pft_type: + + def __init__(self,pft_name): + + # Initialize a dictionary of parameters for any pft + self.name = pft_name + self.param_dic = {} + + +class diagnostics_type: + + def __init__(self): + + self.dates = [] + self.dbh = [] + self.dailyc = [] + self.leaf_c = [] + self.fnrt_c = [] + self.sapw_c = [] + self.store_c = [] + self.struct_c = [] + self.repro_c = [] + self.leaf_cturn = [] + self.fnrt_cturn = [] + self.sapw_cturn = [] + self.store_cturn = [] + self.struct_cturn = [] + + self.leaf_n = [] + self.fnrt_n = [] + self.sapw_n = [] + self.store_n = [] + self.struct_n = [] + self.repro_n = [] + self.leaf_nturn = [] + self.fnrt_nturn = [] + self.sapw_nturn = [] + self.store_nturn = [] + self.struct_nturn = [] + + self.leaf_p = [] + self.fnrt_p = [] + self.sapw_p = [] + self.store_p = [] + self.struct_p = [] + self.repro_p = [] + self.leaf_pturn = [] + self.fnrt_pturn = [] + self.sapw_pturn = [] + self.store_pturn = [] + self.struct_pturn = [] + + self.crown_area = [] + self.root_c_exudate = [] + self.root_n_exudate = [] + self.root_p_exudate = [] + self.growth_resp = [] + + +## Define the state variables and state terms types + +class timetype: + + def __init__(self): + + self.datetime_start = np.datetime64("1600-01-01") + self.datetime_stop = np.datetime64("1400-01-01") + self.datetime = np.datetime64("1300-01-01") + self.dt_fullstep = np.timedelta64(int(86400),'s') + self.sim_complete = False + self.max_err = -9.9 + self.id_substep = -9 + self.dt_substep = np.timedelta64(int(3600),'s') + self.dt_optsubstep = np.timedelta64(int(3600),'s') + + + def InitializeTime(self,date_start_str,date_stop_str,timestep_str,max_trunc_err_str): + + # Perform checks here as well + date_start_str = date_start_str.strip() + date_stop_str = date_stop_str.strip() + timestep_str = timestep_str.strip() + max_trunc_err_str = max_trunc_err_str.strip() + + # Timing for the main time loop + # ------------------------------------------------------------------------------- + self.datetime_start = np.datetime64(date_start_str) + self.datetime_stop = np.datetime64(date_stop_str) + self.datetime = self.datetime_start + self.dt_fullstep = float(timestep_str) + self.sim_complete = False + + # Maximum allowable truncation error on iterator + self.max_err = float(max_trunc_err_str) + + + # Timing for the integrator + # ------------------------------------------------------------------------------- + self.id_substep = 0 + self.dt_substep = self.dt_fullstep + self.dt_optsubstep = self.dt_fullstep + + def ResetTime(self): + + self.datetime = self.datetime_start + self.id_substep = 0 + self.dt_substep = self.dt_fullstep + self.dt_optsubstep = self.dt_fullstep + self.sim_complete = False + + def UpdateTime(self): + + self.datetime += np.timedelta64(int(self.dt_fullstep),'s') + if(self.datetime >= self.datetime_stop): + self.sim_complete = True + + def CheckFullStepTime(self,targettime): + if(np.abs(self.datetime-targettime)>time_precision): + print('The adaptive time-stepper finished') + print(' on a time-stamp that does not match') + print(' the projected timestep') + print(' projected: {}'.format(targettime)) + print(' actual: {}'.format(self.datetime)) + print(' exiting') + exit(2) + else: + self.datetime = targettime + + + + def UpdatePartialTime(self,dt_seconds): + self.datetime += np.timedelta64(int(dt_seconds),'s') + + diff --git a/functional_unit_testing/parteh/py_modules/SyntheticBoundaries.py b/functional_unit_testing/parteh/py_modules/SyntheticBoundaries.py new file mode 100644 index 0000000000..1bdc9285b0 --- /dev/null +++ b/functional_unit_testing/parteh/py_modules/SyntheticBoundaries.py @@ -0,0 +1,127 @@ +import numpy as np +import os +import sys +import getopt +import code # For development: code.interact(local=locals()) +import time + +day_per_year = 365.0 + +class pft_bc_type: + + def __init__(self): + + # Initialize a dictionary of parameters for any pft + self.pft_bc_dic = {} + + +def DailyCFromUnitGPPAR(leaf_area,AGB): + + # ----------------------------------------------------------------------------------- + # This routine estimates Net Daily Carbon Gains (GPP-AR) by estimating + # a mean canopy GPP per leaf area per year, and by estimating + # a mean autotrophic respiration per kilogram per year, both from literature. + # Thus to scale to a plant, the plant's leaf area and total biomass are needed. + # + # THese numbers are taken from Chambers et al. 2004 + # from ZF2 Manaus Brazil + # ----------------------------------------------------------------------------------- + + kg_per_Mg = 1000.0 + m2_per_ha = 10000.0 + + site_AGB = 151.35 # MgC/ha + site_NPP = 9.0 # MgC/ha/yr + site_AR = 21.0 # MgC/ha/yr + site_LAI = 4.7 # m2/m2 + + #site_Rleaf = 9.8 # MgC/ha/yr + #site_Rwood = 4.2 # MgC/ha/yr + #site_Rroot = 5.5 # MgC/ha/yr + + + GPP_per_larea_yr = kg_per_Mg * (site_NPP + site_AR) / \ + site_LAI / m2_per_ha + AR_per_kg_yr = kg_per_Mg * site_AR / site_AGB / \ + m2_per_ha + + GPP = 100.8*GPP_per_larea_yr * leaf_area / day_per_year + AR = AR_per_kg_yr * AGB / day_per_year + + NetDailyC = GPP - AR + + return NetDailyC + + +def DailyCFromCArea(presc_npp_p1,c_area): + + # ----------------------------------------------------------------------------------- + # This method was provided by Charlie Koven via is inferences from the PPA + # literature. Here, net daily carbon [kg] is based on one of two excluding + # parmaters (NPP per crown area per year), for plants that are either in + # the upper canopy (access to sunlight) or in the understory (low sunlight) + # + # c_area, footprint of the crown area [m2]. + # presc_npp_p1, npp generated per crown area [kgC/m2/yr] + # ----------------------------------------------------------------------------------- + + NetDailyC = presc_npp_p1 * c_area / day_per_year + + return NetDailyC + + +def DailyCNPFromCArea(presc_npp_p1,presc_nflux_p1, \ + presc_pflux_p1,c_area): + + # ----------------------------------------------------------------------------------- + # This method was provided by Charlie Koven via is inferences from the PPA + # literature. Here, net daily carbon [kg] is based on one of two excluding + # parmaters (NPP per crown area per year), for plants that are either in + # the upper canopy (access to sunlight) or in the understory (low sunlight) + # + # c_area, footprint of the crown area [m2]. + # 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] + # ----------------------------------------------------------------------------------- + + NetDailyC = presc_npp_p1 * c_area / day_per_year + NetDailyN = presc_nflux_p1 * c_area / day_per_year + NetDailyP = presc_pflux_p1 * c_area / day_per_year + + return NetDailyC, NetDailyN, NetDailyP + + +def DailyCNPFromStorageSinWave(doy,store_c,presc_npp_p1, \ + presc_nflux_p1,presc_pflux_p1,c_area,presc_npp_amp): + + + # This method is supposed to simulate a seasonal cycle of NPP + # In some cases we pass negative daily carbon gain to the allocation model + # however, we have to be careful to not make negative gains larger + # than available storage in those cases. This is not necessarily the most + # realistic model, but its important to test that the parteh algorithms can handle + # these stressfull negative gain conditions. + + doy0=0.0 + + sin_func = np.sin( (doy-doy0)/366.0 * 2.0 * np.pi ) + + #if (sin_func>0.0): + # NetDailyC = sin_func * presc_npp_p1 * c_area / day_per_year + #else: + # NetDailyC = -np.minimum( -neg_store_frac * sin_func * presc_npp_p1* c_area / day_per_year, 0.98* np.float(store_c)) + + NetDailyC = (presc_npp_amp * sin_func * presc_npp_p1 + presc_npp_p1) * c_area/day_per_year + + # This is a fail-safe, for large negatives, cant be larger than storage + if (NetDailyC < 0.0): + NetDailyC = -np.minimum(-NetDailyC,0.98* np.float(store_c)) + + #print("sin_func: {}, NetDailyC: {}, store_c: {}, c_area :{}".format(sin_func,NetDailyC,store_c,c_area)) + + NetDailyN = presc_nflux_p1 * c_area / day_per_year + NetDailyP = presc_pflux_p1 * c_area / day_per_year + + return NetDailyC, NetDailyN, NetDailyP diff --git a/main/FatesIntegratorsMod.F90 b/main/FatesIntegratorsMod.F90 index df51fd6c5d..5171180184 100644 --- a/main/FatesIntegratorsMod.F90 +++ b/main/FatesIntegratorsMod.F90 @@ -1,8 +1,5 @@ module FatesIntegratorsMod - use EDTypesMod , only : ed_site_type - use EDTypesMod , only : ed_patch_type - use EDTypesMod , only : ed_cohort_type use FatesConstantsMod, only : r8 => fates_r8 implicit none @@ -13,7 +10,7 @@ module FatesIntegratorsMod contains - subroutine RKF45(DerivFunction,Y,Ymask,dx,x,ccohort,max_err,Yout,l_pass) + subroutine RKF45(DerivFunction,Y,Ymask,dx,x,max_err,param_array,Yout,opt_dx,l_pass) ! --------------------------------------------------------------------------------- ! Runge-Kutta-Fehlerg 4/5 order adaptive explicit integration @@ -27,9 +24,11 @@ subroutine RKF45(DerivFunction,Y,Ymask,dx,x,ccohort,max_err,Yout,l_pass) logical,intent(in), dimension(:) :: Ymask ! logical mask defining what is on real(r8),intent(in) :: dx ! step size of independent variable real(r8),intent(in) :: x ! independent variable (time?) - type(ed_cohort_type),intent(inout),target :: ccohort ! Cohort derived type real(r8),intent(in) :: max_err ! Maximum allowable error (absolute) + real(r8),intent(in), dimension(:) :: param_array ! Arbitrary space for parameters real(r8),intent(inout), dimension(:) :: Yout ! The output vector + real(r8),intent(out) :: opt_dx ! Optimum step size based + ! on estimated error logical,intent(out) :: l_pass ! Was this a successfully step? ! Locals @@ -84,96 +83,93 @@ subroutine RKF45(DerivFunction,Y,Ymask,dx,x,ccohort,max_err,Yout,l_pass) ! Input Functional Argument interface - function DerivFunction(Y,Ymask,x,ccohort) result(dYdx) - use EDTypesMod , only : ed_site_type - use EDTypesMod , only : ed_patch_type - use EDTypesMod , only : ed_cohort_type - use FatesConstantsMod, only : r8 => fates_r8 - real(r8),intent(in), dimension(:) :: Y ! dependent variable (array) - logical,intent(in), dimension(:) :: Ymask ! logical mask defining what is on - real(r8),intent(in) :: x ! independent variable (time?) - type(ed_cohort_type),intent(in),target :: ccohort ! Cohort derived type - real(r8),dimension(lbound(Y,dim=1):ubound(Y,dim=1)) :: dYdx ! Derivative of dependent variable - end function DerivFunction - end interface - - nY = size(Y,1) - - ! 0th Step - Ytemp(1:nY) = Y(1:nY) - xtemp = x - K0(1:nY) = DerivFunction(Ytemp(1:nY),Ymask,xtemp,ccohort) - - ! 1st Step - Ytemp(1:nY) = Y(1:nY) + dx * (f1_0*K0(1:nY)) - xtemp = x + t1*dx - K1(1:nY) = DerivFunction(Ytemp(1:nY),Ymask,xtemp,ccohort) - - ! 2nd Step - Ytemp(1:nY) = Y(1:nY) + dx * ( f2_0*K0(1:nY) + f2_1*K1(1:nY) ) - xtemp = x + t2*dx - K2(1:nY) = DerivFunction(Ytemp(1:nY),Ymask,xtemp,ccohort) - - ! 3rd Step - Ytemp(1:nY) = Y(1:nY) + dx * ( f3_0*K0(1:nY) + f3_1*K1(1:nY) + & - f3_2*K2(1:nY)) - xtemp = x + t3*dx - K3(1:nY) = DerivFunction(Ytemp(1:nY),Ymask,xtemp,ccohort) - - ! 4th Step - Ytemp(1:nY) = Y(1:nY) + dx * ( f4_0*K0(1:nY) + f4_1*K1(1:nY) + & - f4_2*K2(1:nY) + f4_3*K3(1:nY)) - xtemp = x + t4*dx - K4(1:nY) = DerivFunction(Ytemp(1:nY),Ymask,xtemp,ccohort) - - ! 5th Step - Ytemp(1:nY) = Y(1:nY) + dx * ( f5_0*K0(1:nY) + f5_1*K1(1:nY) + & - f5_2*K2(1:nY) + f5_3*K3(1:nY) + & - f5_4*K4(1:nY)) - xtemp = x + t5*dx - K5(1:nY) = DerivFunction(Ytemp(1:nY),Ymask,xtemp,ccohort) - - - ! Evaluate error on the 4/5 steps - - ! 4th order - Ytemp(1:nY) = Y(1:nY) + dx * ( y_0*K0(1:nY) + y_2*K2(1:nY) + & - y_3*K3(1:nY) + y_4*K4(1:nY) ) - ! 5th order - Yout(1:nY) = Y(1:nY) + dx * ( z_0*K0(1:nY) + z_2*K2(1:nY) + & - z_3*K3(1:nY) + z_4*K4(1:nY) + & - z_5*K5(1:nY) ) - - ! Take the maximum absolute error across all variables - ! To prevent weirdness set a nominal lower bound - err45 = maxval(abs(Yout(1:nY)-Ytemp(1:nY))) - - ! -------------------------------------------------------------------------------- - ! Evaluate error and either approve/reject step. - ! - ! Update our estimate of the optimal time-step. We won't update - ! the current time-step based on this, but we will save this info - ! to help decide the starting sub-step on the next full step - ! The equations may be so smooth that the error estimate is so low that it creates - ! an overflow on the divide, set a lower bound based on max_err. - ! 1e-5, as an error ratio will shorten the timestep to ~5% of original - ! -------------------------------------------------------------------------------- - - ccohort%ode_opt_step = dx * max(min_step_fraction, & - 0.840896 * (max_err/ max(err45,0.00001*max_err))**0.25) - - if(err45 > max_err) then - l_pass = .false. - else - l_pass = .true. - end if + function DerivFunction(Y,Ymask,x,param_array) result(dYdx) + use FatesConstantsMod, only : r8 => fates_r8 + real(r8),intent(in), dimension(:) :: Y ! dependent variable (array) + logical,intent(in), dimension(:) :: Ymask ! logical mask defining what is on + real(r8),intent(in) :: x ! independent variable (time?) + real(r8),intent(in), dimension(:) :: param_array + real(r8),dimension(lbound(Y,dim=1):ubound(Y,dim=1)) :: dYdx ! Derivative of dependent variable + end function DerivFunction + end interface + + nY = size(Y,1) + + ! 0th Step + Ytemp(1:nY) = Y(1:nY) + xtemp = x + K0(1:nY) = DerivFunction(Ytemp(1:nY),Ymask,xtemp,param_array) + + ! 1st Step + Ytemp(1:nY) = Y(1:nY) + dx * (f1_0*K0(1:nY)) + xtemp = x + t1*dx + K1(1:nY) = DerivFunction(Ytemp(1:nY),Ymask,xtemp,param_array) + + ! 2nd Step + Ytemp(1:nY) = Y(1:nY) + dx * ( f2_0*K0(1:nY) + f2_1*K1(1:nY) ) + xtemp = x + t2*dx + K2(1:nY) = DerivFunction(Ytemp(1:nY),Ymask,xtemp,param_array) + + ! 3rd Step + Ytemp(1:nY) = Y(1:nY) + dx * ( f3_0*K0(1:nY) + f3_1*K1(1:nY) + & + f3_2*K2(1:nY)) + xtemp = x + t3*dx + K3(1:nY) = DerivFunction(Ytemp(1:nY),Ymask,xtemp,param_array) + + ! 4th Step + Ytemp(1:nY) = Y(1:nY) + dx * ( f4_0*K0(1:nY) + f4_1*K1(1:nY) + & + f4_2*K2(1:nY) + f4_3*K3(1:nY)) + xtemp = x + t4*dx + K4(1:nY) = DerivFunction(Ytemp(1:nY),Ymask,xtemp,param_array) + + ! 5th Step + Ytemp(1:nY) = Y(1:nY) + dx * ( f5_0*K0(1:nY) + f5_1*K1(1:nY) + & + f5_2*K2(1:nY) + f5_3*K3(1:nY) + & + f5_4*K4(1:nY)) + xtemp = x + t5*dx + K5(1:nY) = DerivFunction(Ytemp(1:nY),Ymask,xtemp,param_array) - return + + ! Evaluate error on the 4/5 steps + + ! 4th order + Ytemp(1:nY) = Y(1:nY) + dx * ( y_0*K0(1:nY) + y_2*K2(1:nY) + & + y_3*K3(1:nY) + y_4*K4(1:nY) ) + ! 5th order + Yout(1:nY) = Y(1:nY) + dx * ( z_0*K0(1:nY) + z_2*K2(1:nY) + & + z_3*K3(1:nY) + z_4*K4(1:nY) + & + z_5*K5(1:nY) ) + + ! Take the maximum absolute error across all variables + ! To prevent weirdness set a nominal lower bound + err45 = maxval(abs(Yout(1:nY)-Ytemp(1:nY))) + + ! -------------------------------------------------------------------------------- + ! Evaluate error and either approve/reject step. + ! + ! Update our estimate of the optimal time-step. We won't update + ! the current time-step based on this, but we will save this info + ! to help decide the starting sub-step on the next full step + ! The equations may be so smooth that the error estimate is so low that it creates + ! an overflow on the divide, set a lower bound based on max_err. + ! 1e-5, as an error ratio will shorten the timestep to ~5% of original + ! -------------------------------------------------------------------------------- + + opt_dx = dx * max(min_step_fraction, & + 0.840896 * (max_err/ max(err45,0.00001*max_err))**0.25) + + if(err45 > max_err) then + l_pass = .false. + else + l_pass = .true. + end if + + return end subroutine RKF45 - + ! =================================================================================== - subroutine Euler(DerivFunction,Y,Ymask,dx,x,ccohort,Yout) + subroutine Euler(DerivFunction,Y,Ymask,dx,x,param_array,Yout) ! --------------------------------------------------------------------------------- ! Simple Euler Integration @@ -185,7 +181,7 @@ subroutine Euler(DerivFunction,Y,Ymask,dx,x,ccohort,Yout) logical,intent(in), dimension(:) :: Ymask ! logical mask defining what is on real(r8),intent(in) :: dx ! step size of independent variable real(r8),intent(in) :: x ! independent variable (time?) - type(ed_cohort_type),intent(inout),target :: ccohort ! Cohort derived type + real(r8),intent(in), dimension(:) :: param_array ! Arbitrary space for parameters real(r8),intent(inout), dimension(:) :: Yout ! The output vector ! Locals @@ -196,22 +192,19 @@ subroutine Euler(DerivFunction,Y,Ymask,dx,x,ccohort,Yout) ! Input Functional Argument interface - function DerivFunction(Y,Ymask,x,ccohort) result(dYdx) - use EDTypesMod , only : ed_site_type - use EDTypesMod , only : ed_patch_type - use EDTypesMod , only : ed_cohort_type - use FatesConstantsMod, only : r8 => fates_r8 - real(r8),intent(in), dimension(:) :: Y ! dependent variable (array) - logical,intent(in), dimension(:) :: Ymask ! logical mask defining what is on - real(r8),intent(in) :: x ! independent variable (time?) - type(ed_cohort_type),intent(in),target :: ccohort ! Cohort derived type + function DerivFunction(Y,Ymask,x,param_array) result(dYdx) + use FatesConstantsMod, only : r8 => fates_r8 + real(r8),intent(in), dimension(:) :: Y ! dependent variable (array) + logical,intent(in), dimension(:) :: Ymask ! logical mask defining what is on + real(r8),intent(in) :: x ! independent variable (time?) + real(r8),intent(in), dimension(:) :: param_array real(r8),dimension(lbound(Y,dim=1):ubound(Y,dim=1)) :: dYdx ! Derivative of dependent variable end function DerivFunction end interface nY = size(Y,1) - dYdx(1:nY) = DerivFunction(Y(1:nY),Ymask,x,ccohort) + dYdx(1:nY) = DerivFunction(Y(1:nY),Ymask,x,param_array) Yout(1:nY) = Y(1:nY) + dx * dYdx(1:nY) diff --git a/parteh/PRTAllometricCarbonMod.F90 b/parteh/PRTAllometricCarbonMod.F90 new file mode 100644 index 0000000000..5c41f5b600 --- /dev/null +++ b/parteh/PRTAllometricCarbonMod.F90 @@ -0,0 +1,983 @@ +module PRTAllometricCarbonMod + + ! ------------------------------------------------------------------------------------ + ! + ! This module contains all of the specific functions and types for + ! Plant Allocation and Reactive Transport Extensible Hypotheses (PARTEH) + ! CARBON only, allometric growth hypothesis + ! + ! Ryan Knox Apr 2018 + ! + ! ------------------------------------------------------------------------------------ + + use PRTGenericMod , only : prt_instance_type + use PRTGenericMod , only : prt_vartype + use PRTGenericMod , only : prt_vartypes + use PRTGenericMod , only : carbon12_species + 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 FatesInterfaceMod , only : hlm_freq_day + use FatesAllometryMod , only : bleaf + use FatesAllometryMod , only : bsap_allom + use FatesAllometryMod , only : bfineroot + use FatesAllometryMod , only : bstore_allom + use FatesAllometryMod , only : bdead_allom + use FatesAllometryMod , only : bbgw_allom + use FatesAllometryMod , only : bagw_allom + use FatesAllometryMod , only : h_allom + use FatesAllometryMod , only : CheckIntegratedAllometries + use FatesAllometryMod , only : StructureResetOfDH + + use FatesGlobals , only : endrun => fates_endrun + use FatesGlobals , only : fates_log + use shr_log_mod , only : errMsg => shr_log_errMsg + use FatesConstantsMod , only : r8 => fates_r8 + use FatesConstantsMod , only : i4 => fates_int + use FatesIntegratorsMod , only : RKF45 + use FatesIntegratorsMod , only : Euler + use EDPftvarcon , only : EDPftvarcon_inst + use FatesConstantsMod , only : calloc_abs_error + use FatesConstantsMod , only : nearzero + use FatesConstantsMod , only : itrue + ! use PARTEHUtilitiesMod , only : MaintenanceTurnover + + implicit none + private + + ! ------------------------------------------------------------------------------------- + ! + ! Define the state variables for this specific hypothesis. Give them units and define + ! the indices that correspond with the generic classifications of PRT variables + ! + ! ------------------------------------------------------------------------------------- + + integer, parameter :: leaf_c_id = 1 + integer, parameter :: fnrt_c_id = 2 + integer, parameter :: sapw_c_id = 3 + integer, parameter :: store_c_id = 4 + integer, parameter :: repro_c_id = 5 + integer, parameter :: struct_c_id = 6 + integer, parameter :: ac_num_vars = 6 ! Number of PRT variables + + integer, parameter :: dbh_id = 7 ! This is just used for the integrator + integer, parameter :: n_integration_vars = 7 + + + ! ------------------------------------------------------------------------------------- + ! Boundary Conditions + ! ------------------------------------------------------------------------------------- + ! Input Boundary Indices (These are public, and therefore + ! each boundary condition across all modules must + ! have a unique name !!!!) + ! ------------------------------------------------------------------------------------- + + integer, public, parameter :: ac_bc_inout_id_dbh = 1 ! Plant DBH + integer, public, parameter :: ac_bc_inout_id_netdc = 2 ! Index for the net daily C input BC + integer, parameter :: num_bc_inout = 2 + + + 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 + + + ! ------------------------------------------------------------------------------------- + ! Define the size of the coorindate vector. For this hypothesis, there is only + ! one pool per each species x organ combination. + ! ------------------------------------------------------------------------------------- + integer, parameter :: icd = 1 ! Only 1 coordinate per variable + + + ! ------------------------------------------------------------------------------------- + ! This is the core type that holds this specific + ! plant reactive transport (PRT) module + ! ------------------------------------------------------------------------------------- + + type callom_prt_vartype + + real(r8) :: allom_deficit ! Deficit of plant WRT allometric target + + end type callom_prt_vartype + + + + type, public, extends(prt_vartypes) :: callom_prt_vartypes + + type(callom_prt_vartype),allocatable :: aux_variables(:) + + contains + + procedure :: DailyPRT => DailyPRTAC + procedure :: FastPRT => FastPRTAC + procedure :: InitAllocate => InitAllocateAC + + end type callom_prt_vartypes + + ! ------------------------------------------------------------------------------------ + ! + ! This next class is an extention of the base instance that maps state variables + ! to the outside model. + ! + ! ------------------------------------------------------------------------------------ + + character(len=*), parameter, private :: sourcefile = __FILE__ + + + ! This is the instance of the mapping table and variable definitions + ! this is only allocated once per node + class(prt_instance_type), target, allocatable :: prt_instance_ac + + + public :: InitPRTInstanceAC + + +contains + + + subroutine InitPRTInstanceAC() + + ! ---------------------------------------------------------------------------------- + ! Initialize and populate the general mapping table that + ! organizes the specific variables in this module to + ! pre-ordained groups, so they can be used to inform + ! the rest of the model + ! ----------------------------------------------------------------------------------- + + allocate(prt_instance_ac) + allocate(prt_instance_ac%state_descriptor(ac_num_vars)) + + prt_instance_ac%hyp_name = 'Allometric Carbon Only' + + call prt_instance_ac%ZeroInstance() + + ! Populate the array + ! This is a carbon only scheme, no isotopes, so should be simple + ! The "indices array" max not exceed max_types_per_sp_organ + ! If that array limit is not large enough for new hypothesis + ! simply increase it. It will not use much memory or increase loop sizes + + + call prt_instance_ac%InitInstance(leaf_c_id,"Leaf Carbon","leaf_c",leaf_organ,carbon12_species) + call prt_instance_ac%InitInstance(fnrt_c_id,"Fine Root Carbon","fnrt_c",fnrt_organ,carbon12_species) + call prt_instance_ac%InitInstance(sapw_c_id,"Sapwood Carbon","sapw_c",sapw_organ,carbon12_species) + call prt_instance_ac%InitInstance(store_c_id,"Storage Carbon","store_c",store_organ,carbon12_species) + call prt_instance_ac%InitInstance(struct_c_id,"Structural Carbon","struct_c",struct_organ,carbon12_species) + call prt_instance_ac%InitInstance(repro_c_id,"Reproductive Carbon","repro_c",repro_organ,carbon12_species) + + return + end subroutine InitPRTInstanceAC + + + ! ===================================================================================== + + + subroutine InitAllocateAC(this) + + ! ---------------------------------------------------------------------------------- + ! This initialization is called everytime a plant/cohort + ! is newly recruited. This simply sets-up, allocates + ! and sets some initialization values + ! ---------------------------------------------------------------------------------- + + class(callom_prt_vartypes) :: this ! this class + + integer :: ivar + + + ! Set the instance pointer to the correct instance + ! ---------------------------------------------------------------------------------- + + this%prt_instance => prt_instance_ac + + + ! Allocate the boundar condition arrays and flush them to no-data flags + ! ---------------------------------------------------------------------------------- + + allocate(this%bc_in(num_bc_in)) + allocate(this%bc_inout(num_bc_inout)) + + + ! Allocate the state variables + allocate(this%variables(ac_num_vars)) + + do ivar = 1, ac_num_vars + + this%variables(ivar)%num_pos = icd + allocate(this%variables(ivar)%val(icd)) + allocate(this%variables(ivar)%val0(icd)) + allocate(this%variables(ivar)%turnover(icd)) + allocate(this%variables(ivar)%dvaldt(icd)) + + end do + + ! Initialize the optimum step size as very large. + + this%ode_opt_step = 1e6_r8 + + + return + end subroutine InitAllocateAC + + + ! ===================================================================================== + + + subroutine DailyPRTAC(this) + + + ! The class is the only argument, input and output bc's are globals + class(callom_prt_vartypes) :: this ! this class + + ! ----------------------------------------------------------------------------------- + ! These are local copies of the in/out boundary condition structure + ! ----------------------------------------------------------------------------------- + + real(r8),pointer :: dbh ! Diameter at breast height [cm] + ! this local will point to both in and out bc's + real(r8),pointer :: carbon_balance ! Daily carbon balance for this cohort [kgC] + + ! These are local copies of the input only boundary conditions + real(r8) :: canopy_trim ! The canopy trimming function [0-1] + integer :: ipft ! Plant Functional Type index + + ! ----------------------------------------------------------------------------------- + ! Local copies of output boundary conditions + ! ----------------------------------------------------------------------------------- + + real(r8) :: target_leaf_c ! target leaf carbon [kgC] + real(r8) :: target_fnrt_c ! target fine-root carbon [kgC] + real(r8) :: target_sapw_c ! target sapwood carbon [kgC] + real(r8) :: target_store_c ! target storage carbon [kgC] + real(r8) :: target_agw_c ! target above ground carbon in woody tissues [kgC] + real(r8) :: target_bgw_c ! target below ground carbon in woody tissues [kgC] + real(r8) :: target_struct_c ! target structural carbon [kgC] + + real(r8) :: leaf_below_target ! fineroot biomass below target amount [kgC] + real(r8) :: fnrt_below_target ! fineroot biomass below target amount [kgC] + real(r8) :: sapw_below_target ! sapwood biomass below target amount [kgC] + real(r8) :: store_below_target ! storage biomass below target amount [kgC] + real(r8) :: struct_below_target ! dead (structural) biomass below target amount [kgC] + real(r8) :: total_below_target ! total biomass below the allometric target [kgC] + + real(r8) :: flux_adj ! adjustment made to growth flux term to minimize error [kgC] + real(r8) :: store_target_fraction ! ratio between storage and leaf biomass when on allometry [kgC] + + real(r8) :: leaf_c_demand ! leaf carbon that is demanded to replace maintenance turnover [kgC] + real(r8) :: fnrt_c_demand ! fineroot carbon that is demanded to replace + ! maintenance turnover [kgC] + real(r8) :: total_c_demand ! total carbon that is demanded to replace maintenance turnover [kgC] + real(r8) :: sapw_area ! dummy sapwood area + logical :: step_pass ! Did the integration step pass? + + real(r8) :: leaf_c_flux + real(r8) :: fnrt_c_flux + real(r8) :: sapw_c_flux + real(r8) :: store_c_flux + real(r8) :: repro_c_flux + real(r8) :: struct_c_flux + + logical :: grow_leaf ! Are leaves at allometric target and should be grown? + logical :: grow_fnrt ! Are fine-roots at allometric target and should be grown? + logical :: grow_sapw ! Is sapwood at allometric target and should be grown? + logical :: grow_store ! Is storage at allometric target and should be grown? + + ! integrator variables + real(r8) :: deltaC ! trial value for substep + integer :: ierr ! error flag for allometric growth step + integer :: nsteps ! number of sub-steps + integer :: istep ! current substep index + real(r8) :: totalC ! total carbon allocated over alometric growth step + real(r8) :: hite_out ! dummy height variable + + integer :: i_var ! local index for iterating state variables + + + ! Integegrator variables + + real(r8),dimension(n_integration_vars) :: c_pool ! Vector of carbon pools passed to integrator + real(r8),dimension(n_integration_vars) :: c_pool_out ! Vector of carbon pools passed back from integrator + logical,dimension(n_integration_vars) :: c_mask ! Mask of active pools during integration + + real(r8), parameter :: cbal_prec = 1.0e-15_r8 ! Desired precision in carbon balance + integer , parameter :: max_substeps = 300 ! Maximum allowable iterations + real(r8), parameter :: max_trunc_error = 1.0_r8 ! Maximum allowable truncation error + integer, parameter :: ODESolve = 2 ! 1=RKF45, 2=Euler + + real(r8) :: intgr_params(num_bc_in) + + + ! This is a local array containing the boundary conditions + ! we need this (for now at least) because the integration layer needs things + ! packed into simple types + + + ! This array is used to hold parameters that must be passed through + ! a generic integrator to the derivative functions + + associate( & + leaf_c => this%variables(leaf_c_id)%val(icd), & + fnrt_c => this%variables(fnrt_c_id)%val(icd), & + sapw_c => this%variables(sapw_c_id)%val(icd), & + store_c => this%variables(store_c_id)%val(icd), & + repro_c => this%variables(repro_c_id)%val(icd), & + struct_c => this%variables(struct_c_id)%val(icd)) + + + ! =================================================================================== + ! + ! !!!! CALCULATIONS THAT SHOULD NOW BE OUTSIDE OF THIS ROUTINE !!!! + ! WE USED TO SET THE "ISNEW" FLAG HERE + ! MAKE SURE THAT IT IS SET AFTER THIS ROUTINE IS CALLED + ! IT SHOULD BE CALLED FOR ANY INSTANCE, NOT JUST THIS + ! currentSite%flux_in = currentSite%flux_in + currentCohort%npp_acc * currentCohort%n + ! + ! =================================================================================== + + ! Copy the boundary conditions into readable local variables + ! We don't use pointers, because inputs should be intent in only + + dbh => this%bc_inout(ac_bc_inout_id_dbh)%rval + carbon_balance => this%bc_inout(ac_bc_inout_id_netdc)%rval + + canopy_trim = this%bc_in(ac_bc_in_id_ctrim)%rval + ipft = this%bc_in(ac_bc_in_id_pft)%ival + + intgr_params(:) = -9.9e32_r8 + intgr_params(ac_bc_in_id_ctrim) = this%bc_in(ac_bc_in_id_ctrim)%rval + intgr_params(ac_bc_in_id_pft) = real(this%bc_in(ac_bc_in_id_pft)%ival) + + + ! ----------------------------------------------------------------------------------- + ! I. Calculate target size of the biomass compartment for a given dbh. + ! ----------------------------------------------------------------------------------- + + + ! Target sapwood biomass and deriv. according to allometry and trimming [kgC, kgC/cm] + !call bsap_allom(dbh,ipft,canopy_trim,sapw_area,target_sapw_c) + call bsap_allom(dbh,ipft,canopy_trim,target_sapw_c) + + + ! Target total above ground deriv. biomass in woody/fibrous tissues [kgC, kgC/cm] + call bagw_allom(dbh,ipft,target_agw_c) + + ! Target total below ground deriv. biomass in woody/fibrous tissues [kgC, kgC/cm] + call bbgw_allom(dbh,ipft,target_bgw_c) + + ! Target total dead (structrual) biomass and deriv. [kgC, kgC/cm] + call bdead_allom( target_agw_c, target_bgw_c, target_sapw_c, ipft, target_struct_c) + + + + + ! ------------------------------------------------------------------------------------ + ! If structure is larger than target, then we need to correct some integration errors + ! by slightly increasing dbh to match it. + ! For grasses, if leaf biomass is larger than target, then we reset dbh to match + ! ----------------------------------------------------------------------------------- + if( (( struct_c - target_struct_c ) > calloc_abs_error) .and. & + (EDPftvarcon_inst%woody(ipft) == itrue) ) then + + call StructureResetOfDH( struct_c, ipft, & + canopy_trim, dbh, hite_out ) + + ! Target sapwood biomass and deriv. according to allometry and trimming [kgC, kgC/cm] + !call bsap_allom(dbh,ipft,canopy_trim,sapw_area,target_sapw_c) + call bsap_allom(dbh,ipft,canopy_trim,target_sapw_c) + + ! Target total above ground deriv. biomass in woody/fibrous tissues [kgC, kgC/cm] + call bagw_allom(dbh,ipft,target_agw_c) + + ! Target total below ground deriv. biomass in woody/fibrous tissues [kgC, kgC/cm] + call bbgw_allom(dbh,ipft,target_bgw_c) + + ! Target total dead (structrual) biomass and deriv. [kgC, kgC/cm] + call bdead_allom( target_agw_c, target_bgw_c, target_sapw_c, ipft, target_struct_c) + + end if + + ! Target leaf biomass according to allometry and trimming + call bleaf(dbh,ipft,canopy_trim,target_leaf_c) + + ! Target fine-root biomass and deriv. according to allometry and trimming [kgC, kgC/cm] + call bfineroot(dbh,ipft,canopy_trim,target_fnrt_c) + + ! Target storage carbon [kgC,kgC/cm] + call bstore_allom(dbh,ipft,canopy_trim,target_store_c) + + + ! ----------------------------------------------------------------------------------- + ! Set memory of the old state variables for comparison + ! ----------------------------------------------------------------------------------- + + do i_var = 1,ac_num_vars + this%variables(i_var)%val0(icd) = this%variables(i_var)%val(icd) + end do + + ! ----------------------------------------------------------------------------------- + ! II. Call maintenance turnover + ! This will increment %turnover and decrease %val + ! ---------------------------------------------------------------------------------- + + call this%MaintTurnover(ipft) + + ! ----------------------------------------------------------------------------------- + ! III. Prioritize some amount of carbon to replace leaf/root turnover + ! Make sure it isnt a negative payment, and either pay what is available + ! or forcefully pay from storage. + ! ----------------------------------------------------------------------------------- + + leaf_c_demand = max(0.0_r8,(target_leaf_c - leaf_c)) + fnrt_c_demand = max(0.0_r8,(target_fnrt_c - fnrt_c)) + + total_c_demand = leaf_c_demand + fnrt_c_demand + + if (total_c_demand> nearzero) then + + ! If we are testing b4b, then we pay this even if we don't have the carbon + ! Just don't pay so much carbon that storage+carbon_balance can't pay for it + leaf_c_flux = min(leaf_c_demand, & + max(0.0_r8,(store_c+carbon_balance)* & + (leaf_c_demand/total_c_demand))) + + carbon_balance = carbon_balance - leaf_c_flux + leaf_c = leaf_c + leaf_c_flux + + ! If we are testing b4b, then we pay this even if we don't have the carbon + fnrt_c_flux = min(fnrt_c_demand, & + max(0.0_r8, (store_c+carbon_balance)* & + (fnrt_c_demand/total_c_demand))) + + carbon_balance = carbon_balance - fnrt_c_flux + fnrt_c = fnrt_c + fnrt_c_flux + + end if + + ! ----------------------------------------------------------------------------------- + ! IV. if carbon balance is negative, re-coup the losses from storage + ! if it is positive, give some love to storage carbon + ! ----------------------------------------------------------------------------------- + + if( carbon_balance < 0.0_r8 ) then + + store_c_flux = carbon_balance + carbon_balance = carbon_balance - store_c_flux + store_c = store_c + store_c_flux + + else + + store_below_target = max(target_store_c - store_c,0.0_r8) + store_target_fraction = max(0.0_r8, store_c/target_store_c ) + + store_c_flux = min(store_below_target,carbon_balance * & + max(exp(-1.*store_target_fraction**4._r8) - exp( -1.0_r8 ),0.0_r8)) + + carbon_balance = carbon_balance - store_c_flux + store_c = store_c + store_c_flux + + end if + + ! ----------------------------------------------------------------------------------- + ! V. If carbon is still available, prioritize some allocation to replace + ! the rest of the leaf/fineroot deficit + ! carbon balance is guaranteed to be >=0 beyond this point + ! ----------------------------------------------------------------------------------- + + leaf_c_demand = max(0.0_r8,(target_leaf_c - leaf_c)) + fnrt_c_demand = max(0.0_r8,(target_fnrt_c - fnrt_c)) + + total_c_demand = leaf_c_demand + fnrt_c_demand + + if( (carbon_balance > nearzero ) .and. (total_c_demand>nearzero)) then + + leaf_c_flux = min(leaf_c_demand, & + carbon_balance*(leaf_c_demand/total_c_demand)) + carbon_balance = carbon_balance - leaf_c_flux + leaf_c = leaf_c + leaf_c_flux + + fnrt_c_flux = min(fnrt_c_demand, & + carbon_balance*(fnrt_c_demand/total_c_demand)) + carbon_balance = carbon_balance - fnrt_c_flux + fnrt_c = fnrt_c + fnrt_c_flux + + end if + + ! ----------------------------------------------------------------------------------- + ! VI. If carbon is still available, we try to push all live + ! pools back towards allometry. But only upwards, if fusion happened + ! to generate some pools above allometric target, don't reduce the pool, + ! just ignore it until the rest of the plant grows to meet it. + ! ----------------------------------------------------------------------------------- + if( carbon_balance > nearzero ) then + + leaf_below_target = max(target_leaf_c - leaf_c,0.0_r8) + fnrt_below_target = max(target_fnrt_c - fnrt_c,0.0_r8) + sapw_below_target = max(target_sapw_c - sapw_c,0.0_r8) + store_below_target = max(target_store_c - store_c,0.0_r8) + + total_below_target = leaf_below_target + fnrt_below_target + & + sapw_below_target + store_below_target + + if ( total_below_target > nearzero ) then + + if( total_below_target > carbon_balance) then + leaf_c_flux = carbon_balance * leaf_below_target/total_below_target + fnrt_c_flux = carbon_balance * fnrt_below_target/total_below_target + sapw_c_flux = carbon_balance * sapw_below_target/total_below_target + store_c_flux = carbon_balance * store_below_target/total_below_target + else + leaf_c_flux = leaf_below_target + fnrt_c_flux = fnrt_below_target + sapw_c_flux = sapw_below_target + store_c_flux = store_below_target + end if + + carbon_balance = carbon_balance - leaf_c_flux + leaf_c = leaf_c + leaf_c_flux + + carbon_balance = carbon_balance - fnrt_c_flux + fnrt_c = fnrt_c + fnrt_c_flux + + carbon_balance = carbon_balance - sapw_c_flux + sapw_c = sapw_c + sapw_c_flux + + carbon_balance = carbon_balance - store_c_flux + store_c = store_c + store_c_flux + + end if + end if + + ! ----------------------------------------------------------------------------------- + ! VIII. If carbon is still available, replenish the structural pool to get + ! back on allometry + ! ----------------------------------------------------------------------------------- + + if( carbon_balance > nearzero ) then + + struct_below_target = max(target_struct_c - struct_c ,0.0_r8) + + if ( struct_below_target > 0.0_r8) then + + struct_c_flux = min(carbon_balance,struct_below_target) + carbon_balance = carbon_balance - struct_c_flux + struct_c = struct_c + struct_c_flux + + end if + + end if + + ! ----------------------------------------------------------------------------------- + ! IX. If carbon is yet still available ... + ! Our pools are now either on allometry or above (from fusion). + ! We we can increment those pools at or below, + ! including structure and reproduction according to their rates + ! Use an adaptive euler integration. If the error is not nominal, + ! the carbon balance sub-step (deltaC) will be halved and tried again + ! ----------------------------------------------------------------------------------- + + if( carbon_balance > nearzero ) then + + ! This routine checks that actual carbon is not below that targets. It does + ! allow actual pools to be above the target, and in these cases, it sends + ! a false on the "grow_<>" flag, allowing the plant to grow into these pools. + ! It also checks to make sure that structural biomass is not above the target. + if ( EDPftvarcon_inst%woody(ipft) == itrue ) then + call TargetAllometryCheck(leaf_c, fnrt_c, sapw_c, & + store_c, struct_c, & + target_leaf_c, target_fnrt_c, & + target_sapw_c, target_store_c, target_struct_c, & + grow_leaf, grow_fnrt, grow_sapw, grow_store) + else + grow_leaf = .true. + grow_fnrt = .true. + grow_sapw = .true. + grow_store = .true. + end if + + ! Initialize the adaptive integrator arrays and flags + ! ----------------------------------------------------------------------------------- + ierr = 1 + totalC = carbon_balance + nsteps = 0 + + c_pool(:) = 0.0_r8 + c_mask(:) = .false. + + c_pool(leaf_c_id) = leaf_c + c_pool(fnrt_c_id) = fnrt_c + c_pool(sapw_c_id) = sapw_c + c_pool(store_c_id) = store_c + c_pool(struct_c_id) = struct_c + c_pool(repro_c_id) = repro_c + c_pool(dbh_id) = dbh + + c_mask(leaf_c_id) = grow_leaf + c_mask(fnrt_c_id) = grow_fnrt + c_mask(sapw_c_id) = grow_sapw + c_mask(store_c_id) = grow_store + c_mask(struct_c_id) = .true. ! Always increment dead on growth step + c_mask(repro_c_id) = .true. ! Always calculate reproduction on growth + c_mask(dbh_id) = .true. ! Always increment dbh on growth step + + if(ODESolve == 2) then + this%ode_opt_step = totalC + end if + + do while( ierr .ne. 0 ) + + deltaC = min(totalC,this%ode_opt_step) + if(ODESolve == 1) then + call RKF45(AllomCGrowthDeriv,c_pool,c_mask,deltaC,totalC, & + max_trunc_error,intgr_params,c_pool_out,this%ode_opt_step,step_pass) + + elseif(ODESolve == 2) then + call Euler(AllomCGrowthDeriv,c_pool,c_mask,deltaC,totalC,intgr_params,c_pool_out) + ! step_pass = .true. + call CheckIntegratedAllometries(c_pool_out(dbh_id),ipft,canopy_trim, & + c_pool_out(leaf_c_id), c_pool_out(fnrt_c_id), c_pool_out(sapw_c_id), & + c_pool_out(store_c_id), c_pool_out(struct_c_id), & + c_mask(leaf_c_id), c_mask(fnrt_c_id), c_mask(sapw_c_id), & + c_mask(store_c_id),c_mask(struct_c_id), max_trunc_error, step_pass) + if(step_pass) then + this%ode_opt_step = deltaC + else + this%ode_opt_step = 0.5*deltaC + end if + else + write(fates_log(),*) 'An integrator was chosen that DNE' + write(fates_log(),*) 'ODESolve = ',ODESolve + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + nsteps = nsteps + 1 + + if (step_pass) then ! If true, then step is accepted + totalC = totalC - deltaC + c_pool(:) = c_pool_out(:) + end if + + if(nsteps > max_substeps ) then + write(fates_log(),*) 'Plant Growth Integrator could not find' + write(fates_log(),*) 'a solution in less than ',max_substeps,' tries' + write(fates_log(),*) 'Aborting' + write(fates_log(),*) 'carbon_balance',carbon_balance + write(fates_log(),*) 'deltaC',deltaC + write(fates_log(),*) 'totalC',totalC + write(fates_log(),*) 'leaf:',grow_leaf,target_leaf_c,target_leaf_c - leaf_c + write(fates_log(),*) 'fnrt:',grow_fnrt,target_fnrt_c,target_fnrt_c - fnrt_c + write(fates_log(),*) 'sap:',grow_sapw,target_sapw_c, target_sapw_c - sapw_c + write(fates_log(),*) 'store:',grow_store,target_store_c,target_store_c - store_c + write(fates_log(),*) 'dead:',target_struct_c,target_struct_c - struct_c + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + ! TotalC should eventually be whittled down to near zero + ! At that point, update the actual states + ! -------------------------------------------------------------------------------- + if( (totalC < calloc_abs_error) .and. (step_pass) )then + + ierr = 0 + leaf_c_flux = c_pool(leaf_c_id) - leaf_c + fnrt_c_flux = c_pool(fnrt_c_id) - fnrt_c + sapw_c_flux = c_pool(sapw_c_id) - sapw_c + store_c_flux = c_pool(store_c_id) - store_c + struct_c_flux = c_pool(struct_c_id) - struct_c + repro_c_flux = c_pool(repro_c_id) - repro_c + + ! Make an adjustment to flux partitions to make it match remaining c balance + flux_adj = carbon_balance/(leaf_c_flux+fnrt_c_flux+sapw_c_flux + & + store_c_flux+struct_c_flux+repro_c_flux) + + + leaf_c_flux = leaf_c_flux*flux_adj + fnrt_c_flux = fnrt_c_flux*flux_adj + sapw_c_flux = sapw_c_flux*flux_adj + store_c_flux = store_c_flux*flux_adj + struct_c_flux = struct_c_flux*flux_adj + repro_c_flux = repro_c_flux*flux_adj + + carbon_balance = carbon_balance - leaf_c_flux + leaf_c = leaf_c + leaf_c_flux + + carbon_balance = carbon_balance - fnrt_c_flux + fnrt_c = fnrt_c + fnrt_c_flux + + carbon_balance = carbon_balance - sapw_c_flux + sapw_c = sapw_c + sapw_c_flux + + carbon_balance = carbon_balance - store_c_flux + store_c = store_c + store_c_flux + + carbon_balance = carbon_balance - struct_c_flux + struct_c = struct_c + struct_c_flux + + carbon_balance = carbon_balance - repro_c_flux + repro_c = repro_c + repro_c_flux + + dbh = c_pool(dbh_id) + + ! THESE HAVE TO BE SET OUTSIDE OF THIS ROUTINE + !! cohort%seed_prod = cohort%seed_prod + brepro_flux / hlm_freq_day + !! cohort%dhdt = (h_sub-cohort%hite)/hlm_freq_day + !! cohort%ddbhdt = (dbh_sub-dbh_in)/hlm_freq_day + + if( abs(carbon_balance)>calloc_abs_error ) then + write(fates_log(),*) 'carbon conservation error while integrating pools' + write(fates_log(),*) 'along alometric curve' + write(fates_log(),*) 'carbon_balance = ',carbon_balance,totalC + write(fates_log(),*) 'exiting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + end if + end do + end if + + end associate + + return + end subroutine DailyPRTAC + + ! ===================================================================================== + + function AllomCGrowthDeriv(c_pools,c_mask,cbalance,intgr_params) result(dCdx) + + ! --------------------------------------------------------------------------------- + ! This function calculates the derivatives for the carbon pools + ! relative to the amount of carbon balance. This function is based completely + ! off of allometry, and assumes that there are no other species (ie nutrients) that + ! govern allocation. + ! --------------------------------------------------------------------------------- + + ! Arguments + real(r8),intent(in), dimension(:) :: c_pools ! Vector of carbon pools + ! dbh,leaf,root,sap,store,dead + logical,intent(in), dimension(:) :: c_mask ! logical mask of active pools + ! some may be turned off + real(r8),intent(in) :: cbalance ! The carbon balance of the + ! partial step (independant var) + + real(r8), intent(in),dimension(:) :: intgr_params ! Generic Array used to pass + ! parameters into this function + + + ! Return Value + real(r8),dimension(lbound(c_pools,dim=1):ubound(c_pools,dim=1)) :: dCdx + + ! locals + integer :: ipft ! PFT index + real(r8) :: canopy_trim ! Canopy trimming function (boundary condition [0-1] + real(r8) :: ct_leaf ! target leaf biomass, dummy var (kgC) + real(r8) :: ct_fnrt ! target fine-root biomass, dummy var (kgC) + real(r8) :: ct_sap ! target sapwood biomass, dummy var (kgC) + real(r8) :: ct_agw ! target aboveground wood, dummy var (kgC) + real(r8) :: ct_bgw ! target belowground wood, dummy var (kgC) + real(r8) :: ct_store ! target storage, dummy var (kgC) + real(r8) :: ct_dead ! target structural biomas, dummy var (kgC) + real(r8) :: sapw_area ! dummy sapwood area + real(r8) :: ct_dleafdd ! target leaf biomass derivative wrt d, (kgC/cm) + real(r8) :: ct_dfnrtdd ! target fine-root biomass derivative wrt d, (kgC/cm) + real(r8) :: ct_dsapdd ! target sapwood biomass derivative wrt d, (kgC/cm) + real(r8) :: ct_dagwdd ! target AG wood biomass derivative wrt d, (kgC/cm) + real(r8) :: ct_dbgwdd ! target BG wood biomass derivative wrt d, (kgC/cm) + real(r8) :: ct_dstoredd ! target storage biomass derivative wrt d, (kgC/cm) + real(r8) :: ct_ddeaddd ! target structural biomass derivative wrt d, (kgC/cm) + real(r8) :: ct_dtotaldd ! target total (not reproductive) biomass derivative wrt d, (kgC/cm) + real(r8) :: repro_fraction ! fraction of carbon balance directed towards reproduction (kgC/kgC) + + + associate( dbh => c_pools(dbh_id), & + cleaf => c_pools(leaf_c_id), & + cfnrt => c_pools(fnrt_c_id), & + csap => c_pools(sapw_c_id), & + cstore => c_pools(store_c_id), & + cdead => c_pools(struct_c_id), & + crepro => c_pools(repro_c_id), & ! Unused (memoryless) + mask_dbh => c_mask(dbh_id), & ! Unused (dbh always grows) + mask_leaf => c_mask(leaf_c_id), & + mask_fnrt => c_mask(fnrt_c_id), & + mask_sap => c_mask(sapw_c_id), & + mask_store => c_mask(store_c_id), & + mask_dead => c_mask(struct_c_id), & ! Unused (dead always grows) + mask_repro => c_mask(repro_c_id) ) + + canopy_trim = intgr_params(ac_bc_in_id_ctrim) + ipft = nint(intgr_params(ac_bc_in_id_pft)) + + if(dbh>huge(dbh)) then + print*,"BIG D IN DERIV:",dbh + stop + end if + + call bleaf(dbh,ipft,canopy_trim,ct_leaf,ct_dleafdd) + call bfineroot(dbh,ipft,canopy_trim,ct_fnrt,ct_dfnrtdd) + !call bsap_allom(dbh,ipft,canopy_trim,sapw_area,ct_sap,ct_dsapdd) + call bsap_allom(dbh,ipft,canopy_trim,ct_sap,ct_dsapdd) + call bagw_allom(dbh,ipft,ct_agw,ct_dagwdd) + call bbgw_allom(dbh,ipft,ct_bgw,ct_dbgwdd) + call bdead_allom(ct_agw,ct_bgw, ct_sap, ipft, ct_dead, & + ct_dagwdd, ct_dbgwdd, ct_dsapdd, ct_ddeaddd) + call bstore_allom(dbh,ipft,canopy_trim,ct_store,ct_dstoredd) + + ! fraction of carbon going towards reproduction + if (dbh <= EDPftvarcon_inst%dbh_repro_threshold(ipft)) then ! cap on leaf biomass + repro_fraction = EDPftvarcon_inst%seed_alloc(ipft) + else + repro_fraction = EDPftvarcon_inst%seed_alloc(ipft) + EDPftvarcon_inst%seed_alloc_mature(ipft) + end if + + dCdx = 0.0_r8 + + ct_dtotaldd = ct_ddeaddd + if (mask_leaf) ct_dtotaldd = ct_dtotaldd + ct_dleafdd + if (mask_fnrt) ct_dtotaldd = ct_dtotaldd + ct_dfnrtdd + if (mask_sap) ct_dtotaldd = ct_dtotaldd + ct_dsapdd + if (mask_store) ct_dtotaldd = ct_dtotaldd + ct_dstoredd + + ! It is possible that with some asymptotic, or hard + ! capped allometries, that all growth rates reach zero. + ! In this case, if there is carbon, give it to reproduction + + if(ct_dtotaldd<=tiny(ct_dtotaldd))then + + dCdx(struct_c_id) = 0.0_r8 + dCdx(dbh_id) = 0.0_r8 + dCdx(leaf_c_id) = 0.0_r8 + dCdx(fnrt_c_id) = 0.0_r8 + dCdx(sapw_c_id) = 0.0_r8 + dCdx(store_c_id) = 0.0_r8 + dCdx(repro_c_id) = 1.0_r8 + + else + + dCdx(struct_c_id) = (ct_ddeaddd/ct_dtotaldd)*(1.0_r8-repro_fraction) + dCdx(dbh_id) = (1.0_r8/ct_dtotaldd)*(1.0_r8-repro_fraction) + + if (mask_leaf) then + dCdx(leaf_c_id) = (ct_dleafdd/ct_dtotaldd)*(1.0_r8-repro_fraction) + else + dCdx(leaf_c_id) = 0.0_r8 + end if + + if (mask_fnrt) then + dCdx(fnrt_c_id) = (ct_dfnrtdd/ct_dtotaldd)*(1.0_r8-repro_fraction) + else + dCdx(fnrt_c_id) = 0.0_r8 + end if + + if (mask_sap) then + dCdx(sapw_c_id) = (ct_dsapdd/ct_dtotaldd)*(1.0_r8-repro_fraction) + else + dCdx(sapw_c_id) = 0.0_r8 + end if + + if (mask_store) then + dCdx(store_c_id) = (ct_dstoredd/ct_dtotaldd)*(1.0_r8-repro_fraction) + else + dCdx(store_c_id) = 0.0_r8 + end if + + dCdx(repro_c_id) = repro_fraction + + end if + + end associate + + return + end function AllomCGrowthDeriv + + ! ==================================================================================== + + subroutine TargetAllometryCheck(bleaf,bfroot,bsap,bstore,bdead, & + bt_leaf,bt_froot,bt_sap,bt_store,bt_dead, & + grow_leaf,grow_froot,grow_sapw,grow_store) + + ! Arguments + real(r8),intent(in) :: bleaf !actual + real(r8),intent(in) :: bfroot + real(r8),intent(in) :: bsap + real(r8),intent(in) :: bstore + real(r8),intent(in) :: bdead + real(r8),intent(in) :: bt_leaf !target + real(r8),intent(in) :: bt_froot + real(r8),intent(in) :: bt_sap + real(r8),intent(in) :: bt_store + real(r8),intent(in) :: bt_dead + logical,intent(out) :: grow_leaf !growth flag + logical,intent(out) :: grow_froot + logical,intent(out) :: grow_sapw + logical,intent(out) :: grow_store + + if( (bt_leaf - bleaf)>calloc_abs_error) then + write(fates_log(),*) 'leaves are not on-allometry at the growth step' + write(fates_log(),*) 'exiting',bleaf,bt_leaf + call endrun(msg=errMsg(sourcefile, __LINE__)) + elseif( (bleaf - bt_leaf)>calloc_abs_error) then + ! leaf is above allometry, ignore + grow_leaf = .false. + else + grow_leaf = .true. + end if + + if( (bt_froot - bfroot)>calloc_abs_error) then + write(fates_log(),*) 'fineroots are not on-allometry at the growth step' + write(fates_log(),*) 'exiting',bfroot, bt_froot + call endrun(msg=errMsg(sourcefile, __LINE__)) + elseif( ( bfroot-bt_froot)>calloc_abs_error ) then + grow_froot = .false. + else + grow_froot = .true. + end if + + if( (bt_sap - bsap)>calloc_abs_error) then + write(fates_log(),*) 'sapwood is not on-allometry at the growth step' + write(fates_log(),*) 'exiting',bsap, bt_sap + call endrun(msg=errMsg(sourcefile, __LINE__)) + elseif( ( bsap-bt_sap)>calloc_abs_error ) then + grow_sapw = .false. + else + grow_sapw = .true. + end if + + if( (bt_store - bstore)>calloc_abs_error) then + write(fates_log(),*) 'storage is not on-allometry at the growth step' + write(fates_log(),*) 'exiting',bstore,bt_store + call endrun(msg=errMsg(sourcefile, __LINE__)) + elseif( ( bstore-bt_store)>calloc_abs_error ) then + grow_store = .false. + else + grow_store = .true. + end if + + if( (bt_dead - bdead)>calloc_abs_error) then + write(fates_log(),*) 'structure not on-allometry at the growth step' + write(fates_log(),*) 'exiting',bdead,bt_dead + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + end subroutine TargetAllometryCheck + + ! ===================================================================================== + + subroutine FastPRTAC(this) + + implicit none + class(callom_prt_vartypes) :: this ! this class + + ! This routine does nothing, because in the carbon only allometric RT model + ! we currently don't have any fast-timestep processes + ! Think of this as a stub. + + + + + + return + end subroutine FastPRTAC + + +end module PRTAllometricCarbonMod + diff --git a/parteh/PRTGenericMod.F90 b/parteh/PRTGenericMod.F90 new file mode 100644 index 0000000000..847c257cdb --- /dev/null +++ b/parteh/PRTGenericMod.F90 @@ -0,0 +1,1101 @@ +module PRTGenericMod + + ! ------------------------------------------------------------------------------------ + ! Plant Allocation and Reactive Transport (PART) + + ! Extensible Hypotheses (EH) = PARTEH + ! + ! Non-Specific (Generic) Classes and Functions + ! This contains the base classes for both the variables and the "instance" + ! This also contains science relevent procedures that are agnostic of hypothesis + ! such as maintenance turnover and restranslocation. + ! + ! Ryan Knox, April 2018 + ! + ! ------------------------------------------------------------------------------------ + + ! TO-DO: Impose a parameter check function + ! 1 item: reproduction must be priority 0 in CNP + + + use FatesConstantsMod, only : r8 => fates_r8 + use FatesConstantsMod, only : i4 => fates_int + use FatesConstantsMod, only : nearzero + use FatesGlobals , only : endrun => fates_endrun + use FatesGlobals , only : fates_log + use EDPftvarcon , only : EDPftvarcon_inst + use shr_log_mod , only : errMsg => shr_log_errMsg + use FatesInterfaceMod, only : hlm_freq_day + + implicit none + + integer, parameter :: maxlen_varname = 128 + integer, parameter :: maxlen_varsymbol = 16 + integer, parameter :: maxlen_varunits = 32 + integer, parameter :: len_baseunit = 6 + + ! SEND THESE TO CONSTANTS + + ! We use this parameter as the value for which we set un-initialized values + real(r8), parameter :: 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 + + + ! ------------------------------------------------------------------------------------- + ! IMPORTANT! + ! All species in all organs should be expressed in terms of KILOGRAMS + ! All rates of change are expressed in terms of kilorams / day + ! This assumption cannot be broken! + ! ------------------------------------------------------------------------------------- + + character(len=len_baseunit), parameter :: mass_unit = 'kg' + character(len=len_baseunit), parameter :: mass_rate_unit = 'kg/day' + + ! ------------------------------------------------------------------------------------- + ! Organ types + ! These are public indices used to map the organs + ! 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 + + ! ------------------------------------------------------------------------------------- + ! Species types + ! These are public indices used to map the species in each hypothesis + ! to the species that are acknowledged in the calling model + ! ------------------------------------------------------------------------------------- + + integer, parameter :: num_species_types = 17 ! Total number of unique species + ! curently recognized by PARTEH + ! should be max index in list below + + ! The following list of unique public indices should be monotonic, and self-explanatory + + integer, parameter :: all_carbon_species = 0 + integer, parameter :: carbon12_species = 1 + integer, parameter :: carbon13_species = 2 + integer, parameter :: carbon14_species = 3 + integer, parameter :: nitrogen_species = 4 + integer, parameter :: phosphorous_species = 5 + integer, parameter :: potassium_species = 6 + integer, parameter :: calcium_species = 7 + integer, parameter :: magnesium_species = 8 + integer, parameter :: sulfur_species = 9 + integer, parameter :: chlorine_species = 10 + integer, parameter :: iron_species = 11 + integer, parameter :: manganese_species = 12 + integer, parameter :: zinc_species = 13 + integer, parameter :: copper_species = 14 + integer, parameter :: boron_species = 15 + integer, parameter :: molybdenum_species = 16 + integer, parameter :: nickel_species = 17 + + + ! We have some lists of species or lists of organs, such as + ! a list of all carbon species. 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 + ! carbon species is the biggest list + ! right now + + + ! List of all carbon species, the special index "all_carbon_species" + ! implies the following list of carbon organs + + integer, parameter, dimension(3) :: carbon_species = & + [carbon12_species, carbon13_species, carbon14_species] + + + ! The following index specifies the maximum number of unique variables + ! that could be described by any unique species x organ combination. In most + ! scenarios, this is simply 1. But for example, one may want multiple leaf + ! layers, each representing carbon 12. Setting this maximum high + ! will not have a substantial impact on the memory footprint, and it will + ! not have an effect on loop sizes because looping bounds are variables. + + integer, parameter :: max_types_per_sp_organ = 1 + + + ! ------------------------------------------------------------------------------------- + ! This is a generic variable type that can be used to describe all + ! species x organ variable combinations. + ! Note that dvaldt does NOT subsume turnover. tunover happens outside the main + ! allocation modules. dvaldt only contains transport, translocation (cross-organ only) + ! growth and reactions. + ! ------------------------------------------------------------------------------------- + + type prt_vartype + + real(r8),allocatable :: val(:) ! Instantaneous state variable [kg] + real(r8),allocatable :: val0(:) ! State variable at the beginning + ! of allocation step [kg] + real(r8),allocatable :: dvaldt(:) ! Net rate of non-turnover change [kg/day] + real(r8),allocatable :: turnover(:) ! Loss rate due to turnover [kg/day] + + ! Placeholder + ! To save on memory, keep this commented out, or simply + ! add this only in the extension ... ? + ! real(r8),dimension(3) :: coordinate ! NOTE FOR QUERYING, INTEGERS ARE BETTER + + integer :: num_pos ! Number of pools with own position per species x organ + + + end type prt_vartype + + + ! ------------------------------------------------------------------------------------- + ! Input boundary conditions + ! ------------------------------------------------------------------------------------- + + type prt_bctype + + real(r8), pointer :: rval + integer, pointer :: ival + + end type prt_bctype + + + ! ------------------------------------------------------------------------------------- + ! This generic type defines the whole set of a plants species and organs + ! It also has arrays which are used to organize the species and organs into + ! commonly used groups so that the variables can be presented to other + ! routines in the model efficienty (such as history output, or assessing cohort + ! indices like LAI, lai-memory, etc, etc) + ! There are procedures that are specialized for each module. And then + ! there are procedures that are supposed to be generic and should support + ! all the different modules. + ! ------------------------------------------------------------------------------------- + + type prt_vartypes + + type(prt_vartype),allocatable :: variables(:) + 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 + + ! Note this is allocated only once per node/instance + ! This really is just a pointer, not an allocatable pointer + type(prt_instance_type), pointer :: prt_instance + + contains + + ! These are extendable procedures that have specialized + ! content in each of the different hypotheses + procedure :: InitAllocate => InitAllocateBase + procedure :: DailyPRT => DailyPRTBase + procedure :: FastPRT => FastPRTBase + + ! These are generic functions that should work on all hypotheses + + procedure, non_overridable :: InitPRTVartype + procedure, non_overridable :: FlushBCs + procedure, non_overridable :: InitializeInitialConditions + procedure, non_overridable :: CheckInitialConditions + procedure, non_overridable :: RegisterBCIn + procedure, non_overridable :: RegisterBCOut + procedure, non_overridable :: RegisterBCInout + procedure, non_overridable :: GetState + procedure, non_overridable :: GetTurnover + procedure, non_overridable :: ZeroRates + + procedure, non_overridable :: MaintTurnover + procedure, non_overridable :: MaintTurnoverSimpleRetranslocation + + end type prt_vartypes + + ! ------------------------------------------------------------------------------------- + ! This next section contains that types that describe the whole instance. These are + ! things that map the variable types themselves from one model to the next, or help + ! decribe the arbitrary variables. These are not instanced on every plant, they are + ! instanced on every model instance. + ! ------------------------------------------------------------------------------------- + + ! ------------------------------------------------------------------------------------- + ! This type simply packs the names and symbols associated with all + ! the variables for any given hypothesis + ! ------------------------------------------------------------------------------------- + + type :: state_descriptor_type + character(len=maxlen_varname) :: longname + character(len=maxlen_varsymbol) :: symbol + integer :: organ_id ! global id for organ + integer :: spec_id ! global id for species + + ! Also, will probably need flags to define different types of groups that this variable + ! belongs too, which will control things like fusion, normalization, when to zero, etc... + + end type state_descriptor_type + + + ! This structure packs both the mapping structure and the variable descriptors + ! -------------------------------------------------------------------------------------- + ! This array should contain the lists of indices to + ! the species x organ variable structure that is used to map variables to the outside + ! world. + ! + ! + ! | carbon | nitrogen | phosphorous | .... | + ! ------------------------------------------ + ! leaf | | | | | + ! fine-root | | | | | + ! sapwood | | | | | + ! storage | | | | | + ! reproduction | | | | | + ! structure | | | | | + ! .... | | | | | + ! ------------------------------------------ + ! + ! ------------------------------------------------------------------------------------- + + type prt_instance_type + + ! Note that index 0 is reserved for "all" or "irrelevant" + character(len=maxlen_varname) :: hyp_name + integer, dimension(0:num_organ_types,0:num_species_types) :: sp_organ_map + type(state_descriptor_type), allocatable :: state_descriptor(:) + + contains + + procedure, non_overridable :: ZeroInstance + procedure, non_overridable :: InitInstance + + end type prt_instance_type + + +contains + + ! ===================================================================================== + ! Module Functions and Subroutines + ! ===================================================================================== + + subroutine ZeroInstance(this) + + class(prt_instance_type) :: this + + integer :: ip ! Organ loop counter + integer :: is ! Species loop counter + + ! First zero out the array + do ip = 1,num_organ_types + do is = 1,num_species_types + this%sp_organ_map(ip,is) = 0 + end do + end do + + return + end subroutine ZeroInstance + + ! ===================================================================================== + + subroutine InitInstance(this, var_id, long_name, symbol, organ_id, spec_id) + + class(prt_instance_type) :: this + integer, intent(in) :: var_id + character(len=*),intent(in) :: long_name + character(len=*),intent(in) :: symbol + integer, intent(in) :: organ_id + integer, intent(in) :: spec_id + + ! Set the descriptions and the associated organs/species in the variable's + ! own array + + this%state_descriptor(var_id)%longname = long_name + this%state_descriptor(var_id)%symbol = symbol + this%state_descriptor(var_id)%organ_id = organ_id + this%state_descriptor(var_id)%spec_id = spec_id + + ! Set the mapping tables for the external model + + this%sp_organ_map(organ_id,spec_id) = var_id + + + return + end subroutine InitInstance + + ! ===================================================================================== + + subroutine InitPRTVartype(this) + + class(prt_vartypes) :: this + + + ! This subroutine should be the first call whenever a prt_vartype object is + ! instantiated. This routine handles the allocation (extended procedure) + ! and then the initializing of states with bogus information, and then + ! the flushing of all boundary conditions to null. + + call this%InitAllocate() + call this%InitializeInitialConditions() + call this%FlushBCs() + + + return + end subroutine InitPRTVartype + + ! ===================================================================================== + + subroutine InitializeInitialConditions(this) + + class(prt_vartypes) :: this + + integer :: num_vars + integer :: i_var + + num_vars = size(this%variables,1) + + do i_var = 1, num_vars + this%variables(i_var)%val(:) = un_initialized + this%variables(i_var)%val0(:) = un_initialized + this%variables(i_var)%turnover(:) = un_initialized + this%variables(i_var)%dvaldt(:) = un_initialized + end do + + + return + end subroutine InitializeInitialConditions + + + ! ============================================================= + + subroutine CheckInitialConditions(this) + + ! This subroutine is called for every variable defined in each specific + ! hypothesis. The global index for the specific hypothesis' variable + ! will be provided as the second argument. + + class(prt_vartypes) :: this + + integer :: n_vars ! Number of variables + integer :: i_var ! index for iterating variables + integer :: n_cor_ids ! Number of coordinate ids + integer :: i_cor ! index for iterating coordinate dimension + integer :: i_gorgan ! The global organ id for this variable + integer :: i_gspecies ! The global species id for this variable + + n_vars = size(this%variables,1) + + do i_var = 1, n_vars + + n_cor_ids = size(this%variables(i_var)%val,1) + + do i_cor = 1, n_cor_ids + + if(this%variables(i_var)%val(i_cor) < check_initialized) then + + i_gorgan = this%prt_instance%state_descriptor(i_var)%organ_id + i_gspecies = this%prt_instance%state_descriptor(i_var)%spec_id + + write(fates_log(),*)'Not all initial conditions for state variables' + write(fates_log(),*)' in PRT hypothesis: ',trim(this%prt_instance%hyp_name) + write(fates_log(),*)' were written out.' + write(fates_log(),*)' i_var: ',i_var + write(fates_log(),*)' i_cor: ',i_cor + write(fates_log(),*)' organ_id:',i_gorgan + write(fates_log(),*)' species_id',i_gspecies + write(fates_log(),*)'Exiting' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + end do + end do + + return + end subroutine CheckInitialConditions + + ! ===================================================================================== + + subroutine FlushBCs(this) + + ! Boundary conditions are pointers to real's and integers in the calling model. + ! To flush these, we set all pointers to null + + ! Arguments + class(prt_vartypes) :: this + + ! Local + integer :: num_bc_in + integer :: num_bc_out + integer :: num_bc_inout + integer :: i + + if(allocated(this%bc_in))then + num_bc_in = size(this%bc_in,1) + do i = 1,num_bc_in + this%bc_in(i)%rval => null() + this%bc_in(i)%ival => null() + end do + end if + + if(allocated(this%bc_out))then + num_bc_out = size(this%bc_out,1) + do i = 1,num_bc_out + this%bc_out(i)%rval => null() + this%bc_out(i)%ival => null() + end do + end if + + if(allocated(this%bc_inout))then + num_bc_inout = size(this%bc_inout,1) + do i = 1,num_bc_inout + this%bc_inout(i)%rval => null() + this%bc_inout(i)%ival => null() + end do + end if + + return + end subroutine FlushBCs + + ! ===================================================================================== + + subroutine RegisterBCIn(this,bc_id, bc_rval, bc_ival ) + + + ! This subroutine should be called once when PARTEH + ! object that is bound to the plant object is first intantiated. + ! Unless there is some reason the boundary condition pointers + ! are changing. + + + ! Input Arguments + + class(prt_vartypes) :: this + integer,intent(in) :: bc_id + real(r8),optional, intent(inout), target :: bc_rval + integer, optional, intent(inout), target :: bc_ival + + if(present(bc_ival)) then + this%bc_in(bc_id)%ival => bc_ival + end if + + if(present(bc_rval)) then + this%bc_in(bc_id)%rval => bc_rval + end if + + + return + end subroutine RegisterBCIn + + + ! ===================================================================================== + + + subroutine CopyPRTVartypes(this, donor_prt_obj) + + ! Arguments + class(prt_vartypes) :: this + type(prt_vartypes), intent(in), pointer :: donor_prt_obj + + ! Locals + + integer :: i_var ! loop iterator for variable objects + integer :: i_bc ! loop iterator for boundary pointers + + integer :: n_vars + integer :: num_bc_in + integer :: num_bc_inout + integer :: num_bc_out + + ! Here we copy over all information from a donor_prt_object into the current PRT + ! object. It is assumed that the current PRT object + ! has already bee initialized ( ie. InitAllocate() ) + ! variable val0 is omitted, because it is ephemeral and used only during the + ! allocation process + + n_vars = size(donor_prt_obj%variables,1) + + do i_var = 1, n_vars + this%variables(i_var)%val(:) = donor_prt_obj%variables(i_var)%val(:) + this%variables(i_var)%dvaldt(:) = donor_prt_obj%variables(i_var)%dvaldt(:) + this%variables(i_var)%turnover(:) = donor_prt_obj%variables(i_var)%turnover(:) + end do + + if(allocated(this%bc_in))then + num_bc_in = size(this%bc_in,1) + do i_bc = 1, num_bc_in + this%bc_in(i_bc)%ival => donor_prt_obj%bc_in(i_bc)%ival + this%bc_in(i_bc)%rval => donor_prt_obj%bc_in(i_bc)%rval + end do + end if + + if(allocated(this%bc_out))then + num_bc_out = size(this%bc_out,1) + do i_bc = 1, num_bc_out + this%bc_out(i_bc)%ival => donor_prt_obj%bc_out(i_bc)%ival + this%bc_out(i_bc)%rval => donor_prt_obj%bc_out(i_bc)%rval + end do + end if + + if(allocated(this%bc_inout))then + num_bc_inout = size(this%bc_inout,1) + do i_bc = 1, num_bc_inout + this%bc_inout(i_bc)%ival => donor_prt_obj%bc_inout(i_bc)%ival + this%bc_inout(i_bc)%rval => donor_prt_obj%bc_inout(i_bc)%rval + end do + end if + + this%ode_opt_step = donor_prt_obj%ode_opt_step + + this%prt_instance => donor_prt_obj%prt_instance + + + return + end subroutine CopyPRTVartypes + + + ! ===================================================================================== + + subroutine WeightedFusePRTVartypes(this,donor_prt_obj, recipient_fuse_weight, position_id) + + ! This subroutine fuses two PRT objects together based on a fusion weighting + ! assigned for the recipient (the class calling this) + + ! Arguments + class(prt_vartypes) :: this + type(prt_vartypes), intent(in), pointer :: donor_prt_obj + real(r8),intent(in) :: recipient_fuse_weight ! This is the weighting + ! for the recipient + integer,intent(in),optional :: position_id + + ! Locals + integer :: n_vars ! Number of variables + integer :: i_var ! Loop iterator over variables + integer :: pos_id ! coordinate id (defaults to 1) + + n_vars = size(this%variables,1) + + if(present(position_id)) then + pos_id = position_id + else + pos_id = 1 + end if + + do i_var = 1, n_vars + this%variables(i_var)%val(pos_id) = recipient_fuse_weight * this%variables(i_var)%val(pos_id) + & + (1.0_r8-recipient_fuse_weight) * donor_prt_obj%variables(i_var)%val(pos_id) + + this%variables(i_var)%val0(pos_id) = recipient_fuse_weight * this%variables(i_var)%val0(pos_id) + & + (1.0_r8-recipient_fuse_weight) * donor_prt_obj%variables(i_var)%val0(pos_id) + + this%variables(i_var)%dvaldt(pos_id) = recipient_fuse_weight * this%variables(i_var)%dvaldt(pos_id) + & + (1.0_r8-recipient_fuse_weight) * donor_prt_obj%variables(i_var)%dvaldt(pos_id) + + this%variables(i_var)%turnover(pos_id) = recipient_fuse_weight * this%variables(i_var)%turnover(pos_id) + & + (1.0_r8-recipient_fuse_weight) * donor_prt_obj%variables(i_var)%turnover(pos_id) + end do + + this%ode_opt_step = recipient_fuse_weight * this%ode_opt_step + & + (1.0_r8-recipient_fuse_weight) * donor_prt_obj%ode_opt_step + + + return + end subroutine WeightedFusePRTVartypes + + ! ===================================================================================== + + subroutine DeallocatePRTVartypes(this) + + class(prt_vartypes) :: this + + integer :: n_vars + integer :: i_var + + n_vars = size(this%variables,1) + + do i_var = 1, n_vars + deallocate(this%variables(i_var)%val) + deallocate(this%variables(i_var)%val0) + deallocate(this%variables(i_var)%dvaldt) + deallocate(this%variables(i_var)%turnover) + end do + + deallocate(this%variables) + + if(allocated(this%bc_in))then + deallocate(this%bc_in) + end if + + if(allocated(this%bc_out))then + deallocate(this%bc_out) + end if + + if(allocated(this%bc_inout))then + deallocate(this%bc_inout) + end if + + this%ode_opt_step = -9.0e10_r8 + + this%prt_instance => null() + + return + end subroutine DeallocatePRTVartypes + + ! ===================================================================================== + + subroutine RegisterBCOut(this,bc_id, bc_rval, bc_ival ) + + ! Input Arguments + + class(prt_vartypes) :: this + integer,intent(in) :: bc_id + real(r8), optional, intent(inout),target :: bc_rval + integer, optional, intent(inout),target :: bc_ival + + if(present(bc_ival)) then + this%bc_out(bc_id)%ival => bc_ival + end if + + if(present(bc_rval)) then + this%bc_out(bc_id)%rval => bc_rval + end if + + return + end subroutine RegisterBCOut + + ! ===================================================================================== + + subroutine RegisterBCInOut(this,bc_id, bc_rval, bc_ival ) + + ! Input Arguments + + class(prt_vartypes) :: this + integer,intent(in) :: bc_id + real(r8), optional, intent(inout),target :: bc_rval + integer, optional, intent(inout),target :: bc_ival + + if(present(bc_ival)) then + this%bc_inout(bc_id)%ival => bc_ival + end if + + if(present(bc_rval)) then + this%bc_inout(bc_id)%rval => bc_rval + end if + + return + end subroutine RegisterBCInOut + + + ! ===================================================================================== + + subroutine ZeroRates(this) + + class(prt_vartypes) :: this + + integer :: n_vars + integer :: ivar + + n_vars = size(this%variables,1) + do ivar = 1,n_vars + this%variables(ivar)%dvaldt(:) = 0.0_r8 + this%variables(ivar)%turnover(:) = 0.0_r8 + end do + + end subroutine ZeroRates + + ! ==================================================================================== + + function GetState(this, organ_id, species_id, position_id) result(sp_organ_val) + + + ! THIS CODE IS VERY INEFFICIENT RIGHT NOW + + + class(prt_vartypes) :: this + integer,intent(in) :: organ_id + integer,intent(in) :: species_id + integer,intent(in),optional :: position_id + real(r8) :: sp_organ_val + + integer :: pos_id + integer :: ispec + integer :: num_species + integer,dimension(max_spec_per_group) :: spec_ids + integer :: index + + sp_organ_val = 0.0_r8 + + if(species_id == all_carbon_species) then + spec_ids(1:3) = carbon_species(1:3) + num_species = 3 + else + num_species = 1 + spec_ids(1) = species_id + end if + + if(present(position_id)) then + pos_id = position_id + + do ispec = 1,num_species + index = this%prt_instance%sp_organ_map(organ_id,spec_ids(ispec)) + if(index>0) sp_organ_val = sp_organ_val + this%variables(index)%val(pos_id) + end do + + else + + do ispec = 1,num_species + + index = this%prt_instance%sp_organ_map(organ_id,spec_ids(ispec)) + if(index>0)then + + do pos_id = 1, this%variables(index)%num_pos + sp_organ_val = sp_organ_val + this%variables(index)%val(pos_id) + end do + end if + + end do + + end if + + return + end function GetState + + + ! ==================================================================================== + + + function GetTurnover(this, organ_id, species_id, position_id) result(sp_organ_turnover) + + + ! THIS CODE IS VERY INEFFICIENT RIGHT NOW + + + class(prt_vartypes) :: this + integer,intent(in) :: organ_id + integer,intent(in) :: species_id + integer,intent(in),optional :: position_id + real(r8) :: sp_organ_turnover + + integer :: pos_id + integer :: ispec + integer :: num_species + integer,dimension(max_spec_per_group) :: spec_ids + integer :: index + + sp_organ_turnover = 0.0_r8 + + if(species_id == all_carbon_species) then + spec_ids(1:3) = carbon_species(1:3) + num_species = 3 + else + num_species = 1 + spec_ids(1) = species_id + end if + + if(present(position_id)) then + pos_id = position_id + + do ispec = 1,num_species + index = this%prt_instance%sp_organ_map(organ_id,spec_ids(ispec)) + if(index>0) sp_organ_turnover = sp_organ_turnover + & + this%variables(index)%turnover(pos_id) + end do + + else + + do ispec = 1,num_species + index = this%prt_instance%sp_organ_map(organ_id,spec_ids(ispec)) + if(index>0) then + do pos_id = 1, this%variables(index)%num_pos + sp_organ_turnover = sp_organ_turnover + this%variables(index)%turnover(pos_id) + end do + end if + + end do + + end if + + return + end function GetTurnover + + ! ===================================================================================== + + function GetCoordVal(this, organ_id, species_id ) result(prt_val) + + class(prt_vartypes) :: this + integer,intent(in) :: organ_id + integer,intent(in) :: species_id + real(r8) :: prt_val + + write(fates_log(),*)'Init must be extended by a child class.' + call endrun(msg=errMsg(__FILE__, __LINE__)) + + end function GetCoordVal + + + ! ==================================================================================== + + subroutine InitAllocateBase(this) + + class(prt_vartypes) :: this + + write(fates_log(),*)'Init must be extended by a child class.' + call endrun(msg=errMsg(__FILE__, __LINE__)) + + end subroutine InitAllocateBase + + ! ==================================================================================== + + subroutine DailyPRTBase(this) + + class(prt_vartypes) :: this + + write(fates_log(),*)'Daily PRT Allocation must be extended' + call endrun(msg=errMsg(__FILE__, __LINE__)) + + end subroutine DailyPRTBase + + ! ==================================================================================== + + subroutine FastPRTBase(this) + + class(prt_vartypes) :: this + + write(fates_log(),*)'FastReactiveTransport must be extended by a child class.' + call endrun(msg=errMsg(__FILE__, __LINE__)) + + end subroutine FastPRTBase + + ! ==================================================================================== + + + subroutine SetState(prt,organ_id, species_id, state_val, position_id) + + ! CONSIDER INTERFACING THIS AND CALLING DIFFERENT SUBROUTINES BY POINTER + + class(prt_vartypes) :: prt + integer,intent(in) :: organ_id + integer,intent(in) :: species_id + real(r8),intent(in) :: state_val + integer,intent(in),optional :: position_id + + + integer :: ispec + integer :: n_vars + integer,dimension(max_spec_per_group) :: spec_ids + integer :: ivar + integer :: index + integer :: pos_id + + if(species_id == all_carbon_species) then + write(fates_log(),*) 'You cannot set the state of all isotopes simultaneously.' + write(fates_log(),*) 'You can only set 1. Exiting.' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + if( present(position_id) ) then + pos_id = position_id + else + pos_id = 1 + end if + + + index = prt%prt_instance%sp_organ_map(organ_id,species_id) + + if(pos_id>prt%variables(index)%num_pos)then + write(fates_log(),*) 'A position index was specified that is' + write(fates_log(),*) 'greater than the allocated position space' + write(fates_log(),*) ' pos_id: ',pos_id + write(fates_log(),*) ' num_pos: ',prt%variables(index)%num_pos + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + + if(index>0) then + prt%variables(index)%val(pos_id) = state_val + else + write(fates_log(),*) 'A mass was sent to PARTEH to over-write' + write(fates_log(),*) ' a pool with a specie x organ combination. ' + write(fates_log(),*) ' that does not exist.' + write(fates_log(),*) ' organ_id:',organ_id + write(fates_log(),*) ' species_id:',species_id + write(fates_log(),*) 'Exiting' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + + return + end subroutine SetState + + + + + ! ==================================================================================== + + + subroutine MaintTurnover(this,ipft) + + ! --------------------------------------------------------------------------------- + ! Generic subroutine (wrapper) calling specialized routines handling + ! the turnover of tissues in living plants (non-mortal) + ! --------------------------------------------------------------------------------- + class(prt_vartypes) :: this + integer,intent(in) :: ipft + + if ( int(EDPftvarcon_inst%turnover_retrans_mode(ipft)) == 1 ) then + call this%MaintTurnoverSimpleRetranslocation(ipft) + else + write(fates_log(),*) 'A maintenance/retranslocation mode was specified' + write(fates_log(),*) 'that is unknown.' + write(fates_log(),*) 'turnover_retrans_mode= ',EDPftvarcon_inst%turnover_retrans_mode(ipft) + write(fates_log(),*) 'pft = ',ipft + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + return + end subroutine MaintTurnover + + ! =================================================================================== + + subroutine MaintTurnoverSimpleRetranslocation(this,ipft) + + ! --------------------------------------------------------------------------------- + ! This subroutine removes biomass from all applicable pools due to + ! "maintenance turnover". Maintenance turnover, in this context + ! is the loss of biomass on living plants, due to continuous turnover. + ! + ! Notes: + ! 1) It is assumed that this is called daily. + ! 2) This is a completely different thing compared to deciduous leaf drop, + ! or loss of biomass from the death of the plant. + ! 3) Since this is maintenance turnover, and not a complete drop of leaves for + ! deciduous trees, we just re-translocate nutrients (if necessary) from the + ! leaves and roots that leave (no pun intended), into the leaves and roots that + ! are still rooted to the plant (pun intended). For deciduous, event-based + ! phenology, we will re-translocate to the storage pool. + ! --------------------------------------------------------------------------------- + + class(prt_vartypes) :: this + integer,intent(in) :: ipft + + + integer :: i_var + integer :: spec_id + integer :: organ_id + integer :: num_sp_vars + integer :: pos_id + + real(r8) :: base_turnover + real(r8) :: leaf_turnover + real(r8) :: fnrt_turnover + real(r8) :: sapw_turnover + real(r8) :: store_turnover + real(r8) :: struct_turnover + real(r8) :: repro_turnover + real(r8) :: turnover ! A temp for the actual turnover removed from pool + real(r8) :: retrans ! A temp for the actual re-translocated mass + + num_sp_vars = size(this%variables,1) + + ! ----------------------------------------------------------------------------------- + ! Calculate the turnover rates + ! ----------------------------------------------------------------------------------- + + if ( EDPftvarcon_inst%branch_turnover(ipft) > nearzero ) then + sapw_turnover = hlm_freq_day / EDPftvarcon_inst%branch_turnover(ipft) + struct_turnover = hlm_freq_day / EDPftvarcon_inst%branch_turnover(ipft) + store_turnover = hlm_freq_day / EDPftvarcon_inst%branch_turnover(ipft) + else + sapw_turnover = 0.0_r8 + struct_turnover = 0.0_r8 + store_turnover = 0.0_r8 + + end if + if ( EDPftvarcon_inst%root_long(ipft) > nearzero ) then + fnrt_turnover = hlm_freq_day / EDPftvarcon_inst%root_long(ipft) + else + fnrt_turnover = 0.0_r8 + end if + if ( (EDPftvarcon_inst%leaf_long(ipft) > nearzero ) .and. & + (EDPftvarcon_inst%evergreen(ipft) == 1) ) then + leaf_turnover = hlm_freq_day / EDPftvarcon_inst%leaf_long(ipft) + else + leaf_turnover = 0.0_r8 + endif + + repro_turnover = 0.0_r8 + + do i_var = 1, num_sp_vars + + organ_id = this%prt_instance%state_descriptor(i_var)%organ_id + spec_id = this%prt_instance%state_descriptor(i_var)%spec_id + + select case(organ_id) + case(leaf_organ) + + base_turnover = leaf_turnover + if ( any(spec_id == carbon_species) ) then + retrans = 0.0_r8 + else if( spec_id == nitrogen_species ) then + retrans = EDPftvarcon_inst%turnover_retrans_leaf_n_p1(ipft) + else if( spec_id == phosphorous_species ) then + retrans = EDPftvarcon_inst%turnover_retrans_leaf_p_p1(ipft) + else + write(fates_log(),*) 'Please add a new re-translocation clause to your ' + write(fates_log(),*) ' organ x species combination' + write(fates_log(),*) ' organ: ',leaf_organ,' species: ',spec_id + write(fates_log(),*) 'Exiting' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + case(fnrt_organ) + + base_turnover = fnrt_turnover + if ( any(spec_id == carbon_species) ) then + retrans = 0.0_r8 + else if( spec_id == nitrogen_species ) then + retrans = EDPftvarcon_inst%turnover_retrans_fnrt_n_p1(ipft) + else if( spec_id == phosphorous_species ) then + retrans = EDPftvarcon_inst%turnover_retrans_fnrt_p_p1(ipft) + else + write(fates_log(),*) 'Please add a new re-translocation clause to your ' + write(fates_log(),*) ' organ x species combination' + write(fates_log(),*) ' organ: ',leaf_organ,' species: ',spec_id + write(fates_log(),*) 'Exiting' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + case(sapw_organ) + base_turnover = sapw_turnover + retrans = 0.0_r8 + case(store_organ) + base_turnover = store_turnover + retrans = 0.0_r8 + case(struct_organ) + base_turnover = struct_turnover + retrans = 0.0_r8 + case(repro_organ) + base_turnover = repro_turnover + retrans = 0.0_r8 + case default + write(fates_log(),*) 'Strange organ issued during turnover' + write(fates_log(),*) 'Exiting' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end select + + ! Loop over all of the coordinate ids + + do pos_id = 1,this%variables(i_var)%num_pos + + turnover = (1.0_r8 - retrans) * base_turnover * this%variables(i_var)%val(pos_id) + + this%variables(i_var)%turnover(pos_id) = this%variables(i_var)%turnover(pos_id) + turnover + + this%variables(i_var)%val(pos_id) = this%variables(i_var)%val(pos_id) - turnover + + end do + + end do + + return + end subroutine MaintTurnoverSimpleRetranslocation + +end module PRTGenericMod From 229dce073e507419b46678ca6daf57d816a168af Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Tue, 18 Sep 2018 18:57:25 -0700 Subject: [PATCH 04/52] Partial first pass on integrating new modular allocation system --- biogeochem/EDCohortDynamicsMod.F90 | 144 +++++++++++++--- biogeochem/EDPhysiologyMod.F90 | 13 +- .../f_wrapper_modules/FatesPFTWrapMod.F90 | 34 ++-- .../parteh/parteh_controls_defaults.xml | 12 +- main/EDInitMod.F90 | 8 +- main/EDPftvarcon.F90 | 157 +++++++++++++++++- main/EDTypesMod.F90 | 38 ++--- main/FatesInterfaceMod.F90 | 18 ++ main/FatesInventoryInitMod.F90 | 8 +- main/FatesParametersInterface.F90 | 1 + main/FatesRestartInterfaceMod.F90 | 74 +++++++-- parameter_files/fates_params_default.cdl | 105 ++++++++++++ parteh/PRTGenericMod.F90 | 65 ++------ 13 files changed, 521 insertions(+), 156 deletions(-) diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index d57000e18f..c82574088e 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -22,6 +22,7 @@ module EDCohortDynamicsMod use EDTypesMod , only : min_n_safemath use EDTypesMod , only : nlevleaf use FatesInterfaceMod , only : hlm_use_planthydro + use FatesInterfaceMod , only : parteh_model use FatesPlantHydraulicsMod, only : FuseCohortHydraulics use FatesPlantHydraulicsMod, only : CopyCohortHydraulics use FatesPlantHydraulicsMod, only : updateSizeDepTreeHydProps @@ -37,6 +38,31 @@ module EDCohortDynamicsMod use FatesAllometryMod , only : carea_allom use FatesAllometryMod , only : StructureResetOfDH use FatesAllometryMod , only : tree_lai, tree_sai + + use PRTGenericMod, only : InitPRTVartype + use PRTGenericMod, only : prt_vartypes + use PRTGenericMod, only : leaf_organ + use PRTGenericMod, only : all_carbon_species + use PRTGenericMod, only : carbon12_species + use PRTGenericMod, only : nitrogen_species + use PRTGenericMod, only : phosphorous_species + use PRTGenericMod, only : leaf_organ + use PRTGenericMod, only : fnrt_organ + use PRTGenericMod, only : sapw_organ + use PRTGenericMod, only : store_organ + use PRTGenericMod, only : repro_organ + use PRTGenericMod, only : struct_organ + use PRTGenericMod, only : carbon12_species + use PRTGenericMod, only : SetState + + use PRTAllometricCarbonMod, only : callom_prt_vartypes + use PRTAllometricCarbonMod, only : ac_bc_inout_id_netdc + use PRTAllometricCarbonMod, only : ac_bc_in_id_pft + use PRTAllometricCarbonMod, only : ac_bc_in_id_ctrim + use PRTAllometricCarbonMod, only : ac_bc_inout_id_dbh + + + ! CIME globals use shr_log_mod , only : errMsg => shr_log_errMsg ! @@ -125,11 +151,50 @@ 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 - new_cohort%bdead = bdead - new_cohort%bstore = bstore - new_cohort%bl = bleaf - new_cohort%br = bfineroot - new_cohort%bsw = bsap + + + ! Initialize the Plant allocative Reactive Transport (PaRT) module + ! Choose from one of the extensible hypotheses (EH) + + select case(parteh_model) + case (1) + + allocate(callom_prt) + new_cohort%prt => callom_prt + +! case(2) + +! allocate(cnpallom_prt) +! new_cohort%prt => cnpallom_prt + + case DEFAULT + write(fates_log(),*) 'You specified an unknown PRT module' + write(fates_log(),*) 'Aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end select + + call ccohort%prt%InitPRTVartype() + + select case(new_cohort%parteh_model) + case (1) + + call SetState(new_cohort%prt,leaf_organ, carbon12_species, bleaf) + call SetState(new_cohort%prt,fnrt_organ, carbon12_species, bfineroot) + call SetState(new_cohort%prt,sapw_organ, carbon12_species, bsap) + call SetState(new_cohort%prt,store_organ, carbon12_species, bstore) + call SetState(new_cohort%prt,struct_organ , carbon12_species, bdead) + call SetState(new_cohort%prt,repro_organ , carbon12_species, 0.0_r8) + + 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) + + end select + + call ccohort%prt%CheckInitialConditions() + new_cohort%ode_opt_step = 1.0e6_r8 ! Initialize the integrator step size as super-huge call sizetype_class_index(new_cohort%dbh,new_cohort%pft, & @@ -151,7 +216,7 @@ 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(new_cohort%bl, new_cohort%pft, new_cohort%c_area, & + new_cohort%treelai = tree_lai(bleaf, new_cohort%pft, new_cohort%c_area, & new_cohort%n, new_cohort%canopy_layer, & patchptr%canopy_layer_tlai ) @@ -422,6 +487,13 @@ subroutine terminate_cohorts( currentSite, currentPatch, level ) type (ed_cohort_type) , pointer :: shorterCohort type (ed_cohort_type) , pointer :: tallerCohort + real(r8) :: leaf_c ! leaf carbon [kg] + real(r8) :: store_c ! storage carbon [kg] + real(r8) :: sapw_c ! sapwood carbon [kg] + 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 :: c ! counter for litter size class. integer :: levcan ! canopy level @@ -434,6 +506,13 @@ subroutine terminate_cohorts( currentSite, currentPatch, level ) terminate = 0 tallerCohort => currentCohort%taller + leaf_c = currentCohort%prt%GetState(leaf_organ, all_carbon_species) + store_c = currentCohort%prt%GetState(store_organ, all_carbon_species) + sapw_c = currentCohort%prt%GetState(sapw_organ, all_carbon_species) + fnrt_c = currentCohort%prt%GetState(fnrt_organ, all_carbon_species) + struct_c = currentCohort%prt%GetState(struct_organ, all_carbon_species) + repro_c = currentCohort%prt%GetState(repro_organ, all_carbon_species) + ! Check if number density is so low is breaks math (level 1) if (currentcohort%n < min_n_safemath .and. level == 1) then terminate = 1 @@ -448,7 +527,7 @@ subroutine terminate_cohorts( currentSite, currentPatch, level ) ! Not enough n or dbh if (currentCohort%n/currentPatch%area <= min_npm2 .or. & ! currentCohort%n <= min_nppatch .or. & - (currentCohort%dbh < 0.00001_r8.and.currentCohort%bstore < 0._r8) ) then + (currentCohort%dbh < 0.00001_r8 .and. store_c < 0._r8) ) then terminate = 1 if ( DEBUG ) then @@ -465,25 +544,22 @@ subroutine terminate_cohorts( currentSite, currentPatch, level ) endif ! live biomass pools are terminally depleted - if ( (currentCohort%bsw+currentCohort%bl+currentCohort%br) < 1e-10_r8 .or. & - currentCohort%bstore < 1e-10_r8) then + if ( ( sapw_c+leaf_c+fnrt_c ) < 1e-10_r8 .or. & + store_c < 1e-10_r8) then terminate = 1 if ( DEBUG ) then write(fates_log(),*) 'terminating cohorts 3', & - currentCohort%bsw,currentCohort%bl,currentCohort%br,currentCohort%bstore + sapw_c,leaf_c,fnrt_c,store_c endif endif ! Total cohort biomass is negative - if ( (currentCohort%b_total()) < 0._r8) then + if ( ( struct_c+sapw_c+leaf_c+fnrt_c+store_c ) < 0._r8) then terminate = 1 if ( DEBUG ) then write(fates_log(),*) 'terminating cohorts 4', & - currentCohort%bsw, & - currentCohort%bl, & - currentCohort%br, & - currentCohort%bdead, & - currentCohort%bstore + struct_c,sapw_c,leaf_c,fnrt_c,store_c + endif endif @@ -496,50 +572,61 @@ subroutine terminate_cohorts( currentSite, currentPatch, level ) else levcan = 2 endif + currentSite%terminated_nindivs(currentCohort%size_class,currentCohort%pft,levcan) = & currentSite%terminated_nindivs(currentCohort%size_class,currentCohort%pft,levcan) + currentCohort%n ! currentSite%termination_carbonflux(levcan) = currentSite%termination_carbonflux(levcan) + & - currentCohort%n * currentCohort%b_total() - + currentCohort%n * (struct_c+sapw_c+leaf_c+fnrt_c+store_c+repro_c) !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*(currentCohort%bdead+currentCohort%bsw) / & + 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*(currentCohort%bdead+currentCohort%bsw) / & + 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* & - (currentCohort%bl)/currentPatch%area + (leaf_c)/currentPatch%area currentPatch%root_litter(currentCohort%pft) = currentPatch%root_litter(currentCohort%pft) + currentCohort%n* & - (currentCohort%br+currentCohort%bstore)/currentPatch%area + (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*(currentCohort%bdead+currentCohort%bsw) * & + + 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*(currentCohort%bdead+currentCohort%bsw) * & + + 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 * (currentCohort%bl) * hlm_days_per_year / AREA + 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 * (currentCohort%br+currentCohort%bstore) * hlm_days_per_year / AREA + currentCohort%n * (fnrt_c + store_c) * hlm_days_per_year / AREA end if + ! Zero out the state pools + call SetState(currentCohort%prt,leaf_organ,carbon12_species,0.0_r8) + call SetState(currentCohort%prt,fnrt_organ,carbon12_species,0.0_r8) + call SetState(currentCohort%prt,sapw_organ,carbon12_species,0.0_r8) + call SetState(currentCohort%prt,struct_organ,carbon12_species,0.0_r8) + call SetState(currentCohort%prt,repro_organ,carbon12_species,0.0_r8) + call SetState(currentCohort%prt,store_organ,carbon12_species,0.0_r8) + ! Set pointers and remove the current cohort from the list shorterCohort => currentCohort%shorter @@ -560,6 +647,11 @@ subroutine terminate_cohorts( currentSite, currentPatch, level ) ! 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) + deallocate(currentCohort) nullify(currentCohort) diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 52d7fb2b56..08689f6271 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -1682,7 +1682,8 @@ subroutine recruitment( currentSite, currentPatch, bc_in ) real(r8) :: b_sapwood ! sapwood biomass [kgC] real(r8) :: b_agw ! Above ground biomass [kgC] real(r8) :: b_bgw ! Below ground biomass [kgC] - + real(r8) :: b_dead + real(r8) :: b_store !---------------------------------------------------------------------- allocate(temp_cohort) ! create temporary cohort @@ -1701,8 +1702,8 @@ subroutine recruitment( currentSite, currentPatch, bc_in ) call bsap_allom(temp_cohort%dbh,ft,temp_cohort%canopy_trim,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,temp_cohort%bdead) - call bstore_allom(temp_cohort%dbh,ft,temp_cohort%canopy_trim,temp_cohort%bstore) + 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) temp_cohort%laimemory = 0.0_r8 if (EDPftvarcon_inst%season_decid(temp_cohort%pft) == 1.and.currentSite%status == 1)then @@ -1726,7 +1727,7 @@ subroutine recruitment( currentSite, currentPatch, bc_in ) 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 & - / (temp_cohort%bdead+b_leaf+b_fineroot+b_sapwood+temp_cohort%bstore) + / (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 @@ -1734,14 +1735,14 @@ subroutine recruitment( currentSite, currentPatch, bc_in ) ! 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) currentSite%flux_in = currentSite%flux_in + temp_cohort%n * & - (temp_cohort%bstore + b_leaf + b_fineroot + b_sapwood + temp_cohort%bdead) + (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 if (temp_cohort%n > 0.0_r8 )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, temp_cohort%bdead, temp_cohort%bstore, & + b_leaf, b_fineroot, b_sapwood, b_dead, b_store, temp_cohort%laimemory, cohortstatus,recruitstatus, temp_cohort%canopy_trim, currentPatch%NCL_p, & currentSite%spread, bc_in) diff --git a/functional_unit_testing/parteh/f_wrapper_modules/FatesPFTWrapMod.F90 b/functional_unit_testing/parteh/f_wrapper_modules/FatesPFTWrapMod.F90 index 03b1b54613..adf122bb18 100644 --- a/functional_unit_testing/parteh/f_wrapper_modules/FatesPFTWrapMod.F90 +++ b/functional_unit_testing/parteh/f_wrapper_modules/FatesPFTWrapMod.F90 @@ -98,10 +98,8 @@ module EDPftvarcon ! THese are new, but not necessarily PARTEH labeled real(r8), pointer :: turnover_retrans_mode(:) - real(r8), pointer :: turnover_retrans_leaf_n_p1(:) - real(r8), pointer :: turnover_retrans_leaf_p_p1(:) - real(r8), pointer :: turnover_retrans_fnrt_n_p1(:) - real(r8), pointer :: turnover_retrans_fnrt_p_p1(:) + real(r8), pointer :: turnover_n_retrans_p1(:,:) + real(r8), pointer :: turnover_p_retrans_p1(:,:) end type EDPftvarcon_inst_type @@ -542,29 +540,17 @@ subroutine EDPftvarconAlloc(numpft_in, numorgans_in) EDPftvarcon_ptr%var(iv)%var_name = "fates_turnover_retrans_mode" EDPftvarcon_ptr%var(iv)%rp_1d => EDPftvarcon_inst%turnover_retrans_mode - allocate( EDPftvarcon_inst%turnover_retrans_leaf_n_p1(1:num_pft) ) - EDPftvarcon_inst%turnover_retrans_leaf_n_p1(:) = nana + allocate( EDPftvarcon_inst%turnover_n_retrans_p1(1:num_pft,1:num_organs) ) + EDPftvarcon_inst%turnover_n_retrans_p1(:,:) = nan iv = iv + 1 - EDPftvarcon_ptr%var(iv)%var_name = "fates_turnover_retrans_leaf_n_p1" - EDPftvarcon_ptr%var(iv)%rp_1d => EDPftvarcon_inst%turnover_retrans_leaf_n_p1 + EDPftvarcon_ptr%var(iv)%var_name = "fates_turnover_n_retrans_p1" + EDPftvarcon_ptr%var(iv)%rp_2d => EDPftvarcon_inst%turnover_n_retrans_p1 - allocate( EDPftvarcon_inst%turnover_retrans_leaf_p_p1(1:num_pft) ) - EDPftvarcon_inst%turnover_retrans_leaf_p_p1(:) = nana + allocate( EDPftvarcon_inst%turnover_p_retrans_p1(1:num_pft,1:num_organs) ) + EDPftvarcon_inst%turnover_p_retrans_p1(:,:) = nan iv = iv + 1 - EDPftvarcon_ptr%var(iv)%var_name = "fates_turnover_retrans_leaf_p_p1" - EDPftvarcon_ptr%var(iv)%rp_1d => EDPftvarcon_inst%turnover_retrans_leaf_p_p1 - - allocate( EDPftvarcon_inst%turnover_retrans_fnrt_n_p1(1:num_pft) ) - EDPftvarcon_inst%turnover_retrans_fnrt_n_p1(:) = nana - iv = iv + 1 - EDPftvarcon_ptr%var(iv)%var_name = "fates_turnover_retrans_fnrt_n_p1" - EDPftvarcon_ptr%var(iv)%rp_1d => EDPftvarcon_inst%turnover_retrans_fnrt_n_p1 - - allocate( EDPftvarcon_inst%turnover_retrans_fnrt_p_p1(1:num_pft) ) - EDPftvarcon_inst%turnover_retrans_fnrt_p_p1(:) = nana - iv = iv + 1 - EDPftvarcon_ptr%var(iv)%var_name = "fates_turnover_retrans_fnrt_p_p1" - EDPftvarcon_ptr%var(iv)%rp_1d => EDPftvarcon_inst%turnover_retrans_fnrt_p_p1 + EDPftvarcon_ptr%var(iv)%var_name = "fates_turnover_p_retrans_p1" + EDPftvarcon_ptr%var(iv)%rp_2d => EDPftvarcon_inst%turnover_p_retrans_p1 ! We should gracefully fail if rootprof_beta is requested diff --git a/functional_unit_testing/parteh/parteh_controls_defaults.xml b/functional_unit_testing/parteh/parteh_controls_defaults.xml index 5359213212..46b3429c50 100644 --- a/functional_unit_testing/parteh/parteh_controls_defaults.xml +++ b/functional_unit_testing/parteh/parteh_controls_defaults.xml @@ -98,10 +98,14 @@ 50.0 , 50.0 1,1 - -9,-9 - -9,-9 - -9,-9 - -9,-9 + + -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9 + -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9 + -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9 + -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9 + -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9 + -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9 + diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index 90068a13b7..33c4f83423 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -354,6 +354,8 @@ subroutine init_cohorts( site_in, patch_in, bc_in) 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] integer, parameter :: rstatus = 0 !---------------------------------------------------------------------- @@ -393,9 +395,9 @@ subroutine init_cohorts( site_in, patch_in, bc_in) ! Calculate sapwood biomass call bsap_allom(temp_cohort%dbh,pft,temp_cohort%canopy_trim,b_sapwood) - call bdead_allom( b_agw, b_bgw, b_sapwood, pft, temp_cohort%bdead ) + call bdead_allom( b_agw, b_bgw, b_sapwood, pft, b_dead ) - call bstore_allom(temp_cohort%dbh, pft, temp_cohort%canopy_trim,temp_cohort%bstore) + call bstore_allom(temp_cohort%dbh, pft, temp_cohort%canopy_trim, b_store) if( EDPftvarcon_inst%evergreen(pft) == 1) then @@ -425,7 +427,7 @@ subroutine init_cohorts( site_in, patch_in, bc_in) 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, temp_cohort%bdead, temp_cohort%bstore, & + b_leaf, b_fineroot, b_sapwood, b_dead, b_store, temp_cohort%laimemory, cstatus, rstatus, temp_cohort%canopy_trim, 1, site_in%spread, bc_in) diff --git a/main/EDPftvarcon.F90 b/main/EDPftvarcon.F90 index a5c70ca2a4..ec36994557 100644 --- a/main/EDPftvarcon.F90 +++ b/main/EDPftvarcon.F90 @@ -43,7 +43,7 @@ module EDPftvarcon real(r8), allocatable :: initd (:) ! initial seedling density real(r8), allocatable :: seed_rain (:) ! seeds that come from outside the gridbox. real(r8), allocatable :: BB_slope (:) ! ball berry slope parameter - real(r8), allocatable :: root_long (:) ! root longevity (yrs) + real(r8), allocatable :: seed_alloc_mature (:) ! fraction of carbon balance allocated to clonal reproduction. real(r8), allocatable :: seed_alloc (:) ! fraction of carbon balance allocated to seeds. real(r8), allocatable :: c2b (:) ! Carbon to biomass multiplier [kg/kgC] @@ -53,7 +53,7 @@ module EDPftvarcon real(r8), allocatable :: evergreen(:) real(r8), allocatable :: slamax(:) real(r8), allocatable :: slatop(:) - real(r8), allocatable :: leaf_long(:) + real(r8), allocatable :: roota_par(:) real(r8), allocatable :: rootb_par(:) real(r8), allocatable :: lf_flab(:) @@ -93,7 +93,7 @@ module EDPftvarcon real(r8), allocatable :: tpuse(:) real(r8), allocatable :: germination_timescale(:) real(r8), allocatable :: seed_decay_turnover(:) - real(r8), allocatable :: branch_turnover(:) ! Turnover time for branchfall on live trees [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) real(r8), allocatable :: rhol(:, :) @@ -157,6 +157,25 @@ module EDPftvarcon ! prescribed_physiology_mode + ! Plant Reactive Transport (allocation) + + real(r8), allocatable :: prt_unit_gr_resp(:,:) ! Unit growth respiration (pft x organ) [kgC/kgC] + 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_alloc_priority(:,:) ! Allocation priority for each organ (pft x organ) [integer 0-6] + + ! Turnover related things + + real(r8), allocatable :: leaf_long(:) ! Leaf turnover time (longevity) (pft) [yr] + real(r8), allocatable :: root_long(:) ! root turnover time (longevity) (pft) [yr] + real(r8), allocatable :: branch_turnover(:) ! Turnover time for branchfall on live trees (pft) [yr] + real(r8), allocatable :: turnover_retrans_mode(:) ! Retranslocation method (pft) + real(r8), allocatable :: turnover_nitr_retrans_p1(:,:) ! Parameter 1 for nitrogen re-translocation (pft x organ) + real(r8), allocatable :: turnover_phos_retrans_p1(:,:) ! Parameter 2 for phosphorous re-translocation (pft x organ) + + ! Plant Hydraulic Parameters ! --------------------------------------------------------------------------------------------- @@ -371,6 +390,8 @@ 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_roota_par' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) @@ -664,6 +685,10 @@ 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_turnover_retrans_mode' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + name = 'fates_branch_turnover' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) @@ -1103,6 +1128,10 @@ subroutine Receive_PFT(this, fates_params) name = 'fates_branch_turnover' call fates_params%RetreiveParameterAllocate(name=name, & data=this%branch_turnover) + + name = 'fates_turnover_retrans_mode' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%turnover_retrans_mode) name = 'fates_trim_limit' call fates_params%RetreiveParameterAllocate(name=name, & @@ -1346,6 +1375,115 @@ end subroutine Receive_PFT_nvariants ! ----------------------------------------------------------------------- + subroutine Register_PFT_prt_organs(this, fates_params) + + use FatesParametersInterface, only : fates_parameters_type, param_string_length + use FatesParametersInterface, only : max_dimensions, dimension_name_prt_organs + use FatesParametersInterface, only : dimension_name_pft, dimension_shape_2d + + implicit none + + class(EDPftvarcon_type), intent(inout) :: this + class(fates_parameters_type), intent(inout) :: fates_params + + integer, parameter :: dim_lower_bound(2) = (/ lower_bound_pft, lower_bound_general /) + character(len=param_string_length) :: dim_names(2) + character(len=param_string_length) :: name + + ! NOTE(bja, 2017-01) initialization doesn't seem to work correctly + ! if dim_names has a parameter qualifier. + dim_names(1) = dimension_name_pft + dim_names(2) = dimension_name_prt_organs + + name = 'fates_prt_unit_gr_resp' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_2d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_prt_nitr_stoich_p1' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_2d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_prt_nitr_stoich_p2' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_2d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_prt_phos_stoich_p1' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_2d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_prt_phos_stoich_p2' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_2d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_prt_alloc_priority' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_2d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + + + name = 'fates_turnover_nitr_retrans_p1' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_2d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_turnover_phos_retrans_p1' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_2d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + + end subroutine Register_PFT_prt_organs + + ! ===================================================================================== + + subroutine Receive_PFT_prt_organs(this, fates_params) + + use FatesParametersInterface, only : fates_parameters_type + use FatesParametersInterface, only : param_string_length + + implicit none + + class(EDPftvarcon_type), intent(inout) :: this + class(fates_parameters_type), intent(inout) :: fates_params + + character(len=param_string_length) :: name + + name = 'fates_prt_unit_gr_resp' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%prt_unit_gr_resp) + + name = 'fates_prt_nitr_stoich_p1' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%prt_nitr_stoich_p1) + + name = 'fates_prt_nitr_stoich_p2' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%prt_nitr_stoich_p2) + + name = 'fates_prt_phos_stoich_p1' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%prt_phos_stoich_p1) + + name = 'fates_prt_phos_stoich_p2' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%prt_phos_stoich_p2) + + name = 'fates_prt_alloc_priority' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%prt_alloc_priority) + + + + name = 'fates_turnover_nitr_retrans_p1' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%turnover_nitr_retrans_p1) + + name = 'fates_turnover_phos_retrans_p1' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%turnover_phos_retrans_p1) + + end subroutine Receive_PFT_hydr_organs + + ! ----------------------------------------------------------------------- + subroutine Register_PFT_hydr_organs(this, fates_params) use FatesParametersInterface, only : fates_parameters_type, param_string_length @@ -1576,6 +1714,7 @@ subroutine FatesReportPFTParams(is_master) write(fates_log(),fmt0) 'allom_agb2 = ',EDPftvarcon_inst%allom_agb2 write(fates_log(),fmt0) 'allom_agb3 = ',EDPftvarcon_inst%allom_agb3 write(fates_log(),fmt0) 'allom_agb4 = ',EDPftvarcon_inst%allom_agb4 + write(fates_log(),fmt0) 'hydr_p_taper = ',EDPftvarcon_inst%hydr_p_taper write(fates_log(),fmt0) 'hydr_rs2 = ',EDPftvarcon_inst%hydr_rs2 write(fates_log(),fmt0) 'hydr_srl = ',EDPftvarcon_inst%hydr_srl @@ -1591,6 +1730,18 @@ subroutine FatesReportPFTParams(is_master) write(fates_log(),fmt0) 'hydr_fcap_node = ',EDPftvarcon_inst%hydr_fcap_node write(fates_log(),fmt0) 'hydr_pinot_node = ',EDPftvarcon_inst%hydr_pinot_node write(fates_log(),fmt0) 'hydr_kmax_node = ',EDPftvarcon_inst%hydr_kmax_node + + + write(fates_log(),fmt0) 'prt_nitr_stoich_p1 = ',EDPftvarcon_inst%prt_nitr_stoich_p1 + write(fates_log(),fmt0) 'prt_nitr_stoich_p2 = ',EDPftvarcon_inst%prt_nitr_stoich_p2 + write(fates_log(),fmt0) 'prt_phos_stoich_p1 = ',EDPftvarcon_inst%prt_phos_stoich_p1 + write(fates_log(),fmt0) 'prt_phos_stoich_p2 = ',EDPftvarcon_inst%prt_phos_stoich_p2 + write(fates_log(),fmt0) 'prt_unit_gr_resp = ',EDPftvarcon_inst%prt_unit_gr_resp + write(fates_log(),fmt0) 'prt_alloc_priority = ',EDPftvarcon_inst%prt_alloc_priority + + write(fates_log(),fmt0) 'turnover_nitr_retrans_p1 = ',EDPftvarcon_inst%turnover_nitr_retrans_p1 + write(fates_log(),fmt0) 'turnover_phos_retrans_p1 = ',EDPftvarcon_inst%turnover_phos_retrans_p1 + write(fates_log(),*) '-------------------------------------------------' end if diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 7d4c2e2841..4b4adce29f 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -5,6 +5,7 @@ module EDTypesMod 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 implicit none save @@ -132,22 +133,23 @@ module EDTypesMod type (ed_patch_type) , pointer :: patchptr => null() ! pointer to patch that cohort is in + + ! Multi-species, multi-organ Plant Reactive Transport (PRT) + ! Contains carbon and nutrient state variables for various plant organs + + class(prt_vartypes), pointer :: prt + ! VEGETATION STRUCTURE integer :: pft ! pft number real(r8) :: n ! number of individuals in cohort per 'area' (10000m2 default) real(r8) :: dbh ! dbh: cm real(r8) :: hite ! height: meters integer :: indexnumber ! unique number for each cohort. (within clump?) - real(r8) :: bdead ! dead biomass: kGC per indiv - real(r8) :: bstore ! stored carbon: kGC per indiv real(r8) :: laimemory ! target leaf 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) :: bsw ! sapwood in stem and roots: kGC per indiv - real(r8) :: bl ! leaf biomass: kGC per indiv - real(r8) :: br ! fine root biomass: kGC per indiv 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] @@ -608,19 +610,8 @@ module EDTypesMod end type ed_site_type -contains - - function b_total(this) - ! Calculate total plant biomass - implicit none - class(ed_cohort_type), intent(inout) :: this - real(r8) :: b_total - - b_total = this%bl + this%br + this%bsw + this%bdead + this%bstore - - end function b_total ! ===================================================================================== @@ -750,13 +741,16 @@ subroutine dump_cohort(ccohort) write(fates_log(),*) 'co%pft = ', ccohort%pft write(fates_log(),*) 'co%n = ', ccohort%n write(fates_log(),*) 'co%dbh = ', ccohort%dbh - write(fates_log(),*) 'co%hite = ', ccohort%hite - write(fates_log(),*) 'co%bdead = ', ccohort%bdead - write(fates_log(),*) 'co%bstore = ', ccohort%bstore + write(fates_log(),*) 'co%hite = ', ccohort%hite write(fates_log(),*) 'co%laimemory = ', ccohort%laimemory - write(fates_log(),*) 'co%bsw = ', ccohort%bsw - write(fates_log(),*) 'co%bl = ', ccohort%bl - write(fates_log(),*) 'co%br = ', ccohort%br + + write(fates_log(),*) 'leaf carbon = ', ccohort%prt%GetState(leaf_organ,all_carbon_species) + write(fates_log(),*) 'fineroot carbon = ', ccohort%prt%GetState(fnrt_organ,all_carbon_species) + write(fates_log(),*) 'sapwood carbon = ', ccohort%prt%GetState(sapw_organ,all_carbon_species) + write(fates_log(),*) 'structural (dead) carbon = ', ccohort%prt%GetState(struct_organ,all_carbon_species) + write(fates_log(),*) 'storage carbon = ', ccohort%prt%GetState(store_organ,all_carbon_species) + write(fates_log(),*) 'reproductive carbon = ', ccohort%prt%GetState(repro_organ,all_carbon_species) + write(fates_log(),*) 'co%lai = ', ccohort%lai write(fates_log(),*) 'co%sai = ', ccohort%sai write(fates_log(),*) 'co%g_sb_laweight = ', ccohort%g_sb_laweight diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 8d97369643..af388b8a14 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -104,6 +104,10 @@ module FatesInterfaceMod ! compare it to our maxpatchpersite, ! and gracefully halt if we are over-allocating + integer, protected :: hlm_parteh_model ! This flag signals which Plant Allocation and Reactive + ! Transport (exensible) Hypothesis (PARTEH) to use + + integer, protected :: hlm_use_vertsoilc ! This flag signals whether or not the ! host model is using vertically discretized ! soil carbon @@ -1211,6 +1215,7 @@ subroutine set_fates_ctrlparms(tag,ival,rval,cval) hlm_ipedof = unset_int hlm_max_patch_per_site = unset_int hlm_use_vertsoilc = unset_int + hlm_parteh_model = unset_int hlm_use_spitfire = unset_int hlm_use_planthydro = unset_int hlm_use_logging = unset_int @@ -1372,6 +1377,13 @@ subroutine set_fates_ctrlparms(tag,ival,rval,cval) call endrun(msg=errMsg(sourcefile, __LINE__)) end if + if(hlm_parteh_model .eq. unset_int) then + if (fates_global_verbose()) then + write(fates_log(), *) 'switch deciding which plant reactive transport model to use' + end if + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + if(hlm_use_vertsoilc .eq. unset_int) then if (fates_global_verbose()) then write(fates_log(), *) 'switch for the HLMs soil carbon discretization unset: hlm_use_vertsoilc, exiting' @@ -1449,6 +1461,12 @@ subroutine set_fates_ctrlparms(tag,ival,rval,cval) if (fates_global_verbose()) then write(fates_log(),*) 'Transfering hlm_use_vertsoilc= ',ival,' to FATES' end if + + case('parteh_model') + hlm_parteh_model = ival + if (fates_global_verbose()) then + write(fates_log(),*) 'Transfering hlm_parteh_model= ',ival,' to FATES' + end if case('use_spitfire') hlm_use_spitfire = ival diff --git a/main/FatesInventoryInitMod.F90 b/main/FatesInventoryInitMod.F90 index 5e7c2955ba..53ef6e8d55 100644 --- a/main/FatesInventoryInitMod.F90 +++ b/main/FatesInventoryInitMod.F90 @@ -796,6 +796,8 @@ subroutine set_inventory_edcohort_type1(csite,bc_in,css_file_unit,npatches, & 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_store 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)' @@ -898,9 +900,9 @@ subroutine set_inventory_edcohort_type1(csite,bc_in,css_file_unit,npatches, & ! Calculate sapwood biomass call bsap_allom(temp_cohort%dbh,c_pft,temp_cohort%canopy_trim,b_sapwood) - call bdead_allom( b_agw, b_bgw, b_sapwood, c_pft, temp_cohort%bdead ) + call bdead_allom( b_agw, b_bgw, b_sapwood, c_pft, b_dead ) - call bstore_allom(temp_cohort%dbh, c_pft, temp_cohort%canopy_trim,temp_cohort%bstore) + call bstore_allom(temp_cohort%dbh, c_pft, temp_cohort%canopy_trim, b_store) if( EDPftvarcon_inst%evergreen(c_pft) == 1) then temp_cohort%laimemory = 0._r8 @@ -929,7 +931,7 @@ subroutine set_inventory_edcohort_type1(csite,bc_in,css_file_unit,npatches, & ! Since spread is a canopy level calculation, we need to provide an initial guess here. site_spread = 0.5_r8 call create_cohort(csite, cpatch, c_pft, temp_cohort%n, temp_cohort%hite, temp_cohort%dbh, & - b_leaf, b_fineroot, b_sapwood, temp_cohort%bdead, temp_cohort%bstore, & + b_leaf, b_fineroot, b_sapwood, b_dead, b_store, & temp_cohort%laimemory, cstatus, rstatus, temp_cohort%canopy_trim, 1, site_spread, bc_in) diff --git a/main/FatesParametersInterface.F90 b/main/FatesParametersInterface.F90 index 9a310f8aaf..8af57330dc 100644 --- a/main/FatesParametersInterface.F90 +++ b/main/FatesParametersInterface.F90 @@ -29,6 +29,7 @@ module FatesParametersInterface character(len=*), parameter, public :: dimension_name_allpfts = 'fates_allpfts' character(len=*), parameter, public :: dimension_name_variants = 'fates_variants' character(len=*), parameter, public :: dimension_name_hydr_organs = 'fates_hydr_organs' + character(len=*), parameter, public :: dimension_name_prt_organs = 'fates_prt_organs' character(len=*), parameter, public :: dimension_name_history_size_bins = 'fates_history_size_bins' character(len=*), parameter, public :: dimension_name_history_age_bins = 'fates_history_age_bins' character(len=*), parameter, public :: dimension_name_history_height_bins = 'fates_history_height_bins' diff --git a/main/FatesRestartInterfaceMod.F90 b/main/FatesRestartInterfaceMod.F90 index 0588832d0a..2c2022eaa5 100644 --- a/main/FatesRestartInterfaceMod.F90 +++ b/main/FatesRestartInterfaceMod.F90 @@ -13,6 +13,23 @@ module FatesRestartInterfaceMod use FatesInterfaceMod, only : bc_in_type use FatesSizeAgeTypeIndicesMod, only : get_sizeage_class_index + use FatesInterfaceMod , only : hlm_parteh_model + + use PRTGenericMod, only : leaf_organ + use PRTGenericMod, only : all_carbon_species + use PRTGenericMod, only : carbon12_species + use PRTGenericMod, only : nitrogen_species + use PRTGenericMod, only : phosphorous_species + use PRTGenericMod, only : leaf_organ + use PRTGenericMod, only : fnrt_organ + use PRTGenericMod, only : sapw_organ + use PRTGenericMod, only : store_organ + use PRTGenericMod, only : repro_organ + use PRTGenericMod, only : struct_organ + use PRTGenericMod, only : carbon12_species + use PRTGenericMod, only : SetState + use PRTGenericMod, only : GetState + ! CIME GLOBALS use shr_log_mod , only : errMsg => shr_log_errMsg @@ -1189,11 +1206,21 @@ subroutine set_restart_vectors(this,nc,nsites,sites) write(fates_log(),*) 'CLTV upperbound ', ubound(rio_npp_acc_co,1) endif - rio_bsw_co(io_idx_co) = ccohort%bsw - rio_bdead_co(io_idx_co) = ccohort%bdead - rio_bleaf_co(io_idx_co) = ccohort%bl - rio_broot_co(io_idx_co) = ccohort%br - rio_bstore_co(io_idx_co) = ccohort%bstore + select case(hlm_parteh_model) + case (1) + + rio_bsw_co(io_idx_co) = ccohort%prt%GetState(sapw_organ, carbon12_species ) + rio_bdead_co(io_idx_co) = ccohort%prt%GetState(struct_organ, carbon12_species ) + rio_bleaf_co(io_idx_co) = ccohort%prt%GetState(leaf_organ, carbon12_species ) + rio_broot_co(io_idx_co) = ccohort%prt%GetState(fnrt_organ, carbon12_species ) + rio_bstore_co(io_idx_co) = ccohort%prt%GetState(store_organ, carbon12_species ) + + case DEFAULT + write(fates_log(),*) 'You specified an unknown PRT module' + write(fates_log(),*) 'Aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end select + 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 @@ -1421,6 +1448,8 @@ subroutine create_patchcohort_structure(this, nc, nsites, sites, bc_in) integer :: idx_pa ! local patch index integer :: io_idx_si ! global site index in IO vector integer :: io_idx_co_1st ! global cohort index in IO vector + real(r8) :: b_dead ! dummy structural biomass (kgC) + real(r8) :: b_store ! dummy storage carbon (kgC) real(r8) :: b_leaf ! leaf biomass dummy var (kgC) real(r8) :: b_fineroot ! fineroot dummy var (kgC) real(r8) :: b_sapwood ! sapwood dummy var (kgC) @@ -1495,8 +1524,7 @@ subroutine create_patchcohort_structure(this, nc, nsites, sites, bc_in) allocate(temp_cohort) temp_cohort%n = 700.0_r8 - temp_cohort%bdead = 0.0_r8 - temp_cohort%bstore = 0.0_r8 + temp_cohort%laimemory = 0.0_r8 temp_cohort%canopy_trim = 1.0_r8 temp_cohort%canopy_layer = 1.0_r8 @@ -1514,14 +1542,16 @@ subroutine create_patchcohort_structure(this, nc, nsites, sites, bc_in) write(fates_log(),*) 'EDRestVectorMod.F90::createPatchCohortStructure call create_cohort ' end if + b_dead = 0.0_r8 + b_store = 0.0_r8 b_leaf = 0.0_r8 b_fineroot = 0.0_r8 b_sapwood = 0.0_r8 site_spread = 0.5_r8 call create_cohort(sites(s),newp, temp_cohort%pft, temp_cohort%n, temp_cohort%hite, temp_cohort%dbh, & - b_leaf, b_fineroot, b_sapwood, temp_cohort%bdead, temp_cohort%bstore, & - temp_cohort%laimemory, cohortstatus,recruitstatus, temp_cohort%canopy_trim, newp%NCL_p, & - site_spread, bc_in(s)) + b_leaf, b_fineroot, b_sapwood, b_dead, b_store, & + temp_cohort%laimemory, cohortstatus,recruitstatus, temp_cohort%canopy_trim, newp%NCL_p, & + site_spread, bc_in(s)) deallocate(temp_cohort) @@ -1761,11 +1791,25 @@ subroutine get_restart_vectors(this, nc, nsites, sites) write(fates_log(),*) 'CVTL io_idx_co ',io_idx_co endif - ccohort%bsw = rio_bsw_co(io_idx_co) - ccohort%bdead = rio_bdead_co(io_idx_co) - ccohort%bl = rio_bleaf_co(io_idx_co) - ccohort%br = rio_broot_co(io_idx_co) - ccohort%bstore = rio_bstore_co(io_idx_co) + select case(hlm_parteh_model) + case (1) + + call SetState(new_cohort%prt,leaf_organ, carbon12_species, rio_bleaf_co(io_idx_co)) + call SetState(new_cohort%prt,fnrt_organ, carbon12_species, rio_broot_co(io_idx_co)) + call SetState(new_cohort%prt,sapw_organ, carbon12_species, rio_bsw_co(io_idx_co)) + call SetState(new_cohort%prt,store_organ, carbon12_species, rio_bstore_co(io_idx_co)) + call SetState(new_cohort%prt,struct_organ , carbon12_species, rio_bdead_co(io_idx_co)) + call SetState(new_cohort%prt,repro_organ , carbon12_species, 0.0_r8) + + case DEFAULT + write(fates_log(),*) 'You specified an unknown PRT module' + write(fates_log(),*) 'Aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end select + + + end select + 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) diff --git a/parameter_files/fates_params_default.cdl b/parameter_files/fates_params_default.cdl index 8f58d4cefa..59954db104 100644 --- a/parameter_files/fates_params_default.cdl +++ b/parameter_files/fates_params_default.cdl @@ -5,6 +5,7 @@ dimensions: fates_history_height_bins = 6 ; fates_history_size_bins = 13 ; fates_hydr_organs = 4 ; + fates_prt_organs = 6 ; fates_litterclass = 6 ; fates_pft = 2 ; fates_scalar = 1 ; @@ -170,6 +171,43 @@ variables: float fates_branch_turnover(fates_pft) ; fates_branch_turnover:units = "yr-1" ; fates_branch_turnover:long_name = "turnover time of branches" ; + + float fates_prt_unit_gr_resp(fates_prt_organs,fates_pft) ; + fates_prt_unit_gr_resp:units = "kgC/kgC" ; + fates_prt_unit_gr_resp:long_name = "Unit growth respiration rate per organ" ; + + float fates_prt_nitr_stoich_p1(fates_prt_organs,fates_pft) ; + fates_prt_nitr_stoich_p1:units = "na" ; + fates_prt_nitr_stoich_p1:long_name = "nitrogen stoichiometry, parameter 1 (hypothesis dependant meaning)" ; + + float fates_prt_nitr_stoich_p2(fates_prt_organs,fates_pft) ; + fates_prt_nitr_stoich_p2:units = "na" ; + fates_prt_nitr_stoich_p2:long_name = "nitrogen stoichiometry, parameter 2 (hypothesis dependant meaning)" ; + + float fates_prt_phos_stoich_p1(fates_prt_organs,fates_pft) ; + fates_prt_phos_stoich_p1:units = "na" ; + fates_prt_phos_stoich_p1:long_name = "phosphorous stoichiometry, parameter 1 (hypothesis dependant meaning)" ; + + float fates_prt_phos_stoich_p2(fates_prt_organs,fates_pft) ; + fates_prt_phos_stoich_p2:units = "na" ; + fates_prt_phos_stoich_p2:long_name = "phosphorous stoichiometry, parameter 2 (hypothesis dependant meaning)" ; + + float 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_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_turnover_nitr_retrans_p1(fates_prt_organs,fates_pft) ; + fates_turnover_nitr_retrans_p1:units = "na" ; + fates_turnover_nitr_retrans_p1:long_name = "retranslocation of nitrogen in turnover, parameter 1 (hypothesis dependant meaning)" ; + + float fates_turnover_phos_retrans_p1(fates_prt_organs,fates_pft) ; + fates_turnover_phos_retrans_p1:units = "na" ; + fates_turnover_phos_retrans_p1:long_name = "retranslocation of phosphorous in turnover, parameter 1 (hypothesis dependant meaning)" ; + float fates_c2b(fates_pft) ; fates_c2b:units = "ratio" ; fates_c2b:long_name = "Carbon to biomass multiplier of bulk structural tissues" ; @@ -709,6 +747,73 @@ data: fates_branch_turnover = 50, 50 ; + fates_prt_unit_gr_resp = + _, _, + _, _, + _, _, + _, _, + _, _, + _, _; + + fates_prt_nitr_stoich_p1 = + _, _, + _, _, + _, _, + _, _, + _, _, + _, _; + + fates_prt_nitr_stoich_p2 = + _, _, + _, _, + _, _, + _, _, + _, _, + _, _; + + fates_prt_phos_stoich_p1 = + _, _, + _, _, + _, _, + _, _, + _, _, + _, _; + + fates_prt_phos_stoich_p2 = + _, _, + _, _, + _, _, + _, _, + _, _, + _, _; + + fates_prt_alloc_priority = + _, _, + _, _, + _, _, + _, _, + _, _, + _, _; + + fates_turnover_retrans_mode = + 1, 1; + + fates_turnover_nitr_retrans_p1 = + _, _, + _, _, + _, _, + _, _, + _, _, + _, _; + + fates_turnover_phos_retrans_p1 = + _, _, + _, _, + _, _, + _, _, + _, _, + _, _; + fates_c2b = 2, 2 ; fates_displar = 0.67, 0.67 ; diff --git a/parteh/PRTGenericMod.F90 b/parteh/PRTGenericMod.F90 index 847c257cdb..8597051db5 100644 --- a/parteh/PRTGenericMod.F90 +++ b/parteh/PRTGenericMod.F90 @@ -609,6 +609,10 @@ subroutine DeallocatePRTVartypes(this) integer :: n_vars integer :: i_var + ! Check to see if there is any value in these pools? + ! SHould not deallocate if there is any carbon left + + n_vars = size(this%variables,1) do i_var = 1, n_vars @@ -1027,59 +1031,20 @@ subroutine MaintTurnoverSimpleRetranslocation(this,ipft) organ_id = this%prt_instance%state_descriptor(i_var)%organ_id spec_id = this%prt_instance%state_descriptor(i_var)%spec_id - - select case(organ_id) - case(leaf_organ) - - base_turnover = leaf_turnover - if ( any(spec_id == carbon_species) ) then - retrans = 0.0_r8 - else if( spec_id == nitrogen_species ) then - retrans = EDPftvarcon_inst%turnover_retrans_leaf_n_p1(ipft) - else if( spec_id == phosphorous_species ) then - retrans = EDPftvarcon_inst%turnover_retrans_leaf_p_p1(ipft) - else - write(fates_log(),*) 'Please add a new re-translocation clause to your ' - write(fates_log(),*) ' organ x species combination' - write(fates_log(),*) ' organ: ',leaf_organ,' species: ',spec_id - write(fates_log(),*) 'Exiting' - call endrun(msg=errMsg(__FILE__, __LINE__)) - end if - - case(fnrt_organ) - - base_turnover = fnrt_turnover - if ( any(spec_id == carbon_species) ) then - retrans = 0.0_r8 - else if( spec_id == nitrogen_species ) then - retrans = EDPftvarcon_inst%turnover_retrans_fnrt_n_p1(ipft) - else if( spec_id == phosphorous_species ) then - retrans = EDPftvarcon_inst%turnover_retrans_fnrt_p_p1(ipft) - else - write(fates_log(),*) 'Please add a new re-translocation clause to your ' - write(fates_log(),*) ' organ x species combination' - write(fates_log(),*) ' organ: ',leaf_organ,' species: ',spec_id - write(fates_log(),*) 'Exiting' - call endrun(msg=errMsg(__FILE__, __LINE__)) - end if - case(sapw_organ) - base_turnover = sapw_turnover - retrans = 0.0_r8 - case(store_organ) - base_turnover = store_turnover - retrans = 0.0_r8 - case(struct_organ) - base_turnover = struct_turnover - retrans = 0.0_r8 - case(repro_organ) - base_turnover = repro_turnover - retrans = 0.0_r8 - case default - write(fates_log(),*) 'Strange organ issued during turnover' + if ( any(spec_id == carbon_species) ) then + retrans = 0.0_r8 + else if( spec_id == nitrogen_species ) then + retrans = EDPftvarcon_inst%turnover_n_retrans_p1(ipft,organ_id) + else if( spec_id == phosphorous_species ) then + retrans = EDPftvarcon_inst%turnover_p_retrans_p1(ipft,organ_id) + else + write(fates_log(),*) 'Please add a new re-translocation clause to your ' + write(fates_log(),*) ' organ x species combination' + write(fates_log(),*) ' organ: ',leaf_organ,' species: ',spec_id write(fates_log(),*) 'Exiting' call endrun(msg=errMsg(__FILE__, __LINE__)) - end select + end if ! Loop over all of the coordinate ids From 91403389b32b6443dd8d2570629ec61553d3a37f Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Wed, 19 Sep 2018 18:49:22 -0700 Subject: [PATCH 05/52] Lots more conversion from old system to parteh v0 --- biogeochem/EDCanopyStructureMod.F90 | 111 ++- biogeochem/EDCohortDynamicsMod.F90 | 125 ++- biogeochem/EDLoggingMortalityMod.F90 | 26 +- biogeochem/EDMortalityFunctionsMod.F90 | 12 +- biogeochem/EDPatchDynamicsMod.F90 | 129 ++- biogeochem/EDPhysiologyMod.F90 | 1053 ++++-------------------- fire/SFMainMod.F90 | 38 +- main/EDMainMod.F90 | 69 +- main/EDTypesMod.F90 | 6 - parteh/PRTGenericMod.F90 | 108 ++- 10 files changed, 633 insertions(+), 1044 deletions(-) diff --git a/biogeochem/EDCanopyStructureMod.F90 b/biogeochem/EDCanopyStructureMod.F90 index acf3d76577..a15ef448d2 100644 --- a/biogeochem/EDCanopyStructureMod.F90 +++ b/biogeochem/EDCanopyStructureMod.F90 @@ -26,6 +26,19 @@ module EDCanopyStructureMod use FatesInterfaceMod , only : numpft use FatesPlantHydraulicsMod, only : UpdateH2OVeg,InitHydrCohort + use PRTGenericMod, only : leaf_organ + use PRTGenericMod, only : all_carbon_species + use PRTGenericMod, only : carbon12_species + use PRTGenericMod, only : nitrogen_species + use PRTGenericMod, only : phosphorous_species + use PRTGenericMod, only : leaf_organ + use PRTGenericMod, only : fnrt_organ + use PRTGenericMod, only : sapw_organ + use PRTGenericMod, only : store_organ + use PRTGenericMod, only : repro_organ + use PRTGenericMod, only : struct_organ + use PRTGenericMod, only : SetState + ! CIME Globals use shr_log_mod , only : errMsg => shr_log_errMsg @@ -319,6 +332,11 @@ subroutine DemoteFromLayer(currentSite,currentPatch,i_lyr) type(ed_cohort_type), pointer :: currentCohort,copyc integer :: i_cwd ! Index for CWD pool real(r8) :: cc_loss ! cohort crown area loss in demotion (m2) + 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] real(r8) :: lossarea real(r8) :: newarea real(r8) :: demote_area @@ -454,6 +472,12 @@ subroutine DemoteFromLayer(currentSite,currentPatch,i_lyr) cc_loss = currentCohort%excl_weight + leaf_c = currentCohort%prt%GetState(leaf_organ,all_carbon_species) + store_c = currentCohort%prt%GetState(store_organ,all_carbon_species) + fnrt_c = currentCohort%prt%GetState(fnrt_organ,all_carbon_species) + sapw_c = currentCohort%prt%GetState(sapw_organ,all_carbon_species) + struct_c = currentCohort%prt%GetState(struct_organ,all_carbon_species) + if(currentCohort%canopy_layer == i_lyr .and. cc_loss>nearzero )then if ( (cc_loss-currentCohort%c_area) > -nearzero .and. & @@ -468,7 +492,7 @@ subroutine DemoteFromLayer(currentSite,currentPatch,i_lyr) currentSite%demotion_rate(currentCohort%size_class) = & currentSite%demotion_rate(currentCohort%size_class) + currentCohort%n currentSite%demotion_carbonflux = currentSite%demotion_carbonflux + & - currentCohort%b_total() * currentCohort%n + (leaf_c + store_c + fnrt_c + sapw_c + struct_c) * currentCohort%n elseif(cc_loss > nearzero .and. cc_loss < currentCohort%c_area )then @@ -481,6 +505,7 @@ subroutine DemoteFromLayer(currentSite,currentPatch,i_lyr) ! demoted to the understory allocate(copyc) + call InitPRTCohort(copyc) call copy_cohort(currentCohort, copyc) if( hlm_use_planthydro.eq.itrue ) then call InitHydrCohort(currentSite,copyc) @@ -499,7 +524,7 @@ subroutine DemoteFromLayer(currentSite,currentPatch,i_lyr) currentSite%demotion_rate(currentCohort%size_class) = & currentSite%demotion_rate(currentCohort%size_class) + currentCohort%n currentSite%demotion_carbonflux = currentSite%demotion_carbonflux + & - currentCohort%b_total() * currentCohort%n + (leaf_c + store_c + fnrt_c + sapw_c + struct_c) * currentCohort%n call carea_allom(copyc%dbh,copyc%n,currentSite%spread,copyc%pft,copyc%c_area) call carea_allom(currentCohort%dbh,currentCohort%n,currentSite%spread, & @@ -532,46 +557,46 @@ subroutine DemoteFromLayer(currentSite,currentPatch,i_lyr) do i_cwd=1,ncwd currentPatch%CWD_AG(i_cwd) = currentPatch%CWD_AG(i_cwd) + & - (currentCohort%bdead+currentCohort%bsw) * & + (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) + & - (currentCohort%bdead+currentCohort%bsw) * & + (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) + (currentCohort%bl)* & - currentCohort%n/currentPatch%area ! leaf litter flux per m2. + 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) + & - (currentCohort%br+currentCohort%bstore)*currentCohort%n/currentPatch%area + (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*(currentCohort%bdead+currentCohort%bsw) * & + + 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*(currentCohort%bdead+currentCohort%bsw) * & + + 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 * (currentCohort%bl) * hlm_days_per_year / AREA + 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 * (currentCohort%br+currentCohort%bstore) * hlm_days_per_year / AREA + currentCohort%n * (fnrt_c + store_c) * hlm_days_per_year / AREA currentCohort%n = 0.0_r8 currentCohort%c_area = 0.0_r8 @@ -641,7 +666,11 @@ subroutine PromoteIntoLayer(currentSite,currentPatch,i_lyr) real(r8) :: cc_gain ! cohort crown area gain in promotion (m2) real(r8) :: arealayer_current ! area (m2) of the current canopy layer real(r8) :: arealayer_below ! area (m2) of the layer below the current layer - + 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] call CanopyLayerArea(currentPatch,currentSite%spread,i_lyr,arealayer_current) call CanopyLayerArea(currentPatch,currentSite%spread,i_lyr+1,arealayer_below) @@ -663,15 +692,22 @@ subroutine PromoteIntoLayer(currentSite,currentPatch,i_lyr) do while (associated(currentCohort)) !look at the cohorts in the canopy layer below... if(currentCohort%canopy_layer == i_lyr+1)then + + leaf_c = currentCohort%prt%GetState(leaf_organ,all_carbon_species) + store_c = currentCohort%prt%GetState(store_organ,all_carbon_species) + fnrt_c = currentCohort%prt%GetState(fnrt_organ,all_carbon_species) + sapw_c = currentCohort%prt%GetState(sapw_organ,all_carbon_species) + struct_c = currentCohort%prt%GetState(struct_organ,all_carbon_species) + currentCohort%canopy_layer = i_lyr call carea_allom(currentCohort%dbh,currentCohort%n,currentSite%spread, & currentCohort%pft,currentCohort%c_area) ! keep track of number and biomass of promoted cohort currentSite%promotion_rate(currentCohort%size_class) = & - currentSite%promotion_rate(currentCohort%size_class) + currentCohort%n + currentSite%promotion_rate(currentCohort%size_class) + currentCohort%n currentSite%promotion_carbonflux = currentSite%promotion_carbonflux + & - currentCohort%b_total() * currentCohort%n - + (leaf_c + fnrt_c + store_c + sapw_c + struct_c) * currentCohort%n + endif currentCohort => currentCohort%shorter enddo @@ -787,7 +823,9 @@ subroutine PromoteIntoLayer(currentSite,currentPatch,i_lyr) currentCohort => currentPatch%tallest do while (associated(currentCohort)) + + !All the trees in this layer need to promote some area upwards... if(currentCohort%canopy_layer == i_lyr+1)then @@ -801,12 +839,20 @@ subroutine PromoteIntoLayer(currentSite,currentPatch,i_lyr) ! keep track of number and biomass of promoted cohort currentSite%promotion_rate(currentCohort%size_class) = & currentSite%promotion_rate(currentCohort%size_class) + currentCohort%n + + leaf_c = currentCohort%prt%GetState(leaf_organ,all_carbon_species) + store_c = currentCohort%prt%GetState(store_organ,all_carbon_species) + fnrt_c = currentCohort%prt%GetState(fnrt_organ,all_carbon_species) + sapw_c = currentCohort%prt%GetState(sapw_organ,all_carbon_species) + struct_c = currentCohort%prt%GetState(struct_organ,all_carbon_species) + currentSite%promotion_carbonflux = currentSite%promotion_carbonflux + & - currentCohort%b_total() * currentCohort%n + (leaf_c + fnrt_c + store_c + sapw_c + struct_c) * currentCohort%n elseif ( cc_gain > nearzero .and. cc_gain < currentCohort%c_area) then allocate(copyc) + call InitPRTCohort(copyc) call copy_cohort(currentCohort, copyc) !makes an identical copy... if( hlm_use_planthydro.eq.itrue ) then call InitHydrCohort(CurrentSite,copyc) @@ -829,8 +875,15 @@ subroutine PromoteIntoLayer(currentSite,currentPatch,i_lyr) ! keep track of number and biomass of promoted cohort currentSite%promotion_rate(copyc%size_class) = & currentSite%promotion_rate(copyc%size_class) + copyc%n + + leaf_c = copyc%prt%GetState(leaf_organ,all_carbon_species) + store_c = copyc%prt%GetState(store_organ,all_carbon_species) + fnrt_c = copyc%prt%GetState(fnrt_organ,all_carbon_species) + sapw_c = copyc%prt%GetState(sapw_organ,all_carbon_species) + struct_c = copyc%prt%GetState(struct_organ,all_carbon_species) + currentSite%promotion_carbonflux = currentSite%promotion_carbonflux + & - copyc%b_total() * copyc%n + (leaf_c + fnrt_c + store_c + sapw_c + struct_c) * copyc%n call carea_allom(currentCohort%dbh,currentCohort%n,currentSite%spread, & currentCohort%pft,currentCohort%c_area) @@ -964,7 +1017,11 @@ subroutine canopy_summarization( nsites, sites, bc_in ) integer :: ifp integer :: patchn ! identification number for each patch. real(r8) :: canopy_leaf_area ! total amount of leaf area in the vegetated area. m2. - + 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] !---------------------------------------------------------------------- if ( DEBUG ) then @@ -1007,7 +1064,12 @@ subroutine canopy_summarization( nsites, sites, bc_in ) ft = currentCohort%pft - + + leaf_c = currentCohort%prt%GetState(leaf_organ, all_carbon_species) + sapw_c = currentCohort%prt%GetState(sapw_organ, all_carbon_species) + struct_c = currentCohort%prt%GetState(struct_organ, all_carbon_species) + fnrt_c = currentCohort%prt%GetState(fnrt_organ, all_carbon_species) + store_c = currentCohort%prt%GetState(store_organ, all_carbon_species) ! Update the cohort's index within the size bin classes ! Update the cohort's index within the SCPF classification system @@ -1017,7 +1079,7 @@ subroutine canopy_summarization( nsites, sites, bc_in ) call carea_allom(currentCohort%dbh,currentCohort%n,sites(s)%spread,& currentCohort%pft,currentCohort%c_area) - currentCohort%treelai = tree_lai(currentCohort%bl, & + currentCohort%treelai = tree_lai(leaf_c, & currentCohort%pft, currentCohort%c_area, currentCohort%n, & currentCohort%canopy_layer, currentPatch%canopy_layer_tlai ) @@ -1041,9 +1103,9 @@ subroutine canopy_summarization( nsites, sites, bc_in ) currentCohort%pft,currentCohort%canopy_trim call endrun(msg=errMsg(sourcefile, __LINE__)) endif - if( (currentCohort%bsw + currentCohort%bl + currentCohort%br) <= 0._r8)then + if( (sapw_c + leaf_c + fnrt_c) <= 0._r8)then write(fates_log(),*) 'FATES: alive biomass is zero in canopy_summarization', & - currentCohort%bsw + currentCohort%bl + currentCohort%br + sapw_c + leaf_c + fnrt_c call endrun(msg=errMsg(sourcefile, __LINE__)) endif @@ -1139,6 +1201,7 @@ subroutine leaf_area_profile( currentSite , snow_depth_si, frac_sno_eff_si) real(r8) :: max_chite ! top of cohort canopy (m) real(r8) :: lai ! summed lai for checking m2 m-2 real(r8) :: snow_depth_avg ! avg snow over whole site + real(r8) :: leaf_c ! leaf carbon [kg] !---------------------------------------------------------------------- @@ -1189,7 +1252,9 @@ subroutine leaf_area_profile( currentSite , snow_depth_si, frac_sno_eff_si) ! Note that the canopy_layer_lai is also calculated in this loop ! but since we go top down in terms of plant size, we should be okay - currentCohort%treelai = tree_lai(currentCohort%bl, currentCohort%pft, currentCohort%c_area, & + leaf_c = currentCohort%prt%GetState(leaf_organ,all_carbon_species) + + currentCohort%treelai = tree_lai(leaf_c, currentCohort%pft, currentCohort%c_area, & currentCohort%n, currentCohort%canopy_layer, & currentPatch%canopy_layer_tlai ) diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index c82574088e..aca2f749b3 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -22,7 +22,7 @@ module EDCohortDynamicsMod use EDTypesMod , only : min_n_safemath use EDTypesMod , only : nlevleaf use FatesInterfaceMod , only : hlm_use_planthydro - use FatesInterfaceMod , only : parteh_model + use FatesInterfaceMod , only : hlm_parteh_model use FatesPlantHydraulicsMod, only : FuseCohortHydraulics use FatesPlantHydraulicsMod, only : CopyCohortHydraulics use FatesPlantHydraulicsMod, only : updateSizeDepTreeHydProps @@ -156,24 +156,7 @@ subroutine create_cohort(currentSite, patchptr, pft, nn, hite, dbh, bleaf, bfine ! Initialize the Plant allocative Reactive Transport (PaRT) module ! Choose from one of the extensible hypotheses (EH) - select case(parteh_model) - case (1) - - allocate(callom_prt) - new_cohort%prt => callom_prt - -! case(2) - -! allocate(cnpallom_prt) -! new_cohort%prt => cnpallom_prt - - case DEFAULT - write(fates_log(),*) 'You specified an unknown PRT module' - write(fates_log(),*) 'Aborting' - call endrun(msg=errMsg(sourcefile, __LINE__)) - end select - - call ccohort%prt%InitPRTVartype() + call InitPRTCohort(new_cohort) select case(new_cohort%parteh_model) case (1) @@ -269,6 +252,36 @@ subroutine create_cohort(currentSite, patchptr, pft, nn, hite, dbh, bleaf, bfine end subroutine create_cohort + ! ------------------------------------------------------------------------------------- + + subroutine InitPRTCohort(ccohort) + + ! This subroutine simply allocates and attaches the correct PRT object. + ! No meaningful values to are set here. + + select case(parteh_model) + case (1) + + allocate(callom_prt) + new_cohort%prt => callom_prt + +! case(2) + +! allocate(cnpallom_prt) +! new_cohort%prt => cnpallom_prt + + case DEFAULT + write(fates_log(),*) 'You specified an unknown PRT module' + write(fates_log(),*) 'Aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end select + + + call ccohort%prt%InitPRTVartype() + + + end subroutine InitPRTCohort + !-------------------------------------------------------------------------------------! subroutine nan_cohort(cc_p) @@ -311,12 +324,7 @@ subroutine nan_cohort(cc_p) 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%bdead = nan ! dead biomass: kGC per indiv - currentCohort%bstore = nan ! stored carbon: kGC per indiv currentCohort%laimemory = nan ! target leaf biomass- set from previous year: kGC per indiv - currentCohort%bsw = nan ! sapwood in stem and roots: kGC per indiv - currentCohort%bl = nan ! leaf biomass: kGC per indiv - currentCohort%br = nan ! fine root biomass: 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] @@ -357,12 +365,6 @@ subroutine nan_cohort(cc_p) currentCohort%froot_mr = nan ! Fine root maintenance respiration. kgC/indiv/s-1 ! ALLOCATION - currentCohort%md = nan ! plant maintenance demand: kgC/indiv/year - currentCohort%leaf_md = nan ! leaf maintenance demand: kgC/indiv/year - currentCohort%root_md = nan ! root maintenance demand: kgC/indiv/year - currentCohort%bsw_md = nan - currentCohort%bdead_md = nan - currentCohort%bstore_md = nan currentCohort%dmort = nan ! proportional mortality rate. (year-1) currentCohort%lmort_direct = nan currentCohort%lmort_infra = nan @@ -393,6 +395,7 @@ subroutine nan_cohort(cc_p) end subroutine nan_cohort !-------------------------------------------------------------------------------------! + subroutine zero_cohort(cc_p) ! ! !DESCRIPTION: @@ -431,12 +434,6 @@ subroutine zero_cohort(cc_p) currentcohort%ts_net_uptake(:) = 0._r8 currentcohort%seed_prod = 0._r8 currentcohort%cfa = 0._r8 - currentcohort%md = 0._r8 - currentcohort%root_md = 0._r8 - currentcohort%leaf_md = 0._r8 - currentcohort%bstore_md = 0._r8 - currentcohort%bsw_md = 0._r8 - currentcohort%bdead_md = 0._r8 currentcohort%npp_acc_hold = 0._r8 currentcohort%gpp_acc_hold = 0._r8 currentcohort%dmort = 0._r8 @@ -764,12 +761,7 @@ subroutine fuse_cohorts(currentSite, currentPatch, bc_in) write(fates_log(),*) 'Cohort I, Cohort II' write(fates_log(),*) 'n:',currentCohort%n,nextc%n write(fates_log(),*) 'isnew:',currentCohort%isnew,nextc%isnew - write(fates_log(),*) 'bdead:',currentCohort%bdead,nextc%bdead - write(fates_log(),*) 'bstore:',currentCohort%bstore,nextc%bstore write(fates_log(),*) 'laimemory:',currentCohort%laimemory,nextc%laimemory - write(fates_log(),*) 'bsw:',currentCohort%bsw,nextc%bsw - write(fates_log(),*) 'bl:',currentCohort%bl ,nextc%bl - write(fates_log(),*) 'br:',currentCohort%br,nextc%br write(fates_log(),*) 'hite:',currentCohort%hite,nextc%hite write(fates_log(),*) 'dbh:',currentCohort%dbh,nextc%dbh write(fates_log(),*) 'pft:',currentCohort%pft,nextc%pft @@ -781,19 +773,14 @@ subroutine fuse_cohorts(currentSite, currentPatch, bc_in) currentCohort%year_net_uptake(i),nextc%year_net_uptake(i) end do end if - - currentCohort%bdead = (currentCohort%n*currentCohort%bdead & - + nextc%n*nextc%bdead)/newn - currentCohort%bstore = (currentCohort%n*currentCohort%bstore & - + nextc%n*nextc%bstore)/newn + + + ! Fuse all mass pools + call currentCohort%prt%WeightedFusePRTVartypes(nextc%prt, nextc%n/newn ) + currentCohort%laimemory = (currentCohort%n*currentCohort%laimemory & + nextc%n*nextc%laimemory)/newn - currentCohort%bsw = (currentCohort%n*currentCohort%bsw & - + nextc%n*nextc%bsw)/newn - currentCohort%bl = (currentCohort%n*currentCohort%bl & - + nextc%n*nextc%bl)/newn - currentCohort%br = (currentCohort%n*currentCohort%br & - + nextc%n*nextc%br)/newn + currentCohort%dbh = (currentCohort%n*currentCohort%dbh & + nextc%n*nextc%dbh)/newn @@ -811,7 +798,7 @@ subroutine fuse_cohorts(currentSite, currentPatch, bc_in) ! ----------------------------------------------------------------- if( EDPftvarcon_inst%woody(currentCohort%pft) == itrue ) then - call StructureResetOfDH( currentCohort%bdead, currentCohort%pft, & + call StructureResetOfDH( currentCohort%prt%GetState(struct_organ,carbon12_species), currentCohort%pft, & currentCohort%canopy_trim, currentCohort%dbh, currentCohort%hite ) end if @@ -829,20 +816,8 @@ subroutine fuse_cohorts(currentSite, currentPatch, bc_in) if ( .not.currentCohort%isnew) then - currentCohort%md = (currentCohort%n*currentCohort%md + & - nextc%n*nextc%md)/newn currentCohort%seed_prod = (currentCohort%n*currentCohort%seed_prod + & nextc%n*nextc%seed_prod)/newn - currentCohort%root_md = (currentCohort%n*currentCohort%root_md + & - nextc%n*nextc%root_md)/newn - currentCohort%leaf_md = (currentCohort%n*currentCohort%leaf_md + & - nextc%n*nextc%leaf_md)/newn - currentCohort%bstore_md = (currentCohort%n*currentCohort%bstore_md + & - nextc%n*nextc%bstore_md)/newn - currentCohort%bsw_md = (currentCohort%n*currentCohort%bsw_md + & - nextc%n*nextc%bsw_md)/newn - currentCohort%bdead_md = (currentCohort%n*currentCohort%bdead_md + & - nextc%n*nextc%bdead_md)/newn currentCohort%gpp_acc = (currentCohort%n*currentCohort%gpp_acc + & nextc%n*nextc%gpp_acc)/newn currentCohort%npp_acc = (currentCohort%n*currentCohort%npp_acc + & @@ -949,6 +924,11 @@ subroutine fuse_cohorts(currentSite, currentPatch, bc_in) ! At this point, nothing should be pointing to current Cohort if (hlm_use_planthydro.eq.itrue) call DeallocateHydrCohort(nextc) + + ! Deallocate the cohort's PRT structure + call nextc%prt%DeallocatePRTVartypes() + deallocate(nextc%prt) + deallocate(nextc) nullify(nextc) @@ -1211,12 +1191,7 @@ subroutine copy_cohort( currentCohort,copyc ) n%n = o%n n%dbh = o%dbh n%hite = o%hite - n%bdead = o%bdead - n%bstore = o%bstore n%laimemory = o%laimemory - n%bsw = o%bsw - n%bl = o%bl - n%br = o%br n%lai = o%lai n%sai = o%sai n%g_sb_laweight = o%g_sb_laweight @@ -1231,6 +1206,10 @@ subroutine copy_cohort( currentCohort,copyc ) n%size_class = o%size_class n%size_by_pft_class = o%size_by_pft_class + ! This transfers the PRT objects over. + call n%prt%CopyPRTVartypes(o%prt) + + ! CARBON FLUXES n%gpp_acc_hold = o%gpp_acc_hold n%gpp_acc = o%gpp_acc @@ -1265,12 +1244,6 @@ subroutine copy_cohort( currentCohort,copyc ) n%froot_mr = o%froot_mr ! ALLOCATION - n%md = o%md - n%leaf_md = o%leaf_md - n%root_md = o%root_md - n%bsw_md = o%bsw_md - n%bdead_md = o%bdead_md - n%bstore_md = o%bstore_md n%dmort = o%dmort n%lmort_direct = o%lmort_direct n%lmort_infra = o%lmort_infra diff --git a/biogeochem/EDLoggingMortalityMod.F90 b/biogeochem/EDLoggingMortalityMod.F90 index 6ef6f1d1f1..3d5d7831be 100644 --- a/biogeochem/EDLoggingMortalityMod.F90 +++ b/biogeochem/EDLoggingMortalityMod.F90 @@ -260,6 +260,11 @@ subroutine logging_litter_fluxes(currentSite, currentPatch, newPatch, patch_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 @@ -274,8 +279,13 @@ subroutine logging_litter_fluxes(currentSite, currentPatch, newPatch, patch_site currentCohort => currentPatch%shortest do while(associated(currentCohort)) p = currentCohort%pft + + sapw_c = currentCohort%prt%GetState(sapw_organ, all_carbon_species) + struct_c = currentCohort%prt%GetState(struct_organ, all_carbon_species) + leaf_c = currentCohort%prt%GetState(leaf_organ, all_carbon_species) + fnrt_c = currentCohort%prt%GetState(fnrt_organ, all_carbon_species) + store_c = currentCohort%prt%GetState(store_organ, all_carbon_species) - if(currentCohort%canopy_layer == 1)then direct_dead = currentCohort%n * currentCohort%lmort_direct indirect_dead = currentCohort%n * & @@ -315,7 +325,7 @@ subroutine logging_litter_fluxes(currentSite, currentPatch, newPatch, patch_site do c = 1,ncwd-1 woody_litter = (direct_dead+indirect_dead) * & - (currentCohort%bdead+currentCohort%bsw) + (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 @@ -344,7 +354,7 @@ subroutine logging_litter_fluxes(currentSite, currentPatch, newPatch, patch_site ! collateral damange and infrastructure logging is applied to bole litter ! ---------------------------------------------------------------------------------------- - woody_litter = indirect_dead * (currentCohort%bdead+currentCohort%bsw) + woody_litter = indirect_dead * (struct_c + sapw_c) cwd_litter_density = SF_val_CWD_frac(ncwd) * woody_litter / litter_area @@ -368,7 +378,7 @@ subroutine logging_litter_fluxes(currentSite, currentPatch, newPatch, patch_site ! Handle litter flux for the belowground portion of directly logged boles ! ---------------------------------------------------------------------------------------- - woody_litter = direct_dead * (currentCohort%bdead+currentCohort%bsw) + 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) + & @@ -393,7 +403,7 @@ subroutine logging_litter_fluxes(currentSite, currentPatch, newPatch, patch_site ! ---------------------------------------------------------------------------------------- trunk_product_site = trunk_product_site + & - SF_val_CWD_frac(ncwd) * agb_frac * direct_dead * (currentCohort%bdead+currentCohort%bsw) + SF_val_CWD_frac(ncwd) * agb_frac * direct_dead * (struct_c + sapw_c) ! ---------------------------------------------------------------------------------------- @@ -401,8 +411,8 @@ subroutine logging_litter_fluxes(currentSite, currentPatch, newPatch, patch_site ! (none of these are exported) ! ---------------------------------------------------------------------------------------- - leaf_litter = (direct_dead+indirect_dead)*currentCohort%bl - root_litter = (direct_dead+indirect_dead)*(currentCohort%br+currentCohort%bstore) + 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 @@ -431,7 +441,7 @@ subroutine logging_litter_fluxes(currentSite, currentPatch, newPatch, patch_site delta_biomass_stock = delta_biomass_stock + & leaf_litter + & root_litter + & - (direct_dead+indirect_dead) * (currentCohort%bdead+currentCohort%bsw) + (direct_dead+indirect_dead) * (struct_c + sapw_c) delta_individual = delta_individual + & direct_dead + & diff --git a/biogeochem/EDMortalityFunctionsMod.F90 b/biogeochem/EDMortalityFunctionsMod.F90 index 603d6e5227..176fc754bf 100644 --- a/biogeochem/EDMortalityFunctionsMod.F90 +++ b/biogeochem/EDMortalityFunctionsMod.F90 @@ -20,6 +20,8 @@ module EDMortalityFunctionsMod use EDParamsMod , only : fates_mortality_disturbance_fraction use FatesInterfaceMod , only : bc_in_type + use PRTGenericMod, only : carbon12_species + use PRTGenericMod, only : store_organ implicit none private @@ -58,7 +60,8 @@ subroutine mortality_rates( cohort_in,bc_in,cmort,hmort,bmort,frmort ) real(r8),intent(out) :: frmort ! freezing stress mortality real(r8) :: frac ! relativised stored carbohydrate - real(r8) :: b_leaf ! target leaf biomass kgC + real(r8) :: leaf_c_target ! target leaf biomass kgC + real(r8) :: store_c real(r8) :: hf_sm_threshold ! hydraulic failure soil moisture threshold real(r8) :: temp_dep_fraction ! Temp. function (freezing mortality) real(r8) :: temp_in_C ! Daily averaged temperature in Celcius @@ -84,8 +87,11 @@ subroutine mortality_rates( cohort_in,bc_in,cmort,hmort,bmort,frmort ) ! Carbon Starvation induced mortality. if ( cohort_in%dbh > 0._r8 ) then - call bleaf(cohort_in%dbh,cohort_in%pft,cohort_in%canopy_trim,b_leaf) - call storage_fraction_of_target(b_leaf, cohort_in%bstore, frac) + call bleaf(cohort_in%dbh,cohort_in%pft,cohort_in%canopy_trim,leaf_c_target) + + store_c = cohort_in%prt%GetState(store_organ,carbon12_species) + + call storage_fraction_of_target(leaf_c_target, store_c, frac) if( frac .lt. 1._r8) then cmort = max(0.0_r8,EDPftvarcon_inst%mort_scalar_cstarvation(cohort_in%pft) * & (1.0_r8 - frac)) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 358f342297..d35011566d 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -38,6 +38,24 @@ module EDPatchDynamicsMod use FatesConstantsMod , only : years_per_day use FatesConstantsMod , only : nearzero + use EDCohortDynamicsMod , only : InitPRTCohort + + use PRTGenericMod, only : leaf_organ + use PRTGenericMod, only : all_carbon_species + use PRTGenericMod, only : carbon12_species + use PRTGenericMod, only : nitrogen_species + use PRTGenericMod, only : phosphorous_species + use PRTGenericMod, only : leaf_organ + use PRTGenericMod, only : fnrt_organ + use PRTGenericMod, only : sapw_organ + use PRTGenericMod, only : store_organ + use PRTGenericMod, only : repro_organ + use PRTGenericMod, only : struct_organ + use PRTGenericMod, only : carbon12_species + use PRTGenericMod, only : SetState + + + ! CIME globals use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) @@ -312,6 +330,12 @@ subroutine spawn_patches( currentSite, bc_in) 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 + 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] + real(r8) :: total_c ! total carbon of plant [kg] !--------------------------------------------------------------------- storesmallcohort => null() ! storage of the smallest cohort for insertion routine @@ -385,6 +409,7 @@ subroutine spawn_patches( currentSite, bc_in) 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 @@ -396,6 +421,15 @@ subroutine spawn_patches( currentSite, bc_in) nc%canopy_layer = 1 nc%canopy_layer_yesterday = 1._r8 + sapw_c = currentCohort%prt%GetState(sapw_organ, all_carbon_species) + struct_c = currentCohort%prt%GetState(struct_organ, all_carbon_species) + leaf_c = currentCohort%prt%GetState(leaf_organ, all_carbon_species) + fnrt_c = currentCohort%prt%GetState(fnrt_organ, all_carbon_species) + store_c = currentCohort%prt%GetState(store_organ, all_carbon_species) + + 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 @@ -439,9 +473,12 @@ subroutine spawn_patches( currentSite, bc_in) currentSite%imort_rate(currentCohort%size_class, currentCohort%pft) = & currentSite%imort_rate(currentCohort%size_class, currentCohort%pft) + & nc%n * ED_val_understorey_death / hlm_freq_day + + + currentSite%imort_carbonflux = currentSite%imort_carbonflux + & (nc%n * ED_val_understorey_death / hlm_freq_day ) * & - currentCohort%b_total() * g_per_kg * days_per_sec * years_per_day * ha_per_m2 + total_c * g_per_kg * days_per_sec * years_per_day * ha_per_m2 ! Step 2: Apply survivor ship function based on the understory death fraction ! remaining of understory plants of those that are knocked over by the overstorey trees dying... @@ -565,7 +602,7 @@ subroutine spawn_patches( currentSite, bc_in) nc%n * logging_coll_under_frac / hlm_freq_day currentSite%imort_carbonflux = currentSite%imort_carbonflux + & (nc%n * logging_coll_under_frac/ hlm_freq_day ) * & - currentCohort%b_total() * g_per_kg * days_per_sec * years_per_day * ha_per_m2 + total_c * g_per_kg * days_per_sec * years_per_day * ha_per_m2 ! Step 2: Apply survivor ship function based on the understory death fraction @@ -605,7 +642,7 @@ subroutine spawn_patches( currentSite, bc_in) nc%bmort = currentCohort%bmort nc%frmort = currentCohort%frmort nc%dmort = currentCohort%dmort - nc%lmort_direct = currentCohort%lmort_direct + nc%lmort_direct = currentCohort%lmort_direct nc%lmort_collateral = currentCohort%lmort_collateral nc%lmort_infra = currentCohort%lmort_infra @@ -639,8 +676,13 @@ subroutine spawn_patches( currentSite, bc_in) new_patch%tallest => storebigcohort new_patch%shortest => storesmallcohort else + + ! Get rid of the new temporary cohort if(hlm_use_planthydro.eq.itrue) call DeallocateHydrCohort(nc) - deallocate(nc) !get rid of the new memory. + call nc%prt%DeallocatePRTVartypes() + deallocate(nc%prt) + deallocate(nc) + endif currentCohort => currentCohort%taller @@ -845,6 +887,11 @@ subroutine fire_litter_fluxes(currentSite, cp_target, new_patch_target, patch_si 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 grass. KgC/individual/day + 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 !--------------------------------------------------------------------- @@ -884,15 +931,23 @@ subroutine fire_litter_fluxes(currentSite, cp_target, new_patch_target, patch_si 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_species) + struct_c = currentCohort%prt%GetState(struct_organ, all_carbon_species) + leaf_c = currentCohort%prt%GetState(leaf_organ, all_carbon_species) + fnrt_c = currentCohort%prt%GetState(fnrt_organ, all_carbon_species) + store_c = currentCohort%prt%GetState(store_organ, all_carbon_species) + ! stem biomass per tree - bstem = (currentCohort%bsw + currentCohort%bdead) * EDPftvarcon_inst%allom_agb_frac(p) + bstem = (sapw_c + struct_c) * EDPftvarcon_inst%allom_agb_frac(p) ! coarse root biomass per tree - bcroot = (currentCohort%bsw + currentCohort%bdead) * (1.0_r8 - EDPftvarcon_inst%allom_agb_frac(p) ) + 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 @@ -903,20 +958,21 @@ subroutine fire_litter_fluxes(currentSite, cp_target, new_patch_target, patch_si ! Unburned parts of dead tree pool. ! Unburned leaves and roots - new_patch%leaf_litter(p) = new_patch%leaf_litter(p) + dead_tree_density * (currentCohort%bl) & - * (1.0_r8-currentCohort%cfa) - new_patch%root_litter(p) = new_patch%root_litter(p) + dead_tree_density * (currentCohort%br+currentCohort%bstore) + new_patch%leaf_litter(p) = new_patch%leaf_litter(p) + dead_tree_density * leaf_c * (1.0_r8-currentCohort%cfa) + + new_patch%root_litter(p) = new_patch%root_litter(p) + dead_tree_density * (fnrt_c+store_c) + currentPatch%leaf_litter(p) = currentPatch%leaf_litter(p) + dead_tree_density * & - (currentCohort%bl) * (1.0_r8-currentCohort%cfa) + leaf_c * (1.0_r8-currentCohort%cfa) currentPatch%root_litter(p) = currentPatch%root_litter(p) + dead_tree_density * & - (currentCohort%br+currentCohort%bstore) + (fnrt_c + store_c) ! track as diagnostic fluxes currentSite%leaf_litter_diagnostic_input_carbonflux(p) = currentSite%leaf_litter_diagnostic_input_carbonflux(p) + & - (currentCohort%bl) * (1.0_r8-currentCohort%cfa) * currentCohort%fire_mort * currentCohort%n * & + leaf_c * (1.0_r8-currentCohort%cfa) * currentCohort%fire_mort * currentCohort%n * & hlm_days_per_year / AREA currentSite%root_litter_diagnostic_input_carbonflux(p) = currentSite%root_litter_diagnostic_input_carbonflux(p) + & - (currentCohort%br+currentCohort%bstore) * (1.0_r8-currentCohort%cfa) * currentCohort%fire_mort * & + (fnrt_c + store_c) * (1.0_r8-currentCohort%cfa) * currentCohort%fire_mort * & currentCohort%n * hlm_days_per_year / AREA ! below ground coarse woody debris from burned trees @@ -971,11 +1027,13 @@ subroutine fire_litter_fluxes(currentSite, cp_target, new_patch_target, patch_si do p = 1,numpft currentSite%leaf_litter_burned(p) = currentSite%leaf_litter_burned(p) + & - dead_tree_density * currentCohort%bl * currentCohort%cfa + dead_tree_density * leaf_c * currentCohort%cfa + currentSite%flux_out = currentSite%flux_out + & - dead_tree_density * AREA * currentCohort%bl * currentCohort%cfa + dead_tree_density * AREA * leaf_c * currentCohort%cfa + currentSite%total_burn_flux_to_atm = currentSite%total_burn_flux_to_atm + & - dead_tree_density * AREA * currentCohort%bl * currentCohort%cfa + dead_tree_density * AREA * leaf_c * currentCohort%cfa enddo @@ -993,19 +1051,24 @@ subroutine fire_litter_fluxes(currentSite, cp_target, new_patch_target, patch_si currentCohort => new_patch%shortest do while(associated(currentCohort)) + sapw_c = currentCohort%prt%GetState(sapw_organ, all_carbon_species) + leaf_c = currentCohort%prt%GetState(leaf_organ, all_carbon_species) + call carea_allom(currentCohort%dbh,currentCohort%n,currentSite%spread,currentCohort%pft,currentCohort%c_area) if(EDPftvarcon_inst%woody(currentCohort%pft) == 1)then - burned_leaves = min(currentCohort%bl, (currentCohort%bl+currentCohort%bsw) * currentCohort%cfa) + burned_leaves = min(leaf_c, (leaf_c + sapw_c) * currentCohort%cfa) else - burned_leaves = min(currentCohort%bl, (currentCohort%bl+currentCohort%bsw) * currentPatch%burnt_frac_litter(6)) + burned_leaves = min(leaf_c, (leaf_c + sapw_c) * currentPatch%burnt_frac_litter(6)) endif if (burned_leaves > 0.0_r8) then - currentCohort%bl = currentCohort%bl - burned_leaves + ! Remove burned leaves from the pool + call SetState(currentCohort%prt,leaf_organ, carbon12_species, leaf_c - burned_leaves ) !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 @@ -1045,6 +1108,11 @@ subroutine mortality_litter_fluxes(currentSite, cp_target, new_patch_target, pat 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 @@ -1060,6 +1128,12 @@ subroutine mortality_litter_fluxes(currentSite, cp_target, new_patch_target, pat currentCohort => currentPatch%shortest do while(associated(currentCohort)) p = currentCohort%pft + + sapw_c = currentCohort%prt%GetState(sapw_organ, all_carbon_species) + struct_c = currentCohort%prt%GetState(struct_organ, all_carbon_species) + leaf_c = currentCohort%prt%GetState(leaf_organ, all_carbon_species) + fnrt_c = currentCohort%prt%GetState(fnrt_organ, all_carbon_species) + store_c = currentCohort%prt%GetState(store_organ, all_carbon_species) if(currentCohort%canopy_layer == 1)then !currentCohort%dmort = mortality_rates(currentCohort) @@ -1067,12 +1141,14 @@ subroutine mortality_litter_fluxes(currentSite, cp_target, new_patch_target, pat !not right to recalcualte dmort here. canopy_dead = currentCohort%n * min(1.0_r8,currentCohort%dmort * hlm_freq_day * fates_mortality_disturbance_fraction) + + canopy_mortality_woody_litter(p)= canopy_mortality_woody_litter(p) + & - canopy_dead*(currentCohort%bdead+currentCohort%bsw) + canopy_dead*(struct_c + sapw_c) canopy_mortality_leaf_litter(p) = canopy_mortality_leaf_litter(p) + & - canopy_dead*(currentCohort%bl) + canopy_dead*leaf_c canopy_mortality_root_litter(p) = canopy_mortality_root_litter(p) + & - canopy_dead*(currentCohort%br+currentCohort%bstore) + canopy_dead*(fnrt_c + store_c) if( hlm_use_planthydro == itrue ) then call AccumulateMortalityWaterStorage(currentSite,currentCohort, canopy_dead) @@ -1083,11 +1159,11 @@ subroutine mortality_litter_fluxes(currentSite, cp_target, new_patch_target, pat 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*(currentCohort%bdead+currentCohort%bsw) + understorey_dead*(struct_c + sapw_c) canopy_mortality_leaf_litter(p)= canopy_mortality_leaf_litter(p)+ & - understorey_dead* currentCohort%bl + understorey_dead*leaf_c canopy_mortality_root_litter(p)= canopy_mortality_root_litter(p)+ & - understorey_dead*(currentCohort%br+currentCohort%bstore) + understorey_dead*(fnrt_c + store_c) if( hlm_use_planthydro == itrue ) then call AccumulateMortalityWaterStorage(currentSite,currentCohort, understorey_dead) @@ -1895,7 +1971,8 @@ subroutine patch_pft_size_profile(cp_pnt) currentPatch%pft_agb_profile(currentCohort%pft,j) = & currentPatch%pft_agb_profile(currentCohort%pft,j) + & - currentCohort%bdead*currentCohort%n/currentPatch%area + currentCohort%prt%GetState(struct_organ, all_carbon_species) * & + currentCohort%n/currentPatch%area endif enddo ! dbh bins diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 08689f6271..8df1d2e87c 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -54,9 +54,18 @@ module EDPhysiologyMod use FatesAllometryMod , only : CheckIntegratedAllometries use FatesAllometryMod , only : StructureResetOfDH - use FatesIntegratorsMod, only : RKF45 - use FatesIntegratorsMod, only : Euler - + use PRTGenericMod, only : leaf_organ + use PRTGenericMod, only : all_carbon_species + use PRTGenericMod, only : carbon12_species + use PRTGenericMod, only : nitrogen_species + use PRTGenericMod, only : phosphorous_species + use PRTGenericMod, only : leaf_organ + use PRTGenericMod, only : fnrt_organ + use PRTGenericMod, only : sapw_organ + use PRTGenericMod, only : store_organ + use PRTGenericMod, only : repro_organ + use PRTGenericMod, only : struct_organ + use PRTGenericMod, only : SetState implicit none private @@ -74,6 +83,7 @@ module EDPhysiologyMod private :: seed_decay private :: seed_germination public :: flux_into_litter_pools + public :: ZeroAllocationRates logical, parameter :: DEBUG = .false. ! local debug flag @@ -93,6 +103,31 @@ module EDPhysiologyMod contains + subroutine ZeroAllocationRates( currentSite ) + + ! !ARGUMENTS + type(ed_site_type), intent(inout), target :: currentSite + type(ed_patch_type), pointer :: currentPatch + type(ed_cohort_type), pointer :: currentCohort + + currentPatch => currentSite%youngest_patch + do while(associated(currentPatch)) + + currentCohort => currentPatch%tallest + do while (associated(currentCohort)) + + ! This sets turnover and growth rates to zero + call currentCohort%prt%ZeroRates() + + currentCohort => currentCohort%shorter + enddo + currentPatch => currentPatch%older + end do + + return + end subroutine ZeroAllocationRates + + ! ============================================================================ subroutine non_canopy_derivs( currentSite, currentPatch, bc_in ) @@ -182,7 +217,11 @@ subroutine trim_canopy( currentSite ) integer :: cl ! canopy layer index 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] real(r8) :: leaf_inc ! LAI-only portion of the vegetation increment of dinc_ed real(r8) :: lai_canopy_above ! the LAI in the canopy layers above the layer of interest real(r8) :: lai_layers_above ! the LAI in the leaf layers, within the current canopy, @@ -201,7 +240,10 @@ subroutine trim_canopy( currentSite ) trimmed = .false. ipft = currentCohort%pft call carea_allom(currentCohort%dbh,currentCohort%n,currentSite%spread,currentCohort%pft,currentCohort%c_area) - currentCohort%treelai = tree_lai(currentCohort%bl, currentCohort%pft, currentCohort%c_area, & + + leaf_c = currentCohort%prt%GetState(leaf_organ, all_carbon_species) + + currentCohort%treelai = tree_lai(leaf_c, currentCohort%pft, currentCohort%c_area, & currentCohort%n, currentCohort%canopy_layer, & currentPatch%canopy_layer_tlai ) @@ -214,7 +256,7 @@ subroutine trim_canopy( currentSite ) if (currentCohort%nv > nlevleaf)then write(fates_log(),*) 'nv > nlevleaf',currentCohort%nv, & currentCohort%treelai,currentCohort%treesai, & - currentCohort%c_area,currentCohort%n,currentCohort%bl + currentCohort%c_area,currentCohort%n,leaf_c call endrun(msg=errMsg(sourcefile, __LINE__)) endif @@ -366,6 +408,12 @@ subroutine phenology( currentSite, bc_in ) integer :: day ! day of month (1, ..., 31) integer :: sec ! seconds of the day + 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] + real(r8) :: gdd_threshold integer :: ncdstart ! beginning of counting period for chilling degree days. integer :: gddstart ! beginning of counting period for growing degree days. @@ -595,6 +643,10 @@ subroutine phenology_leafonoff(currentSite) type(ed_patch_type) , pointer :: currentPatch type(ed_cohort_type), pointer :: currentCohort + real(r8) :: leaf_c ! leaf carbon [kg] + real(r8) :: store_c ! storage carbon [kg] + real(r8) :: transferred_c ! carbon transferred from storage to leaf [kg] + real(r8) :: store_output ! the amount of the store to put into leaves - ! is a barrier against negative storage and C starvation. @@ -609,28 +661,28 @@ subroutine phenology_leafonoff(currentSite) do while(associated(currentCohort)) currentCohort%leaf_litter = 0.0_r8 !zero leaf litter for today. - + + ! Retrieve existing leaf and storage carbon + + store_c = currentCohort%prt%GetState(store_organ, carbon12_species) + leaf_c = currentCohort%prt%GetState(leaf_organ, carbon12_species) + + !COLD LEAF ON if (EDPftvarcon_inst%season_decid(currentCohort%pft) == 1)then if (currentSite%status == 2)then !we have just moved to leaves being on . if (currentCohort%status_coh == 1)then !Are the leaves currently off? currentCohort%status_coh = 2 !Leaves are on, so change status to stop flow of carbon out of bstore. - if (currentCohort%laimemory <= currentCohort%bstore)then - currentCohort%bl = currentCohort%laimemory !extract stored carbon to make new leaves. - else - ! we can only put on as much carbon as there is in the store... - ! nb. Putting all of bstore into leaves is C-starvation suicidal. - ! The tendency for this could be parameterized - currentCohort%bl = currentCohort%bstore * store_output - endif - - - if ( DEBUG ) write(fates_log(),*) 'EDPhysMod 1 ',currentCohort%bstore - currentCohort%bstore = currentCohort%bstore - currentCohort%bl ! Drain store + transferred_c = min(currentCohort%laimemory, store_c*store_output) + + ! Transfer into leaves + call SetState(currentCohort%prt,leaf_organ, carbon12_species, transferred_c ) - if ( DEBUG ) write(fates_log(),*) 'EDPhysMod 2 ',currentCohort%bstore + ! Reduce storage + call SetState(currentCohort%prt,store_organ, carbon12_species, store_c - transferred_c ) + store_c = store_c - transferred_c currentCohort%laimemory = 0.0_r8 endif !pft phenology @@ -638,39 +690,43 @@ subroutine phenology_leafonoff(currentSite) !COLD LEAF OFF ! currentCohort%leaf_litter = 0.0_r8 !zero leaf litter for today. + if (currentSite%status == 1)then !past leaf drop day? Leaves still on tree? if (currentCohort%status_coh == 2)then ! leaves have not dropped - currentCohort%status_coh = 1 + currentCohort%status_coh = 1 !remember what the lai was this year to put the same amount back on in the spring... - currentCohort%laimemory = currentCohort%bl + currentCohort%laimemory = leaf_c ! add lost carbon to litter - currentCohort%leaf_litter = currentCohort%bl - currentCohort%bl = 0.0_r8 + currentCohort%leaf_litter = leaf_c + + ! Drop Leaves + ! (THIS NEEDS TO MIGRATED TO A PRT PHENOLOGY SCHEME THAT HANDLES + ! ARBITRARY SPECIES (EG N+P) ) + call SetState(currentCohort%prt,leaf_organ, carbon12_species, 0.0_r8 ) + leaf_c = 0.0_r8 endif !leaf status endif !currentSite status endif !season_decid !DROUGHT LEAF ON + + if (EDPftvarcon_inst%stress_decid(currentCohort%pft) == 1)then if (currentSite%dstatus == 2)then !we have just moved to leaves being on . if (currentCohort%status_coh == 1)then !is it the leaf-on day? Are the leaves currently off? currentCohort%status_coh = 2 !Leaves are on, so change status to stop flow of carbon out of bstore. - if (currentCohort%laimemory <= currentCohort%bstore)then - currentCohort%bl = currentCohort%laimemory !extract stored carbon to make new leaves. - else - - !we can only put on as much carbon as there is in the store. - currentCohort%bl = currentCohort%bstore * store_output - endif - if ( DEBUG ) write(fates_log(),*) 'EDPhysMod 3 ',currentCohort%bstore + transferred_c = min(currentCohort%laimemory, store_c*store_output) + + ! Transfer into leaves + call SetState(currentCohort%prt,leaf_organ, carbon12_species, transferred_c ) - currentCohort%bstore = currentCohort%bstore - currentCohort%bl ! empty store - - if ( DEBUG ) write(fates_log(),*) 'EDPhysMod 4 ',currentCohort%bstore + ! Reduce storage + call SetState(currentCohort%prt,store_organ, carbon12_species, store_c - transferred_c ) + store_c = store_c - transferred_c currentCohort%laimemory = 0.0_r8 endif !currentCohort status again? @@ -680,12 +736,14 @@ subroutine phenology_leafonoff(currentSite) if (currentSite%dstatus == 1)then if (currentCohort%status_coh == 2)then ! leaves have not dropped currentCohort%status_coh = 1 - currentCohort%laimemory = currentCohort%bl - ! add retranslocated carbon (very small) to store. - currentCohort%bstore = currentCohort%bstore + + currentCohort%laimemory = leaf_c + ! add falling leaves to litter pools . convert to KgC/m2 - currentCohort%leaf_litter = currentCohort%bl - currentCohort%bl = 0.0_r8 + currentCohort%leaf_litter = leaf_c + + call SetState(currentCohort%prt,leaf_organ, carbon12_species, 0.0_r8 ) + leaf_c = 0.0_r8 endif endif !status @@ -846,819 +904,7 @@ subroutine seed_germination( currentSite, currentPatch ) end subroutine seed_germination ! ============================================================================ - subroutine PlantGrowth( currentSite, currentCohort, bc_in ) - ! - ! !DESCRIPTION: - ! Main subroutine for plant allocation and growth - ! - ! !USES: - ! Original: Rosie Fisher - ! Updated: Ryan Knox - - use FatesInterfaceMod, only : hlm_use_ed_prescribed_phys - - ! - ! !ARGUMENTS - type(ed_site_type), intent(inout), target :: currentSite - type(ed_cohort_type),intent(inout), target :: currentCohort - type(bc_in_type), intent(in) :: bc_in - ! - ! !LOCAL VARIABLES: - - integer :: ipft ! PFT index - - - real(r8) :: carbon_balance ! daily carbon balance for this cohort - - ! Per plant allocation targets - real(r8) :: bt_leaf ! leaf biomass (kgC) - real(r8) :: dbt_leaf_dd ! change in leaf biomass wrt diameter (kgC/cm) - real(r8) :: bt_fineroot ! fine root biomass (kgC) - real(r8) :: dbt_fineroot_dd ! change in fine root biomass wrt diameter (kgC/cm) - real(r8) :: bt_sap ! sapwood biomass (kgC) - real(r8) :: dbt_sap_dd ! change in sapwood biomass wrt diameter (kgC/cm) - real(r8) :: bt_agw ! above ground biomass (kgC/cm) - real(r8) :: dbt_agw_dd ! change in above ground biomass wrt diameter (kgC/cm) - real(r8) :: bt_bgw ! coarse root biomass (kgC) - real(r8) :: dbt_bgw_dd ! change in coarse root biomass (kgC/cm) - real(r8) :: bt_dead ! dead (structural) biomass (kgC) - real(r8) :: dbt_dead_dd ! change in dead biomass wrt diameter (kgC/cm) - real(r8) :: bt_store ! target storage biomass (kgC) - real(r8) :: dbt_store_dd ! target rate of change in storage (kgC/cm) - real(r8) :: dbt_total_dd ! total target biomass rate of change (kgC/cm) - - real(r8) :: leaf_below_target ! leaf biomass below target amount [kgC] - real(r8) :: froot_below_target ! fineroot biomass below target amount [kgC] - real(r8) :: sap_below_target ! sapwood biomass below target amount [kgC] - real(r8) :: store_below_target ! storage biomass below target amount [kgC] - real(r8) :: dead_below_target ! dead (structural) biomass below target amount [kgC] - real(r8) :: total_below_target ! total biomass below the allometric target [kgC] - - real(r8) :: bstore_flux ! carbon fluxing into storage [kgC] - real(r8) :: bl_flux ! carbon fluxing into leaves [kgC] - real(r8) :: br_flux ! carbon fluxing into fineroots [kgC] - real(r8) :: bsw_flux ! carbon fluxing into sapwood [kgC] - real(r8) :: bdead_flux ! carbon fluxing into structure [kgC] - real(r8) :: brepro_flux ! carbon fluxing into reproductive tissues [kgC] - real(r8) :: flux_adj ! adjustment made to growth flux term to minimize error [kgC] - - real(r8) :: store_target_fraction ! ratio between storage and leaf biomass when on allometry [kgC] - real(r8) :: repro_fraction ! fraction of carbon gain sent to reproduction when on-allometry - - real(r8) :: leaf_turnover_demand ! leaf carbon that is demanded to replace maintenance turnover [kgC] - real(r8) :: root_turnover_demand ! fineroot carbon that is demanded to replace - ! maintenance turnover [kgC] - real(r8) :: total_turnover_demand ! total carbon that is demanded to replace maintenance turnover [kgC] - - real(r8),dimension(n_cplantpools) :: c_pool ! Vector of carbon pools passed to integrator - real(r8),dimension(n_cplantpools) :: c_pool_out ! Vector of carbon pools passed back from integrator - logical,dimension(n_cplantpools) :: c_mask ! Mask of active pools during integration - - logical :: step_pass ! Did the integration step pass? - - logical :: grow_leaf ! Are leaves at allometric target and should be grown? - logical :: grow_froot ! Are fine-roots at allometric target and should be grown? - logical :: grow_sap ! Is sapwood at allometric target and should be grown? - logical :: grow_store ! Is storage at allometric target and should be grown? - - ! integrator variables - real(r8) :: deltaC ! trial value for substep - integer :: ierr ! error flag for allometric growth step - integer :: nsteps ! number of sub-steps - integer :: istep ! current substep index - real(r8) :: totalC ! total carbon allocated over alometric growth step - real(r8) :: dbh_sub ! substep dbh - real(r8) :: h_sub ! substep h - real(r8) :: bl_sub ! substep leaf biomass - real(r8) :: br_sub ! substep root biomass - real(r8) :: bsw_sub ! substep sapwood biomass - real(r8) :: bstore_sub ! substep storage biomass - real(r8) :: bdead_sub ! substep structural biomass - real(r8) :: brepro_sub ! substep reproductive biomass - - - ! Woody turnover timescale [years] - real(r8), parameter :: cbal_prec = 1.0e-15_r8 ! Desired precision in carbon balance - ! non-integrator part - integer , parameter :: max_substeps = 300 ! Number of step attempts before - ! giving up - real(r8), parameter :: max_trunc_error = 1.0_r8 ! allowable numerical truncation error - integer, parameter :: ODESolve = 2 ! 1=RKF45, 2=Euler - - - ipft = currentCohort%pft - - ! Initialize seed production - currentCohort%seed_prod = 0.0_r8 - - ! Initialize NPP flux diagnostics - currentCohort%npp_stor = 0.0_r8 - currentCohort%npp_leaf = 0.0_r8 - currentCohort%npp_fnrt = 0.0_r8 - currentCohort%npp_dead = 0.0_r8 - currentCohort%npp_seed = 0.0_r8 - currentCohort%npp_sapw = 0.0_r8 - - ! Initialize rates of change - currentCohort%dhdt = 0.0_r8 - currentCohort%dbdeaddt = 0.0_r8 - currentCohort%dbstoredt = 0.0_r8 - currentCohort%ddbhdt = 0.0_r8 - - ! If the cohort has grown, it is not new - currentCohort%isnew=.false. - - ! ----------------------------------------------------------------------------------- - ! I. Identify the net carbon gain for this dynamics interval - ! Set the available carbon pool, identify allocation portions, and decrement - ! the available carbon pool to zero. - ! ----------------------------------------------------------------------------------- - - ! convert from kgC/indiv/day into kgC/indiv/year - ! _acc_hold is remembered until the next dynamics step (used for I/O) - ! _acc will be reset soon and will be accumulated on the next leaf photosynthesis - ! step - - if (hlm_use_ed_prescribed_phys .eq. itrue) then - if (currentCohort%canopy_layer .eq. 1) then - currentCohort%npp_acc_hold = EDPftvarcon_inst%prescribed_npp_canopy(ipft) & - * currentCohort%c_area / currentCohort%n - ! add these for balance checking purposes - currentCohort%npp_acc = currentCohort%npp_acc_hold / hlm_days_per_year - else - currentCohort%npp_acc_hold = EDPftvarcon_inst%prescribed_npp_understory(ipft) & - * currentCohort%c_area / currentCohort%n - ! add these for balance checking purposes - currentCohort%npp_acc = currentCohort%npp_acc_hold / hlm_days_per_year - endif - else - currentCohort%npp_acc_hold = currentCohort%npp_acc * dble(hlm_days_per_year) - currentCohort%gpp_acc_hold = currentCohort%gpp_acc * dble(hlm_days_per_year) - currentCohort%resp_acc_hold = currentCohort%resp_acc * dble(hlm_days_per_year) - endif - - currentSite%flux_in = currentSite%flux_in + currentCohort%npp_acc * currentCohort%n - - - ! Available carbon for growth [kgC] - carbon_balance = currentCohort%npp_acc - - ! ----------------------------------------------------------------------------------- - ! II. Calculate target size of living biomass compartment for a given dbh. - ! ----------------------------------------------------------------------------------- - - ! Target sapwood biomass and deriv. according to allometry and trimming [kgC, kgC/cm] - call bsap_allom(currentCohort%dbh,ipft,currentCohort%canopy_trim,bt_sap,dbt_sap_dd) - - ! Target total above ground deriv. biomass in woody/fibrous tissues [kgC, kgC/cm] - call bagw_allom(currentCohort%dbh,ipft,bt_agw,dbt_agw_dd) - - ! Target total below ground deriv. biomass in woody/fibrous tissues [kgC, kgC/cm] - call bbgw_allom(currentCohort%dbh,ipft,bt_bgw,dbt_bgw_dd) - - ! Target total dead (structrual) biomass and deriv. [kgC, kgC/cm] - call bdead_allom( bt_agw, bt_bgw, bt_sap, ipft, bt_dead, & - dbt_agw_dd, dbt_bgw_dd, dbt_sap_dd, dbt_dead_dd ) - - ! ------------------------------------------------------------------------------------ - ! If structure is larger than target, then we need to correct some integration errors - ! by slightly increasing dbh to match it. - ! ----------------------------------------------------------------------------------- - if( ((currentCohort%bdead-bt_dead) > calloc_abs_error) .and. & - (EDPftvarcon_inst%woody(ipft) == itrue) ) then - call StructureResetOfDH( currentCohort%bdead, ipft, & - currentCohort%canopy_trim, currentCohort%dbh, currentCohort%hite ) - - ! Re-calculate the sapwood and structural wood targets based on the new dbh - ! ------------------------------------------------------------------------------------------ - - ! Target sapwood biomass and deriv. according to allometry and trimming [kgC, kgC/cm] - call bsap_allom(currentCohort%dbh,ipft,currentCohort%canopy_trim,bt_sap,dbt_sap_dd) - - ! Target total above ground deriv. biomass in woody/fibrous tissues [kgC, kgC/cm] - call bagw_allom(currentCohort%dbh,ipft,bt_agw,dbt_agw_dd) - - ! Target total below ground deriv. biomass in woody/fibrous tissues [kgC, kgC/cm] - call bbgw_allom(currentCohort%dbh,ipft,bt_bgw,dbt_bgw_dd) - - ! Target total dead (structrual) biomass and deriv. [kgC, kgC/cm] - call bdead_allom( bt_agw, bt_bgw, bt_sap, ipft, bt_dead, & - dbt_agw_dd, dbt_bgw_dd, dbt_sap_dd, dbt_dead_dd ) - - end if - - ! Target leaf biomass according to allometry and trimming - call bleaf(currentCohort%dbh,ipft,currentCohort%canopy_trim,bt_leaf,dbt_leaf_dd) - - ! Target fine-root biomass and deriv. according to allometry and trimming [kgC, kgC/cm] - call bfineroot(currentCohort%dbh,ipft,currentCohort%canopy_trim,bt_fineroot,dbt_fineroot_dd) - - ! Target storage carbon [kgC,kgC/cm] - call bstore_allom(currentCohort%dbh,ipft,currentCohort%canopy_trim,bt_store,dbt_store_dd) - - - ! ----------------------------------------------------------------------------------- - ! III(b). Calculate the maintenance turnover demands - ! NOTE(RGK): If branches are falling all year, even on deciduous trees, we should - ! be pulling some leaves with them when leaves are out... - ! - ! If the turnover time-scales are zero, that means there is no turnover. - ! - ! ----------------------------------------------------------------------------------- - currentCohort%leaf_md = 0.0_r8 - currentCohort%bsw_md = 0.0_r8 - currentCohort%bdead_md = 0.0_r8 - currentCohort%bstore_md = 0.0_r8 - currentCohort%root_md = 0.0_r8 - - if ( EDPftvarcon_inst%branch_turnover(ipft) > tiny(EDPftvarcon_inst%branch_turnover(ipft)) ) then - currentCohort%bsw_md = currentCohort%bsw / EDPftvarcon_inst%branch_turnover(ipft) - currentCohort%bdead_md = currentCohort%bdead / EDPftvarcon_inst%branch_turnover(ipft) - currentCohort%bstore_md = currentCohort%bstore / EDPftvarcon_inst%branch_turnover(ipft) - end if - - if (EDPftvarcon_inst%evergreen(ipft) == 1)then - currentCohort%leaf_md = currentCohort%bl / EDPftvarcon_inst%leaf_long(ipft) - currentCohort%root_md = currentCohort%br / EDPftvarcon_inst%root_long(ipft) - endif - - if (EDPftvarcon_inst%season_decid(ipft) == 1)then - currentCohort%root_md = currentCohort%br /EDPftvarcon_inst%root_long(ipft) - endif - - if (EDPftvarcon_inst%stress_decid(ipft) == 1)then - currentCohort%root_md = currentCohort%br /EDPftvarcon_inst%root_long(ipft) - endif - - ! ----------------------------------------------------------------------------------- - ! IV. Remove turnover from the appropriate pools - ! - ! Units: kgC/year * (year/days_per_year) = kgC/day -> (day elapsed) -> kgC - ! ----------------------------------------------------------------------------------- - - currentCohort%bl = currentCohort%bl - currentCohort%leaf_md*hlm_freq_day - currentcohort%br = currentcohort%br - currentCohort%root_md*hlm_freq_day - currentcohort%bsw = currentcohort%bsw - currentCohort%bsw_md*hlm_freq_day - currentCohort%bdead = currentCohort%bdead - currentCohort%bdead_md*hlm_freq_day - currentCohort%bstore = currentCohort%bstore - currentCohort%bstore_md*hlm_freq_day - - - ! ----------------------------------------------------------------------------------- - ! V. Prioritize some amount of carbon to replace leaf/root turnover - ! Make sure it isnt a negative payment, and either pay what is available - ! or forcefully pay from storage. - ! ----------------------------------------------------------------------------------- - - leaf_turnover_demand = currentCohort%leaf_md*EDPftvarcon_inst%leaf_stor_priority(ipft)*hlm_freq_day - root_turnover_demand = currentCohort%root_md*EDPftvarcon_inst%leaf_stor_priority(ipft)*hlm_freq_day - total_turnover_demand = leaf_turnover_demand + root_turnover_demand - - if(total_turnover_demand>0.0_r8)then - - ! If we are testing b4b, then we pay this even if we don't have the carbon - ! Just don't pay so much carbon that storage+carbon_balance can't pay for it - bl_flux = min(leaf_turnover_demand, & - max(0.0_r8,(currentCohort%bstore+carbon_balance)* & - (leaf_turnover_demand/total_turnover_demand))) - - carbon_balance = carbon_balance - bl_flux - currentCohort%bl = currentCohort%bl + bl_flux - currentCohort%npp_leaf = currentCohort%npp_leaf + bl_flux / hlm_freq_day - - ! If we are testing b4b, then we pay this even if we don't have the carbon - br_flux = min(root_turnover_demand, & - max(0.0_r8, (currentCohort%bstore+carbon_balance)* & - (root_turnover_demand/total_turnover_demand))) - - carbon_balance = carbon_balance - br_flux - currentCohort%br = currentCohort%br + br_flux - currentCohort%npp_fnrt = currentCohort%npp_fnrt + br_flux / hlm_freq_day - - end if - - - ! ----------------------------------------------------------------------------------- - ! VI. if carbon balance is negative, re-coup the losses from storage - ! if it is positive, give some love to storage carbon - ! NOTE: WE ARE STILL ALLOWING STORAGE CARBON TO GO NEGATIVE, AT LEAST IN THIS - ! PART OF THE CODE. - ! ----------------------------------------------------------------------------------- - - if( carbon_balance < 0.0_r8 ) then - - bstore_flux = carbon_balance - carbon_balance = carbon_balance - bstore_flux - currentCohort%bstore = currentCohort%bstore + bstore_flux - currentCohort%npp_stor = currentCohort%npp_stor + bstore_flux / hlm_freq_day - ! We have pushed to net-zero carbon, the rest of this routine can be ignored - return - - else - - store_below_target = max(bt_store - currentCohort%bstore,0.0_r8) - store_target_fraction = max(0.0_r8,currentCohort%bstore/bt_store) - - bstore_flux = min(store_below_target,carbon_balance * & - max(exp(-1.*store_target_fraction**4._r8) - exp( -1.0_r8 ),0.0_r8)) - - carbon_balance = carbon_balance - bstore_flux - currentCohort%bstore = currentCohort%bstore + bstore_flux - currentCohort%npp_stor = currentCohort%npp_stor + bstore_flux / hlm_freq_day - end if - - ! ----------------------------------------------------------------------------------- - ! VII. If carbon is still available, prioritize some allocation to replace - ! the rest of the leaf/fineroot turnover demand - ! carbon balance is guaranteed to be >=0 beyond this point - ! ----------------------------------------------------------------------------------- - - leaf_turnover_demand = currentCohort%leaf_md * & - (1.0_r8-EDPftvarcon_inst%leaf_stor_priority(ipft))*hlm_freq_day - root_turnover_demand = currentCohort%root_md * & - (1.0_r8-EDPftvarcon_inst%leaf_stor_priority(ipft))*hlm_freq_day - total_turnover_demand = leaf_turnover_demand + root_turnover_demand - - if(total_turnover_demand>0.0_r8)then - - bl_flux = min(leaf_turnover_demand, carbon_balance*(leaf_turnover_demand/total_turnover_demand)) - carbon_balance = carbon_balance - bl_flux - currentCohort%bl = currentCohort%bl + bl_flux - currentCohort%npp_leaf = currentCohort%npp_leaf + bl_flux / hlm_freq_day - - br_flux = min(root_turnover_demand, carbon_balance*(root_turnover_demand/total_turnover_demand)) - carbon_balance = carbon_balance - br_flux - currentCohort%br = currentCohort%br + br_flux - currentCohort%npp_fnrt = currentCohort%npp_fnrt + br_flux / hlm_freq_day - - end if - - - ! ----------------------------------------------------------------------------------- - ! VIII. If carbon is still available, we try to push all live - ! pools back towards allometry. But only upwards, if fusion happened - ! to generate some pools above allometric target, don't reduce the pool, - ! just ignore it until the rest of the plant grows to meet it. - ! ----------------------------------------------------------------------------------- - - if( carbon_balance0.0_r8) then - - if( total_below_target > carbon_balance) then - bl_flux = carbon_balance * leaf_below_target/total_below_target - br_flux = carbon_balance * froot_below_target/total_below_target - bsw_flux = carbon_balance * sap_below_target/total_below_target - bstore_flux = carbon_balance * store_below_target/total_below_target - else - bl_flux = leaf_below_target - br_flux = froot_below_target - bsw_flux = sap_below_target - bstore_flux = store_below_target - end if - - carbon_balance = carbon_balance - bl_flux - currentCohort%bl = currentCohort%bl + bl_flux - currentCohort%npp_leaf = currentCohort%npp_leaf + bl_flux / hlm_freq_day - - carbon_balance = carbon_balance - br_flux - currentCohort%br = currentCohort%br + br_flux - currentCohort%npp_fnrt = currentCohort%npp_fnrt + br_flux / hlm_freq_day - - carbon_balance = carbon_balance - bsw_flux - currentCohort%bsw = currentCohort%bsw + bsw_flux - currentCohort%npp_sapw = currentCohort%npp_sapw + bsw_flux / hlm_freq_day - - carbon_balance = carbon_balance - bstore_flux - currentCohort%bstore = currentCohort%bstore + bstore_flux - currentCohort%npp_stor = currentCohort%npp_stor + bstore_flux / hlm_freq_day - - end if - - ! ----------------------------------------------------------------------------------- - ! IX. If carbon is still available, replenish the structural pool to get - ! back on allometry - ! ----------------------------------------------------------------------------------- - - if( carbon_balance 0.0_r8 .and. dead_below_target>0.0_r8) then - - bdead_flux = min(carbon_balance,dead_below_target) - carbon_balance = carbon_balance - bdead_flux - currentCohort%bdead = currentCohort%bdead + bdead_flux - currentCohort%npp_dead = currentCohort%npp_dead + bdead_flux / hlm_freq_day - - end if - - ! ----------------------------------------------------------------------------------- - ! X. If carbon is yet still available ... - ! Our pools are now either on allometry or above (from fusion). - ! We we can increment those pools at or below, - ! including structure and reproduction according to their rates - ! Use an adaptive euler integration. If the error is not nominal, - ! the carbon balance sub-step (deltaC) will be halved and tried again - ! ----------------------------------------------------------------------------------- - - if( carbon_balance" flag, allowing the plant to grow into these pools. - ! Again this is possible due to erors in numerical integration and/or the fusion - ! process. - ! It also checks to make sure that structural biomass is not below the target. - ! Note that we assume structural biomass is always on allometry. - ! For non-woody plants, we do not perform this partial growth logic (ie - ! allowing only some pools to grow), we let all pools at or above allometry to - ! grow. This is because we can't force any single pool to be on-allometry, and - ! thus a condition could potentially occur where all pools, either from fusion or - ! numerical errors, are above allometry and would be flagged to not grow, in which - ! case the plant would be frozen in time - - if ( EDPftvarcon_inst%woody(ipft) == itrue ) then - call TargetAllometryCheck(currentCohort%bl,currentCohort%br,currentCohort%bsw, & - currentCohort%bstore,currentCohort%bdead, & - bt_leaf,bt_fineroot,bt_sap,bt_store,bt_dead, & - grow_leaf,grow_froot,grow_sap,grow_store) - else - grow_leaf = .true. - grow_froot = .true. - grow_sap = .true. - grow_store = .true. - end if - - - ! Initialize the adaptive integrator arrays and flags - ! ----------------------------------------------------------------------------------- - ierr = 1 - totalC = carbon_balance - nsteps = 0 - c_pool(i_dbh) = currentCohort%dbh - c_pool(i_cleaf) = currentCohort%bl - c_pool(i_cfroot) = currentCohort%br - c_pool(i_csap) = currentCohort%bsw - c_pool(i_cstore) = currentCohort%bstore - c_pool(i_cdead) = currentCohort%bdead - c_pool(i_crepro) = 0.0_r8 - c_mask(i_dbh) = .true. ! Always increment dbh on growth step - c_mask(i_cleaf) = grow_leaf - c_mask(i_cfroot) = grow_froot - c_mask(i_csap) = grow_sap - c_mask(i_cstore) = grow_store - c_mask(i_cdead) = .true. ! Always increment dead on growth step - c_mask(i_crepro) = .true. ! Always calculate reproduction on growth - if(ODESolve == 2) then - currentCohort%ode_opt_step = totalC - end if - - do while( ierr .ne. 0 ) - - deltaC = min(totalC,currentCohort%ode_opt_step) - if(ODESolve == 1) then - call RKF45(AllomCGrowthDeriv,c_pool,c_mask,deltaC,totalC,currentCohort, & - max_trunc_error,c_pool_out,step_pass) - - elseif(ODESolve == 2) then - call Euler(AllomCGrowthDeriv,c_pool,c_mask,deltaC,totalC,currentCohort,c_pool_out) -! step_pass = .true. - call CheckIntegratedAllometries(c_pool_out(i_dbh),ipft,currentCohort%canopy_trim, & - c_pool_out(i_cleaf), c_pool_out(i_cfroot), c_pool_out(i_csap), & - c_pool_out(i_cstore), c_pool_out(i_cdead), & - c_mask(i_cleaf), c_mask(i_cfroot), c_mask(i_csap), & - c_mask(i_cstore),c_mask(i_cdead), max_trunc_error, step_pass) - if(step_pass) then - currentCohort%ode_opt_step = deltaC - else - currentCohort%ode_opt_step = 0.5*deltaC - end if - else - write(fates_log(),*) 'An integrator was chosen that DNE' - write(fates_log(),*) 'ODESolve = ',ODESolve - call endrun(msg=errMsg(sourcefile, __LINE__)) - end if - - nsteps = nsteps + 1 - - if (step_pass) then ! If true, then step is accepted - totalC = totalC - deltaC - c_pool(:) = c_pool_out(:) - end if - - if(nsteps > max_substeps ) then - write(fates_log(),*) 'Plant Growth Integrator could not find' - write(fates_log(),*) 'a solution in less than ',max_substeps,' tries' - write(fates_log(),*) 'Aborting' - write(fates_log(),*) 'carbon_balance',carbon_balance - write(fates_log(),*) 'deltaC',deltaC - write(fates_log(),*) 'totalC',totalC - write(fates_log(),*) 'leaf:',grow_leaf,c_pool_out(i_cleaf),bt_leaf,bt_leaf-currentCohort%bl - write(fates_log(),*) 'froot:',grow_froot,c_pool_out(i_cfroot),bt_fineroot,currentCohort%br - write(fates_log(),*) 'sap:',grow_sap,c_pool_out(i_csap),bt_sap,currentCohort%bsw - write(fates_log(),*) 'store:',grow_store, c_pool_out(i_cstore),bt_store,currentCohort%bstore - write(fates_log(),*) 'dead:',c_pool_out(i_cdead),bt_dead,currentCohort%bdead - call dump_cohort(currentCohort) - call endrun(msg=errMsg(sourcefile, __LINE__)) - end if - - ! TotalC should eventually be whittled down to near zero - ! At that point, update the actual states - ! -------------------------------------------------------------------------------- - if( (totalC < calloc_abs_error) .and. (step_pass) )then - ierr = 0 - - bl_flux = c_pool(i_cleaf) - currentCohort%bl - br_flux = c_pool(i_cfroot) - currentCohort%br - bsw_flux = c_pool(i_csap) - currentCohort%bsw - bstore_flux = c_pool(i_cstore) - currentCohort%bstore - bdead_flux = c_pool(i_cdead) - currentCohort%bdead - brepro_flux = c_pool(i_crepro) - - ! Make an adjustment to flux partitions to make it match remaining c balance - flux_adj = carbon_balance/(bl_flux+br_flux+bsw_flux + & - bstore_flux+bdead_flux+brepro_flux) - - bl_flux = bl_flux*flux_adj - br_flux = br_flux*flux_adj - bsw_flux = bsw_flux*flux_adj - bstore_flux = bstore_flux*flux_adj - bdead_flux = bdead_flux*flux_adj - brepro_flux = brepro_flux*flux_adj - - carbon_balance = carbon_balance - bl_flux - currentCohort%bl = currentCohort%bl + bl_flux - currentCohort%npp_leaf = currentCohort%npp_leaf + bl_flux / hlm_freq_day - - carbon_balance = carbon_balance - br_flux - currentCohort%br = currentCohort%br + br_flux - currentCohort%npp_fnrt = currentCohort%npp_fnrt + br_flux / hlm_freq_day - - carbon_balance = carbon_balance - bsw_flux - currentCohort%bsw = currentCohort%bsw + bsw_flux - currentCohort%npp_sapw = currentCohort%npp_sapw + bsw_flux / hlm_freq_day - - carbon_balance = carbon_balance - bstore_flux - currentCohort%bstore = currentCohort%bstore + bstore_flux - currentCohort%npp_stor = currentCohort%npp_stor + bstore_flux / hlm_freq_day - - carbon_balance = carbon_balance - bdead_flux - currentCohort%bdead = currentCohort%bdead + bdead_flux - currentCohort%npp_dead = currentCohort%npp_dead + bdead_flux / hlm_freq_day - - carbon_balance = carbon_balance - brepro_flux - currentCohort%npp_seed = currentCohort%npp_seed + brepro_flux / hlm_freq_day - currentCohort%seed_prod = currentCohort%seed_prod + brepro_flux / hlm_freq_day - - dbh_sub = c_pool(i_dbh) - call h_allom(dbh_sub,ipft,h_sub) - - ! Set derivatives used as diagnostics - currentCohort%dhdt = (h_sub-currentCohort%hite)/hlm_freq_day - currentCohort%dbdeaddt = bdead_flux/hlm_freq_day - currentCohort%dbstoredt = bstore_flux/hlm_freq_day - currentCohort%ddbhdt = (dbh_sub-currentCohort%dbh)/hlm_freq_day - - currentCohort%dbh = dbh_sub - currentCohort%hite = h_sub - - if( abs(carbon_balance)>calloc_abs_error ) then - write(fates_log(),*) 'carbon conservation error while integrating pools' - write(fates_log(),*) 'along alometric curve' - write(fates_log(),*) 'carbon_balance = ',carbon_balance,totalC - write(fates_log(),*) 'exiting' - call endrun(msg=errMsg(sourcefile, __LINE__)) - end if - - end if - end do - - return - end subroutine PlantGrowth - - ! ====================================================================================== - - function AllomCGrowthDeriv(c_pools,c_mask,cbalance,currentCohort) result(dCdx) - - ! --------------------------------------------------------------------------------- - ! This function calculates the derivatives for the carbon pools - ! relative to the amount of carbon balance. This function is based completely - ! off of allometry, and assumes that there are no other species (ie nutrients) that - ! govern allocation. - ! --------------------------------------------------------------------------------- - - ! Arguments - real(r8),intent(in), dimension(:) :: c_pools ! Vector of carbon pools - ! dbh,leaf,root,sap,store,dead - logical,intent(in), dimension(:) :: c_mask ! logical mask of active pools - ! some may be turned off - real(r8),intent(in) :: cbalance ! The carbon balance of the - ! partial step (independant var) - ! THIS IS A DUMMY VAR - type(ed_cohort_type),intent(in),target :: currentCohort ! Cohort derived type - - - ! Return Value - real(r8),dimension(lbound(c_pools,dim=1):ubound(c_pools,dim=1)) :: dCdx - - ! locals - integer :: ipft ! pft index - real(r8) :: ct_leaf ! target leaf biomass, dummy var (kgC) - real(r8) :: ct_froot ! target fine-root biomass, dummy var (kgC) - real(r8) :: ct_sap ! target sapwood biomass, dummy var (kgC) - real(r8) :: ct_agw ! target aboveground wood, dummy var (kgC) - real(r8) :: ct_bgw ! target belowground wood, dummy var (kgC) - real(r8) :: ct_store ! target storage, dummy var (kgC) - real(r8) :: ct_dead ! target structural biomas, dummy var (kgC) - - real(r8) :: ct_dleafdd ! target leaf biomass derivative wrt d, (kgC/cm) - real(r8) :: ct_dfrootdd ! target fine-root biomass derivative wrt d, (kgC/cm) - real(r8) :: ct_dsapdd ! target sapwood biomass derivative wrt d, (kgC/cm) - real(r8) :: ct_dagwdd ! target AG wood biomass derivative wrt d, (kgC/cm) - real(r8) :: ct_dbgwdd ! target BG wood biomass derivative wrt d, (kgC/cm) - real(r8) :: ct_dstoredd ! target storage biomass derivative wrt d, (kgC/cm) - real(r8) :: ct_ddeaddd ! target structural biomass derivative wrt d, (kgC/cm) - real(r8) :: ct_dtotaldd ! target total (not reproductive) biomass derivative wrt d, (kgC/cm) - real(r8) :: repro_fraction ! fraction of carbon balance directed towards reproduction (kgC/kgC) - - - - associate( dbh => c_pools(i_dbh), & - cleaf => c_pools(i_cleaf), & - cfroot => c_pools(i_cfroot), & - csap => c_pools(i_csap), & - cstore => c_pools(i_cstore), & - cdead => c_pools(i_cdead), & - crepro => c_pools(i_crepro), & ! Unused (memoryless) - mask_dbh => c_mask(i_dbh), & ! Unused (dbh always grows) - mask_leaf => c_mask(i_cleaf), & - mask_froot=> c_mask(i_cfroot), & - mask_sap => c_mask(i_csap), & - mask_store=> c_mask(i_cstore), & - mask_dead => c_mask(i_cdead), & ! Unused (dead always grows) - mask_repro=> c_mask(i_crepro) ) ! Unused (memoryless) - - ipft = currentCohort%pft - - call bleaf(dbh,ipft,currentCohort%canopy_trim,ct_leaf,ct_dleafdd) - call bfineroot(dbh,ipft,currentCohort%canopy_trim,ct_froot,ct_dfrootdd) - call bsap_allom(dbh,ipft,currentCohort%canopy_trim,ct_sap,ct_dsapdd) - call bagw_allom(dbh,ipft,ct_agw,ct_dagwdd) - call bbgw_allom(dbh,ipft,ct_bgw,ct_dbgwdd) - call bdead_allom(ct_agw,ct_bgw, ct_sap, ipft, ct_dead, & - ct_dagwdd, ct_dbgwdd, ct_dsapdd, ct_ddeaddd) - call bstore_allom(dbh,ipft,currentCohort%canopy_trim,ct_store,ct_dstoredd) - - ! fraction of carbon going towards reproduction - if (dbh <= EDPftvarcon_inst%dbh_repro_threshold(ipft)) then ! cap on leaf biomass - repro_fraction = EDPftvarcon_inst%seed_alloc(ipft) - else - repro_fraction = EDPftvarcon_inst%seed_alloc(ipft) + EDPftvarcon_inst%seed_alloc_mature(ipft) - end if - - dCdx = 0.0_r8 - - ct_dtotaldd = ct_ddeaddd - if (mask_leaf) ct_dtotaldd = ct_dtotaldd + ct_dleafdd - if (mask_froot) ct_dtotaldd = ct_dtotaldd + ct_dfrootdd - if (mask_sap) ct_dtotaldd = ct_dtotaldd + ct_dsapdd - if (mask_store) ct_dtotaldd = ct_dtotaldd + ct_dstoredd - - ! It is possible that with some asymptotic, or hard - ! capped allometries, that all growth rates reach zero. - ! In this case, if there is carbon, give it to reproduction - -! repro_fraction = 0.0_r8 - - if(ct_dtotaldd<=tiny(ct_dtotaldd))then - - dCdx(i_cdead) = 0.0_r8 - dCdx(i_dbh) = 0.0_r8 - dCdx(i_cleaf) = 0.0_r8 - dCdx(i_cfroot) = 0.0_r8 - dCdx(i_csap) = 0.0_r8 - dCdx(i_cstore) = 0.0_r8 - dCdx(i_crepro) = 1.0_r8 - - else - - dCdx(i_cdead) = (ct_ddeaddd/ct_dtotaldd)*(1.0_r8-repro_fraction) - dCdx(i_dbh) = (1.0_r8/ct_dtotaldd)*(1.0_r8-repro_fraction) - - if (mask_leaf) then - dCdx(i_cleaf) = (ct_dleafdd/ct_dtotaldd)*(1.0_r8-repro_fraction) - else - dCdx(i_cleaf) = 0.0_r8 - end if - - if (mask_froot) then - dCdx(i_cfroot) = (ct_dfrootdd/ct_dtotaldd)*(1.0_r8-repro_fraction) - else - dCdx(i_cfroot) = 0.0_r8 - end if - - if (mask_sap) then - dCdx(i_csap) = (ct_dsapdd/ct_dtotaldd)*(1.0_r8-repro_fraction) - else - dCdx(i_csap) = 0.0_r8 - end if - - if (mask_store) then - dCdx(i_cstore) = (ct_dstoredd/ct_dtotaldd)*(1.0_r8-repro_fraction) - else - dCdx(i_cstore) = 0.0_r8 - end if - - dCdx(i_crepro) = repro_fraction - - end if - - - end associate - - return - end function AllomCGrowthDeriv - - ! ====================================================================================== - - subroutine TargetAllometryCheck(bleaf,bfroot,bsap,bstore,bdead, & - bt_leaf,bt_froot,bt_sap,bt_store,bt_dead, & - grow_leaf,grow_froot,grow_sap,grow_store) - - ! Arguments - real(r8),intent(in) :: bleaf !actual - real(r8),intent(in) :: bfroot - real(r8),intent(in) :: bsap - real(r8),intent(in) :: bstore - real(r8),intent(in) :: bdead - real(r8),intent(in) :: bt_leaf !target - real(r8),intent(in) :: bt_froot - real(r8),intent(in) :: bt_sap - real(r8),intent(in) :: bt_store - real(r8),intent(in) :: bt_dead - logical,intent(out) :: grow_leaf !growth flag - logical,intent(out) :: grow_froot - logical,intent(out) :: grow_sap - logical,intent(out) :: grow_store - - if( (bt_leaf - bleaf)>calloc_abs_error) then - write(fates_log(),*) 'leaves are not on-allometry at the growth step' - write(fates_log(),*) 'exiting',bleaf,bt_leaf - call endrun(msg=errMsg(sourcefile, __LINE__)) - elseif( (bleaf - bt_leaf)>calloc_abs_error) then - ! leaf is above allometry, ignore - grow_leaf = .false. - else - grow_leaf = .true. - end if - - if( (bt_froot - bfroot)>calloc_abs_error) then - write(fates_log(),*) 'fineroots are not on-allometry at the growth step' - write(fates_log(),*) 'exiting',bfroot, bt_froot - call endrun(msg=errMsg(sourcefile, __LINE__)) - elseif( ( bfroot-bt_froot)>calloc_abs_error ) then - grow_froot = .false. - else - grow_froot = .true. - end if - - if( (bt_sap - bsap)>calloc_abs_error) then - write(fates_log(),*) 'sapwood is not on-allometry at the growth step' - write(fates_log(),*) 'exiting',bsap, bt_sap - call endrun(msg=errMsg(sourcefile, __LINE__)) - elseif( ( bsap-bt_sap)>calloc_abs_error ) then - grow_sap = .false. - else - grow_sap = .true. - end if - - if( (bt_store - bstore)>calloc_abs_error) then - write(fates_log(),*) 'storage is not on-allometry at the growth step' - write(fates_log(),*) 'exiting',bstore,bt_store - call endrun(msg=errMsg(sourcefile, __LINE__)) - elseif( ( bstore-bt_store)>calloc_abs_error ) then - grow_store = .false. - else - grow_store = .true. - end if - - if( (bt_dead - bdead)>calloc_abs_error) then - write(fates_log(),*) 'structure not on-allometry at the growth step' - write(fates_log(),*) 'exiting',bdead,bt_dead - call endrun(msg=errMsg(sourcefile, __LINE__)) - end if - end subroutine TargetAllometryCheck - - ! ============================================================================ subroutine recruitment( currentSite, currentPatch, bc_in ) ! ! !DESCRIPTION: @@ -1779,6 +1025,17 @@ subroutine CWD_Input( currentSite, currentPatch) 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 integer :: pft !---------------------------------------------------------------------- @@ -1791,32 +1048,48 @@ subroutine CWD_Input( currentSite, currentPatch) do while(associated(currentCohort)) pft = currentCohort%pft + + leaf_c_turnover = currentCohort%prt%GetTurnover(leaf_organ,all_carbon_species) + store_c_turnover = currentCohort%prt%GetTurnover(store_organ,all_carbon_species) + fnrt_c_turnover = currentCohort%prt%GetTurnover(fnrt_organ,all_carbon_species) + sapw_c_turnover = currentCohort%prt%GetTurnover(sapw_organ,all_carbon_species) + struct_c_turnover = currentCohort%prt%GetTurnover(struct_organ,all_carbon_species) + + leaf_c = currentCohort%prt%GetState(leaf_organ,all_carbon_species) + store_c = currentCohort%prt%GetState(store_organ,all_carbon_species) + fnrt_c = currentCohort%prt%GetState(fnrt_organ,all_carbon_species) + sapw_c = currentCohort%prt%GetState(sapw_organ,all_carbon_species) + struct_c = currentCohort%prt%GetState(struct_organ,all_carbon_species) + ! ================================================ ! Litter from tissue turnover. KgC/m2/year ! ================================================ - currentPatch%leaf_litter_in(pft) = currentPatch%leaf_litter_in(pft) + & - currentCohort%leaf_md * currentCohort%n/currentPatch%area !turnover + currentPatch%leaf_litter_in(pft) = currentPatch%leaf_litter_in(pft) + & + leaf_c_turnover * currentCohort%n/currentPatch%area/hlm_freq_day + currentPatch%root_litter_in(pft) = currentPatch%root_litter_in(pft) + & - (currentCohort%root_md + currentCohort%bstore_md) & - * currentCohort%n/currentPatch%area !turnover - + (fnrt_c_turnover + store_c_turnover ) * currentCohort%n/currentPatch%area + currentPatch%leaf_litter_in(pft) = currentPatch%leaf_litter_in(pft) + & - currentCohort%leaf_litter * currentCohort%n/currentPatch%area/hlm_freq_day - + currentCohort%leaf_litter * currentCohort%n/currentPatch%area/hlm_freq_day + !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) + & - (currentCohort%bdead_md + currentCohort%bsw_md) * & - SF_val_CWD_frac(c) * currentCohort%n/currentPatch%area * EDPftvarcon_inst%allom_agb_frac(currentCohort%pft) + (sapw_turnover + struct_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) + & - (currentCohort%bdead_md + currentCohort%bsw_md) * & - SF_val_CWD_frac(c) * currentCohort%n/currentPatch%area *(1.0_r8-EDPftvarcon_inst%allom_agb_frac(currentCohort%pft)) + (sapw_turnover + struct_turnover)/hlm_freq_day * & + SF_val_CWD_frac(c) * currentCohort%n/currentPatch%area * & + (1.0_r8-EDPftvarcon_inst%allom_agb_frac(currentCohort%pft)) enddo !if (currentCohort%canopy_layer > 1)then @@ -1831,7 +1104,7 @@ subroutine CWD_Input( currentSite, currentPatch) ! 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 + currentCohort%n/hlm_freq_day/currentPatch%area ! Total number of dead understory from indirect logging dead_n_ilogging = ( currentCohort%lmort_collateral + currentCohort%lmort_infra) * & @@ -1839,27 +1112,28 @@ subroutine CWD_Input( currentSite, currentPatch) dead_n_natural = dead_n - dead_n_dlogging - dead_n_ilogging - + currentPatch%leaf_litter_in(pft) = currentPatch%leaf_litter_in(pft) + & - (currentCohort%bl)* dead_n + (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 - !(currentCohort%bl+currentCohort%leaf_litter/hlm_freq_day)* dead_n + currentPatch%root_litter_in(pft) = currentPatch%root_litter_in(pft) + & - (currentCohort%br+currentCohort%bstore) * dead_n + (fnrt_c + store_c ) * dead_n ! Update diagnostics that track resource management currentSite%resources_management%delta_litter_stock = & currentSite%resources_management%delta_litter_stock + & - (currentCohort%bl+currentCohort%br+currentCohort%bstore) * & + (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 + & - (currentCohort%bl+currentCohort%br+currentCohort%bstore) * & + (leaf_c + fnrt_c + store_c ) * & (dead_n_ilogging+dead_n_dlogging) * & hlm_freq_day * currentPatch%area @@ -1870,25 +1144,25 @@ subroutine CWD_Input( currentSite, currentPatch) do c = 1,ncwd - currentPatch%cwd_BG_in(c) = currentPatch%cwd_BG_in(c) + (currentCohort%bdead+currentCohort%bsw) * & + 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)) ! 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) + (currentCohort%bdead+currentCohort%bsw) * & + 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 - currentPatch%cwd_AG_in(c) = currentPatch%cwd_AG_in(c) + (currentCohort%bdead+currentCohort%bsw) * & + 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) ! Send AGB component of boles from direct-logging activities to export/harvest pool ! Generate trunk product (kgC/day/site) - trunk_product = (currentCohort%bdead+currentCohort%bsw) * & + 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 @@ -1907,19 +1181,19 @@ subroutine CWD_Input( currentSite, currentPatch) ! Update diagnostics that track resource management currentSite%resources_management%delta_litter_stock = & currentSite%resources_management%delta_litter_stock + & - (currentCohort%bdead+currentCohort%bsw) * & + (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 + & - (currentCohort%bdead+currentCohort%bsw) * & + (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), & - (currentCohort%bdead+currentCohort%bsw), dead_n + (struct_c + sapw_c), dead_n endif end do @@ -2148,6 +1422,11 @@ subroutine flux_into_litter_pools(nsites, sites, bc_in, bc_out) 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 ! NOTE(rgk, 201705) this parameter was brought over from SoilBiogeochemVerticalProfile ! how steep profile is for surface components (1/ e_folding depth) (1/m) @@ -2158,6 +1437,8 @@ subroutine flux_into_litter_pools(nsites, sites, bc_in, bc_out) real(r8) :: croot_prof(1:nsites, 1:hlm_numlevgrnd) real(r8) :: stem_prof(1:nsites, 1:hlm_numlevgrnd) + + delta = 0.001_r8 !no of seconds in a year. time_convert = 365.0_r8*sec_per_day @@ -2346,11 +1627,19 @@ subroutine flux_into_litter_pools(nsites, sites, bc_in, bc_out) biomass_bg_ft(1:numpft) = 0._r8 currentCohort => currentPatch%tallest do while(associated(currentCohort)) + + leaf_c = currentCohort%prt%GetState(leaf_organ,all_carbon_species) + store_c = currentCohort%prt%GetState(store_organ,all_carbon_species) + fnrt_c = currentCohort%prt%GetState(fnrt_organ,all_carbon_species) + sapw_c = currentCohort%prt%GetState(sapw_organ,all_carbon_species) + struct_c = currentCohort%prt%GetState(struct_organ,all_carbon_species) + biomass_bg_ft(currentCohort%pft) = biomass_bg_ft(currentCohort%pft) + & - ((currentCohort%bdead + currentCohort%bsw ) * & - (1.0_r8-EDPftvarcon_inst%allom_agb_frac(currentCohort%pft)) + & - (currentCohort%br + currentCohort%bstore )) * & - (currentCohort%n / currentPatch%area) + ( (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 ! diff --git a/fire/SFMainMod.F90 b/fire/SFMainMod.F90 index fd1f50e0fd..fa7784e473 100644 --- a/fire/SFMainMod.F90 +++ b/fire/SFMainMod.F90 @@ -28,6 +28,21 @@ module SFMainMod use EDtypesMod , only : NFSC use EDtypesMod , only : TR_SF + use PRTGenericMod, only : leaf_organ + use PRTGenericMod, only : all_carbon_species + use PRTGenericMod, only : carbon12_species + use PRTGenericMod, only : nitrogen_species + use PRTGenericMod, only : phosphorous_species + use PRTGenericMod, only : leaf_organ + use PRTGenericMod, only : fnrt_organ + use PRTGenericMod, only : sapw_organ + use PRTGenericMod, only : store_organ + use PRTGenericMod, only : repro_organ + use PRTGenericMod, only : struct_organ + use PRTGenericMod, only : carbon12_species + use PRTGenericMod, only : SetState + + implicit none private @@ -167,7 +182,11 @@ subroutine charecteristics_of_fuel ( currentSite ) currentCohort => currentPatch%tallest do while(associated(currentCohort)) if(EDPftvarcon_inst%woody(currentCohort%pft) == 0)then - currentPatch%livegrass = currentPatch%livegrass + currentCohort%bl*currentCohort%n/currentPatch%area + + currentPatch%livegrass = currentPatch%livegrass + & + currentCohort%prt%GetState(leaf_organ, all_carbon_species) * & + currentCohort%n/currentPatch%area + endif currentCohort => currentCohort%shorter enddo @@ -822,8 +841,11 @@ subroutine crown_scorching ( currentSite ) currentCohort => currentPatch%tallest; do while(associated(currentCohort)) if (EDPftvarcon_inst%woody(currentCohort%pft) == 1) then !trees only - tree_ag_biomass = tree_ag_biomass+(currentCohort%bl+EDPftvarcon_inst%allom_agb_frac(currentCohort%pft)* & - (currentCohort%bsw + currentCohort%bdead))*currentCohort%n + tree_ag_biomass = tree_ag_biomass + & + (currentCohort%prt%GetState(leaf_organ, all_carbon_species) + & + EDPftvarcon_inst%allom_agb_frac(currentCohort%pft) * & + (currentCohort%prt%GetState(sapw_organ, all_carbon_species) + & + currentCohort%prt%GetState(struct_organ, all_carbon_species) ))*currentCohort%n endif !trees only currentCohort=>currentCohort%shorter; @@ -838,8 +860,14 @@ subroutine crown_scorching ( currentSite ) do while(associated(currentCohort)) if (EDPftvarcon_inst%woody(currentCohort%pft) == 1 & .and. (tree_ag_biomass > 0.0_r8)) then !trees only - f_ag_bmass = ((currentCohort%bl+EDPftvarcon_inst%allom_agb_frac(currentCohort%pft)*(currentCohort%bsw + & - currentCohort%bdead))*currentCohort%n)/tree_ag_biomass + + f_ag_biomass = (currentCohort%prt%GetState(leaf_organ, all_carbon_species) + & + EDPftvarcon_inst%allom_agb_frac(currentCohort%pft) * & + (currentCohort%prt%GetState(sapw_organ, all_carbon_species) + & + currentCohort%prt%GetState(struct_organ, all_carbon_species) ))*currentCohort%n + + f_ag_bmass = f_ag_biomass/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 diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index 817adf0850..ec5fd79d50 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -32,6 +32,7 @@ module EDMainMod use EDPhysiologyMod , only : phenology use EDPhysiologyMod , only : recruitment use EDPhysiologyMod , only : trim_canopy + use EDPhysiologyMod , only : ZeroAllocationRates use SFMainMod , only : fire_model use FatesSizeAgeTypeIndicesMod, only : get_age_class_index use EDtypesMod , only : ncwd @@ -108,6 +109,10 @@ subroutine ed_ecosystem_dynamics(currentSite, bc_in) !FIX(SPM,032414) take this out. On startup these values are all zero and on restart it !zeros out values read in the restart file + + ! Zero turnover rates and growth diagnostics + call ZeroAllocationRates(currentSite) + call ed_total_balance_check(currentSite, 0) @@ -239,6 +244,8 @@ subroutine ed_integrate_state_variables(currentSite, bc_in ) integer :: ft ! Counter for PFT real(r8) :: small_no ! to circumvent numerical errors that cause negative values of things that can't be negative 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] !----------------------------------------------------------------------- small_no = 0.0000000000_r8 ! Obviously, this is arbitrary. RF - changed to zero @@ -268,9 +275,59 @@ subroutine ed_integrate_state_variables(currentSite, bc_in ) ! Calculate the mortality derivatives call Mortality_Derivative( currentSite, currentCohort, bc_in ) + ! ----------------------------------------------------------------------------- + ! Apply Plant Allocation and Reactive Transport + ! ----------------------------------------------------------------------------- + + hite_old = currentCohort%hite + dbh_old = currentCohort%dbh + + ! ----------------------------------------------------------------------------- + ! Identify the net carbon gain for this dynamics interval + ! Set the available carbon pool, identify allocation portions, and + ! decrement the available carbon pool to zero. + ! ----------------------------------------------------------------------------- + ! + ! convert from kgC/indiv/day into kgC/indiv/year + ! _acc_hold is remembered until the next dynamics step (used for I/O) + ! _acc will be reset soon and will be accumulated on the next leaf + ! photosynthesis step + ! ----------------------------------------------------------------------------- + + if (hlm_use_ed_prescribed_phys .eq. itrue) then + if (currentCohort%canopy_layer .eq. 1) then + currentCohort%npp_acc_hold = EDPftvarcon_inst%prescribed_npp_canopy(ipft) & + * currentCohort%c_area / currentCohort%n + ! add these for balance checking purposes + currentCohort%npp_acc = currentCohort%npp_acc_hold / hlm_days_per_year + else + currentCohort%npp_acc_hold = EDPftvarcon_inst%prescribed_npp_understory(ipft) & + * currentCohort%c_area / currentCohort%n + ! add these for balance checking purposes + currentCohort%npp_acc = currentCohort%npp_acc_hold / hlm_days_per_year + endif + else + currentCohort%npp_acc_hold = currentCohort%npp_acc * dble(hlm_days_per_year) + currentCohort%gpp_acc_hold = currentCohort%gpp_acc * dble(hlm_days_per_year) + currentCohort%resp_acc_hold = currentCohort%resp_acc * dble(hlm_days_per_year) + endif + + currentSite%flux_in = currentSite%flux_in + currentCohort%npp_acc * currentCohort%n + + call currentCohort%prt%DailyPRT() - ! Apply growth to potentially all carbon pools - call PlantGrowth( currentSite, currentCohort, bc_in ) + ! Transfer all reproductive tissues into seed production + currentCohort%seed_prod = currentCohort%prt%GetState(repro_organ,all_carbon_species) / hlm_freq_day + call SetState(currentCohort%prt,repro_organ,carbon12_species,0.0_r8) + + ! This cohort has grown, it is no longer "new" + currentCohort%is_new = .false. + + ! Update the plant height (if it has grown) + call h_allom(currentCohort%dbh,currentCohort%pft,currentCohort%hite) + + currentCohort%dhdt = (currentCohort%hite-hite_old)/hlm_freq_day + currentCohort%ddbhdt = (currentCohort%dbh-dbh_old)/hlm_freq_day ! Carbon assimilate has been spent at this point ! and can now be safely zero'd @@ -522,15 +579,17 @@ subroutine ed_total_balance_check (currentSite, call_index ) write(fates_log(),*)'---' currentCohort => currentPatch%tallest do while(associated(currentCohort)) - write(fates_log(),*) currentCohort%bdead,currentCohort%bstore,currentCohort%n + write(fates_log(),*) 'structure: ',currentCohort%prt%GetState(struct_organ,all_carbon_species) + write(fates_log(),*) 'storage: ',currentCohort%prt%GetState(storage_organ,all_carbon_species) + write(fates_log(),*) 'N plant: ',currentCohort%n currentCohort => currentCohort%shorter; enddo !end cohort loop currentPatch => currentPatch%younger enddo !end patch loop end if - + 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( int(hlm_current_year*10000 + hlm_current_month*100 + hlm_current_day).ne.hlm_reference_date ) then write(fates_log(),*) 'aborting on date:',hlm_current_year,hlm_current_month,hlm_current_day diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 4b4adce29f..2d8e63e27d 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -226,12 +226,6 @@ module EDTypesMod real(r8) :: froot_mr ! Live fine root maintenance respiration: kgC/indiv/s ! ALLOCATION - real(r8) :: md ! plant maintenance demand: kgC/indiv/year - real(r8) :: leaf_md ! leaf maintenance demand: kgC/indiv/year - real(r8) :: root_md ! root maintenance demand: kgC/indiv/year - real(r8) :: bsw_md ! sawpwood maintenance demand: kgC/indiv/year - real(r8) :: bstore_md ! storage maintenance demand: kgC/indiv/year - real(r8) :: bdead_md ! structural (branch) maintenance demand: kgC/indiv/year real(r8) :: seed_prod ! reproduction seed and clonal: KgC/indiv/year real(r8) :: leaf_litter ! leaf litter from phenology: KgC/m2 diff --git a/parteh/PRTGenericMod.F90 b/parteh/PRTGenericMod.F90 index 8597051db5..5fdcec497f 100644 --- a/parteh/PRTGenericMod.F90 +++ b/parteh/PRTGenericMod.F90 @@ -135,11 +135,17 @@ module PRTGenericMod type prt_vartype - real(r8),allocatable :: val(:) ! Instantaneous state variable [kg] + real(r8),allocatable :: val(:) ! Instantaneous state variable [kg] real(r8),allocatable :: val0(:) ! State variable at the beginning - ! of allocation step [kg] - real(r8),allocatable :: dvaldt(:) ! Net rate of non-turnover change [kg/day] - real(r8),allocatable :: turnover(:) ! Loss rate due to turnover [kg/day] + ! of the control period [kg] + real(r8),allocatable :: net_art(:) ! Net change due to allocation/transport [kg] + ! over the control period [kg] + real(r8),allocatable :: turnover(:) ! Losses rate due to turnover [kg] + ! or, any mass destined for litter + ! over the control period + +! real(r8),allocatable :: burned(:) ! Losses due to burn [kg] +! real(r8),allocatable :: herbiv(:) ! Losses due to herbivory [kg] ! Placeholder ! To save on memory, keep this commented out, or simply @@ -357,7 +363,7 @@ subroutine InitializeInitialConditions(this) this%variables(i_var)%val(:) = un_initialized this%variables(i_var)%val0(:) = un_initialized this%variables(i_var)%turnover(:) = un_initialized - this%variables(i_var)%dvaldt(:) = un_initialized + this%variables(i_var)%net_art(:) = un_initialized end do @@ -515,7 +521,8 @@ subroutine CopyPRTVartypes(this, donor_prt_obj) do i_var = 1, n_vars this%variables(i_var)%val(:) = donor_prt_obj%variables(i_var)%val(:) - this%variables(i_var)%dvaldt(:) = donor_prt_obj%variables(i_var)%dvaldt(:) + this%variables(i_var)%val0(:) = donor_prt_obj%variables(i_var)%val0(:) + this%variables(i_var)%net_art(:) = donor_prt_obj%variables(i_var)%net_art(:) this%variables(i_var)%turnover(:) = donor_prt_obj%variables(i_var)%turnover(:) end do @@ -586,8 +593,8 @@ subroutine WeightedFusePRTVartypes(this,donor_prt_obj, recipient_fuse_weight, po this%variables(i_var)%val0(pos_id) = recipient_fuse_weight * this%variables(i_var)%val0(pos_id) + & (1.0_r8-recipient_fuse_weight) * donor_prt_obj%variables(i_var)%val0(pos_id) - this%variables(i_var)%dvaldt(pos_id) = recipient_fuse_weight * this%variables(i_var)%dvaldt(pos_id) + & - (1.0_r8-recipient_fuse_weight) * donor_prt_obj%variables(i_var)%dvaldt(pos_id) + this%variables(i_var)%net_art(pos_id) = recipient_fuse_weight * this%variables(i_var)%net_art(pos_id) + & + (1.0_r8-recipient_fuse_weight) * donor_prt_obj%variables(i_var)%net_art(pos_id) this%variables(i_var)%turnover(pos_id) = recipient_fuse_weight * this%variables(i_var)%turnover(pos_id) + & (1.0_r8-recipient_fuse_weight) * donor_prt_obj%variables(i_var)%turnover(pos_id) @@ -618,7 +625,7 @@ subroutine DeallocatePRTVartypes(this) do i_var = 1, n_vars deallocate(this%variables(i_var)%val) deallocate(this%variables(i_var)%val0) - deallocate(this%variables(i_var)%dvaldt) + deallocate(this%variables(i_var)%net_art) deallocate(this%variables(i_var)%turnover) end do @@ -692,6 +699,13 @@ end subroutine RegisterBCInOut subroutine ZeroRates(this) + ! --------------------------------------------------------------------------------- + ! This subroutine zeros all of the rates of change for our variables. + ! It also sets the initial value to the current state. + ! This allows us to make mass conservation checks, where + ! val - val0 = net_art + turnover + ! --------------------------------------------------------------------------------- + class(prt_vartypes) :: this integer :: n_vars @@ -699,13 +713,58 @@ subroutine ZeroRates(this) n_vars = size(this%variables,1) do ivar = 1,n_vars - this%variables(ivar)%dvaldt(:) = 0.0_r8 + this%variables(ivar)%val0(:) = this%variables(ivar)%val(:) + this%variables(ivar)%net_art(:) = 0.0_r8 this%variables(ivar)%turnover(:) = 0.0_r8 end do end subroutine ZeroRates ! ==================================================================================== + + subroutine CheckMassConservation(this) + + class(prt_vartypes) :: this + + integer :: n_vars + integer :: ivar + + real(r8) :: err + + + n_vars = size(this%variables,1) + do ivar = 1,n_vars + + do pos_id = 1, this%variables(ivar)%num_pos + + err = (this%variables(ivar)%val(pos_id) - this%variables(ivar)%val0(pos_id)) - & + (this%variables(ivar)%net_art(pos_id) & + -this%variables(ivar)%turnover(pos_id)) + + if( abs(err) > calloc_abs_error ) then + write(fates_log(),*) 'PARTEH mass conservation check failed' + write(fates_log(),*) ' Change in mass over control period should' + write(fates_log(),*) ' always equal the integrated fluxes.' + write(fates_log(),*) ' organ id: ',this%prt_instance%state_descriptor(i_var)%organ_id + write(fates_log(),*) ' species_id: ',this%prt_instance%state_descriptor(i_var)%spec_id + write(fates_log(),*) ' position id: ',pos_id + write(fates_log(),*) ' symbol: ',trim(this%prt_instance%state_descriptor(i_var)%symbol) + write(fates_log(),*) ' longname: ',trim(this%prt_instance%state_descriptor(i_var)%longname) + write(fates_log(),*) ' err: ',err,' max error: ',calloc_abs_error + write(fates_log(),*) ' terms: ', this%variables(ivar)%val(pos_id), & + this%variables(ivar)%val0(pos_id), & + this%variables(ivar)%net_art(pos_id), & + this%variables(ivar)%turnover(pos_id) + write(fates_log(),*) ' Exiting.' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + end do + + return + end subroutine CheckMassConservation + + ! ==================================================================================== function GetState(this, organ_id, species_id, position_id) result(sp_organ_val) @@ -930,6 +989,35 @@ subroutine SetState(prt,organ_id, species_id, state_val, position_id) end subroutine SetState + ! ==================================================================================== + + + subroutine EventTurnover(this, ipft, event_type) + + class(prt_vartypes) :: this + integer,intent(in) :: ipft + integer,intent(in) :: event_type + + if( event_type .eq. deciduous_event ) then + + + + + elseif( event_type .eq. storm_event ) then + + + else + write(fates_log(),*) 'An event based turnover event was specified' + write(fates_log(),*) ' that does not match pre-defined types' + write(fates_log(),*) ' deciduous_event: ',deciduous_event + write(fates_log(),*) ' trauma_event: ',trauma_event + write(fates_log(),*) ' event_type: ',event_type + write(fates_log(),*) 'Exiting' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + end subroutine EventTurnover + ! ==================================================================================== From 3aafcaef1f963e745fdf23e5a2e018d8fdb44dec Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Wed, 19 Sep 2018 21:23:32 -0700 Subject: [PATCH 06/52] Minor syntax changes to describing main prt object --- parteh/PRTGenericMod.F90 | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/parteh/PRTGenericMod.F90 b/parteh/PRTGenericMod.F90 index 5fdcec497f..60d8c91fc9 100644 --- a/parteh/PRTGenericMod.F90 +++ b/parteh/PRTGenericMod.F90 @@ -128,9 +128,12 @@ module PRTGenericMod ! ------------------------------------------------------------------------------------- ! This is a generic variable type that can be used to describe all ! species x organ variable combinations. - ! Note that dvaldt does NOT subsume turnover. tunover happens outside the main - ! allocation modules. dvaldt only contains transport, translocation (cross-organ only) - ! growth and reactions. + ! + ! It is assumed that over the control period (probably 1 day) that + ! changes in the current state (val) relative to the value at the start of the + ! control period (val0), are equal to the time integrated flux terms + ! (net_art, turnover, etc) + ! ! ------------------------------------------------------------------------------------- type prt_vartype @@ -150,10 +153,9 @@ module PRTGenericMod ! Placeholder ! To save on memory, keep this commented out, or simply ! add this only in the extension ... ? - ! real(r8),dimension(3) :: coordinate ! NOTE FOR QUERYING, INTEGERS ARE BETTER + ! real(r8),allocatable :: coordinate(:,:) integer :: num_pos ! Number of pools with own position per species x organ - end type prt_vartype From e7fedaa8c8469b2dfe8b802efc0080d5ba2bbdf8 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Wed, 19 Sep 2018 21:36:04 -0700 Subject: [PATCH 07/52] minor syntax updates to prt generic --- parteh/PRTGenericMod.F90 | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) diff --git a/parteh/PRTGenericMod.F90 b/parteh/PRTGenericMod.F90 index 60d8c91fc9..72492b400b 100644 --- a/parteh/PRTGenericMod.F90 +++ b/parteh/PRTGenericMod.F90 @@ -173,11 +173,15 @@ module PRTGenericMod ! ------------------------------------------------------------------------------------- - ! This generic type defines the whole set of a plants species and organs - ! It also has arrays which are used to organize the species and organs into - ! commonly used groups so that the variables can be presented to other - ! routines in the model efficienty (such as history output, or assessing cohort - ! indices like LAI, lai-memory, etc, etc) + ! This generic type defines the object that attaches to the instance of any plant. + ! ie this is the parent object. + ! It contains the state variable object: variables + ! as well as the boundary condition pointers bc_inout, bc_in and bc_out + ! + ! This object also contains the bulk of the PRT routines, including + ! extended (hypothesis specific routines) and generic routines (eg + ! routines that can operate on any hypothesis) + ! ! There are procedures that are specialized for each module. And then ! there are procedures that are supposed to be generic and should support ! all the different modules. @@ -185,7 +189,7 @@ module PRTGenericMod type prt_vartypes - type(prt_vartype),allocatable :: variables(:) + type(prt_vartype),allocatable :: variables(:) ! The state variables 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 From 8b58a6894ab8bb1e6a1f5d092859588ac8e31f4d Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Sun, 23 Sep 2018 14:52:08 -0700 Subject: [PATCH 08/52] Converted biophysics routines into new allocation structure. First pass. --- biogeochem/EDCohortDynamicsMod.F90 | 23 ++++-- biogeochem/EDPatchDynamicsMod.F90 | 3 +- biogeophys/FatesPlantHydraulicsMod.F90 | 33 +++++++-- biogeophys/FatesPlantRespPhotosynthMod.F90 | 85 ++++++++++++++++++---- main/FatesParameterDerivedMod.F90 | 16 +--- parameter_files/fates_params_default.cdl | 10 +-- 6 files changed, 122 insertions(+), 48 deletions(-) diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index aca2f749b3..01fe8acf8b 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -78,6 +78,7 @@ module EDCohortDynamicsMod public :: sort_cohorts public :: copy_cohort public :: count_cohorts + public :: InitPRTCohort logical, parameter :: DEBUG = .false. ! local debug flag @@ -155,10 +156,17 @@ subroutine create_cohort(currentSite, patchptr, pft, nn, hite, dbh, bleaf, bfine ! Initialize the Plant allocative Reactive Transport (PaRT) module ! Choose from one of the extensible hypotheses (EH) + ! ----------------------------------------------------------------------------------- call InitPRTCohort(new_cohort) - select case(new_cohort%parteh_model) + ! 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_model) case (1) call SetState(new_cohort%prt,leaf_organ, carbon12_species, bleaf) @@ -176,9 +184,15 @@ subroutine create_cohort(currentSite, patchptr, pft, nn, hite, dbh, bleaf, bfine end select + + ! This call cycles through the initial conditions, and makes sure that they + ! are all initialized. + ! ----------------------------------------------------------------------------------- + call ccohort%prt%CheckInitialConditions() - new_cohort%ode_opt_step = 1.0e6_r8 ! Initialize the integrator step size as super-huge + + call sizetype_class_index(new_cohort%dbh,new_cohort%pft, & new_cohort%size_class,new_cohort%size_by_pft_class) @@ -264,11 +278,6 @@ subroutine InitPRTCohort(ccohort) allocate(callom_prt) new_cohort%prt => callom_prt - -! case(2) - -! allocate(cnpallom_prt) -! new_cohort%prt => cnpallom_prt case DEFAULT write(fates_log(),*) 'You specified an unknown PRT module' diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index d35011566d..9c9c7dc11b 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -40,7 +40,6 @@ module EDPatchDynamicsMod use EDCohortDynamicsMod , only : InitPRTCohort - use PRTGenericMod, only : leaf_organ use PRTGenericMod, only : all_carbon_species use PRTGenericMod, only : carbon12_species use PRTGenericMod, only : nitrogen_species @@ -1906,6 +1905,8 @@ subroutine dealloc_patch(cpatch) ncohort => ccohort%taller if(hlm_use_planthydro.eq.itrue) call DeallocateHydrCohort(ccohort) + call ccohort%prt%DeallocatePRTVartypes() + deallocate(ccohort%prt) deallocate(ccohort) ccohort => ncohort diff --git a/biogeophys/FatesPlantHydraulicsMod.F90 b/biogeophys/FatesPlantHydraulicsMod.F90 index 98ff027ad6..0b3bdfc0b6 100644 --- a/biogeophys/FatesPlantHydraulicsMod.F90 +++ b/biogeophys/FatesPlantHydraulicsMod.F90 @@ -70,6 +70,19 @@ module FatesPlantHydraulicsMod use FatesHydraulicsMemMod, only: InitHydraulicsDerived use FatesHydraulicsMemMod, only: nlevsoi_hyd_max + use PRTGenericMod, only : all_carbon_species + use PRTGenericMod, only : carbon12_species + use PRTGenericMod, only : nitrogen_species + use PRTGenericMod, only : phosphorous_species + use PRTGenericMod, only : leaf_organ + use PRTGenericMod, only : fnrt_organ + use PRTGenericMod, only : sapw_organ + use PRTGenericMod, only : store_organ + use PRTGenericMod, only : repro_organ + use PRTGenericMod, only : struct_organ + use PRTGenericMod, only : carbon12_species + use PRTGenericMod, only : SetState + use clm_time_manager , only : get_step_size, get_nstep use FatesConstantsMod, only: cm2_per_m2 @@ -309,6 +322,10 @@ subroutine updateSizeDepTreeHydProps(currentSite,cc_p,bc_in) real(r8) :: kmax_tot ! total tree (leaf to root tip) hydraulic conductance [kg s-1 MPa-1] real(r8) :: dz_node1_nodekplus1 ! cumulative distance between canopy node and node k + 1 [m] real(r8) :: dz_node1_lowerk ! cumulative distance between canopy node and upper boundary of node k [m] + real(r8) :: leaf_c + real(r8) :: fnrt_c + real(r8) :: sapw_c + real(r8) :: struct_c integer :: nlevsoi_hyd ! Number of soil hydraulic layers integer :: nlevsoil ! Number of total soil layers type(ed_cohort_hydr_type), pointer :: ccohort_hydr @@ -323,16 +340,22 @@ subroutine updateSizeDepTreeHydProps(currentSite,cc_p,bc_in) FT = cCohort%pft roota = EDPftvarcon_inst%roota_par(FT) rootb = EDPftvarcon_inst%rootb_par(FT) + + leaf_c = cCohort%prt%GetState(leaf_organ, all_carbon_species) + sapw_c = cCohort%prt%GetState(sapw_organ, all_carbon_species) + fnrt_c = cCohort%prt%GetState(fnrt_organ, all_carbon_species) + struct_c = cCohort%prt%GetState(struct_organ, all_carbon_species) + !roota = 4.372_r8 ! TESTING: deep (see Zeng 2001 Table 1) !rootb = 0.978_r8 ! TESTING: deep (see Zeng 2001 Table 1) !roota = 8.992_r8 ! TESTING: shallow (see Zeng 2001 Table 1) !rootb = 8.992_r8 ! TESTING: shallow (see Zeng 2001 Table 1) - if(cCohort%bl>0.0) then !only update when bleaf >0 - b_woody_carb = cCohort%bsw + cCohort%bdead + if(leaf_c>0.0) then !only update when bleaf >0 + b_woody_carb = sapw_c + struct_c b_woody_bg_carb = (1.0_r8-EDPftvarcon_inst%allom_agb_frac(FT)) * b_woody_carb - b_tot_carb = cCohort%bsw + cCohort%bdead + cCohort%bl + cCohort%br - b_canopy_carb = cCohort%bl + b_tot_carb = sapw_c + struct_c + leaf_c + fnrt_c + b_canopy_carb = leaf_c b_bg_carb = (1.0_r8-EDPftvarcon_inst%allom_agb_frac(FT)) * b_tot_carb ! SAVE INITIAL VOLUMES @@ -403,7 +426,7 @@ subroutine updateSizeDepTreeHydProps(currentSite,cc_p,bc_in) !Determine belowground biomass as a function of total (sapwood, heartwood, leaf, fine root) biomass !then subtract out the fine root biomass to get coarse (transporting) root biomass - !b_troot_carb = b_bg_carb - cCohort%br ! this can give negative values + b_troot_carb = b_woody_bg_carb b_troot_biom = b_troot_carb * C2B v_troot = b_troot_biom / (EDPftvarcon_inst%wood_density(FT)*1.e3_r8) diff --git a/biogeophys/FatesPlantRespPhotosynthMod.F90 b/biogeophys/FatesPlantRespPhotosynthMod.F90 index ebbbdc37e5..fa3256d22e 100644 --- a/biogeophys/FatesPlantRespPhotosynthMod.F90 +++ b/biogeophys/FatesPlantRespPhotosynthMod.F90 @@ -30,6 +30,18 @@ module FATESPlantRespPhotosynthMod use EDTypesMod, only : nlevleaf use EDTypesMod, only : nclmax + use PRTGenericMod, only : carbon12_species + use PRTGenericMod, only : nitrogen_species + use PRTGenericMod, only : phosphorous_species + use PRTGenericMod, only : leaf_organ + use PRTGenericMod, only : fnrt_organ + use PRTGenericMod, only : sapw_organ + use PRTGenericMod, only : store_organ + use PRTGenericMod, only : repro_organ + use PRTGenericMod, only : struct_organ + use PRTGenericMod, only : carbon12_species + use PRTGenericMod, only : SetState + ! CIME Globals use shr_log_mod , only : errMsg => shr_log_errMsg @@ -158,7 +170,9 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) ! nitrogen content (kgN/plant) real(r8) :: live_croot_n ! Live coarse root (below-ground sapwood) ! nitrogen content (kgN/plant) - real(r8) :: froot_n ! Fine root nitrogen content (kgN/plant) + real(r8) :: sapw_c ! Sapwood carbon (kgC/plant) + real(r8) :: fnrt_c ! Fine root carbon (kgC/plant) + real(r8) :: fnrt_n ! Fine root nitrogen content (kgN/plant) real(r8) :: g_sb_leaves ! Mean combined (stomata+boundary layer) leaf conductance [m/s] ! over all of the patch's leaves. The "sb" refers to the combined ! "s"tomatal and "b"oundary layer. @@ -176,7 +190,8 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) real(r8) :: check_elai ! This is a check on the effective LAI that is calculated ! over each cohort x layer. real(r8) :: cohort_eleaf_area ! This is the effective leaf area [m2] reported by each cohort - + real(r8) :: lmr25top ! canopy top leaf maint resp rate at 25C + ! for this plant or pft (umol CO2/m**2/s) real(r8) :: leaf_inc ! LAI-only portion of the vegetation increment of dinc_ed real(r8) :: lai_canopy_above ! the LAI in the canopy layers above the layer of interest real(r8) :: lai_layers_above ! the LAI in the leaf layers, within the current canopy, @@ -223,9 +238,6 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) 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? - leafcn => EDPftvarcon_inst%leafcn , & ! leaf C:N (gC/gN) - frootcn => EDPftvarcon_inst%frootcn, & ! froot C:N (gc/gN) - woodcn => EDPftvarcon_inst%woodcn, & ! wood C:N (gc/gN) q10 => FatesSynchronizedParamsInst%Q10 ) bbbopt(0) = ED_val_bbopt_c4 @@ -349,7 +361,9 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) cl = currentCohort%canopy_layer call bleaf(currentCohort%dbh,currentCohort%pft,currentCohort%canopy_trim,b_leaf) - call storage_fraction_of_target(b_leaf, currentCohort%bstore, frac) + call storage_fraction_of_target(b_leaf, & + currentCohort%prt%GetState(store_organ, carbon12_species), & + frac) call lowstorage_maintresp_reduction(frac,currentCohort%pft, & maintresp_reduction_factor) @@ -369,7 +383,9 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) ! not been done yet. ! ------------------------------------------------------------ - if ( .not.rate_mask_z(iv,ft,cl) .or. (hlm_use_planthydro.eq.itrue) ) then + if ( .not.rate_mask_z(iv,ft,cl) .or. & + (hlm_use_planthydro.eq.itrue) .or. & + (hlm_parteh_model.ne.1) ) then if (hlm_use_planthydro.eq.itrue) then @@ -407,9 +423,34 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) ! Scale for leaf nitrogen profile nscaler = exp(-kn(ft) * cumulative_lai) + + ! Leaf maintenance respiration to match the base rate used in CN + ! but with the new temperature functions for C3 and C4 plants. + + ! CN respiration has units: g C / g N [leaf] / s. This needs to be + ! converted from g C / g N [leaf] / s to umol CO2 / m**2 [leaf] / s + + ! Then scale this value at the top of the canopy for canopy depth + ! Leaf nitrogen concentration at the top of the canopy (g N leaf / m**2 leaf) + select case(new_cohort%parteh_model) + case (1) + lnc = 1._r8 / & + (slatop(ft) * EDPftvarcon_inst%prt_nitr_stoich_p1(ipft,leaf_organ)) + +! case (2) +! +! leaf_c = currentCohort%prt%GetState(leaf_organ, carbon12_species) +! leaf_n = currentCohort%prt%GetState(leaf_organ, nitrogen_species) +! lnc = leaf_c / (slatop * leaf_n ) + + end select + + lmr25top = 2.525e-6_r8 * (1.5_r8 ** ((25._r8 - 20._r8)/10._r8)) + lmr25top = lmr25top * lnc / (umolC_to_kgC * g_per_kg) + ! Part VII: Calculate dark respiration (leaf maintenance) for this layer - call LeafLayerMaintenanceRespiration( param_derived%lmr25top(ft),& ! in + call LeafLayerMaintenanceRespiration( lmr25top, & ! in nscaler, & ! in ft, & ! in bc_in(s)%t_veg_pa(ifp), & ! in @@ -533,13 +574,23 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) ! the sapwood pools. ! Units are in (kgN/plant) ! ------------------------------------------------------------------ - live_stem_n = EDPftvarcon_inst%allom_agb_frac(currentCohort%pft) * currentCohort%bsw / & - woodcn(currentCohort%pft) - live_croot_n = (1.0_r8-EDPftvarcon_inst%allom_agb_frac(currentCohort%pft)) * currentCohort%bsw / & - woodcn(currentCohort%pft) - froot_n = currentCohort%br / frootcn(currentCohort%pft) - + + select case(parteh_model) + case (1) + + sapw_c = currentCohort%prt%GetState(sapw_organ, all_carbon_species) + fnrt_c = currentCohort%prt%GetState(fnrt_organ, all_carbon_species) + + live_stem_n = EDPftvarcon_inst%allom_agb_frac(currentCohort%pft) * & + sapw_c / EDPftvarcon_inst%prt_nitr_stoich_p1(ipft,sapw_organ) + + live_croot_n = (1.0_r8-EDPftvarcon_inst%allom_agb_frac(currentCohort%pft)) * & + sapw_c / EDPftvarcon_inst%prt_nitr_stoich_p1(ipft,sapw_organ) + + fnrt_n = fnrt_c / EDPftvarcon_inst%prt_nitr_stoich_p1(ipft,fnrt_organ) + end select + !------------------------------------------------------------------------------ ! Calculate Whole Plant Respiration ! (this doesn't really need to be in this iteration at all, surely?) @@ -566,7 +617,7 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) do j = 1,bc_in(s)%nlevsoil tcsoi = q10**((bc_in(s)%t_soisno_sl(j)-tfrz - 20.0_r8)/10.0_r8) currentCohort%froot_mr = currentCohort%froot_mr + & - froot_n * ED_val_base_mr_20 * tcsoi * currentPatch%rootfr_ft(ft,j) * maintresp_reduction_factor + fnrt_n * ED_val_base_mr_20 * tcsoi * currentPatch%rootfr_ft(ft,j) * maintresp_reduction_factor enddo ! Coarse Root MR (kgC/plant/s) (below ground sapwood) @@ -1604,6 +1655,10 @@ subroutine LeafLayerMaintenanceRespiration(lmr25top_ft, & real(r8), parameter :: lmrc = 1.15912391_r8 ! scaling factor for high ! temperature inhibition (25 C = 1.0) + + + + ! Part I: Leaf Maintenance respiration: umol CO2 / m**2 [leaf] / s ! ---------------------------------------------------------------------------------- lmr25 = lmr25top_ft * nscaler diff --git a/main/FatesParameterDerivedMod.F90 b/main/FatesParameterDerivedMod.F90 index 7bbaec6ad5..efdc3319bd 100644 --- a/main/FatesParameterDerivedMod.F90 +++ b/main/FatesParameterDerivedMod.F90 @@ -23,8 +23,6 @@ module FatesParameterDerivedMod ! rate at 25C (umol CO2/m**2/s) real(r8), allocatable :: kp25top(:) ! canopy top: initial slope of CO2 response ! curve (C4 plants) at 25C - real(r8), allocatable :: lmr25top(:) ! canopy top: leaf maintenance respiration - ! rate at 25C (umol CO2/m**2/s) contains procedure :: Init @@ -45,7 +43,6 @@ subroutine InitAllocate(this,numpft) allocate(this%jmax25top(numpft)) allocate(this%tpu25top(numpft)) allocate(this%kp25top(numpft)) - allocate(this%lmr25top(numpft)) return end subroutine InitAllocate @@ -74,8 +71,7 @@ subroutine Init(this,numpft) do ft = 1,numpft - ! Leaf nitrogen concentration at the top of the canopy (g N leaf / m**2 leaf) - lnc = 1._r8 / (slatop(ft) * leafcn(ft)) + ! Parameters derived from vcmax25top. ! Bonan et al (2011) JGR, 116, doi:10.1029/2010JG001593 @@ -92,17 +88,7 @@ subroutine Init(this,numpft) this%tpu25top(ft) = 0.167_r8 * vcmax25top(ft) this%kp25top(ft) = 20000._r8 * vcmax25top(ft) - ! Leaf maintenance respiration to match the base rate used in CN - ! but with the new temperature functions for C3 and C4 plants. - ! - ! - ! CN respiration has units: g C / g N [leaf] / s. This needs to be - ! converted from g C / g N [leaf] / s to umol CO2 / m**2 [leaf] / s - ! - ! Then scale this value at the top of the canopy for canopy depth - this%lmr25top(ft) = 2.525e-6_r8 * (1.5_r8 ** ((25._r8 - 20._r8)/10._r8)) - this%lmr25top(ft) = this%lmr25top(ft) * lnc / (umolC_to_kgC * g_per_kg) end do !ft diff --git a/parameter_files/fates_params_default.cdl b/parameter_files/fates_params_default.cdl index 59954db104..0d56291089 100644 --- a/parameter_files/fates_params_default.cdl +++ b/parameter_files/fates_params_default.cdl @@ -173,23 +173,23 @@ variables: fates_branch_turnover:long_name = "turnover time of branches" ; float fates_prt_unit_gr_resp(fates_prt_organs,fates_pft) ; - fates_prt_unit_gr_resp:units = "kgC/kgC" ; + fates_prt_unit_gr_resp:units = "gC/gC" ; fates_prt_unit_gr_resp:long_name = "Unit growth respiration rate per organ" ; float fates_prt_nitr_stoich_p1(fates_prt_organs,fates_pft) ; - fates_prt_nitr_stoich_p1:units = "na" ; + fates_prt_nitr_stoich_p1:units = "(gC/gN)" ; fates_prt_nitr_stoich_p1:long_name = "nitrogen stoichiometry, parameter 1 (hypothesis dependant meaning)" ; float fates_prt_nitr_stoich_p2(fates_prt_organs,fates_pft) ; - fates_prt_nitr_stoich_p2:units = "na" ; + fates_prt_nitr_stoich_p2:units = "(gC/cN)" ; fates_prt_nitr_stoich_p2:long_name = "nitrogen stoichiometry, parameter 2 (hypothesis dependant meaning)" ; float fates_prt_phos_stoich_p1(fates_prt_organs,fates_pft) ; - fates_prt_phos_stoich_p1:units = "na" ; + fates_prt_phos_stoich_p1:units = "(gC/gP)" ; fates_prt_phos_stoich_p1:long_name = "phosphorous stoichiometry, parameter 1 (hypothesis dependant meaning)" ; float fates_prt_phos_stoich_p2(fates_prt_organs,fates_pft) ; - fates_prt_phos_stoich_p2:units = "na" ; + fates_prt_phos_stoich_p2:units = "(gC/gP)" ; fates_prt_phos_stoich_p2:long_name = "phosphorous stoichiometry, parameter 2 (hypothesis dependant meaning)" ; float fates_prt_alloc_priority(fates_prt_organs,fates_pft) ; From a3b68cb5ab9cae4dfd51ad28cdef43b25b6615d5 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Sun, 23 Sep 2018 14:56:53 -0700 Subject: [PATCH 09/52] Removed old CN parameters --- main/EDPftvarcon.F90 | 18 ------------------ main/FatesParameterDerivedMod.F90 | 9 +-------- 2 files changed, 1 insertion(+), 26 deletions(-) diff --git a/main/EDPftvarcon.F90 b/main/EDPftvarcon.F90 index ec36994557..d90aa0b048 100644 --- a/main/EDPftvarcon.F90 +++ b/main/EDPftvarcon.F90 @@ -67,9 +67,6 @@ module EDPftvarcon ! of leaf scattering elements decreases light interception real(r8), allocatable :: c3psn(:) ! index defining the photosynthetic pathway C4 = 0, C3 = 1 real(r8), allocatable :: vcmax25top(:) - real(r8), allocatable :: leafcn(:) - real(r8), allocatable :: frootcn(:) - real(r8), allocatable :: woodcn(:) real(r8), allocatable :: smpso(:) real(r8), allocatable :: smpsc(:) real(r8), allocatable :: grperc(:) @@ -877,18 +874,6 @@ subroutine Receive_PFT(this, fates_params) call fates_params%RetreiveParameterAllocate(name=name, & data=this%vcmax25top) - name = 'fates_leaf_cn_ratio' - call fates_params%RetreiveParameterAllocate(name=name, & - data=this%leafcn) - - name = 'fates_froot_cn_ratio' - call fates_params%RetreiveParameterAllocate(name=name, & - data=this%frootcn) - - name = 'fates_wood_cn_ratio' - call fates_params%RetreiveParameterAllocate(name=name, & - data=this%woodcn) - name = 'fates_smpso' call fates_params%RetreiveParameterAllocate(name=name, & data=this%smpso) @@ -1658,9 +1643,6 @@ subroutine FatesReportPFTParams(is_master) write(fates_log(),fmt0) 'clumping_index = ',EDPftvarcon_inst%clumping_index write(fates_log(),fmt0) 'c3psn = ',EDPftvarcon_inst%c3psn write(fates_log(),fmt0) 'vcmax25top = ',EDPftvarcon_inst%vcmax25top - write(fates_log(),fmt0) 'leafcn = ',EDPftvarcon_inst%leafcn - write(fates_log(),fmt0) 'frootcn = ',EDPftvarcon_inst%frootcn - write(fates_log(),fmt0) 'woodcn = ',EDPftvarcon_inst%woodcn write(fates_log(),fmt0) 'smpso = ',EDPftvarcon_inst%smpso write(fates_log(),fmt0) 'smpsc = ',EDPftvarcon_inst%smpsc write(fates_log(),fmt0) 'grperc = ',EDPftvarcon_inst%grperc diff --git a/main/FatesParameterDerivedMod.F90 b/main/FatesParameterDerivedMod.F90 index efdc3319bd..9da1eeb01e 100644 --- a/main/FatesParameterDerivedMod.F90 +++ b/main/FatesParameterDerivedMod.F90 @@ -60,18 +60,11 @@ subroutine Init(this,numpft) integer :: ft ! pft index real(r8) :: lnc ! leaf N concentration (gN leaf/m^2) - associate( & - - vcmax25top => EDPftvarcon_inst%vcmax25top, & ! - slatop => EDPftvarcon_inst%slatop , & ! specific leaf area at top of canopy, - ! projected area basis [m^2/gC] - leafcn => EDPftvarcon_inst%leafcn ) ! leaf C:N (gC/gN) + associate( vcmax25top => EDPftvarcon_inst%vcmax25top ) call this%InitAllocate(numpft) do ft = 1,numpft - - ! Parameters derived from vcmax25top. ! Bonan et al (2011) JGR, 116, doi:10.1029/2010JG001593 From 39fbed2cd4b8a3f8441bbbf43ce535cb3f95ef47 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Mon, 24 Sep 2018 12:42:30 -0700 Subject: [PATCH 10/52] Added the call to load the PRT instances --- main/FatesInterfaceMod.F90 | 34 ++++- parteh/PRTAllometricCarbonMod.F90 | 3 + parteh/PRTGenericMod.F90 | 206 ++++++------------------------ 3 files changed, 74 insertions(+), 169 deletions(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index af388b8a14..c17e1eb09f 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -28,6 +28,8 @@ module FatesInterfaceMod use EDPftvarcon , only : EDPftvarcon_inst use EDParamsMod , only : FatesReportParams + use PRTAllometricCarbonMod, only : InitPRTInstanceAC + ! use PRTAllometricCNPMod, only : InitPRTInstanceACNP ! CIME Globals use shr_log_mod , only : errMsg => shr_log_errMsg @@ -40,6 +42,7 @@ module FatesInterfaceMod public :: SetFatesTime public :: set_fates_global_elements public :: FatesReportParameters + public :: InitPARTEHGlobals character(len=*), parameter, private :: sourcefile = & __FILE__ @@ -596,7 +599,7 @@ subroutine FatesInterfaceInit(log_unit,global_verbose) logical, intent(in) :: global_verbose call FatesGlobalsInit(log_unit,global_verbose) - + end subroutine FatesInterfaceInit ! ==================================================================================== @@ -1574,4 +1577,33 @@ subroutine FatesReportParameters(masterproc) return end subroutine FatesReportParameters + ! ==================================================================================== + + subroutine InitPARTEHGlobals() + + ! Initialize the Plant Allocation and Reactive Transport + ! global functions and mapping tables + + select case(int(hlm_parteh_mode)) + case (1) + call InitPRTInstanceAC() + case(2) + + !call InitPRTInstanceACNP() + write(fates_log(),*) 'You specified the allometric CNP mode' + write(fates_log(),*) 'with relaxed target stoichiometry.' + write(fates_log(),*) 'This mode is not available yet.' + call endrun(msg=errMsg(sourcefile, __LINE__)) + + case DEFAULT + write(fates_log(),*) 'You specified an unknown PRT module' + write(fates_log(),*) 'Aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + + end select + + + + end subroutine InitPARTEHGlobals + end module FatesInterfaceMod diff --git a/parteh/PRTAllometricCarbonMod.F90 b/parteh/PRTAllometricCarbonMod.F90 index 5c41f5b600..0203a6bf28 100644 --- a/parteh/PRTAllometricCarbonMod.F90 +++ b/parteh/PRTAllometricCarbonMod.F90 @@ -8,6 +8,9 @@ module PRTAllometricCarbonMod ! ! Ryan Knox Apr 2018 ! + ! TO-DO: THE MAPPING TABLES SHOULD BE PROTECTED STATUS. TEST ADDING THIS AFTER 1ST + ! SUCCESFULL RUN + ! ! ------------------------------------------------------------------------------------ use PRTGenericMod , only : prt_instance_type diff --git a/parteh/PRTGenericMod.F90 b/parteh/PRTGenericMod.F90 index 72492b400b..11f92e11be 100644 --- a/parteh/PRTGenericMod.F90 +++ b/parteh/PRTGenericMod.F90 @@ -13,18 +13,22 @@ module PRTGenericMod ! ! ------------------------------------------------------------------------------------ + ! ------------------------------------------------------------------------------------ ! TO-DO: Impose a parameter check function - ! 1 item: reproduction must be priority 0 in CNP - + ! reproduction must be priority 0 in CNP + ! + ! TO-DO: Create a generic mapping table that will list all species + ! of a specific organ of interest. + ! ------------------------------------------------------------------------------------ use FatesConstantsMod, only : r8 => fates_r8 use FatesConstantsMod, only : i4 => fates_int use FatesConstantsMod, only : nearzero use FatesGlobals , only : endrun => fates_endrun use FatesGlobals , only : fates_log - use EDPftvarcon , only : EDPftvarcon_inst + use shr_log_mod , only : errMsg => shr_log_errMsg - use FatesInterfaceMod, only : hlm_freq_day + implicit none @@ -147,7 +151,7 @@ module PRTGenericMod ! or, any mass destined for litter ! over the control period -! real(r8),allocatable :: burned(:) ! Losses due to burn [kg] + real(r8),allocatable :: burned(:) ! Losses due to burn [kg] ! real(r8),allocatable :: herbiv(:) ! Losses due to herbivory [kg] ! Placeholder @@ -269,12 +273,27 @@ module PRTGenericMod ! ! ------------------------------------------------------------------------------------- + ! This type will help us loop through all the different variables associated + ! with a specific organ type. Since variables are a combination of organ and + ! species, the number of unique variables is capped at the number of species + ! per each organ. + + type organ_map_type + integer, dimension(1,num_species_types) :: var_id + integer :: num_vars + end type organ_map_type + + type prt_instance_type ! Note that index 0 is reserved for "all" or "irrelevant" - character(len=maxlen_varname) :: hyp_name + character(len=maxlen_varname) :: hyp_name + + ! This will list the specific variable ids associated with + ! each organ integer, dimension(0:num_organ_types,0:num_species_types) :: sp_organ_map - type(state_descriptor_type), allocatable :: state_descriptor(:) + type(state_descriptor_type), allocatable :: state_descriptor(:) + type(organ_map_type), dimension(1:num_organ_types) :: organ_map contains @@ -294,14 +313,16 @@ subroutine ZeroInstance(this) class(prt_instance_type) :: this - integer :: ip ! Organ loop counter + integer :: io ! Organ loop counter integer :: is ! Species loop counter ! First zero out the array - do ip = 1,num_organ_types + do io = 1,num_organ_types do is = 1,num_species_types - this%sp_organ_map(ip,is) = 0 + this%sp_organ_map(io,is) = 0 + this%organ_map(io)%var_id(is) = 0 end do + this%organ_map(io)%num_vars = 0 end do return @@ -330,6 +351,12 @@ subroutine InitInstance(this, var_id, long_name, symbol, organ_id, spec_id) this%sp_organ_map(organ_id,spec_id) = var_id + ! Set another map that helps to locate all the relevant pools associated + ! with an organ + + this%organ_map(organ_id)%num_vars = this%organ_map(organ_id)%num_vars + 1 + this%organ_map(organ_id)%var_id(this%organ_map(organ_id)%num_vars) = var_id + return end subroutine InitInstance @@ -998,163 +1025,6 @@ end subroutine SetState ! ==================================================================================== - subroutine EventTurnover(this, ipft, event_type) - - class(prt_vartypes) :: this - integer,intent(in) :: ipft - integer,intent(in) :: event_type - - if( event_type .eq. deciduous_event ) then - - - - - elseif( event_type .eq. storm_event ) then - - - else - write(fates_log(),*) 'An event based turnover event was specified' - write(fates_log(),*) ' that does not match pre-defined types' - write(fates_log(),*) ' deciduous_event: ',deciduous_event - write(fates_log(),*) ' trauma_event: ',trauma_event - write(fates_log(),*) ' event_type: ',event_type - write(fates_log(),*) 'Exiting' - call endrun(msg=errMsg(__FILE__, __LINE__)) - end if - - end subroutine EventTurnover - - - - ! ==================================================================================== - - - subroutine MaintTurnover(this,ipft) - - ! --------------------------------------------------------------------------------- - ! Generic subroutine (wrapper) calling specialized routines handling - ! the turnover of tissues in living plants (non-mortal) - ! --------------------------------------------------------------------------------- - class(prt_vartypes) :: this - integer,intent(in) :: ipft - - if ( int(EDPftvarcon_inst%turnover_retrans_mode(ipft)) == 1 ) then - call this%MaintTurnoverSimpleRetranslocation(ipft) - else - write(fates_log(),*) 'A maintenance/retranslocation mode was specified' - write(fates_log(),*) 'that is unknown.' - write(fates_log(),*) 'turnover_retrans_mode= ',EDPftvarcon_inst%turnover_retrans_mode(ipft) - write(fates_log(),*) 'pft = ',ipft - call endrun(msg=errMsg(__FILE__, __LINE__)) - end if - - return - end subroutine MaintTurnover - - ! =================================================================================== - - subroutine MaintTurnoverSimpleRetranslocation(this,ipft) - - ! --------------------------------------------------------------------------------- - ! This subroutine removes biomass from all applicable pools due to - ! "maintenance turnover". Maintenance turnover, in this context - ! is the loss of biomass on living plants, due to continuous turnover. - ! - ! Notes: - ! 1) It is assumed that this is called daily. - ! 2) This is a completely different thing compared to deciduous leaf drop, - ! or loss of biomass from the death of the plant. - ! 3) Since this is maintenance turnover, and not a complete drop of leaves for - ! deciduous trees, we just re-translocate nutrients (if necessary) from the - ! leaves and roots that leave (no pun intended), into the leaves and roots that - ! are still rooted to the plant (pun intended). For deciduous, event-based - ! phenology, we will re-translocate to the storage pool. - ! --------------------------------------------------------------------------------- - - class(prt_vartypes) :: this - integer,intent(in) :: ipft - - - integer :: i_var - integer :: spec_id - integer :: organ_id - integer :: num_sp_vars - integer :: pos_id - - real(r8) :: base_turnover - real(r8) :: leaf_turnover - real(r8) :: fnrt_turnover - real(r8) :: sapw_turnover - real(r8) :: store_turnover - real(r8) :: struct_turnover - real(r8) :: repro_turnover - real(r8) :: turnover ! A temp for the actual turnover removed from pool - real(r8) :: retrans ! A temp for the actual re-translocated mass - - num_sp_vars = size(this%variables,1) - - ! ----------------------------------------------------------------------------------- - ! Calculate the turnover rates - ! ----------------------------------------------------------------------------------- - - if ( EDPftvarcon_inst%branch_turnover(ipft) > nearzero ) then - sapw_turnover = hlm_freq_day / EDPftvarcon_inst%branch_turnover(ipft) - struct_turnover = hlm_freq_day / EDPftvarcon_inst%branch_turnover(ipft) - store_turnover = hlm_freq_day / EDPftvarcon_inst%branch_turnover(ipft) - else - sapw_turnover = 0.0_r8 - struct_turnover = 0.0_r8 - store_turnover = 0.0_r8 - - end if - if ( EDPftvarcon_inst%root_long(ipft) > nearzero ) then - fnrt_turnover = hlm_freq_day / EDPftvarcon_inst%root_long(ipft) - else - fnrt_turnover = 0.0_r8 - end if - if ( (EDPftvarcon_inst%leaf_long(ipft) > nearzero ) .and. & - (EDPftvarcon_inst%evergreen(ipft) == 1) ) then - leaf_turnover = hlm_freq_day / EDPftvarcon_inst%leaf_long(ipft) - else - leaf_turnover = 0.0_r8 - endif - - repro_turnover = 0.0_r8 - - do i_var = 1, num_sp_vars - - organ_id = this%prt_instance%state_descriptor(i_var)%organ_id - spec_id = this%prt_instance%state_descriptor(i_var)%spec_id - - if ( any(spec_id == carbon_species) ) then - retrans = 0.0_r8 - else if( spec_id == nitrogen_species ) then - retrans = EDPftvarcon_inst%turnover_n_retrans_p1(ipft,organ_id) - else if( spec_id == phosphorous_species ) then - retrans = EDPftvarcon_inst%turnover_p_retrans_p1(ipft,organ_id) - else - write(fates_log(),*) 'Please add a new re-translocation clause to your ' - write(fates_log(),*) ' organ x species combination' - write(fates_log(),*) ' organ: ',leaf_organ,' species: ',spec_id - write(fates_log(),*) 'Exiting' - call endrun(msg=errMsg(__FILE__, __LINE__)) - end if - - ! Loop over all of the coordinate ids - - do pos_id = 1,this%variables(i_var)%num_pos - - turnover = (1.0_r8 - retrans) * base_turnover * this%variables(i_var)%val(pos_id) - - this%variables(i_var)%turnover(pos_id) = this%variables(i_var)%turnover(pos_id) + turnover - - this%variables(i_var)%val(pos_id) = this%variables(i_var)%val(pos_id) - turnover - - end do - - end do - - return - end subroutine MaintTurnoverSimpleRetranslocation + end module PRTGenericMod From f987da90936483b25ca75356a031cfd00849e59f Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Tue, 25 Sep 2018 11:17:22 -0700 Subject: [PATCH 11/52] First pass at code handling loss fluxes, updates to parameters. --- main/EDPftvarcon.F90 | 192 +++++++++++++++++- parteh/PRTLossFluxesMod.F90 | 395 ++++++++++++++++++++++++++++++++++++ 2 files changed, 582 insertions(+), 5 deletions(-) create mode 100644 parteh/PRTLossFluxesMod.F90 diff --git a/main/EDPftvarcon.F90 b/main/EDPftvarcon.F90 index d90aa0b048..5c705bfb85 100644 --- a/main/EDPftvarcon.F90 +++ b/main/EDPftvarcon.F90 @@ -69,7 +69,8 @@ module EDPftvarcon real(r8), allocatable :: vcmax25top(:) real(r8), allocatable :: smpso(:) real(r8), allocatable :: smpsc(:) - real(r8), allocatable :: grperc(:) + real(r8), allocatable :: grperc(:) ! Growth respiration per unit Carbon gained + ! ONLY parteh_mode == 1 [kg/kg] real(r8), allocatable :: maintresp_reduction_curvature(:) ! curvature of MR reduction as f(carbon storage), ! 1=linear, 0=very curved real(r8), allocatable :: maintresp_reduction_intercept(:) ! intercept of MR reduction as f(carbon storage), @@ -169,8 +170,10 @@ module EDPftvarcon real(r8), allocatable :: root_long(:) ! root turnover time (longevity) (pft) [yr] real(r8), allocatable :: branch_turnover(:) ! Turnover time for branchfall on live trees (pft) [yr] real(r8), allocatable :: turnover_retrans_mode(:) ! Retranslocation method (pft) + + real(r8), allocatable :: turnover_carb_retrans_p1(:,:) ! Parameter 1 for carbon re-translocation (pft x organ) real(r8), allocatable :: turnover_nitr_retrans_p1(:,:) ! Parameter 1 for nitrogen re-translocation (pft x organ) - real(r8), allocatable :: turnover_phos_retrans_p1(:,:) ! Parameter 2 for phosphorous re-translocation (pft x organ) + real(r8), allocatable :: turnover_phos_retrans_p1(:,:) ! Parameter 1 for phosphorous re-translocation (pft x organ) ! Plant Hydraulic Parameters @@ -1404,8 +1407,10 @@ subroutine Register_PFT_prt_organs(this, fates_params) call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_2d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - - + name = 'fates_turnover_carb_retrans_p1' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_2d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + name = 'fates_turnover_nitr_retrans_p1' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_2d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) @@ -1455,7 +1460,9 @@ subroutine Receive_PFT_prt_organs(this, fates_params) call fates_params%RetreiveParameterAllocate(name=name, & data=this%prt_alloc_priority) - + name = 'fates_turnover_carb_retrans_p1' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%turnover_carb_retrans_p1) name = 'fates_turnover_nitr_retrans_p1' call fates_params%RetreiveParameterAllocate(name=name, & @@ -1721,6 +1728,7 @@ subroutine FatesReportPFTParams(is_master) write(fates_log(),fmt0) 'prt_unit_gr_resp = ',EDPftvarcon_inst%prt_unit_gr_resp write(fates_log(),fmt0) 'prt_alloc_priority = ',EDPftvarcon_inst%prt_alloc_priority + write(fates_log(),fmt0) 'turnover_carb_retrans_p1 = ',EDPftvarcon_inst%turnover_carb_retrans_p1 write(fates_log(),fmt0) 'turnover_nitr_retrans_p1 = ',EDPftvarcon_inst%turnover_nitr_retrans_p1 write(fates_log(),fmt0) 'turnover_phos_retrans_p1 = ',EDPftvarcon_inst%turnover_phos_retrans_p1 @@ -1874,6 +1882,180 @@ subroutine FatesCheckParams(is_master) end if + + ! Check re-translocations + ! Seems reasonable to assume that sapwood, structure and reproduction + ! should not be re-translocating mass upon turnover + ! ------------------------------------------------------------------- + + if ((EDPftvarcon_inst%turnover_carb_retrans_p1(ipft,repro_organ) > nearzero) .or. & + (EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,repro_organ) > nearzero) .or. & + (EDPftvarcon_inst%turnover_phos_retrans_p1(ipft,repro_organ) > nearzero) ) then + write(fates_log(),*) ' Retranslocation of reproductive tissues should be zero.' + write(fates_log(),*) ' PFT#: ',ipft + write(fates_log(),*) ' carbon: ',EDPftvarcon_inst%turnover_carb_retrans_p1(ipft,repro_organ) + write(fates_log(),*) ' nitr: ',EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,repro_organ) + write(fates_log(),*) ' phos: ',EDPftvarcon_inst%turnover_phos_retrans_p1(ipft,repro_organ) + write(fates_log(),*) ' Aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + if ((EDPftvarcon_inst%turnover_carb_retrans_p1(ipft,sapw_organ) > nearzero) .or. & + (EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,sapw_organ) > nearzero) .or. & + (EDPftvarcon_inst%turnover_phos_retrans_p1(ipft,sapw_organ) > nearzero) ) then + write(fates_log(),*) ' Retranslocation of sapwood tissues should be zero.' + write(fates_log(),*) ' PFT#: ',ipft + write(fates_log(),*) ' carbon: ',EDPftvarcon_inst%turnover_carb_retrans_p1(ipft,sapw_organ) + write(fates_log(),*) ' nitr: ',EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,sapw_organ) + write(fates_log(),*) ' phos: ',EDPftvarcon_inst%turnover_phos_retrans_p1(ipft,sapw_organ) + write(fates_log(),*) ' Aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + if ((EDPftvarcon_inst%turnover_carb_retrans_p1(ipft,struct_organ) > nearzero) .or. & + (EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,struct_organ) > nearzero) .or. & + (EDPftvarcon_inst%turnover_phos_retrans_p1(ipft,struct_organ) > nearzero) ) then + write(fates_log(),*) ' Retranslocation of structural(dead) tissues should be zero.' + write(fates_log(),*) ' PFT#: ',ipft + write(fates_log(),*) ' carbon: ',EDPftvarcon_inst%turnover_carb_retrans_p1(ipft,struct_organ) + write(fates_log(),*) ' nitr: ',EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,struct_organ) + write(fates_log(),*) ' phos: ',EDPftvarcon_inst%turnover_phos_retrans_p1(ipft,struct_organ) + write(fates_log(),*) ' Aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + ! Leaf retranslocation should be between 0 and 1 + if ((EDPftvarcon_inst%turnover_carb_retrans_p1(ipft,leaf_organ) > 1.0_r8) .or. & + ((EDPftvarcon_inst%turnover_carb_retrans_p1(ipft,leaf_organ) < 0.0_r8)) then + write(fates_log(),*) ' Retranslocation of leaf tissues should be between 0 and 1.' + write(fates_log(),*) ' PFT#: ',ipft + write(fates_log(),*) ' carbon: ',EDPftvarcon_inst%turnover_carb_retrans_p1(ipft,leaf_organ) + write(fates_log(),*) ' Aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + if ((hlm_parteh_mode .eq. 2) .and. & + ((EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,leaf_organ) > 1.0_r8) .or. & + (EDPftvarcon_inst%turnover_phos_retrans_p1(ipft,leaf_organ) > 1.0_r8) .or. & + (EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,leaf_organ) < 0.0_r8) .or. & + (EDPftvarcon_inst%turnover_phos_retrans_p1(ipft,leaf_organ) < 0.0_r8))) then + write(fates_log(),*) ' Retranslocation of leaf tissues should be between 0 and 1.' + write(fates_log(),*) ' PFT#: ',ipft + write(fates_log(),*) ' nitr: ',EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,leaf_organ) + write(fates_log(),*) ' phos: ',EDPftvarcon_inst%turnover_phos_retrans_p1(ipft,leaf_organ) + write(fates_log(),*) ' Aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + ! Fineroot retranslocation should be between 0-1 + if ((EDPftvarcon_inst%turnover_carb_retrans_p1(ipft,fnrt_organ) > 1.0_r8) .or. & + ((EDPftvarcon_inst%turnover_carb_retrans_p1(ipft,fnrt_organ) < 0.0_r8)) then + write(fates_log(),*) ' Retranslocation of leaf tissues should be between 0 and 1.' + write(fates_log(),*) ' PFT#: ',ipft + write(fates_log(),*) ' carbon: ',EDPftvarcon_inst%turnover_carb_retrans_p1(ipft,fnrt_organ) + write(fates_log(),*) ' Aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + if ((hlm_parteh_mode .eq. 2) .and. & + ((EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,fnrt_organ) > 1.0_r8) .or. & + (EDPftvarcon_inst%turnover_phos_retrans_p1(ipft,fnrt_organ) > 1.0_r8) .or. & + (EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,fnrt_organ) < 0.0_r8) .or. & + (EDPftvarcon_inst%turnover_phos_retrans_p1(ipft,fnrt_organ) < 0.0_r8))) then + write(fates_log(),*) ' Retranslocation of leaf tissues should be between 0 and 1.' + write(fates_log(),*) ' PFT#: ',ipft + write(fates_log(),*) ' nitr: ',EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,fnrt_organ) + write(fates_log(),*) ' phos: ',EDPftvarcon_inst%turnover_phos_retrans_p1(ipft,fnrt_organ) + write(fates_log(),*) ' Aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + ! Storage retranslocation should be between 0-1 (storage retrans seems weird, but who knows) + if ((EDPftvarcon_inst%turnover_carb_retrans_p1(ipft,store_organ) > 1.0_r8) .or. & + ((EDPftvarcon_inst%turnover_carb_retrans_p1(ipft,store_organ) < 0.0_r8)) then + write(fates_log(),*) ' Retranslocation of leaf tissues should be between 0 and 1.' + write(fates_log(),*) ' PFT#: ',ipft + write(fates_log(),*) ' carbon: ',EDPftvarcon_inst%turnover_carb_retrans_p1(ipft,store_organ) + write(fates_log(),*) ' Aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + if ((hlm_parteh_mode .eq. 2) .and. & + ((EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,store_organ) > 1.0_r8) .or. & + (EDPftvarcon_inst%turnover_phos_retrans_p1(ipft,store_organ) > 1.0_r8) .or. & + (EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,store_organ) < 0.0_r8) .or. & + (EDPftvarcon_inst%turnover_phos_retrans_p1(ipft,store_organ) < 0.0_r8))) then + write(fates_log(),*) ' Retranslocation of leaf tissues should be between 0 and 1.' + write(fates_log(),*) ' PFT#: ',ipft + write(fates_log(),*) ' nitr: ',EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,store_organ) + write(fates_log(),*) ' phos: ',EDPftvarcon_inst%turnover_phos_retrans_p1(ipft,store_organ) + write(fates_log(),*) ' Aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + ! Growth respiration + if (hlm_parteh_mode .eq. 1) then + if ( ( EDPftvarcon_inst%grperc(ipft) < 0.0_r8) .or. & + ( EDPftvarcon_inst%grperc(ipft) > 1.0_r8 ) ) then + write(fates_log(),*) ' PFT#: ',ipft + write(fates_log(),*) ' Growth respiration must be between 0 and 1: ',EDPftvarcon_inst%grperc(ipft) + write(fates_log(),*) ' Aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + elseif(hlm_parteh_mode .eq. 2) then + if ( ( any(EDPftvarcon_inst%prt_unit_gr_resp(ipft,:) < 0.0_r8)) .or. & + ( any(EDPftvarcon_inst%prt_unit_gr_resp(ipft,:) >= 1.0_r8)) ) then + write(fates_log(),*) ' PFT#: ',ipft + write(fates_log(),*) ' Growth respiration must be between 0 and 1: ',EDPftvarcon_inst%prt_unit_gr_resp(ipft,:) + write(fates_log(),*) ' Aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + end if + + ! Stoichiometric Ratios + if ( (any(EDPftvarcon_inst%prt_nitr_stoich_p1(ipft,:) < 0.0_r8)) .or. & + (any(EDPftvarcon_inst%prt_nitr_stoich_p1(ipft,:) >= 1.0_r8)) .or. & + (any(EDPftvarcon_inst%prt_nitr_stoich_p2(ipft,:) < 0.0_r8)) .or. & + (any(EDPftvarcon_inst%prt_nitr_stoich_p2(ipft,:) >= 1.0_r8)) ) then + write(fates_log(),*) ' PFT#: ',ipft + write(fates_log(),*) ' N per C stoichiometry must bet between 0-1' + write(fates_log(),*) EDPftvarcon_inst%prt_nitr_stoich_p1(ipft,:) + write(fates_log(),*) EDPftvarcon_inst%prt_nitr_stoich_p2(ipft,:) + write(fates_log(),*) ' Aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + ! Stoichiometric Ratios + if (hlm_parteh_mode .eq. 2) then + if ( (any(EDPftvarcon_inst%prt_phos_stoich_p1(ipft,:) < 0.0_r8)) .or. & + (any(EDPftvarcon_inst%prt_phos_stoich_p1(ipft,:) >= 1.0_r8)) .or. & + (any(EDPftvarcon_inst%prt_phos_stoich_p2(ipft,:) < 0.0_r8)) .or. & + (any(EDPftvarcon_inst%prt_phos_stoich_p2(ipft,:) >= 1.0_r8)) ) then + write(fates_log(),*) ' PFT#: ',ipft + write(fates_log(),*) ' P per C stoichiometry must bet between 0-1' + write(fates_log(),*) EDPftvarcon_inst%prt_phos_stoich_p1(ipft,:) + write(fates_log(),*) EDPftvarcon_inst%prt_phos_stoich_p2(ipft,:) + write(fates_log(),*) ' Aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + end if + + if (hlm_parteh_mode .eq. 1) then + if (any(EDPftvarcon_inst%prt_alloc_priority(ipft,:) .ne. 0)) then + write(fates_log(),*) ' PFT#: ',ipft + write(fates_log(),*) ' Allocation priorities should be 0 for H1' + write(fates_log(),*) EDPftvarcon_inst%prt_alloc_priority(ipft,:) + write(fates_log(),*) ' Aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + elseif (hlm_parteh_mode .eq. 2) then + if ( any(EDPftvarcon_inst%prt_alloc_priority(ipft,:) < 0) .or. & + any(EDPftvarcon_inst%prt_alloc_priority(ipft,:) > 6) ) then + write(fates_log(),*) ' PFT#: ',ipft + write(fates_log(),*) ' Allocation priorities should be 0-6 for H1' + write(fates_log(),*) EDPftvarcon_inst%prt_alloc_priority(ipft,:) + write(fates_log(),*) ' Aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + end if + end do diff --git a/parteh/PRTLossFluxesMod.F90 b/parteh/PRTLossFluxesMod.F90 new file mode 100644 index 0000000000..e4432e0cdb --- /dev/null +++ b/parteh/PRTLossFluxesMod.F90 @@ -0,0 +1,395 @@ +module PRTLossFluxesMod + + use EDPftvarcon, only : EDPftvarcon_inst + use PRTGeneric, only : prt_vartypes + use PRTGeneric, only : leaf_organ + use PRTGeneric, only : fnrt_organ + use PRTGeneric, only : sapw_organ + use PRTGeneric, only : store_organ + use PRTGeneric, only : repro_organ + use PRTGeneric, only : truct_organ + use PRTGeneric, only : all_carbon_species + use PRTGeneric, only : carbon12_species + use PRTGeneric, only : nitrogen_species + use PRTGeneric, only : phosphorous_species + use FatesInterfaceMod, only : hlm_freq_day + + ! These public flags specify what kind of event based + ! turnover is happening + + implicit none + private + + integer, public, parameter :: deciduous_drop_event = 1 + integer, public, parameter :: storm_event = 2 + integer, public, parameter :: fire_event = 3 + integer, public, parameter :: herbivory_event = 4 + + ! ------------------------------------------------------------------------------------- + ! This module hosts two public functions that handle all things + ! related to loss fluxes. They broadly cover the two types of turnover; + ! that which happens as events (storms, deciduous drop, herbivory + ! fire, etc), and maintenance turnover (constant background) + ! of evergreens, and branchfall). + ! + ! IMPORTANT POINTS! + ! Retranslocation is handled by a single + ! flag that defines the mode for each PFT. So there + ! are assumptions here. A deciduous plant does not + ! have maintenance leaf and fine-root turnover, and vice + ! versa. Therefore, the retranslocation parameter + ! will have different meanings potentially, for each PFT. + ! + ! Branchfall occurs for each PFT (it may be at a reduced rate, + ! but it will be called none-the-less). + ! + ! THIS ROUTINE ONLY DEALS WITH LOSSES OF BIOMASS FROM PLANTS THAT ARE SURVIVING + ! AN EVENT. IF A PLANT DIES, THEN THIS ROUTINE DOES NOT HANDLE ITS FLUXES. It + ! is however likely that an event like fire will kill a portion of a populatoin, + ! and damage the remaining population, these routines will assist in the latter. + ! + ! EDPftvarcon_inst%turnover_retrans_mode + ! ------------------------------------------------------------------------------------- + + public :: DeciduousTurnover + public :: MaintTurnover + public :: PlantBurnLosses + +contains + + + subroutine PlantBurnLosses(prt, ipft, organ_id, mass_fraction) + + ! This subroutine assumes that there is no re-translocation associated + ! with burn. There is only one destiny for burned mass within + ! the organ, and that is outside the plant. + ! It is also assumed that non PARTEH parts of the code (ie the fire-model) + ! will decide what to do with the burned mass (i.e. sent it to the litter + ! pool or send to atmosphere, or.. other?) + + class(prt_vartypes) :: prt + integer,intent(in) :: ipft + integer,intent(in) :: organ_id + real(r8),intent(in) :: mass_fraction + + integer :: i_pos ! position index + integer :: i_var ! index for the variable of interest + integer :: i_sp_var ! loop counter for all species in this organ + integer :: num_sp_var ! Loop size for iterating over all species + integer :: spec_id ! Species id of the turnover pool + real(r8) :: burned_mass ! Burned mass of each species, in eahc + ! position, in the organ of interest + + associate(organ_map => prt%prt_instance%organ_map) + + ! This is the total number of state variables associated + ! with this particular organ + + num_sp_vars = organ_map(organ_id)%num_vars + + do i_sp_var = 1, num_sp_vars + + i_var = organ_map(organ_id)%var_id(i_sp_var) + + spec_id = prt%prt_instance%state_descriptor(i_var)%spec_id + + ! Loop over all of the coordinate ids + do i_pos = 1,prt%variables(i_var)%num_pos + + ! The mass that is leaving the plant + burned_mass = mass_fraction * prt%variables(i_var)%val(i_pos) + + ! Track the amount of mass being burned (+ is amount lost) + prt%variables(i_var)%burned(i_pos) = prt%variables(i_var)%burned(i_pos) & + + 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) & + - burned_mass + + end do + + end do + + end associate + + end subroutine PlantBurnLosses + + ! =================================================================================== + + + subroutine DeciduousTurnover(prt,ipft,organ_id,mass_fraction) + + ! --------------------------------------------------------------------------------- + ! Generic subroutine (wrapper) calling specialized routines handling + ! the turnover of tissues in living plants (non-mortal) + ! --------------------------------------------------------------------------------- + class(prt_vartypes) :: prt + integer,intent(in) :: ipft + integer,intent(in) :: organ_id + real(r8),intent(in) :: mass_fraction + + if ( int(EDPftvarcon_inst%turnover_retrans_mode(ipft)) == 1 ) then + call DeciduousTurnoverSimpleRetranslocation(prt,ipft,organ_id,mass_fraction) + else + write(fates_log(),*) 'A retranslocation mode was specified for deciduous drop' + write(fates_log(),*) 'that is unknown.' + write(fates_log(),*) 'turnover_retrans_mode= ',EDPftvarcon_inst%turnover_retrans_mode(ipft) + write(fates_log(),*) 'pft = ',ipft + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + return + end subroutine DeciduousTurnover + + + ! ==================================================================================== + + subroutine DeciduousTurnoverSimpleRetranslocation(pft,ipft,organ_id,mass_fraction) + + ! --------------------------------------------------------------------------------- + ! Calculate losses due to deciduous turnover. + ! the turnover of tissues in living plants (non-mortal) + ! + ! ALERT: NO CODE IS CURRENTLY IN PLACE TO LIMIT THE AMOUNT OF CARBON OR NUTRIENT + ! CAN BE RE-TRANSLOCATED INTO STORAGE. IT IS POSSIBLE THAT THE MAXIMUM IS BEING + ! WAY OVER-SHOT. TO FIX THIS, EACH HYPOTHESIS NEEDS TO HAVE WRAPPER CODE + ! TO PROVIDE A WAY TO CALCULATE MAXIMUM ALLOWABLE STORAGE. + ! + ! --------------------------------------------------------------------------------- + + class(prt_vartypes) :: prt + integer,intent(in) :: ipft + integer,intent(in) :: organ_id + real(r8),intent(in) :: mass_fraction + + integer :: i_var ! index for the variable of interest + integer :: i_sp_var ! loop counter for all species in this organ + + integer :: num_sp_var ! Loop size for iterating over all species + ! in the organ that is turning over + integer :: spec_id ! Species id of the turnover pool + integer :: store_var_id ! Variable id of the storage pool + integer :: i_pos ! position index (spatial) + real(r8) :: retrans ! retranslocated fraction + real(r8) :: turnover_mass + real(r8) :: retranslocated_mass + + + associate(organ_map => prt%prt_instance%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__)) + + end if + + ! This is the total number of state variables associated + ! with this particular organ + num_sp_vars = organ_map(organ_id)%num_vars + + do i_sp_var = 1, num_sp_vars + + i_var = organ_map(organ_id)%var_id(i_sp_var) + + spec_id = prt%prt_instance%state_descriptor(i_var)%spec_id + + if ( any(spec_id == carbon_species) ) then + retrans = EDPftvarcon_inst%turnover_carb_retrans_p1(ipft,organ_id) + else if( spec_id == nitrogen_species ) then + retrans = EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,organ_id) + else if( spec_id == phosphorous_species ) then + retrans = EDPftvarcon_inst%turnover_phos_retrans_p1(ipft,organ_id) + else + write(fates_log(),*) 'Please add a new re-translocation clause to your ' + write(fates_log(),*) ' organ x species combination' + write(fates_log(),*) ' organ: ',leaf_organ,' species: ',spec_id + write(fates_log(),*) 'Exiting' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + ! Get the variable id of the storage pool for this species + store_var_id = prt%prt_instance%sp_organ_map(store_organ,spec_id) + + ! Loop over all of the coordinate ids + do i_pos = 1,prt%variables(i_var)%num_pos + + ! The mass that is leaving the plant + turnover_mass = (1.0_r8 - retrans) * mass_fraction * prt%variables(i_var)%val(i_pos) + + ! The mass that is going towards storage + retranslocated_mass = retrans * mass_fraction * prt%variables(i_var)%val(i_pos) + + ! Track the amount of mass being turned over (+ is amount lost) + prt%variables(i_var)%turnover(i_pos) = prt%variables(i_var)%turnover(i_pos) & + + turnover_mass + + ! Track the amount of mass the is being re-translocated (- is amount lost) + prt%variables(i_var)%net_art(i_pos) = prt%variables(i_var)%net_art(i_pos) & + - retranslocated_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) & + - (turnover_mass + retranslocated_mass) + + ! Now, since re-translocation is handled by the storage pool, + ! we add the re-translocated mass to it + + prt%variables(store_var_id)%net_art(i_pos) = & + prt%variables(store_var_id)%net_art(i_pos) + retranslocated_mass + + prt%variables(store_var_id)%val(i_pos) = & + prt%variables(store_var_id)%val(i_pos) + retranslocated_mass + + + end do + + end do + + end associate + + return + end subroutine DeciduousTurnoverSimpleRetranslocation + + ! ==================================================================================== + + subroutine MaintTurnover(prt,ipft) + + ! --------------------------------------------------------------------------------- + ! Generic subroutine (wrapper) calling specialized routines handling + ! the turnover of tissues in living plants (non-mortal) + ! --------------------------------------------------------------------------------- + class(prt_vartypes) :: prt + integer,intent(in) :: ipft + + if ( int(EDPftvarcon_inst%turnover_retrans_mode(ipft)) == 1 ) then + call MaintTurnoverSimpleRetranslocation(prt,ipft) + else + write(fates_log(),*) 'A maintenance/retranslocation mode was specified' + write(fates_log(),*) 'that is unknown.' + write(fates_log(),*) 'turnover_retrans_mode= ',EDPftvarcon_inst%turnover_retrans_mode(ipft) + write(fates_log(),*) 'pft = ',ipft + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + return + end subroutine MaintTurnover + + ! =================================================================================== + + subroutine MaintTurnoverSimpleRetranslocation(prt,ipft) + + ! --------------------------------------------------------------------------------- + ! This subroutine removes biomass from all applicable pools due to + ! "maintenance turnover". Maintenance turnover, in this context + ! is the loss of biomass on living plants, due to continuous turnover. + ! + ! Notes: + ! 1) It is assumed that this is called daily. + ! 2) This is a completely different thing compared to deciduous leaf drop, + ! or loss of biomass from the death of the plant. + ! 3) Since this is maintenance turnover, and not a complete drop of leaves for + ! deciduous trees, we just re-translocate nutrients (if necessary) from the + ! leaves and roots that leave (no pun intended), into the leaves and roots that + ! are still rooted to the plant (pun intended). For deciduous, event-based + ! phenology, we will re-translocate to the storage pool. + ! 4) There are currently no reaction costs associated with re-translocation + ! --------------------------------------------------------------------------------- + + class(prt_vartypes) :: prt + integer,intent(in) :: ipft + + + integer :: i_var + integer :: spec_id + integer :: organ_id + integer :: num_sp_vars + integer :: i_pos + + real(r8) :: base_turnover + real(r8) :: leaf_turnover + real(r8) :: fnrt_turnover + real(r8) :: sapw_turnover + real(r8) :: store_turnover + real(r8) :: struct_turnover + real(r8) :: repro_turnover + real(r8) :: turnover ! A temp for the actual turnover removed from pool + real(r8) :: retrans ! A temp for the actual re-translocated mass + + num_sp_vars = size(prt%variables,1) + + ! ----------------------------------------------------------------------------------- + ! Calculate the turnover rates + ! ----------------------------------------------------------------------------------- + + if ( EDPftvarcon_inst%branch_turnover(ipft) > nearzero ) then + sapw_turnover = hlm_freq_day / EDPftvarcon_inst%branch_turnover(ipft) + struct_turnover = hlm_freq_day / EDPftvarcon_inst%branch_turnover(ipft) + store_turnover = hlm_freq_day / EDPftvarcon_inst%branch_turnover(ipft) + else + sapw_turnover = 0.0_r8 + struct_turnover = 0.0_r8 + store_turnover = 0.0_r8 + + end if + if ( EDPftvarcon_inst%root_long(ipft) > nearzero ) then + fnrt_turnover = hlm_freq_day / EDPftvarcon_inst%root_long(ipft) + else + fnrt_turnover = 0.0_r8 + end if + if ( (EDPftvarcon_inst%leaf_long(ipft) > nearzero ) .and. & + (EDPftvarcon_inst%evergreen(ipft) == 1) ) then + leaf_turnover = hlm_freq_day / EDPftvarcon_inst%leaf_long(ipft) + else + leaf_turnover = 0.0_r8 + endif + + repro_turnover = 0.0_r8 + + do i_var = 1, num_sp_vars + + organ_id = prt%prt_instance%state_descriptor(i_var)%organ_id + spec_id = prt%prt_instance%state_descriptor(i_var)%spec_id + + if ( any(spec_id == carbon_species) ) then + retrans = EDPftvarcon_inst%turnover_carb_retrans_p1(ipft,organ_id) + else if( spec_id == nitrogen_species ) then + retrans = EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,organ_id) + else if( spec_id == phosphorous_species ) then + retrans = EDPftvarcon_inst%turnover_phos_retrans_p1(ipft,organ_id) + else + write(fates_log(),*) 'Please add a new re-translocation clause to your ' + write(fates_log(),*) ' organ x species combination' + write(fates_log(),*) ' organ: ',leaf_organ,' species: ',spec_id + write(fates_log(),*) 'Exiting' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + ! Loop over all of the coordinate ids + + do i_pos = 1,prt%variables(i_var)%num_pos + + turnover = (1.0_r8 - retrans) * base_turnover * prt%variables(i_var)%val(i_pos) + + prt%variables(i_var)%turnover(i_pos) = prt%variables(i_var)%turnover(i_pos) + turnover + + prt%variables(i_var)%val(i_pos) = prt%variables(i_var)%val(i_pos) - turnover + + end do + + end do + + return + end subroutine MaintTurnoverSimpleRetranslocation + + + + + +end module PRTLossFluxesMod From d3f760fe813e0ce46dc132c85baaccfecdab0f03 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Tue, 25 Sep 2018 14:18:37 -0700 Subject: [PATCH 12/52] Updating calls to loss-fluxes. Removed the cohort litter_flux variable (redundant). --- biogeochem/EDCohortDynamicsMod.F90 | 11 +- biogeochem/EDPatchDynamicsMod.F90 | 6 +- biogeochem/EDPhysiologyMod.F90 | 102 +++++++------ biogeophys/FatesPlantRespPhotosynthMod.F90 | 10 +- main/ChecksBalancesMod.F90 | 37 +++-- main/EDMainMod.F90 | 14 ++ main/EDTypesMod.F90 | 3 +- parteh/PRTAllometricCarbonMod.F90 | 4 +- parteh/PRTGenericMod.F90 | 72 ++++++++- parteh/PRTLossFluxesMod.F90 | 170 ++++++++++++++++++--- 10 files changed, 328 insertions(+), 101 deletions(-) diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index 01fe8acf8b..495f13bfe8 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -384,7 +384,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%leaf_litter = nan ! leaf litter from phenology: KgC/m2 + ! VARIABLES NEEDED FOR INTEGRATION currentCohort%dndt = nan ! time derivative of cohort size @@ -438,7 +438,7 @@ subroutine zero_cohort(cc_p) currentcohort%gpp_tstep = 0._r8 currentcohort%resp_tstep = 0._r8 currentcohort%resp_acc_hold = 0._r8 - currentcohort%leaf_litter = 0._r8 + 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 @@ -598,13 +598,9 @@ subroutine terminate_cohorts( currentSite, currentPatch, level ) * 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 @@ -854,8 +850,6 @@ subroutine fuse_cohorts(currentSite, currentPatch, bc_in) currentCohort%fire_mort = (currentCohort%n*currentCohort%fire_mort + & nextc%n*nextc%fire_mort)/newn - currentCohort%leaf_litter = (currentCohort%n*currentCohort%leaf_litter + & - nextc%n*nextc%leaf_litter)/newn ! mortality diagnostics currentCohort%cmort = (currentCohort%n*currentCohort%cmort + nextc%n*nextc%cmort)/newn @@ -1260,7 +1254,6 @@ subroutine copy_cohort( currentCohort,copyc ) n%seed_prod = o%seed_prod n%treelai = o%treelai n%treesai = o%treesai - n%leaf_litter = o%leaf_litter n%c_area = o%c_area ! Mortality diagnostics diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 9c9c7dc11b..d5e95aa88e 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -53,7 +53,7 @@ module EDPatchDynamicsMod use PRTGenericMod, only : carbon12_species use PRTGenericMod, only : SetState - + use PRTLossFluxesMod, only : PRTBurnLosses ! CIME globals @@ -1062,8 +1062,8 @@ subroutine fire_litter_fluxes(currentSite, cp_target, new_patch_target, patch_si if (burned_leaves > 0.0_r8) then ! Remove burned leaves from the pool - call SetState(currentCohort%prt,leaf_organ, carbon12_species, leaf_c - burned_leaves ) - + call PRTBurnLosses(currentCohort%prt, leaf_organ, burned_leaves/leaf_c) + !KgC/gridcell/day currentSite%flux_out = currentSite%flux_out + burned_leaves * currentCohort%n * & patch_site_areadis/currentPatch%area * AREA diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 8df1d2e87c..25f424e189 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -66,6 +66,8 @@ module EDPhysiologyMod use PRTGenericMod, only : repro_organ use PRTGenericMod, only : struct_organ use PRTGenericMod, only : SetState + use PRTLossFluxesMod, only : PRTPhenologyFlush + use PRTLossFluxesMod, only : PRTDeciduousTurnover implicit none private @@ -643,13 +645,11 @@ subroutine phenology_leafonoff(currentSite) type(ed_patch_type) , pointer :: currentPatch type(ed_cohort_type), pointer :: currentCohort - real(r8) :: leaf_c ! leaf carbon [kg] - real(r8) :: store_c ! storage carbon [kg] - real(r8) :: transferred_c ! carbon transferred from storage to leaf [kg] - - real(r8) :: store_output ! the amount of the store to put into leaves - + real(r8) :: leaf_c ! leaf carbon [kg] + real(r8) :: store_c ! storage carbon [kg] + real(r8) :: store_output ! the amount of the store to put into leaves - ! is a barrier against negative storage and C starvation. - + real(r8) :: store_c_transfer_frac ! Fraction of storage carbon used to flush leaves !------------------------------------------------------------------------ currentPatch => CurrentSite%oldest_patch @@ -660,73 +660,81 @@ subroutine phenology_leafonoff(currentSite) currentCohort => currentPatch%tallest do while(associated(currentCohort)) - currentCohort%leaf_litter = 0.0_r8 !zero leaf litter for today. - ! Retrieve existing leaf and storage carbon store_c = currentCohort%prt%GetState(store_organ, carbon12_species) leaf_c = currentCohort%prt%GetState(leaf_organ, carbon12_species) - !COLD LEAF ON if (EDPftvarcon_inst%season_decid(currentCohort%pft) == 1)then if (currentSite%status == 2)then !we have just moved to leaves being on . if (currentCohort%status_coh == 1)then !Are the leaves currently off? - currentCohort%status_coh = 2 !Leaves are on, so change status to stop flow of carbon out of bstore. - - transferred_c = min(currentCohort%laimemory, store_c*store_output) + currentCohort%status_coh = 2 ! Leaves are on, so change status to + ! stop flow of carbon out of bstore. - ! Transfer into leaves - call SetState(currentCohort%prt,leaf_organ, carbon12_species, transferred_c ) - - ! Reduce storage - call SetState(currentCohort%prt,store_organ, carbon12_species, store_c - transferred_c ) + if(store_c>nearzero) then + store_c_transfer_frac = & + min(currentCohort%laimemory, store_c*store_output)/store_c + else + store_c_transfer_frac = 0.0_r8 + end if + + call PRTPhenologyFlush(currentCohort%prt, currentCohort%pft, & + leaf_organ, store_c_transfer_frac) - store_c = store_c - transferred_c currentCohort%laimemory = 0.0_r8 endif !pft phenology endif ! growing season !COLD LEAF OFF -! currentCohort%leaf_litter = 0.0_r8 !zero leaf litter for today. - if (currentSite%status == 1)then !past leaf drop day? Leaves still on tree? if (currentCohort%status_coh == 2)then ! leaves have not dropped - currentCohort%status_coh = 1 - !remember what the lai was this year to put the same amount back on in the spring... + + ! This sets the cohort to the "leaves off" flag + currentCohort%status_coh = 1 + + ! Remember what the lai was (leaf mass actually) was for next year + ! the same amount back on in the spring... + currentCohort%laimemory = leaf_c - ! add lost carbon to litter - currentCohort%leaf_litter = leaf_c + ! Drop Leaves (this routine will update the leaf state variables, + ! for carbon and any other species that are prognostic. It will + ! also track the turnover masses that will be sent to litter later on) - ! Drop Leaves - ! (THIS NEEDS TO MIGRATED TO A PRT PHENOLOGY SCHEME THAT HANDLES - ! ARBITRARY SPECIES (EG N+P) ) - call SetState(currentCohort%prt,leaf_organ, carbon12_species, 0.0_r8 ) - leaf_c = 0.0_r8 + call PRTDeciduousTurnover(currentCohort%prt,currentCohort%pft, & + leaf_organ, 1.0_r8) endif !leaf status endif !currentSite status endif !season_decid !DROUGHT LEAF ON + if (EDPftvarcon_inst%stress_decid(currentCohort%pft) == 1)then + + if (currentSite%dstatus == 2)then - if (EDPftvarcon_inst%stress_decid(currentCohort%pft) == 1)then - if (currentSite%dstatus == 2)then !we have just moved to leaves being on . - if (currentCohort%status_coh == 1)then !is it the leaf-on day? Are the leaves currently off? - currentCohort%status_coh = 2 !Leaves are on, so change status to stop flow of carbon out of bstore. + ! we have just moved to leaves being on . - transferred_c = min(currentCohort%laimemory, store_c*store_output) - - ! Transfer into leaves - call SetState(currentCohort%prt,leaf_organ, carbon12_species, transferred_c ) + if (currentCohort%status_coh == 1)then - ! Reduce storage - call SetState(currentCohort%prt,store_organ, carbon12_species, store_c - transferred_c ) + !is it the leaf-on day? Are the leaves currently off? + + currentCohort%status_coh = 2 ! Leaves are on, so change status to + ! stop flow of carbon out of bstore. + + if(store_c>nearzero) then + store_c_transfer_frac = & + min(currentCohort%laimemory, store_c*store_output)/store_c + else + store_c_transfer_frac = 0.0_r8 + end if + + call PRTPhenologyFlush(currentCohort%prt, currentCohort%pft, & + leaf_organ, store_c_transfer_frac) - store_c = store_c - transferred_c currentCohort%laimemory = 0.0_r8 endif !currentCohort status again? @@ -735,15 +743,15 @@ subroutine phenology_leafonoff(currentSite) !DROUGHT LEAF OFF if (currentSite%dstatus == 1)then if (currentCohort%status_coh == 2)then ! leaves have not dropped - currentCohort%status_coh = 1 + ! This sets the cohort to the "leaves off" flag + currentCohort%status_coh = 1 + + ! Remember what the lai (leaf mass actually) was for next year currentCohort%laimemory = leaf_c - ! add falling leaves to litter pools . convert to KgC/m2 - currentCohort%leaf_litter = leaf_c - - call SetState(currentCohort%prt,leaf_organ, carbon12_species, 0.0_r8 ) - leaf_c = 0.0_r8 + call PRTDeciduousTurnover(currentCohort%prt,currentCohort%pft, & + leaf_organ, 1.0_r8) endif endif !status @@ -1071,8 +1079,6 @@ subroutine CWD_Input( currentSite, currentPatch) currentPatch%root_litter_in(pft) = currentPatch%root_litter_in(pft) + & (fnrt_c_turnover + store_c_turnover ) * currentCohort%n/currentPatch%area - currentPatch%leaf_litter_in(pft) = currentPatch%leaf_litter_in(pft) + & - currentCohort%leaf_litter * currentCohort%n/currentPatch%area/hlm_freq_day !daily leaf loss needs to be scaled up to the annual scale here. diff --git a/biogeophys/FatesPlantRespPhotosynthMod.F90 b/biogeophys/FatesPlantRespPhotosynthMod.F90 index fa3256d22e..3a9d25b179 100644 --- a/biogeophys/FatesPlantRespPhotosynthMod.F90 +++ b/biogeophys/FatesPlantRespPhotosynthMod.F90 @@ -434,8 +434,8 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) ! Leaf nitrogen concentration at the top of the canopy (g N leaf / m**2 leaf) select case(new_cohort%parteh_model) case (1) - lnc = 1._r8 / & - (slatop(ft) * EDPftvarcon_inst%prt_nitr_stoich_p1(ipft,leaf_organ)) + + lnc = EDPftvarcon_inst%prt_nitr_stoich_p1(ipft,leaf_organ)/slatop(ft) ! case (2) ! @@ -582,12 +582,12 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) fnrt_c = currentCohort%prt%GetState(fnrt_organ, all_carbon_species) live_stem_n = EDPftvarcon_inst%allom_agb_frac(currentCohort%pft) * & - sapw_c / EDPftvarcon_inst%prt_nitr_stoich_p1(ipft,sapw_organ) + sapw_c * EDPftvarcon_inst%prt_nitr_stoich_p1(ipft,sapw_organ) live_croot_n = (1.0_r8-EDPftvarcon_inst%allom_agb_frac(currentCohort%pft)) * & - sapw_c / EDPftvarcon_inst%prt_nitr_stoich_p1(ipft,sapw_organ) + sapw_c * EDPftvarcon_inst%prt_nitr_stoich_p1(ipft,sapw_organ) - fnrt_n = fnrt_c / EDPftvarcon_inst%prt_nitr_stoich_p1(ipft,fnrt_organ) + fnrt_n = fnrt_c * EDPftvarcon_inst%prt_nitr_stoich_p1(ipft,fnrt_organ) end select diff --git a/main/ChecksBalancesMod.F90 b/main/ChecksBalancesMod.F90 index 00cd466f0f..61a48365af 100644 --- a/main/ChecksBalancesMod.F90 +++ b/main/ChecksBalancesMod.F90 @@ -4,6 +4,19 @@ module ChecksBalancesMod 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 FatesConstants, only : g_per_kg + + use PRTGenericMod, only : all_carbon_species + use PRTGenericMod, only : carbon12_species + use PRTGenericMod, only : nitrogen_species + use PRTGenericMod, only : phosphorous_species + use PRTGenericMod, only : leaf_organ + use PRTGenericMod, only : fnrt_organ + use PRTGenericMod, only : sapw_organ + use PRTGenericMod, only : store_organ + use PRTGenericMod, only : repro_organ + use PRTGenericMod, only : struct_organ + use PRTGenericMod, only : carbon12_species implicit none @@ -78,11 +91,13 @@ subroutine SummarizeNetFluxes( nsites, sites, bc_in, is_beg_day ) ! map biomass pools to column level sites(s)%biomass_stock = sites(s)%biomass_stock + & - (currentCohort%bdead + & - currentCohort%bsw + & - currentCohort%bl + & - currentCohort%br + & - currentCohort%bstore) * n_perm2 * 1.e3_r8 + ( currentCohort%prt%GetState(struct_organ,all_carbon_species) + & + currentCohort%prt%GetState(sapw_organ,all_carbon_species) + & + currentCohort%prt%GetState(leaf_organ,all_carbon_species) + & + currentCohort%prt%GetState(fnrt_organ,all_carbon_species) + & + currentCohort%prt%GetState(store_organ,all_carbon_species) + & + currentCohort%prt%GetState(repro_organ,all_carbon_species) ) & + * n_perm2 * g_per_kg currentCohort => currentCohort%shorter enddo !currentCohort @@ -268,11 +283,13 @@ subroutine SiteCarbonStock(currentSite,total_stock,biomass_stock,litter_stock,se currentCohort => currentPatch%tallest do while(associated(currentCohort)) biomass_stock = biomass_stock + & - (currentCohort%bdead + & - currentCohort%bsw + & - currentCohort%br + & - currentCohort%bl + & - currentCohort%bstore) * currentCohort%n + (currentCohort%prt%GetState(struct_organ,all_carbon_species) + & + currentCohort%prt%GetState(sapw_organ,all_carbon_species) + & + currentCohort%prt%GetState(leaf_organ,all_carbon_species) + & + currentCohort%prt%GetState(fnrt_organ,all_carbon_species) + & + currentCohort%prt%GetState(store_organ,all_carbon_species) + & + currentCohort%prt%GetState(repro_organ,all_carbon_species) ) & + * currentCohort%n currentCohort => currentCohort%shorter enddo !end cohort loop currentPatch => currentPatch%younger diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index ec5fd79d50..c93751b762 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -53,6 +53,20 @@ module EDMainMod use FatesGlobals , only : endrun => fates_endrun use ChecksBalancesMod , only : SiteCarbonStock use EDMortalityFunctionsMod , only : Mortality_Derivative + + use PRTGenericMod, only : all_carbon_species + use PRTGenericMod, only : carbon12_species + use PRTGenericMod, only : nitrogen_species + use PRTGenericMod, only : phosphorous_species + use PRTGenericMod, only : leaf_organ + use PRTGenericMod, only : fnrt_organ + use PRTGenericMod, only : sapw_organ + use PRTGenericMod, only : store_organ + use PRTGenericMod, only : repro_organ + use PRTGenericMod, only : struct_organ + use PRTGenericMod, only : carbon12_species + use PRTGenericMod, only : SetState + ! CIME Globals use shr_log_mod , only : errMsg => shr_log_errMsg use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 2d8e63e27d..225cc818ab 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -228,7 +228,7 @@ module EDTypesMod ! ALLOCATION real(r8) :: seed_prod ! reproduction seed and clonal: KgC/indiv/year - real(r8) :: leaf_litter ! leaf litter from phenology: KgC/m2 + !MORTALITY real(r8) :: dmort ! proportional mortality rate. (year-1) @@ -790,7 +790,6 @@ subroutine dump_cohort(ccohort) 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%leaf_litter = ', ccohort%leaf_litter write(fates_log(),*) 'co%c_area = ', ccohort%c_area write(fates_log(),*) 'co%cmort = ', ccohort%cmort write(fates_log(),*) 'co%bmort = ', ccohort%bmort diff --git a/parteh/PRTAllometricCarbonMod.F90 b/parteh/PRTAllometricCarbonMod.F90 index 0203a6bf28..6369613540 100644 --- a/parteh/PRTAllometricCarbonMod.F90 +++ b/parteh/PRTAllometricCarbonMod.F90 @@ -24,6 +24,8 @@ module PRTAllometricCarbonMod use PRTGenericMod , only : repro_organ use PRTGenericMod , only : struct_organ + use PRTLossFluxesMod , only : PRTMaintTurnover + use FatesInterfaceMod , only : hlm_freq_day use FatesAllometryMod , only : bleaf use FatesAllometryMod , only : bsap_allom @@ -426,7 +428,7 @@ subroutine DailyPRTAC(this) ! This will increment %turnover and decrease %val ! ---------------------------------------------------------------------------------- - call this%MaintTurnover(ipft) + call PRTMaintTurnover(this,ipft) ! ----------------------------------------------------------------------------------- ! III. Prioritize some amount of carbon to replace leaf/root turnover diff --git a/parteh/PRTGenericMod.F90 b/parteh/PRTGenericMod.F90 index 11f92e11be..0cc29fd1b6 100644 --- a/parteh/PRTGenericMod.F90 +++ b/parteh/PRTGenericMod.F90 @@ -396,6 +396,7 @@ subroutine InitializeInitialConditions(this) this%variables(i_var)%val(:) = un_initialized this%variables(i_var)%val0(:) = un_initialized this%variables(i_var)%turnover(:) = un_initialized + this%variables(i_var)%burned(:) = un_initialized this%variables(i_var)%net_art(:) = un_initialized end do @@ -553,10 +554,11 @@ subroutine CopyPRTVartypes(this, donor_prt_obj) n_vars = size(donor_prt_obj%variables,1) do i_var = 1, n_vars - this%variables(i_var)%val(:) = donor_prt_obj%variables(i_var)%val(:) - this%variables(i_var)%val0(:) = donor_prt_obj%variables(i_var)%val0(:) - this%variables(i_var)%net_art(:) = donor_prt_obj%variables(i_var)%net_art(:) - this%variables(i_var)%turnover(:) = donor_prt_obj%variables(i_var)%turnover(:) + this%variables(i_var)%val(:) = donor_prt_obj%variables(i_var)%val(:) + this%variables(i_var)%val0(:) = donor_prt_obj%variables(i_var)%val0(:) + this%variables(i_var)%net_art(:) = donor_prt_obj%variables(i_var)%net_art(:) + this%variables(i_var)%turnover(:) = donor_prt_obj%variables(i_var)%turnover(:) + this%variables(i_var)%burned(:) = donor_prt_obj%variables(i_var)%burned(:) end do if(allocated(this%bc_in))then @@ -631,6 +633,10 @@ subroutine WeightedFusePRTVartypes(this,donor_prt_obj, recipient_fuse_weight, po this%variables(i_var)%turnover(pos_id) = recipient_fuse_weight * this%variables(i_var)%turnover(pos_id) + & (1.0_r8-recipient_fuse_weight) * donor_prt_obj%variables(i_var)%turnover(pos_id) + + this%variables(i_var)%burned(pos_id) = recipient_fuse_weight * this%variables(i_var)%burned(pos_id) + & + (1.0_r8-recipient_fuse_weight) * donor_prt_obj%variables(i_var)%burned(pos_id) + end do this%ode_opt_step = recipient_fuse_weight * this%ode_opt_step + & @@ -749,6 +755,7 @@ subroutine ZeroRates(this) this%variables(ivar)%val0(:) = this%variables(ivar)%val(:) this%variables(ivar)%net_art(:) = 0.0_r8 this%variables(ivar)%turnover(:) = 0.0_r8 + this%variables(ivar)%burned(:) = 0.0_r8 end do end subroutine ZeroRates @@ -772,7 +779,8 @@ subroutine CheckMassConservation(this) err = (this%variables(ivar)%val(pos_id) - this%variables(ivar)%val0(pos_id)) - & (this%variables(ivar)%net_art(pos_id) & - -this%variables(ivar)%turnover(pos_id)) + -this%variables(ivar)%turnover(pos_id) & + -this%variables(ivar)%burned(pos_id) ) if( abs(err) > calloc_abs_error ) then write(fates_log(),*) 'PARTEH mass conservation check failed' @@ -912,6 +920,59 @@ function GetTurnover(this, organ_id, species_id, position_id) result(sp_organ_tu return end function GetTurnover + ! ========================================================================= + + function GetBurned(this, organ_id, species_id, position_id) result(sp_organ_burned) + + + class(prt_vartypes) :: this + integer,intent(in) :: organ_id + integer,intent(in) :: species_id + integer,intent(in),optional :: position_id + real(r8) :: sp_organ_burned + + integer :: pos_id + integer :: ispec + integer :: num_species + integer,dimension(max_spec_per_group) :: spec_ids + integer :: index + + sp_organ_burned = 0.0_r8 + + if(species_id == all_carbon_species) then + spec_ids(1:3) = carbon_species(1:3) + num_species = 3 + else + num_species = 1 + spec_ids(1) = species_id + end if + + if(present(position_id)) then + pos_id = position_id + + do ispec = 1,num_species + index = this%prt_instance%sp_organ_map(organ_id,spec_ids(ispec)) + if(index>0) sp_organ_burned = sp_organ_burned + & + this%variables(index)%burned(pos_id) + end do + + else + + do ispec = 1,num_species + index = this%prt_instance%sp_organ_map(organ_id,spec_ids(ispec)) + if(index>0) then + do pos_id = 1, this%variables(index)%num_pos + sp_organ_burned = sp_organ_burned + this%variables(index)%burned(pos_id) + end do + end if + + end do + + end if + + return + end function GetBurned + ! ===================================================================================== function GetCoordVal(this, organ_id, species_id ) result(prt_val) @@ -1021,7 +1082,6 @@ subroutine SetState(prt,organ_id, species_id, state_val, position_id) return end subroutine SetState - ! ==================================================================================== diff --git a/parteh/PRTLossFluxesMod.F90 b/parteh/PRTLossFluxesMod.F90 index e4432e0cdb..be4f39af37 100644 --- a/parteh/PRTLossFluxesMod.F90 +++ b/parteh/PRTLossFluxesMod.F90 @@ -20,11 +20,6 @@ module PRTLossFluxesMod implicit none private - integer, public, parameter :: deciduous_drop_event = 1 - integer, public, parameter :: storm_event = 2 - integer, public, parameter :: fire_event = 3 - integer, public, parameter :: herbivory_event = 4 - ! ------------------------------------------------------------------------------------- ! This module hosts two public functions that handle all things ! related to loss fluxes. They broadly cover the two types of turnover; @@ -45,20 +40,163 @@ module PRTLossFluxesMod ! ! THIS ROUTINE ONLY DEALS WITH LOSSES OF BIOMASS FROM PLANTS THAT ARE SURVIVING ! AN EVENT. IF A PLANT DIES, THEN THIS ROUTINE DOES NOT HANDLE ITS FLUXES. It - ! is however likely that an event like fire will kill a portion of a populatoin, + ! is however likely that an event like fire will kill a portion of a population, ! and damage the remaining population, these routines will assist in the latter. ! ! EDPftvarcon_inst%turnover_retrans_mode ! ------------------------------------------------------------------------------------- - public :: DeciduousTurnover - public :: MaintTurnover - public :: PlantBurnLosses + public :: PRTDeciduousTurnover + public :: PRTMaintTurnover + public :: PRTBurnLosses + public :: PRTPhenologyFlush contains + + subroutine PRTPhenologyFlush(prt, ipft, organ_id, c_store_transfer_frac) + + ! This subroutine is used to flush (leaves) from storage upon bud-burst. + ! Leaves are somewhat implied here, but the function does allow for other + ! pools (fine-roots) to be flushed from storage as well. + + class(prt_vartypes) :: prt + integer,intent(in) :: ipft + integer,intent(in) :: organ_id + real(r8),intent(in) :: c_store_transfer_frac ! carbon mass fraction + ! transferred from storage + + integer :: i_var ! variable index + integer :: i_cvar ! carbon variable index + integer :: i_pos ! spatial position index + integer :: i_store ! storage variable index + integer :: spec_id ! global species identifier + integer :: num_sp_vars ! number of species for this organ + integer :: i_store ! variable index of storage + real(r8) :: mass_transfer ! The actual mass + ! removed from storage + ! for each pool + real(r8) :: target_stoich ! stoichiometry of species of interest + real(r8) :: sp_target ! target nutrient mass for species + real(r8) :: sp_demand ! nutrient demand for species + + + associate(organ_map => prt%prt_instance%organ_map) + + ! This is the total number of state variables associated + ! with this particular organ (ie carbon, nitrogen, phosphorous, ...) + + num_sp_vars = organ_map(organ_id)%num_vars + + + ! First transfer in carbon + ! -------------------------------------------------------------------------------- + + i_cvar = prt%prt_instance%sp_organ_map(organ_id,carbon12_species) + + ! Get the variable id of the storage pool for this species (carbon12) + i_store = prt%prt_instance%sp_organ_map(store_organ,carbon12_species) + + ! Loop over all of the coordinate ids + do i_pos = 1,prt%variables(i_cvar)%num_pos + + ! Calculate the mass transferred out of storage into the pool of interest + mass_transfer = prt%variables(i_store)%val(i_pos) * c_store_transfer_frac + + ! Increment the c pool of interest + prt%variables(i_cvar)%net_art(i_pos) = & + prt%variables(i_cvar)%net_art(i_pos) + mass_transfer + + ! Update the c pool + prt%variables(i_cvar)%val(i_pos) = & + prt%variables(i_cvar)%val(i_pos) + mass_transfer + + ! Increment the c pool of interest + prt%variables(i_store)%net_art(i_pos) = & + prt%variables(i_store)%net_art(i_pos) - mass_transfer + + ! Update the c pool + prt%variables(i_store)%val(i_pos) = & + prt%variables(i_store)%val(i_pos) - mass_transfer + + + end do + + + ! Transfer in other species + ! -------------------------------------------------------------------------------- + + do i_sp_var = 1, num_sp_vars + + i_var = organ_map(organ_id)%var_id(i_sp_var) + + ! Variable index for the species of interest + spec_id = prt%prt_instance%state_descriptor(i_var)%spec_id + + if ( spec_id .ne. carbon12_species ) then + + ! Get the variable id of the storage pool for this species + i_store = prt%prt_instance%sp_organ_map(store_organ,spec_id) + + ! Calculate the stoichiometry with C for this species + + if( spec_id == nitrogen_species ) then + target_stoich = EDPftvarcon_inst%prt_nitr_stoich_p1(ipft,organ_id) + else if( spec_id == phosphorous_species ) 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 species that DNE' + write(fates_log(),*) ' organ: ',organ_id,' species: ',spec_id + write(fates_log(),*) 'Exiting' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + + ! Loop over all of the coordinate ids + do i_pos = 1,prt%variables(i_var)%num_pos + + ! The target quanitity for this species is based on the amount + ! of carbon + sp_target = prt%variables(i_cvar)%val(i_pos) * target_stoich + + sp_demand = max(0.0_r8,sp_target - prt%variables(i_var)%val(i_pos)) + + ! Assume that all of the storage is transferrable + mass_transfer = min(sp_demand, prt%variables(i_store)%val(i_pos)) + + ! Increment the pool of interest + prt%variables(i_var)%net_art(i_pos) = & + prt%variables(i_var)%net_art(i_pos) + mass_transfer + + ! Update the c pool + prt%variables(i_var)%val(i_pos) = & + prt%variables(i_var)%val(i_pos) + mass_transfer + + ! Increment the c pool of interest + prt%variables(i_store)%net_art(i_pos) = & + prt%variables(i_store)%net_art(i_pos) - mass_transfer + + ! Update the c pool + prt%variables(i_store)%val(i_pos) = & + prt%variables(i_store)%val(i_pos) - mass_transfer + + + end do + + end if + + end do + + + + end associate + return + end subroutine PRTPhenologyFlush - subroutine PlantBurnLosses(prt, ipft, organ_id, mass_fraction) + ! ===================================================================================== + + subroutine PRTBurnLosses(prt, organ_id, mass_fraction) ! This subroutine assumes that there is no re-translocation associated ! with burn. There is only one destiny for burned mass within @@ -68,7 +206,6 @@ subroutine PlantBurnLosses(prt, ipft, organ_id, mass_fraction) ! pool or send to atmosphere, or.. other?) class(prt_vartypes) :: prt - integer,intent(in) :: ipft integer,intent(in) :: organ_id real(r8),intent(in) :: mass_fraction @@ -112,13 +249,12 @@ subroutine PlantBurnLosses(prt, ipft, organ_id, mass_fraction) end do end associate - - end subroutine PlantBurnLosses + end subroutine PRTBurnLosses ! =================================================================================== - subroutine DeciduousTurnover(prt,ipft,organ_id,mass_fraction) + subroutine PRTDeciduousTurnover(prt,ipft,organ_id,mass_fraction) ! --------------------------------------------------------------------------------- ! Generic subroutine (wrapper) calling specialized routines handling @@ -140,7 +276,7 @@ subroutine DeciduousTurnover(prt,ipft,organ_id,mass_fraction) end if return - end subroutine DeciduousTurnover + end subroutine PRTDeciduousTurnover ! ==================================================================================== @@ -259,7 +395,7 @@ end subroutine DeciduousTurnoverSimpleRetranslocation ! ==================================================================================== - subroutine MaintTurnover(prt,ipft) + subroutine PRTMaintTurnover(prt,ipft) ! --------------------------------------------------------------------------------- ! Generic subroutine (wrapper) calling specialized routines handling @@ -279,7 +415,7 @@ subroutine MaintTurnover(prt,ipft) end if return - end subroutine MaintTurnover + end subroutine PRTMaintTurnover ! =================================================================================== From f6b47fdc95116f8a744c8eb7a955900f3144a2e9 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Tue, 25 Sep 2018 17:24:03 -0700 Subject: [PATCH 13/52] Code fixes and tweaks to enable new turnover design into the parteh unit testing framework. --- .../parteh/build_fortran_objects.sh | 3 + .../f_wrapper_modules/FatesCohortWrapMod.F90 | 3 + .../f_wrapper_modules/FatesPFTWrapMod.F90 | 88 +++++----- .../parteh/parteh_controls_defaults.xml | 14 +- .../parteh/parteh_controls_smoketests.xml | 35 ++-- .../parteh/parteh_controls_variable_netc.xml | 26 +-- parteh/PRTAllometricCarbonMod.F90 | 54 +++++-- parteh/PRTGenericMod.F90 | 151 +++++++++--------- parteh/PRTLossFluxesMod.F90 | 53 +++--- 9 files changed, 244 insertions(+), 183 deletions(-) diff --git a/functional_unit_testing/parteh/build_fortran_objects.sh b/functional_unit_testing/parteh/build_fortran_objects.sh index 27cd07c65b..7f8c4e3fd3 100755 --- a/functional_unit_testing/parteh/build_fortran_objects.sh +++ b/functional_unit_testing/parteh/build_fortran_objects.sh @@ -28,6 +28,9 @@ gfortran $F_OPTS $MOD_FLAG bld/ -I bld/ -o bld/FatesAllometryMod.o ${FATES_SRC}/ # The Generic (parent) PARTEH module gfortran $F_OPTS $MOD_FLAG bld/ -I bld/ -o bld/PRTGenericMod.o ${FATES_SRC}/parteh/PRTGenericMod.F90 +# Loss Fluxes and phenology +gfortran $F_OPTS $MOD_FLAG bld/ -I bld/ -o bld/PRTLossFluxesMod.o ${FATES_SRC}/parteh/PRTLossFluxesMod.F90 + # The carbon-only PARTEH module gfortran $F_OPTS $MOD_FLAG bld/ -I bld/ -o bld/PRTAllometricCarbonMod.o ${FATES_SRC}/parteh/PRTAllometricCarbonMod.F90 diff --git a/functional_unit_testing/parteh/f_wrapper_modules/FatesCohortWrapMod.F90 b/functional_unit_testing/parteh/f_wrapper_modules/FatesCohortWrapMod.F90 index 1bcb5acee5..92afc78214 100644 --- a/functional_unit_testing/parteh/f_wrapper_modules/FatesCohortWrapMod.F90 +++ b/functional_unit_testing/parteh/f_wrapper_modules/FatesCohortWrapMod.F90 @@ -44,6 +44,8 @@ module FatesCohortWrapMod use PRTAllometricCarbonMod, only : ac_bc_in_id_ctrim use PRTAllometricCarbonMod, only : ac_bc_inout_id_dbh + use PRTLossFluxesMod, only : PRTMaintTurnover + ! use PRTAllometricCNPMod, only : cnp_allom_prt_vartypes ! use PRTAllometricCNPMod, only : acnp_bc_inout_id_dbh ! use PRTAllometricCNPMod, only : acnp_bc_inout_id_netdc @@ -347,6 +349,7 @@ subroutine WrapDailyPRT(ipft,daily_carbon_gain,daily_nitrogen_gain, & call ccohort%prt%ZeroRates() + call PRTMaintTurnover(ccohort%prt, ipft) select case(int(ccohort%parteh_model)) case (1) diff --git a/functional_unit_testing/parteh/f_wrapper_modules/FatesPFTWrapMod.F90 b/functional_unit_testing/parteh/f_wrapper_modules/FatesPFTWrapMod.F90 index adf122bb18..0a46a97d10 100644 --- a/functional_unit_testing/parteh/f_wrapper_modules/FatesPFTWrapMod.F90 +++ b/functional_unit_testing/parteh/f_wrapper_modules/FatesPFTWrapMod.F90 @@ -89,17 +89,19 @@ module EDPftvarcon ! Hypothesis 1: Unused [na] - real(r8), pointer :: parteh_unit_gr_resp(:,:) - real(r8), pointer :: parteh_n_stoich_p1(:,:) - real(r8), pointer :: parteh_n_stoich_p2(:,:) - real(r8), pointer :: parteh_p_stoich_p1(:,:) - real(r8), pointer :: parteh_p_stoich_p2(:,:) - real(r8), pointer :: parteh_c_alloc_priority(:,:) + real(r8), pointer :: prt_unit_gr_resp(:,:) + real(r8), pointer :: prt_nitr_stoich_p1(:,:) + real(r8), pointer :: prt_nitr_stoich_p2(:,:) + real(r8), pointer :: prt_phos_stoich_p1(:,:) + real(r8), pointer :: prt_phos_stoich_p2(:,:) + real(r8), pointer :: prt_alloc_priority(:,:) ! THese are new, but not necessarily PARTEH labeled real(r8), pointer :: turnover_retrans_mode(:) - real(r8), pointer :: turnover_n_retrans_p1(:,:) - real(r8), pointer :: turnover_p_retrans_p1(:,:) + + real(r8), pointer :: turnover_carb_retrans_p1(:,:) + real(r8), pointer :: turnover_nitr_retrans_p1(:,:) + real(r8), pointer :: turnover_phos_retrans_p1(:,:) end type EDPftvarcon_inst_type @@ -493,46 +495,46 @@ subroutine EDPftvarconAlloc(numpft_in, numorgans_in) EDPftvarcon_ptr%var(iv)%rp_1d => EDPftvarcon_inst%rootb_par - allocate( EDPftvarcon_inst%parteh_n_stoich_p1(1:num_pft,1:num_organs)); - EDPftvarcon_inst%parteh_n_stoich_p1(:,:) = nan + allocate( EDPftvarcon_inst%prt_nitr_stoich_p1(1:num_pft,1:num_organs)); + EDPftvarcon_inst%prt_nitr_stoich_p1(:,:) = nan iv = iv + 1 - EDPftvarcon_ptr%var(iv)%var_name = "fates_parteh_n_stoich_p1" - EDPftvarcon_ptr%var(iv)%rp_2d => EDPftvarcon_inst%parteh_n_stoich_p1 + EDPftvarcon_ptr%var(iv)%var_name = "fates_prt_nitr_stoich_p1" + EDPftvarcon_ptr%var(iv)%rp_2d => EDPftvarcon_inst%prt_nitr_stoich_p1 - allocate( EDPftvarcon_inst%parteh_p_stoich_p1(1:num_pft,1:num_organs)); - EDPftvarcon_inst%parteh_p_stoich_p1(:,:) = nan + allocate( EDPftvarcon_inst%prt_phos_stoich_p1(1:num_pft,1:num_organs)); + EDPftvarcon_inst%prt_phos_stoich_p1(:,:) = nan iv = iv + 1 - EDPftvarcon_ptr%var(iv)%var_name = "fates_parteh_p_stoich_p1" - EDPftvarcon_ptr%var(iv)%rp_2d => EDPftvarcon_inst%parteh_p_stoich_p1 + EDPftvarcon_ptr%var(iv)%var_name = "fates_prt_phos_stoich_p1" + EDPftvarcon_ptr%var(iv)%rp_2d => EDPftvarcon_inst%prt_phos_stoich_p1 - allocate( EDPftvarcon_inst%parteh_n_stoich_p2(1:num_pft,1:num_organs)); - EDPftvarcon_inst%parteh_n_stoich_p2(:,:) = nan + allocate( EDPftvarcon_inst%prt_nitr_stoich_p2(1:num_pft,1:num_organs)); + EDPftvarcon_inst%prt_nitr_stoich_p2(:,:) = nan iv = iv + 1 - EDPftvarcon_ptr%var(iv)%var_name = "fates_parteh_n_stoich_p2" - EDPftvarcon_ptr%var(iv)%rp_2d => EDPftvarcon_inst%parteh_n_stoich_p2 + EDPftvarcon_ptr%var(iv)%var_name = "fates_prt_nitr_stoich_p2" + EDPftvarcon_ptr%var(iv)%rp_2d => EDPftvarcon_inst%prt_nitr_stoich_p2 - allocate( EDPftvarcon_inst%parteh_p_stoich_p2(1:num_pft,1:num_organs)); - EDPftvarcon_inst%parteh_p_stoich_p2(:,:) = nan + allocate( EDPftvarcon_inst%prt_phos_stoich_p2(1:num_pft,1:num_organs)); + EDPftvarcon_inst%prt_phos_stoich_p2(:,:) = nan iv = iv + 1 - EDPftvarcon_ptr%var(iv)%var_name = "fates_parteh_p_stoich_p2" - EDPftvarcon_ptr%var(iv)%rp_2d => EDPftvarcon_inst%parteh_p_stoich_p2 + EDPftvarcon_ptr%var(iv)%var_name = "fates_prt_phos_stoich_p2" + EDPftvarcon_ptr%var(iv)%rp_2d => EDPftvarcon_inst%prt_phos_stoich_p2 - allocate( EDPftvarcon_inst%parteh_unit_gr_resp(1:num_pft,1:num_organs)); - EDPftvarcon_inst%parteh_unit_gr_resp(:,:) = nan + allocate( EDPftvarcon_inst%prt_unit_gr_resp(1:num_pft,1:num_organs)); + EDPftvarcon_inst%prt_unit_gr_resp(:,:) = nan iv = iv + 1 - EDPftvarcon_ptr%var(iv)%var_name = "fates_parteh_unit_gr_resp" - EDPftvarcon_ptr%var(iv)%rp_2d => EDPftvarcon_inst%parteh_unit_gr_resp + EDPftvarcon_ptr%var(iv)%var_name = "fates_prt_unit_gr_resp" + EDPftvarcon_ptr%var(iv)%rp_2d => EDPftvarcon_inst%prt_unit_gr_resp - allocate( EDPftvarcon_inst%parteh_c_alloc_priority(1:num_pft,1:num_organs)); - EDPftvarcon_inst%parteh_c_alloc_priority(:,:) = nan + allocate( EDPftvarcon_inst%prt_alloc_priority(1:num_pft,1:num_organs)); + EDPftvarcon_inst%prt_alloc_priority(:,:) = nan iv = iv + 1 - EDPftvarcon_ptr%var(iv)%var_name = "fates_parteh_c_alloc_priority" - EDPftvarcon_ptr%var(iv)%rp_2d => EDPftvarcon_inst%parteh_c_alloc_priority + EDPftvarcon_ptr%var(iv)%var_name = "fates_prt_alloc_priority" + EDPftvarcon_ptr%var(iv)%rp_2d => EDPftvarcon_inst%prt_alloc_priority allocate( EDPftvarcon_inst%turnover_retrans_mode(1:num_pft) ) EDPftvarcon_inst%turnover_retrans_mode(:) = nan @@ -540,17 +542,23 @@ subroutine EDPftvarconAlloc(numpft_in, numorgans_in) EDPftvarcon_ptr%var(iv)%var_name = "fates_turnover_retrans_mode" EDPftvarcon_ptr%var(iv)%rp_1d => EDPftvarcon_inst%turnover_retrans_mode - allocate( EDPftvarcon_inst%turnover_n_retrans_p1(1:num_pft,1:num_organs) ) - EDPftvarcon_inst%turnover_n_retrans_p1(:,:) = nan + allocate( EDPftvarcon_inst%turnover_carb_retrans_p1(1:num_pft,1:num_organs) ) + EDPftvarcon_inst%turnover_carb_retrans_p1(:,:) = nan + iv = iv + 1 + EDPftvarcon_ptr%var(iv)%var_name = "fates_turnover_carb_retrans_p1" + EDPftvarcon_ptr%var(iv)%rp_2d => EDPftvarcon_inst%turnover_carb_retrans_p1 + + allocate( EDPftvarcon_inst%turnover_nitr_retrans_p1(1:num_pft,1:num_organs) ) + EDPftvarcon_inst%turnover_nitr_retrans_p1(:,:) = nan iv = iv + 1 - EDPftvarcon_ptr%var(iv)%var_name = "fates_turnover_n_retrans_p1" - EDPftvarcon_ptr%var(iv)%rp_2d => EDPftvarcon_inst%turnover_n_retrans_p1 + EDPftvarcon_ptr%var(iv)%var_name = "fates_turnover_nitr_retrans_p1" + EDPftvarcon_ptr%var(iv)%rp_2d => EDPftvarcon_inst%turnover_nitr_retrans_p1 - allocate( EDPftvarcon_inst%turnover_p_retrans_p1(1:num_pft,1:num_organs) ) - EDPftvarcon_inst%turnover_p_retrans_p1(:,:) = nan + allocate( EDPftvarcon_inst%turnover_phos_retrans_p1(1:num_pft,1:num_organs) ) + EDPftvarcon_inst%turnover_phos_retrans_p1(:,:) = nan iv = iv + 1 - EDPftvarcon_ptr%var(iv)%var_name = "fates_turnover_p_retrans_p1" - EDPftvarcon_ptr%var(iv)%rp_2d => EDPftvarcon_inst%turnover_p_retrans_p1 + EDPftvarcon_ptr%var(iv)%var_name = "fates_turnover_phos_retrans_p1" + EDPftvarcon_ptr%var(iv)%rp_2d => EDPftvarcon_inst%turnover_phos_retrans_p1 ! We should gracefully fail if rootprof_beta is requested diff --git a/functional_unit_testing/parteh/parteh_controls_defaults.xml b/functional_unit_testing/parteh/parteh_controls_defaults.xml index 46b3429c50..3b2a71b276 100644 --- a/functional_unit_testing/parteh/parteh_controls_defaults.xml +++ b/functional_unit_testing/parteh/parteh_controls_defaults.xml @@ -99,13 +99,13 @@ 1,1 - -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9 - -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9 - -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9 - -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9 - -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9 - -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9 - + -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9 + -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9 + -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9 + -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9 + -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9 + -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9 + -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9 diff --git a/functional_unit_testing/parteh/parteh_controls_smoketests.xml b/functional_unit_testing/parteh/parteh_controls_smoketests.xml index 895511e0de..04940b489e 100644 --- a/functional_unit_testing/parteh/parteh_controls_smoketests.xml +++ b/functional_unit_testing/parteh/parteh_controls_smoketests.xml @@ -100,32 +100,41 @@ 0.5 , 0.5 ,0.5, 0.5 ,0.5 50.0 , 50.0 , 50.0 , 50.0 , 50.0 - - - - 1,1,1,1,1 - -9,0,0.25,0.25,0.25 - -9,0,0.25,0.25,0.25 - -9,0,0.25,0.25,0.25 - -9,0,0.25,0.25,0.25 - - -9,-9,-9,-9,-9,-9, + 1,1,1,1,1 + + 0,0,0,0,0,0, + 0,0,0,0,0,0, + 0.05,0.05,0,0,0,0, + 0.05,0.05,0,0,0,0, + 0.05,0.05,0,0,0,0 + 0,0,0,0,0,0, + 0,0,0,0,0,0, + 0.25,0.15,0,0,0,0, + 0.25,0,0,0,0, + 0.25,0,0,0,0 + 0,0,0,0,0,0, + 0,0,0,0,0,0, + 0.25,0.15,0,0,0,0, + 0.25,0,0,0,0, + 0.25,0,0,0,0 + + -9,-9,-9,-9,-9,-9, 0.05,0.05,0.05,0.05,0.05,0.05, 0,0,0,0,0,0, 0.05,0.05,0.05,0.05,0.05,0.05, 0.05,0.05,0.05,0.05,0.05,0.05 - -9,-9,-9,-9,-9,-9, + -9,-9,-9,-9,-9,-9, 0.05,0.05,0.05,0.05,0.05,0.05, 0,0,0,0,0,0, 0.05,0.05,0.05,0.05,0.05,0.05, 0.05,0.05,0.05,0.05,0.05,0.05 - -9,-9,-9,-9,-9,-9, + -9,-9,-9,-9,-9,-9, 0.05,0.05,0.05,0.05,0.05,0.05, 0,0,0,0,0,0, 0.05,0.05,0.05,0.05,0.05,0.05, 0.05,0.05,0.05,0.05,0.05,0.05 - -9,-9,-9,-9,-9,-9, + -9,-9,-9,-9,-9,-9, 0.05,0.05,0.05,0.05,0.05,0.05, 0,0,0,0,0,0, 0.05,0.05,0.05,0.05,0.05,0.05, diff --git a/functional_unit_testing/parteh/parteh_controls_variable_netc.xml b/functional_unit_testing/parteh/parteh_controls_variable_netc.xml index f31ad26bf6..82a6479b58 100644 --- a/functional_unit_testing/parteh/parteh_controls_variable_netc.xml +++ b/functional_unit_testing/parteh/parteh_controls_variable_netc.xml @@ -99,17 +99,21 @@ 50.0 , 50.0 , 50.0 1,1,1 - -9,0.25, 0.25 - -9,0.25, 0.25 - -9,0.25, 0.25 - -9,0.25, 0.25 - - - 0,0,0,0,0,0,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05 - 0,0,0,0,0,0,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05 - - 0,0,0,0,0,0,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05 - 0,0,0,0,0,0,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05 + 0.05,0,0,0,0,0, + 0.05,0,0,0,0,0, + 0.05,0,0,0,0,0 + -9,0,0,0,0,0, + 0.25,0,0,0,0,0, + 0.25,0,0,0,0,0 + -9,0,0,0,0,0, + 0.25,0,0,0,0,0, + 0.25,0,0,0,0,0 + + 0,0,0,0,0,0,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05 + 0,0,0,0,0,0,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05 + + 0,0,0,0,0,0,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05 + 0,0,0,0,0,0,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05 1,1,2,2,0,3,1,1,2,2,0,3,1,1,2,2,0,3 diff --git a/parteh/PRTAllometricCarbonMod.F90 b/parteh/PRTAllometricCarbonMod.F90 index 6369613540..b6efdd3872 100644 --- a/parteh/PRTAllometricCarbonMod.F90 +++ b/parteh/PRTAllometricCarbonMod.F90 @@ -216,7 +216,8 @@ subroutine InitAllocateAC(this) allocate(this%variables(ivar)%val(icd)) allocate(this%variables(ivar)%val0(icd)) allocate(this%variables(ivar)%turnover(icd)) - allocate(this%variables(ivar)%dvaldt(icd)) + allocate(this%variables(ivar)%net_art(icd)) + allocate(this%variables(ivar)%burned(icd)) end do @@ -286,6 +287,14 @@ subroutine DailyPRTAC(this) real(r8) :: repro_c_flux real(r8) :: struct_c_flux + real(r8) :: leaf_c0 ! Initial value of carbon used to determine net flux + real(r8) :: fnrt_c0 ! during this routine + real(r8) :: sapw_c0 + real(r8) :: store_c0 + real(r8) :: repro_c0 + real(r8) :: struct_c0 + + logical :: grow_leaf ! Are leaves at allometric target and should be grown? logical :: grow_fnrt ! Are fine-roots at allometric target and should be grown? logical :: grow_sapw ! Is sapwood at allometric target and should be grown? @@ -376,8 +385,6 @@ subroutine DailyPRTAC(this) ! Target total dead (structrual) biomass and deriv. [kgC, kgC/cm] call bdead_allom( target_agw_c, target_bgw_c, target_sapw_c, ipft, target_struct_c) - - ! ------------------------------------------------------------------------------------ ! If structure is larger than target, then we need to correct some integration errors @@ -415,20 +422,12 @@ subroutine DailyPRTAC(this) call bstore_allom(dbh,ipft,canopy_trim,target_store_c) - ! ----------------------------------------------------------------------------------- - ! Set memory of the old state variables for comparison - ! ----------------------------------------------------------------------------------- - - do i_var = 1,ac_num_vars - this%variables(i_var)%val0(icd) = this%variables(i_var)%val(icd) - end do - - ! ----------------------------------------------------------------------------------- - ! II. Call maintenance turnover - ! This will increment %turnover and decrease %val - ! ---------------------------------------------------------------------------------- - - call PRTMaintTurnover(this,ipft) + leaf_c0 = leaf_c + fnrt_c0 = fnrt_c + sapw_c0 = sapw_c + store_c0 = store_c + repro_c0 = repro_c + struct_c0 = struct_c ! ----------------------------------------------------------------------------------- ! III. Prioritize some amount of carbon to replace leaf/root turnover @@ -742,6 +741,27 @@ subroutine DailyPRTAC(this) end do end if + ! Track the net allocations and transport from this routine + + this%variables(leaf_c_id)%net_art(icd) = & + this%variables(leaf_c_id)%net_art(icd) + (leaf_c - leaf_c0) + + this%variables(fnrt_c_id)%net_art(icd) = & + this%variables(fnrt_c_id)%net_art(icd) + (fnrt_c - fnrt_c0) + + this%variables(sapw_c_id)%net_art(icd) = & + this%variables(sapw_c_id)%net_art(icd) + (sapw_c - sapw_c0) + + this%variables(store_c_id)%net_art(icd) = & + this%variables(store_c_id)%net_art(icd) + (store_c - store_c0) + + this%variables(repro_c_id)%net_art(icd) = & + this%variables(repro_c_id)%net_art(icd) + (repro_c - repro_c0) + + this%variables(struct_c_id)%net_art(icd) = & + this%variables(struct_c_id)%net_art(icd) + (struct_c - struct_c0) + + end associate return diff --git a/parteh/PRTGenericMod.F90 b/parteh/PRTGenericMod.F90 index 0cc29fd1b6..87bf8e6e0b 100644 --- a/parteh/PRTGenericMod.F90 +++ b/parteh/PRTGenericMod.F90 @@ -24,6 +24,7 @@ module PRTGenericMod use FatesConstantsMod, only : r8 => fates_r8 use FatesConstantsMod, only : i4 => fates_int use FatesConstantsMod, only : nearzero + use FatesConstantsMod, only : calloc_abs_error use FatesGlobals , only : endrun => fates_endrun use FatesGlobals , only : fates_log @@ -223,9 +224,7 @@ module PRTGenericMod procedure, non_overridable :: GetState procedure, non_overridable :: GetTurnover procedure, non_overridable :: ZeroRates - - procedure, non_overridable :: MaintTurnover - procedure, non_overridable :: MaintTurnoverSimpleRetranslocation + procedure, non_overridable :: CheckMassConservation end type prt_vartypes @@ -279,7 +278,7 @@ module PRTGenericMod ! per each organ. type organ_map_type - integer, dimension(1,num_species_types) :: var_id + integer, dimension(1:num_species_types) :: var_id integer :: num_vars end type organ_map_type @@ -387,8 +386,8 @@ subroutine InitializeInitialConditions(this) class(prt_vartypes) :: this - integer :: num_vars - integer :: i_var + integer :: num_vars ! Number of variables + integer :: i_var ! Variable index num_vars = size(this%variables,1) @@ -658,7 +657,6 @@ subroutine DeallocatePRTVartypes(this) ! Check to see if there is any value in these pools? ! SHould not deallocate if there is any carbon left - n_vars = size(this%variables,1) do i_var = 1, n_vars @@ -666,6 +664,7 @@ subroutine DeallocatePRTVartypes(this) deallocate(this%variables(i_var)%val0) deallocate(this%variables(i_var)%net_art) deallocate(this%variables(i_var)%turnover) + deallocate(this%variables(i_var)%burned) end do deallocate(this%variables) @@ -747,15 +746,15 @@ subroutine ZeroRates(this) class(prt_vartypes) :: this - integer :: n_vars - integer :: ivar + integer :: n_vars ! Number of variables + integer :: i_var ! Variable index n_vars = size(this%variables,1) - do ivar = 1,n_vars - this%variables(ivar)%val0(:) = this%variables(ivar)%val(:) - this%variables(ivar)%net_art(:) = 0.0_r8 - this%variables(ivar)%turnover(:) = 0.0_r8 - this%variables(ivar)%burned(:) = 0.0_r8 + do i_var = 1,n_vars + this%variables(i_var)%val0(:) = this%variables(i_var)%val(:) + this%variables(i_var)%net_art(:) = 0.0_r8 + this%variables(i_var)%turnover(:) = 0.0_r8 + this%variables(i_var)%burned(:) = 0.0_r8 end do end subroutine ZeroRates @@ -766,21 +765,22 @@ subroutine CheckMassConservation(this) class(prt_vartypes) :: this - integer :: n_vars - integer :: ivar + integer :: n_vars ! Number of variables + integer :: i_var ! Variable index + integer :: i_pos ! Position (coordinate) index real(r8) :: err n_vars = size(this%variables,1) - do ivar = 1,n_vars - - do pos_id = 1, this%variables(ivar)%num_pos + do i_var = 1,n_vars + + do i_pos = 1, this%variables(i_var)%num_pos - err = (this%variables(ivar)%val(pos_id) - this%variables(ivar)%val0(pos_id)) - & - (this%variables(ivar)%net_art(pos_id) & - -this%variables(ivar)%turnover(pos_id) & - -this%variables(ivar)%burned(pos_id) ) + err = (this%variables(i_var)%val(i_pos) - this%variables(i_var)%val0(i_pos)) - & + (this%variables(i_var)%net_art(i_pos) & + -this%variables(i_var)%turnover(i_pos) & + -this%variables(i_var)%burned(i_pos) ) if( abs(err) > calloc_abs_error ) then write(fates_log(),*) 'PARTEH mass conservation check failed' @@ -788,18 +788,19 @@ subroutine CheckMassConservation(this) write(fates_log(),*) ' always equal the integrated fluxes.' write(fates_log(),*) ' organ id: ',this%prt_instance%state_descriptor(i_var)%organ_id write(fates_log(),*) ' species_id: ',this%prt_instance%state_descriptor(i_var)%spec_id - write(fates_log(),*) ' position id: ',pos_id + write(fates_log(),*) ' position id: ',i_pos write(fates_log(),*) ' symbol: ',trim(this%prt_instance%state_descriptor(i_var)%symbol) write(fates_log(),*) ' longname: ',trim(this%prt_instance%state_descriptor(i_var)%longname) write(fates_log(),*) ' err: ',err,' max error: ',calloc_abs_error - write(fates_log(),*) ' terms: ', this%variables(ivar)%val(pos_id), & - this%variables(ivar)%val0(pos_id), & - this%variables(ivar)%net_art(pos_id), & - this%variables(ivar)%turnover(pos_id) + write(fates_log(),*) ' terms: ', this%variables(i_var)%val(i_pos), & + this%variables(i_var)%val0(i_pos), & + this%variables(i_var)%net_art(i_pos), & + this%variables(i_var)%turnover(i_pos) write(fates_log(),*) ' Exiting.' call endrun(msg=errMsg(__FILE__, __LINE__)) end if + end do end do return @@ -809,9 +810,11 @@ end subroutine CheckMassConservation function GetState(this, organ_id, species_id, position_id) result(sp_organ_val) - - ! THIS CODE IS VERY INEFFICIENT RIGHT NOW - + ! This function returns the current amount of mass for + ! any combination of organ and species. If a position + ! is provided, it will us it, but otherwise, it will sum over + ! all dimensions. It also can accomodate all_carbon_species, which + ! will return the mass of all carbon isotopes combined. class(prt_vartypes) :: this integer,intent(in) :: organ_id @@ -819,11 +822,11 @@ function GetState(this, organ_id, species_id, position_id) result(sp_organ_val) integer,intent(in),optional :: position_id real(r8) :: sp_organ_val - integer :: pos_id + integer :: i_pos integer :: ispec integer :: num_species integer,dimension(max_spec_per_group) :: spec_ids - integer :: index + integer :: i_var sp_organ_val = 0.0_r8 @@ -836,22 +839,22 @@ function GetState(this, organ_id, species_id, position_id) result(sp_organ_val) end if if(present(position_id)) then - pos_id = position_id + i_pos = position_id do ispec = 1,num_species - index = this%prt_instance%sp_organ_map(organ_id,spec_ids(ispec)) - if(index>0) sp_organ_val = sp_organ_val + this%variables(index)%val(pos_id) + i_var = this%prt_instance%sp_organ_map(organ_id,spec_ids(ispec)) + if(i_var>0) sp_organ_val = sp_organ_val + this%variables(i_var)%val(i_pos) end do else do ispec = 1,num_species - index = this%prt_instance%sp_organ_map(organ_id,spec_ids(ispec)) - if(index>0)then + i_var = this%prt_instance%sp_organ_map(organ_id,spec_ids(ispec)) + if(i_var>0)then - do pos_id = 1, this%variables(index)%num_pos - sp_organ_val = sp_organ_val + this%variables(index)%val(pos_id) + do i_pos = 1, this%variables(i_var)%num_pos + sp_organ_val = sp_organ_val + this%variables(i_var)%val(i_pos) end do end if @@ -869,7 +872,8 @@ end function GetState function GetTurnover(this, organ_id, species_id, position_id) result(sp_organ_turnover) - ! THIS CODE IS VERY INEFFICIENT RIGHT NOW + ! THis function is very similar to GetState, with the only difference that it + ! returns the turnover mass so-far during the period of interest. class(prt_vartypes) :: this @@ -878,11 +882,11 @@ function GetTurnover(this, organ_id, species_id, position_id) result(sp_organ_tu integer,intent(in),optional :: position_id real(r8) :: sp_organ_turnover - integer :: pos_id + integer :: i_pos integer :: ispec integer :: num_species integer,dimension(max_spec_per_group) :: spec_ids - integer :: index + integer :: i_var sp_organ_turnover = 0.0_r8 @@ -895,21 +899,21 @@ function GetTurnover(this, organ_id, species_id, position_id) result(sp_organ_tu end if if(present(position_id)) then - pos_id = position_id + i_pos = position_id do ispec = 1,num_species - index = this%prt_instance%sp_organ_map(organ_id,spec_ids(ispec)) - if(index>0) sp_organ_turnover = sp_organ_turnover + & - this%variables(index)%turnover(pos_id) + i_var = this%prt_instance%sp_organ_map(organ_id,spec_ids(ispec)) + if(i_var>0) sp_organ_turnover = sp_organ_turnover + & + this%variables(i_var)%turnover(i_pos) end do else do ispec = 1,num_species - index = this%prt_instance%sp_organ_map(organ_id,spec_ids(ispec)) - if(index>0) then - do pos_id = 1, this%variables(index)%num_pos - sp_organ_turnover = sp_organ_turnover + this%variables(index)%turnover(pos_id) + i_var = this%prt_instance%sp_organ_map(organ_id,spec_ids(ispec)) + if(i_var>0) then + do i_pos = 1, this%variables(i_var)%num_pos + sp_organ_turnover = sp_organ_turnover + this%variables(i_var)%turnover(i_pos) end do end if @@ -923,7 +927,9 @@ end function GetTurnover ! ========================================================================= function GetBurned(this, organ_id, species_id, position_id) result(sp_organ_burned) - + + ! THis function is very similar to GetBurned, with the only difference that it + ! returns the turnover mass so-far during the period of interest. class(prt_vartypes) :: this integer,intent(in) :: organ_id @@ -931,11 +937,11 @@ function GetBurned(this, organ_id, species_id, position_id) result(sp_organ_burn integer,intent(in),optional :: position_id real(r8) :: sp_organ_burned - integer :: pos_id + integer :: i_pos integer :: ispec integer :: num_species integer,dimension(max_spec_per_group) :: spec_ids - integer :: index + integer :: i_var sp_organ_burned = 0.0_r8 @@ -948,21 +954,21 @@ function GetBurned(this, organ_id, species_id, position_id) result(sp_organ_burn end if if(present(position_id)) then - pos_id = position_id + i_pos = position_id do ispec = 1,num_species - index = this%prt_instance%sp_organ_map(organ_id,spec_ids(ispec)) - if(index>0) sp_organ_burned = sp_organ_burned + & - this%variables(index)%burned(pos_id) + i_var = this%prt_instance%sp_organ_map(organ_id,spec_ids(ispec)) + if(i_var>0) sp_organ_burned = sp_organ_burned + & + this%variables(i_var)%burned(i_pos) end do else do ispec = 1,num_species - index = this%prt_instance%sp_organ_map(organ_id,spec_ids(ispec)) - if(index>0) then - do pos_id = 1, this%variables(index)%num_pos - sp_organ_burned = sp_organ_burned + this%variables(index)%burned(pos_id) + i_var = this%prt_instance%sp_organ_map(organ_id,spec_ids(ispec)) + if(i_var>0) then + do i_pos = 1, this%variables(i_var)%num_pos + sp_organ_burned = sp_organ_burned + this%variables(i_var)%burned(i_pos) end do end if @@ -1038,9 +1044,8 @@ subroutine SetState(prt,organ_id, species_id, state_val, position_id) integer :: ispec integer :: n_vars integer,dimension(max_spec_per_group) :: spec_ids - integer :: ivar - integer :: index - integer :: pos_id + integer :: i_var + integer :: i_pos if(species_id == all_carbon_species) then write(fates_log(),*) 'You cannot set the state of all isotopes simultaneously.' @@ -1049,25 +1054,25 @@ subroutine SetState(prt,organ_id, species_id, state_val, position_id) end if if( present(position_id) ) then - pos_id = position_id + i_pos = position_id else - pos_id = 1 + i_pos = 1 end if - index = prt%prt_instance%sp_organ_map(organ_id,species_id) + i_var = prt%prt_instance%sp_organ_map(organ_id,species_id) - if(pos_id>prt%variables(index)%num_pos)then + if(i_pos>prt%variables(i_var)%num_pos)then write(fates_log(),*) 'A position index was specified that is' write(fates_log(),*) 'greater than the allocated position space' - write(fates_log(),*) ' pos_id: ',pos_id - write(fates_log(),*) ' num_pos: ',prt%variables(index)%num_pos + write(fates_log(),*) ' i_pos: ',i_pos + write(fates_log(),*) ' num_pos: ',prt%variables(i_var)%num_pos call endrun(msg=errMsg(__FILE__, __LINE__)) end if - if(index>0) then - prt%variables(index)%val(pos_id) = state_val + if(i_var>0) then + prt%variables(i_var)%val(i_pos) = state_val else write(fates_log(),*) 'A mass was sent to PARTEH to over-write' write(fates_log(),*) ' a pool with a specie x organ combination. ' diff --git a/parteh/PRTLossFluxesMod.F90 b/parteh/PRTLossFluxesMod.F90 index be4f39af37..79bc1df658 100644 --- a/parteh/PRTLossFluxesMod.F90 +++ b/parteh/PRTLossFluxesMod.F90 @@ -1,21 +1,28 @@ module PRTLossFluxesMod use EDPftvarcon, only : EDPftvarcon_inst - use PRTGeneric, only : prt_vartypes - use PRTGeneric, only : leaf_organ - use PRTGeneric, only : fnrt_organ - use PRTGeneric, only : sapw_organ - use PRTGeneric, only : store_organ - use PRTGeneric, only : repro_organ - use PRTGeneric, only : truct_organ - use PRTGeneric, only : all_carbon_species - use PRTGeneric, only : carbon12_species - use PRTGeneric, only : nitrogen_species - use PRTGeneric, only : phosphorous_species + 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 : repro_organ + use PRTGenericMod, only : struct_organ + use PRTGenericMod, only : all_carbon_species + use PRTGenericMod, only : carbon_species ! This is a vector + use PRTGenericMod, only : carbon12_species + use PRTGenericMod, only : nitrogen_species + use PRTGenericMod, only : phosphorous_species use FatesInterfaceMod, only : hlm_freq_day - ! These public flags specify what kind of event based - ! turnover is happening + use FatesConstantsMod, only : r8 => fates_r8 + use FatesConstantsMod, only : i4 => fates_int + use FatesConstantsMod, only : nearzero + use FatesConstantsMod, only : calloc_abs_error + use FatesGlobals , only : endrun => fates_endrun + use FatesGlobals , only : fates_log + use shr_log_mod , only : errMsg => shr_log_errMsg + implicit none private @@ -67,12 +74,13 @@ subroutine PRTPhenologyFlush(prt, ipft, organ_id, c_store_transfer_frac) ! transferred from storage integer :: i_var ! variable index + integer :: i_sp_var ! index for all species in + ! a given organ integer :: i_cvar ! carbon variable index integer :: i_pos ! spatial position index integer :: i_store ! storage variable index integer :: spec_id ! global species identifier integer :: num_sp_vars ! number of species for this organ - integer :: i_store ! variable index of storage real(r8) :: mass_transfer ! The actual mass ! removed from storage ! for each pool @@ -83,10 +91,7 @@ subroutine PRTPhenologyFlush(prt, ipft, organ_id, c_store_transfer_frac) associate(organ_map => prt%prt_instance%organ_map) - ! This is the total number of state variables associated - ! with this particular organ (ie carbon, nitrogen, phosphorous, ...) - num_sp_vars = organ_map(organ_id)%num_vars ! First transfer in carbon @@ -126,7 +131,11 @@ subroutine PRTPhenologyFlush(prt, ipft, organ_id, c_store_transfer_frac) ! Transfer in other species ! -------------------------------------------------------------------------------- - do i_sp_var = 1, num_sp_vars + ! This is the total number of state variables associated + ! with this particular organ (ie carbon, nitrogen, phosphorous, ...) + + + do i_sp_var = 1, organ_map(organ_id)%num_vars i_var = organ_map(organ_id)%var_id(i_sp_var) @@ -212,7 +221,7 @@ subroutine PRTBurnLosses(prt, organ_id, mass_fraction) integer :: i_pos ! position index integer :: i_var ! index for the variable of interest integer :: i_sp_var ! loop counter for all species in this organ - integer :: num_sp_var ! Loop size for iterating over all species + integer :: num_sp_vars ! Loop size for iterating over all species integer :: spec_id ! Species id of the turnover pool real(r8) :: burned_mass ! Burned mass of each species, in eahc ! position, in the organ of interest @@ -281,7 +290,7 @@ end subroutine PRTDeciduousTurnover ! ==================================================================================== - subroutine DeciduousTurnoverSimpleRetranslocation(pft,ipft,organ_id,mass_fraction) + subroutine DeciduousTurnoverSimpleRetranslocation(prt,ipft,organ_id,mass_fraction) ! --------------------------------------------------------------------------------- ! Calculate losses due to deciduous turnover. @@ -302,8 +311,8 @@ subroutine DeciduousTurnoverSimpleRetranslocation(pft,ipft,organ_id,mass_fractio integer :: i_var ! index for the variable of interest integer :: i_sp_var ! loop counter for all species in this organ - integer :: num_sp_var ! Loop size for iterating over all species - ! in the organ that is turning over + integer :: num_sp_vars ! Loop size for iterating over all species + ! in the organ that is turning over integer :: spec_id ! Species id of the turnover pool integer :: store_var_id ! Variable id of the storage pool integer :: i_pos ! position index (spatial) From 22b62f8a8870f4dcff05ce5fbb2be91e53b55a49 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Wed, 26 Sep 2018 11:57:50 -0700 Subject: [PATCH 14/52] Updated functional unit test build script to include external CNP module --- functional_unit_testing/parteh/build_fortran_objects.sh | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/functional_unit_testing/parteh/build_fortran_objects.sh b/functional_unit_testing/parteh/build_fortran_objects.sh index 7f8c4e3fd3..544fec9bbd 100755 --- a/functional_unit_testing/parteh/build_fortran_objects.sh +++ b/functional_unit_testing/parteh/build_fortran_objects.sh @@ -4,6 +4,8 @@ FATES_SRC=../../ +CNP_SRC=/home/rgknox/SyncLRC/PARTEH/FModules/ + F_OPTS="-shared -fPIC -g -ffpe-trap=zero,overflow,underflow -fbacktrace -fbounds-check" MOD_FLAG="-J" @@ -35,7 +37,7 @@ gfortran $F_OPTS $MOD_FLAG bld/ -I bld/ -o bld/PRTLossFluxesMod.o ${FATES_SRC}/p gfortran $F_OPTS $MOD_FLAG bld/ -I bld/ -o bld/PRTAllometricCarbonMod.o ${FATES_SRC}/parteh/PRTAllometricCarbonMod.F90 # The CNP allometric target model -#gfortran $F_OPTS $MOD_FLAG bld/ -I bld/ -o FModules/PRTAllometricCNPMod.o FModules/PRTAllometricCNPMod.F90 +gfortran $F_OPTS $MOD_FLAG bld/ -I bld/ -o bld/PRTAllometricCNPMod.o ${CNP_SRC}/PRTAllometricCNPMod.F90 # Initialize PARTEH instance and mapping functions gfortran $F_OPTS $MOD_FLAG bld/ -I bld/ bld/PRTGenericMod.o bld/PRTAllometricCarbonMod.o -o bld/FatesPARTEHWrapMod.o f_wrapper_modules/FatesPARTEHWrapMod.F90 From 9a3494522844cf678a86e818b2a9490b52d32606 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Wed, 26 Sep 2018 13:10:44 -0700 Subject: [PATCH 15/52] Bug fixes to maintenance losses, fixes/updates to the unit test to use the CNP hypothesis (external). --- .../parteh/PartehDriver.py | 16 ++- .../f_wrapper_modules/FatesCohortWrapMod.F90 | 130 +++++++++--------- .../f_wrapper_modules/FatesPARTEHWrapMod.F90 | 4 +- .../f_wrapper_modules/FatesPFTWrapMod.F90 | 34 ++--- .../parteh/parteh_controls_defaults.xml | 14 +- .../parteh/parteh_controls_smoketests.xml | 12 +- .../parteh/parteh_controls_variable_netc.xml | 12 +- parteh/PRTAllometricCarbonMod.F90 | 17 +-- parteh/PRTGenericMod.F90 | 20 ++- parteh/PRTLossFluxesMod.F90 | 60 +++++--- 10 files changed, 170 insertions(+), 149 deletions(-) diff --git a/functional_unit_testing/parteh/PartehDriver.py b/functional_unit_testing/parteh/PartehDriver.py index 2a96925782..bc9c9c28e4 100644 --- a/functional_unit_testing/parteh/PartehDriver.py +++ b/functional_unit_testing/parteh/PartehDriver.py @@ -48,10 +48,11 @@ f90_fates_wrap_obj_name = 'bld/FatesWrapMod.o' f90_fates_integrators_obj_name = 'bld/FatesIntegratorsMod.o' f90_fates_partehwrap_obj_name = 'bld/FatesPARTEHWrapMod.o' +f90_fates_lossfluxes_obj_name = 'bld/PRTLossFluxesMod.o' f90_fates_parteh_generic_obj_name = 'bld/PRTGenericMod.o' f90_fates_pftwrap_obj_name = 'bld/FatesPFTWrapMod.o' f90_fates_parteh_callom_obj_name = 'bld/PRTAllometricCarbonMod.o' -#f90_fates_parteh_cnpallom_obj_name = 'bld/PRTAllometricCNPMod.o' +f90_fates_parteh_cnpallom_obj_name = 'bld/PRTAllometricCNPMod.o' f90_fates_cohortwrap_obj_name = 'bld/FatesCohortWrapMod.o' f90_fates_allom_obj_name = 'bld/FatesAllometryMod.o' @@ -110,13 +111,14 @@ def main(argv): # Define the F90 objects # These must be loaded according to the module dependency order # Note that these calls instantiate the modules - f90_fates_wrap_obj = ctypes.CDLL(f90_fates_wrap_obj_name,mode=ctypes.RTLD_GLOBAL) - f90_fates_integrators_obj = ctypes.CDLL(f90_fates_integrators_obj_name,mode=ctypes.RTLD_GLOBAL) - f90_fates_pftwrap_obj = ctypes.CDLL(f90_fates_pftwrap_obj_name,mode=ctypes.RTLD_GLOBAL) + f90_fates_wrap_obj = ctypes.CDLL(f90_fates_wrap_obj_name,mode=ctypes.RTLD_GLOBAL) + f90_fates_integrators_obj = ctypes.CDLL(f90_fates_integrators_obj_name,mode=ctypes.RTLD_GLOBAL) + f90_fates_pftwrap_obj = ctypes.CDLL(f90_fates_pftwrap_obj_name,mode=ctypes.RTLD_GLOBAL) f90_fates_parteh_generic_obj = ctypes.CDLL(f90_fates_parteh_generic_obj_name,mode=ctypes.RTLD_GLOBAL) - f90_fates_allom_obj = ctypes.CDLL(f90_fates_allom_obj_name,mode=ctypes.RTLD_GLOBAL) - f90_fates_parteh_callom_obj = ctypes.CDLL(f90_fates_parteh_callom_obj_name,mode=ctypes.RTLD_GLOBAL) - #f90_fates_parteh_cnpallom_obj = ctypes.CDLL(f90_fates_parteh_cnpallom_obj_name,mode=ctypes.RTLD_GLOBAL) + f90_fates_allom_obj = ctypes.CDLL(f90_fates_allom_obj_name,mode=ctypes.RTLD_GLOBAL) + f90_fates_parteh_callom_obj = ctypes.CDLL(f90_fates_parteh_callom_obj_name,mode=ctypes.RTLD_GLOBAL) + f90_fates_lossfluxes_obj = ctypes.CDLL(f90_fates_lossfluxes_obj_name,mode=ctypes.RTLD_GLOBAL) + f90_fates_parteh_cnpallom_obj = ctypes.CDLL(f90_fates_parteh_cnpallom_obj_name,mode=ctypes.RTLD_GLOBAL) f90_fates_partehwrap_obj = ctypes.CDLL(f90_fates_partehwrap_obj_name,mode=ctypes.RTLD_GLOBAL) f90_fates_cohortwrap_obj = ctypes.CDLL(f90_fates_cohortwrap_obj_name,mode=ctypes.RTLD_GLOBAL) diff --git a/functional_unit_testing/parteh/f_wrapper_modules/FatesCohortWrapMod.F90 b/functional_unit_testing/parteh/f_wrapper_modules/FatesCohortWrapMod.F90 index 92afc78214..c5a6b81da9 100644 --- a/functional_unit_testing/parteh/f_wrapper_modules/FatesCohortWrapMod.F90 +++ b/functional_unit_testing/parteh/f_wrapper_modules/FatesCohortWrapMod.F90 @@ -46,20 +46,18 @@ module FatesCohortWrapMod use PRTLossFluxesMod, only : PRTMaintTurnover -! use PRTAllometricCNPMod, only : cnp_allom_prt_vartypes -! use PRTAllometricCNPMod, only : acnp_bc_inout_id_dbh -! use PRTAllometricCNPMod, only : acnp_bc_inout_id_netdc -! use PRTAllometricCNPMod, only : acnp_bc_inout_id_rmaint_def -! use PRTAllometricCNPMod, only : acnp_bc_inout_id_netdn -! use PRTAllometricCNPMod, only : acnp_bc_inout_id_netdp - -! use PRTAllometricCNPMod, only : acnp_bc_in_id_ctrim -! use PRTAllometricCNPMod, only : acnp_bc_in_id_pft - -! use PRTAllometricCNPMod, only : acnp_bc_out_id_rootcexude -! use PRTAllometricCNPMod, only : acnp_bc_out_id_rootnexude -! use PRTAllometricCNPMod, only : acnp_bc_out_id_rootpexude -! use PRTAllometricCNPMod, only : acnp_bc_out_id_growresp + use PRTAllometricCNPMod, only : cnp_allom_prt_vartypes + use PRTAllometricCNPMod, only : acnp_bc_inout_id_dbh + use PRTAllometricCNPMod, only : acnp_bc_inout_id_netdc + use PRTAllometricCNPMod, only : acnp_bc_inout_id_rmaint_def + use PRTAllometricCNPMod, only : acnp_bc_inout_id_netdn + use PRTAllometricCNPMod, only : acnp_bc_inout_id_netdp + use PRTAllometricCNPMod, only : acnp_bc_in_id_ctrim + use PRTAllometricCNPMod, only : acnp_bc_in_id_pft + use PRTAllometricCNPMod, only : acnp_bc_out_id_rootcexude + use PRTAllometricCNPMod, only : acnp_bc_out_id_rootnexude + use PRTAllometricCNPMod, only : acnp_bc_out_id_rootpexude + use PRTAllometricCNPMod, only : acnp_bc_out_id_growresp use FatesConstantsMod , only : nearzero @@ -186,7 +184,7 @@ subroutine CohortPySet(ipft,hgt_min,canopy_trim) class(callom_prt_vartypes), pointer :: callom_prt -! class(cnp_allom_prt_vartypes), pointer :: cnpallom_prt + class(cnp_allom_prt_vartypes), pointer :: cnpallom_prt ccohort => cohort_array(ipft) @@ -231,10 +229,10 @@ subroutine CohortPySet(ipft,hgt_min,canopy_trim) allocate(callom_prt) ccohort%prt => callom_prt -! case(2) + case(2) -! allocate(cnpallom_prt) -! ccohort%prt => cnpallom_prt + allocate(cnpallom_prt) + ccohort%prt => cnpallom_prt case DEFAULT write(fates_log(),*) 'You specified an unknown PRT module' @@ -260,63 +258,63 @@ subroutine CohortPySet(ipft,hgt_min,canopy_trim) call ccohort%prt%RegisterBCIn(ac_bc_in_id_pft,bc_ival = ccohort%pft) call ccohort%prt%RegisterBCIn(ac_bc_in_id_ctrim,bc_rval = ccohort%canopy_trim) -! case (2) + case (2) ! Initializing with the target stoichiometric ratios ! (OR you can initialize with the minimum ratios too.... p2) - !leaf_n = leaf_c * EDPftvarcon_inst%parteh_n_stoich_p1(ipft,leaf_organ) - !fnrt_n = fnrt_c * EDPftvarcon_inst%parteh_n_stoich_p1(ipft,fnrt_organ) - !sapw_n = sapw_c * EDPftvarcon_inst%parteh_n_stoich_p1(ipft,sapw_organ) - !store_n = store_c * EDPftvarcon_inst%parteh_n_stoich_p1(ipft,store_organ) - !struct_n = struct_c * EDPftvarcon_inst%parteh_n_stoich_p1(ipft,struct_organ) - !repro_n = repro_c * EDPftvarcon_inst%parteh_n_stoich_p1(ipft,repro_organ) + leaf_n = leaf_c * EDPftvarcon_inst%prt_nitr_stoich_p1(ipft,leaf_organ) + fnrt_n = fnrt_c * EDPftvarcon_inst%prt_nitr_stoich_p1(ipft,fnrt_organ) + sapw_n = sapw_c * EDPftvarcon_inst%prt_nitr_stoich_p1(ipft,sapw_organ) + store_n = store_c * EDPftvarcon_inst%prt_nitr_stoich_p1(ipft,store_organ) + struct_n = struct_c * EDPftvarcon_inst%prt_nitr_stoich_p1(ipft,struct_organ) + repro_n = repro_c * EDPftvarcon_inst%prt_nitr_stoich_p1(ipft,repro_organ) - !leaf_p = leaf_c * EDPftvarcon_inst%parteh_p_stoich_p1(ipft,leaf_organ) - !fnrt_p = fnrt_c * EDPftvarcon_inst%parteh_p_stoich_p1(ipft,fnrt_organ) - !sapw_p = sapw_c * EDPftvarcon_inst%parteh_p_stoich_p1(ipft,sapw_organ) - !store_p = store_c * EDPftvarcon_inst%parteh_p_stoich_p1(ipft,store_organ) - !struct_p = struct_c * EDPftvarcon_inst%parteh_p_stoich_p1(ipft,struct_organ) - !repro_p = repro_c * EDPftvarcon_inst%parteh_p_stoich_p1(ipft,repro_organ) - - !ccohort%accum_r_maint_deficit = 0.0_r8 + leaf_p = leaf_c * EDPftvarcon_inst%prt_phos_stoich_p1(ipft,leaf_organ) + fnrt_p = fnrt_c * EDPftvarcon_inst%prt_phos_stoich_p1(ipft,fnrt_organ) + sapw_p = sapw_c * EDPftvarcon_inst%prt_phos_stoich_p1(ipft,sapw_organ) + store_p = store_c * EDPftvarcon_inst%prt_phos_stoich_p1(ipft,store_organ) + struct_p = struct_c * EDPftvarcon_inst%prt_phos_stoich_p1(ipft,struct_organ) + repro_p = repro_c * EDPftvarcon_inst%prt_phos_stoich_p1(ipft,repro_organ) + + ccohort%accum_r_maint_deficit = 0.0_r8 - !call SetState(ccohort%prt,leaf_organ, carbon12_species, leaf_c) - !call SetState(ccohort%prt,fnrt_organ, carbon12_species, fnrt_c) - !call SetState(ccohort%prt,sapw_organ, carbon12_species, sapw_c) - !call SetState(ccohort%prt,store_organ, carbon12_species, store_c) - !call SetState(ccohort%prt,struct_organ , carbon12_species, struct_c) - !call SetState(ccohort%prt,repro_organ , carbon12_species, repro_c) - - !call SetState(ccohort%prt,leaf_organ, nitrogen_species, leaf_n) - !call SetState(ccohort%prt,fnrt_organ, nitrogen_species, fnrt_n) - !call SetState(ccohort%prt,sapw_organ, nitrogen_species, sapw_n) - !call SetState(ccohort%prt,store_organ, nitrogen_species, store_n) - !call SetState(ccohort%prt,struct_organ , nitrogen_species, struct_n) - !call SetState(ccohort%prt,repro_organ , nitrogen_species, repro_n) - - !call SetState(ccohort%prt,leaf_organ, phosphorous_species, leaf_p) - !call SetState(ccohort%prt,fnrt_organ, phosphorous_species, fnrt_p) - !call SetState(ccohort%prt,sapw_organ, phosphorous_species, sapw_p) - !call SetState(ccohort%prt,store_organ, phosphorous_species, store_p) - !call SetState(ccohort%prt,struct_organ , phosphorous_species, struct_p) - !call SetState(ccohort%prt,repro_organ , phosphorous_species, repro_p) + call SetState(ccohort%prt,leaf_organ, carbon12_species, leaf_c) + call SetState(ccohort%prt,fnrt_organ, carbon12_species, fnrt_c) + call SetState(ccohort%prt,sapw_organ, carbon12_species, sapw_c) + call SetState(ccohort%prt,store_organ, carbon12_species, store_c) + call SetState(ccohort%prt,struct_organ , carbon12_species, struct_c) + call SetState(ccohort%prt,repro_organ , carbon12_species, repro_c) + + call SetState(ccohort%prt,leaf_organ, nitrogen_species, leaf_n) + call SetState(ccohort%prt,fnrt_organ, nitrogen_species, fnrt_n) + call SetState(ccohort%prt,sapw_organ, nitrogen_species, sapw_n) + call SetState(ccohort%prt,store_organ, nitrogen_species, store_n) + call SetState(ccohort%prt,struct_organ , nitrogen_species, struct_n) + call SetState(ccohort%prt,repro_organ , nitrogen_species, repro_n) + + call SetState(ccohort%prt,leaf_organ, phosphorous_species, leaf_p) + call SetState(ccohort%prt,fnrt_organ, phosphorous_species, fnrt_p) + call SetState(ccohort%prt,sapw_organ, phosphorous_species, sapw_p) + call SetState(ccohort%prt,store_organ, phosphorous_species, store_p) + call SetState(ccohort%prt,struct_organ , phosphorous_species, struct_p) + call SetState(ccohort%prt,repro_organ , phosphorous_species, 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_rmaint_def, bc_rval = ccohort%accum_r_maint_deficit) + 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_rmaint_def, bc_rval = ccohort%accum_r_maint_deficit) ! Register Input only BC's - !call ccohort%prt%RegisterBCIn(acnp_bc_in_id_pft,bc_ival = ccohort%pft) - !call ccohort%prt%RegisterBCIn(acnp_bc_in_id_ctrim,bc_rval = ccohort%canopy_trim) + call ccohort%prt%RegisterBCIn(acnp_bc_in_id_pft,bc_ival = ccohort%pft) + call ccohort%prt%RegisterBCIn(acnp_bc_in_id_ctrim,bc_rval = ccohort%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_growresp,bc_rval = ccohort%daily_r_grow ) + 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_growresp,bc_rval = ccohort%daily_r_grow ) end select @@ -377,7 +375,9 @@ subroutine WrapDailyPRT(ipft,daily_carbon_gain,daily_nitrogen_gain, & write(fates_log(),*) 'Aborting' call endrun(msg=errMsg(sourcefile, __LINE__)) end select - + + + call ccohort%prt%CheckMassConservation(ipft) diff --git a/functional_unit_testing/parteh/f_wrapper_modules/FatesPARTEHWrapMod.F90 b/functional_unit_testing/parteh/f_wrapper_modules/FatesPARTEHWrapMod.F90 index 2e14f18959..6f6f63ee04 100644 --- a/functional_unit_testing/parteh/f_wrapper_modules/FatesPARTEHWrapMod.F90 +++ b/functional_unit_testing/parteh/f_wrapper_modules/FatesPARTEHWrapMod.F90 @@ -13,7 +13,7 @@ module FatesPARTEHWrapMod use PRTAllometricCarbonMod, only : InitPRTInstanceAC - !! use PRTAllometricCNPMod, only : InitPRTInstanceACNP + use PRTAllometricCNPMod, only : InitPRTInstanceACNP use FatesGlobals , only : endrun => fates_endrun use FatesGlobals , only : fates_log use shr_log_mod , only : errMsg => shr_log_errMsg @@ -42,7 +42,7 @@ subroutine SPMapPyset() !prt_mode) ! case(2) -!! call InitPRTInstanceACNP() + call InitPRTInstanceACNP() ! case DEFAULT ! write(fates_log(),*) 'You specified an unknown PRT module' diff --git a/functional_unit_testing/parteh/f_wrapper_modules/FatesPFTWrapMod.F90 b/functional_unit_testing/parteh/f_wrapper_modules/FatesPFTWrapMod.F90 index 0a46a97d10..115d362c5d 100644 --- a/functional_unit_testing/parteh/f_wrapper_modules/FatesPFTWrapMod.F90 +++ b/functional_unit_testing/parteh/f_wrapper_modules/FatesPFTWrapMod.F90 @@ -48,10 +48,8 @@ module EDPftvarcon real(r8), pointer :: cushion(:) real(r8), pointer :: c2b(:) real(r8), pointer :: vcmax25top(:) - !real(r8), pointer :: allom_la_per_sa_int(:) - !real(r8), pointer :: allom_la_per_sa_slp(:) - real(r8), pointer :: allom_latosa_int(:) - real(r8), pointer :: allom_latosa_slp(:) + real(r8), pointer :: allom_la_per_sa_int(:) + real(r8), pointer :: allom_la_per_sa_slp(:) real(r8), pointer :: slatop(:) real(r8), pointer :: slamax(:) real(r8), pointer :: allom_l2fr(:) @@ -385,29 +383,17 @@ subroutine EDPftvarconAlloc(numpft_in, numorgans_in) EDPftvarcon_ptr%var(iv)%var_name = "fates_vcmax25top" EDPftvarcon_ptr%var(iv)%rp_1d => EDPftvarcon_inst%vcmax25top -! allocate( EDPftvarcon_inst%allom_la_per_sa_int(1:num_pft)); -! EDPftvarcon_inst%allom_la_per_sa_int(:) = nan -! iv = iv + 1 -! EDPftvarcon_ptr%var(iv)%var_name = "fates_allom_la_per_sa_int" -! EDPftvarcon_ptr%var(iv)%rp_1d => EDPftvarcon_inst%allom_la_per_sa_int - -! allocate( EDPftvarcon_inst%allom_la_per_sa_slp(1:num_pft)); -! EDPftvarcon_inst%allom_la_per_sa_slp(:) = nan -! iv = iv + 1 -! EDPftvarcon_ptr%var(iv)%var_name = "fates_allom_la_per_sa_slp" -! EDPftvarcon_ptr%var(iv)%rp_1d => EDPftvarcon_inst%allom_la_per_sa_slp - - allocate( EDPftvarcon_inst%allom_latosa_int(1:num_pft)); - EDPftvarcon_inst%allom_latosa_int(:) = nan + allocate( EDPftvarcon_inst%allom_la_per_sa_int(1:num_pft)); + EDPftvarcon_inst%allom_la_per_sa_int(:) = nan iv = iv + 1 - EDPftvarcon_ptr%var(iv)%var_name = "fates_allom_latosa_int" - EDPftvarcon_ptr%var(iv)%rp_1d => EDPftvarcon_inst%allom_latosa_int + EDPftvarcon_ptr%var(iv)%var_name = "fates_allom_la_per_sa_int" + EDPftvarcon_ptr%var(iv)%rp_1d => EDPftvarcon_inst%allom_la_per_sa_int - allocate( EDPftvarcon_inst%allom_latosa_slp(1:num_pft)); - EDPftvarcon_inst%allom_latosa_slp(:) = nan + allocate( EDPftvarcon_inst%allom_la_per_sa_slp(1:num_pft)); + EDPftvarcon_inst%allom_la_per_sa_slp(:) = nan iv = iv + 1 - EDPftvarcon_ptr%var(iv)%var_name = "fates_allom_latosa_slp" - EDPftvarcon_ptr%var(iv)%rp_1d => EDPftvarcon_inst%allom_latosa_slp + EDPftvarcon_ptr%var(iv)%var_name = "fates_allom_la_per_sa_slp" + EDPftvarcon_ptr%var(iv)%rp_1d => EDPftvarcon_inst%allom_la_per_sa_slp allocate( EDPftvarcon_inst%slatop(1:num_pft)); EDPftvarcon_inst%slatop(:) = nan diff --git a/functional_unit_testing/parteh/parteh_controls_defaults.xml b/functional_unit_testing/parteh/parteh_controls_defaults.xml index 3b2a71b276..91637d093e 100644 --- a/functional_unit_testing/parteh/parteh_controls_defaults.xml +++ b/functional_unit_testing/parteh/parteh_controls_defaults.xml @@ -81,8 +81,8 @@ 2.0 , 2.0 0.7 , 0.7 2.0 , 2.0 - 1.00 , 1.00 - 0.0 , 0.0 + 1.00 , 1.00 + 0.0 , 0.0 0.012 , 0.012 0.012 , 0.012 1.0 , 1.0 @@ -99,13 +99,13 @@ 1,1 - -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9 + 0.025, 0.025, 0.025, 0.025, 0.025, 0.025, 0.025, 0.025, 0.025, 0.025, 0.025, 0.025 -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9 -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9 - -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9 - -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9 - -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9 - -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9 + -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9 + -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9 + -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9 + -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9 diff --git a/functional_unit_testing/parteh/parteh_controls_smoketests.xml b/functional_unit_testing/parteh/parteh_controls_smoketests.xml index 04940b489e..9cf876fb6c 100644 --- a/functional_unit_testing/parteh/parteh_controls_smoketests.xml +++ b/functional_unit_testing/parteh/parteh_controls_smoketests.xml @@ -118,35 +118,35 @@ 0.25,0,0,0,0, 0.25,0,0,0,0 - -9,-9,-9,-9,-9,-9, + -9,-9,-9,-9,-9,-9, 0.05,0.05,0.05,0.05,0.05,0.05, 0,0,0,0,0,0, 0.05,0.05,0.05,0.05,0.05,0.05, 0.05,0.05,0.05,0.05,0.05,0.05 - -9,-9,-9,-9,-9,-9, + -9,-9,-9,-9,-9,-9, 0.05,0.05,0.05,0.05,0.05,0.05, 0,0,0,0,0,0, 0.05,0.05,0.05,0.05,0.05,0.05, 0.05,0.05,0.05,0.05,0.05,0.05 - -9,-9,-9,-9,-9,-9, + -9,-9,-9,-9,-9,-9, 0.05,0.05,0.05,0.05,0.05,0.05, 0,0,0,0,0,0, 0.05,0.05,0.05,0.05,0.05,0.05, 0.05,0.05,0.05,0.05,0.05,0.05 - -9,-9,-9,-9,-9,-9, + -9,-9,-9,-9,-9,-9, 0.05,0.05,0.05,0.05,0.05,0.05, 0,0,0,0,0,0, 0.05,0.05,0.05,0.05,0.05,0.05, 0.05,0.05,0.05,0.05,0.05,0.05 - -9,-9,-9,-9,-9,-9, + -9,-9,-9,-9,-9,-9, 1,1,2,2,0,3, 1,1,2,2,0,3, 1,1,2,2,0,3, 1,1,2,2,0,3 - -9,-9,-9,-9,-9,-9, + -9,-9,-9,-9,-9,-9, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, diff --git a/functional_unit_testing/parteh/parteh_controls_variable_netc.xml b/functional_unit_testing/parteh/parteh_controls_variable_netc.xml index 82a6479b58..40c043dce2 100644 --- a/functional_unit_testing/parteh/parteh_controls_variable_netc.xml +++ b/functional_unit_testing/parteh/parteh_controls_variable_netc.xml @@ -109,15 +109,15 @@ 0.25,0,0,0,0,0, 0.25,0,0,0,0,0 - 0,0,0,0,0,0,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05 - 0,0,0,0,0,0,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05 + 0,0,0,0,0,0,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05 + 0,0,0,0,0,0,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05 - 0,0,0,0,0,0,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05 - 0,0,0,0,0,0,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05 + 0,0,0,0,0,0,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05 + 0,0,0,0,0,0,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05 - 1,1,2,2,0,3,1,1,2,2,0,3,1,1,2,2,0,3 + 1,1,2,2,0,3,1,1,2,2,0,3,1,1,2,2,0,3 - 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01 + 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01 diff --git a/parteh/PRTAllometricCarbonMod.F90 b/parteh/PRTAllometricCarbonMod.F90 index b6efdd3872..0be4ec57ab 100644 --- a/parteh/PRTAllometricCarbonMod.F90 +++ b/parteh/PRTAllometricCarbonMod.F90 @@ -263,6 +263,8 @@ subroutine DailyPRTAC(this) real(r8) :: target_bgw_c ! target below ground carbon in woody tissues [kgC] real(r8) :: target_struct_c ! target structural carbon [kgC] + real(r8) :: sapw_area ! dummy var, x-section area of sapwood [m2] + real(r8) :: leaf_below_target ! fineroot biomass below target amount [kgC] real(r8) :: fnrt_below_target ! fineroot biomass below target amount [kgC] real(r8) :: sapw_below_target ! sapwood biomass below target amount [kgC] @@ -277,7 +279,6 @@ subroutine DailyPRTAC(this) real(r8) :: fnrt_c_demand ! fineroot carbon that is demanded to replace ! maintenance turnover [kgC] real(r8) :: total_c_demand ! total carbon that is demanded to replace maintenance turnover [kgC] - real(r8) :: sapw_area ! dummy sapwood area logical :: step_pass ! Did the integration step pass? real(r8) :: leaf_c_flux @@ -372,9 +373,7 @@ subroutine DailyPRTAC(this) ! Target sapwood biomass and deriv. according to allometry and trimming [kgC, kgC/cm] - !call bsap_allom(dbh,ipft,canopy_trim,sapw_area,target_sapw_c) - call bsap_allom(dbh,ipft,canopy_trim,target_sapw_c) - + call bsap_allom(dbh,ipft,canopy_trim,sapw_area,target_sapw_c) ! Target total above ground deriv. biomass in woody/fibrous tissues [kgC, kgC/cm] call bagw_allom(dbh,ipft,target_agw_c) @@ -398,8 +397,7 @@ subroutine DailyPRTAC(this) canopy_trim, dbh, hite_out ) ! Target sapwood biomass and deriv. according to allometry and trimming [kgC, kgC/cm] - !call bsap_allom(dbh,ipft,canopy_trim,sapw_area,target_sapw_c) - call bsap_allom(dbh,ipft,canopy_trim,target_sapw_c) + call bsap_allom(dbh,ipft,canopy_trim,sapw_area,target_sapw_c) ! Target total above ground deriv. biomass in woody/fibrous tissues [kgC, kgC/cm] call bagw_allom(dbh,ipft,target_agw_c) @@ -803,9 +801,9 @@ function AllomCGrowthDeriv(c_pools,c_mask,cbalance,intgr_params) result(dCdx) real(r8) :: ct_bgw ! target belowground wood, dummy var (kgC) real(r8) :: ct_store ! target storage, dummy var (kgC) real(r8) :: ct_dead ! target structural biomas, dummy var (kgC) - real(r8) :: sapw_area ! dummy sapwood area + real(r8) :: sapw_area ! dummy sapwood area real(r8) :: ct_dleafdd ! target leaf biomass derivative wrt d, (kgC/cm) - real(r8) :: ct_dfnrtdd ! target fine-root biomass derivative wrt d, (kgC/cm) + real(r8) :: ct_dfnrtdd ! target fine-root biomass derivative wrt d, (kgC/cm) real(r8) :: ct_dsapdd ! target sapwood biomass derivative wrt d, (kgC/cm) real(r8) :: ct_dagwdd ! target AG wood biomass derivative wrt d, (kgC/cm) real(r8) :: ct_dbgwdd ! target BG wood biomass derivative wrt d, (kgC/cm) @@ -840,8 +838,7 @@ function AllomCGrowthDeriv(c_pools,c_mask,cbalance,intgr_params) result(dCdx) call bleaf(dbh,ipft,canopy_trim,ct_leaf,ct_dleafdd) call bfineroot(dbh,ipft,canopy_trim,ct_fnrt,ct_dfnrtdd) - !call bsap_allom(dbh,ipft,canopy_trim,sapw_area,ct_sap,ct_dsapdd) - call bsap_allom(dbh,ipft,canopy_trim,ct_sap,ct_dsapdd) + call bsap_allom(dbh,ipft,canopy_trim,sapw_area,ct_sap,ct_dsapdd) call bagw_allom(dbh,ipft,ct_agw,ct_dagwdd) call bbgw_allom(dbh,ipft,ct_bgw,ct_dbgwdd) call bdead_allom(ct_agw,ct_bgw, ct_sap, ipft, ct_dead, & diff --git a/parteh/PRTGenericMod.F90 b/parteh/PRTGenericMod.F90 index 87bf8e6e0b..cd215c3d09 100644 --- a/parteh/PRTGenericMod.F90 +++ b/parteh/PRTGenericMod.F90 @@ -33,6 +33,8 @@ module PRTGenericMod implicit none + logical, parameter :: debug = .true. + integer, parameter :: maxlen_varname = 128 integer, parameter :: maxlen_varsymbol = 16 integer, parameter :: maxlen_varunits = 32 @@ -761,15 +763,17 @@ end subroutine ZeroRates ! ==================================================================================== - subroutine CheckMassConservation(this) + subroutine CheckMassConservation(this,ipft) class(prt_vartypes) :: this + integer, intent(in) :: ipft integer :: n_vars ! Number of variables integer :: i_var ! Variable index integer :: i_pos ! Position (coordinate) index real(r8) :: err + real(r8) :: rel_err n_vars = size(this%variables,1) @@ -777,15 +781,22 @@ subroutine CheckMassConservation(this) do i_pos = 1, this%variables(i_var)%num_pos - err = (this%variables(i_var)%val(i_pos) - this%variables(i_var)%val0(i_pos)) - & + err = abs((this%variables(i_var)%val(i_pos) - this%variables(i_var)%val0(i_pos)) - & (this%variables(i_var)%net_art(i_pos) & -this%variables(i_var)%turnover(i_pos) & - -this%variables(i_var)%burned(i_pos) ) + -this%variables(i_var)%burned(i_pos) )) + if(this%variables(i_var)%val(i_pos) > nearzero) then + rel_err = err / this%variables(i_var)%val(i_pos) + else + rel_err = 0.0_r8 + end if + if( abs(err) > calloc_abs_error ) then write(fates_log(),*) 'PARTEH mass conservation check failed' write(fates_log(),*) ' Change in mass over control period should' write(fates_log(),*) ' always equal the integrated fluxes.' + write(fates_log(),*) ' pft id: ',ipft write(fates_log(),*) ' organ id: ',this%prt_instance%state_descriptor(i_var)%organ_id write(fates_log(),*) ' species_id: ',this%prt_instance%state_descriptor(i_var)%spec_id write(fates_log(),*) ' position id: ',i_pos @@ -795,7 +806,8 @@ subroutine CheckMassConservation(this) write(fates_log(),*) ' terms: ', this%variables(i_var)%val(i_pos), & this%variables(i_var)%val0(i_pos), & this%variables(i_var)%net_art(i_pos), & - this%variables(i_var)%turnover(i_pos) + this%variables(i_var)%turnover(i_pos), & + this%variables(i_var)%burned(i_pos) write(fates_log(),*) ' Exiting.' call endrun(msg=errMsg(__FILE__, __LINE__)) end if diff --git a/parteh/PRTLossFluxesMod.F90 b/parteh/PRTLossFluxesMod.F90 index 79bc1df658..1910f73ae4 100644 --- a/parteh/PRTLossFluxesMod.F90 +++ b/parteh/PRTLossFluxesMod.F90 @@ -13,6 +13,9 @@ module PRTLossFluxesMod use PRTGenericMod, only : carbon12_species use PRTGenericMod, only : nitrogen_species use PRTGenericMod, only : phosphorous_species + use PRTGenericMod, only : un_initialized + use PRTGenericMod, only : check_initialized + use PRTGenericMod, only : num_organ_types use FatesInterfaceMod, only : hlm_freq_day use FatesConstantsMod, only : r8 => fates_r8 @@ -457,45 +460,50 @@ subroutine MaintTurnoverSimpleRetranslocation(prt,ipft) integer :: num_sp_vars integer :: i_pos - real(r8) :: base_turnover + real(r8) :: turnover real(r8) :: leaf_turnover real(r8) :: fnrt_turnover real(r8) :: sapw_turnover real(r8) :: store_turnover real(r8) :: struct_turnover real(r8) :: repro_turnover - real(r8) :: turnover ! A temp for the actual turnover removed from pool + real(r8), dimension(num_organ_types) :: base_turnover ! A temp for the actual turnover removed from pool real(r8) :: retrans ! A temp for the actual re-translocated mass + num_sp_vars = size(prt%variables,1) ! ----------------------------------------------------------------------------------- - ! Calculate the turnover rates + ! Calculate the turnover rates (maybe this should be done once in the parameter + ! check routine. Perhaps generate a rate in parameters derived? ! ----------------------------------------------------------------------------------- + + base_turnover(:) = un_initialized if ( EDPftvarcon_inst%branch_turnover(ipft) > nearzero ) then - sapw_turnover = hlm_freq_day / EDPftvarcon_inst%branch_turnover(ipft) - struct_turnover = hlm_freq_day / EDPftvarcon_inst%branch_turnover(ipft) - store_turnover = hlm_freq_day / EDPftvarcon_inst%branch_turnover(ipft) + base_turnover(sapw_organ) = hlm_freq_day / EDPftvarcon_inst%branch_turnover(ipft) + base_turnover(struct_organ) = hlm_freq_day / EDPftvarcon_inst%branch_turnover(ipft) + base_turnover(store_organ) = hlm_freq_day / EDPftvarcon_inst%branch_turnover(ipft) else - sapw_turnover = 0.0_r8 - struct_turnover = 0.0_r8 - store_turnover = 0.0_r8 - + base_turnover(sapw_organ) = 0.0_r8 + base_turnover(struct_organ) = 0.0_r8 + base_turnover(store_organ) = 0.0_r8 end if + if ( EDPftvarcon_inst%root_long(ipft) > nearzero ) then - fnrt_turnover = hlm_freq_day / EDPftvarcon_inst%root_long(ipft) + base_turnover(fnrt_organ) = hlm_freq_day / EDPftvarcon_inst%root_long(ipft) else - fnrt_turnover = 0.0_r8 + base_turnover(fnrt_organ) = 0.0_r8 end if + if ( (EDPftvarcon_inst%leaf_long(ipft) > nearzero ) .and. & (EDPftvarcon_inst%evergreen(ipft) == 1) ) then - leaf_turnover = hlm_freq_day / EDPftvarcon_inst%leaf_long(ipft) + base_turnover(leaf_organ) = hlm_freq_day / EDPftvarcon_inst%leaf_long(ipft) else - leaf_turnover = 0.0_r8 + base_turnover(leaf_organ) = 0.0_r8 endif - repro_turnover = 0.0_r8 + base_turnover(repro_organ) = 0.0_r8 do i_var = 1, num_sp_vars @@ -511,17 +519,33 @@ subroutine MaintTurnoverSimpleRetranslocation(prt,ipft) else write(fates_log(),*) 'Please add a new re-translocation clause to your ' write(fates_log(),*) ' organ x species combination' - write(fates_log(),*) ' organ: ',leaf_organ,' species: ',spec_id + write(fates_log(),*) ' organ: ',organ_id,' species: ',spec_id write(fates_log(),*) 'Exiting' call endrun(msg=errMsg(__FILE__, __LINE__)) end if + if(base_turnover(organ_id) < check_initialized) then + write(fates_log(),*) 'A maintenance turnover rate for the organ' + write(fates_log(),*) ' was not specified....' + write(fates_log(),*) ' organ: ',organ_id,' species: ',spec_id + write(fates_log(),*) ' base turnover rate: ',base_turnover(organ_id) + write(fates_log(),*) 'Exiting' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if ! Loop over all of the coordinate ids + if(retrans<0.0 .or. retrans>1.0) then + write(fates_log(),*) 'Unacceptable retranslocation calculated' + write(fates_log(),*) ' organ: ',organ_id,' species: ',spec_id + write(fates_log(),*) ' retranslocation fraction: ',retrans + write(fates_log(),*) 'Exiting' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + do i_pos = 1,prt%variables(i_var)%num_pos - turnover = (1.0_r8 - retrans) * base_turnover * prt%variables(i_var)%val(i_pos) - + turnover = (1.0_r8 - retrans) * base_turnover(organ_id) * prt%variables(i_var)%val(i_pos) + prt%variables(i_var)%turnover(i_pos) = prt%variables(i_var)%turnover(i_pos) + turnover prt%variables(i_var)%val(i_pos) = prt%variables(i_var)%val(i_pos) - turnover From fb39f3c198b0208eee11d3d4b601c1b4d1395970 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 27 Sep 2018 11:46:17 -0700 Subject: [PATCH 16/52] Added phenology events to the functional unit tests, however its messy and needs cleanup. --- .../parteh/PartehDriver.py | 78 +++++++++-- .../f_wrapper_modules/FatesCohortWrapMod.F90 | 24 +++- .../f_wrapper_modules/FatesPFTWrapMod.F90 | 15 +++ .../parteh/parteh_controls_defaults.xml | 2 + .../parteh/parteh_controls_phenevents.xml | 124 ++++++++++++++++++ .../parteh/py_modules/SyntheticBoundaries.py | 72 ++++++++-- parteh/PRTLossFluxesMod.F90 | 20 ++- 7 files changed, 308 insertions(+), 27 deletions(-) create mode 100644 functional_unit_testing/parteh/parteh_controls_phenevents.xml diff --git a/functional_unit_testing/parteh/PartehDriver.py b/functional_unit_testing/parteh/PartehDriver.py index bc9c9c28e4..043b8918b8 100644 --- a/functional_unit_testing/parteh/PartehDriver.py +++ b/functional_unit_testing/parteh/PartehDriver.py @@ -130,11 +130,47 @@ def main(argv): iret=f90_fates_pftwrap_obj.__edpftvarcon_MOD_edpftvarconalloc(byref(c_int(parameters.num_pfts)), \ byref(c_int(max_num_organs))) - + # Set the phenology type + phen_type = [] + for pft_idx,pft_obj in enumerate(parameters.parteh_pfts): + + evergreen = np.int(parameters.parteh_pfts[pft_idx].param_dic['fates_phen_evergreen'][0]) + cold_deciduous = np.int(parameters.parteh_pfts[pft_idx].param_dic['fates_phen_season_decid'][0]) + stress_deciduous = np.int(parameters.parteh_pfts[pft_idx].param_dic['fates_phen_stress_decid'][0]) + if(evergreen==1): + if(cold_deciduous==1): + print("Poorly defined phenology mode 0") + exit(2) + if(stress_deciduous==1): + print("Poorly defined phenology mode 1") + exit(2) + phen_type.append(1) + elif(cold_deciduous==1): + if(evergreen==1): + print("Poorly defined phenology mode 2") + exit(2) + if(stress_deciduous==1): + print("Poorly defined phenology mode 3") + exit(2) + phen_type.append(2) + elif(stress_deciduous==1): + if(evergreen==1): + print("Poorly defined phenology mode 4") + exit(2) + if(cold_deciduous==1): + print("Poorly defined phenology mode 5") + exit(2) + phen_type.append(3) + else: + print("Unknown phenology mode ? {} {} {}".format(evergreen,cold_deciduous,stress_deciduous)) + exit(2) + + # Loop through each pft and pft's parameters and pass them to the fortran object # Also, some parameters may be arrays (like organ number) for pft_idx,pft_obj in enumerate(parameters.parteh_pfts): + for par_idx, par_key in enumerate(pft_obj.param_dic.iterkeys()): pval = pft_obj.param_dic[par_key] print("{} {} {}".format(par_idx,par_key,pval)) @@ -195,10 +231,12 @@ def main(argv): # --------------------------------------------------------------------------- # First lets query this pft-cohort and return a smattering of indices + leaf_area = c_double(0.0) agb = c_double(0.0) crown_area = c_double(0.0) dbh = c_double(0.0) + target_leaf_c = c_double(-9.9) leaf_c = c_double(0.0) fnrt_c = c_double(0.0) sapw_c = c_double(0.0) @@ -243,17 +281,28 @@ def main(argv): byref(leaf_area), \ byref(crown_area), \ byref(agb), \ - byref(store_c)) + byref(store_c),\ + byref(target_leaf_c)) + + - # if(parameters.boundary_method=="DailyCFromUnitGPPAR"): - # net_daily_c = SyntheticBoundaries.DailyCFromUnitGPPAR(leaf_area.value,agb.value) + doy = time_control.datetime.astype(object).timetuple().tm_yday + + + + # Call phenology module, if no leaves... then npp should be zero... + flush_c,drop_frac_c,leaf_status = SyntheticBoundaries.DeciduousPhenology(doy, \ + target_leaf_c.value, \ + store_c.value, phen_type[pft_idx]) if(parameters.boundary_method=="DailyCFromCArea"): presc_npp_p1 = parameters.boundary_pfts[pft_idx].param_dic['fates_prescribed_npp_p1'] net_daily_c = SyntheticBoundaries.DailyCFromCArea(presc_npp_p1, \ - crown_area.value) + crown_area.value, \ + phen_type[pft_idx], \ + leaf_status) net_daily_n = 0.0 net_daily_p = 0.0 r_maint_demand = 0.0 @@ -268,7 +317,9 @@ def main(argv): net_daily_c, net_daily_n, net_daily_p = SyntheticBoundaries.DailyCNPFromCArea(presc_npp_p1, \ presc_nflux_p1, \ presc_pflux_p1, \ - crown_area.value) + crown_area.value, \ + phen_type[pft_idx], \ + leaf_status) r_maint_demand = 0.0 @@ -280,7 +331,7 @@ def main(argv): presc_pflux_p1 = parameters.boundary_pfts[pft_idx].param_dic['fates_prescribed_pflux_p1'] - doy = time_control.datetime.astype(object).timetuple().tm_yday + net_daily_c, net_daily_n, net_daily_p = SyntheticBoundaries.DailyCNPFromStorageSinWave(doy,\ store_c.value,\ @@ -288,7 +339,9 @@ def main(argv): presc_nflux_p1, \ presc_pflux_p1, \ crown_area.value, \ - presc_npp_amp ) + presc_npp_amp, \ + phen_type[pft_idx], \ + leaf_status ) r_maint_demand = 0.0 else: @@ -297,14 +350,21 @@ def main(argv): exit() + + + + # This function will pass in all boundary conditions, some will be dummy arguments init_canopy_trim = 1.0 iret=f90_fates_cohortwrap_obj.__fatescohortwrapmod_MOD_wrapdailyprt(byref(c_int(pft_idx+1)), \ byref(c_double(net_daily_c)), \ + byref(c_double(init_canopy_trim)), \ + byref(c_double(flush_c)), \ + byref(c_double(drop_frac_c)), \ byref(c_double(net_daily_n)), \ byref(c_double(net_daily_p)), \ - byref(c_double(init_canopy_trim)), \ byref(c_double(r_maint_demand))) + # This function will retrieve diagnostics diff --git a/functional_unit_testing/parteh/f_wrapper_modules/FatesCohortWrapMod.F90 b/functional_unit_testing/parteh/f_wrapper_modules/FatesCohortWrapMod.F90 index c5a6b81da9..66f52e769e 100644 --- a/functional_unit_testing/parteh/f_wrapper_modules/FatesCohortWrapMod.F90 +++ b/functional_unit_testing/parteh/f_wrapper_modules/FatesCohortWrapMod.F90 @@ -45,6 +45,8 @@ module FatesCohortWrapMod use PRTAllometricCarbonMod, only : ac_bc_inout_id_dbh use PRTLossFluxesMod, only : PRTMaintTurnover + use PRTLossFluxesMod, only : PRTDeciduousTurnover + use PRTLossFluxesMod, only : PRTPhenologyFlush use PRTAllometricCNPMod, only : cnp_allom_prt_vartypes use PRTAllometricCNPMod, only : acnp_bc_inout_id_dbh @@ -326,14 +328,16 @@ end subroutine CohortPySet ! ===================================================================================== - subroutine WrapDailyPRT(ipft,daily_carbon_gain,daily_nitrogen_gain, & - daily_phosphorous_gain,canopy_trim,daily_r_maint_demand) + subroutine WrapDailyPRT(ipft,daily_carbon_gain,canopy_trim,flush_c,drop_frac_c, & + daily_nitrogen_gain, daily_phosphorous_gain,daily_r_maint_demand ) implicit none ! Arguments integer(i4),intent(in) :: ipft real(r8),intent(in) :: daily_carbon_gain real(r8),intent(in) :: canopy_trim + real(r8),intent(in) :: flush_c + real(r8),intent(in) :: drop_frac_c real(r8), intent(in), optional :: daily_nitrogen_gain real(r8), intent(in), optional :: daily_phosphorous_gain real(r8), intent(in), optional :: daily_r_maint_demand @@ -347,6 +351,14 @@ subroutine WrapDailyPRT(ipft,daily_carbon_gain,daily_nitrogen_gain, & call ccohort%prt%ZeroRates() + call PRTDeciduousTurnover(ccohort%prt, ipft, leaf_organ , drop_frac_c) + + if(drop_frac_c>nearzero)then + print*,"DCG:",daily_carbon_gain + end if + + call PRTPhenologyFlush(ccohort%prt, ipft, leaf_organ, flush_c) + call PRTMaintTurnover(ccohort%prt, ipft) select case(int(ccohort%parteh_model)) @@ -386,7 +398,7 @@ end subroutine WrapDailyPRT ! ===================================================================================== - subroutine WrapQueryVars(ipft,leaf_area,crown_area,agb,store_c) + subroutine WrapQueryVars(ipft,leaf_area,crown_area,agb,store_c,target_leaf_c) implicit none ! Arguments @@ -395,6 +407,7 @@ subroutine WrapQueryVars(ipft,leaf_area,crown_area,agb,store_c) real(r8),intent(out) :: crown_area real(r8),intent(out) :: agb real(r8),intent(out) :: store_c + real(r8),intent(out) :: target_leaf_c real(r8) :: leaf_c type(ed_cohort_type), pointer :: ccohort @@ -416,6 +429,8 @@ subroutine WrapQueryVars(ipft,leaf_area,crown_area,agb,store_c) call bagw_allom(ccohort%dbh,ipft,agb) + call bleaf(ccohort%dbh,ipft, ccohort%canopy_trim, target_leaf_c) + return end subroutine WrapQueryVars @@ -493,6 +508,9 @@ subroutine WrapQueryDiagnostics(ipft, dbh, & store_c = ccohort%prt%GetState(organ_id=store_organ, species_id=all_carbon_species) struct_c = ccohort%prt%GetState(organ_id=struct_organ, species_id=all_carbon_species) repro_c = ccohort%prt%GetState(organ_id=repro_organ, species_id=all_carbon_species) + + print*,ipft,leaf_c + leaf_cturn = ccohort%prt%GetTurnover(organ_id=leaf_organ, species_id=all_carbon_species) fnrt_cturn = ccohort%prt%GetTurnover(organ_id=fnrt_organ, species_id=all_carbon_species) diff --git a/functional_unit_testing/parteh/f_wrapper_modules/FatesPFTWrapMod.F90 b/functional_unit_testing/parteh/f_wrapper_modules/FatesPFTWrapMod.F90 index 115d362c5d..75e30b32e7 100644 --- a/functional_unit_testing/parteh/f_wrapper_modules/FatesPFTWrapMod.F90 +++ b/functional_unit_testing/parteh/f_wrapper_modules/FatesPFTWrapMod.F90 @@ -24,6 +24,8 @@ module EDPftvarcon real(r8), pointer :: seed_alloc_mature(:) real(r8), pointer :: dbh_repro_threshold(:) real(r8), pointer :: evergreen(:) + real(r8), pointer :: season_decid(:) + real(r8), pointer :: stress_decid(:) real(r8), pointer :: woody(:) real(r8), pointer :: hgt_min(:) real(r8), pointer :: allom_hmode(:) @@ -239,6 +241,19 @@ subroutine EDPftvarconAlloc(numpft_in, numorgans_in) EDPftvarcon_ptr%var(iv)%var_name = "fates_phen_evergreen" EDPftvarcon_ptr%var(iv)%rp_1d => EDPftvarcon_inst%evergreen + allocate( EDPftvarcon_inst%season_decid(1:num_pft)); + EDPftvarcon_inst%season_decid (:) = nan + iv = iv + 1 + EDPftvarcon_ptr%var(iv)%var_name = "fates_phen_season_decid" + EDPftvarcon_ptr%var(iv)%rp_1d => EDPftvarcon_inst%season_decid + + allocate( EDPftvarcon_inst%stress_decid(1:num_pft)); + EDPftvarcon_inst%stress_decid (:) = nan + iv = iv + 1 + EDPftvarcon_ptr%var(iv)%var_name = "fates_phen_stress_decid" + EDPftvarcon_ptr%var(iv)%rp_1d => EDPftvarcon_inst%stress_decid + + allocate( EDPftvarcon_inst%woody(1:num_pft)); EDPftvarcon_inst%woody (:) = nan iv = iv + 1 diff --git a/functional_unit_testing/parteh/parteh_controls_defaults.xml b/functional_unit_testing/parteh/parteh_controls_defaults.xml index 91637d093e..0efa50f750 100644 --- a/functional_unit_testing/parteh/parteh_controls_defaults.xml +++ b/functional_unit_testing/parteh/parteh_controls_defaults.xml @@ -55,6 +55,8 @@ 1 , 1 1 , 1 + 0 , 0 + 0 , 0 0.2 , 0.2 0.2 , 0.2 30.0 , 30.0 diff --git a/functional_unit_testing/parteh/parteh_controls_phenevents.xml b/functional_unit_testing/parteh/parteh_controls_phenevents.xml new file mode 100644 index 0000000000..3352b22ae5 --- /dev/null +++ b/functional_unit_testing/parteh/parteh_controls_phenevents.xml @@ -0,0 +1,124 @@ + + + + + + + + + + + 0 + + + + + + + + + 86400 + 1500-01-01 + 1510-01-01 + 0.001 + + + + + + + + + AllometricCNP + + + DailyCNPFromStorageSinWaveNoMaint + + + + + + + Carbon Only, constant NPP + Carbon Only, 120% sin NPP + + + + leaf + fine root + sapwood + storage + reproductive + structural + + + + 1 , 1 + 1 , 0 + 0 , 1 + 0 , 0 + 0.2 , 0.2 + 0.2 , 0.2 + 30.0 , 30.0 + 1.0 , 1.0 + 1.5 , 1.5 + 50.0 , 50.0 + 5 , 5 + 3 , 3 + 1 , 1 + 1 , 1 + 1 , 1 + 1 , 1 + 1 , 1 + 57.6 , 57.6 + 0.74 , 0.74 + 21.6 , 21.6 + 0.0673 , 0.0673 + 0.976 , 0.976 + -999.9 , -999.9 + -999.9 , -999.9 + 0.07 , 0.07 + 1.3 , 1.3 + 0.55 , 0.55 + 2.0 , 2.0 + 0.7 , 0.7 + 2.0 , 2.0 + 1.00 , 1.00 + 0.0 , 0.0 + 0.012 , 0.012 + 0.012 , 0.012 + 1.0 , 1.0 + 0.65 , 0.65 + 0.1 , 0.1 + 0.0 , 0.0 + 0.33 , 0.33 + 0.65 , 0.65 + 300.0 , 300.0 + 1.5 , 1.5 + 1.5 , 1.5 + 0.5 , 0.0 + 50.0 , 50.0 + + 1,1 + + 0.025, 0.025, 0.025, 0.025, 0.025, 0.025, 0.025, 0.025, 0.025, 0.025, 0.025, 0.025 + -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9 + -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9 + -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9 + -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9 + -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9 + -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9 + + + + + 0.4, 0.4 + -9.9, -9.9 + -9.9, -9.9 + 1.2, 1.2 + + + + + + diff --git a/functional_unit_testing/parteh/py_modules/SyntheticBoundaries.py b/functional_unit_testing/parteh/py_modules/SyntheticBoundaries.py index 1bdc9285b0..e5747129ae 100644 --- a/functional_unit_testing/parteh/py_modules/SyntheticBoundaries.py +++ b/functional_unit_testing/parteh/py_modules/SyntheticBoundaries.py @@ -53,7 +53,7 @@ def DailyCFromUnitGPPAR(leaf_area,AGB): return NetDailyC -def DailyCFromCArea(presc_npp_p1,c_area): +def DailyCFromCArea(presc_npp_p1,c_area,phen_type,leaf_status): # ----------------------------------------------------------------------------------- # This method was provided by Charlie Koven via is inferences from the PPA @@ -65,13 +65,16 @@ def DailyCFromCArea(presc_npp_p1,c_area): # presc_npp_p1, npp generated per crown area [kgC/m2/yr] # ----------------------------------------------------------------------------------- - NetDailyC = presc_npp_p1 * c_area / day_per_year - + if( (phen_type == 1) or (leaf_status ==1)): + NetDailyC = presc_npp_p1 * c_area / day_per_year + else: + NetDailyC = 0.0 + return NetDailyC def DailyCNPFromCArea(presc_npp_p1,presc_nflux_p1, \ - presc_pflux_p1,c_area): + presc_pflux_p1,c_area,phen_type,leaf_status): # ----------------------------------------------------------------------------------- # This method was provided by Charlie Koven via is inferences from the PPA @@ -86,15 +89,21 @@ def DailyCNPFromCArea(presc_npp_p1,presc_nflux_p1, \ # presc_pflux_p1, Phosphorous flux per crown area [kgP/m2/yr] # ----------------------------------------------------------------------------------- - NetDailyC = presc_npp_p1 * c_area / day_per_year - NetDailyN = presc_nflux_p1 * c_area / day_per_year - NetDailyP = presc_pflux_p1 * c_area / day_per_year + if( (phen_type == 1) or (leaf_status ==1)): + NetDailyC = presc_npp_p1 * c_area / day_per_year + NetDailyN = presc_nflux_p1 * c_area / day_per_year + NetDailyP = presc_pflux_p1 * c_area / day_per_year + else: + NetDailyC = 0.0 + NetDailyN = 0.0 + NetDailyP = 0.0 return NetDailyC, NetDailyN, NetDailyP def DailyCNPFromStorageSinWave(doy,store_c,presc_npp_p1, \ - presc_nflux_p1,presc_pflux_p1,c_area,presc_npp_amp): + presc_nflux_p1,presc_pflux_p1,c_area,presc_npp_amp, \ + phen_type, leaf_status): # This method is supposed to simulate a seasonal cycle of NPP @@ -121,7 +130,50 @@ def DailyCNPFromStorageSinWave(doy,store_c,presc_npp_p1, \ #print("sin_func: {}, NetDailyC: {}, store_c: {}, c_area :{}".format(sin_func,NetDailyC,store_c,c_area)) - NetDailyN = presc_nflux_p1 * c_area / day_per_year - NetDailyP = presc_pflux_p1 * c_area / day_per_year + if( (phen_type == 1) or (leaf_status ==1)): + NetDailyN = presc_nflux_p1 * c_area / day_per_year + NetDailyP = presc_pflux_p1 * c_area / day_per_year + else: + NetDailyN = 0.0 + NetDailyP = 0.0 + NetDailyC = 0.0 return NetDailyC, NetDailyN, NetDailyP + + +def DeciduousPhenology(doy, target_leaf_c, store_c, phen_type): + + # Time leaf-on with rising NPP + leaf_on_doy = np.int(366.0 * 0.01) + + leaf_off_doy = np.int(366.0 * 0.55) + + if ( doy==leaf_on_doy): + + flush_c = np.minimum(store_c,target_leaf_c * 0.5) + else: + flush_c = 0.0 + + if ( doy==leaf_off_doy): + drop_frac_c = 1.0 + print("Dropping") + else: + drop_frac_c = 0.0 + + if(doy>=leaf_on_doy and doy prt%prt_instance%organ_map) - - - ! First transfer in carbon ! -------------------------------------------------------------------------------- @@ -338,10 +335,13 @@ subroutine DeciduousTurnoverSimpleRetranslocation(prt,ipft,organ_id,mass_fractio end if + + ! This is the total number of state variables associated ! with this particular organ num_sp_vars = organ_map(organ_id)%num_vars - + + do i_sp_var = 1, num_sp_vars i_var = organ_map(organ_id)%var_id(i_sp_var) @@ -364,7 +364,9 @@ subroutine DeciduousTurnoverSimpleRetranslocation(prt,ipft,organ_id,mass_fractio ! Get the variable id of the storage pool for this species store_var_id = prt%prt_instance%sp_organ_map(store_organ,spec_id) - + + + ! Loop over all of the coordinate ids do i_pos = 1,prt%variables(i_var)%num_pos @@ -394,6 +396,14 @@ subroutine DeciduousTurnoverSimpleRetranslocation(prt,ipft,organ_id,mass_fractio prt%variables(store_var_id)%val(i_pos) = & prt%variables(store_var_id)%val(i_pos) + retranslocated_mass + + if(mass_fraction>nearzero)then + print*,"Mass Fraction",mass_fraction + print*,organ_id,num_sp_vars,i_var,prt%variables(i_var)%num_pos,retrans + print*,prt%variables(i_var)%val(i_pos),prt%variables(i_var)%turnover(i_pos) + print*,prt%variables(i_var)%net_art(i_pos) ,prt%variables(store_var_id)%net_art(i_pos) + end if + end do From b27fbee57dbcb305129de6b0faf96bb492c63bce Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 27 Sep 2018 13:00:54 -0700 Subject: [PATCH 17/52] Debugged phenology events in the unit testing framework --- .../parteh/PartehDriver.py | 1 + .../f_wrapper_modules/FatesCohortWrapMod.F90 | 19 +++++++++---------- .../parteh/py_modules/SyntheticBoundaries.py | 5 ----- main/EDTypesMod.F90 | 7 +++++++ parteh/PRTAllometricCarbonMod.F90 | 13 ++++++++++--- parteh/PRTLossFluxesMod.F90 | 11 +---------- 6 files changed, 28 insertions(+), 28 deletions(-) diff --git a/functional_unit_testing/parteh/PartehDriver.py b/functional_unit_testing/parteh/PartehDriver.py index 043b8918b8..c567039696 100644 --- a/functional_unit_testing/parteh/PartehDriver.py +++ b/functional_unit_testing/parteh/PartehDriver.py @@ -361,6 +361,7 @@ def main(argv): byref(c_double(init_canopy_trim)), \ byref(c_double(flush_c)), \ byref(c_double(drop_frac_c)), \ + byref(c_int(leaf_status)), \ byref(c_double(net_daily_n)), \ byref(c_double(net_daily_p)), \ byref(c_double(r_maint_demand))) diff --git a/functional_unit_testing/parteh/f_wrapper_modules/FatesCohortWrapMod.F90 b/functional_unit_testing/parteh/f_wrapper_modules/FatesCohortWrapMod.F90 index 66f52e769e..96fe55397c 100644 --- a/functional_unit_testing/parteh/f_wrapper_modules/FatesCohortWrapMod.F90 +++ b/functional_unit_testing/parteh/f_wrapper_modules/FatesCohortWrapMod.F90 @@ -56,6 +56,7 @@ module FatesCohortWrapMod use PRTAllometricCNPMod, only : acnp_bc_inout_id_netdp use PRTAllometricCNPMod, only : acnp_bc_in_id_ctrim use PRTAllometricCNPMod, only : acnp_bc_in_id_pft + use PRTAllometricCNPMod, only : acnp_bc_in_id_status use PRTAllometricCNPMod, only : acnp_bc_out_id_rootcexude use PRTAllometricCNPMod, only : acnp_bc_out_id_rootnexude use PRTAllometricCNPMod, only : acnp_bc_out_id_rootpexude @@ -80,7 +81,7 @@ module FatesCohortWrapMod integer :: pft ! pft number integer :: parteh_model ! The PARTEH allocation hypothesis used real(r8) :: dbh ! dbh: cm - + integer :: status_coh ! leaf status 1=off, 2=on real(r8) :: canopy_trim ! Trimming function for the canopy real(r8) :: dhdt ! time derivative of height : m/year @@ -129,6 +130,7 @@ subroutine CohortInitAlloc(numcohorts) ccohort%parteh_model = -1 ccohort%pft = -9 ccohort%dbh = -999.9_r8 + ccohort%status_coh = -1 ccohort%canopy_trim = -999.9_r8 ccohort%dhdt = -999.9_r8 ccohort%ddbhdt = -999.9_r8 @@ -311,6 +313,7 @@ subroutine CohortPySet(ipft,hgt_min,canopy_trim) ! Register Input only BC's call ccohort%prt%RegisterBCIn(acnp_bc_in_id_pft,bc_ival = ccohort%pft) call ccohort%prt%RegisterBCIn(acnp_bc_in_id_ctrim,bc_rval = ccohort%canopy_trim) + call ccohort%prt%RegisterBCIn(acnp_bc_in_id_status,bc_ival = ccohort%status_coh) ! Register Output Boundary Conditions call ccohort%prt%RegisterBCOut(acnp_bc_out_id_rootcexude,bc_rval = ccohort%carbon_root_exudate) @@ -328,7 +331,7 @@ end subroutine CohortPySet ! ===================================================================================== - subroutine WrapDailyPRT(ipft,daily_carbon_gain,canopy_trim,flush_c,drop_frac_c, & + 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 ) implicit none @@ -338,6 +341,7 @@ subroutine WrapDailyPRT(ipft,daily_carbon_gain,canopy_trim,flush_c,drop_frac_c, real(r8),intent(in) :: canopy_trim real(r8),intent(in) :: flush_c 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_r_maint_demand @@ -347,15 +351,13 @@ subroutine WrapDailyPRT(ipft,daily_carbon_gain,canopy_trim,flush_c,drop_frac_c, ccohort => cohort_array(ipft) + ccohort%status_coh = leaf_status + ! Zero the rate of change and the turnover arrays call ccohort%prt%ZeroRates() call PRTDeciduousTurnover(ccohort%prt, ipft, leaf_organ , drop_frac_c) - - if(drop_frac_c>nearzero)then - print*,"DCG:",daily_carbon_gain - end if call PRTPhenologyFlush(ccohort%prt, ipft, leaf_organ, flush_c) @@ -414,7 +416,7 @@ subroutine WrapQueryVars(ipft,leaf_area,crown_area,agb,store_c,target_leaf_c) real(r8),parameter :: nplant = 1.0_r8 real(r8),parameter :: site_spread = 1.0_r8 - integer, parameter :: status_coh = 2 + real(r8), parameter, dimension(nclmax) :: canopy_lai = [0.0_r8,0.0_r8,0.0_r8,0.0_r8] integer, parameter :: cl1 = 1 @@ -509,9 +511,6 @@ subroutine WrapQueryDiagnostics(ipft, dbh, & struct_c = ccohort%prt%GetState(organ_id=struct_organ, species_id=all_carbon_species) repro_c = ccohort%prt%GetState(organ_id=repro_organ, species_id=all_carbon_species) - print*,ipft,leaf_c - - leaf_cturn = ccohort%prt%GetTurnover(organ_id=leaf_organ, species_id=all_carbon_species) fnrt_cturn = ccohort%prt%GetTurnover(organ_id=fnrt_organ, species_id=all_carbon_species) sapw_cturn = ccohort%prt%GetTurnover(organ_id=sapw_organ, species_id=all_carbon_species) diff --git a/functional_unit_testing/parteh/py_modules/SyntheticBoundaries.py b/functional_unit_testing/parteh/py_modules/SyntheticBoundaries.py index e5747129ae..e9abd25b4d 100644 --- a/functional_unit_testing/parteh/py_modules/SyntheticBoundaries.py +++ b/functional_unit_testing/parteh/py_modules/SyntheticBoundaries.py @@ -149,14 +149,12 @@ def DeciduousPhenology(doy, target_leaf_c, store_c, phen_type): leaf_off_doy = np.int(366.0 * 0.55) if ( doy==leaf_on_doy): - flush_c = np.minimum(store_c,target_leaf_c * 0.5) else: flush_c = 0.0 if ( doy==leaf_off_doy): drop_frac_c = 1.0 - print("Dropping") else: drop_frac_c = 0.0 @@ -170,9 +168,6 @@ def DeciduousPhenology(doy, target_leaf_c, store_c, phen_type): drop_frac_c = 0.0 leaf_status = 1 - #print("doy {} leaf_on_doy {} leaf_off_doy {} flush_c {} drop_frac_c {}".format(doy,leaf_on_doy,leaf_off_doy,flush_c,drop_frac_c)) - - return flush_c, drop_frac_c, leaf_status diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 225cc818ab..844a0bceb0 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -61,6 +61,13 @@ module EDTypesMod ! 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. + + ! Switches that turn on/off ED dynamics process (names are self explanatory) ! IMPORTANT NOTE!!! THESE SWITCHES ARE EXPERIMENTAL. ! THEY SHOULD CORRECTLY TURN OFF OR ON THE PROCESS, BUT.. THERE ARE VARIOUS diff --git a/parteh/PRTAllometricCarbonMod.F90 b/parteh/PRTAllometricCarbonMod.F90 index 0be4ec57ab..22777a4c2c 100644 --- a/parteh/PRTAllometricCarbonMod.F90 +++ b/parteh/PRTAllometricCarbonMod.F90 @@ -433,12 +433,19 @@ subroutine DailyPRTAC(this) ! or forcefully pay from storage. ! ----------------------------------------------------------------------------------- - leaf_c_demand = max(0.0_r8,(target_leaf_c - leaf_c)) - fnrt_c_demand = max(0.0_r8,(target_fnrt_c - fnrt_c)) + if( EDPftvarcon_inst%evergreen(ipft) ==1 ) then + leaf_c_demand = max(0.0_r8, & + EDPftvarcon_inst%leaf_stor_priority(ipft)*this%variables(leaf_c_id)%turnover(icd)) + else + leaf_c_demand = 0.0_r8 + end if + + fnrt_c_demand = max(0.0_r8, & + EDPftvarcon_inst%leaf_stor_priority(ipft)*this%variables(fnrt_c_id)%turnover(icd)) total_c_demand = leaf_c_demand + fnrt_c_demand - if (total_c_demand> nearzero) then + if (total_c_demand> nearzero ) then ! If we are testing b4b, then we pay this even if we don't have the carbon ! Just don't pay so much carbon that storage+carbon_balance can't pay for it diff --git a/parteh/PRTLossFluxesMod.F90 b/parteh/PRTLossFluxesMod.F90 index b7ea74caed..e2c464197c 100644 --- a/parteh/PRTLossFluxesMod.F90 +++ b/parteh/PRTLossFluxesMod.F90 @@ -298,7 +298,7 @@ subroutine DeciduousTurnoverSimpleRetranslocation(prt,ipft,organ_id,mass_fractio ! ! ALERT: NO CODE IS CURRENTLY IN PLACE TO LIMIT THE AMOUNT OF CARBON OR NUTRIENT ! CAN BE RE-TRANSLOCATED INTO STORAGE. IT IS POSSIBLE THAT THE MAXIMUM IS BEING - ! WAY OVER-SHOT. TO FIX THIS, EACH HYPOTHESIS NEEDS TO HAVE WRAPPER CODE + ! OVER-SHOT. TO FIX THIS, EACH HYPOTHESIS NEEDS TO HAVE WRAPPER CODE ! TO PROVIDE A WAY TO CALCULATE MAXIMUM ALLOWABLE STORAGE. ! ! --------------------------------------------------------------------------------- @@ -397,15 +397,6 @@ subroutine DeciduousTurnoverSimpleRetranslocation(prt,ipft,organ_id,mass_fractio prt%variables(store_var_id)%val(i_pos) = & prt%variables(store_var_id)%val(i_pos) + retranslocated_mass - if(mass_fraction>nearzero)then - print*,"Mass Fraction",mass_fraction - print*,organ_id,num_sp_vars,i_var,prt%variables(i_var)%num_pos,retrans - print*,prt%variables(i_var)%val(i_pos),prt%variables(i_var)%turnover(i_pos) - print*,prt%variables(i_var)%net_art(i_pos) ,prt%variables(store_var_id)%net_art(i_pos) - end if - - - end do end do From a40884f099b1392b65145497c345b654f6e6ae41 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 27 Sep 2018 18:16:54 -0700 Subject: [PATCH 18/52] Lots of debugging of parteh integration. This changeset compiles. --- biogeochem/EDCanopyStructureMod.F90 | 1 + biogeochem/EDCohortDynamicsMod.F90 | 43 ++-- biogeochem/EDLoggingMortalityMod.F90 | 7 +- biogeochem/EDPhysiologyMod.F90 | 8 +- biogeophys/FatesPlantHydraulicsMod.F90 | 29 ++- biogeophys/FatesPlantRespPhotosynthMod.F90 | 36 +-- fire/SFMainMod.F90 | 30 ++- .../parteh/py_modules/SyntheticBoundaries.py | 13 +- main/ChecksBalancesMod.F90 | 11 +- main/EDInitMod.F90 | 2 +- main/EDMainMod.F90 | 17 +- main/EDPftvarcon.F90 | 128 ++++++---- main/EDTypesMod.F90 | 18 +- main/FatesHistoryInterfaceMod.F90 | 236 ++++++++---------- main/FatesInterfaceMod.F90 | 4 +- main/FatesRestartInterfaceMod.F90 | 65 +---- parteh/PRTAllometricCarbonMod.F90 | 3 - parteh/PRTGenericMod.F90 | 63 ++++- 18 files changed, 377 insertions(+), 337 deletions(-) diff --git a/biogeochem/EDCanopyStructureMod.F90 b/biogeochem/EDCanopyStructureMod.F90 index a15ef448d2..05b6fc5d59 100644 --- a/biogeochem/EDCanopyStructureMod.F90 +++ b/biogeochem/EDCanopyStructureMod.F90 @@ -14,6 +14,7 @@ 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 FatesAllometryMod , only : tree_lai use FatesAllometryMod , only : tree_sai use EDtypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type, ncwd diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index 4f6d8cd1c1..b41d6ab9a8 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -188,7 +188,7 @@ subroutine create_cohort(currentSite, patchptr, pft, nn, hite, dbh, bleaf, bfine ! are all initialized. ! ----------------------------------------------------------------------------------- - call ccohort%prt%CheckInitialConditions() + call new_cohort%prt%CheckInitialConditions() @@ -267,27 +267,34 @@ end subroutine create_cohort ! ------------------------------------------------------------------------------------- - subroutine InitPRTCohort(ccohort) + subroutine InitPRTCohort(new_cohort) - ! This subroutine simply allocates and attaches the correct PRT object. - ! No meaningful values to are set here. - - select case(parteh_model) - case (1) - - allocate(callom_prt) - new_cohort%prt => callom_prt - - case DEFAULT - write(fates_log(),*) 'You specified an unknown PRT module' - write(fates_log(),*) 'Aborting' - call endrun(msg=errMsg(sourcefile, __LINE__)) - end select + ! This subroutine simply allocates and attaches the correct PRT object. + ! No meaningful values to are set here. + ! + ! !ARGUMENTS + type(ed_cohort_type), intent(inout), target :: new_cohort + type(callom_prt_vartypes), pointer :: callom_prt - - call ccohort%prt%InitPRTVartype() + select case(hlm_parteh_model) + case (1) + + allocate(callom_prt) + new_cohort%prt => callom_prt + + 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() + + return end subroutine InitPRTCohort !-------------------------------------------------------------------------------------! diff --git a/biogeochem/EDLoggingMortalityMod.F90 b/biogeochem/EDLoggingMortalityMod.F90 index 3d5d7831be..3a83f8d071 100644 --- a/biogeochem/EDLoggingMortalityMod.F90 +++ b/biogeochem/EDLoggingMortalityMod.F90 @@ -45,7 +45,12 @@ module EDLoggingMortalityMod use FatesGlobals , only : fates_log use shr_log_mod , only : errMsg => shr_log_errMsg use FatesPlantHydraulicsMod, only : AccumulateMortalityWaterStorage - + + use PRTGenericMod , only : all_carbon_species + use PRTGenericMod , only : sapw_organ, struct_organ, leaf_organ + use PRTGenericMod , only : fnrt_organ, store_organ, repro_organ + + implicit none private diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 351624c6da..e67f7034b7 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -14,6 +14,7 @@ module EDPhysiologyMod use FatesInterfaceMod, only : numpft use FatesInterfaceMod, only : hlm_use_planthydro use FatesConstantsMod, only : r8 => fates_r8 + use FatesConstantsMod, only : nearzero use EDPftvarcon , only : EDPftvarcon_inst use FatesInterfaceMod, only : bc_in_type use EDCohortDynamicsMod , only : zero_cohort @@ -76,7 +77,6 @@ module EDPhysiologyMod public :: trim_canopy public :: phenology private :: phenology_leafonoff - public :: PlantGrowth public :: recruitment private :: cwd_input private :: cwd_out @@ -997,7 +997,7 @@ subroutine recruitment( currentSite, currentPatch, bc_in ) if (temp_cohort%n > 0.0_r8 )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, + b_leaf, b_fineroot, b_sapwood, b_dead, b_store, & temp_cohort%laimemory, cohortstatus,recruitstatus, temp_cohort%canopy_trim, currentPatch%NCL_p, & currentSite%spread, bc_in) @@ -1089,12 +1089,12 @@ subroutine CWD_Input( currentSite, currentPatch) do c = 1,ncwd currentPatch%cwd_AG_in(c) = currentPatch%cwd_AG_in(c) + & - (sapw_turnover + struct_turnover)/hlm_freq_day * & + (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_turnover + struct_turnover)/hlm_freq_day * & + (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)) enddo diff --git a/biogeophys/FatesPlantHydraulicsMod.F90 b/biogeophys/FatesPlantHydraulicsMod.F90 index 3026ff456a..bf29dfbf32 100644 --- a/biogeophys/FatesPlantHydraulicsMod.F90 +++ b/biogeophys/FatesPlantHydraulicsMod.F90 @@ -75,14 +75,9 @@ module FatesPlantHydraulicsMod use PRTGenericMod, only : carbon12_species use PRTGenericMod, only : nitrogen_species use PRTGenericMod, only : phosphorous_species - use PRTGenericMod, only : leaf_organ - use PRTGenericMod, only : fnrt_organ - use PRTGenericMod, only : sapw_organ - use PRTGenericMod, only : store_organ - use PRTGenericMod, only : repro_organ - use PRTGenericMod, only : struct_organ + use PRTGenericMod, only : leaf_organ, fnrt_organ, sapw_organ + use PRTGenericMod, only : store_organ, repro_organ, struct_organ use PRTGenericMod, only : carbon12_species - use PRTGenericMod, only : SetState use clm_time_manager , only : get_step_size, get_nstep @@ -450,8 +445,8 @@ subroutine updateSizeDepTreeHydProps(currentSite,cc_p,bc_in) ccohort_hydr%z_node_aroot(1:nlevsoi_hyd) = -bc_in%z_sisl(1:nlevsoi_hyd) - ccohort_hydr%l_aroot_tot = cCohort%br*C2B*EDPftvarcon_inst%hydr_srl(FT) - !ccohort_hydr%v_aroot_tot = cCohort%br/EDecophyscon%ccontent(FT)/EDecophyscon%rootdens(FT) + ccohort_hydr%l_aroot_tot = fnrt_c*C2B*EDPftvarcon_inst%hydr_srl(FT) + !ccohort_hydr%v_aroot_tot = fnrt_c/EDecophyscon%ccontent(FT)/EDecophyscon%rootdens(FT) ccohort_hydr%v_aroot_tot = pi_const*(EDPftvarcon_inst%hydr_rs2(FT)**2._r8)*ccohort_hydr%l_aroot_tot !ccohort_hydr%l_aroot_tot = ccohort_hydr%v_aroot_tot/(pi_const*EDecophyscon%rs2(FT)**2) if(nlevsoi_hyd == 1) then @@ -913,7 +908,10 @@ subroutine UpdateH2OVeg(nsites,sites,bc_out) currentCohort=>currentPatch%tallest do while(associated(currentCohort)) balive_patch = balive_patch + & - (currentCohort%bl + currentCohort%bsw + currentCohort%br ) * currentCohort%n + (currentCohort%prt%GetState(fnrt_organ, all_carbon_species) + & + currentCohort%prt%GetState(sapw_organ, all_carbon_species) + & + currentCohort%prt%GetState(leaf_organ, all_carbon_species)) * currentCohort%n + currentCohort => currentCohort%shorter enddo !cohort @@ -1318,7 +1316,9 @@ subroutine BTranForHLMDiagnosticsFromCohortHydr(nsites,sites,bc_out) ccohort=>cpatch%tallest do while(associated(ccohort)) balive_patch = balive_patch + & - (cCohort%bl + cCohort%bsw + cCohort%br) * ccohort%n + (cCohort%prt%GetState(fnrt_organ, all_carbon_species) + & + cCohort%prt%GetState(sapw_organ, all_carbon_species) + & + cCohort%prt%GetState(leaf_organ, all_carbon_species))* ccohort%n ccohort => ccohort%shorter enddo !cohort @@ -1326,8 +1326,11 @@ subroutine BTranForHLMDiagnosticsFromCohortHydr(nsites,sites,bc_out) ccohort=>cpatch%tallest do while(associated(ccohort)) bc_out(s)%btran_pa(ifp) = bc_out(s)%btran_pa(ifp) + & - ccohort%co_hydr%btran(1) * (cCohort%bl + cCohort%bsw + cCohort%br) * & - ccohort%n / balive_patch + ccohort%co_hydr%btran(1) * & + (cCohort%prt%GetState(fnrt_organ, all_carbon_species) + & + cCohort%prt%GetState(sapw_organ, all_carbon_species) + & + cCohort%prt%GetState(leaf_organ, all_carbon_species)) * & + ccohort%n / balive_patch ccohort => ccohort%shorter enddo !cohort cpatch => cpatch%younger diff --git a/biogeophys/FatesPlantRespPhotosynthMod.F90 b/biogeophys/FatesPlantRespPhotosynthMod.F90 index 3a9d25b179..4d3e2323a9 100644 --- a/biogeophys/FatesPlantRespPhotosynthMod.F90 +++ b/biogeophys/FatesPlantRespPhotosynthMod.F90 @@ -25,6 +25,7 @@ module FATESPlantRespPhotosynthMod use FatesConstantsMod, only : r8 => fates_r8 use FatesConstantsMod, only : itrue use FatesInterfaceMod, only : hlm_use_planthydro + use FatesInterfaceMod, only : hlm_parteh_model use FatesInterfaceMod, only : numpft use EDTypesMod, only : maxpft use EDTypesMod, only : nlevleaf @@ -173,6 +174,8 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) real(r8) :: sapw_c ! Sapwood carbon (kgC/plant) real(r8) :: fnrt_c ! Fine root carbon (kgC/plant) real(r8) :: fnrt_n ! Fine root nitrogen content (kgN/plant) + real(r8) :: leaf_c ! Leaf carbon (kgC/plant) + real(r8) :: leaf_n ! leaf nitrogen content (kgN/plant) real(r8) :: g_sb_leaves ! Mean combined (stomata+boundary layer) leaf conductance [m/s] ! over all of the patch's leaves. The "sb" refers to the combined ! "s"tomatal and "b"oundary layer. @@ -190,6 +193,7 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) real(r8) :: check_elai ! This is a check on the effective LAI that is calculated ! over each cohort x layer. real(r8) :: cohort_eleaf_area ! This is the effective leaf area [m2] reported by each cohort + real(r8) :: lnc_top ! Leaf nitrogen content per unit area at canopy top [gN/m2] real(r8) :: lmr25top ! canopy top leaf maint resp rate at 25C ! for this plant or pft (umol CO2/m**2/s) real(r8) :: leaf_inc ! LAI-only portion of the vegetation increment of dinc_ed @@ -199,6 +203,7 @@ 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 + ! ----------------------------------------------------------------------------------- ! Keeping these two definitions in case they need to be added later @@ -432,21 +437,21 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) ! Then scale this value at the top of the canopy for canopy depth ! Leaf nitrogen concentration at the top of the canopy (g N leaf / m**2 leaf) - select case(new_cohort%parteh_model) + select case(hlm_parteh_model) case (1) - lnc = EDPftvarcon_inst%prt_nitr_stoich_p1(ipft,leaf_organ)/slatop(ft) + lnc_top = EDPftvarcon_inst%prt_nitr_stoich_p1(ft,leaf_organ)/slatop(ft) -! case (2) -! -! leaf_c = currentCohort%prt%GetState(leaf_organ, carbon12_species) -! leaf_n = currentCohort%prt%GetState(leaf_organ, nitrogen_species) -! lnc = leaf_c / (slatop * leaf_n ) + case (2) + + leaf_c = currentCohort%prt%GetState(leaf_organ, carbon12_species) + leaf_n = currentCohort%prt%GetState(leaf_organ, nitrogen_species) + lnc_top = leaf_n / (slatop(ft) * leaf_c ) end select lmr25top = 2.525e-6_r8 * (1.5_r8 ** ((25._r8 - 20._r8)/10._r8)) - lmr25top = lmr25top * lnc / (umolC_to_kgC * g_per_kg) + lmr25top = lmr25top * lnc_top / (umolC_to_kgC * g_per_kg) ! Part VII: Calculate dark respiration (leaf maintenance) for this layer @@ -575,20 +580,23 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) ! Units are in (kgN/plant) ! ------------------------------------------------------------------ - select case(parteh_model) + select case(hlm_parteh_model) case (1) - sapw_c = currentCohort%prt%GetState(sapw_organ, all_carbon_species) - fnrt_c = currentCohort%prt%GetState(fnrt_organ, all_carbon_species) + sapw_c = currentCohort%prt%GetState(sapw_organ, carbon12_species) + fnrt_c = currentCohort%prt%GetState(fnrt_organ, carbon12_species) live_stem_n = EDPftvarcon_inst%allom_agb_frac(currentCohort%pft) * & - sapw_c * EDPftvarcon_inst%prt_nitr_stoich_p1(ipft,sapw_organ) + sapw_c * EDPftvarcon_inst%prt_nitr_stoich_p1(ft,sapw_organ) live_croot_n = (1.0_r8-EDPftvarcon_inst%allom_agb_frac(currentCohort%pft)) * & - sapw_c * EDPftvarcon_inst%prt_nitr_stoich_p1(ipft,sapw_organ) + sapw_c * EDPftvarcon_inst%prt_nitr_stoich_p1(ft,sapw_organ) - fnrt_n = fnrt_c * EDPftvarcon_inst%prt_nitr_stoich_p1(ipft,fnrt_organ) + fnrt_n = fnrt_c * EDPftvarcon_inst%prt_nitr_stoich_p1(ft,fnrt_organ) + case default + + end select !------------------------------------------------------------------------------ diff --git a/fire/SFMainMod.F90 b/fire/SFMainMod.F90 index fa7784e473..d294d1410c 100644 --- a/fire/SFMainMod.F90 +++ b/fire/SFMainMod.F90 @@ -829,8 +829,12 @@ subroutine crown_scorching ( currentSite ) type(ed_patch_type), pointer :: currentPatch type(ed_cohort_type), pointer :: currentCohort - real f_ag_bmass !fraction of a tree cohort's above-ground biomass as a proportion of total patch ag tree biomass. - real tree_ag_biomass !total amount of above-ground tree biomass in patch. kgC/m2 + 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] + currentPatch => currentSite%oldest_patch; do while(associated(currentPatch)) @@ -841,11 +845,14 @@ subroutine crown_scorching ( currentSite ) 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_species) + sapw_c = currentCohort%prt%GetState(sapw_organ, all_carbon_species) + struct_c = currentCohort%prt%GetState(struct_organ, all_carbon_species) + tree_ag_biomass = tree_ag_biomass + & - (currentCohort%prt%GetState(leaf_organ, all_carbon_species) + & - EDPftvarcon_inst%allom_agb_frac(currentCohort%pft) * & - (currentCohort%prt%GetState(sapw_organ, all_carbon_species) + & - currentCohort%prt%GetState(struct_organ, all_carbon_species) ))*currentCohort%n + currentCohort%n * (leaf_c + & + EDPftvarcon_inst%allom_agb_frac(currentCohort%pft)*(sapw_c + struct_c)) endif !trees only currentCohort=>currentCohort%shorter; @@ -861,12 +868,13 @@ subroutine crown_scorching ( currentSite ) if (EDPftvarcon_inst%woody(currentCohort%pft) == 1 & .and. (tree_ag_biomass > 0.0_r8)) then !trees only - f_ag_biomass = (currentCohort%prt%GetState(leaf_organ, all_carbon_species) + & - EDPftvarcon_inst%allom_agb_frac(currentCohort%pft) * & - (currentCohort%prt%GetState(sapw_organ, all_carbon_species) + & - currentCohort%prt%GetState(struct_organ, all_carbon_species) ))*currentCohort%n + leaf_c = currentCohort%prt%GetState(leaf_organ, all_carbon_species) + sapw_c = currentCohort%prt%GetState(sapw_organ, all_carbon_species) + struct_c = currentCohort%prt%GetState(struct_organ, all_carbon_species) - f_ag_bmass = f_ag_biomass/tree_ag_biomass + 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 diff --git a/functional_unit_testing/parteh/py_modules/SyntheticBoundaries.py b/functional_unit_testing/parteh/py_modules/SyntheticBoundaries.py index e9abd25b4d..27f6ed5edc 100644 --- a/functional_unit_testing/parteh/py_modules/SyntheticBoundaries.py +++ b/functional_unit_testing/parteh/py_modules/SyntheticBoundaries.py @@ -65,7 +65,7 @@ def DailyCFromCArea(presc_npp_p1,c_area,phen_type,leaf_status): # presc_npp_p1, npp generated per crown area [kgC/m2/yr] # ----------------------------------------------------------------------------------- - if( (phen_type == 1) or (leaf_status ==1)): + if( (phen_type == 1) or (leaf_status ==2)): NetDailyC = presc_npp_p1 * c_area / day_per_year else: NetDailyC = 0.0 @@ -89,7 +89,7 @@ def DailyCNPFromCArea(presc_npp_p1,presc_nflux_p1, \ # presc_pflux_p1, Phosphorous flux per crown area [kgP/m2/yr] # ----------------------------------------------------------------------------------- - if( (phen_type == 1) or (leaf_status ==1)): + if( (phen_type == 1) or (leaf_status ==2)): NetDailyC = presc_npp_p1 * c_area / day_per_year NetDailyN = presc_nflux_p1 * c_area / day_per_year NetDailyP = presc_pflux_p1 * c_area / day_per_year @@ -125,12 +125,13 @@ def DailyCNPFromStorageSinWave(doy,store_c,presc_npp_p1, \ NetDailyC = (presc_npp_amp * sin_func * presc_npp_p1 + presc_npp_p1) * c_area/day_per_year # This is a fail-safe, for large negatives, cant be larger than storage + if (NetDailyC < 0.0): NetDailyC = -np.minimum(-NetDailyC,0.98* np.float(store_c)) #print("sin_func: {}, NetDailyC: {}, store_c: {}, c_area :{}".format(sin_func,NetDailyC,store_c,c_area)) - if( (phen_type == 1) or (leaf_status ==1)): + if( (phen_type == 1) or (leaf_status ==2)): NetDailyN = presc_nflux_p1 * c_area / day_per_year NetDailyP = presc_pflux_p1 * c_area / day_per_year else: @@ -159,14 +160,14 @@ def DeciduousPhenology(doy, target_leaf_c, store_c, phen_type): drop_frac_c = 0.0 if(doy>=leaf_on_doy and doy 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 FatesConstants, only : g_per_kg - + 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_species use PRTGenericMod, only : carbon12_species use PRTGenericMod, only : nitrogen_species diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index fd68b06198..f25b45409c 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -429,7 +429,7 @@ subroutine init_cohorts( site_in, patch_in, bc_in) 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, + b_leaf, b_fineroot, b_sapwood, b_dead, b_store, & temp_cohort%laimemory, cstatus, rstatus, temp_cohort%canopy_trim, 1, site_in%spread, bc_in) diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index c93751b762..9874e93071 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -15,6 +15,7 @@ module EDMainMod use FatesInterfaceMod , only : hlm_current_day use FatesInterfaceMod , only : hlm_use_planthydro use FatesInterfaceMod , only : hlm_reference_date + use FatesInterfaceMod , only : hlm_use_ed_prescribed_phys use FatesInterfaceMod , only : hlm_use_ed_st3 use FatesInterfaceMod , only : bc_in_type use FatesInterfaceMod , only : hlm_masterproc @@ -27,7 +28,6 @@ module EDMainMod use EDPatchDynamicsMod , only : fuse_patches use EDPatchDynamicsMod , only : spawn_patches use EDPatchDynamicsMod , only : terminate_patches - use EDPhysiologyMod , only : PlantGrowth use EDPhysiologyMod , only : non_canopy_derivs use EDPhysiologyMod , only : phenology use EDPhysiologyMod , only : recruitment @@ -67,6 +67,8 @@ module EDMainMod use PRTGenericMod, only : carbon12_species use PRTGenericMod, only : SetState + use EDPftvarcon, only : EDPftvarcon_inst + ! CIME Globals use shr_log_mod , only : errMsg => shr_log_errMsg use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) @@ -260,6 +262,7 @@ subroutine ed_integrate_state_variables(currentSite, bc_in ) 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] + !----------------------------------------------------------------------- small_no = 0.0000000000_r8 ! Obviously, this is arbitrary. RF - changed to zero @@ -286,6 +289,8 @@ subroutine ed_integrate_state_variables(currentSite, bc_in ) do while(associated(currentCohort)) + ft = currentCohort%pft + ! Calculate the mortality derivatives call Mortality_Derivative( currentSite, currentCohort, bc_in ) @@ -310,12 +315,12 @@ subroutine ed_integrate_state_variables(currentSite, bc_in ) if (hlm_use_ed_prescribed_phys .eq. itrue) then if (currentCohort%canopy_layer .eq. 1) then - currentCohort%npp_acc_hold = EDPftvarcon_inst%prescribed_npp_canopy(ipft) & + 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 else - currentCohort%npp_acc_hold = EDPftvarcon_inst%prescribed_npp_understory(ipft) & + 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 @@ -335,10 +340,10 @@ subroutine ed_integrate_state_variables(currentSite, bc_in ) call SetState(currentCohort%prt,repro_organ,carbon12_species,0.0_r8) ! This cohort has grown, it is no longer "new" - currentCohort%is_new = .false. + currentCohort%isnew = .false. ! Update the plant height (if it has grown) - call h_allom(currentCohort%dbh,currentCohort%pft,currentCohort%hite) + call h_allom(currentCohort%dbh,ft,currentCohort%hite) currentCohort%dhdt = (currentCohort%hite-hite_old)/hlm_freq_day currentCohort%ddbhdt = (currentCohort%dbh-dbh_old)/hlm_freq_day @@ -594,7 +599,7 @@ subroutine ed_total_balance_check (currentSite, call_index ) currentCohort => currentPatch%tallest do while(associated(currentCohort)) write(fates_log(),*) 'structure: ',currentCohort%prt%GetState(struct_organ,all_carbon_species) - write(fates_log(),*) 'storage: ',currentCohort%prt%GetState(storage_organ,all_carbon_species) + write(fates_log(),*) 'storage: ',currentCohort%prt%GetState(store_organ,all_carbon_species) write(fates_log(),*) 'N plant: ',currentCohort%n currentCohort => currentCohort%shorter; enddo !end cohort loop diff --git a/main/EDPftvarcon.F90 b/main/EDPftvarcon.F90 index 271e8db79a..b56dd8a1af 100644 --- a/main/EDPftvarcon.F90 +++ b/main/EDPftvarcon.F90 @@ -8,9 +8,13 @@ module EDPftvarcon ! !USES: use EDTypesMod , only : maxSWb, ivis, inir use FatesConstantsMod, only : r8 => fates_r8 + use FatesConstantsMod, only : nearzero use FatesGlobals, only : fates_log use FatesGlobals, only : endrun => fates_endrun + use PRTGenericMod, only : leaf_organ, fnrt_organ, store_organ + use PRTGenericMod, only : sapw_organ, struct_organ, repro_organ + ! CIME Globals use shr_log_mod , only : errMsg => shr_log_errMsg @@ -70,7 +74,7 @@ module EDPftvarcon real(r8), allocatable :: smpso(:) real(r8), allocatable :: smpsc(:) real(r8), allocatable :: grperc(:) ! Growth respiration per unit Carbon gained - ! ONLY parteh_mode == 1 [kg/kg] + ! ONLY parteh_model == 1 [kg/kg] real(r8), allocatable :: maintresp_reduction_curvature(:) ! curvature of MR reduction as f(carbon storage), ! 1=linear, 0=very curved real(r8), allocatable :: maintresp_reduction_intercept(:) ! intercept of MR reduction as f(carbon storage), @@ -1420,7 +1424,7 @@ subroutine Register_PFT_prt_organs(this, fates_params) dimension_names=dim_names, lower_bounds=dim_lower_bound) - end subroutine Register_PFT_prt_organs + end subroutine Register_PFT_prt_organs ! ===================================================================================== @@ -1472,7 +1476,7 @@ subroutine Receive_PFT_prt_organs(this, fates_params) call fates_params%RetreiveParameterAllocate(name=name, & data=this%turnover_phos_retrans_p1) - end subroutine Receive_PFT_hydr_organs + end subroutine Receive_PFT_prt_organs ! ----------------------------------------------------------------------- @@ -1741,7 +1745,7 @@ end subroutine FatesReportPFTParams ! ===================================================================================== - subroutine FatesCheckParams(is_master) + subroutine FatesCheckParams(is_master, parteh_model) ! ---------------------------------------------------------------------------------- ! @@ -1756,14 +1760,34 @@ subroutine FatesCheckParams(is_master) ! Argument logical, intent(in) :: is_master ! Only log if this is the master proc - + integer, intent(in) :: parteh_model ! argument for nl flag hlm_parteh_model + character(len=32),parameter :: fmt0 = '(a,100(F12.4,1X))' integer :: npft,ipft npft = size(EDPftvarcon_inst%pft_used,1) + if(.not.is_master) return + + + if (parteh_model .eq. 2) then + write(fates_log(),*) 'FATES Plant Allocation and Reactive Transport' + write(fates_log(),*) 'with flexible target stoichiometry for NP and' + write(fates_log(),*) 'allometrically constrianed C is still under development' + write(fates_log(),*) 'Aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + + elseif (parteh_model .ne. 1) then + + write(fates_log(),*) 'FATES Plant Allocation and Reactive Transport has' + write(fates_log(),*) 'only 1 module supported, allometric carbon only.' + write(fates_log(),*) 'fates_parteh_model must be set to 1 in the namelist' + write(fates_log(),*) 'Aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + do ipft = 1,npft @@ -1885,10 +1909,11 @@ subroutine FatesCheckParams(is_master) ! Check re-translocations ! Seems reasonable to assume that sapwood, structure and reproduction - ! should not be re-translocating mass upon turnover + ! should not be re-translocating mass upon turnover. + ! Note to advanced users. Feel free to remove these checks... ! ------------------------------------------------------------------- - if ((EDPftvarcon_inst%turnover_carb_retrans_p1(ipft,repro_organ) > nearzero) .or. & + if ( (EDPftvarcon_inst%turnover_carb_retrans_p1(ipft,repro_organ) > nearzero) .or. & (EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,repro_organ) > nearzero) .or. & (EDPftvarcon_inst%turnover_phos_retrans_p1(ipft,repro_organ) > nearzero) ) then write(fates_log(),*) ' Retranslocation of reproductive tissues should be zero.' @@ -1925,73 +1950,76 @@ subroutine FatesCheckParams(is_master) end if ! Leaf retranslocation should be between 0 and 1 - if ((EDPftvarcon_inst%turnover_carb_retrans_p1(ipft,leaf_organ) > 1.0_r8) .or. & - ((EDPftvarcon_inst%turnover_carb_retrans_p1(ipft,leaf_organ) < 0.0_r8)) then + if ( (EDPftvarcon_inst%turnover_carb_retrans_p1(ipft,leaf_organ) > 1.0_r8) .or. & + (EDPftvarcon_inst%turnover_carb_retrans_p1(ipft,leaf_organ) < 0.0_r8) ) then write(fates_log(),*) ' Retranslocation of leaf tissues should be between 0 and 1.' write(fates_log(),*) ' PFT#: ',ipft write(fates_log(),*) ' carbon: ',EDPftvarcon_inst%turnover_carb_retrans_p1(ipft,leaf_organ) write(fates_log(),*) ' Aborting' call endrun(msg=errMsg(sourcefile, __LINE__)) end if - if ((hlm_parteh_mode .eq. 2) .and. & - ((EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,leaf_organ) > 1.0_r8) .or. & - (EDPftvarcon_inst%turnover_phos_retrans_p1(ipft,leaf_organ) > 1.0_r8) .or. & - (EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,leaf_organ) < 0.0_r8) .or. & - (EDPftvarcon_inst%turnover_phos_retrans_p1(ipft,leaf_organ) < 0.0_r8))) then - write(fates_log(),*) ' Retranslocation of leaf tissues should be between 0 and 1.' - write(fates_log(),*) ' PFT#: ',ipft - write(fates_log(),*) ' nitr: ',EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,leaf_organ) - write(fates_log(),*) ' phos: ',EDPftvarcon_inst%turnover_phos_retrans_p1(ipft,leaf_organ) - write(fates_log(),*) ' Aborting' - call endrun(msg=errMsg(sourcefile, __LINE__)) + if (parteh_model .eq. 2) then + if ((EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,leaf_organ) > 1.0_r8) .or. & + (EDPftvarcon_inst%turnover_phos_retrans_p1(ipft,leaf_organ) > 1.0_r8) .or. & + (EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,leaf_organ) < 0.0_r8) .or. & + (EDPftvarcon_inst%turnover_phos_retrans_p1(ipft,leaf_organ) < 0.0_r8)) then + write(fates_log(),*) ' Retranslocation of leaf tissues should be between 0 and 1.' + write(fates_log(),*) ' PFT#: ',ipft + write(fates_log(),*) ' nitr: ',EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,leaf_organ) + write(fates_log(),*) ' phos: ',EDPftvarcon_inst%turnover_phos_retrans_p1(ipft,leaf_organ) + write(fates_log(),*) ' Aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if end if ! Fineroot retranslocation should be between 0-1 - if ((EDPftvarcon_inst%turnover_carb_retrans_p1(ipft,fnrt_organ) > 1.0_r8) .or. & - ((EDPftvarcon_inst%turnover_carb_retrans_p1(ipft,fnrt_organ) < 0.0_r8)) then + if ((EDPftvarcon_inst%turnover_carb_retrans_p1(ipft,fnrt_organ) > 1.0_r8) .or. & + (EDPftvarcon_inst%turnover_carb_retrans_p1(ipft,fnrt_organ) < 0.0_r8)) then write(fates_log(),*) ' Retranslocation of leaf tissues should be between 0 and 1.' write(fates_log(),*) ' PFT#: ',ipft write(fates_log(),*) ' carbon: ',EDPftvarcon_inst%turnover_carb_retrans_p1(ipft,fnrt_organ) write(fates_log(),*) ' Aborting' call endrun(msg=errMsg(sourcefile, __LINE__)) end if - if ((hlm_parteh_mode .eq. 2) .and. & - ((EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,fnrt_organ) > 1.0_r8) .or. & - (EDPftvarcon_inst%turnover_phos_retrans_p1(ipft,fnrt_organ) > 1.0_r8) .or. & - (EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,fnrt_organ) < 0.0_r8) .or. & - (EDPftvarcon_inst%turnover_phos_retrans_p1(ipft,fnrt_organ) < 0.0_r8))) then - write(fates_log(),*) ' Retranslocation of leaf tissues should be between 0 and 1.' - write(fates_log(),*) ' PFT#: ',ipft - write(fates_log(),*) ' nitr: ',EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,fnrt_organ) - write(fates_log(),*) ' phos: ',EDPftvarcon_inst%turnover_phos_retrans_p1(ipft,fnrt_organ) - write(fates_log(),*) ' Aborting' - call endrun(msg=errMsg(sourcefile, __LINE__)) + if (parteh_model .eq. 2) then + if ((EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,fnrt_organ) > 1.0_r8) .or. & + (EDPftvarcon_inst%turnover_phos_retrans_p1(ipft,fnrt_organ) > 1.0_r8) .or. & + (EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,fnrt_organ) < 0.0_r8) .or. & + (EDPftvarcon_inst%turnover_phos_retrans_p1(ipft,fnrt_organ) < 0.0_r8)) then + write(fates_log(),*) ' Retranslocation of leaf tissues should be between 0 and 1.' + write(fates_log(),*) ' PFT#: ',ipft + write(fates_log(),*) ' nitr: ',EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,fnrt_organ) + write(fates_log(),*) ' phos: ',EDPftvarcon_inst%turnover_phos_retrans_p1(ipft,fnrt_organ) + write(fates_log(),*) ' Aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if end if ! Storage retranslocation should be between 0-1 (storage retrans seems weird, but who knows) if ((EDPftvarcon_inst%turnover_carb_retrans_p1(ipft,store_organ) > 1.0_r8) .or. & - ((EDPftvarcon_inst%turnover_carb_retrans_p1(ipft,store_organ) < 0.0_r8)) then + (EDPftvarcon_inst%turnover_carb_retrans_p1(ipft,store_organ) < 0.0_r8)) then write(fates_log(),*) ' Retranslocation of leaf tissues should be between 0 and 1.' write(fates_log(),*) ' PFT#: ',ipft write(fates_log(),*) ' carbon: ',EDPftvarcon_inst%turnover_carb_retrans_p1(ipft,store_organ) write(fates_log(),*) ' Aborting' call endrun(msg=errMsg(sourcefile, __LINE__)) end if - if ((hlm_parteh_mode .eq. 2) .and. & - ((EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,store_organ) > 1.0_r8) .or. & - (EDPftvarcon_inst%turnover_phos_retrans_p1(ipft,store_organ) > 1.0_r8) .or. & - (EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,store_organ) < 0.0_r8) .or. & - (EDPftvarcon_inst%turnover_phos_retrans_p1(ipft,store_organ) < 0.0_r8))) then - write(fates_log(),*) ' Retranslocation of leaf tissues should be between 0 and 1.' - write(fates_log(),*) ' PFT#: ',ipft - write(fates_log(),*) ' nitr: ',EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,store_organ) - write(fates_log(),*) ' phos: ',EDPftvarcon_inst%turnover_phos_retrans_p1(ipft,store_organ) - write(fates_log(),*) ' Aborting' - call endrun(msg=errMsg(sourcefile, __LINE__)) + if (parteh_model .eq. 2) then + if ((EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,store_organ) > 1.0_r8) .or. & + (EDPftvarcon_inst%turnover_phos_retrans_p1(ipft,store_organ) > 1.0_r8) .or. & + (EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,store_organ) < 0.0_r8) .or. & + (EDPftvarcon_inst%turnover_phos_retrans_p1(ipft,store_organ) < 0.0_r8)) then + write(fates_log(),*) ' Retranslocation of leaf tissues should be between 0 and 1.' + write(fates_log(),*) ' PFT#: ',ipft + write(fates_log(),*) ' nitr: ',EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,store_organ) + write(fates_log(),*) ' phos: ',EDPftvarcon_inst%turnover_phos_retrans_p1(ipft,store_organ) + write(fates_log(),*) ' Aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if end if ! Growth respiration - if (hlm_parteh_mode .eq. 1) then + if (parteh_model .eq. 1) then if ( ( EDPftvarcon_inst%grperc(ipft) < 0.0_r8) .or. & ( EDPftvarcon_inst%grperc(ipft) > 1.0_r8 ) ) then write(fates_log(),*) ' PFT#: ',ipft @@ -1999,7 +2027,7 @@ subroutine FatesCheckParams(is_master) write(fates_log(),*) ' Aborting' call endrun(msg=errMsg(sourcefile, __LINE__)) end if - elseif(hlm_parteh_mode .eq. 2) then + elseif(parteh_model .eq. 2) then if ( ( any(EDPftvarcon_inst%prt_unit_gr_resp(ipft,:) < 0.0_r8)) .or. & ( any(EDPftvarcon_inst%prt_unit_gr_resp(ipft,:) >= 1.0_r8)) ) then write(fates_log(),*) ' PFT#: ',ipft @@ -2023,7 +2051,7 @@ subroutine FatesCheckParams(is_master) end if ! Stoichiometric Ratios - if (hlm_parteh_mode .eq. 2) then + if (parteh_model .eq. 2) then if ( (any(EDPftvarcon_inst%prt_phos_stoich_p1(ipft,:) < 0.0_r8)) .or. & (any(EDPftvarcon_inst%prt_phos_stoich_p1(ipft,:) >= 1.0_r8)) .or. & (any(EDPftvarcon_inst%prt_phos_stoich_p2(ipft,:) < 0.0_r8)) .or. & @@ -2037,7 +2065,7 @@ subroutine FatesCheckParams(is_master) end if end if - if (hlm_parteh_mode .eq. 1) then + if (parteh_model .eq. 1) then if (any(EDPftvarcon_inst%prt_alloc_priority(ipft,:) .ne. 0)) then write(fates_log(),*) ' PFT#: ',ipft write(fates_log(),*) ' Allocation priorities should be 0 for H1' @@ -2045,7 +2073,7 @@ subroutine FatesCheckParams(is_master) write(fates_log(),*) ' Aborting' call endrun(msg=errMsg(sourcefile, __LINE__)) end if - elseif (hlm_parteh_mode .eq. 2) then + elseif (parteh_model .eq. 2) then if ( any(EDPftvarcon_inst%prt_alloc_priority(ipft,:) < 0) .or. & any(EDPftvarcon_inst%prt_alloc_priority(ipft,:) > 6) ) then write(fates_log(),*) ' PFT#: ',ipft diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 844a0bceb0..98973dff8e 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -6,6 +6,9 @@ module EDTypesMod 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_species implicit none save @@ -281,11 +284,7 @@ module EDTypesMod ! Hydraulics type(ed_cohort_hydr_type), pointer :: co_hydr ! All cohort hydraulics data, see FatesHydraulicsMemMod.F90 - contains - - procedure, public :: b_total - - end type ed_cohort_type + end type ed_cohort_type @@ -481,7 +480,6 @@ module EDTypesMod ! PLANT HYDRAULICS (not currently used in hydraulics RGK 03-2018) ! type(ed_patch_hydr_type) , pointer :: pa_hydr ! All patch hydraulics data, see FatesHydraulicsMemMod.F90 - contains end type ed_patch_type @@ -612,7 +610,7 @@ module EDTypesMod end type ed_site_type - + contains ! ===================================================================================== @@ -787,12 +785,6 @@ subroutine dump_cohort(ccohort) write(fates_log(),*) 'co%livestem_mr = ', ccohort%livestem_mr write(fates_log(),*) 'co%livecroot_mr = ', ccohort%livecroot_mr write(fates_log(),*) 'co%froot_mr = ', ccohort%froot_mr - write(fates_log(),*) 'co%md = ', ccohort%md - write(fates_log(),*) 'co%leaf_md = ', ccohort%leaf_md - write(fates_log(),*) 'co%root_md = ', ccohort%root_md - write(fates_log(),*) 'co%bstore_md = ', ccohort%bstore_md - write(fates_log(),*) 'co%bdead_md = ', ccohort%bdead_md - write(fates_log(),*) 'co%bsw_md = ', ccohort%bsw_md write(fates_log(),*) 'co%dmort = ', ccohort%dmort write(fates_log(),*) 'co%seed_prod = ', ccohort%seed_prod write(fates_log(),*) 'co%treelai = ', ccohort%treelai diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 7497d53673..2b39dd6db2 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -16,6 +16,7 @@ module FatesHistoryInterfaceMod use FatesInterfaceMod , only : hlm_use_planthydro use FatesInterfaceMod , only : hlm_use_ed_st3 use FatesInterfaceMod , only : numpft + use FatesInterfaceMod , only : hlm_freq_day use EDParamsMod , only : ED_val_comp_excln use FatesInterfaceMod , only : nlevsclass, nlevage use FatesInterfaceMod , only : nlevheight @@ -33,6 +34,11 @@ module FatesHistoryInterfaceMod use FatesConstantsMod , only : days_per_year use FatesConstantsMod , only : years_per_day + use PRTGenericMod , only : leaf_organ, fnrt_organ, sapw_organ + use PRTGenericMod , only : struct_organ, store_organ, repro_organ + use PRTGenericMod , only : all_carbon_species + + implicit none ! These variables hold the index of the history output structure so we don't @@ -239,10 +245,6 @@ module FatesHistoryInterfaceMod 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_dbalivedt_canopy_si_scls - integer, private :: ih_dbdeaddt_canopy_si_scls - integer, private :: ih_dbstoredt_canopy_si_scls - integer, private :: ih_storage_flux_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 @@ -263,10 +265,6 @@ module FatesHistoryInterfaceMod 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_dbalivedt_understory_si_scls - integer, private :: ih_dbdeaddt_understory_si_scls - integer, private :: ih_dbstoredt_understory_si_scls - integer, private :: ih_storage_flux_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 @@ -1306,6 +1304,27 @@ subroutine update_history_dyn(this,nc,nsites,sites) real(r8) :: frac_canopy_in_bin ! fraction of a leaf's canopy that is within a given height bin real(r8) :: binbottom,bintop ! edges of height bins + ! The following are all carbon states, turnover and net allocation flux variables + ! the organs of relevance should be self explanatory + real(r8) :: sapw_c + real(r8) :: struct_c + real(r8) :: leaf_c + real(r8) :: fnrt_c + real(r8) :: store_c + real(r8) :: alive_c + real(r8) :: total_c + real(r8) :: sapw_c_turnover + real(r8) :: store_c_turnover + real(r8) :: leaf_c_turnover + real(r8) :: fnrt_c_turnover + real(r8) :: struct_c_turnover + real(r8) :: sapw_c_net_art + real(r8) :: store_c_net_art + real(r8) :: leaf_c_net_art + real(r8) :: fnrt_c_net_art + real(r8) :: struct_c_net_art + real(r8) :: repro_c_net_art + type(ed_patch_type),pointer :: cpatch type(ed_cohort_type),pointer :: ccohort @@ -1437,10 +1456,6 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_bdead_md_canopy_si_scls => this%hvars(ih_bdead_md_canopy_si_scls)%r82d, & hio_bstore_md_canopy_si_scls => this%hvars(ih_bstore_md_canopy_si_scls)%r82d, & hio_seed_prod_canopy_si_scls => this%hvars(ih_seed_prod_canopy_si_scls)%r82d, & - hio_dbalivedt_canopy_si_scls => this%hvars(ih_dbalivedt_canopy_si_scls)%r82d, & - hio_dbdeaddt_canopy_si_scls => this%hvars(ih_dbdeaddt_canopy_si_scls)%r82d, & - hio_dbstoredt_canopy_si_scls => this%hvars(ih_dbstoredt_canopy_si_scls)%r82d, & - hio_storage_flux_canopy_si_scls => this%hvars(ih_storage_flux_canopy_si_scls)%r82d, & hio_npp_leaf_canopy_si_scls => this%hvars(ih_npp_leaf_canopy_si_scls)%r82d, & hio_npp_fnrt_canopy_si_scls => this%hvars(ih_npp_fnrt_canopy_si_scls)%r82d, & hio_npp_sapw_canopy_si_scls => this%hvars(ih_npp_sapw_canopy_si_scls)%r82d, & @@ -1454,10 +1469,6 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_bsw_md_understory_si_scls => this%hvars(ih_bsw_md_understory_si_scls)%r82d, & hio_bdead_md_understory_si_scls => this%hvars(ih_bdead_md_understory_si_scls)%r82d, & hio_seed_prod_understory_si_scls => this%hvars(ih_seed_prod_understory_si_scls)%r82d, & - hio_dbalivedt_understory_si_scls => this%hvars(ih_dbalivedt_understory_si_scls)%r82d, & - hio_dbdeaddt_understory_si_scls => this%hvars(ih_dbdeaddt_understory_si_scls)%r82d, & - hio_dbstoredt_understory_si_scls => this%hvars(ih_dbstoredt_understory_si_scls)%r82d, & - hio_storage_flux_understory_si_scls => this%hvars(ih_storage_flux_understory_si_scls)%r82d, & hio_npp_leaf_understory_si_scls => this%hvars(ih_npp_leaf_understory_si_scls)%r82d, & hio_npp_fnrt_understory_si_scls => this%hvars(ih_npp_fnrt_understory_si_scls)%r82d, & hio_npp_sapw_understory_si_scls => this%hvars(ih_npp_sapw_understory_si_scls)%r82d, & @@ -1625,29 +1636,40 @@ subroutine update_history_dyn(this,nc,nsites,sites) endif ! Update biomass components - hio_bleaf_pa(io_pa) = hio_bleaf_pa(io_pa) + n_density * ccohort%bl * g_per_kg - hio_bstore_pa(io_pa) = hio_bstore_pa(io_pa) + n_density * ccohort%bstore * g_per_kg - hio_bdead_pa(io_pa) = hio_bdead_pa(io_pa) + n_density * ccohort%bdead * g_per_kg - hio_balive_pa(io_pa) = hio_balive_pa(io_pa) + n_density * & - (ccohort%bsw + ccohort%br + ccohort%bl) * g_per_kg - hio_bsapwood_pa(io_pa) = hio_bsapwood_pa(io_pa) + n_density * ccohort%bsw * g_per_kg - hio_bfineroot_pa(io_pa) = hio_bfineroot_pa(io_pa) + n_density * ccohort%br * g_per_kg - hio_btotal_pa(io_pa) = hio_btotal_pa(io_pa) + n_density * ccohort%b_total() * g_per_kg + + sapw_c = ccohort%prt%GetState(sapw_organ, all_carbon_species) + struct_c = ccohort%prt%GetState(struct_organ, all_carbon_species) + leaf_c = ccohort%prt%GetState(leaf_organ, all_carbon_species) + fnrt_c = ccohort%prt%GetState(fnrt_organ, all_carbon_species) + store_c = ccohort%prt%GetState(store_organ, all_carbon_species) + + alive_c = leaf_c + fnrt_c + sapw_c + total_c = alive_c + store_c + struct_c + + hio_bleaf_pa(io_pa) = hio_bleaf_pa(io_pa) + n_density * leaf_c * g_per_kg + hio_bstore_pa(io_pa) = hio_bstore_pa(io_pa) + n_density * store_c * g_per_kg + hio_bdead_pa(io_pa) = hio_bdead_pa(io_pa) + n_density * struct_c * g_per_kg + hio_balive_pa(io_pa) = hio_balive_pa(io_pa) + n_density * alive_c * g_per_kg + + hio_bsapwood_pa(io_pa) = hio_bsapwood_pa(io_pa) + n_density * sapw_c * g_per_kg + hio_bfineroot_pa(io_pa) = hio_bfineroot_pa(io_pa) + n_density * fnrt_c * g_per_kg + hio_btotal_pa(io_pa) = hio_btotal_pa(io_pa) + n_density * total_c * g_per_kg + hio_agb_pa(io_pa) = hio_agb_pa(io_pa) + n_density * g_per_kg * & - ( ccohort%bl + (ccohort%bsw + ccohort%bdead) * EDPftvarcon_inst%allom_agb_frac(ccohort%pft) ) + ( leaf_c + (sapw_c + struct_c + store_c) * EDPftvarcon_inst%allom_agb_frac(ccohort%pft) ) ! Update PFT partitioned biomass components hio_leafbiomass_si_pft(io_si,ft) = hio_leafbiomass_si_pft(io_si,ft) + & - (ccohort%n * AREA_INV) * ccohort%bl * g_per_kg + (ccohort%n * AREA_INV) * leaf_c * g_per_kg hio_storebiomass_si_pft(io_si,ft) = hio_storebiomass_si_pft(io_si,ft) + & - (ccohort%n * AREA_INV) * ccohort%bstore * g_per_kg + (ccohort%n * AREA_INV) * store_c * g_per_kg hio_nindivs_si_pft(io_si,ft) = hio_nindivs_si_pft(io_si,ft) + & ccohort%n * AREA_INV hio_biomass_si_pft(io_si, ft) = hio_biomass_si_pft(io_si, ft) + & - (ccohort%n * AREA_INV) * ccohort%b_total() * g_per_kg + (ccohort%n * AREA_INV) * total_c * g_per_kg ! Update PFT crown area hio_crownarea_si_pft(io_si, ft) = hio_crownarea_si_pft(io_si, ft) + & @@ -1655,7 +1677,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) ! update total biomass per age bin hio_biomass_si_age(io_si,cpatch%age_class) = hio_biomass_si_age(io_si,cpatch%age_class) & - + ccohort%b_total() * ccohort%n * AREA_INV + + total_c * ccohort%n * AREA_INV ! ecosystem-level, organ-partitioned NPP/allocation fluxes @@ -1755,10 +1777,10 @@ subroutine update_history_dyn(this,nc,nsites,sites) end if hio_agb_si_scls(io_si,scls) = hio_agb_si_scls(io_si,scls) + & - ccohort%b_total() * ccohort%n * EDPftvarcon_inst%allom_agb_frac(ccohort%pft) * AREA_INV + total_c * ccohort%n * EDPftvarcon_inst%allom_agb_frac(ccohort%pft) * AREA_INV hio_biomass_si_scls(io_si,scls) = hio_biomass_si_scls(io_si,scls) + & - ccohort%b_total() * ccohort%n * AREA_INV + total_c * ccohort%n * AREA_INV ! update size-class x patch-age related quantities @@ -1782,7 +1804,22 @@ subroutine update_history_dyn(this,nc,nsites,sites) ccohort%n * ccohort%npp_acc_hold * AREA_INV hio_biomass_si_agepft(io_si,iagepft) = hio_biomass_si_agepft(io_si,iagepft) + & - ccohort%b_total() * ccohort%n * AREA_INV + total_c * ccohort%n * AREA_INV + + ! Calculate turnover and allocation rates (these are in total kg/day) + + sapw_c_turnover = ccohort%prt%GetTurnover(sapw_organ, all_carbon_species) + store_c_turnover = ccohort%prt%GetTurnover(store_organ, all_carbon_species) + leaf_c_turnover = ccohort%prt%GetTurnover(leaf_organ, all_carbon_species) + fnrt_c_turnover = ccohort%prt%GetTurnover(fnrt_organ, all_carbon_species) + struct_c_turnover = ccohort%prt%GetTurnover(struct_organ, all_carbon_species) + + sapw_c_net_art = ccohort%prt%GetNetArt(sapw_organ, all_carbon_species) + store_c_net_art = ccohort%prt%GetNetArt(store_organ, all_carbon_species) + leaf_c_net_art = ccohort%prt%GetNetArt(leaf_organ, all_carbon_species) + fnrt_c_net_art = ccohort%prt%GetNetArt(fnrt_organ, all_carbon_species) + struct_c_net_art = ccohort%prt%GetNetArt(struct_organ, all_carbon_species) + repro_c_net_art = ccohort%prt%GetNetArt(repro_organ, all_carbon_species) ! update SCPF/SCLS- and canopy/subcanopy- partitioned quantities if (ccohort%canopy_layer .eq. 1) then @@ -1792,11 +1829,11 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_ddbh_canopy_si_scag(io_si,iscag) = hio_ddbh_canopy_si_scag(io_si,iscag) + & ccohort%ddbhdt*ccohort%n hio_bstor_canopy_si_scpf(io_si,scpf) = hio_bstor_canopy_si_scpf(io_si,scpf) + & - ccohort%bstore * ccohort%n + store_c * ccohort%n hio_bleaf_canopy_si_scpf(io_si,scpf) = hio_bleaf_canopy_si_scpf(io_si,scpf) + & - ccohort%bl * ccohort%n + leaf_c * ccohort%n - hio_canopy_biomass_pa(io_pa) = hio_canopy_biomass_pa(io_pa) + n_density * ccohort%b_total() * g_per_kg + hio_canopy_biomass_pa(io_pa) = hio_canopy_biomass_pa(io_pa) + n_density * total_c * g_per_kg !hio_mortality_canopy_si_scpf(io_si,scpf) = hio_mortality_canopy_si_scpf(io_si,scpf)+ & ! (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%fmort + ccohort%frmort) * ccohort%n @@ -1832,49 +1869,41 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_canopy_mortality_carbonflux_si(io_si) = hio_canopy_mortality_carbonflux_si(io_si) + & (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%fmort + ccohort%frmort) * & - ccohort%b_total() * ccohort%n * g_per_kg * days_per_sec * years_per_day * ha_per_m2 + & - (ccohort%lmort_direct + ccohort%lmort_collateral + ccohort%lmort_infra)* ccohort%b_total() * & + total_c * ccohort%n * g_per_kg * days_per_sec * years_per_day * ha_per_m2 + & + (ccohort%lmort_direct + ccohort%lmort_collateral + ccohort%lmort_infra) * total_c * & ccohort%n * g_per_kg * ha_per_m2 - hio_leaf_md_canopy_si_scls(io_si,scls) = hio_leaf_md_canopy_si_scls(io_si,scls) + & - ccohort%leaf_md * ccohort%n - hio_root_md_canopy_si_scls(io_si,scls) = hio_root_md_canopy_si_scls(io_si,scls) + & - ccohort%root_md * ccohort%n hio_carbon_balance_canopy_si_scls(io_si,scls) = hio_carbon_balance_canopy_si_scls(io_si,scls) + & ccohort%n * ccohort%npp_acc_hold - + + + hio_leaf_md_canopy_si_scls(io_si,scls) = hio_leaf_md_canopy_si_scls(io_si,scls) + & + leaf_c_turnover * ccohort%n * hlm_freq_day + hio_root_md_canopy_si_scls(io_si,scls) = hio_root_md_canopy_si_scls(io_si,scls) + & + fnrt_c_turnover * ccohort%n * hlm_freq_day hio_bsw_md_canopy_si_scls(io_si,scls) = hio_bsw_md_canopy_si_scls(io_si,scls) + & - ccohort%bsw_md * ccohort%n + sapw_c_turnover * ccohort%n * hlm_freq_day hio_bstore_md_canopy_si_scls(io_si,scls) = hio_bstore_md_canopy_si_scls(io_si,scls) + & - ccohort%bstore_md * ccohort%n + store_c_turnover * ccohort%n * hlm_freq_day hio_bdead_md_canopy_si_scls(io_si,scls) = hio_bdead_md_canopy_si_scls(io_si,scls) + & - ccohort%bdead_md * ccohort%n + struct_c_turnover * ccohort%n * hlm_freq_day hio_seed_prod_canopy_si_scls(io_si,scls) = hio_seed_prod_canopy_si_scls(io_si,scls) + & - ccohort%seed_prod * ccohort%n - hio_dbdeaddt_canopy_si_scls(io_si,scls) = hio_dbdeaddt_canopy_si_scls(io_si,scls) + & - ccohort%dbdeaddt * ccohort%n - hio_dbstoredt_canopy_si_scls(io_si,scls) = hio_dbstoredt_canopy_si_scls(io_si,scls) + & - ccohort%dbstoredt * ccohort%n - hio_storage_flux_canopy_si_scls(io_si,scls) = hio_storage_flux_canopy_si_scls(io_si,scls) + & - ccohort%npp_stor * ccohort%n + ccohort%seed_prod * ccohort%n hio_npp_leaf_canopy_si_scls(io_si,scls) = hio_npp_leaf_canopy_si_scls(io_si,scls) + & - ccohort%npp_leaf * ccohort%n + leaf_c_net_art * ccohort%n * hlm_freq_day hio_npp_fnrt_canopy_si_scls(io_si,scls) = hio_npp_fnrt_canopy_si_scls(io_si,scls) + & - ccohort%npp_fnrt * ccohort%n + fnrt_c_net_art * ccohort%n * hlm_freq_day hio_npp_sapw_canopy_si_scls(io_si,scls) = hio_npp_sapw_canopy_si_scls(io_si,scls) + & - ccohort%npp_sapw * ccohort%n + sapw_c_net_art * ccohort%n * hlm_freq_day hio_npp_dead_canopy_si_scls(io_si,scls) = hio_npp_dead_canopy_si_scls(io_si,scls) + & - ccohort%npp_dead * ccohort%n + struct_c_net_art * ccohort%n * hlm_freq_day hio_npp_seed_canopy_si_scls(io_si,scls) = hio_npp_seed_canopy_si_scls(io_si,scls) + & - ccohort%npp_seed * ccohort%n + repro_c_net_art * ccohort%n * hlm_freq_day hio_npp_stor_canopy_si_scls(io_si,scls) = hio_npp_stor_canopy_si_scls(io_si,scls) + & - ccohort%npp_stor * ccohort%n - - hio_dbalivedt_canopy_si_scls(io_si,scls) = hio_dbalivedt_canopy_si_scls(io_si,scls) + & - (ccohort%npp_leaf+ccohort%npp_fnrt+ccohort%npp_sapw+ccohort%npp_stor)* ccohort%n - + store_c_net_art * ccohort%n * hlm_freq_day + hio_yesterdaycanopylevel_canopy_si_scls(io_si,scls) = & hio_yesterdaycanopylevel_canopy_si_scls(io_si,scls) + & ccohort%canopy_layer_yesterday * ccohort%n @@ -1885,13 +1914,11 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_ddbh_understory_si_scag(io_si,iscag) = hio_ddbh_understory_si_scag(io_si,iscag) + & ccohort%ddbhdt*ccohort%n hio_bstor_understory_si_scpf(io_si,scpf) = hio_bstor_understory_si_scpf(io_si,scpf) + & - ccohort%bstore * ccohort%n + store_c * ccohort%n hio_bleaf_understory_si_scpf(io_si,scpf) = hio_bleaf_understory_si_scpf(io_si,scpf) + & - ccohort%bl * ccohort%n + leaf_c * ccohort%n hio_understory_biomass_pa(io_pa) = hio_understory_biomass_pa(io_pa) + & - n_density * ccohort%b_total() * g_per_kg - !hio_mortality_understory_si_scpf(io_si,scpf) = hio_mortality_understory_si_scpf(io_si,scpf)+ & - ! (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%fmort + ccohort%frmort) * ccohort%n + n_density * total_c * g_per_kg hio_mortality_understory_si_scpf(io_si,scpf) = hio_mortality_understory_si_scpf(io_si,scpf)+ & (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%fmort + ccohort%frmort ) * ccohort%n + & @@ -1925,47 +1952,38 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_understory_mortality_carbonflux_si(io_si) = hio_understory_mortality_carbonflux_si(io_si) + & (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%fmort + ccohort%frmort) * & - ccohort%b_total() * ccohort%n * g_per_kg * days_per_sec * years_per_day * ha_per_m2 + & - (ccohort%lmort_direct + ccohort%lmort_collateral + ccohort%lmort_infra) * ccohort%b_total() * & + total_c * ccohort%n * g_per_kg * days_per_sec * years_per_day * ha_per_m2 + & + (ccohort%lmort_direct + ccohort%lmort_collateral + ccohort%lmort_infra) * total_c * & ccohort%n * g_per_kg * ha_per_m2 hio_carbon_balance_understory_si_scls(io_si,scls) = hio_carbon_balance_understory_si_scls(io_si,scls) + & ccohort%npp_acc_hold * ccohort%n hio_leaf_md_understory_si_scls(io_si,scls) = hio_leaf_md_understory_si_scls(io_si,scls) + & - ccohort%leaf_md * ccohort%n + leaf_c_turnover * ccohort%n * hlm_freq_day hio_root_md_understory_si_scls(io_si,scls) = hio_root_md_understory_si_scls(io_si,scls) + & - ccohort%root_md * ccohort%n + fnrt_c_turnover * ccohort%n * hlm_freq_day hio_bsw_md_understory_si_scls(io_si,scls) = hio_bsw_md_understory_si_scls(io_si,scls) + & - ccohort%bsw_md * ccohort%n + sapw_c_turnover * ccohort%n * hlm_freq_day hio_bstore_md_understory_si_scls(io_si,scls) = hio_bstore_md_understory_si_scls(io_si,scls) + & - ccohort%bstore_md * ccohort%n + store_c_turnover * ccohort%n * hlm_freq_day hio_bdead_md_understory_si_scls(io_si,scls) = hio_bdead_md_understory_si_scls(io_si,scls) + & - ccohort%bdead_md * ccohort%n + struct_c_turnover * ccohort%n * hlm_freq_day hio_seed_prod_understory_si_scls(io_si,scls) = hio_seed_prod_understory_si_scls(io_si,scls) + & ccohort%seed_prod * ccohort%n - hio_dbdeaddt_understory_si_scls(io_si,scls) = hio_dbdeaddt_understory_si_scls(io_si,scls) + & - ccohort%dbdeaddt * ccohort%n - hio_dbstoredt_understory_si_scls(io_si,scls) = hio_dbstoredt_understory_si_scls(io_si,scls) + & - ccohort%dbstoredt * ccohort%n - hio_storage_flux_understory_si_scls(io_si,scls) = hio_storage_flux_understory_si_scls(io_si,scls) + & - ccohort%npp_stor * ccohort%n hio_npp_leaf_understory_si_scls(io_si,scls) = hio_npp_leaf_understory_si_scls(io_si,scls) + & - ccohort%npp_leaf * ccohort%n + leaf_c_net_art * ccohort%n * hlm_freq_day hio_npp_fnrt_understory_si_scls(io_si,scls) = hio_npp_fnrt_understory_si_scls(io_si,scls) + & - ccohort%npp_fnrt * ccohort%n + fnrt_c_net_art * ccohort%n * hlm_freq_day hio_npp_sapw_understory_si_scls(io_si,scls) = hio_npp_sapw_understory_si_scls(io_si,scls) + & - ccohort%npp_sapw * ccohort%n + sapw_c_net_art * ccohort%n * hlm_freq_day hio_npp_dead_understory_si_scls(io_si,scls) = hio_npp_dead_understory_si_scls(io_si,scls) + & - ccohort%npp_dead * ccohort%n + struct_c_net_art * ccohort%n * hlm_freq_day hio_npp_seed_understory_si_scls(io_si,scls) = hio_npp_seed_understory_si_scls(io_si,scls) + & - ccohort%npp_seed * ccohort%n + repro_c_net_art * ccohort%n * hlm_freq_day hio_npp_stor_understory_si_scls(io_si,scls) = hio_npp_stor_understory_si_scls(io_si,scls) + & - ccohort%npp_stor * ccohort%n - - hio_dbalivedt_understory_si_scls(io_si,scls) = hio_dbalivedt_understory_si_scls(io_si,scls) + & - (ccohort%npp_leaf+ccohort%npp_fnrt+ccohort%npp_sapw+ccohort%npp_stor)* ccohort%n + store_c_net_art * ccohort%n * hlm_freq_day hio_yesterdaycanopylevel_understory_si_scls(io_si,scls) = & hio_yesterdaycanopylevel_understory_si_scls(io_si,scls) + & @@ -4048,16 +4066,6 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_carbon_balance_understory_si_scls ) - call this%set_history_var(vname='DBALIVEDT_CANOPY_SCLS', units = 'kg C / ha / yr', & - long='DBALIVEDT for canopy plants by size class', use_default='inactive', & - avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_dbalivedt_canopy_si_scls ) - - call this%set_history_var(vname='DBALIVEDT_UNDERSTORY_SCLS', units = 'kg C / ha / yr', & - long='DBALIVEDT for understory plants by size class', use_default='inactive', & - avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_dbalivedt_understory_si_scls ) - call this%set_history_var(vname='MORTALITY_UNDERSTORY_SCLS', units = 'indiv/ha/yr', & long='total mortality of understory trees by size class', use_default='active', & avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & @@ -4113,21 +4121,6 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_seed_prod_canopy_si_scls ) - call this%set_history_var(vname='DBDEADDT_CANOPY_SCLS', units = 'kg C / ha / yr', & - long='DBDEADDT for canopy plants by size class', use_default='inactive', & - avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_dbdeaddt_canopy_si_scls ) - - call this%set_history_var(vname='DBSTOREDT_CANOPY_SCLS', units = 'kg C / ha / yr', & - long='DBSTOREDT for canopy plants by size class', use_default='inactive', & - avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_dbstoredt_canopy_si_scls ) - - call this%set_history_var(vname='STORAGE_FLUX_CANOPY_SCLS', units = 'kg C / ha / yr', & - long='STORAGE_FLUX for canopy plants by size class', use_default='inactive', & - avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_storage_flux_canopy_si_scls ) - call this%set_history_var(vname='NPP_LEAF_CANOPY_SCLS', units = 'kg C / ha / yr', & long='NPP_LEAF for canopy plants by size class', use_default='inactive', & avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=-999.9_r8, & @@ -4238,21 +4231,6 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_seed_prod_understory_si_scls ) - call this%set_history_var(vname='DBDEADDT_UNDERSTORY_SCLS', units = 'kg C / ha / yr', & - long='DBDEADDT for understory plants by size class', use_default='inactive', & - avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_dbdeaddt_understory_si_scls ) - - call this%set_history_var(vname='DBSTOREDT_UNDERSTORY_SCLS', units = 'kg C / ha / yr', & - long='DBSTOREDT for understory plants by size class', use_default='inactive', & - avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_dbstoredt_understory_si_scls ) - - call this%set_history_var(vname='STORAGE_FLUX_UNDERSTORY_SCLS', units = 'kg C / ha / yr', & - long='STORAGE_FLUX for understory plants by size class', use_default='inactive', & - avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_storage_flux_understory_si_scls ) - call this%set_history_var(vname='NPP_LEAF_UNDERSTORY_SCLS', units = 'kg C / ha / yr', & long='NPP_LEAF for understory plants by size class', use_default='inactive', & avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index c17e1eb09f..cbc6378ee4 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -1572,7 +1572,7 @@ subroutine FatesReportParameters(masterproc) call FatesReportPFTParams(masterproc) call FatesReportParams(masterproc) - call FatesCheckParams(masterproc) + call FatesCheckParams(masterproc,hlm_parteh_model) return end subroutine FatesReportParameters @@ -1584,7 +1584,7 @@ subroutine InitPARTEHGlobals() ! Initialize the Plant Allocation and Reactive Transport ! global functions and mapping tables - select case(int(hlm_parteh_mode)) + select case(int(hlm_parteh_model)) case (1) call InitPRTInstanceAC() case(2) diff --git a/main/FatesRestartInterfaceMod.F90 b/main/FatesRestartInterfaceMod.F90 index 2c2022eaa5..e28b91f74c 100644 --- a/main/FatesRestartInterfaceMod.F90 +++ b/main/FatesRestartInterfaceMod.F90 @@ -100,11 +100,6 @@ module FatesRestartInterfaceMod integer, private :: ir_dbh_co integer, private :: ir_height_co integer, private :: ir_laimemory_co - integer, private :: ir_leaf_md_co - integer, private :: ir_root_md_co - integer, private :: ir_sapwood_md_co - integer, private :: ir_dead_md_co - integer, private :: ir_store_md_co integer, private :: ir_nplant_co integer, private :: ir_gpp_acc_co integer, private :: ir_npp_acc_co @@ -684,31 +679,6 @@ 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_leaf_maint_dmnd', vtype=cohort_r8, & - long_name='ed cohort - leaf maintenance demand', & - units='kgC/indiv/year', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_leaf_md_co ) - - call this%set_restart_var(vname='fates_root_maint_dmnd', vtype=cohort_r8, & - long_name='ed cohort - fine root maintenance demand', & - units='kgC/indiv', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_root_md_co ) - - call this%set_restart_var(vname='fates_store_maint_dmnd', vtype=cohort_r8, & - long_name='ed cohort - storage maintenance demand', & - units='kgC/indiv', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_store_md_co ) - - call this%set_restart_var(vname='fates_sapwood_maint_dmnd', vtype=cohort_r8, & - long_name='ed cohort - sapwood maintenance demand', & - units='kgC/indiv', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_sapwood_md_co ) - - call this%set_restart_var(vname='fates_dead_maint_dmnd', vtype=cohort_r8, & - long_name='ed cohort - structure maintenance demand', & - units='kgC/indiv', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_dead_md_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, & @@ -1093,11 +1063,6 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_dbh_co => this%rvars(ir_dbh_co)%r81d, & rio_height_co => this%rvars(ir_height_co)%r81d, & rio_laimemory_co => this%rvars(ir_laimemory_co)%r81d, & - rio_leaf_md_co => this%rvars(ir_leaf_md_co)%r81d, & - rio_root_md_co => this%rvars(ir_root_md_co)%r81d, & - rio_store_md_co => this%rvars(ir_store_md_co)%r81d, & - rio_sapwood_md_co => this%rvars(ir_sapwood_md_co)%r81d, & - rio_dead_md_co => this%rvars(ir_dead_md_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, & @@ -1227,11 +1192,7 @@ subroutine set_restart_vectors(this,nc,nsites,sites) 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_leaf_md_co(io_idx_co) = ccohort%leaf_md - rio_root_md_co(io_idx_co) = ccohort%root_md - rio_store_md_co(io_idx_co) = ccohort%bstore_md - rio_sapwood_md_co(io_idx_co) = ccohort%bsw_md - rio_dead_md_co(io_idx_co) = ccohort%bdead_md + rio_nplant_co(io_idx_co) = ccohort%n rio_gpp_acc_co(io_idx_co) = ccohort%gpp_acc rio_npp_acc_co(io_idx_co) = ccohort%npp_acc @@ -1692,11 +1653,6 @@ subroutine get_restart_vectors(this, nc, nsites, sites) rio_dbh_co => this%rvars(ir_dbh_co)%r81d, & rio_height_co => this%rvars(ir_height_co)%r81d, & rio_laimemory_co => this%rvars(ir_laimemory_co)%r81d, & - rio_leaf_md_co => this%rvars(ir_leaf_md_co)%r81d, & - rio_root_md_co => this%rvars(ir_root_md_co)%r81d, & - rio_sapwood_md_co => this%rvars(ir_sapwood_md_co)%r81d, & - rio_store_md_co => this%rvars(ir_store_md_co)%r81d, & - rio_dead_md_co => this%rvars(ir_dead_md_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, & @@ -1794,12 +1750,12 @@ subroutine get_restart_vectors(this, nc, nsites, sites) select case(hlm_parteh_model) case (1) - call SetState(new_cohort%prt,leaf_organ, carbon12_species, rio_bleaf_co(io_idx_co)) - call SetState(new_cohort%prt,fnrt_organ, carbon12_species, rio_broot_co(io_idx_co)) - call SetState(new_cohort%prt,sapw_organ, carbon12_species, rio_bsw_co(io_idx_co)) - call SetState(new_cohort%prt,store_organ, carbon12_species, rio_bstore_co(io_idx_co)) - call SetState(new_cohort%prt,struct_organ , carbon12_species, rio_bdead_co(io_idx_co)) - call SetState(new_cohort%prt,repro_organ , carbon12_species, 0.0_r8) + call SetState(ccohort%prt,leaf_organ, carbon12_species, rio_bleaf_co(io_idx_co)) + call SetState(ccohort%prt,fnrt_organ, carbon12_species, rio_broot_co(io_idx_co)) + call SetState(ccohort%prt,sapw_organ, carbon12_species, rio_bsw_co(io_idx_co)) + call SetState(ccohort%prt,store_organ, carbon12_species, rio_bstore_co(io_idx_co)) + call SetState(ccohort%prt,struct_organ , carbon12_species, rio_bdead_co(io_idx_co)) + call SetState(ccohort%prt,repro_organ , carbon12_species, 0.0_r8) case DEFAULT write(fates_log(),*) 'You specified an unknown PRT module' @@ -1808,19 +1764,12 @@ subroutine get_restart_vectors(this, nc, nsites, sites) end select - end select - 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%dbh = rio_dbh_co(io_idx_co) ccohort%hite = rio_height_co(io_idx_co) ccohort%laimemory = rio_laimemory_co(io_idx_co) - ccohort%leaf_md = rio_leaf_md_co(io_idx_co) - ccohort%root_md = rio_root_md_co(io_idx_co) - ccohort%bstore_md = rio_store_md_co(io_idx_co) - ccohort%bsw_md = rio_sapwood_md_co(io_idx_co) - ccohort%bdead_md = rio_dead_md_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) diff --git a/parteh/PRTAllometricCarbonMod.F90 b/parteh/PRTAllometricCarbonMod.F90 index 22777a4c2c..407610764b 100644 --- a/parteh/PRTAllometricCarbonMod.F90 +++ b/parteh/PRTAllometricCarbonMod.F90 @@ -24,9 +24,6 @@ module PRTAllometricCarbonMod use PRTGenericMod , only : repro_organ use PRTGenericMod , only : struct_organ - use PRTLossFluxesMod , only : PRTMaintTurnover - - use FatesInterfaceMod , only : hlm_freq_day use FatesAllometryMod , only : bleaf use FatesAllometryMod , only : bsap_allom use FatesAllometryMod , only : bfineroot diff --git a/parteh/PRTGenericMod.F90 b/parteh/PRTGenericMod.F90 index cd215c3d09..f347759a9d 100644 --- a/parteh/PRTGenericMod.F90 +++ b/parteh/PRTGenericMod.F90 @@ -225,9 +225,13 @@ module PRTGenericMod procedure, non_overridable :: RegisterBCInout procedure, non_overridable :: GetState procedure, non_overridable :: GetTurnover + procedure, non_overridable :: GetBurned + procedure, non_overridable :: GetNetART procedure, non_overridable :: ZeroRates procedure, non_overridable :: CheckMassConservation - + procedure, non_overridable :: DeallocatePRTVartypes + procedure, non_overridable :: WeightedFusePRTVartypes + procedure, non_overridable :: CopyPRTVartypes end type prt_vartypes ! ------------------------------------------------------------------------------------- @@ -940,7 +944,7 @@ end function GetTurnover function GetBurned(this, organ_id, species_id, position_id) result(sp_organ_burned) - ! THis function is very similar to GetBurned, with the only difference that it + ! THis function is very similar to GetTurnover, with the only difference that it ! returns the turnover mass so-far during the period of interest. class(prt_vartypes) :: this @@ -991,6 +995,61 @@ function GetBurned(this, organ_id, species_id, position_id) result(sp_organ_burn return end function GetBurned + ! ==================================================================================== + + function GetNetART(this, organ_id, species_id, position_id) result(sp_organ_netart) + + ! THis function is very similar to GetTurnover, with the only difference that it + ! returns the Net changes due to Allocations Reactions and Transport in that pool + + class(prt_vartypes) :: this + integer,intent(in) :: organ_id + integer,intent(in) :: species_id + integer,intent(in),optional :: position_id + real(r8) :: sp_organ_netart + + integer :: i_pos + integer :: ispec + integer :: num_species + integer,dimension(max_spec_per_group) :: spec_ids + integer :: i_var + + sp_organ_netart = 0.0_r8 + + if(species_id == all_carbon_species) then + spec_ids(1:3) = carbon_species(1:3) + num_species = 3 + else + num_species = 1 + spec_ids(1) = species_id + end if + + if(present(position_id)) then + i_pos = position_id + + do ispec = 1,num_species + i_var = this%prt_instance%sp_organ_map(organ_id,spec_ids(ispec)) + if(i_var>0) sp_organ_netart = sp_organ_netart + & + this%variables(i_var)%net_art(i_pos) + end do + + else + + do ispec = 1,num_species + i_var = this%prt_instance%sp_organ_map(organ_id,spec_ids(ispec)) + if(i_var>0) then + do i_pos = 1, this%variables(i_var)%num_pos + sp_organ_netart = sp_organ_netart + this%variables(i_var)%net_art(i_pos) + end do + end if + + end do + + end if + + return + end function GetNetART + ! ===================================================================================== function GetCoordVal(this, organ_id, species_id ) result(prt_val) From 11c485517388e11e16f3158ed619a4aaa02939ed Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Fri, 28 Sep 2018 13:16:32 -0700 Subject: [PATCH 19/52] Debugging parteh v1, model runs, crashes after several years due to carbon inbalance. --- biogeochem/EDCohortDynamicsMod.F90 | 51 ------ .../parteh/parteh_controls_phenevents_v2.xml | 170 ++++++++++++++++++ main/EDMainMod.F90 | 12 +- main/EDPftvarcon.F90 | 104 ++++++----- main/EDTypesMod.F90 | 22 --- main/FatesHistoryInterfaceMod.F90 | 102 +++++------ main/FatesInterfaceMod.F90 | 4 +- main/FatesRestartInterfaceMod.F90 | 99 +--------- parameter_files/fates_params_default.cdl | 54 +++--- parteh/PRTAllometricCarbonMod.F90 | 22 ++- 10 files changed, 332 insertions(+), 308 deletions(-) create mode 100644 functional_unit_testing/parteh/parteh_controls_phenevents_v2.xml diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index b41d6ab9a8..844e0e20a5 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -364,13 +364,6 @@ subroutine nan_cohort(cc_p) currentCohort%resp_tstep = nan ! RESP: kgC/indiv/timestep currentCohort%resp_acc = nan ! RESP: kGC/cohort/day - currentCohort%npp_leaf = nan - currentCohort%npp_fnrt = nan - currentCohort%npp_sapw = nan - currentCohort%npp_dead = nan - currentCohort%npp_seed = nan - currentCohort%npp_stor = nan - !RESPIRATION currentCohort%rdark = nan currentCohort%resp_m = nan ! Maintenance respiration. kGC/cohort/year @@ -396,8 +389,6 @@ subroutine nan_cohort(cc_p) currentCohort%dndt = nan ! time derivative of cohort size currentCohort%dhdt = nan ! time derivative of height currentCohort%ddbhdt = nan ! time derivative of dbh - currentCohort%dbdeaddt = nan ! time derivative of dead biomass - currentCohort%dbstoredt = nan ! time derivative of stored biomass ! FIRE currentCohort%cfa = nan ! proportion of crown affected by fire @@ -405,8 +396,6 @@ subroutine nan_cohort(cc_p) currentCohort%crownfire_mort = nan ! probability of tree post-fire mortality due to crown scorch currentCohort%fire_mort = nan ! post-fire mortality from cambial and crown damage assuming two are independent - currentCohort%ode_opt_step = nan ! integrator step size - end subroutine nan_cohort !-------------------------------------------------------------------------------------! @@ -462,12 +451,6 @@ subroutine zero_cohort(cc_p) currentcohort%prom_weight = 0._r8 currentcohort%crownfire_mort = 0._r8 currentcohort%cambial_mort = 0._r8 - currentCohort%npp_leaf = 0._r8 - currentCohort%npp_fnrt = 0._r8 - currentCohort%npp_sapw = 0._r8 - currentCohort%npp_dead = 0._r8 - currentCohort%npp_seed = 0._r8 - currentCohort%npp_stor = 0._r8 end subroutine zero_cohort @@ -872,31 +855,9 @@ subroutine fuse_cohorts(currentSite, currentPatch, bc_in) currentCohort%lmort_infra = (currentCohort%n*currentCohort%lmort_infra + & nextc%n*nextc%lmort_infra)/newn - ! npp diagnostics - currentCohort%npp_leaf = (currentCohort%n*currentCohort%npp_leaf + & - nextc%n*nextc%npp_leaf)/newn - currentCohort%npp_fnrt = (currentCohort%n*currentCohort%npp_fnrt + & - nextc%n*nextc%npp_fnrt)/newn - currentCohort%npp_sapw = (currentCohort%n*currentCohort%npp_sapw + & - nextc%n*nextc%npp_sapw)/newn - currentCohort%npp_dead = (currentCohort%n*currentCohort%npp_dead + & - nextc%n*nextc%npp_dead)/newn - currentCohort%npp_seed = (currentCohort%n*currentCohort%npp_seed + & - nextc%n*nextc%npp_seed)/newn - currentCohort%npp_stor = (currentCohort%n*currentCohort%npp_stor + & - nextc%n*nextc%npp_stor)/newn - ! biomass and dbh tendencies currentCohort%ddbhdt = (currentCohort%n*currentCohort%ddbhdt + & nextc%n*nextc%ddbhdt)/newn - currentCohort%dbdeaddt = (currentCohort%n*currentCohort%dbdeaddt + & - nextc%n*nextc%dbdeaddt)/newn - currentCohort%dbstoredt = (currentCohort%n*currentCohort%dbstoredt + & - nextc%n*nextc%dbstoredt)/newn - - ! Integration step size - currentCohort%ode_opt_step = (currentCohort%n*currentCohort%ode_opt_step + & - nextc%n*nextc%ode_opt_step)/newn do i=1, nlevleaf if (currentCohort%year_net_uptake(i) == 999._r8 .or. nextc%year_net_uptake(i) == 999._r8) then @@ -1237,13 +1198,6 @@ subroutine copy_cohort( currentCohort,copyc ) n%year_net_uptake = o%year_net_uptake n%ts_net_uptake = o%ts_net_uptake - n%npp_leaf = o%npp_leaf - n%npp_fnrt = o%npp_fnrt - n%npp_sapw = o%npp_sapw - n%npp_dead = o%npp_dead - n%npp_seed = o%npp_seed - n%npp_stor = o%npp_stor - !RESPIRATION n%rdark = o%rdark n%resp_m = o%resp_m @@ -1277,15 +1231,10 @@ subroutine copy_cohort( currentCohort,copyc ) ! Flags n%isnew = o%isnew - ! Integrator memory - n%ode_opt_step = o%ode_opt_step - ! VARIABLES NEEDED FOR INTEGRATION n%dndt = o%dndt n%dhdt = o%dhdt n%ddbhdt = o%ddbhdt - n%dbdeaddt = o%dbdeaddt - n%dbstoredt = o%dbstoredt if ( DEBUG ) write(fates_log(),*) 'EDCohortDyn dpstoredt ',o%dbstoredt diff --git a/functional_unit_testing/parteh/parteh_controls_phenevents_v2.xml b/functional_unit_testing/parteh/parteh_controls_phenevents_v2.xml new file mode 100644 index 0000000000..f6e1f4b789 --- /dev/null +++ b/functional_unit_testing/parteh/parteh_controls_phenevents_v2.xml @@ -0,0 +1,170 @@ + + + + + + + + + + + 0 + + + + + + + + + 86400 + 1500-01-01 + 1505-01-01 + 0.001 + + + + + + + + + AllometricCNP + + + DailyCNPFromCArea + + + + + + + Carbon Only, evergreen + Carbon Only, deciduous + CNP, evergreen + CNP, deciduous + CNP, deciduous 0.5 NP + + + + leaf + fine root + sapwood + storage + reproductive + structural + + + + 1 , 1 , 2 , 2 , 2 + 1 , 0 , 1 , 0 , 0 + 0 , 1 , 0 , 1 , 1 + 0 , 0 , 0 , 0 , 0 + 0.2 , 0.2 , 0.2 , 0.2 , 0.2 + 0.2 , 0.2, 0.2, 0.2, 0.2 + 30.0 , 30.0 , 30.0, 30.0 , 30.0 + 1.0 , 1.0 , 1.0, 1.0 , 1.0 + 1.5 , 1.5 , 1.5, 1.5 , 1.5 + 50.0 , 50.0 , 50.0, 50.0 , 50.0 + 5 , 5 , 5, 5 , 5 + 3 , 3 , 3, 3 , 3 + 1 , 1 , 1, 1 , 1 + 1 , 1 , 1, 1 , 1 + 1 , 1 , 1, 1 , 1 + 1 , 1 , 1, 1 , 1 + 1 , 1 , 1, 1 , 1 + 57.6 , 57.6 , 57.6, 57.6 , 57.6 + 0.74 , 0.74 , 0.74, 0.74 , 0.74 + 21.6 , 21.6 , 21.6, 21.6 , 21.6 + 0.0673 , 0.0673 , 0.0673, 0.0673 , 0.0673 + 0.976 , 0.976 , 0.976, 0.976 , 0.976 + -999.9 , -999.9 , -999.9, -999.9 , -999.9 + -999.9 , -999.9 , -999.9, -999.9 , -999.9 + 0.07 , 0.07 , 0.07, 0.07 , 0.07 + 1.3 , 1.3 , 1.3, 1.3 , 1.3 + 0.55 , 0.55 , 0.55 , 0.55 , 0.55 + 2.0 , 2.0 , 2.0, 2.0 , 2.0 + 0.7 , 0.7 , 0.7, 0.7 , 0.7 + 2.0 , 2.0 , 2.0, 2.0 , 2.0 + 1.00 , 1.00 , 1.00 , 1.00 , 1.00 + 0.0 , 0.0 , 0.0, 0.0 , 0.0 + 0.012 , 0.012 , 0.012, 0.012 , 0.012 + 0.012 , 0.012 , 0.012, 0.012 , 0.012 + 1.0 , 1.0 , 1.0, 1.0 , 1.0 + 0.65 , 0.65 , 0.65 , 0.65 , 0.65 + 0.1 , 0.1 , 0.1, 0.1 , 0.1 + 0.0 , 0.0 , 0.0, 0.0 , 0.0 + 0.33 , 0.33 , 0.33, 0.33 , 0.33 + 0.65 , 0.65 , 0.65, 0.65 , 0.65 + 300.0 , 300.0 , 300.0, 300.0 , 300.0 + 1.5 , 1.5 ,1.5, 1.5 ,1.5 + 1.5 , 1.5 ,1.5, 1.5 ,1.5 + 0.5 , 0.5 ,0.5, 0.5 ,0.5 + 50.0 , 50.0 , 50.0 , 50.0 , 50.0 + + 1,1,1,1,1 + + 0.05,0.05,0,0,0,0, + 0.05,0.05,0,0,0,0, + 0.05,0.05,0,0,0,0, + 0.05,0.05,0,0,0,0, + 0.05,0.05,0,0,0,0 + 0,0,0,0,0,0, + 0,0,0,0,0,0, + 0.25,0,0,0,0,0, + 0.25,0,0,0,0,0, + 0.25,0,0,0,0,0 + 0,0,0,0,0,0, + 0,0,0,0,0,0, + 0.25,0,0,0,0,0, + 0.25,0,0,0,0,0, + 0.25,0,0,0,0,0 + + -9,-9,-9,-9,-9,-9, + -9,-9,-9,-9,-9,-9, + 0.05,0.05,0.05,0.05,0.05,0.05, + 0.05,0.05,0.05,0.05,0.05,0.05, + 0.05,0.05,0.05,0.05,0.05,0.05 + + -9,-9,-9,-9,-9,-9, + -9,-9,-9,-9,-9,-9, + 0.05,0.05,0.05,0.05,0.05,0.05, + 0.05,0.05,0.05,0.05,0.05,0.05, + 0.05,0.05,0.05,0.05,0.05,0.05 + -9,-9,-9,-9,-9,-9, + -9,-9,-9,-9,-9,-9, + 0.05,0.05,0.05,0.05,0.05,0.05, + 0.05,0.05,0.05,0.05,0.05,0.05, + 0.05,0.05,0.05,0.05,0.05,0.05 + -9,-9,-9,-9,-9,-9, + -9,-9,-9,-9,-9,-9, + 0.05,0.05,0.05,0.05,0.05,0.05, + 0.05,0.05,0.05,0.05,0.05,0.05, + 0.05,0.05,0.05,0.05,0.05,0.05 + + -9,-9,-9,-9,-9,-9, + -9,-9,-9,-9,-9,-9, + 1,1,2,2,0,3, + 1,1,2,2,0,3, + 1,1,2,2,0,3 + + -9,-9,-9,-9,-9,-9, + -9,-9,-9,-9,-9,-9, + 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, + 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, + 0.01, 0.01, 0.01, 0.01, 0.01, 0.01 + + + + + + 0.4, 0.4, 0.4, 0.4, 0.4 + -9.9, -9.9, 0.5, 0.5, 0.01 + -9.9, -9.9, 0.5, 0.5, 0.01 + 1.2, 1.2, 1.2, 1.2, 1.2 + + + + + + diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index 9874e93071..5fc8a2387f 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -656,12 +656,10 @@ subroutine bypass_dynamics(currentSite) currentCohort%gpp_acc = 0.0_r8 currentCohort%resp_acc = 0.0_r8 - currentCohort%npp_leaf = 0.0_r8 - currentCohort%npp_fnrt = 0.0_r8 - currentCohort%npp_sapw = 0.0_r8 - currentCohort%npp_dead = 0.0_r8 - currentCohort%npp_seed = 0.0_r8 - currentCohort%npp_stor = 0.0_r8 + ! No need to set the "net_art" terms to zero + ! they are zeroed at the beginning of the daily step + ! If DailyPRT, maintenance, and phenology are not called + ! then these should stay zero. currentCohort%bmort = 0.0_r8 currentCohort%hmort = 0.0_r8 @@ -672,8 +670,6 @@ subroutine bypass_dynamics(currentSite) currentCohort%dndt = 0.0_r8 currentCohort%dhdt = 0.0_r8 currentCohort%ddbhdt = 0.0_r8 - currentCohort%dbdeaddt = 0.0_r8 - currentCohort%dbstoredt = 0.0_r8 currentCohort => currentCohort%taller enddo diff --git a/main/EDPftvarcon.F90 b/main/EDPftvarcon.F90 index b56dd8a1af..c2e14c9a5c 100644 --- a/main/EDPftvarcon.F90 +++ b/main/EDPftvarcon.F90 @@ -211,7 +211,9 @@ module EDPftvarcon procedure, private :: Register_PFT_nvariants procedure, private :: Receive_PFT_nvariants procedure, private :: Register_PFT_hydr_organs - procedure, private :: Receive_PFT_hydr_organs + procedure, private :: Receive_PFT_hydr_organs + procedure, private :: Register_PFT_prt_organs + procedure, private :: Receive_PFT_prt_organs procedure, private :: Register_PFT_numrad procedure, private :: Receive_PFT_numrad end type EDPftvarcon_type @@ -253,6 +255,7 @@ subroutine Register(this, fates_params) call this%Register_PFT_numrad(fates_params) call this%Register_PFT_nvariants(fates_params) call this%Register_PFT_hydr_organs(fates_params) + call this%Register_PFT_prt_organs(fates_params) end subroutine Register @@ -270,6 +273,7 @@ subroutine Receive(this, fates_params) call this%Receive_PFT_numrad(fates_params) call this%Receive_PFT_nvariants(fates_params) call this%Receive_PFT_hydr_organs(fates_params) + call this%Receive_PFT_prt_organs(fates_params) end subroutine Receive @@ -394,8 +398,6 @@ 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_roota_par' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) @@ -445,18 +447,6 @@ 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_leaf_cn_ratio' - call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names, lower_bounds=dim_lower_bound) - - name = 'fates_froot_cn_ratio' - call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names, lower_bounds=dim_lower_bound) - - name = 'fates_wood_cn_ratio' - call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'fates_smpso' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) @@ -1913,41 +1903,64 @@ subroutine FatesCheckParams(is_master, parteh_model) ! Note to advanced users. Feel free to remove these checks... ! ------------------------------------------------------------------- - if ( (EDPftvarcon_inst%turnover_carb_retrans_p1(ipft,repro_organ) > nearzero) .or. & - (EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,repro_organ) > nearzero) .or. & - (EDPftvarcon_inst%turnover_phos_retrans_p1(ipft,repro_organ) > nearzero) ) then + if ( (EDPftvarcon_inst%turnover_carb_retrans_p1(ipft,repro_organ) > nearzero) ) then write(fates_log(),*) ' Retranslocation of reproductive tissues should be zero.' write(fates_log(),*) ' PFT#: ',ipft write(fates_log(),*) ' carbon: ',EDPftvarcon_inst%turnover_carb_retrans_p1(ipft,repro_organ) - write(fates_log(),*) ' nitr: ',EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,repro_organ) - write(fates_log(),*) ' phos: ',EDPftvarcon_inst%turnover_phos_retrans_p1(ipft,repro_organ) write(fates_log(),*) ' Aborting' call endrun(msg=errMsg(sourcefile, __LINE__)) end if - - if ((EDPftvarcon_inst%turnover_carb_retrans_p1(ipft,sapw_organ) > nearzero) .or. & - (EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,sapw_organ) > nearzero) .or. & - (EDPftvarcon_inst%turnover_phos_retrans_p1(ipft,sapw_organ) > nearzero) ) then + if (parteh_model .eq. 2) then + if ((EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,repro_organ) > nearzero) .or. & + (EDPftvarcon_inst%turnover_phos_retrans_p1(ipft,repro_organ) > nearzero) ) then + write(fates_log(),*) ' Retranslocation of reproductive tissues should be zero.' + write(fates_log(),*) ' PFT#: ',ipft + write(fates_log(),*) ' carbon: ',EDPftvarcon_inst%turnover_carb_retrans_p1(ipft,repro_organ) + write(fates_log(),*) ' nitr: ',EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,repro_organ) + write(fates_log(),*) ' phos: ',EDPftvarcon_inst%turnover_phos_retrans_p1(ipft,repro_organ) + write(fates_log(),*) ' Aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + end if + + if ((EDPftvarcon_inst%turnover_carb_retrans_p1(ipft,sapw_organ) > nearzero)) then write(fates_log(),*) ' Retranslocation of sapwood tissues should be zero.' write(fates_log(),*) ' PFT#: ',ipft write(fates_log(),*) ' carbon: ',EDPftvarcon_inst%turnover_carb_retrans_p1(ipft,sapw_organ) - write(fates_log(),*) ' nitr: ',EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,sapw_organ) - write(fates_log(),*) ' phos: ',EDPftvarcon_inst%turnover_phos_retrans_p1(ipft,sapw_organ) write(fates_log(),*) ' Aborting' call endrun(msg=errMsg(sourcefile, __LINE__)) end if + if (parteh_model .eq. 2) then + if ((EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,sapw_organ) > nearzero) .or. & + (EDPftvarcon_inst%turnover_phos_retrans_p1(ipft,sapw_organ) > nearzero) ) then + write(fates_log(),*) ' Retranslocation of sapwood tissues should be zero.' + write(fates_log(),*) ' PFT#: ',ipft + write(fates_log(),*) ' carbon: ',EDPftvarcon_inst%turnover_carb_retrans_p1(ipft,sapw_organ) + write(fates_log(),*) ' nitr: ',EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,sapw_organ) + write(fates_log(),*) ' phos: ',EDPftvarcon_inst%turnover_phos_retrans_p1(ipft,sapw_organ) + write(fates_log(),*) ' Aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + end if - if ((EDPftvarcon_inst%turnover_carb_retrans_p1(ipft,struct_organ) > nearzero) .or. & - (EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,struct_organ) > nearzero) .or. & - (EDPftvarcon_inst%turnover_phos_retrans_p1(ipft,struct_organ) > nearzero) ) then + if ((EDPftvarcon_inst%turnover_carb_retrans_p1(ipft,struct_organ) > nearzero)) then write(fates_log(),*) ' Retranslocation of structural(dead) tissues should be zero.' write(fates_log(),*) ' PFT#: ',ipft write(fates_log(),*) ' carbon: ',EDPftvarcon_inst%turnover_carb_retrans_p1(ipft,struct_organ) - write(fates_log(),*) ' nitr: ',EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,struct_organ) - write(fates_log(),*) ' phos: ',EDPftvarcon_inst%turnover_phos_retrans_p1(ipft,struct_organ) write(fates_log(),*) ' Aborting' call endrun(msg=errMsg(sourcefile, __LINE__)) end if + if (parteh_model .eq. 2) then + if ((EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,struct_organ) > nearzero) .or. & + (EDPftvarcon_inst%turnover_phos_retrans_p1(ipft,struct_organ) > nearzero) ) then + write(fates_log(),*) ' Retranslocation of structural(dead) tissues should be zero.' + write(fates_log(),*) ' PFT#: ',ipft + write(fates_log(),*) ' nitr: ',EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,struct_organ) + write(fates_log(),*) ' phos: ',EDPftvarcon_inst%turnover_phos_retrans_p1(ipft,struct_organ) + write(fates_log(),*) ' Aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + end if ! Leaf retranslocation should be between 0 and 1 if ( (EDPftvarcon_inst%turnover_carb_retrans_p1(ipft,leaf_organ) > 1.0_r8) .or. & @@ -2038,18 +2051,27 @@ subroutine FatesCheckParams(is_master, parteh_model) end if ! Stoichiometric Ratios + + ! The first nitrogen stoichiometry is used in all cases if ( (any(EDPftvarcon_inst%prt_nitr_stoich_p1(ipft,:) < 0.0_r8)) .or. & - (any(EDPftvarcon_inst%prt_nitr_stoich_p1(ipft,:) >= 1.0_r8)) .or. & - (any(EDPftvarcon_inst%prt_nitr_stoich_p2(ipft,:) < 0.0_r8)) .or. & - (any(EDPftvarcon_inst%prt_nitr_stoich_p2(ipft,:) >= 1.0_r8)) ) then + (any(EDPftvarcon_inst%prt_nitr_stoich_p1(ipft,:) >= 1.0_r8))) then write(fates_log(),*) ' PFT#: ',ipft write(fates_log(),*) ' N per C stoichiometry must bet between 0-1' write(fates_log(),*) EDPftvarcon_inst%prt_nitr_stoich_p1(ipft,:) - write(fates_log(),*) EDPftvarcon_inst%prt_nitr_stoich_p2(ipft,:) write(fates_log(),*) ' Aborting' call endrun(msg=errMsg(sourcefile, __LINE__)) end if - + if(parteh_model .eq. 2) then + if( (any(EDPftvarcon_inst%prt_nitr_stoich_p2(ipft,:) < 0.0_r8)) .or. & + (any(EDPftvarcon_inst%prt_nitr_stoich_p2(ipft,:) >= 1.0_r8)) ) then + write(fates_log(),*) ' PFT#: ',ipft + write(fates_log(),*) ' N per C stoichiometry must bet between 0-1' + write(fates_log(),*) EDPftvarcon_inst%prt_nitr_stoich_p2(ipft,:) + write(fates_log(),*) ' Aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + end if + ! Stoichiometric Ratios if (parteh_model .eq. 2) then if ( (any(EDPftvarcon_inst%prt_phos_stoich_p1(ipft,:) < 0.0_r8)) .or. & @@ -2065,15 +2087,7 @@ subroutine FatesCheckParams(is_master, parteh_model) end if end if - if (parteh_model .eq. 1) then - if (any(EDPftvarcon_inst%prt_alloc_priority(ipft,:) .ne. 0)) then - write(fates_log(),*) ' PFT#: ',ipft - write(fates_log(),*) ' Allocation priorities should be 0 for H1' - write(fates_log(),*) EDPftvarcon_inst%prt_alloc_priority(ipft,:) - write(fates_log(),*) ' Aborting' - call endrun(msg=errMsg(sourcefile, __LINE__)) - end if - elseif (parteh_model .eq. 2) then + if (parteh_model .eq. 2) then if ( any(EDPftvarcon_inst%prt_alloc_priority(ipft,:) < 0) .or. & any(EDPftvarcon_inst%prt_alloc_priority(ipft,:) > 6) ) then write(fates_log(),*) ' PFT#: ',ipft diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 98973dff8e..7affcaa5d1 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -212,16 +212,6 @@ module EDTypesMod real(r8) :: resp_acc real(r8) :: resp_acc_hold - ! Plant Tissue Carbon Fluxes - - ! Fluxes in from Net Primary Production - real(r8) :: npp_leaf ! NPP into leaves (includes replacement of turnover): KgC/indiv/year - real(r8) :: npp_fnrt ! NPP into fine roots (includes replacement of turnover): KgC/indiv/year - real(r8) :: npp_sapw ! NPP into sapwood: KgC/indiv/year - real(r8) :: npp_dead ! NPP into deadwood (structure): KgC/indiv/year - real(r8) :: npp_seed ! NPP into seeds: KgC/indiv/year - real(r8) :: npp_stor ! NPP into storage: KgC/indiv/year - real(r8) :: ts_net_uptake(nlevleaf) ! Net uptake of leaf layers: kgC/m2/timestep real(r8) :: year_net_uptake(nlevleaf) ! Net uptake of leaf layers: kgC/m2/year @@ -276,11 +266,6 @@ module EDTypesMod real(r8) :: crownfire_mort ! probability of tree post-fire mortality due to crown scorch:- real(r8) :: fire_mort ! post-fire mortality from cambial and crown damage assuming two are independent:- - ! Integration - real(r8) :: ode_opt_step ! What is the current optimum step size - ! for the integrator? (variable units, including kgC, - ! and then time when we have multiple species) - ! Hydraulics type(ed_cohort_hydr_type), pointer :: co_hydr ! All cohort hydraulics data, see FatesHydraulicsMemMod.F90 @@ -772,13 +757,6 @@ subroutine dump_cohort(ccohort) write(fates_log(),*) 'co%resp_tstep = ', ccohort%resp_tstep write(fates_log(),*) 'co%resp_acc = ', ccohort%resp_acc write(fates_log(),*) 'co%resp_acc_hold = ', ccohort%resp_acc_hold - write(fates_log(),*) 'co%npp_leaf = ', ccohort%npp_leaf - write(fates_log(),*) 'co%npp_fnrt = ', ccohort%npp_fnrt - write(fates_log(),*) 'co%npp_sapw = ', ccohort%npp_sapw - write(fates_log(),*) 'co%npp_dead = ', ccohort%npp_dead - write(fates_log(),*) 'co%npp_seed = ', ccohort%npp_seed - write(fates_log(),*) 'co%npp_stor = ', ccohort%npp_stor - write(fates_log(),*) 'co%ode_opt_step = ', ccohort%ode_opt_step write(fates_log(),*) 'co%rdark = ', ccohort%rdark write(fates_log(),*) 'co%resp_m = ', ccohort%resp_m write(fates_log(),*) 'co%resp_g = ', ccohort%resp_g diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 2b39dd6db2..9b519ae699 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -1636,12 +1636,29 @@ subroutine update_history_dyn(this,nc,nsites,sites) endif ! Update biomass components - + + + ! Mass pools [kgC] sapw_c = ccohort%prt%GetState(sapw_organ, all_carbon_species) struct_c = ccohort%prt%GetState(struct_organ, all_carbon_species) leaf_c = ccohort%prt%GetState(leaf_organ, all_carbon_species) fnrt_c = ccohort%prt%GetState(fnrt_organ, all_carbon_species) store_c = ccohort%prt%GetState(store_organ, all_carbon_species) + + ! Turnover pools [kgC] * [/yr] = [kgC/yr] + sapw_c_turnover = ccohort%prt%GetTurnover(sapw_organ, all_carbon_species) * hlm_freq_day + store_c_turnover = ccohort%prt%GetTurnover(store_organ, all_carbon_species) * hlm_freq_day + leaf_c_turnover = ccohort%prt%GetTurnover(leaf_organ, all_carbon_species) * hlm_freq_day + fnrt_c_turnover = ccohort%prt%GetTurnover(fnrt_organ, all_carbon_species) * hlm_freq_day + struct_c_turnover = ccohort%prt%GetTurnover(struct_organ, all_carbon_species) * hlm_freq_day + + ! Net change from allocation and transport [kgC] * [/yr] = [kgC/yr] + sapw_c_net_art = ccohort%prt%GetNetArt(sapw_organ, all_carbon_species) * hlm_freq_day + store_c_net_art = ccohort%prt%GetNetArt(store_organ, all_carbon_species) * hlm_freq_day + leaf_c_net_art = ccohort%prt%GetNetArt(leaf_organ, all_carbon_species) * hlm_freq_day + fnrt_c_net_art = ccohort%prt%GetNetArt(fnrt_organ, all_carbon_species) * hlm_freq_day + struct_c_net_art = ccohort%prt%GetNetArt(struct_organ, all_carbon_species) * hlm_freq_day + repro_c_net_art = ccohort%prt%GetNetArt(repro_organ, all_carbon_species) * hlm_freq_day alive_c = leaf_c + fnrt_c + sapw_c total_c = alive_c + store_c + struct_c @@ -1681,14 +1698,14 @@ subroutine update_history_dyn(this,nc,nsites,sites) ! ecosystem-level, organ-partitioned NPP/allocation fluxes - hio_npp_leaf_si(io_si) = hio_npp_leaf_si(io_si) + ccohort%npp_leaf * n_perm2 - hio_npp_seed_si(io_si) = hio_npp_seed_si(io_si) + ccohort%npp_seed * n_perm2 - hio_npp_stem_si(io_si) = hio_npp_stem_si(io_si) + (ccohort%npp_sapw + ccohort%npp_dead) * n_perm2 * & + hio_npp_leaf_si(io_si) = hio_npp_leaf_si(io_si) + leaf_c_net_art * n_perm2 + hio_npp_seed_si(io_si) = hio_npp_seed_si(io_si) + repro_c_net_art * n_perm2 + hio_npp_stem_si(io_si) = hio_npp_stem_si(io_si) + (sapw_c_net_art + struct_c_net_art) * n_perm2 * & (EDPftvarcon_inst%allom_agb_frac(ccohort%pft)) - hio_npp_froot_si(io_si) = hio_npp_froot_si(io_si) + ccohort%npp_fnrt * n_perm2 - hio_npp_croot_si(io_si) = hio_npp_croot_si(io_si) + (ccohort%npp_sapw + ccohort%npp_dead) * n_perm2 * & + hio_npp_froot_si(io_si) = hio_npp_froot_si(io_si) + fnrt_c_net_art * n_perm2 + hio_npp_croot_si(io_si) = hio_npp_croot_si(io_si) + (sapw_c_net_art + struct_c_net_art) * n_perm2 * & (1._r8-EDPftvarcon_inst%allom_agb_frac(ccohort%pft)) - hio_npp_stor_si(io_si) = hio_npp_stor_si(io_si) + ccohort%npp_stor * n_perm2 + hio_npp_stor_si(io_si) = hio_npp_stor_si(io_si) + store_c_net_art * n_perm2 ! Site by Size-Class x PFT (SCPF) ! ------------------------------------------------------------------------ @@ -1707,39 +1724,25 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_npp_totl_si_scpf(io_si,scpf) = hio_npp_totl_si_scpf(io_si,scpf) + & ccohort%npp_acc_hold *n_perm2 hio_npp_leaf_si_scpf(io_si,scpf) = hio_npp_leaf_si_scpf(io_si,scpf) + & - ccohort%npp_leaf*n_perm2 + leaf_c_net_art*n_perm2 hio_npp_fnrt_si_scpf(io_si,scpf) = hio_npp_fnrt_si_scpf(io_si,scpf) + & - ccohort%npp_fnrt*n_perm2 + fnrt_c_net_art*n_perm2 hio_npp_bgsw_si_scpf(io_si,scpf) = hio_npp_bgsw_si_scpf(io_si,scpf) + & - ccohort%npp_sapw*n_perm2* & + sapw_c_net_art*n_perm2* & (1._r8-EDPftvarcon_inst%allom_agb_frac(ccohort%pft)) hio_npp_agsw_si_scpf(io_si,scpf) = hio_npp_agsw_si_scpf(io_si,scpf) + & - ccohort%npp_sapw*n_perm2* & + sapw_c_net_art*n_perm2* & EDPftvarcon_inst%allom_agb_frac(ccohort%pft) hio_npp_bgdw_si_scpf(io_si,scpf) = hio_npp_bgdw_si_scpf(io_si,scpf) + & - ccohort%npp_dead*n_perm2* & + struct_c_net_art*n_perm2* & (1._r8-EDPftvarcon_inst%allom_agb_frac(ccohort%pft)) hio_npp_agdw_si_scpf(io_si,scpf) = hio_npp_agdw_si_scpf(io_si,scpf) + & - ccohort%npp_dead*n_perm2* & + struct_c_net_art*n_perm2* & EDPftvarcon_inst%allom_agb_frac(ccohort%pft) hio_npp_seed_si_scpf(io_si,scpf) = hio_npp_seed_si_scpf(io_si,scpf) + & - ccohort%npp_seed*n_perm2 + repro_c_net_art*n_perm2 hio_npp_stor_si_scpf(io_si,scpf) = hio_npp_stor_si_scpf(io_si,scpf) + & - ccohort%npp_stor*n_perm2 - - npp_partition_error = abs(ccohort%npp_acc_hold-(ccohort%npp_leaf+ccohort%npp_fnrt+ & - ccohort%npp_sapw+ccohort%npp_dead+ & - ccohort%npp_seed+ccohort%npp_stor)) - if( npp_partition_error > 100.0_r8*calloc_abs_error ) then - write(fates_log(),*) 'NPP Partitions are not balancing' - write(fates_log(),*) 'Absolute Error [kgC/day]: ',npp_partition_error - write(fates_log(),*) 'Fractional Error: ', abs(npp_partition_error/ccohort%npp_acc_hold) - write(fates_log(),*) 'Terms: ',ccohort%npp_acc_hold,ccohort%npp_leaf,ccohort%npp_fnrt, & - ccohort%npp_sapw,ccohort%npp_dead, & - ccohort%npp_seed,ccohort%npp_stor - write(fates_log(),*) ' NPP components during FATES-HLM linking does not balance ' - call endrun(msg=errMsg(__FILE__, __LINE__)) - end if + store_c_net_art*n_perm2 ! Woody State Variables (basal area and number density and mortality) if (EDPftvarcon_inst%woody(ft) == 1) then @@ -1806,20 +1809,7 @@ 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 - ! Calculate turnover and allocation rates (these are in total kg/day) - - sapw_c_turnover = ccohort%prt%GetTurnover(sapw_organ, all_carbon_species) - store_c_turnover = ccohort%prt%GetTurnover(store_organ, all_carbon_species) - leaf_c_turnover = ccohort%prt%GetTurnover(leaf_organ, all_carbon_species) - fnrt_c_turnover = ccohort%prt%GetTurnover(fnrt_organ, all_carbon_species) - struct_c_turnover = ccohort%prt%GetTurnover(struct_organ, all_carbon_species) - - sapw_c_net_art = ccohort%prt%GetNetArt(sapw_organ, all_carbon_species) - store_c_net_art = ccohort%prt%GetNetArt(store_organ, all_carbon_species) - leaf_c_net_art = ccohort%prt%GetNetArt(leaf_organ, all_carbon_species) - fnrt_c_net_art = ccohort%prt%GetNetArt(fnrt_organ, all_carbon_species) - struct_c_net_art = ccohort%prt%GetNetArt(struct_organ, all_carbon_species) - repro_c_net_art = ccohort%prt%GetNetArt(repro_organ, all_carbon_species) + ! update SCPF/SCLS- and canopy/subcanopy- partitioned quantities if (ccohort%canopy_layer .eq. 1) then @@ -1892,17 +1882,17 @@ subroutine update_history_dyn(this,nc,nsites,sites) ccohort%seed_prod * ccohort%n hio_npp_leaf_canopy_si_scls(io_si,scls) = hio_npp_leaf_canopy_si_scls(io_si,scls) + & - leaf_c_net_art * ccohort%n * hlm_freq_day + leaf_c_net_art * ccohort%n hio_npp_fnrt_canopy_si_scls(io_si,scls) = hio_npp_fnrt_canopy_si_scls(io_si,scls) + & - fnrt_c_net_art * ccohort%n * hlm_freq_day + fnrt_c_net_art * ccohort%n hio_npp_sapw_canopy_si_scls(io_si,scls) = hio_npp_sapw_canopy_si_scls(io_si,scls) + & - sapw_c_net_art * ccohort%n * hlm_freq_day + sapw_c_net_art * ccohort%n hio_npp_dead_canopy_si_scls(io_si,scls) = hio_npp_dead_canopy_si_scls(io_si,scls) + & - struct_c_net_art * ccohort%n * hlm_freq_day + struct_c_net_art * ccohort%n hio_npp_seed_canopy_si_scls(io_si,scls) = hio_npp_seed_canopy_si_scls(io_si,scls) + & - repro_c_net_art * ccohort%n * hlm_freq_day + repro_c_net_art * ccohort%n hio_npp_stor_canopy_si_scls(io_si,scls) = hio_npp_stor_canopy_si_scls(io_si,scls) + & - store_c_net_art * ccohort%n * hlm_freq_day + store_c_net_art * ccohort%n hio_yesterdaycanopylevel_canopy_si_scls(io_si,scls) = & hio_yesterdaycanopylevel_canopy_si_scls(io_si,scls) + & @@ -1973,18 +1963,18 @@ subroutine update_history_dyn(this,nc,nsites,sites) ccohort%seed_prod * ccohort%n hio_npp_leaf_understory_si_scls(io_si,scls) = hio_npp_leaf_understory_si_scls(io_si,scls) + & - leaf_c_net_art * ccohort%n * hlm_freq_day + leaf_c_net_art * ccohort%n hio_npp_fnrt_understory_si_scls(io_si,scls) = hio_npp_fnrt_understory_si_scls(io_si,scls) + & - fnrt_c_net_art * ccohort%n * hlm_freq_day + fnrt_c_net_art * ccohort%n hio_npp_sapw_understory_si_scls(io_si,scls) = hio_npp_sapw_understory_si_scls(io_si,scls) + & - sapw_c_net_art * ccohort%n * hlm_freq_day + sapw_c_net_art * ccohort%n hio_npp_dead_understory_si_scls(io_si,scls) = hio_npp_dead_understory_si_scls(io_si,scls) + & - struct_c_net_art * ccohort%n * hlm_freq_day + struct_c_net_art * ccohort%n hio_npp_seed_understory_si_scls(io_si,scls) = hio_npp_seed_understory_si_scls(io_si,scls) + & - repro_c_net_art * ccohort%n * hlm_freq_day + repro_c_net_art * ccohort%n hio_npp_stor_understory_si_scls(io_si,scls) = hio_npp_stor_understory_si_scls(io_si,scls) + & - store_c_net_art * ccohort%n * hlm_freq_day - + store_c_net_art * ccohort%n + hio_yesterdaycanopylevel_understory_si_scls(io_si,scls) = & hio_yesterdaycanopylevel_understory_si_scls(io_si,scls) + & ccohort%canopy_layer_yesterday * ccohort%n diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index cbc6378ee4..3b249f94e1 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -1465,7 +1465,7 @@ subroutine set_fates_ctrlparms(tag,ival,rval,cval) write(fates_log(),*) 'Transfering hlm_use_vertsoilc= ',ival,' to FATES' end if - case('parteh_model') + case('parteh_mode') hlm_parteh_model = ival if (fates_global_verbose()) then write(fates_log(),*) 'Transfering hlm_parteh_model= ',ival,' to FATES' @@ -1584,7 +1584,7 @@ subroutine InitPARTEHGlobals() ! Initialize the Plant Allocation and Reactive Transport ! global functions and mapping tables - select case(int(hlm_parteh_model)) + select case(hlm_parteh_model) case (1) call InitPRTInstanceAC() case(2) diff --git a/main/FatesRestartInterfaceMod.F90 b/main/FatesRestartInterfaceMod.F90 index e28b91f74c..3d8bd2d16b 100644 --- a/main/FatesRestartInterfaceMod.F90 +++ b/main/FatesRestartInterfaceMod.F90 @@ -107,15 +107,7 @@ module FatesRestartInterfaceMod integer, private :: ir_gpp_acc_hold_co integer, private :: ir_npp_acc_hold_co integer, private :: ir_resp_acc_hold_co - integer, private :: ir_npp_leaf_co - integer, private :: ir_npp_froot_co - integer, private :: ir_npp_sw_co - integer, private :: ir_npp_dead_co - integer, private :: ir_npp_seed_co - integer, private :: ir_npp_store_co - - integer, private :: ir_ode_opt_step_co - + integer, private :: ir_bmort_co integer, private :: ir_hmort_co integer, private :: ir_cmort_co @@ -129,8 +121,6 @@ module FatesRestartInterfaceMod integer, private :: ir_ddbhdt_co - integer, private :: ir_dbdeaddt_co - integer, private :: ir_dbstoredt_co integer, private :: ir_resp_tstep_co integer, private :: ir_pft_co integer, private :: ir_status_co @@ -714,41 +704,6 @@ subroutine define_restart_vars(this, initialize_variables) units='kgC/indiv/year', flushval = flushzero, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_resp_acc_hold_co ) - call this%set_restart_var(vname='fates_npp_leaf', vtype=cohort_r8, & - long_name='ed cohort - npp sent to leaves', & - units='kgC/indiv/day', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_npp_leaf_co ) - - call this%set_restart_var(vname='fates_npp_froot', vtype=cohort_r8, & - long_name='ed cohort - npp sent to fine roots', & - units='kgC/indiv/day', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_npp_froot_co ) - - call this%set_restart_var(vname='fates_npp_sapwood', vtype=cohort_r8, & - long_name='ed cohort - npp sent to sapwood', & - units='kgC/indiv/day', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_npp_sw_co ) - - call this%set_restart_var(vname='fates_npp_bdead', vtype=cohort_r8, & - long_name='ed cohort - npp sent to dead (structure) biomass in live plants', & - units='kgC/indiv/day', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_npp_dead_co ) - - call this%set_restart_var(vname='fates_npp_seed', vtype=cohort_r8, & - long_name='ed cohort - npp sent to seed biomass', & - units='kgC/indiv/day', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_npp_seed_co ) - - call this%set_restart_var(vname='fates_npp_store', vtype=cohort_r8, & - long_name='ed cohort - npp sent to storage biomass', & - units='kgC/indiv/day', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_npp_store_co ) - - call this%set_restart_var(vname='fates_ode_opt_step', vtype=cohort_r8, & - long_name='ed cohort - current ode integrator step size', & - units='-', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_ode_opt_step_co) - call this%set_restart_var(vname='fates_bmort', vtype=cohort_r8, & long_name='ed cohort - background mortality rate', & units='/year', flushval = flushzero, & @@ -795,16 +750,6 @@ subroutine define_restart_vars(this, initialize_variables) units='cm/year', flushval = flushzero, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_ddbhdt_co ) - call this%set_restart_var(vname='fates_dbdeaddt', vtype=cohort_r8, & - long_name='ed cohort - differential: ddbh/dt', & - units='cm/year', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_dbdeaddt_co ) - - call this%set_restart_var(vname='fates_dbstoredt', vtype=cohort_r8, & - long_name='ed cohort - differential: ddbh/dt', & - units='cm/year', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_dbstoredt_co ) - call this%set_restart_var(vname='fates_resp_tstep', vtype=cohort_r8, & long_name='ed cohort - autotrophic respiration over timestep', & units='kgC/indiv/timestep', flushval = flushzero, & @@ -1070,14 +1015,6 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_gpp_acc_hold_co => this%rvars(ir_gpp_acc_hold_co)%r81d, & rio_resp_acc_hold_co => this%rvars(ir_resp_acc_hold_co)%r81d, & rio_npp_acc_hold_co => this%rvars(ir_npp_acc_hold_co)%r81d, & - rio_npp_leaf_co => this%rvars(ir_npp_leaf_co)%r81d, & - rio_npp_froot_co => this%rvars(ir_npp_froot_co)%r81d, & - rio_npp_sw_co => this%rvars(ir_npp_sw_co)%r81d, & - rio_npp_dead_co => this%rvars(ir_npp_dead_co)%r81d, & - rio_npp_seed_co => this%rvars(ir_npp_seed_co)%r81d, & - rio_npp_store_co => this%rvars(ir_npp_store_co)%r81d, & - - rio_ode_opt_step_co => this%rvars(ir_ode_opt_step_co)%r81d, & rio_bmort_co => this%rvars(ir_bmort_co)%r81d, & rio_hmort_co => this%rvars(ir_hmort_co)%r81d, & @@ -1088,8 +1025,6 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_lmort_collateral_co => this%rvars(ir_lmort_collateral_co)%r81d, & rio_lmort_infra_co => this%rvars(ir_lmort_infra_co)%r81d, & rio_ddbhdt_co => this%rvars(ir_ddbhdt_co)%r81d, & - rio_dbdeaddt_co => this%rvars(ir_dbdeaddt_co)%r81d, & - rio_dbstoredt_co => this%rvars(ir_dbstoredt_co)%r81d, & rio_resp_tstep_co => this%rvars(ir_resp_tstep_co)%r81d, & rio_pft_co => this%rvars(ir_pft_co)%int1d, & rio_status_co => this%rvars(ir_status_co)%int1d, & @@ -1200,13 +1135,7 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_gpp_acc_hold_co(io_idx_co) = ccohort%gpp_acc_hold rio_resp_acc_hold_co(io_idx_co) = ccohort%resp_acc_hold rio_npp_acc_hold_co(io_idx_co) = ccohort%npp_acc_hold - rio_npp_leaf_co(io_idx_co) = ccohort%npp_leaf - rio_npp_froot_co(io_idx_co) = ccohort%npp_fnrt - rio_npp_sw_co(io_idx_co) = ccohort%npp_sapw - rio_npp_dead_co(io_idx_co) = ccohort%npp_dead - rio_npp_seed_co(io_idx_co) = ccohort%npp_seed - rio_npp_store_co(io_idx_co) = ccohort%npp_stor - rio_ode_opt_step_co(io_idx_co) = ccohort%ode_opt_step + rio_bmort_co(io_idx_co) = ccohort%bmort rio_hmort_co(io_idx_co) = ccohort%hmort rio_cmort_co(io_idx_co) = ccohort%cmort @@ -1219,8 +1148,6 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_lmort_infra_co(io_idx_co) = ccohort%lmort_infra rio_ddbhdt_co(io_idx_co) = ccohort%ddbhdt - rio_dbdeaddt_co(io_idx_co) = ccohort%dbdeaddt - rio_dbstoredt_co(io_idx_co) = ccohort%dbstoredt rio_resp_tstep_co(io_idx_co) = ccohort%resp_tstep rio_pft_co(io_idx_co) = ccohort%pft rio_status_co(io_idx_co) = ccohort%status_coh @@ -1660,15 +1587,7 @@ subroutine get_restart_vectors(this, nc, nsites, sites) rio_gpp_acc_hold_co => this%rvars(ir_gpp_acc_hold_co)%r81d, & rio_resp_acc_hold_co => this%rvars(ir_resp_acc_hold_co)%r81d, & rio_npp_acc_hold_co => this%rvars(ir_npp_acc_hold_co)%r81d, & - rio_npp_leaf_co => this%rvars(ir_npp_leaf_co)%r81d, & - rio_npp_froot_co => this%rvars(ir_npp_froot_co)%r81d, & - rio_npp_sw_co => this%rvars(ir_npp_sw_co)%r81d, & - rio_npp_dead_co => this%rvars(ir_npp_dead_co)%r81d, & - rio_npp_seed_co => this%rvars(ir_npp_seed_co)%r81d, & - rio_npp_store_co => this%rvars(ir_npp_store_co)%r81d, & - - rio_ode_opt_step_co => this%rvars(ir_ode_opt_step_co)%r81d, & - + rio_bmort_co => this%rvars(ir_bmort_co)%r81d, & rio_hmort_co => this%rvars(ir_hmort_co)%r81d, & rio_cmort_co => this%rvars(ir_cmort_co)%r81d, & @@ -1680,8 +1599,6 @@ subroutine get_restart_vectors(this, nc, nsites, sites) rio_lmort_infra_co => this%rvars(ir_lmort_infra_co)%r81d, & rio_ddbhdt_co => this%rvars(ir_ddbhdt_co)%r81d, & - rio_dbdeaddt_co => this%rvars(ir_dbdeaddt_co)%r81d, & - rio_dbstoredt_co => this%rvars(ir_dbstoredt_co)%r81d, & rio_resp_tstep_co => this%rvars(ir_resp_tstep_co)%r81d, & rio_pft_co => this%rvars(ir_pft_co)%int1d, & rio_status_co => this%rvars(ir_status_co)%int1d, & @@ -1777,13 +1694,7 @@ subroutine get_restart_vectors(this, nc, nsites, sites) ccohort%gpp_acc_hold = rio_gpp_acc_hold_co(io_idx_co) ccohort%resp_acc_hold = rio_resp_acc_hold_co(io_idx_co) ccohort%npp_acc_hold = rio_npp_acc_hold_co(io_idx_co) - ccohort%npp_leaf = rio_npp_leaf_co(io_idx_co) - ccohort%npp_fnrt = rio_npp_froot_co(io_idx_co) - ccohort%npp_sapw = rio_npp_sw_co(io_idx_co) - ccohort%npp_dead = rio_npp_dead_co(io_idx_co) - ccohort%npp_seed = rio_npp_seed_co(io_idx_co) - ccohort%npp_stor = rio_npp_store_co(io_idx_co) - ccohort%ode_opt_step = rio_ode_opt_step_co(io_idx_co) + ccohort%bmort = rio_bmort_co(io_idx_co) ccohort%hmort = rio_hmort_co(io_idx_co) ccohort%cmort = rio_cmort_co(io_idx_co) @@ -1796,8 +1707,6 @@ subroutine get_restart_vectors(this, nc, nsites, sites) ccohort%lmort_infra = rio_lmort_infra_co(io_idx_co) ccohort%ddbhdt = rio_ddbhdt_co(io_idx_co) - ccohort%dbdeaddt = rio_dbdeaddt_co(io_idx_co) - ccohort%dbstoredt = rio_dbstoredt_co(io_idx_co) ccohort%resp_tstep = rio_resp_tstep_co(io_idx_co) ccohort%pft = rio_pft_co(io_idx_co) ccohort%status_coh = rio_status_co(io_idx_co) diff --git a/parameter_files/fates_params_default.cdl b/parameter_files/fates_params_default.cdl index 0ffb1ff8aa..22326db946 100644 --- a/parameter_files/fates_params_default.cdl +++ b/parameter_files/fates_params_default.cdl @@ -178,7 +178,7 @@ variables: float fates_prt_nitr_stoich_p1(fates_prt_organs,fates_pft) ; fates_prt_nitr_stoich_p1:units = "(gC/gN)" ; - fates_prt_nitr_stoich_p1:long_name = "nitrogen stoichiometry, parameter 1 (hypothesis dependant meaning)" ; + fates_prt_nitr_stoich_p1:long_name = "nitrogen stoichiometry" ; float fates_prt_nitr_stoich_p2(fates_prt_organs,fates_pft) ; fates_prt_nitr_stoich_p2:units = "(gC/cN)" ; @@ -200,6 +200,10 @@ variables: fates_turnover_retrans_mode:units = "index" ; fates_turnover_retrans_mode:long_name = "retranslocation method for leaf/fineroot turnover" ; + float fates_turnover_carb_retrans_p1(fates_prt_organs,fates_pft) ; + fates_turnover_carb_retrans_p1:units = "na" ; + fates_turnover_carb_retrans_p1:long_name = "retranslocation of carbon in turnover, parameter 1 (hypothesis dependant meaning)" ; + float fates_turnover_nitr_retrans_p1(fates_prt_organs,fates_pft) ; fates_turnover_nitr_retrans_p1:units = "na" ; fates_turnover_nitr_retrans_p1:long_name = "retranslocation of nitrogen in turnover, parameter 1 (hypothesis dependant meaning)" ; @@ -235,9 +239,6 @@ variables: float fates_fr_flig(fates_pft) ; fates_fr_flig:units = "fraction" ; fates_fr_flig:long_name = "Fine root litter lignin fraction" ; - float fates_froot_cn_ratio(fates_pft) ; - fates_froot_cn_ratio:units = "gC/gN" ; - fates_froot_cn_ratio:long_name = "Fine root C:N" ; float fates_grperc(fates_pft) ; fates_grperc:units = "unitless" ; fates_grperc:long_name = "Growth respiration factor" ; @@ -268,9 +269,6 @@ variables: float 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_cn_ratio(fates_pft) ; - fates_leaf_cn_ratio:units = "gC/gN" ; - fates_leaf_cn_ratio:long_name = "Leaf C:N" ; float fates_leaf_diameter(fates_pft) ; fates_leaf_diameter:units = "m" ; fates_leaf_diameter:long_name = "Characteristic leaf dimension" ; @@ -448,9 +446,6 @@ variables: float 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_wood_cn_ratio(fates_pft) ; - fates_wood_cn_ratio:units = "gC/gN" ; - fates_wood_cn_ratio:long_name = "Wood C:N" ; float fates_wood_density(fates_pft) ; fates_wood_density:units = "g/cm3" ; fates_wood_density:long_name = "mean density of woody tissue in plant" ; @@ -749,20 +744,21 @@ data: fates_branch_turnover = 50, 50 ; fates_prt_unit_gr_resp = - _, _, - _, _, - _, _, - _, _, - _, _, - _, _; + 0.11, 0.11, + 0.11, 0.11, + 0.11, 0.11, + 0.11, 0.11, + 0.11, 0.11, + 0.11, 0.11, + 0.11, 0.11; fates_prt_nitr_stoich_p1 = - _, _, - _, _, - _, _, - _, _, - _, _, - _, _; + 0.033, 0.033, + 0.024, 0.024, + 0.0047, 0.0047, + 0.0047, 0.0047, + 0.0047, 0.0047, + 0.0047, 0.0047; fates_prt_nitr_stoich_p2 = _, _, @@ -799,6 +795,14 @@ data: fates_turnover_retrans_mode = 1, 1; + fates_turnover_carb_retrans_p1 = + 0.00, 0.00, + 0.00, 0.00, + 0.00, 0.00, + 0.00, 0.00, + 0.00, 0.00, + 0.00, 0.00; + fates_turnover_nitr_retrans_p1 = _, _, _, _, @@ -833,8 +837,6 @@ data: fates_fr_flig = 0.25, 0.25 ; - fates_froot_cn_ratio = 42, 42 ; - fates_grperc = 0.11, 0.11 ; fates_hydr_avuln_gs = 2.5, 2.5 ; @@ -855,8 +857,6 @@ data: fates_leaf_clumping_index = 0.85, 0.85 ; - fates_leaf_cn_ratio = 30, 30 ; - fates_leaf_diameter = 0.04, 0.04 ; fates_leaf_jmaxha = 43540, 43540 ; @@ -975,8 +975,6 @@ data: fates_trim_limit = 0.3, 0.3 ; - fates_wood_cn_ratio = 210, 210 ; - fates_wood_density = 0.7, 0.7 ; fates_woody = 1, 1 ; diff --git a/parteh/PRTAllometricCarbonMod.F90 b/parteh/PRTAllometricCarbonMod.F90 index 407610764b..eef3645c5a 100644 --- a/parteh/PRTAllometricCarbonMod.F90 +++ b/parteh/PRTAllometricCarbonMod.F90 @@ -583,15 +583,35 @@ subroutine DailyPRTAC(this) ! including structure and reproduction according to their rates ! Use an adaptive euler integration. If the error is not nominal, ! the carbon balance sub-step (deltaC) will be halved and tried again + ! + ! Note that we compare against calloc_abs_error here because it is possible + ! that all the carbon was effectively used up, but a miniscule amount + ! remains due to numerical precision (ie -20 or so), so even though + ! the plant has not been brought to be "on allometry", it thinks it has carbon + ! left to allocate, and thus it must be on allometry when its not. ! ----------------------------------------------------------------------------------- - if( carbon_balance > nearzero ) then + if( carbon_balance > calloc_abs_error ) then ! This routine checks that actual carbon is not below that targets. It does ! allow actual pools to be above the target, and in these cases, it sends ! a false on the "grow_<>" flag, allowing the plant to grow into these pools. ! It also checks to make sure that structural biomass is not above the target. if ( EDPftvarcon_inst%woody(ipft) == itrue ) then + + + if( (target_store_c - store_c)>calloc_abs_error) then + write(fates_log(),*) 'storage is not on-allometry at the growth step' + write(fates_log(),*) 'exiting' + write(fates_log(),*) 'cbal: ',carbon_balance + write(fates_log(),*) 'near-zero',nearzero + write(fates_log(),*) 'store_c: ',store_c + write(fates_log(),*) 'target c: ',target_store_c + write(fates_log(),*) 'store_c0:', store_c0 + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + call TargetAllometryCheck(leaf_c, fnrt_c, sapw_c, & store_c, struct_c, & target_leaf_c, target_fnrt_c, & From d1497bbc46e8a422cfa0ebc3b1e3295bc663c2e7 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Fri, 28 Sep 2018 14:59:01 -0700 Subject: [PATCH 20/52] More debugging for parteh-fates. Added reproductive flux handler. --- biogeochem/EDPhysiologyMod.F90 | 5 ++ main/EDMainMod.F90 | 16 ++++- main/EDPftvarcon.F90 | 23 +++++++ main/FatesHistoryInterfaceMod.F90 | 46 +++++++------- parameter_files/fates_params_default.cdl | 2 +- parteh/PRTGenericMod.F90 | 5 +- parteh/PRTLossFluxesMod.F90 | 77 ++++++++++++++++++++++++ 7 files changed, 147 insertions(+), 27 deletions(-) diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index e67f7034b7..3da783f2cc 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -662,6 +662,8 @@ subroutine phenology_leafonoff(currentSite) ! Retrieve existing leaf and storage carbon + call currentCohort%prt%CheckMassConservation(currentCohort%pft,0) + store_c = currentCohort%prt%GetState(store_organ, carbon12_species) leaf_c = currentCohort%prt%GetState(leaf_organ, carbon12_species) @@ -756,6 +758,9 @@ subroutine phenology_leafonoff(currentSite) endif endif !status endif !drought dec. + + call currentCohort%prt%CheckMassConservation(currentCohort%pft,1) + currentCohort => currentCohort%shorter enddo !currentCohort diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index 5fc8a2387f..7b6f457414 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -67,6 +67,9 @@ module EDMainMod use PRTGenericMod, only : carbon12_species use PRTGenericMod, only : SetState + use PRTLossFluxesMod, only : PRTMaintTurnover + use PRTLossFluxesMod, only : PRTReproRelease + use EDPftvarcon, only : EDPftvarcon_inst ! CIME Globals @@ -158,6 +161,9 @@ subroutine ed_ecosystem_dynamics(currentSite, bc_in) end if + call ed_total_balance_check(currentSite,-1) + + !****************************************************************************** ! Reproduction, Recruitment and Cohort Dynamics : controls cohort organisation !****************************************************************************** @@ -333,11 +339,17 @@ subroutine ed_integrate_state_variables(currentSite, bc_in ) currentSite%flux_in = currentSite%flux_in + currentCohort%npp_acc * currentCohort%n + call currentCohort%prt%CheckMassConservation(ft,3) + call PRTMaintTurnover(currentCohort%prt,ft) + call currentCohort%prt%CheckMassConservation(ft,4) call currentCohort%prt%DailyPRT() + call currentCohort%prt%CheckMassConservation(ft,5) ! Transfer all reproductive tissues into seed production - currentCohort%seed_prod = currentCohort%prt%GetState(repro_organ,all_carbon_species) / hlm_freq_day - call SetState(currentCohort%prt,repro_organ,carbon12_species,0.0_r8) + + call PRTReproRelease(currentCohort%prt,repro_organ,carbon12_species, & + 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. diff --git a/main/EDPftvarcon.F90 b/main/EDPftvarcon.F90 index c2e14c9a5c..29fda91360 100644 --- a/main/EDPftvarcon.F90 +++ b/main/EDPftvarcon.F90 @@ -2052,6 +2052,29 @@ subroutine FatesCheckParams(is_master, parteh_model) ! Stoichiometric Ratios + ! Firstly, the seed production and germination models cannot handle nutrients. So + ! we assume (for now) that seeds do not have nutrients (parteh_mode = 1 is c only) + if(parteh_model .eq. 2) then + if ( (EDPftvarcon_inst%prt_nitr_stoich_p1(ipft,repro_organ) > nearzero) .or. & + (EDPftvarcon_inst%prt_nitr_stoich_p1(ipft,repro_organ) < -nearzero) .or. & + (EDPftvarcon_inst%prt_phos_stoich_p1(ipft,repro_organ) > nearzero) .or. & + (EDPftvarcon_inst%prt_phos_stoich_p1(ipft,repro_organ) < -nearzero) .or. & + (EDPftvarcon_inst%prt_nitr_stoich_p2(ipft,repro_organ) > nearzero) .or. & + (EDPftvarcon_inst%prt_nitr_stoich_p2(ipft,repro_organ) < -nearzero) .or. & + (EDPftvarcon_inst%prt_phos_stoich_p2(ipft,repro_organ) > nearzero) .or. & + (EDPftvarcon_inst%prt_phos_stoich_p2(ipft,repro_organ) < -nearzero) ) then + write(fates_log(),*) 'N & P should be zero in reproductive tissues' + write(fates_log(),*) 'until nutrients are coupled into recruitment' + write(fates_log(),*) ' PFT#: ',ipft + write(fates_log(),*) EDPftvarcon_inst%prt_nitr_stoich_p1(ipft,repro_organ) + write(fates_log(),*) EDPftvarcon_inst%prt_phos_stoich_p1(ipft,repro_organ) + write(fates_log(),*) EDPftvarcon_inst%prt_nitr_stoich_p2(ipft,repro_organ) + write(fates_log(),*) EDPftvarcon_inst%prt_phos_stoich_p2(ipft,repro_organ) + write(fates_log(),*) ' Aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + end if + ! The first nitrogen stoichiometry is used in all cases if ( (any(EDPftvarcon_inst%prt_nitr_stoich_p1(ipft,:) < 0.0_r8)) .or. & (any(EDPftvarcon_inst%prt_nitr_stoich_p1(ipft,:) >= 1.0_r8))) then diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 9b519ae699..9ff5aeb333 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -1645,20 +1645,20 @@ subroutine update_history_dyn(this,nc,nsites,sites) fnrt_c = ccohort%prt%GetState(fnrt_organ, all_carbon_species) store_c = ccohort%prt%GetState(store_organ, all_carbon_species) - ! Turnover pools [kgC] * [/yr] = [kgC/yr] - sapw_c_turnover = ccohort%prt%GetTurnover(sapw_organ, all_carbon_species) * hlm_freq_day - store_c_turnover = ccohort%prt%GetTurnover(store_organ, all_carbon_species) * hlm_freq_day - leaf_c_turnover = ccohort%prt%GetTurnover(leaf_organ, all_carbon_species) * hlm_freq_day - fnrt_c_turnover = ccohort%prt%GetTurnover(fnrt_organ, all_carbon_species) * hlm_freq_day - struct_c_turnover = ccohort%prt%GetTurnover(struct_organ, all_carbon_species) * hlm_freq_day + ! Turnover pools [kgC/day] / [yr/day] = [kgC/yr] + sapw_c_turnover = ccohort%prt%GetTurnover(sapw_organ, all_carbon_species) / hlm_freq_day + store_c_turnover = ccohort%prt%GetTurnover(store_organ, all_carbon_species) / hlm_freq_day + leaf_c_turnover = ccohort%prt%GetTurnover(leaf_organ, all_carbon_species) / hlm_freq_day + fnrt_c_turnover = ccohort%prt%GetTurnover(fnrt_organ, all_carbon_species) / hlm_freq_day + struct_c_turnover = ccohort%prt%GetTurnover(struct_organ, all_carbon_species) / hlm_freq_day - ! Net change from allocation and transport [kgC] * [/yr] = [kgC/yr] - sapw_c_net_art = ccohort%prt%GetNetArt(sapw_organ, all_carbon_species) * hlm_freq_day - store_c_net_art = ccohort%prt%GetNetArt(store_organ, all_carbon_species) * hlm_freq_day - leaf_c_net_art = ccohort%prt%GetNetArt(leaf_organ, all_carbon_species) * hlm_freq_day - fnrt_c_net_art = ccohort%prt%GetNetArt(fnrt_organ, all_carbon_species) * hlm_freq_day - struct_c_net_art = ccohort%prt%GetNetArt(struct_organ, all_carbon_species) * hlm_freq_day - repro_c_net_art = ccohort%prt%GetNetArt(repro_organ, all_carbon_species) * hlm_freq_day + ! Net change from allocation and transport [kgC/day] / [yr/day] = [kgC/yr] + sapw_c_net_art = ccohort%prt%GetNetArt(sapw_organ, all_carbon_species) / hlm_freq_day + store_c_net_art = ccohort%prt%GetNetArt(store_organ, all_carbon_species) / hlm_freq_day + leaf_c_net_art = ccohort%prt%GetNetArt(leaf_organ, all_carbon_species) / hlm_freq_day + fnrt_c_net_art = ccohort%prt%GetNetArt(fnrt_organ, all_carbon_species) / hlm_freq_day + struct_c_net_art = ccohort%prt%GetNetArt(struct_organ, all_carbon_species) / hlm_freq_day + repro_c_net_art = ccohort%prt%GetNetArt(repro_organ, all_carbon_species) / hlm_freq_day alive_c = leaf_c + fnrt_c + sapw_c total_c = alive_c + store_c + struct_c @@ -1869,15 +1869,15 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_leaf_md_canopy_si_scls(io_si,scls) = hio_leaf_md_canopy_si_scls(io_si,scls) + & - leaf_c_turnover * ccohort%n * hlm_freq_day + leaf_c_turnover * ccohort%n hio_root_md_canopy_si_scls(io_si,scls) = hio_root_md_canopy_si_scls(io_si,scls) + & - fnrt_c_turnover * ccohort%n * hlm_freq_day + fnrt_c_turnover * ccohort%n hio_bsw_md_canopy_si_scls(io_si,scls) = hio_bsw_md_canopy_si_scls(io_si,scls) + & - sapw_c_turnover * ccohort%n * hlm_freq_day + sapw_c_turnover * ccohort%n hio_bstore_md_canopy_si_scls(io_si,scls) = hio_bstore_md_canopy_si_scls(io_si,scls) + & - store_c_turnover * ccohort%n * hlm_freq_day + store_c_turnover * ccohort%n hio_bdead_md_canopy_si_scls(io_si,scls) = hio_bdead_md_canopy_si_scls(io_si,scls) + & - struct_c_turnover * ccohort%n * hlm_freq_day + struct_c_turnover * ccohort%n hio_seed_prod_canopy_si_scls(io_si,scls) = hio_seed_prod_canopy_si_scls(io_si,scls) + & ccohort%seed_prod * ccohort%n @@ -1950,15 +1950,15 @@ subroutine update_history_dyn(this,nc,nsites,sites) ccohort%npp_acc_hold * ccohort%n hio_leaf_md_understory_si_scls(io_si,scls) = hio_leaf_md_understory_si_scls(io_si,scls) + & - leaf_c_turnover * ccohort%n * hlm_freq_day + leaf_c_turnover * ccohort%n hio_root_md_understory_si_scls(io_si,scls) = hio_root_md_understory_si_scls(io_si,scls) + & - fnrt_c_turnover * ccohort%n * hlm_freq_day + fnrt_c_turnover * ccohort%n hio_bsw_md_understory_si_scls(io_si,scls) = hio_bsw_md_understory_si_scls(io_si,scls) + & - sapw_c_turnover * ccohort%n * hlm_freq_day + sapw_c_turnover * ccohort%n hio_bstore_md_understory_si_scls(io_si,scls) = hio_bstore_md_understory_si_scls(io_si,scls) + & - store_c_turnover * ccohort%n * hlm_freq_day + store_c_turnover * ccohort%n hio_bdead_md_understory_si_scls(io_si,scls) = hio_bdead_md_understory_si_scls(io_si,scls) + & - struct_c_turnover * ccohort%n * hlm_freq_day + struct_c_turnover * ccohort%n hio_seed_prod_understory_si_scls(io_si,scls) = hio_seed_prod_understory_si_scls(io_si,scls) + & ccohort%seed_prod * ccohort%n diff --git a/parameter_files/fates_params_default.cdl b/parameter_files/fates_params_default.cdl index 22326db946..ae6511265c 100644 --- a/parameter_files/fates_params_default.cdl +++ b/parameter_files/fates_params_default.cdl @@ -757,7 +757,7 @@ data: 0.024, 0.024, 0.0047, 0.0047, 0.0047, 0.0047, - 0.0047, 0.0047, + 0.0, 0.0, 0.0047, 0.0047; fates_prt_nitr_stoich_p2 = diff --git a/parteh/PRTGenericMod.F90 b/parteh/PRTGenericMod.F90 index f347759a9d..6c859d2a62 100644 --- a/parteh/PRTGenericMod.F90 +++ b/parteh/PRTGenericMod.F90 @@ -767,10 +767,12 @@ end subroutine ZeroRates ! ==================================================================================== - subroutine CheckMassConservation(this,ipft) + subroutine CheckMassConservation(this,ipft,position_id) class(prt_vartypes) :: this integer, intent(in) :: ipft + integer, intent(in) :: position_id ! Helps to know where + ! in the call sequence this was called integer :: n_vars ! Number of variables integer :: i_var ! Variable index @@ -801,6 +803,7 @@ subroutine CheckMassConservation(this,ipft) write(fates_log(),*) ' Change in mass over control period should' write(fates_log(),*) ' always equal the integrated fluxes.' write(fates_log(),*) ' pft id: ',ipft + write(fates_log(),*) ' position id: ',position_id write(fates_log(),*) ' organ id: ',this%prt_instance%state_descriptor(i_var)%organ_id write(fates_log(),*) ' species_id: ',this%prt_instance%state_descriptor(i_var)%spec_id write(fates_log(),*) ' position id: ',i_pos diff --git a/parteh/PRTLossFluxesMod.F90 b/parteh/PRTLossFluxesMod.F90 index e2c464197c..9cfc487e29 100644 --- a/parteh/PRTLossFluxesMod.F90 +++ b/parteh/PRTLossFluxesMod.F90 @@ -60,6 +60,7 @@ module PRTLossFluxesMod public :: PRTMaintTurnover public :: PRTBurnLosses public :: PRTPhenologyFlush + public :: PRTReproRelease contains @@ -260,6 +261,82 @@ subroutine PRTBurnLosses(prt, organ_id, mass_fraction) end associate end subroutine PRTBurnLosses + + ! ===================================================================================== + + + subroutine PRTReproRelease(prt, organ_id, spec_id, mass_fraction, mass_out) + + ! This subroutine assumes that there is no re-translocation associated + ! with the release of reproductive tissues. + ! We also do not have a special flux for the release of reproductive + ! tissues. To not confuse this with turnover, we will provide an output + ! mass flux, and instead of tracking it, we will just set val0 to val + ! to prevent mass imbalances. + + class(prt_vartypes) :: prt + integer,intent(in) :: organ_id + integer,intent(in) :: spec_id + real(r8),intent(in) :: mass_fraction + real(r8),intent(out) :: mass_out + + integer :: i_pos ! position index + integer :: i_var ! index for the variable of interest + integer :: spec_id ! Species id of the turnover pool + + + associate(organ_map => prt%prt_instance%organ_map, & + sp_organ_map => prt%prt_instance%sp_organ_map, & + state_descriptor => prt%prt_instance%state_descriptor) + + ! This is the total number of state variables associated + ! with this particular organ. + ! In the future, we may have more finely resolved reproductive + ! 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(),*) 'pft = ',ipft + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + if (spec_id .ne. carbon12_species) then + write(fates_log(),*) 'Reproductive tissue releases were called for a species other than c12' + write(fates_log(),*) 'Only carbon seed masses are curently handled.' + write(fates_log(),*) 'pft = ',ipft + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + ! This is the total number of state variables associated + ! with this particular organ + + i_var = sp_organ_map(organ_id,spec_id) + + ! Reproductive mass leaving the plant + mass_out = 0.0_r8 + + ! Loop over all of the coordinate ids + do i_pos = 1,prt%variables(i_var)%num_pos + + ! The mass that is leaving the plant + mass_out = mass_out + mass_fraction * prt%variables(i_var)%val(i_pos) + + ! 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) - & + (mass_fraction * prt%variables(i_var)%val(i_pos)) + + ! Update the val0 (because we don't give this dedicated flux) + ! This is somewhat of a hack + prt%variables(i_var)%val0(i_pos) = prt%variables(i_var)%val(i_pos) - & + prt%variables(i_var)%net_art(i_pos) + + + end do + + end associate + end subroutine PRTReproRelease + ! =================================================================================== From ec51801aec1ec716e9238c74c5b68bac5e24de39 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Mon, 1 Oct 2018 13:15:24 -0700 Subject: [PATCH 21/52] bug fixes relevant to parteh v0. Fixed root litter accumulation and fusion weighting --- biogeochem/EDCohortDynamicsMod.F90 | 7 ++++--- biogeochem/EDPatchDynamicsMod.F90 | 11 +++++++---- biogeochem/EDPhysiologyMod.F90 | 3 ++- main/ChecksBalancesMod.F90 | 1 - main/EDInitMod.F90 | 7 +++++++ main/EDMainMod.F90 | 11 +++++------ parteh/PRTAllometricCarbonMod.F90 | 15 ++++++--------- parteh/PRTGenericMod.F90 | 4 +--- parteh/PRTLossFluxesMod.F90 | 3 --- 9 files changed, 32 insertions(+), 30 deletions(-) diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index 844e0e20a5..50d4deb771 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -191,8 +191,6 @@ subroutine create_cohort(currentSite, patchptr, pft, nn, hite, dbh, bleaf, bfine call new_cohort%prt%CheckInitialConditions() - - call sizetype_class_index(new_cohort%dbh,new_cohort%pft, & new_cohort%size_class,new_cohort%size_by_pft_class) @@ -586,6 +584,9 @@ subroutine terminate_cohorts( currentSite, currentPatch, level ) 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 @@ -770,7 +771,7 @@ subroutine fuse_cohorts(currentSite, currentPatch, bc_in) ! Fuse all mass pools - call currentCohort%prt%WeightedFusePRTVartypes(nextc%prt, nextc%n/newn ) + call currentCohort%prt%WeightedFusePRTVartypes(nextc%prt, currentCohort%n/newn ) currentCohort%laimemory = (currentCohort%n*currentCohort%laimemory & + nextc%n*nextc%laimemory)/newn diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index d5e95aa88e..1efd285afb 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -50,9 +50,6 @@ module EDPatchDynamicsMod use PRTGenericMod, only : store_organ use PRTGenericMod, only : repro_organ use PRTGenericMod, only : struct_organ - use PRTGenericMod, only : carbon12_species - use PRTGenericMod, only : SetState - use PRTLossFluxesMod, only : PRTBurnLosses @@ -886,6 +883,7 @@ subroutine fire_litter_fluxes(currentSite, cp_target, new_patch_target, patch_si 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 grass. 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] @@ -1062,7 +1060,12 @@ subroutine fire_litter_fluxes(currentSite, cp_target, new_patch_target, patch_si if (burned_leaves > 0.0_r8) then ! Remove burned leaves from the pool - call PRTBurnLosses(currentCohort%prt, leaf_organ, burned_leaves/leaf_c) + 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) !KgC/gridcell/day currentSite%flux_out = currentSite%flux_out + burned_leaves * currentCohort%n * & diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 3da783f2cc..13ae169c94 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -1083,7 +1083,8 @@ subroutine CWD_Input( currentSite, currentPatch) leaf_c_turnover * currentCohort%n/currentPatch%area/hlm_freq_day currentPatch%root_litter_in(pft) = currentPatch%root_litter_in(pft) + & - (fnrt_c_turnover + store_c_turnover ) * currentCohort%n/currentPatch%area + (fnrt_c_turnover + store_c_turnover ) * & + currentCohort%n/currentPatch%area/hlm_freq_day !daily leaf loss needs to be scaled up to the annual scale here. diff --git a/main/ChecksBalancesMod.F90 b/main/ChecksBalancesMod.F90 index 9be70611f9..f7b3235ecc 100644 --- a/main/ChecksBalancesMod.F90 +++ b/main/ChecksBalancesMod.F90 @@ -15,7 +15,6 @@ module ChecksBalancesMod use PRTGenericMod, only : store_organ use PRTGenericMod, only : repro_organ use PRTGenericMod, only : struct_organ - use PRTGenericMod, only : carbon12_species implicit none diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index f25b45409c..1f832ca801 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -439,6 +439,13 @@ subroutine init_cohorts( site_in, patch_in, bc_in) enddo !numpft + ! Zero the mass flux pools of the new cohorts +! temp_cohort => patch_in%tallest +! do while(associated(temp_cohort)) +! call temp_cohort%prt%ZeroRates() +! temp_cohort => temp_cohort%shorter +! end do + call fuse_cohorts(site_in, patch_in,bc_in) call sort_cohorts(patch_in) diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index 7b6f457414..f68cf9dccb 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -64,8 +64,6 @@ module EDMainMod use PRTGenericMod, only : store_organ use PRTGenericMod, only : repro_organ use PRTGenericMod, only : struct_organ - use PRTGenericMod, only : carbon12_species - use PRTGenericMod, only : SetState use PRTLossFluxesMod, only : PRTMaintTurnover use PRTLossFluxesMod, only : PRTReproRelease @@ -118,6 +116,9 @@ subroutine ed_ecosystem_dynamics(currentSite, bc_in) 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 + + ! Call a routine that simply identifies if logging should occur ! This is limited to a global event until more structured event handling is enabled call IsItLoggingTime(hlm_masterproc,currentSite) @@ -161,9 +162,6 @@ subroutine ed_ecosystem_dynamics(currentSite, bc_in) end if - call ed_total_balance_check(currentSite,-1) - - !****************************************************************************** ! Reproduction, Recruitment and Cohort Dynamics : controls cohort organisation !****************************************************************************** @@ -276,6 +274,8 @@ subroutine ed_integrate_state_variables(currentSite, bc_in ) currentSite%dseed_dt(:) = 0._r8 currentSite%seed_rain_flux(:) = 0._r8 + + currentPatch => currentSite%youngest_patch do while(associated(currentPatch)) @@ -346,7 +346,6 @@ subroutine ed_integrate_state_variables(currentSite, bc_in ) call currentCohort%prt%CheckMassConservation(ft,5) ! Transfer all reproductive tissues into seed production - call PRTReproRelease(currentCohort%prt,repro_organ,carbon12_species, & 1.0_r8, currentCohort%seed_prod) currentCohort%seed_prod = currentCohort%seed_prod / hlm_freq_day diff --git a/parteh/PRTAllometricCarbonMod.F90 b/parteh/PRTAllometricCarbonMod.F90 index eef3645c5a..c9dc46fd7f 100644 --- a/parteh/PRTAllometricCarbonMod.F90 +++ b/parteh/PRTAllometricCarbonMod.F90 @@ -23,6 +23,7 @@ module PRTAllometricCarbonMod use PRTGenericMod , only : store_organ use PRTGenericMod , only : repro_organ use PRTGenericMod , only : struct_organ + use PRTGenericMod , only : un_initialized use FatesAllometryMod , only : bleaf use FatesAllometryMod , only : bsap_allom @@ -340,14 +341,6 @@ subroutine DailyPRTAC(this) struct_c => this%variables(struct_c_id)%val(icd)) - ! =================================================================================== - ! - ! !!!! CALCULATIONS THAT SHOULD NOW BE OUTSIDE OF THIS ROUTINE !!!! - ! WE USED TO SET THE "ISNEW" FLAG HERE - ! MAKE SURE THAT IT IS SET AFTER THIS ROUTINE IS CALLED - ! IT SHOULD BE CALLED FOR ANY INSTANCE, NOT JUST THIS - ! currentSite%flux_in = currentSite%flux_in + currentCohort%npp_acc * currentCohort%n - ! ! =================================================================================== ! Copy the boundary conditions into readable local variables @@ -359,7 +352,7 @@ subroutine DailyPRTAC(this) canopy_trim = this%bc_in(ac_bc_in_id_ctrim)%rval ipft = this%bc_in(ac_bc_in_id_pft)%ival - intgr_params(:) = -9.9e32_r8 + intgr_params(:) = un_initialized intgr_params(ac_bc_in_id_ctrim) = this%bc_in(ac_bc_in_id_ctrim)%rval intgr_params(ac_bc_in_id_pft) = real(this%bc_in(ac_bc_in_id_pft)%ival) @@ -784,6 +777,10 @@ subroutine DailyPRTAC(this) this%variables(struct_c_id)%net_art(icd) + (struct_c - struct_c0) + + + + end associate return diff --git a/parteh/PRTGenericMod.F90 b/parteh/PRTGenericMod.F90 index 6c859d2a62..c20823d9a1 100644 --- a/parteh/PRTGenericMod.F90 +++ b/parteh/PRTGenericMod.F90 @@ -155,6 +155,7 @@ module PRTGenericMod ! over the control period real(r8),allocatable :: burned(:) ! Losses due to burn [kg] + ! real(r8),allocatable :: herbiv(:) ! Losses due to herbivory [kg] ! Placeholder @@ -592,9 +593,6 @@ subroutine CopyPRTVartypes(this, donor_prt_obj) this%ode_opt_step = donor_prt_obj%ode_opt_step - this%prt_instance => donor_prt_obj%prt_instance - - return end subroutine CopyPRTVartypes diff --git a/parteh/PRTLossFluxesMod.F90 b/parteh/PRTLossFluxesMod.F90 index 9cfc487e29..b0465c4951 100644 --- a/parteh/PRTLossFluxesMod.F90 +++ b/parteh/PRTLossFluxesMod.F90 @@ -282,7 +282,6 @@ subroutine PRTReproRelease(prt, organ_id, spec_id, mass_fraction, mass_out) integer :: i_pos ! position index integer :: i_var ! index for the variable of interest - integer :: spec_id ! Species id of the turnover pool associate(organ_map => prt%prt_instance%organ_map, & @@ -297,14 +296,12 @@ subroutine PRTReproRelease(prt, organ_id, spec_id, mass_fraction, mass_out) 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(),*) 'pft = ',ipft call endrun(msg=errMsg(__FILE__, __LINE__)) end if if (spec_id .ne. carbon12_species) then write(fates_log(),*) 'Reproductive tissue releases were called for a species other than c12' write(fates_log(),*) 'Only carbon seed masses are curently handled.' - write(fates_log(),*) 'pft = ',ipft call endrun(msg=errMsg(__FILE__, __LINE__)) end if From 33c8fa97012511d279dc80293a80b3fc359cdac0 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Mon, 1 Oct 2018 18:28:19 -0700 Subject: [PATCH 22/52] Enabled object oriented filling/retrieving of PRT variables from restart. Untested --- main/FatesHistoryInterfaceMod.F90 | 33 ++-- main/FatesRestartInterfaceMod.F90 | 269 +++++++++++++++++++++--------- parteh/PRTAllometricCarbonMod.F90 | 22 ++- parteh/PRTGenericMod.F90 | 16 +- 4 files changed, 236 insertions(+), 104 deletions(-) diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 9ff5aeb333..f6ebb86ffd 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -1644,22 +1644,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) leaf_c = ccohort%prt%GetState(leaf_organ, all_carbon_species) fnrt_c = ccohort%prt%GetState(fnrt_organ, all_carbon_species) store_c = ccohort%prt%GetState(store_organ, all_carbon_species) - - ! Turnover pools [kgC/day] / [yr/day] = [kgC/yr] - sapw_c_turnover = ccohort%prt%GetTurnover(sapw_organ, all_carbon_species) / hlm_freq_day - store_c_turnover = ccohort%prt%GetTurnover(store_organ, all_carbon_species) / hlm_freq_day - leaf_c_turnover = ccohort%prt%GetTurnover(leaf_organ, all_carbon_species) / hlm_freq_day - fnrt_c_turnover = ccohort%prt%GetTurnover(fnrt_organ, all_carbon_species) / hlm_freq_day - struct_c_turnover = ccohort%prt%GetTurnover(struct_organ, all_carbon_species) / hlm_freq_day - - ! Net change from allocation and transport [kgC/day] / [yr/day] = [kgC/yr] - sapw_c_net_art = ccohort%prt%GetNetArt(sapw_organ, all_carbon_species) / hlm_freq_day - store_c_net_art = ccohort%prt%GetNetArt(store_organ, all_carbon_species) / hlm_freq_day - leaf_c_net_art = ccohort%prt%GetNetArt(leaf_organ, all_carbon_species) / hlm_freq_day - fnrt_c_net_art = ccohort%prt%GetNetArt(fnrt_organ, all_carbon_species) / hlm_freq_day - struct_c_net_art = ccohort%prt%GetNetArt(struct_organ, all_carbon_species) / hlm_freq_day - repro_c_net_art = ccohort%prt%GetNetArt(repro_organ, all_carbon_species) / hlm_freq_day - + alive_c = leaf_c + fnrt_c + sapw_c total_c = alive_c + store_c + struct_c @@ -1716,6 +1701,22 @@ subroutine update_history_dyn(this,nc,nsites,sites) ! have any meaning, otherwise they are just inialization values if( .not.(ccohort%isnew) ) then + ! Turnover pools [kgC/day] / [yr/day] = [kgC/yr] + sapw_c_turnover = ccohort%prt%GetTurnover(sapw_organ, all_carbon_species) / hlm_freq_day + store_c_turnover = ccohort%prt%GetTurnover(store_organ, all_carbon_species) / hlm_freq_day + leaf_c_turnover = ccohort%prt%GetTurnover(leaf_organ, all_carbon_species) / hlm_freq_day + fnrt_c_turnover = ccohort%prt%GetTurnover(fnrt_organ, all_carbon_species) / hlm_freq_day + struct_c_turnover = ccohort%prt%GetTurnover(struct_organ, all_carbon_species) / hlm_freq_day + + ! Net change from allocation and transport [kgC/day] / [yr/day] = [kgC/yr] + sapw_c_net_art = ccohort%prt%GetNetArt(sapw_organ, all_carbon_species) / hlm_freq_day + store_c_net_art = ccohort%prt%GetNetArt(store_organ, all_carbon_species) / hlm_freq_day + leaf_c_net_art = ccohort%prt%GetNetArt(leaf_organ, all_carbon_species) / hlm_freq_day + fnrt_c_net_art = ccohort%prt%GetNetArt(fnrt_organ, all_carbon_species) / hlm_freq_day + struct_c_net_art = ccohort%prt%GetNetArt(struct_organ, all_carbon_species) / hlm_freq_day + repro_c_net_art = ccohort%prt%GetNetArt(repro_organ, all_carbon_species) / hlm_freq_day + + associate( scpf => ccohort%size_by_pft_class, & scls => ccohort%size_class ) diff --git a/main/FatesRestartInterfaceMod.F90 b/main/FatesRestartInterfaceMod.F90 index 3d8bd2d16b..cbe237cf37 100644 --- a/main/FatesRestartInterfaceMod.F90 +++ b/main/FatesRestartInterfaceMod.F90 @@ -28,7 +28,8 @@ module FatesRestartInterfaceMod use PRTGenericMod, only : struct_organ use PRTGenericMod, only : carbon12_species use PRTGenericMod, only : SetState - use PRTGenericMod, only : GetState + use PRTGenericMod, only : prt_instance + ! CIME GLOBALS use shr_log_mod , only : errMsg => shr_log_errMsg @@ -89,11 +90,7 @@ module FatesRestartInterfaceMod integer, private :: ir_seedrainflux_si integer, private :: ir_trunk_product_si integer, private :: ir_ncohort_pa - integer, private :: ir_bsw_co - integer, private :: ir_bdead_co - integer, private :: ir_bleaf_co - integer, private :: ir_broot_co - integer, private :: ir_bstore_co + integer, private :: ir_canopy_layer_co integer, private :: ir_canopy_layer_yesterday_co integer, private :: ir_canopy_trim_co @@ -143,6 +140,9 @@ module FatesRestartInterfaceMod integer, private :: ir_fabi_sha_paclftls integer, private :: ir_watermem_siwm + integer, private :: ir_prt_base ! Base index for all PRT variables + + ! 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) @@ -151,6 +151,11 @@ module FatesRestartInterfaceMod integer, parameter :: old_cohort = 0 integer, parameter :: new_cohort = 1 + real(r8), parameter :: flushinvalid = -9999.0 + real(r8), parameter :: flushzero = 0.0 + real(r8), parameter :: flushone = 1.0 + + ! Local debug flag logical, parameter :: DEBUG=.false. @@ -209,6 +214,7 @@ module FatesRestartInterfaceMod procedure, private :: flush_rvars procedure, private :: define_restart_vars procedure, private :: set_restart_var + procedure, private :: DefinePRTRestartVars end type fates_restart_interface_type @@ -488,10 +494,7 @@ subroutine define_restart_vars(this, initialize_variables) class(fates_restart_interface_type), intent(inout) :: this logical, intent(in) :: initialize_variables ! are we 'count'ing or 'initializ'ing? integer :: ivar - real(r8), parameter :: flushinvalid = -9999.0 - real(r8), parameter :: flushzero = 0.0 - real(r8), parameter :: flushone = 1.0 - + ivar=0 @@ -623,27 +626,6 @@ subroutine define_restart_vars(this, initialize_variables) ! 1D cohort Variables ! ----------------------------------------------------------------------------------- - call this%set_restart_var(vname='fates_bsw', vtype=cohort_r8, & - long_name='ed cohort sapwood biomass', units='kgC/indiv', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_bsw_co ) - - call this%set_restart_var(vname='fates_bdead', vtype=cohort_r8, & - long_name='ed cohort - dead (structural) biomass in living plants', & - units='kgC/indiv', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_bdead_co ) - - call this%set_restart_var(vname='fates_bl', vtype=cohort_r8, & - long_name='ed cohort - leaf biomass', units='kgC/indiv', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_bleaf_co ) - - call this%set_restart_var(vname='fates_br', vtype=cohort_r8, & - long_name='ed cohort - fine root biomass', units='kgC/indiv', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_broot_co ) - - call this%set_restart_var(vname='fates_bstore', vtype=cohort_r8, & - long_name='ed cohort - storage biomass', units='kgC/indiv', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_bstore_co ) - call this%set_restart_var(vname='fates_canopy_layer', vtype=cohort_r8, & long_name='ed cohort - canopy_layer', units='unitless', flushval = flushzero, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_canopy_layer_co ) @@ -744,7 +726,6 @@ subroutine define_restart_vars(this, initialize_variables) units='%/event', flushval = flushzero, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_lmort_infra_co ) - call this%set_restart_var(vname='fates_ddbhdt', vtype=cohort_r8, & long_name='ed cohort - differential: ddbh/dt', & units='cm/year', flushval = flushzero, & @@ -859,13 +840,136 @@ subroutine define_restart_vars(this, initialize_variables) long_name='last 10 days of volumetric soil water, by site x day-index', & units='m3/m3', flushval = flushzero, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_watermem_siwm ) - + + + ! Register all of the PRT states and fluxes + + ir_prt_base = ivar + call this%DefinePRTRestartVars(initialize_variables,ivar) + + ! Must be last thing before return this%num_restart_vars_ = ivar - end subroutine define_restart_vars - + end subroutine define_restart_vars + + ! ===================================================================================== + + subroutine DefinePRTRestartVars(this,initialize_variables,ivar) + + use FatesIOVariableKindMod, only : cohort_r8 + + class(fates_restart_interface_type) :: this + logical, intent(in) :: initialize_variables + integer,intent(inout) :: ivar ! global variable counter + + integer :: n_vars ! number of state variables + integer :: n_pos ! number of discrete positions + integer :: dummy_out ! dummy index for variable + ! position in global file + integer :: i_var ! loop counter for prt variables + integer :: i_pos ! loop counter for discrete position + + character(len=32) :: symbol_base ! Symbol name without position or flux type + character(len=128) :: name_base ! name without position or flux type + character(len=4) :: pos_symbol + character(len=128) :: symbol + character(len=256) :: long_name + + + n_vars = size(prt_instance%state_descriptor,1) + + do i_var = 1, n_vars + + + ! The base symbol name + symbol_base = prt_instance%state_descriptor(i_var)%symbol + + ! The long name of the variable + name_base = prt_instance%state_descriptor(i_var)%longname + + + n_pos = prt_instance%state_descriptor(i_var)%num_pos + + do i_pos = 1, n_pos + + + ! String describing the physical position of the variable + write(pos_symbol, '(I3.3)') i_pos + + ! Register the instantaneous state variable "val" + ! ---------------------------------------------------------------------------- + + ! The symbol that is written to file + symbol = trim(symbol_base)//'_val_'//'_pos_'//trim(pos_symbol) + + ! The expanded long name of the variable + long_name = trim(name_base)//', state var, position:'//trim(pos_symbol) + + call this%set_restart_var(vname=trim(symbol), & + vtype=cohort_r8, & + long_name=trim(long_name), & + units='kg', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, & + ivar=ivar, index = dummy_out ) + + ! Register the turnover flux variables + ! ---------------------------------------------------------------------------- + + ! The symbol that is written to file + symbol = trim(symbol_base)//'_turn_'//'_pos_'//trim(pos_symbol) + + ! The expanded long name of the variable + long_name = trim(name_base)//', turnover, position:'//trim(pos_symbol) + + call this%set_restart_var(vname=trim(symbol), & + vtype=cohort_r8, & + long_name=trim(long_name), & + units='kg', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, & + ivar=ivar, index = dummy_out ) + + + + ! Register the net allocation flux variable + ! ---------------------------------------------------------------------------- + + ! The symbol that is written to file + symbol = trim(symbol_base)//'_net_'//'_pos_'//trim(pos_symbol) + + ! The expanded long name of the variable + long_name = trim(name_base)//', net allocation/transp, position:'//trim(pos_symbol) + + call this%set_restart_var(vname=trim(symbol), & + vtype=cohort_r8, & + long_name=trim(long_name), & + units='kg', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, & + ivar=ivar, index = dummy_out ) + + + + ! Register the burn flux variable + ! ---------------------------------------------------------------------------- + ! The symbol that is written to file + symbol = trim(symbol_base)//'_burned_'//'_pos_'//trim(pos_symbol) + + ! The expanded long name of the variable + long_name = trim(name_base)//', burned mass:'//trim(pos_symbol) + + call this%set_restart_var(vname=symbol, & + vtype=cohort_r8, & + long_name=trim(long_name), & + units='kg', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, & + ivar=i_var, index = dummy_out ) + + end do + end do + + return + end subroutine DefinePRTRestartVars ! ===================================================================================== @@ -966,7 +1070,10 @@ subroutine set_restart_vectors(this,nc,nsites,sites) integer :: ft ! functional type index integer :: k,j,i ! indices to the radiation matrix - + integer :: i_var_pos ! loop counter for var x position + integer :: i_var ! loop counter for PRT variables + integer :: i_pos ! loop counter for discrete PRT positions + type(fates_restart_variable_type) :: rvar type(ed_patch_type),pointer :: cpatch type(ed_cohort_type),pointer :: ccohort @@ -997,11 +1104,6 @@ subroutine set_restart_vectors(this,nc,nsites,sites) 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_bsw_co => this%rvars(ir_bsw_co)%r81d, & - rio_bdead_co => this%rvars(ir_bdead_co)%r81d, & - rio_bleaf_co => this%rvars(ir_bleaf_co)%r81d, & - rio_broot_co => this%rvars(ir_broot_co)%r81d, & - rio_bstore_co => this%rvars(ir_bstore_co)%r81d, & rio_canopy_layer_co => this%rvars(ir_canopy_layer_co)%r81d, & rio_canopy_layer_yesterday_co => this%rvars(ir_canopy_layer_yesterday_co)%r81d, & rio_canopy_trim_co => this%rvars(ir_canopy_trim_co)%r81d, & @@ -1105,22 +1207,32 @@ subroutine set_restart_vectors(this,nc,nsites,sites) write(fates_log(),*) 'CLTV lowerbound ', lbound(rio_npp_acc_co,1) write(fates_log(),*) 'CLTV upperbound ', ubound(rio_npp_acc_co,1) endif - - select case(hlm_parteh_model) - case (1) - - rio_bsw_co(io_idx_co) = ccohort%prt%GetState(sapw_organ, carbon12_species ) - rio_bdead_co(io_idx_co) = ccohort%prt%GetState(struct_organ, carbon12_species ) - rio_bleaf_co(io_idx_co) = ccohort%prt%GetState(leaf_organ, carbon12_species ) - rio_broot_co(io_idx_co) = ccohort%prt%GetState(fnrt_organ, carbon12_species ) - rio_bstore_co(io_idx_co) = ccohort%prt%GetState(store_organ, carbon12_species ) - - case DEFAULT - write(fates_log(),*) 'You specified an unknown PRT module' - write(fates_log(),*) 'Aborting' - call endrun(msg=errMsg(sourcefile, __LINE__)) - end select - + + ! Fill output arrays of PRT variables + i_var_pos = 0 + do i_var = 1, size(ccohort%prt%variables,1) + do i_pos = 1, ccohort%prt%variables(i_var)%num_pos + + i_var_pos = i_var_pos + 1 + this%rvars(ir_prt_base+i_var_pos)%r81d(io_idx_co) = & + ccohort%prt%variables(i_var)%val(i_pos) + + i_var_pos = i_var_pos + 1 + this%rvars(ir_prt_base+i_var_pos)%r81d(io_idx_co) = & + ccohort%prt%variables(i_var)%turnover(i_pos) + + i_var_pos = i_var_pos + 1 + this%rvars(ir_prt_base+i_var_pos)%r81d(io_idx_co) = & + ccohort%prt%variables(i_var)%net_art(i_pos) + + i_var_pos = i_var_pos + 1 + this%rvars(ir_prt_base+i_var_pos)%r81d(io_idx_co) = & + ccohort%prt%variables(i_var)%burned(i_pos) + + end do + end do + + 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 @@ -1541,7 +1653,9 @@ subroutine get_restart_vectors(this, nc, nsites, sites) integer :: totalcohorts ! total cohort count on this thread (diagnostic) integer :: patchespersite ! number of patches per site integer :: cohortsperpatch ! number of cohorts per patch - + integer :: i_var_pos ! loop counter for var x position + integer :: i_var ! loop counter for PRT variables + integer :: i_pos ! loop counter for discrete PRT positions associate( rio_npatch_si => this%rvars(ir_npatch_si)%int1d, & @@ -1569,11 +1683,6 @@ subroutine get_restart_vectors(this, nc, nsites, sites) 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_bsw_co => this%rvars(ir_bsw_co)%r81d, & - rio_bdead_co => this%rvars(ir_bdead_co)%r81d, & - rio_bleaf_co => this%rvars(ir_bleaf_co)%r81d, & - rio_broot_co => this%rvars(ir_broot_co)%r81d, & - rio_bstore_co => this%rvars(ir_bstore_co)%r81d, & rio_canopy_layer_co => this%rvars(ir_canopy_layer_co)%r81d, & rio_canopy_layer_yesterday_co => this%rvars(ir_canopy_layer_yesterday_co)%r81d, & rio_canopy_trim_co => this%rvars(ir_canopy_trim_co)%r81d, & @@ -1664,23 +1773,29 @@ subroutine get_restart_vectors(this, nc, nsites, sites) write(fates_log(),*) 'CVTL io_idx_co ',io_idx_co endif - select case(hlm_parteh_model) - case (1) - - call SetState(ccohort%prt,leaf_organ, carbon12_species, rio_bleaf_co(io_idx_co)) - call SetState(ccohort%prt,fnrt_organ, carbon12_species, rio_broot_co(io_idx_co)) - call SetState(ccohort%prt,sapw_organ, carbon12_species, rio_bsw_co(io_idx_co)) - call SetState(ccohort%prt,store_organ, carbon12_species, rio_bstore_co(io_idx_co)) - call SetState(ccohort%prt,struct_organ , carbon12_species, rio_bdead_co(io_idx_co)) - call SetState(ccohort%prt,repro_organ , carbon12_species, 0.0_r8) + ! Fill PRT state variables with array data + i_var_pos = 0 + do i_var = 1, size(ccohort%prt%variables,1) + do i_pos = 1, ccohort%prt%variables(i_var)%num_pos + + i_var_pos = i_var_pos + 1 + ccohort%prt%variables(i_var)%val(i_pos) = & + this%rvars(ir_prt_base+i_var_pos)%r81d(io_idx_co) - case DEFAULT - write(fates_log(),*) 'You specified an unknown PRT module' - write(fates_log(),*) 'Aborting' - call endrun(msg=errMsg(sourcefile, __LINE__)) - end select + i_var_pos = i_var_pos + 1 + ccohort%prt%variables(i_var)%turnover(i_pos) = & + this%rvars(ir_prt_base+i_var_pos)%r81d(io_idx_co) + i_var_pos = i_var_pos + 1 + ccohort%prt%variables(i_var)%net_art(i_pos) = & + this%rvars(ir_prt_base+i_var_pos)%r81d(io_idx_co) + i_var_pos = i_var_pos + 1 + ccohort%prt%variables(i_var)%burned(i_pos) = & + this%rvars(ir_prt_base+i_var_pos)%r81d(io_idx_co) + end do + end do + 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) diff --git a/parteh/PRTAllometricCarbonMod.F90 b/parteh/PRTAllometricCarbonMod.F90 index c9dc46fd7f..b0f89d2034 100644 --- a/parteh/PRTAllometricCarbonMod.F90 +++ b/parteh/PRTAllometricCarbonMod.F90 @@ -14,6 +14,7 @@ module PRTAllometricCarbonMod ! ------------------------------------------------------------------------------------ use PRTGenericMod , only : prt_instance_type + use PRTGenericMod , only : prt_instance use PRTGenericMod , only : prt_vartype use PRTGenericMod , only : prt_vartypes use PRTGenericMod , only : carbon12_species @@ -154,6 +155,8 @@ subroutine InitPRTInstanceAC() allocate(prt_instance_ac) allocate(prt_instance_ac%state_descriptor(ac_num_vars)) + prt_instance => prt_instance_ac + prt_instance_ac%hyp_name = 'Allometric Carbon Only' call prt_instance_ac%ZeroInstance() @@ -165,12 +168,12 @@ subroutine InitPRTInstanceAC() ! simply increase it. It will not use much memory or increase loop sizes - call prt_instance_ac%InitInstance(leaf_c_id,"Leaf Carbon","leaf_c",leaf_organ,carbon12_species) - call prt_instance_ac%InitInstance(fnrt_c_id,"Fine Root Carbon","fnrt_c",fnrt_organ,carbon12_species) - call prt_instance_ac%InitInstance(sapw_c_id,"Sapwood Carbon","sapw_c",sapw_organ,carbon12_species) - call prt_instance_ac%InitInstance(store_c_id,"Storage Carbon","store_c",store_organ,carbon12_species) - call prt_instance_ac%InitInstance(struct_c_id,"Structural Carbon","struct_c",struct_organ,carbon12_species) - call prt_instance_ac%InitInstance(repro_c_id,"Reproductive Carbon","repro_c",repro_organ,carbon12_species) + call prt_instance_ac%InitInstance(leaf_c_id,"Leaf Carbon","leaf_c",leaf_organ,carbon12_species,icd) + call prt_instance_ac%InitInstance(fnrt_c_id,"Fine Root Carbon","fnrt_c",fnrt_organ,carbon12_species,icd) + call prt_instance_ac%InitInstance(sapw_c_id,"Sapwood Carbon","sapw_c",sapw_organ,carbon12_species,icd) + call prt_instance_ac%InitInstance(store_c_id,"Storage Carbon","store_c",store_organ,carbon12_species,icd) + call prt_instance_ac%InitInstance(struct_c_id,"Structural Carbon","struct_c",struct_organ,carbon12_species,icd) + call prt_instance_ac%InitInstance(repro_c_id,"Reproductive Carbon","repro_c",repro_organ,carbon12_species,icd) return end subroutine InitPRTInstanceAC @@ -850,16 +853,21 @@ function AllomCGrowthDeriv(c_pools,c_mask,cbalance,intgr_params) result(dCdx) mask_repro => c_mask(repro_c_id) ) canopy_trim = intgr_params(ac_bc_in_id_ctrim) - ipft = nint(intgr_params(ac_bc_in_id_pft)) + ipft = int(intgr_params(ac_bc_in_id_pft)) if(dbh>huge(dbh)) then print*,"BIG D IN DERIV:",dbh stop end if + print*,"ipft: ",ipft + call bleaf(dbh,ipft,canopy_trim,ct_leaf,ct_dleafdd) call bfineroot(dbh,ipft,canopy_trim,ct_fnrt,ct_dfnrtdd) call bsap_allom(dbh,ipft,canopy_trim,sapw_area,ct_sap,ct_dsapdd) + + print*,"Clear" + call bagw_allom(dbh,ipft,ct_agw,ct_dagwdd) call bbgw_allom(dbh,ipft,ct_bgw,ct_dbgwdd) call bdead_allom(ct_agw,ct_bgw, ct_sap, ipft, ct_dead, & diff --git a/parteh/PRTGenericMod.F90 b/parteh/PRTGenericMod.F90 index c20823d9a1..3dbfcd3e9d 100644 --- a/parteh/PRTGenericMod.F90 +++ b/parteh/PRTGenericMod.F90 @@ -36,7 +36,7 @@ module PRTGenericMod logical, parameter :: debug = .true. integer, parameter :: maxlen_varname = 128 - integer, parameter :: maxlen_varsymbol = 16 + integer, parameter :: maxlen_varsymbol = 32 integer, parameter :: maxlen_varunits = 32 integer, parameter :: len_baseunit = 6 @@ -252,7 +252,8 @@ module PRTGenericMod character(len=maxlen_varsymbol) :: symbol integer :: organ_id ! global id for organ integer :: spec_id ! global id for species - + integer :: num_pos ! number of descrete spatial positions + ! Also, will probably need flags to define different types of groups that this variable ! belongs too, which will control things like fusion, normalization, when to zero, etc... @@ -309,6 +310,9 @@ module PRTGenericMod end type prt_instance_type + type(prt_instance_type),pointer :: prt_instance + + contains ! ===================================================================================== @@ -336,7 +340,7 @@ end subroutine ZeroInstance ! ===================================================================================== - subroutine InitInstance(this, var_id, long_name, symbol, organ_id, spec_id) + subroutine InitInstance(this, var_id, long_name, symbol, organ_id, spec_id, num_pos) class(prt_instance_type) :: this integer, intent(in) :: var_id @@ -344,6 +348,7 @@ subroutine InitInstance(this, var_id, long_name, symbol, organ_id, spec_id) character(len=*),intent(in) :: symbol integer, intent(in) :: organ_id integer, intent(in) :: spec_id + integer, intent(in) :: num_pos ! Set the descriptions and the associated organs/species in the variable's ! own array @@ -352,6 +357,7 @@ subroutine InitInstance(this, var_id, long_name, symbol, organ_id, spec_id) this%state_descriptor(var_id)%symbol = symbol this%state_descriptor(var_id)%organ_id = organ_id this%state_descriptor(var_id)%spec_id = spec_id + this%state_descriptor(var_id)%num_pos = num_pos ! Set the mapping tables for the external model @@ -1162,6 +1168,8 @@ end subroutine SetState ! ==================================================================================== - + + + end module PRTGenericMod From dcb9219e9d622e50729cc18a8281a65f40413620 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Mon, 1 Oct 2018 18:41:12 -0700 Subject: [PATCH 23/52] Some debugging for restarts on arbitrary prt variables. --- main/FatesRestartInterfaceMod.F90 | 19 +++++++++---------- parteh/PRTAllometricCarbonMod.F90 | 4 ---- 2 files changed, 9 insertions(+), 14 deletions(-) diff --git a/main/FatesRestartInterfaceMod.F90 b/main/FatesRestartInterfaceMod.F90 index cbe237cf37..190acacf2c 100644 --- a/main/FatesRestartInterfaceMod.F90 +++ b/main/FatesRestartInterfaceMod.F90 @@ -894,7 +894,6 @@ subroutine DefinePRTRestartVars(this,initialize_variables,ivar) do i_pos = 1, n_pos - ! String describing the physical position of the variable write(pos_symbol, '(I3.3)') i_pos @@ -902,8 +901,8 @@ subroutine DefinePRTRestartVars(this,initialize_variables,ivar) ! ---------------------------------------------------------------------------- ! The symbol that is written to file - symbol = trim(symbol_base)//'_val_'//'_pos_'//trim(pos_symbol) - + symbol = trim(symbol_base)//'_val_'//trim(pos_symbol) + ! The expanded long name of the variable long_name = trim(name_base)//', state var, position:'//trim(pos_symbol) @@ -918,8 +917,8 @@ subroutine DefinePRTRestartVars(this,initialize_variables,ivar) ! ---------------------------------------------------------------------------- ! The symbol that is written to file - symbol = trim(symbol_base)//'_turn_'//'_pos_'//trim(pos_symbol) - + symbol = trim(symbol_base)//'_turn_'//trim(pos_symbol) + ! The expanded long name of the variable long_name = trim(name_base)//', turnover, position:'//trim(pos_symbol) @@ -936,8 +935,8 @@ subroutine DefinePRTRestartVars(this,initialize_variables,ivar) ! ---------------------------------------------------------------------------- ! The symbol that is written to file - symbol = trim(symbol_base)//'_net_'//'_pos_'//trim(pos_symbol) - + symbol = trim(symbol_base)//'_net_'//trim(pos_symbol) + ! The expanded long name of the variable long_name = trim(name_base)//', net allocation/transp, position:'//trim(pos_symbol) @@ -953,8 +952,8 @@ subroutine DefinePRTRestartVars(this,initialize_variables,ivar) ! Register the burn flux variable ! ---------------------------------------------------------------------------- ! The symbol that is written to file - symbol = trim(symbol_base)//'_burned_'//'_pos_'//trim(pos_symbol) - + symbol = trim(symbol_base)//'_burned_'//trim(pos_symbol) + ! The expanded long name of the variable long_name = trim(name_base)//', burned mass:'//trim(pos_symbol) @@ -963,7 +962,7 @@ subroutine DefinePRTRestartVars(this,initialize_variables,ivar) long_name=trim(long_name), & units='kg', flushval = flushzero, & hlms='CLM:ALM', initialize=initialize_variables, & - ivar=i_var, index = dummy_out ) + ivar=ivar, index = dummy_out ) end do end do diff --git a/parteh/PRTAllometricCarbonMod.F90 b/parteh/PRTAllometricCarbonMod.F90 index b0f89d2034..dd70900865 100644 --- a/parteh/PRTAllometricCarbonMod.F90 +++ b/parteh/PRTAllometricCarbonMod.F90 @@ -860,14 +860,10 @@ function AllomCGrowthDeriv(c_pools,c_mask,cbalance,intgr_params) result(dCdx) stop end if - print*,"ipft: ",ipft - call bleaf(dbh,ipft,canopy_trim,ct_leaf,ct_dleafdd) call bfineroot(dbh,ipft,canopy_trim,ct_fnrt,ct_dfnrtdd) call bsap_allom(dbh,ipft,canopy_trim,sapw_area,ct_sap,ct_dsapdd) - print*,"Clear" - call bagw_allom(dbh,ipft,ct_agw,ct_dagwdd) call bbgw_allom(dbh,ipft,ct_bgw,ct_dbgwdd) call bdead_allom(ct_agw,ct_bgw, ct_sap, ipft, ct_dead, & From f133b7932ea13f3476bd1e81fd2db6a889879de1 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Tue, 2 Oct 2018 16:37:14 -0700 Subject: [PATCH 24/52] bug fixes in parteh v1 --- biogeochem/EDCohortDynamicsMod.F90 | 23 ++++++++++------ parteh/PRTGenericMod.F90 | 44 +++++++++++++++--------------- 2 files changed, 36 insertions(+), 31 deletions(-) diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index 50d4deb771..8c41eb006f 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -175,12 +175,6 @@ subroutine create_cohort(currentSite, patchptr, pft, nn, hite, dbh, bleaf, bfine call SetState(new_cohort%prt,struct_organ , carbon12_species, bdead) call SetState(new_cohort%prt,repro_organ , carbon12_species, 0.0_r8) - 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) - end select @@ -280,7 +274,7 @@ subroutine InitPRTCohort(new_cohort) allocate(callom_prt) new_cohort%prt => callom_prt - + case DEFAULT write(fates_log(),*) 'You specified an unknown PRT module' @@ -289,9 +283,20 @@ subroutine InitPRTCohort(new_cohort) end select - call new_cohort%prt%InitPRTVartype() - + + select case(hlm_parteh_model) + case (1) + + ! Register boundary conditions + 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) + + end select + + return end subroutine InitPRTCohort diff --git a/parteh/PRTGenericMod.F90 b/parteh/PRTGenericMod.F90 index 3dbfcd3e9d..7c05827a9b 100644 --- a/parteh/PRTGenericMod.F90 +++ b/parteh/PRTGenericMod.F90 @@ -573,29 +573,29 @@ subroutine CopyPRTVartypes(this, donor_prt_obj) this%variables(i_var)%burned(:) = donor_prt_obj%variables(i_var)%burned(:) end do - if(allocated(this%bc_in))then - num_bc_in = size(this%bc_in,1) - do i_bc = 1, num_bc_in - this%bc_in(i_bc)%ival => donor_prt_obj%bc_in(i_bc)%ival - this%bc_in(i_bc)%rval => donor_prt_obj%bc_in(i_bc)%rval - end do - end if +! if(allocated(this%bc_in))then +! num_bc_in = size(this%bc_in,1) +! do i_bc = 1, num_bc_in +! this%bc_in(i_bc)%ival => donor_prt_obj%bc_in(i_bc)%ival +! this%bc_in(i_bc)%rval => donor_prt_obj%bc_in(i_bc)%rval +! end do +! end if - if(allocated(this%bc_out))then - num_bc_out = size(this%bc_out,1) - do i_bc = 1, num_bc_out - this%bc_out(i_bc)%ival => donor_prt_obj%bc_out(i_bc)%ival - this%bc_out(i_bc)%rval => donor_prt_obj%bc_out(i_bc)%rval - end do - end if - - if(allocated(this%bc_inout))then - num_bc_inout = size(this%bc_inout,1) - do i_bc = 1, num_bc_inout - this%bc_inout(i_bc)%ival => donor_prt_obj%bc_inout(i_bc)%ival - this%bc_inout(i_bc)%rval => donor_prt_obj%bc_inout(i_bc)%rval - end do - end if +! if(allocated(this%bc_out))then +! num_bc_out = size(this%bc_out,1) +! do i_bc = 1, num_bc_out +! this%bc_out(i_bc)%ival => donor_prt_obj%bc_out(i_bc)%ival +! this%bc_out(i_bc)%rval => donor_prt_obj%bc_out(i_bc)%rval +! end do +! end if + +! if(allocated(this%bc_inout))then +! num_bc_inout = size(this%bc_inout,1) +! do i_bc = 1, num_bc_inout +! this%bc_inout(i_bc)%ival => donor_prt_obj%bc_inout(i_bc)%ival +! this%bc_inout(i_bc)%rval => donor_prt_obj%bc_inout(i_bc)%rval +! end do +! end if this%ode_opt_step = donor_prt_obj%ode_opt_step From 19f634db40cea7dcf6dfca8474de53308b91a687 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Wed, 3 Oct 2018 16:49:32 -0700 Subject: [PATCH 25/52] Fixed some descriptions in the parameter file. Added the flush fraction parameter, and checks. --- main/EDPftvarcon.F90 | 31 ++++++++++++++++++++++++ parameter_files/fates_params_default.cdl | 29 +++++++++++++--------- parteh/PRTLossFluxesMod.F90 | 26 ++++++++++++++++++++ 3 files changed, 75 insertions(+), 11 deletions(-) diff --git a/main/EDPftvarcon.F90 b/main/EDPftvarcon.F90 index 29fda91360..f516bfad47 100644 --- a/main/EDPftvarcon.F90 +++ b/main/EDPftvarcon.F90 @@ -170,6 +170,9 @@ module EDPftvarcon ! 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 :: leaf_long(:) ! Leaf turnover time (longevity) (pft) [yr] real(r8), allocatable :: root_long(:) ! root turnover time (longevity) (pft) [yr] real(r8), allocatable :: branch_turnover(:) ! Turnover time for branchfall on live trees (pft) [yr] @@ -707,6 +710,9 @@ 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_phenflush_fraction' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) end subroutine Register_PFT @@ -1135,6 +1141,10 @@ subroutine Receive_PFT(this, fates_params) call fates_params%RetreiveParameterAllocate(name=name, & data=this%displar) + name = 'fates_phenflush_fraction' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%phenflush_fraction) + end subroutine Receive_PFT !----------------------------------------------------------------------- @@ -1671,6 +1681,7 @@ subroutine FatesReportPFTParams(is_master) write(fates_log(),fmt0) 'rhos = ',EDPftvarcon_inst%rhos 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) '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 @@ -1846,6 +1857,26 @@ subroutine FatesCheckParams(is_master, parteh_model) ! call endrun(msg=errMsg(sourcefile, __LINE__)) ! ! end if + + + ! Check if the fraction of storage used for flushing deciduous trees + ! is greater than zero, and less than or equal to 1. + + if ( int(EDPftvarcon_inst%evergreen(ipft)) .ne. 1 ) then + if ( ( EDPftvarcon_inst%phenflush_fraction(ipft) < nearzero ) .or. & + ( EDPFtvarcon_inst%phenflush_fraction(ipft) > 1 ) ) then + + write(fates_log(),*) ' Deciduous plants must flush some storage carbon' + write(fates_log(),*) ' on bud-burst. If phenflush_fraction is not greater than 0' + write(fates_log(),*) ' it will not be able to put out any leaves. Plants need leaves.' + write(fates_log(),*) ' PFT#: ',ipft + write(fates_log(),*) ' evergreen flag: (shold be 0):',int(EDPftvarcon_inst%evergreen(ipft)) + write(fates_log(),*) ' phenflush_fraction: ', EDPFtvarcon_inst%phenflush_fraction(ipft) + write(fates_log(),*) ' Aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + end if + ! Check if freezing tolerance is within reasonable bounds ! ---------------------------------------------------------------------------------- diff --git a/parameter_files/fates_params_default.cdl b/parameter_files/fates_params_default.cdl index ae6511265c..dbcac5c2ee 100644 --- a/parameter_files/fates_params_default.cdl +++ b/parameter_files/fates_params_default.cdl @@ -177,40 +177,44 @@ variables: fates_prt_unit_gr_resp:long_name = "Unit growth respiration rate per organ" ; float fates_prt_nitr_stoich_p1(fates_prt_organs,fates_pft) ; - fates_prt_nitr_stoich_p1:units = "(gC/gN)" ; - fates_prt_nitr_stoich_p1:long_name = "nitrogen stoichiometry" ; + 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) ; - fates_prt_nitr_stoich_p2:units = "(gC/cN)" ; - fates_prt_nitr_stoich_p2:long_name = "nitrogen stoichiometry, parameter 2 (hypothesis dependant meaning)" ; + 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) ; - fates_prt_phos_stoich_p1:units = "(gC/gP)" ; - fates_prt_phos_stoich_p1:long_name = "phosphorous stoichiometry, parameter 1 (hypothesis dependant meaning)" ; + 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) ; - fates_prt_phos_stoich_p2:units = "(gC/gP)" ; - fates_prt_phos_stoich_p2:long_name = "phosphorous stoichiometry, parameter 2 (hypothesis dependant meaning)" ; + fates_prt_phos_stoich_p2:units = "(gP/gC)" ; + fates_prt_phos_stoich_p2:long_name = "phosphorous stoichiometry, parameter 2" ; float 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_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_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_turnover_carb_retrans_p1(fates_prt_organs,fates_pft) ; fates_turnover_carb_retrans_p1:units = "na" ; - fates_turnover_carb_retrans_p1:long_name = "retranslocation of carbon in turnover, parameter 1 (hypothesis dependant meaning)" ; + fates_turnover_carb_retrans_p1:long_name = "retranslocation of carbon in turnover, parameter 1" ; float fates_turnover_nitr_retrans_p1(fates_prt_organs,fates_pft) ; fates_turnover_nitr_retrans_p1:units = "na" ; - fates_turnover_nitr_retrans_p1:long_name = "retranslocation of nitrogen in turnover, parameter 1 (hypothesis dependant meaning)" ; + fates_turnover_nitr_retrans_p1:long_name = "retranslocation of nitrogen in turnover, parameter 1" ; float fates_turnover_phos_retrans_p1(fates_prt_organs,fates_pft) ; fates_turnover_phos_retrans_p1:units = "na" ; - fates_turnover_phos_retrans_p1:long_name = "retranslocation of phosphorous in turnover, parameter 1 (hypothesis dependant meaning)" ; + fates_turnover_phos_retrans_p1:long_name = "retranslocation of phosphorous in turnover, parameter 1" ; float fates_c2b(fates_pft) ; fates_c2b:units = "ratio" ; @@ -792,6 +796,9 @@ data: _, _, _, _; + fates_phenflush_fraction = + 0.5, 0.5; + fates_turnover_retrans_mode = 1, 1; diff --git a/parteh/PRTLossFluxesMod.F90 b/parteh/PRTLossFluxesMod.F90 index b0465c4951..2287b697cf 100644 --- a/parteh/PRTLossFluxesMod.F90 +++ b/parteh/PRTLossFluxesMod.F90 @@ -93,6 +93,19 @@ subroutine PRTPhenologyFlush(prt, ipft, organ_id, c_store_transfer_frac) real(r8) :: sp_demand ! nutrient demand for species + ! We currently only allow the flushing and drop of leaves. + ! 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 + 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 + write(fates_log(),*) 'Exiting' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + associate(organ_map => prt%prt_instance%organ_map) ! First transfer in carbon @@ -348,6 +361,19 @@ subroutine PRTDeciduousTurnover(prt,ipft,organ_id,mass_fraction) integer,intent(in) :: organ_id real(r8),intent(in) :: mass_fraction + ! We currently only allow the flushing and drop of leaves. + ! 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 + 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 + write(fates_log(),*) 'Exiting' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + if ( int(EDPftvarcon_inst%turnover_retrans_mode(ipft)) == 1 ) then call DeciduousTurnoverSimpleRetranslocation(prt,ipft,organ_id,mass_fraction) else From 43dcde8f72fbf44881e3adb71b7d66f389a8be08 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Mon, 8 Oct 2018 11:48:34 -0600 Subject: [PATCH 26/52] Fixed type definition of prt objects during copy and fuse --- parteh/PRTGenericMod.F90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/parteh/PRTGenericMod.F90 b/parteh/PRTGenericMod.F90 index 7c05827a9b..3fef3720e1 100644 --- a/parteh/PRTGenericMod.F90 +++ b/parteh/PRTGenericMod.F90 @@ -544,8 +544,8 @@ end subroutine RegisterBCIn subroutine CopyPRTVartypes(this, donor_prt_obj) ! Arguments - class(prt_vartypes) :: this - type(prt_vartypes), intent(in), pointer :: donor_prt_obj + class(prt_vartypes) :: this + class(prt_vartypes), intent(in), pointer :: donor_prt_obj ! Locals @@ -611,11 +611,11 @@ subroutine WeightedFusePRTVartypes(this,donor_prt_obj, recipient_fuse_weight, po ! assigned for the recipient (the class calling this) ! Arguments - class(prt_vartypes) :: this - type(prt_vartypes), intent(in), pointer :: donor_prt_obj - real(r8),intent(in) :: recipient_fuse_weight ! This is the weighting + class(prt_vartypes) :: this + class(prt_vartypes), intent(in), pointer :: donor_prt_obj + real(r8),intent(in) :: recipient_fuse_weight ! This is the weighting ! for the recipient - integer,intent(in),optional :: position_id + integer,intent(in),optional :: position_id ! Locals integer :: n_vars ! Number of variables From 707b0c998b7f322758dfa05df342fd5dc21fc426 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Wed, 10 Oct 2018 17:32:47 -0700 Subject: [PATCH 27/52] Updated the default 14pft file to include parteh parameters. Added the organ variable to describe the organ dimension in the parameter files. --- parameter_files/fates_params_14pfts.cdl | 173 +++++++++++++++++++---- parameter_files/fates_params_default.cdl | 14 +- 2 files changed, 159 insertions(+), 28 deletions(-) diff --git a/parameter_files/fates_params_14pfts.cdl b/parameter_files/fates_params_14pfts.cdl index ab90b8fe17..3f14d408ae 100644 --- a/parameter_files/fates_params_14pfts.cdl +++ b/parameter_files/fates_params_14pfts.cdl @@ -10,6 +10,7 @@ dimensions: fates_scalar = 1 ; fates_string_length = 60 ; fates_variants = 2 ; + fates_prt_organs = 6 ; variables: float fates_history_height_bin_edges(fates_history_height_bins) ; fates_history_height_bin_edges:units = "m" ; @@ -119,6 +120,9 @@ variables: 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) ; 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" ; @@ -203,6 +207,51 @@ variables: float fates_branch_turnover(fates_pft) ; fates_branch_turnover:units = "yr-1" ; fates_branch_turnover:long_name = "turnover time of branches" ; + + float fates_prt_unit_gr_resp(fates_prt_organs,fates_pft) ; + fates_prt_unit_gr_resp:units = "gC/gC" ; + fates_prt_unit_gr_resp:long_name = "Unit growth respiration rate per organ" ; + + float 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) ; + 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) ; + 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) ; + fates_prt_phos_stoich_p2:units = "(gP/gC)" ; + fates_prt_phos_stoich_p2:long_name = "phosphorous stoichiometry, parameter 2" ; + + float 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_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_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_turnover_carb_retrans_p1(fates_prt_organs,fates_pft) ; + fates_turnover_carb_retrans_p1:units = "na" ; + fates_turnover_carb_retrans_p1:long_name = "retranslocation of carbon in turnover, parameter 1" ; + + float fates_turnover_nitr_retrans_p1(fates_prt_organs,fates_pft) ; + fates_turnover_nitr_retrans_p1:units = "na" ; + fates_turnover_nitr_retrans_p1:long_name = "retranslocation of nitrogen in turnover, parameter 1" ; + + float fates_turnover_phos_retrans_p1(fates_prt_organs,fates_pft) ; + fates_turnover_phos_retrans_p1:units = "na" ; + fates_turnover_phos_retrans_p1:long_name = "retranslocation of phosphorous in turnover, parameter 1" ; + float fates_c2b(fates_pft) ; fates_c2b:units = "ratio" ; fates_c2b:long_name = "Carbon to biomass multiplier of bulk structural tissues" ; @@ -230,9 +279,6 @@ variables: float fates_fr_flig(fates_pft) ; fates_fr_flig:units = "fraction" ; fates_fr_flig:long_name = "Fine root litter lignin fraction" ; - float fates_froot_cn_ratio(fates_pft) ; - fates_froot_cn_ratio:units = "gC/gN" ; - fates_froot_cn_ratio:long_name = "Fine root C:N" ; float fates_grperc(fates_pft) ; fates_grperc:units = "unitless" ; fates_grperc:long_name = "Growth respiration factor" ; @@ -284,9 +330,6 @@ variables: float 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_cn_ratio(fates_pft) ; - fates_leaf_cn_ratio:units = "gC/gN" ; - fates_leaf_cn_ratio:long_name = "Leaf C:N" ; float fates_leaf_c3psn(fates_pft) ; fates_leaf_c3psn:units = "flag" ; fates_leaf_c3psn:long_name = "Photosynthetic pathway (1=c3, 0=c4)" ; @@ -439,7 +482,7 @@ variables: 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) ; 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 (NOT USED YET)" ; + 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" ; @@ -473,9 +516,6 @@ variables: float 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_wood_cn_ratio(fates_pft) ; - fates_wood_cn_ratio:units = "gC/gN" ; - fates_wood_cn_ratio:long_name = "Wood C:N" ; float fates_wood_density(fates_pft) ; fates_wood_density:units = "g/cm3" ; fates_wood_density:long_name = "mean density of woody tissue in plant" ; @@ -637,17 +677,25 @@ data: "broadleaf_evergreen_tropical_tree ", "needleleaf_evergreen_temperate_tree ", "needleleaf_evergreen_boreal_tree ", - "needleleaf_deciduous_boreal_tree (force evgrn)", + "needleleaf_deciduous_boreal_tree ", "broadleaf_evergreen_temperate_tree ", - "broadleaf_deciduous_tropical_tree (force evgrn)", - "broadleaf_deciduous_temperate_tree (force evgrn)", - "broadleaf_deciduous_boreal_tree (force evgrn)", + "broadleaf_deciduous_tropical_tree ", + "broadleaf_deciduous_temperate_tree ", + "broadleaf_deciduous_boreal_tree ", "broadleaf_evergreen_temperate_shrub ", - "broadleaf_deciduous_temperate_shrub (force evgrn)", - "broadleaf_deciduous_boreal_shrub (force evgrn)", - "arctic_c3_grass (force evgrn)", - "cool_c3_grass (force evgrn)", - "c4_grass (force evgrn)" ; + "broadleaf_deciduous_temperate_shrub ", + "broadleaf_deciduous_boreal_shrub ", + "arctic_c3_grass ", + "cool_c3_grass ", + "c4_grass " ; + + fates_prt_organ_name = + "leaf ", + "fine root ", + "sapwood ", + "storage ", + "reproduction ", + "structure "; fates_alloc_storage_cushion = 2, 1.2, 1.2, 1.2, 1.2, 1.2, 1.2, 1.2, 1.2, 1.2, 1.2, 1.2, 1.2, 1.2 ; @@ -724,6 +772,86 @@ data: fates_branch_turnover = 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 0, 0, 0 ; + fates_prt_unit_gr_resp = + 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, + 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, + 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, + 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, + 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, + 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11; + + + fates_prt_nitr_stoich_p1 = + 0.033, 0.029, 0.025, 0.04, 0.033, 0.04, 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, 0.024, 0.024, + 0.0047, 0.0047, 0.0047, 0.0047, 0.0047, 0.0047, 0.0047, 0.0047, 0.0047, 0.0047, 0.0047, 0.0047, 0.0047, 0.0047, + 0.0047, 0.0047, 0.0047, 0.0047, 0.0047, 0.0047, 0.0047, 0.0047, 0.0047, 0.0047, 0.0047, 0.0047, 0.0047, 0.0047, + 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.0047, 0.0047, 0.0047, 0.0047, 0.0047, 0.0047, 0.0047, 0.0047, 0.0047, 0.0047, 0.0047, 0.0047, 0.0047, 0.0047; + + fates_prt_nitr_stoich_p2 = + _, _, _, _, _, _, _, _, _, _, _, _, _, _, + _, _, _, _, _, _, _, _, _, _, _, _, _, _, + _, _, _, _, _, _, _, _, _, _, _, _, _, _, + _, _, _, _, _, _, _, _, _, _, _, _, _, _, + _, _, _, _, _, _, _, _, _, _, _, _, _, _, + _, _, _, _, _, _, _, _, _, _, _, _, _, _; + + fates_prt_phos_stoich_p1 = + _, _, _, _, _, _, _, _, _, _, _, _, _, _, + _, _, _, _, _, _, _, _, _, _, _, _, _, _, + _, _, _, _, _, _, _, _, _, _, _, _, _, _, + _, _, _, _, _, _, _, _, _, _, _, _, _, _, + _, _, _, _, _, _, _, _, _, _, _, _, _, _, + _, _, _, _, _, _, _, _, _, _, _, _, _, _; + + fates_prt_phos_stoich_p2 = + _, _, _, _, _, _, _, _, _, _, _, _, _, _, + _, _, _, _, _, _, _, _, _, _, _, _, _, _, + _, _, _, _, _, _, _, _, _, _, _, _, _, _, + _, _, _, _, _, _, _, _, _, _, _, _, _, _, + _, _, _, _, _, _, _, _, _, _, _, _, _, _, + _, _, _, _, _, _, _, _, _, _, _, _, _, _; + + fates_prt_alloc_priority = + _, _, _, _, _, _, _, _, _, _, _, _, _, _, + _, _, _, _, _, _, _, _, _, _, _, _, _, _, + _, _, _, _, _, _, _, _, _, _, _, _, _, _, + _, _, _, _, _, _, _, _, _, _, _, _, _, _, + _, _, _, _, _, _, _, _, _, _, _, _, _, _, + _, _, _, _, _, _, _, _, _, _, _, _, _, _; + + fates_phenflush_fraction = + _, _, _, 0.5, _, 0.5, 0.5, 0.5, _, 0.5, 0.5, 0.5, 0.5, 0.5; + + fates_turnover_retrans_mode = + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1; + + fates_turnover_carb_retrans_p1 = + 0.025, 0.025, 0.025, 0.05, 0.025, 0.05, 0.05, 0.05, 0.025, 0.05, 0.05, 0.05, 0.05, 0.05, + 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, + 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, + 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, + 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, + 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00; + + + fates_turnover_nitr_retrans_p1 = + _, _, _, _, _, _, _, _, _, _, _, _, _, _, + _, _, _, _, _, _, _, _, _, _, _, _, _, _, + _, _, _, _, _, _, _, _, _, _, _, _, _, _, + _, _, _, _, _, _, _, _, _, _, _, _, _, _, + _, _, _, _, _, _, _, _, _, _, _, _, _, _, + _, _, _, _, _, _, _, _, _, _, _, _, _, _; + + fates_turnover_phos_retrans_p1 = + _, _, _, _, _, _, _, _, _, _, _, _, _, _, + _, _, _, _, _, _, _, _, _, _, _, _, _, _, + _, _, _, _, _, _, _, _, _, _, _, _, _, _, + _, _, _, _, _, _, _, _, _, _, _, _, _, _, + _, _, _, _, _, _, _, _, _, _, _, _, _, _, + _, _, _, _, _, _, _, _, _, _, _, _, _, _; + fates_c2b = 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2 ; fates_displar = 0.67, 0.67, 0.67, 0.67, 0.67, 0.67, 0.67, 0.67, 0.67, 0.67, @@ -750,8 +878,6 @@ data: fates_fr_flig = 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25 ; - fates_froot_cn_ratio = 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42 ; - fates_grperc = 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11 ; @@ -853,8 +979,6 @@ data: fates_leaf_BB_slope = 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8 ; - fates_leaf_cn_ratio = 30, 35, 40, 25, 30, 25, 25, 25, 30, 25, 25, 25, 25, 25 ; - fates_leaf_c3psn = 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0 ; fates_leaf_clumping_index = 0.85, 0.85, 0.675, 0.8, 0.85, 0.85, 0.9, 0.75, @@ -1032,9 +1156,6 @@ 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, 0.3, 0.3 ; - fates_wood_cn_ratio = 210, 210, 210, 210, 210, 210, 210, 210, 210, 210, 210, - 210, 210, 210 ; - fates_wood_density = 0.7, 0.7, 0.7, 0.7, 0.7, 0.7, 0.7, 0.7, 0.7, 0.7, 0.7, 0.7, 0.7, 0.7 ; diff --git a/parameter_files/fates_params_default.cdl b/parameter_files/fates_params_default.cdl index dbcac5c2ee..ed1bf71b5a 100644 --- a/parameter_files/fates_params_default.cdl +++ b/parameter_files/fates_params_default.cdl @@ -84,6 +84,9 @@ variables: 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_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)" ; @@ -416,7 +419,7 @@ variables: 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) ; 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 (NOT USED YET)" ; + 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" ; @@ -687,6 +690,14 @@ data: "broadleaf_evergreen_tropical_tree ", "broadleaf_evergreen_tropical_tree " ; + fates_prt_organ_name = + "leaf ", + "fine root ", + "sapwood ", + "storage ", + "reproduction ", + "structure "; + fates_rootprof_beta = 0.976, 0.976, _, _ ; @@ -753,7 +764,6 @@ data: 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, - 0.11, 0.11, 0.11, 0.11; fates_prt_nitr_stoich_p1 = From 2e96e19c19f58d6fd4a2f860dee77a5c9330b790 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 11 Oct 2018 18:04:47 -0700 Subject: [PATCH 28/52] parteh: Moved the allocation of the prt structure to be a non-overridable base procedure. Also, added support variables to the global instance for number of variables, number of boundary conditions, and number of positions. Also, removed the plant instance prt_vartypes structures pointer to the global instance. This was unnecessary, as there is only one global intance, which has a generic pointer. --- biogeochem/EDCohortDynamicsMod.F90 | 48 +++- biogeochem/FatesAllometryMod.F90 | 5 +- biogeophys/FatesPlantRespPhotosynthMod.F90 | 5 +- main/EDPftvarcon.F90 | 6 +- main/FatesRestartInterfaceMod.F90 | 24 +- parteh/PRTAllometricCarbonMod.F90 | 102 +++---- parteh/PRTGenericMod.F90 | 307 +++++++++++---------- parteh/PRTLossFluxesMod.F90 | 56 ++-- 8 files changed, 279 insertions(+), 274 deletions(-) diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index 8c41eb006f..8fa9f9a7ef 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -38,9 +38,10 @@ module EDCohortDynamicsMod use FatesAllometryMod , only : StructureResetOfDH use FatesAllometryMod , only : tree_lai, tree_sai + 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 : leaf_organ use PRTGenericMod, only : all_carbon_species use PRTGenericMod, only : carbon12_species use PRTGenericMod, only : nitrogen_species @@ -166,7 +167,7 @@ subroutine create_cohort(currentSite, patchptr, pft, nn, hite, dbh, bleaf, bfine ! ----------------------------------------------------------------------------------- select case(hlm_parteh_model) - case (1) + case (prt_carbon_allom_hyp) call SetState(new_cohort%prt,leaf_organ, carbon12_species, bleaf) call SetState(new_cohort%prt,fnrt_organ, carbon12_species, bfineroot) @@ -261,16 +262,31 @@ end subroutine create_cohort subroutine InitPRTCohort(new_cohort) + ! ---------------------------------------------------------------------------------- ! This subroutine simply allocates and attaches the correct PRT object. - ! No meaningful values to are set here. + ! 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. + ! ----------------------------------------------------------------------------------- + ! ! !ARGUMENTS type(ed_cohort_type), intent(inout), target :: new_cohort type(callom_prt_vartypes), pointer :: callom_prt + ! Allocate the PRT class object + ! Each hypothesis has a different object which is an extension + ! of the base class. + select case(hlm_parteh_model) - case (1) + case (prt_carbon_allom_hyp) allocate(callom_prt) new_cohort%prt => callom_prt @@ -283,12 +299,32 @@ subroutine InitPRTCohort(new_cohort) 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%InitPRTVartype() + + ! 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. + + select case(hlm_parteh_model) - case (1) + case (prt_carbon_allom_hyp) + + ! Register boundary conditions for the Carbon Only Allometric Hypothesis - ! Register boundary conditions 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) diff --git a/biogeochem/FatesAllometryMod.F90 b/biogeochem/FatesAllometryMod.F90 index 943f162e39..3f011b98c0 100644 --- a/biogeochem/FatesAllometryMod.F90 +++ b/biogeochem/FatesAllometryMod.F90 @@ -580,7 +580,10 @@ real(r8) function tree_lai( bl, pft, c_area, nplant, cl, canopy_lai) !---------------------------------------------------------------------- if( bl < 0._r8 .or. pft == 0 ) then - write(fates_log(),*) 'problem in treelai',bl,pft + ! This message was signalling many times + ! because of cases where leaf biomass is a negative that is + ! within reasonable precision of 0 (ie -1e-19) + ! write(fates_log(),*) 'problem in treelai',bl,pft endif slat = g_per_kg * EDPftvarcon_inst%slatop(pft) ! m2/g to m2/kg diff --git a/biogeophys/FatesPlantRespPhotosynthMod.F90 b/biogeophys/FatesPlantRespPhotosynthMod.F90 index 4d3e2323a9..ae9ffecd61 100644 --- a/biogeophys/FatesPlantRespPhotosynthMod.F90 +++ b/biogeophys/FatesPlantRespPhotosynthMod.F90 @@ -30,7 +30,8 @@ module FATESPlantRespPhotosynthMod use EDTypesMod, only : maxpft use EDTypesMod, only : nlevleaf use EDTypesMod, only : nclmax - + + use PRTGenericMod, only : prt_carbon_allom_hyp use PRTGenericMod, only : carbon12_species use PRTGenericMod, only : nitrogen_species use PRTGenericMod, only : phosphorous_species @@ -390,7 +391,7 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) if ( .not.rate_mask_z(iv,ft,cl) .or. & (hlm_use_planthydro.eq.itrue) .or. & - (hlm_parteh_model.ne.1) ) then + (hlm_parteh_model .ne. prt_carbon_allom_hyp ) ) then if (hlm_use_planthydro.eq.itrue) then diff --git a/main/EDPftvarcon.F90 b/main/EDPftvarcon.F90 index f516bfad47..d71046adfa 100644 --- a/main/EDPftvarcon.F90 +++ b/main/EDPftvarcon.F90 @@ -12,6 +12,8 @@ module EDPftvarcon use FatesGlobals, only : fates_log use FatesGlobals, only : endrun => fates_endrun + use PRTGenericMod, only : prt_cnp_flex_allom_hyp + use PRTGenericMod, only : prt_carbon_allom_hyp use PRTGenericMod, only : leaf_organ, fnrt_organ, store_organ use PRTGenericMod, only : sapw_organ, struct_organ, repro_organ @@ -1773,14 +1775,14 @@ subroutine FatesCheckParams(is_master, parteh_model) if(.not.is_master) return - if (parteh_model .eq. 2) then + if (parteh_model .eq. prt_cnp_flex_allom_hyp) then write(fates_log(),*) 'FATES Plant Allocation and Reactive Transport' write(fates_log(),*) 'with flexible target stoichiometry for NP and' write(fates_log(),*) 'allometrically constrianed C is still under development' write(fates_log(),*) 'Aborting' call endrun(msg=errMsg(sourcefile, __LINE__)) - elseif (parteh_model .ne. 1) then + elseif (parteh_model .ne. prt_carbon_allom_hyp) then write(fates_log(),*) 'FATES Plant Allocation and Reactive Transport has' write(fates_log(),*) 'only 1 module supported, allometric carbon only.' diff --git a/main/FatesRestartInterfaceMod.F90 b/main/FatesRestartInterfaceMod.F90 index 190acacf2c..42ba592f3e 100644 --- a/main/FatesRestartInterfaceMod.F90 +++ b/main/FatesRestartInterfaceMod.F90 @@ -13,9 +13,6 @@ module FatesRestartInterfaceMod use FatesInterfaceMod, only : bc_in_type use FatesSizeAgeTypeIndicesMod, only : get_sizeage_class_index - use FatesInterfaceMod , only : hlm_parteh_model - - use PRTGenericMod, only : leaf_organ use PRTGenericMod, only : all_carbon_species use PRTGenericMod, only : carbon12_species use PRTGenericMod, only : nitrogen_species @@ -864,8 +861,6 @@ subroutine DefinePRTRestartVars(this,initialize_variables,ivar) logical, intent(in) :: initialize_variables integer,intent(inout) :: ivar ! global variable counter - integer :: n_vars ! number of state variables - integer :: n_pos ! number of discrete positions integer :: dummy_out ! dummy index for variable ! position in global file integer :: i_var ! loop counter for prt variables @@ -877,11 +872,7 @@ subroutine DefinePRTRestartVars(this,initialize_variables,ivar) character(len=128) :: symbol character(len=256) :: long_name - - n_vars = size(prt_instance%state_descriptor,1) - - do i_var = 1, n_vars - + do i_var = 1, prt_instance%num_vars ! The base symbol name symbol_base = prt_instance%state_descriptor(i_var)%symbol @@ -889,10 +880,7 @@ subroutine DefinePRTRestartVars(this,initialize_variables,ivar) ! The long name of the variable name_base = prt_instance%state_descriptor(i_var)%longname - - n_pos = prt_instance%state_descriptor(i_var)%num_pos - - do i_pos = 1, n_pos + do i_pos = 1, prt_instance%state_descriptor(i_var)%num_pos ! String describing the physical position of the variable write(pos_symbol, '(I3.3)') i_pos @@ -1209,8 +1197,8 @@ subroutine set_restart_vectors(this,nc,nsites,sites) ! Fill output arrays of PRT variables i_var_pos = 0 - do i_var = 1, size(ccohort%prt%variables,1) - do i_pos = 1, ccohort%prt%variables(i_var)%num_pos + do i_var = 1, prt_instance%num_vars + do i_pos = 1, prt_instance%state_descriptor(i_var)%num_pos i_var_pos = i_var_pos + 1 this%rvars(ir_prt_base+i_var_pos)%r81d(io_idx_co) = & @@ -1774,8 +1762,8 @@ subroutine get_restart_vectors(this, nc, nsites, sites) ! Fill PRT state variables with array data i_var_pos = 0 - do i_var = 1, size(ccohort%prt%variables,1) - do i_pos = 1, ccohort%prt%variables(i_var)%num_pos + do i_var = 1, prt_instance%num_vars + do i_pos = 1, prt_instance%state_descriptor(i_var)%num_pos i_var_pos = i_var_pos + 1 ccohort%prt%variables(i_var)%val(i_pos) = & diff --git a/parteh/PRTAllometricCarbonMod.F90 b/parteh/PRTAllometricCarbonMod.F90 index dd70900865..58edee7dd4 100644 --- a/parteh/PRTAllometricCarbonMod.F90 +++ b/parteh/PRTAllometricCarbonMod.F90 @@ -48,27 +48,31 @@ module PRTAllometricCarbonMod use FatesConstantsMod , only : calloc_abs_error use FatesConstantsMod , only : nearzero use FatesConstantsMod , only : itrue - ! use PARTEHUtilitiesMod , only : MaintenanceTurnover + implicit none private ! ------------------------------------------------------------------------------------- ! - ! Define the state variables for this specific hypothesis. Give them units and define - ! the indices that correspond with the generic classifications of PRT variables + ! Define the state variables for this specific hypothesis. ! ! ------------------------------------------------------------------------------------- - integer, parameter :: leaf_c_id = 1 - integer, parameter :: fnrt_c_id = 2 - integer, parameter :: sapw_c_id = 3 - integer, parameter :: store_c_id = 4 - integer, parameter :: repro_c_id = 5 - integer, parameter :: struct_c_id = 6 - integer, parameter :: ac_num_vars = 6 ! Number of PRT variables + integer, parameter :: leaf_c_id = 1 ! Unique object index for leaf carbon + integer, parameter :: fnrt_c_id = 2 ! Unique object index for fine-root carbon + integer, parameter :: sapw_c_id = 3 ! Unique object index for sapwood carbon + integer, parameter :: store_c_id = 4 ! Unique object index for storage carbon + integer, parameter :: repro_c_id = 5 ! Unique object index for reproductive carbon + integer, parameter :: struct_c_id = 6 ! Unique object index for structural carbon + integer, parameter :: ac_num_vars = 6 ! THIS MUST MATCH THE LARGEST INDEX ABOVE + - integer, parameter :: dbh_id = 7 ! This is just used for the integrator + ! For this hypothesis, we integrate dbh along with the other 6. Since this + ! is a boundary condition, we do not add it to the state array, but we do want + ! to include it with the integrator array. + + integer, parameter :: dbh_id = 7 ! This is just used for the integrator integer, parameter :: n_integration_vars = 7 @@ -89,6 +93,8 @@ module PRTAllometricCarbonMod integer, public, parameter :: ac_bc_in_id_ctrim = 2 ! Index for the canopy trim function integer, parameter :: num_bc_in = 2 + ! THere are no purely output boundary conditions + integer, parameter :: num_bc_out = 0 ! ------------------------------------------------------------------------------------- ! Define the size of the coorindate vector. For this hypothesis, there is only @@ -118,7 +124,6 @@ module PRTAllometricCarbonMod procedure :: DailyPRT => DailyPRTAC procedure :: FastPRT => FastPRTAC - procedure :: InitAllocate => InitAllocateAC end type callom_prt_vartypes @@ -150,23 +155,21 @@ subroutine InitPRTInstanceAC() ! organizes the specific variables in this module to ! pre-ordained groups, so they can be used to inform ! the rest of the model + ! This is called very early on in the call sequence of the model, and should occur + ! before any plants start being initialized. These mapping tables must + ! exist before that happens. ! ----------------------------------------------------------------------------------- allocate(prt_instance_ac) allocate(prt_instance_ac%state_descriptor(ac_num_vars)) - prt_instance => prt_instance_ac - prt_instance_ac%hyp_name = 'Allometric Carbon Only' + ! Set mapping tables to zero call prt_instance_ac%ZeroInstance() - ! Populate the array - ! This is a carbon only scheme, no isotopes, so should be simple - ! The "indices array" max not exceed max_types_per_sp_organ - ! If that array limit is not large enough for new hypothesis - ! simply increase it. It will not use much memory or increase loop sizes - + ! Register the variables. Each variable must be associated with a global identifier + ! for an organ and species. call prt_instance_ac%InitInstance(leaf_c_id,"Leaf Carbon","leaf_c",leaf_organ,carbon12_species,icd) call prt_instance_ac%InitInstance(fnrt_c_id,"Fine Root Carbon","fnrt_c",fnrt_organ,carbon12_species,icd) @@ -175,61 +178,18 @@ subroutine InitPRTInstanceAC() call prt_instance_ac%InitInstance(struct_c_id,"Structural Carbon","struct_c",struct_organ,carbon12_species,icd) call prt_instance_ac%InitInstance(repro_c_id,"Reproductive Carbon","repro_c",repro_organ,carbon12_species,icd) - return - end subroutine InitPRTInstanceAC - - - ! ===================================================================================== - - - subroutine InitAllocateAC(this) - - ! ---------------------------------------------------------------------------------- - ! This initialization is called everytime a plant/cohort - ! is newly recruited. This simply sets-up, allocates - ! and sets some initialization values - ! ---------------------------------------------------------------------------------- - - class(callom_prt_vartypes) :: this ! this class - - integer :: ivar + ! Set some of the array sizes for input and output boundary conditions + prt_instance_ac%num_bc_in = num_bc_in + prt_instance_ac%num_bc_out = num_bc_out + prt_instance_ac%num_bc_inout = num_bc_inout + prt_instance_ac%num_vars = ac_num_vars + ! Have the global generic pointer, point to this hypothesis' object + prt_instance => prt_instance_ac - ! Set the instance pointer to the correct instance - ! ---------------------------------------------------------------------------------- - - this%prt_instance => prt_instance_ac - - - ! Allocate the boundar condition arrays and flush them to no-data flags - ! ---------------------------------------------------------------------------------- - - allocate(this%bc_in(num_bc_in)) - allocate(this%bc_inout(num_bc_inout)) - - - ! Allocate the state variables - allocate(this%variables(ac_num_vars)) - - do ivar = 1, ac_num_vars - - this%variables(ivar)%num_pos = icd - allocate(this%variables(ivar)%val(icd)) - allocate(this%variables(ivar)%val0(icd)) - allocate(this%variables(ivar)%turnover(icd)) - allocate(this%variables(ivar)%net_art(icd)) - allocate(this%variables(ivar)%burned(icd)) - - end do - - ! Initialize the optimum step size as very large. - - this%ode_opt_step = 1e6_r8 - return - end subroutine InitAllocateAC - + end subroutine InitPRTInstanceAC ! ===================================================================================== diff --git a/parteh/PRTGenericMod.F90 b/parteh/PRTGenericMod.F90 index 3fef3720e1..54a054de6f 100644 --- a/parteh/PRTGenericMod.F90 +++ b/parteh/PRTGenericMod.F90 @@ -58,7 +58,16 @@ module PRTGenericMod character(len=len_baseunit), parameter :: mass_unit = 'kg' character(len=len_baseunit), parameter :: 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 + + ! ------------------------------------------------------------------------------------- ! Organ types ! These are public indices used to map the organs @@ -120,18 +129,8 @@ module PRTGenericMod integer, parameter, dimension(3) :: carbon_species = & [carbon12_species, carbon13_species, carbon14_species] - - - ! The following index specifies the maximum number of unique variables - ! that could be described by any unique species x organ combination. In most - ! scenarios, this is simply 1. But for example, one may want multiple leaf - ! layers, each representing carbon 12. Setting this maximum high - ! will not have a substantial impact on the memory footprint, and it will - ! not have an effect on loop sizes because looping bounds are variables. - - integer, parameter :: max_types_per_sp_organ = 1 - + ! ------------------------------------------------------------------------------------- ! This is a generic variable type that can be used to describe all ! species x organ variable combinations. @@ -150,7 +149,7 @@ module PRTGenericMod ! of the control period [kg] real(r8),allocatable :: net_art(:) ! Net change due to allocation/transport [kg] ! over the control period [kg] - real(r8),allocatable :: turnover(:) ! Losses rate due to turnover [kg] + real(r8),allocatable :: turnover(:) ! Losses due to turnover [kg] ! or, any mass destined for litter ! over the control period @@ -163,8 +162,6 @@ module PRTGenericMod ! add this only in the extension ... ? ! real(r8),allocatable :: coordinate(:,:) - integer :: num_pos ! Number of pools with own position per species x organ - end type prt_vartype @@ -203,20 +200,17 @@ module PRTGenericMod type(prt_bctype), allocatable :: bc_out(:) ! These are overwritten real(r8) :: ode_opt_step - ! Note this is allocated only once per node/instance - ! This really is just a pointer, not an allocatable pointer - type(prt_instance_type), pointer :: prt_instance - contains ! These are extendable procedures that have specialized ! content in each of the different hypotheses - procedure :: InitAllocate => InitAllocateBase + procedure :: DailyPRT => DailyPRTBase procedure :: FastPRT => FastPRTBase ! These are generic functions that should work on all hypotheses + procedure, non_overridable :: InitAllocate procedure, non_overridable :: InitPRTVartype procedure, non_overridable :: FlushBCs procedure, non_overridable :: InitializeInitialConditions @@ -236,10 +230,15 @@ module PRTGenericMod end type prt_vartypes ! ------------------------------------------------------------------------------------- - ! This next section contains that types that describe the whole instance. These are - ! things that map the variable types themselves from one model to the next, or help - ! decribe the arbitrary variables. These are not instanced on every plant, they are - ! instanced on every model instance. + ! This next section contains the object that describe the mapping for each specific + ! hypothesis. It is also a way to call the descriptions of variables for any + ! arbitrary hypothesis. + ! These are things that are generally true, not specific to each plant. + ! For instance the map just contains the list of variable names, not the values for + ! each plant. + ! These are not instanced on every plant, they are just instanced once on every model + ! machine or memory space. They should only be initialized once and used + ! as read-only from that point on. ! ------------------------------------------------------------------------------------- ! ------------------------------------------------------------------------------------- @@ -251,17 +250,29 @@ module PRTGenericMod character(len=maxlen_varname) :: longname character(len=maxlen_varsymbol) :: symbol integer :: organ_id ! global id for organ - integer :: spec_id ! global id for species - integer :: num_pos ! number of descrete spatial positions + integer :: spec_id ! global id for species + integer :: num_pos ! number of descrete spatial positions ! Also, will probably need flags to define different types of groups that this variable ! belongs too, which will control things like fusion, normalization, when to zero, etc... end type state_descriptor_type + + + ! This type will help us loop through all the different variables associated + ! with a specific organ type. Since variables are a combination of organ and + ! species, the number of unique variables is capped at the number of species + ! per each organ. + type organ_map_type + integer, dimension(1:num_species_types) :: var_id + integer :: num_vars + end type organ_map_type + + ! This structure packs both the mapping structure and the variable descriptors - ! -------------------------------------------------------------------------------------- + ! ------------------------------------------------------------------------------------- ! This array should contain the lists of indices to ! the species x organ variable structure that is used to map variables to the outside ! world. @@ -279,16 +290,6 @@ module PRTGenericMod ! ------------------------------------------ ! ! ------------------------------------------------------------------------------------- - - ! This type will help us loop through all the different variables associated - ! with a specific organ type. Since variables are a combination of organ and - ! species, the number of unique variables is capped at the number of species - ! per each organ. - - type organ_map_type - integer, dimension(1:num_species_types) :: var_id - integer :: num_vars - end type organ_map_type type prt_instance_type @@ -296,12 +297,29 @@ module PRTGenericMod ! Note that index 0 is reserved for "all" or "irrelevant" character(len=maxlen_varname) :: hyp_name - ! This will list the specific variable ids associated with - ! each organ + ! This will save the specific variable id associated with each organ and species integer, dimension(0:num_organ_types,0:num_species_types) :: sp_organ_map + + type(state_descriptor_type), allocatable :: state_descriptor(:) + + ! This will save the list of variable ids associated with each organ. There + ! are multiple of these because we may have multiple species per organ. type(organ_map_type), dimension(1:num_organ_types) :: organ_map + ! The number of input boundary conditions + integer :: num_bc_in + + ! The number of output boundary conditions + integer :: num_bc_out + + ! The number of combo input-output boundary conditions + integer :: num_bc_inout + + ! The number of variables set by each hypothesis + integer :: num_vars + + contains procedure, non_overridable :: ZeroInstance @@ -334,7 +352,16 @@ subroutine ZeroInstance(this) end do this%organ_map(io)%num_vars = 0 end do - + + ! Set the number of boundary conditions as a bogus value + this%num_bc_in = -9 + this%num_bc_out = -9 + this%num_bc_inout = -9 + + ! Set the number of variables to a bogus value. This should be + ! immediately over-written in the routine that is calling this + this%num_vars = -9 + return end subroutine ZeroInstance @@ -350,6 +377,7 @@ subroutine InitInstance(this, var_id, long_name, symbol, organ_id, spec_id, num_ integer, intent(in) :: spec_id integer, intent(in) :: num_pos + ! Set the descriptions and the associated organs/species in the variable's ! own array @@ -379,32 +407,79 @@ subroutine InitPRTVartype(this) class(prt_vartypes) :: this - + ! This subroutine should be the first call whenever a prt_vartype object is ! instantiated. This routine handles the allocation (extended procedure) ! and then the initializing of states with bogus information, and then ! the flushing of all boundary conditions to null. - call this%InitAllocate() - call this%InitializeInitialConditions() - call this%FlushBCs() + call this%InitAllocate() ! Allocate memory spaces + call this%InitializeInitialConditions() ! Set states to a nan-like starter value + call this%FlushBCs() ! Set all boundary condition pointers + ! to null return end subroutine InitPRTVartype + ! ===================================================================================== + + subroutine InitAllocate(this) + + ! ---------------------------------------------------------------------------------- + ! This initialization is called everytime a plant/cohort + ! is newly recruited. This simply sets-up, allocates + ! and sets some initialization values + ! ---------------------------------------------------------------------------------- + + class(prt_vartypes) :: this + + integer :: i_var ! Variable loop index + integer :: num_pos ! The number of positions for each variable + + ! Allocate the boundar condition arrays and flush them to no-data flags + ! ---------------------------------------------------------------------------------- + + if(prt_instance%num_bc_in > 0) then + allocate(this%bc_in(prt_instance%num_bc_in)) + end if + + if(prt_instance%num_bc_inout > 0) then + allocate(this%bc_inout(prt_instance%num_bc_inout)) + end if + + if(prt_instance%num_bc_out > 0) then + allocate(this%bc_out(prt_instance%num_bc_out)) + end if + + ! Allocate the state variables + allocate(this%variables(prt_instance%num_vars)) + + do i_var = 1, prt_instance%num_vars + + num_pos = prt_instance%state_descriptor(i_var)%num_pos + + allocate(this%variables(i_var)%val(num_pos)) + allocate(this%variables(i_var)%val0(num_pos)) + allocate(this%variables(i_var)%turnover(num_pos)) + allocate(this%variables(i_var)%net_art(num_pos)) + allocate(this%variables(i_var)%burned(num_pos)) + + end do + + + return + end subroutine InitAllocate + ! ===================================================================================== subroutine InitializeInitialConditions(this) class(prt_vartypes) :: this - integer :: num_vars ! Number of variables integer :: i_var ! Variable index - num_vars = size(this%variables,1) - - do i_var = 1, num_vars + do i_var = 1, prt_instance%num_vars this%variables(i_var)%val(:) = un_initialized this%variables(i_var)%val0(:) = un_initialized this%variables(i_var)%turnover(:) = un_initialized @@ -412,6 +487,9 @@ subroutine InitializeInitialConditions(this) this%variables(i_var)%net_art(:) = un_initialized end do + ! Initialize the optimum step size as very large. + + this%ode_opt_step = 1e6_r8 return end subroutine InitializeInitialConditions @@ -427,16 +505,13 @@ subroutine CheckInitialConditions(this) class(prt_vartypes) :: this - integer :: n_vars ! Number of variables integer :: i_var ! index for iterating variables integer :: n_cor_ids ! Number of coordinate ids integer :: i_cor ! index for iterating coordinate dimension integer :: i_gorgan ! The global organ id for this variable integer :: i_gspecies ! The global species id for this variable - n_vars = size(this%variables,1) - - do i_var = 1, n_vars + do i_var = 1, prt_instance%num_vars n_cor_ids = size(this%variables(i_var)%val,1) @@ -444,11 +519,11 @@ subroutine CheckInitialConditions(this) if(this%variables(i_var)%val(i_cor) < check_initialized) then - i_gorgan = this%prt_instance%state_descriptor(i_var)%organ_id - i_gspecies = this%prt_instance%state_descriptor(i_var)%spec_id + i_gorgan = prt_instance%state_descriptor(i_var)%organ_id + i_gspecies = prt_instance%state_descriptor(i_var)%spec_id write(fates_log(),*)'Not all initial conditions for state variables' - write(fates_log(),*)' in PRT hypothesis: ',trim(this%prt_instance%hyp_name) + write(fates_log(),*)' in PRT hypothesis: ',trim(prt_instance%hyp_name) write(fates_log(),*)' were written out.' write(fates_log(),*)' i_var: ',i_var write(fates_log(),*)' i_cor: ',i_cor @@ -552,7 +627,6 @@ subroutine CopyPRTVartypes(this, donor_prt_obj) integer :: i_var ! loop iterator for variable objects integer :: i_bc ! loop iterator for boundary pointers - integer :: n_vars integer :: num_bc_in integer :: num_bc_inout integer :: num_bc_out @@ -563,9 +637,7 @@ subroutine CopyPRTVartypes(this, donor_prt_obj) ! variable val0 is omitted, because it is ephemeral and used only during the ! allocation process - n_vars = size(donor_prt_obj%variables,1) - - do i_var = 1, n_vars + do i_var = 1, prt_instance%num_vars this%variables(i_var)%val(:) = donor_prt_obj%variables(i_var)%val(:) this%variables(i_var)%val0(:) = donor_prt_obj%variables(i_var)%val0(:) this%variables(i_var)%net_art(:) = donor_prt_obj%variables(i_var)%net_art(:) @@ -573,30 +645,6 @@ subroutine CopyPRTVartypes(this, donor_prt_obj) this%variables(i_var)%burned(:) = donor_prt_obj%variables(i_var)%burned(:) end do -! if(allocated(this%bc_in))then -! num_bc_in = size(this%bc_in,1) -! do i_bc = 1, num_bc_in -! this%bc_in(i_bc)%ival => donor_prt_obj%bc_in(i_bc)%ival -! this%bc_in(i_bc)%rval => donor_prt_obj%bc_in(i_bc)%rval -! end do -! end if - -! if(allocated(this%bc_out))then -! num_bc_out = size(this%bc_out,1) -! do i_bc = 1, num_bc_out -! this%bc_out(i_bc)%ival => donor_prt_obj%bc_out(i_bc)%ival -! this%bc_out(i_bc)%rval => donor_prt_obj%bc_out(i_bc)%rval -! end do -! end if - -! if(allocated(this%bc_inout))then -! num_bc_inout = size(this%bc_inout,1) -! do i_bc = 1, num_bc_inout -! this%bc_inout(i_bc)%ival => donor_prt_obj%bc_inout(i_bc)%ival -! this%bc_inout(i_bc)%rval => donor_prt_obj%bc_inout(i_bc)%rval -! end do -! end if - this%ode_opt_step = donor_prt_obj%ode_opt_step return @@ -618,19 +666,17 @@ subroutine WeightedFusePRTVartypes(this,donor_prt_obj, recipient_fuse_weight, po integer,intent(in),optional :: position_id ! Locals - integer :: n_vars ! Number of variables integer :: i_var ! Loop iterator over variables integer :: pos_id ! coordinate id (defaults to 1) - n_vars = size(this%variables,1) - if(present(position_id)) then pos_id = position_id else pos_id = 1 end if - do i_var = 1, n_vars + do i_var = 1, prt_instance%num_vars + this%variables(i_var)%val(pos_id) = recipient_fuse_weight * this%variables(i_var)%val(pos_id) + & (1.0_r8-recipient_fuse_weight) * donor_prt_obj%variables(i_var)%val(pos_id) @@ -661,15 +707,12 @@ subroutine DeallocatePRTVartypes(this) class(prt_vartypes) :: this - integer :: n_vars integer :: i_var ! Check to see if there is any value in these pools? ! SHould not deallocate if there is any carbon left - n_vars = size(this%variables,1) - - do i_var = 1, n_vars + do i_var = 1, prt_instance%num_vars deallocate(this%variables(i_var)%val) deallocate(this%variables(i_var)%val0) deallocate(this%variables(i_var)%net_art) @@ -691,10 +734,6 @@ subroutine DeallocatePRTVartypes(this) deallocate(this%bc_inout) end if - this%ode_opt_step = -9.0e10_r8 - - this%prt_instance => null() - return end subroutine DeallocatePRTVartypes @@ -756,11 +795,9 @@ subroutine ZeroRates(this) class(prt_vartypes) :: this - integer :: n_vars ! Number of variables integer :: i_var ! Variable index - n_vars = size(this%variables,1) - do i_var = 1,n_vars + do i_var = 1, prt_instance%num_vars this%variables(i_var)%val0(:) = this%variables(i_var)%val(:) this%variables(i_var)%net_art(:) = 0.0_r8 this%variables(i_var)%turnover(:) = 0.0_r8 @@ -778,7 +815,6 @@ subroutine CheckMassConservation(this,ipft,position_id) integer, intent(in) :: position_id ! Helps to know where ! in the call sequence this was called - integer :: n_vars ! Number of variables integer :: i_var ! Variable index integer :: i_pos ! Position (coordinate) index @@ -786,10 +822,10 @@ subroutine CheckMassConservation(this,ipft,position_id) real(r8) :: rel_err - n_vars = size(this%variables,1) - do i_var = 1,n_vars - - do i_pos = 1, this%variables(i_var)%num_pos + + do i_var = 1, prt_instance%num_vars + + do i_pos = 1, prt_instance%state_descriptor(i_var)%num_pos err = abs((this%variables(i_var)%val(i_pos) - this%variables(i_var)%val0(i_pos)) - & (this%variables(i_var)%net_art(i_pos) & @@ -808,11 +844,11 @@ subroutine CheckMassConservation(this,ipft,position_id) write(fates_log(),*) ' always equal the integrated fluxes.' write(fates_log(),*) ' pft id: ',ipft write(fates_log(),*) ' position id: ',position_id - write(fates_log(),*) ' organ id: ',this%prt_instance%state_descriptor(i_var)%organ_id - write(fates_log(),*) ' species_id: ',this%prt_instance%state_descriptor(i_var)%spec_id + write(fates_log(),*) ' organ id: ',prt_instance%state_descriptor(i_var)%organ_id + write(fates_log(),*) ' species_id: ',prt_instance%state_descriptor(i_var)%spec_id write(fates_log(),*) ' position id: ',i_pos - write(fates_log(),*) ' symbol: ',trim(this%prt_instance%state_descriptor(i_var)%symbol) - write(fates_log(),*) ' longname: ',trim(this%prt_instance%state_descriptor(i_var)%longname) + write(fates_log(),*) ' symbol: ',trim(prt_instance%state_descriptor(i_var)%symbol) + write(fates_log(),*) ' longname: ',trim(prt_instance%state_descriptor(i_var)%longname) write(fates_log(),*) ' err: ',err,' max error: ',calloc_abs_error write(fates_log(),*) ' terms: ', this%variables(i_var)%val(i_pos), & this%variables(i_var)%val0(i_pos), & @@ -835,7 +871,7 @@ function GetState(this, organ_id, species_id, position_id) result(sp_organ_val) ! This function returns the current amount of mass for ! any combination of organ and species. If a position - ! is provided, it will us it, but otherwise, it will sum over + ! is provided, it will use it, but otherwise, it will sum over ! all dimensions. It also can accomodate all_carbon_species, which ! will return the mass of all carbon isotopes combined. @@ -865,7 +901,7 @@ function GetState(this, organ_id, species_id, position_id) result(sp_organ_val) i_pos = position_id do ispec = 1,num_species - i_var = this%prt_instance%sp_organ_map(organ_id,spec_ids(ispec)) + i_var = prt_instance%sp_organ_map(organ_id,spec_ids(ispec)) if(i_var>0) sp_organ_val = sp_organ_val + this%variables(i_var)%val(i_pos) end do @@ -873,10 +909,10 @@ function GetState(this, organ_id, species_id, position_id) result(sp_organ_val) do ispec = 1,num_species - i_var = this%prt_instance%sp_organ_map(organ_id,spec_ids(ispec)) + i_var = prt_instance%sp_organ_map(organ_id,spec_ids(ispec)) if(i_var>0)then - do i_pos = 1, this%variables(i_var)%num_pos + do i_pos = 1, prt_instance%state_descriptor(i_var)%num_pos sp_organ_val = sp_organ_val + this%variables(i_var)%val(i_pos) end do end if @@ -925,7 +961,7 @@ function GetTurnover(this, organ_id, species_id, position_id) result(sp_organ_tu i_pos = position_id do ispec = 1,num_species - i_var = this%prt_instance%sp_organ_map(organ_id,spec_ids(ispec)) + i_var = prt_instance%sp_organ_map(organ_id,spec_ids(ispec)) if(i_var>0) sp_organ_turnover = sp_organ_turnover + & this%variables(i_var)%turnover(i_pos) end do @@ -933,9 +969,9 @@ function GetTurnover(this, organ_id, species_id, position_id) result(sp_organ_tu else do ispec = 1,num_species - i_var = this%prt_instance%sp_organ_map(organ_id,spec_ids(ispec)) + i_var = prt_instance%sp_organ_map(organ_id,spec_ids(ispec)) if(i_var>0) then - do i_pos = 1, this%variables(i_var)%num_pos + do i_pos = 1, prt_instance%state_descriptor(i_var)%num_pos sp_organ_turnover = sp_organ_turnover + this%variables(i_var)%turnover(i_pos) end do end if @@ -980,7 +1016,7 @@ function GetBurned(this, organ_id, species_id, position_id) result(sp_organ_burn i_pos = position_id do ispec = 1,num_species - i_var = this%prt_instance%sp_organ_map(organ_id,spec_ids(ispec)) + i_var = prt_instance%sp_organ_map(organ_id,spec_ids(ispec)) if(i_var>0) sp_organ_burned = sp_organ_burned + & this%variables(i_var)%burned(i_pos) end do @@ -988,9 +1024,9 @@ function GetBurned(this, organ_id, species_id, position_id) result(sp_organ_burn else do ispec = 1,num_species - i_var = this%prt_instance%sp_organ_map(organ_id,spec_ids(ispec)) + i_var = prt_instance%sp_organ_map(organ_id,spec_ids(ispec)) if(i_var>0) then - do i_pos = 1, this%variables(i_var)%num_pos + do i_pos = 1, prt_instance%state_descriptor(i_var)%num_pos sp_organ_burned = sp_organ_burned + this%variables(i_var)%burned(i_pos) end do end if @@ -1035,7 +1071,7 @@ function GetNetART(this, organ_id, species_id, position_id) result(sp_organ_neta i_pos = position_id do ispec = 1,num_species - i_var = this%prt_instance%sp_organ_map(organ_id,spec_ids(ispec)) + i_var = prt_instance%sp_organ_map(organ_id,spec_ids(ispec)) if(i_var>0) sp_organ_netart = sp_organ_netart + & this%variables(i_var)%net_art(i_pos) end do @@ -1043,9 +1079,9 @@ function GetNetART(this, organ_id, species_id, position_id) result(sp_organ_neta else do ispec = 1,num_species - i_var = this%prt_instance%sp_organ_map(organ_id,spec_ids(ispec)) + i_var = prt_instance%sp_organ_map(organ_id,spec_ids(ispec)) if(i_var>0) then - do i_pos = 1, this%variables(i_var)%num_pos + do i_pos = 1, prt_instance%state_descriptor(i_var)%num_pos sp_organ_netart = sp_organ_netart + this%variables(i_var)%net_art(i_pos) end do end if @@ -1071,18 +1107,6 @@ function GetCoordVal(this, organ_id, species_id ) result(prt_val) end function GetCoordVal - - ! ==================================================================================== - - subroutine InitAllocateBase(this) - - class(prt_vartypes) :: this - - write(fates_log(),*)'Init must be extended by a child class.' - call endrun(msg=errMsg(__FILE__, __LINE__)) - - end subroutine InitAllocateBase - ! ==================================================================================== subroutine DailyPRTBase(this) @@ -1106,11 +1130,14 @@ subroutine FastPRTBase(this) end subroutine FastPRTBase ! ==================================================================================== - subroutine SetState(prt,organ_id, species_id, state_val, position_id) - ! CONSIDER INTERFACING THIS AND CALLING DIFFERENT SUBROUTINES BY POINTER + ! This routine should only be called for initalizing the state value + ! of a plant's pools. A value is passed in to set the state of + ! organ and species couplets, and position id if it is provided. + ! A select statement will most definitely bracket the call to this + ! routine. class(prt_vartypes) :: prt integer,intent(in) :: organ_id @@ -1120,7 +1147,6 @@ subroutine SetState(prt,organ_id, species_id, state_val, position_id) integer :: ispec - integer :: n_vars integer,dimension(max_spec_per_group) :: spec_ids integer :: i_var integer :: i_pos @@ -1137,14 +1163,13 @@ subroutine SetState(prt,organ_id, species_id, state_val, position_id) i_pos = 1 end if + i_var = prt_instance%sp_organ_map(organ_id,species_id) - i_var = prt%prt_instance%sp_organ_map(organ_id,species_id) - - if(i_pos>prt%variables(i_var)%num_pos)then + if(i_pos > prt_instance%state_descriptor(i_var)%num_pos )then write(fates_log(),*) 'A position index was specified that is' write(fates_log(),*) 'greater than the allocated position space' write(fates_log(),*) ' i_pos: ',i_pos - write(fates_log(),*) ' num_pos: ',prt%variables(i_var)%num_pos + write(fates_log(),*) ' num_pos: ',prt_instance%state_descriptor(i_var)%num_pos call endrun(msg=errMsg(__FILE__, __LINE__)) end if @@ -1168,8 +1193,4 @@ end subroutine SetState ! ==================================================================================== - - - - end module PRTGenericMod diff --git a/parteh/PRTLossFluxesMod.F90 b/parteh/PRTLossFluxesMod.F90 index 2287b697cf..01f38764c7 100644 --- a/parteh/PRTLossFluxesMod.F90 +++ b/parteh/PRTLossFluxesMod.F90 @@ -1,6 +1,6 @@ module PRTLossFluxesMod - use EDPftvarcon, only : EDPftvarcon_inst + use EDPftvarcon, only : EDPftvarcon_inst use PRTGenericMod, only : prt_vartypes use PRTGenericMod, only : leaf_organ use PRTGenericMod, only : fnrt_organ @@ -16,6 +16,7 @@ module PRTLossFluxesMod use PRTGenericMod, only : un_initialized use PRTGenericMod, only : check_initialized use PRTGenericMod, only : num_organ_types + use PRTGenericMod, only : prt_instance use FatesInterfaceMod, only : hlm_freq_day use FatesConstantsMod, only : r8 => fates_r8 @@ -84,7 +85,6 @@ subroutine PRTPhenologyFlush(prt, ipft, organ_id, c_store_transfer_frac) integer :: i_pos ! spatial position index integer :: i_store ! storage variable index integer :: spec_id ! global species identifier - integer :: num_sp_vars ! number of species for this organ real(r8) :: mass_transfer ! The actual mass ! removed from storage ! for each pool @@ -106,18 +106,18 @@ subroutine PRTPhenologyFlush(prt, ipft, organ_id, c_store_transfer_frac) end if - associate(organ_map => prt%prt_instance%organ_map) + associate(organ_map => prt_instance%organ_map) ! First transfer in carbon ! -------------------------------------------------------------------------------- - i_cvar = prt%prt_instance%sp_organ_map(organ_id,carbon12_species) + i_cvar = prt_instance%sp_organ_map(organ_id,carbon12_species) ! Get the variable id of the storage pool for this species (carbon12) - i_store = prt%prt_instance%sp_organ_map(store_organ,carbon12_species) + i_store = prt_instance%sp_organ_map(store_organ,carbon12_species) ! Loop over all of the coordinate ids - do i_pos = 1,prt%variables(i_cvar)%num_pos + do i_pos = 1,prt_instance%state_descriptor(i_cvar)%num_pos ! Calculate the mass transferred out of storage into the pool of interest mass_transfer = prt%variables(i_store)%val(i_pos) * c_store_transfer_frac @@ -154,12 +154,12 @@ subroutine PRTPhenologyFlush(prt, ipft, organ_id, c_store_transfer_frac) i_var = organ_map(organ_id)%var_id(i_sp_var) ! Variable index for the species of interest - spec_id = prt%prt_instance%state_descriptor(i_var)%spec_id + spec_id = prt_instance%state_descriptor(i_var)%spec_id if ( spec_id .ne. carbon12_species ) then ! Get the variable id of the storage pool for this species - i_store = prt%prt_instance%sp_organ_map(store_organ,spec_id) + i_store = prt_instance%sp_organ_map(store_organ,spec_id) ! Calculate the stoichiometry with C for this species @@ -177,7 +177,7 @@ subroutine PRTPhenologyFlush(prt, ipft, organ_id, c_store_transfer_frac) ! Loop over all of the coordinate ids - do i_pos = 1,prt%variables(i_var)%num_pos + do i_pos = 1,prt_instance%state_descriptor(i_var)%num_pos ! The target quanitity for this species is based on the amount ! of carbon @@ -240,7 +240,7 @@ subroutine PRTBurnLosses(prt, organ_id, mass_fraction) real(r8) :: burned_mass ! Burned mass of each species, in eahc ! position, in the organ of interest - associate(organ_map => prt%prt_instance%organ_map) + associate(organ_map => prt_instance%organ_map) ! This is the total number of state variables associated ! with this particular organ @@ -251,10 +251,10 @@ subroutine PRTBurnLosses(prt, organ_id, mass_fraction) i_var = organ_map(organ_id)%var_id(i_sp_var) - spec_id = prt%prt_instance%state_descriptor(i_var)%spec_id + spec_id = prt_instance%state_descriptor(i_var)%spec_id ! Loop over all of the coordinate ids - do i_pos = 1,prt%variables(i_var)%num_pos + do i_pos = 1,prt_instance%state_descriptor(i_var)%num_pos ! The mass that is leaving the plant burned_mass = mass_fraction * prt%variables(i_var)%val(i_pos) @@ -297,9 +297,9 @@ subroutine PRTReproRelease(prt, organ_id, spec_id, mass_fraction, mass_out) integer :: i_var ! index for the variable of interest - associate(organ_map => prt%prt_instance%organ_map, & - sp_organ_map => prt%prt_instance%sp_organ_map, & - state_descriptor => prt%prt_instance%state_descriptor) + associate(organ_map => prt_instance%organ_map, & + sp_organ_map => prt_instance%sp_organ_map, & + state_descriptor => prt_instance%state_descriptor) ! This is the total number of state variables associated ! with this particular organ. @@ -327,7 +327,7 @@ subroutine PRTReproRelease(prt, organ_id, spec_id, mass_fraction, mass_out) mass_out = 0.0_r8 ! Loop over all of the coordinate ids - do i_pos = 1,prt%variables(i_var)%num_pos + do i_pos = 1, prt_instance%state_descriptor(i_var)%num_pos ! The mass that is leaving the plant mass_out = mass_out + mass_fraction * prt%variables(i_var)%val(i_pos) @@ -421,7 +421,7 @@ subroutine DeciduousTurnoverSimpleRetranslocation(prt,ipft,organ_id,mass_fractio real(r8) :: retranslocated_mass - associate(organ_map => prt%prt_instance%organ_map) + associate(organ_map => prt_instance%organ_map) if( (organ_id == store_organ) .or. & (organ_id == struct_organ) .or. & @@ -446,7 +446,7 @@ subroutine DeciduousTurnoverSimpleRetranslocation(prt,ipft,organ_id,mass_fractio i_var = organ_map(organ_id)%var_id(i_sp_var) - spec_id = prt%prt_instance%state_descriptor(i_var)%spec_id + spec_id = prt_instance%state_descriptor(i_var)%spec_id if ( any(spec_id == carbon_species) ) then retrans = EDPftvarcon_inst%turnover_carb_retrans_p1(ipft,organ_id) @@ -463,12 +463,10 @@ subroutine DeciduousTurnoverSimpleRetranslocation(prt,ipft,organ_id,mass_fractio end if ! Get the variable id of the storage pool for this species - store_var_id = prt%prt_instance%sp_organ_map(store_organ,spec_id) - - - + store_var_id = prt_instance%sp_organ_map(store_organ,spec_id) + ! Loop over all of the coordinate ids - do i_pos = 1,prt%variables(i_var)%num_pos + do i_pos = 1, prt_instance%state_descriptor(i_var)%num_pos ! The mass that is leaving the plant turnover_mass = (1.0_r8 - retrans) * mass_fraction * prt%variables(i_var)%val(i_pos) @@ -553,12 +551,10 @@ subroutine MaintTurnoverSimpleRetranslocation(prt,ipft) class(prt_vartypes) :: prt integer,intent(in) :: ipft - integer :: i_var integer :: spec_id integer :: organ_id - integer :: num_sp_vars integer :: i_pos real(r8) :: turnover @@ -572,8 +568,6 @@ subroutine MaintTurnoverSimpleRetranslocation(prt,ipft) real(r8) :: retrans ! A temp for the actual re-translocated mass - num_sp_vars = size(prt%variables,1) - ! ----------------------------------------------------------------------------------- ! Calculate the turnover rates (maybe this should be done once in the parameter ! check routine. Perhaps generate a rate in parameters derived? @@ -606,10 +600,10 @@ subroutine MaintTurnoverSimpleRetranslocation(prt,ipft) base_turnover(repro_organ) = 0.0_r8 - do i_var = 1, num_sp_vars + do i_var = 1, prt_instance%num_vars - organ_id = prt%prt_instance%state_descriptor(i_var)%organ_id - spec_id = prt%prt_instance%state_descriptor(i_var)%spec_id + organ_id = prt_instance%state_descriptor(i_var)%organ_id + spec_id = prt_instance%state_descriptor(i_var)%spec_id if ( any(spec_id == carbon_species) ) then retrans = EDPftvarcon_inst%turnover_carb_retrans_p1(ipft,organ_id) @@ -643,7 +637,7 @@ subroutine MaintTurnoverSimpleRetranslocation(prt,ipft) call endrun(msg=errMsg(__FILE__, __LINE__)) end if - do i_pos = 1,prt%variables(i_var)%num_pos + do i_pos = 1, prt_instance%state_descriptor(i_var)%num_pos turnover = (1.0_r8 - retrans) * base_turnover(organ_id) * prt%variables(i_var)%val(i_pos) From e9b32b09f44f9baeb1d3c33bb20447e4078cd734 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Fri, 12 Oct 2018 13:44:50 -0700 Subject: [PATCH 29/52] Connected phenology flush fraction to the actual process --- biogeochem/EDPhysiologyMod.F90 | 35 +++++++++++++++++----------------- 1 file changed, 18 insertions(+), 17 deletions(-) diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 900d89963c..7bcecb848a 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -647,31 +647,29 @@ subroutine phenology_leafonoff(currentSite) real(r8) :: leaf_c ! leaf carbon [kg] real(r8) :: store_c ! storage carbon [kg] - real(r8) :: store_output ! the amount of the store to put into leaves - - ! is a barrier against negative storage and C starvation. real(r8) :: store_c_transfer_frac ! Fraction of storage carbon used to flush leaves - + integer :: ipft real(r8), parameter :: leaf_drop_fraction = 1.0_r8 !------------------------------------------------------------------------ currentPatch => CurrentSite%oldest_patch - store_output = 0.5_r8 - do while(associated(currentPatch)) currentCohort => currentPatch%tallest do while(associated(currentCohort)) + ipft = currentCohort%pft + ! Retrieve existing leaf and storage carbon - call currentCohort%prt%CheckMassConservation(currentCohort%pft,0) + call currentCohort%prt%CheckMassConservation(ipft,0) store_c = currentCohort%prt%GetState(store_organ, carbon12_species) leaf_c = currentCohort%prt%GetState(leaf_organ, carbon12_species) !COLD LEAF ON - if (EDPftvarcon_inst%season_decid(currentCohort%pft) == 1)then + if (EDPftvarcon_inst%season_decid(ipft) == 1)then if (currentSite%status == 2)then !we have just moved to leaves being on . if (currentCohort%status_coh == 1)then !Are the leaves currently off? currentCohort%status_coh = 2 ! Leaves are on, so change status to @@ -679,13 +677,14 @@ subroutine phenology_leafonoff(currentSite) if(store_c>nearzero) then store_c_transfer_frac = & - min(currentCohort%laimemory, store_c*store_output)/store_c + min(EDPftvarcon_inst%phenflush_fraction(ipft)*currentCohort%laimemory, store_c)/store_c else store_c_transfer_frac = 0.0_r8 end if - - call PRTPhenologyFlush(currentCohort%prt, currentCohort%pft, & - leaf_organ, store_c_transfer_frac) + + ! 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) currentCohort%laimemory = 0.0_r8 @@ -708,7 +707,7 @@ subroutine phenology_leafonoff(currentSite) ! for carbon and any other species that are prognostic. It will ! also track the turnover masses that will be sent to litter later on) - call PRTDeciduousTurnover(currentCohort%prt,currentCohort%pft, & + call PRTDeciduousTurnover(currentCohort%prt,ipft, & leaf_organ, leaf_drop_fraction) endif !leaf status @@ -716,7 +715,7 @@ subroutine phenology_leafonoff(currentSite) endif !season_decid !DROUGHT LEAF ON - if (EDPftvarcon_inst%stress_decid(currentCohort%pft) == 1)then + if (EDPftvarcon_inst%stress_decid(ipft) == 1)then if (currentSite%dstatus == 2)then @@ -730,12 +729,14 @@ subroutine phenology_leafonoff(currentSite) if(store_c>nearzero) then store_c_transfer_frac = & - min(currentCohort%laimemory, store_c*store_output)/store_c + min(EDPftvarcon_inst%phenflush_fraction(ipft)*currentCohort%laimemory, store_c)/store_c else store_c_transfer_frac = 0.0_r8 end if - call PRTPhenologyFlush(currentCohort%prt, currentCohort%pft, & + ! 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) currentCohort%laimemory = 0.0_r8 @@ -753,14 +754,14 @@ subroutine phenology_leafonoff(currentSite) ! Remember what the lai (leaf mass actually) was for next year currentCohort%laimemory = leaf_c - call PRTDeciduousTurnover(currentCohort%prt,currentCohort%pft, & + call PRTDeciduousTurnover(currentCohort%prt,ipft, & leaf_organ, leaf_drop_fraction) endif endif !status endif !drought dec. - call currentCohort%prt%CheckMassConservation(currentCohort%pft,1) + call currentCohort%prt%CheckMassConservation(ipft,1) currentCohort => currentCohort%shorter enddo !currentCohort From fe69005cf8e2e8faf48a0149728bbb54dfad8883 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Mon, 15 Oct 2018 15:22:25 -0700 Subject: [PATCH 30/52] Updated unit testing scripts to reflect updates in core parteh code. --- .../f_wrapper_modules/FatesCohortWrapMod.F90 | 33 ++++- .../parteh/parteh_controls_phenevents.xml | 124 ------------------ .../parteh/parteh_controls_smoketests.xml | 10 +- parteh/PRTAllometricCarbonMod.F90 | 17 +-- 4 files changed, 36 insertions(+), 148 deletions(-) delete mode 100644 functional_unit_testing/parteh/parteh_controls_phenevents.xml diff --git a/functional_unit_testing/parteh/f_wrapper_modules/FatesCohortWrapMod.F90 b/functional_unit_testing/parteh/f_wrapper_modules/FatesCohortWrapMod.F90 index 96fe55397c..fb72756f6b 100644 --- a/functional_unit_testing/parteh/f_wrapper_modules/FatesCohortWrapMod.F90 +++ b/functional_unit_testing/parteh/f_wrapper_modules/FatesCohortWrapMod.F90 @@ -37,17 +37,20 @@ module FatesCohortWrapMod use PRTGenericMod, only : struct_organ use PRTGenericMod, only : carbon12_species use PRTGenericMod, only : SetState + use PRTGenericMod, only : prt_instance use PRTAllometricCarbonMod, only : callom_prt_vartypes use PRTAllometricCarbonMod, only : ac_bc_inout_id_netdc use PRTAllometricCarbonMod, only : ac_bc_in_id_pft use PRTAllometricCarbonMod, only : ac_bc_in_id_ctrim use PRTAllometricCarbonMod, only : ac_bc_inout_id_dbh + use PRTAllometricCarbonMod, only : prt_instance_ac use PRTLossFluxesMod, only : PRTMaintTurnover use PRTLossFluxesMod, only : PRTDeciduousTurnover use PRTLossFluxesMod, only : PRTPhenologyFlush + use PRTAllometricCNPMod, only : prt_instance_acnp use PRTAllometricCNPMod, only : cnp_allom_prt_vartypes use PRTAllometricCNPMod, only : acnp_bc_inout_id_dbh use PRTAllometricCNPMod, only : acnp_bc_inout_id_netdc @@ -200,7 +203,6 @@ subroutine CohortPySet(ipft,hgt_min,canopy_trim) call h2d_allom(hgt_min,ipft,ccohort%dbh) ccohort%canopy_trim = canopy_trim - ! Use allometry to compute initial values ! Leaf biomass (carbon) @@ -229,12 +231,12 @@ subroutine CohortPySet(ipft,hgt_min,canopy_trim) select case(ccohort%parteh_model) case (1) - + prt_instance => prt_instance_ac allocate(callom_prt) ccohort%prt => callom_prt case(2) - + prt_instance => prt_instance_acnp allocate(cnpallom_prt) ccohort%prt => cnpallom_prt @@ -365,7 +367,7 @@ subroutine WrapDailyPRT(ipft,daily_carbon_gain,canopy_trim,flush_c,drop_frac_c,l select case(int(ccohort%parteh_model)) case (1) - + prt_instance => prt_instance_ac ccohort%daily_carbon_gain = daily_carbon_gain call ccohort%prt%DailyPRT() @@ -374,7 +376,7 @@ subroutine WrapDailyPRT(ipft,daily_carbon_gain,canopy_trim,flush_c,drop_frac_c,l ccohort%carbon_root_exudate = 0.0_r8 case (2) - + prt_instance => prt_instance_acnp ccohort%daily_carbon_gain = daily_carbon_gain ccohort%daily_nitrogen_gain = daily_nitrogen_gain ccohort%daily_phosphorous_gain = daily_phosphorous_gain @@ -391,7 +393,7 @@ subroutine WrapDailyPRT(ipft,daily_carbon_gain,canopy_trim,flush_c,drop_frac_c,l end select - call ccohort%prt%CheckMassConservation(ipft) + call ccohort%prt%CheckMassConservation(ipft,1) @@ -421,7 +423,16 @@ subroutine WrapQueryVars(ipft,leaf_area,crown_area,agb,store_c,target_leaf_c) integer, parameter :: cl1 = 1 ccohort => cohort_array(ipft) + + + select case(int(ccohort%parteh_model)) + case (1) + prt_instance => prt_instance_ac + case (2) + prt_instance => prt_instance_acnp + end select + leaf_c = ccohort%prt%GetState(leaf_organ, all_carbon_species ) store_c = ccohort%prt%GetState(store_organ, all_carbon_species ) @@ -501,7 +512,15 @@ subroutine WrapQueryDiagnostics(ipft, dbh, & real(r8),parameter :: nplant = 1.0_r8 real(r8),parameter :: site_spread = 1.0_r8 - ccohort => cohort_array(ipft) + ccohort => cohort_array(ipft) + + select case(int(ccohort%parteh_model)) + case (1) + prt_instance => prt_instance_ac + case (2) + prt_instance => prt_instance_acnp + end select + dbh = ccohort%dbh leaf_c = ccohort%prt%GetState(organ_id=leaf_organ, species_id=all_carbon_species) diff --git a/functional_unit_testing/parteh/parteh_controls_phenevents.xml b/functional_unit_testing/parteh/parteh_controls_phenevents.xml deleted file mode 100644 index 3352b22ae5..0000000000 --- a/functional_unit_testing/parteh/parteh_controls_phenevents.xml +++ /dev/null @@ -1,124 +0,0 @@ - - - - - - - - - - - 0 - - - - - - - - - 86400 - 1500-01-01 - 1510-01-01 - 0.001 - - - - - - - - - AllometricCNP - - - DailyCNPFromStorageSinWaveNoMaint - - - - - - - Carbon Only, constant NPP - Carbon Only, 120% sin NPP - - - - leaf - fine root - sapwood - storage - reproductive - structural - - - - 1 , 1 - 1 , 0 - 0 , 1 - 0 , 0 - 0.2 , 0.2 - 0.2 , 0.2 - 30.0 , 30.0 - 1.0 , 1.0 - 1.5 , 1.5 - 50.0 , 50.0 - 5 , 5 - 3 , 3 - 1 , 1 - 1 , 1 - 1 , 1 - 1 , 1 - 1 , 1 - 57.6 , 57.6 - 0.74 , 0.74 - 21.6 , 21.6 - 0.0673 , 0.0673 - 0.976 , 0.976 - -999.9 , -999.9 - -999.9 , -999.9 - 0.07 , 0.07 - 1.3 , 1.3 - 0.55 , 0.55 - 2.0 , 2.0 - 0.7 , 0.7 - 2.0 , 2.0 - 1.00 , 1.00 - 0.0 , 0.0 - 0.012 , 0.012 - 0.012 , 0.012 - 1.0 , 1.0 - 0.65 , 0.65 - 0.1 , 0.1 - 0.0 , 0.0 - 0.33 , 0.33 - 0.65 , 0.65 - 300.0 , 300.0 - 1.5 , 1.5 - 1.5 , 1.5 - 0.5 , 0.0 - 50.0 , 50.0 - - 1,1 - - 0.025, 0.025, 0.025, 0.025, 0.025, 0.025, 0.025, 0.025, 0.025, 0.025, 0.025, 0.025 - -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9 - -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9 - -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9 - -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9 - -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9 - -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9 - - - - - 0.4, 0.4 - -9.9, -9.9 - -9.9, -9.9 - 1.2, 1.2 - - - - - - diff --git a/functional_unit_testing/parteh/parteh_controls_smoketests.xml b/functional_unit_testing/parteh/parteh_controls_smoketests.xml index 9cf876fb6c..c92a4acd96 100644 --- a/functional_unit_testing/parteh/parteh_controls_smoketests.xml +++ b/functional_unit_testing/parteh/parteh_controls_smoketests.xml @@ -58,6 +58,8 @@ 1 , 2 , 2 , 2 , 2 1 , 1 , 1 , 1 , 1 + 0 , 0 , 0 , 0 , 0 + 0 , 0 , 0 , 0 , 0 0.2 , 0.2 , 0.2 , 0.2 , 0.2 0.2 , 0.2, 0.2, 0.2, 0.2 30.0 , 30.0 , 30.0, 30.0 , 30.0 @@ -110,13 +112,13 @@ 0,0,0,0,0,0, 0,0,0,0,0,0, 0.25,0.15,0,0,0,0, - 0.25,0,0,0,0, - 0.25,0,0,0,0 + 0.25,0,0,0,0,0, + 0.25,0,0,0,0,0 0,0,0,0,0,0, 0,0,0,0,0,0, 0.25,0.15,0,0,0,0, - 0.25,0,0,0,0, - 0.25,0,0,0,0 + 0.25,0,0,0,0,0, + 0.25,0,0,0,0,0 -9,-9,-9,-9,-9,-9, 0.05,0.05,0.05,0.05,0.05,0.05, diff --git a/parteh/PRTAllometricCarbonMod.F90 b/parteh/PRTAllometricCarbonMod.F90 index 58edee7dd4..c577b7c51f 100644 --- a/parteh/PRTAllometricCarbonMod.F90 +++ b/parteh/PRTAllometricCarbonMod.F90 @@ -65,7 +65,7 @@ module PRTAllometricCarbonMod integer, parameter :: store_c_id = 4 ! Unique object index for storage carbon integer, parameter :: repro_c_id = 5 ! Unique object index for reproductive carbon integer, parameter :: struct_c_id = 6 ! Unique object index for structural carbon - integer, parameter :: ac_num_vars = 6 ! THIS MUST MATCH THE LARGEST INDEX ABOVE + integer, parameter :: num_vars = 6 ! THIS MUST MATCH THE LARGEST INDEX ABOVE ! For this hypothesis, we integrate dbh along with the other 6. Since this @@ -108,18 +108,9 @@ module PRTAllometricCarbonMod ! plant reactive transport (PRT) module ! ------------------------------------------------------------------------------------- - type callom_prt_vartype - - real(r8) :: allom_deficit ! Deficit of plant WRT allometric target - - end type callom_prt_vartype - - type, public, extends(prt_vartypes) :: callom_prt_vartypes - type(callom_prt_vartype),allocatable :: aux_variables(:) - contains procedure :: DailyPRT => DailyPRTAC @@ -139,7 +130,7 @@ module PRTAllometricCarbonMod ! This is the instance of the mapping table and variable definitions ! this is only allocated once per node - class(prt_instance_type), target, allocatable :: prt_instance_ac + class(prt_instance_type), public, target, allocatable :: prt_instance_ac public :: InitPRTInstanceAC @@ -161,7 +152,7 @@ subroutine InitPRTInstanceAC() ! ----------------------------------------------------------------------------------- allocate(prt_instance_ac) - allocate(prt_instance_ac%state_descriptor(ac_num_vars)) + allocate(prt_instance_ac%state_descriptor(num_vars)) prt_instance_ac%hyp_name = 'Allometric Carbon Only' @@ -182,7 +173,7 @@ subroutine InitPRTInstanceAC() prt_instance_ac%num_bc_in = num_bc_in prt_instance_ac%num_bc_out = num_bc_out prt_instance_ac%num_bc_inout = num_bc_inout - prt_instance_ac%num_vars = ac_num_vars + prt_instance_ac%num_vars = num_vars ! Have the global generic pointer, point to this hypothesis' object prt_instance => prt_instance_ac From d39786621d0e2d1dafdc0dd74dc38d0a486220a9 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Wed, 17 Oct 2018 15:36:05 -0700 Subject: [PATCH 31/52] parteh syntax changes, renamed hlm_parteh_mode, added the named cases for hlm_parteh_mode, cleaned up some loop counters during restarts. Updated comments in the allometric carbon only hypothesis. --- biogeochem/EDCohortDynamicsMod.F90 | 9 +- biogeochem/EDMortalityFunctionsMod.F90 | 6 +- biogeochem/EDPatchDynamicsMod.F90 | 1 - biogeophys/FatesPlantRespPhotosynthMod.F90 | 35 ++-- main/EDPftvarcon.F90 | 38 ++-- main/FatesInterfaceMod.F90 | 27 +-- main/FatesRestartInterfaceMod.F90 | 78 +++++--- parteh/PRTAllometricCarbonMod.F90 | 212 +++++++++++++-------- 8 files changed, 253 insertions(+), 153 deletions(-) diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index a01fd810d2..c6e45a2028 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -22,7 +22,7 @@ module EDCohortDynamicsMod use EDTypesMod , only : min_n_safemath use EDTypesMod , only : nlevleaf use FatesInterfaceMod , only : hlm_use_planthydro - use FatesInterfaceMod , only : hlm_parteh_model + use FatesInterfaceMod , only : hlm_parteh_mode use FatesPlantHydraulicsMod, only : FuseCohortHydraulics use FatesPlantHydraulicsMod, only : CopyCohortHydraulics use FatesPlantHydraulicsMod, only : updateSizeDepTreeHydProps @@ -52,7 +52,6 @@ module EDCohortDynamicsMod use PRTGenericMod, only : store_organ use PRTGenericMod, only : repro_organ use PRTGenericMod, only : struct_organ - use PRTGenericMod, only : carbon12_species use PRTGenericMod, only : SetState use PRTAllometricCarbonMod, only : callom_prt_vartypes @@ -166,7 +165,7 @@ subroutine create_cohort(currentSite, patchptr, pft, nn, hite, dbh, bleaf, bfine ! cohorts can be copied and fused, but special routines handle that. ! ----------------------------------------------------------------------------------- - select case(hlm_parteh_model) + select case(hlm_parteh_mode) case (prt_carbon_allom_hyp) call SetState(new_cohort%prt,leaf_organ, carbon12_species, bleaf) @@ -285,7 +284,7 @@ subroutine InitPRTCohort(new_cohort) ! Each hypothesis has a different object which is an extension ! of the base class. - select case(hlm_parteh_model) + select case(hlm_parteh_mode) case (prt_carbon_allom_hyp) allocate(callom_prt) @@ -320,7 +319,7 @@ subroutine InitPRTCohort(new_cohort) ! value boundary condition. - select case(hlm_parteh_model) + select case(hlm_parteh_mode) case (prt_carbon_allom_hyp) ! Register boundary conditions for the Carbon Only Allometric Hypothesis diff --git a/biogeochem/EDMortalityFunctionsMod.F90 b/biogeochem/EDMortalityFunctionsMod.F90 index 245437ab27..1daedf65c8 100644 --- a/biogeochem/EDMortalityFunctionsMod.F90 +++ b/biogeochem/EDMortalityFunctionsMod.F90 @@ -20,7 +20,7 @@ module EDMortalityFunctionsMod use EDParamsMod , only : fates_mortality_disturbance_fraction use FatesInterfaceMod , only : bc_in_type - use PRTGenericMod, only : carbon12_species + use PRTGenericMod, only : all_carbon_species use PRTGenericMod, only : store_organ implicit none @@ -86,9 +86,9 @@ subroutine mortality_rates( cohort_in,bc_in,cmort,hmort,bmort,frmort ) ! Carbon Starvation induced mortality. if ( cohort_in%dbh > 0._r8 ) then - call bleaf(cohort_in%dbh,cohort_in%pft,cohort_in%canopy_trim,leaf_c_target) - store_c = cohort_in%prt%GetState(store_organ,carbon12_species) + call bleaf(cohort_in%dbh,cohort_in%pft,cohort_in%canopy_trim,leaf_c_target) + store_c = cohort_in%prt%GetState(store_organ,all_carbon_species) call storage_fraction_of_target(leaf_c_target, store_c, frac) if( frac .lt. 1._r8) then diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index eb0575014b..1c31b1437f 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -41,7 +41,6 @@ module EDPatchDynamicsMod use EDCohortDynamicsMod , only : InitPRTCohort use PRTGenericMod, only : all_carbon_species - use PRTGenericMod, only : carbon12_species use PRTGenericMod, only : nitrogen_species use PRTGenericMod, only : phosphorous_species use PRTGenericMod, only : leaf_organ diff --git a/biogeophys/FatesPlantRespPhotosynthMod.F90 b/biogeophys/FatesPlantRespPhotosynthMod.F90 index f4e711c648..21297b7509 100644 --- a/biogeophys/FatesPlantRespPhotosynthMod.F90 +++ b/biogeophys/FatesPlantRespPhotosynthMod.F90 @@ -25,14 +25,15 @@ module FATESPlantRespPhotosynthMod use FatesConstantsMod, only : r8 => fates_r8 use FatesConstantsMod, only : itrue use FatesInterfaceMod, only : hlm_use_planthydro - use FatesInterfaceMod, only : hlm_parteh_model + use FatesInterfaceMod, only : hlm_parteh_mode use FatesInterfaceMod, only : numpft use EDTypesMod, only : maxpft use EDTypesMod, only : nlevleaf use EDTypesMod, only : nclmax use PRTGenericMod, only : prt_carbon_allom_hyp - use PRTGenericMod, only : carbon12_species + use PRTGenericMod, only : prt_cnp_flex_allom_hyp + use PRTGenericMod, only : all_carbon_species use PRTGenericMod, only : nitrogen_species use PRTGenericMod, only : phosphorous_species use PRTGenericMod, only : leaf_organ @@ -41,8 +42,6 @@ module FATESPlantRespPhotosynthMod use PRTGenericMod, only : store_organ use PRTGenericMod, only : repro_organ use PRTGenericMod, only : struct_organ - use PRTGenericMod, only : carbon12_species - use PRTGenericMod, only : SetState ! CIME Globals use shr_log_mod , only : errMsg => shr_log_errMsg @@ -391,7 +390,7 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) if ( .not.rate_mask_z(iv,ft,cl) .or. & (hlm_use_planthydro.eq.itrue) .or. & - (hlm_parteh_model .ne. prt_carbon_allom_hyp ) ) then + (hlm_parteh_mode .ne. prt_carbon_allom_hyp ) ) then if (hlm_use_planthydro.eq.itrue) then @@ -438,12 +437,12 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) ! Then scale this value at the top of the canopy for canopy depth ! Leaf nitrogen concentration at the top of the canopy (g N leaf / m**2 leaf) - select case(hlm_parteh_model) - case (1) + select case(hlm_parteh_mode) + case (prt_carbon_allom_hyp) lnc_top = EDPftvarcon_inst%prt_nitr_stoich_p1(ft,leaf_organ)/slatop(ft) - case (2) + case (prt_cnp_flex_allom_hyp) leaf_c = currentCohort%prt%GetState(leaf_organ, carbon12_species) leaf_n = currentCohort%prt%GetState(leaf_organ, nitrogen_species) @@ -581,11 +580,11 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) ! Units are in (kgN/plant) ! ------------------------------------------------------------------ - select case(hlm_parteh_model) - case (1) - - sapw_c = currentCohort%prt%GetState(sapw_organ, carbon12_species) - fnrt_c = currentCohort%prt%GetState(fnrt_organ, carbon12_species) + sapw_c = currentCohort%prt%GetState(sapw_organ, all_carbon_species) + fnrt_c = currentCohort%prt%GetState(fnrt_organ, all_carbon_species) + + select case(hlm_parteh_mode) + case (prt_carbon_allom_hyp) live_stem_n = EDPftvarcon_inst%allom_agb_frac(currentCohort%pft) * & sapw_c * EDPftvarcon_inst%prt_nitr_stoich_p1(ft,sapw_organ) @@ -594,7 +593,17 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) sapw_c * EDPftvarcon_inst%prt_nitr_stoich_p1(ft,sapw_organ) fnrt_n = fnrt_c * EDPftvarcon_inst%prt_nitr_stoich_p1(ft,fnrt_organ) + + case(prt_cnp_flex_allom_hyp) + live_stem_n = EDPftvarcon_inst%allom_agb_frac(currentCohort%pft) * & + currentCohort%prt%GetState(sapw_organ, nitrogen_species) + + live_croot_n = (1.0_r8-EDPftvarcon_inst%allom_agb_frac(currentCohort%pft)) * & + currentCohort%prt%GetState(sapw_organ, nitrogen_species) + + fnrt_n = currentCohort%prt%GetState(fnrt_organ, nitrogen_species) + case default diff --git a/main/EDPftvarcon.F90 b/main/EDPftvarcon.F90 index d71046adfa..513ae66ebb 100644 --- a/main/EDPftvarcon.F90 +++ b/main/EDPftvarcon.F90 @@ -76,7 +76,7 @@ module EDPftvarcon real(r8), allocatable :: smpso(:) real(r8), allocatable :: smpsc(:) real(r8), allocatable :: grperc(:) ! Growth respiration per unit Carbon gained - ! ONLY parteh_model == 1 [kg/kg] + ! ONLY parteh_mode == 1 [kg/kg] real(r8), allocatable :: maintresp_reduction_curvature(:) ! curvature of MR reduction as f(carbon storage), ! 1=linear, 0=very curved real(r8), allocatable :: maintresp_reduction_intercept(:) ! intercept of MR reduction as f(carbon storage), @@ -1748,7 +1748,7 @@ end subroutine FatesReportPFTParams ! ===================================================================================== - subroutine FatesCheckParams(is_master, parteh_model) + subroutine FatesCheckParams(is_master, parteh_mode) ! ---------------------------------------------------------------------------------- ! @@ -1762,8 +1762,8 @@ subroutine FatesCheckParams(is_master, parteh_model) ! Argument - logical, intent(in) :: is_master ! Only log if this is the master proc - integer, intent(in) :: parteh_model ! argument for nl flag hlm_parteh_model + logical, intent(in) :: is_master ! Only log if this is the master proc + integer, intent(in) :: parteh_mode ! argument for nl flag hlm_parteh_mode character(len=32),parameter :: fmt0 = '(a,100(F12.4,1X))' @@ -1775,18 +1775,18 @@ subroutine FatesCheckParams(is_master, parteh_model) if(.not.is_master) return - if (parteh_model .eq. prt_cnp_flex_allom_hyp) then + if (parteh_mode .eq. prt_cnp_flex_allom_hyp) then write(fates_log(),*) 'FATES Plant Allocation and Reactive Transport' write(fates_log(),*) 'with flexible target stoichiometry for NP and' write(fates_log(),*) 'allometrically constrianed C is still under development' write(fates_log(),*) 'Aborting' call endrun(msg=errMsg(sourcefile, __LINE__)) - elseif (parteh_model .ne. prt_carbon_allom_hyp) then + elseif (parteh_mode .ne. prt_carbon_allom_hyp) then write(fates_log(),*) 'FATES Plant Allocation and Reactive Transport has' write(fates_log(),*) 'only 1 module supported, allometric carbon only.' - write(fates_log(),*) 'fates_parteh_model must be set to 1 in the namelist' + write(fates_log(),*) 'fates_parteh_mode must be set to 1 in the namelist' write(fates_log(),*) 'Aborting' call endrun(msg=errMsg(sourcefile, __LINE__)) end if @@ -1943,7 +1943,7 @@ subroutine FatesCheckParams(is_master, parteh_model) write(fates_log(),*) ' Aborting' call endrun(msg=errMsg(sourcefile, __LINE__)) end if - if (parteh_model .eq. 2) then + if (parteh_mode .eq. 2) then if ((EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,repro_organ) > nearzero) .or. & (EDPftvarcon_inst%turnover_phos_retrans_p1(ipft,repro_organ) > nearzero) ) then write(fates_log(),*) ' Retranslocation of reproductive tissues should be zero.' @@ -1963,7 +1963,7 @@ subroutine FatesCheckParams(is_master, parteh_model) write(fates_log(),*) ' Aborting' call endrun(msg=errMsg(sourcefile, __LINE__)) end if - if (parteh_model .eq. 2) then + if (parteh_mode .eq. 2) then if ((EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,sapw_organ) > nearzero) .or. & (EDPftvarcon_inst%turnover_phos_retrans_p1(ipft,sapw_organ) > nearzero) ) then write(fates_log(),*) ' Retranslocation of sapwood tissues should be zero.' @@ -1983,7 +1983,7 @@ subroutine FatesCheckParams(is_master, parteh_model) write(fates_log(),*) ' Aborting' call endrun(msg=errMsg(sourcefile, __LINE__)) end if - if (parteh_model .eq. 2) then + if (parteh_mode .eq. 2) then if ((EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,struct_organ) > nearzero) .or. & (EDPftvarcon_inst%turnover_phos_retrans_p1(ipft,struct_organ) > nearzero) ) then write(fates_log(),*) ' Retranslocation of structural(dead) tissues should be zero.' @@ -2004,7 +2004,7 @@ subroutine FatesCheckParams(is_master, parteh_model) write(fates_log(),*) ' Aborting' call endrun(msg=errMsg(sourcefile, __LINE__)) end if - if (parteh_model .eq. 2) then + if (parteh_mode .eq. 2) then if ((EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,leaf_organ) > 1.0_r8) .or. & (EDPftvarcon_inst%turnover_phos_retrans_p1(ipft,leaf_organ) > 1.0_r8) .or. & (EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,leaf_organ) < 0.0_r8) .or. & @@ -2027,7 +2027,7 @@ subroutine FatesCheckParams(is_master, parteh_model) write(fates_log(),*) ' Aborting' call endrun(msg=errMsg(sourcefile, __LINE__)) end if - if (parteh_model .eq. 2) then + if (parteh_mode .eq. 2) then if ((EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,fnrt_organ) > 1.0_r8) .or. & (EDPftvarcon_inst%turnover_phos_retrans_p1(ipft,fnrt_organ) > 1.0_r8) .or. & (EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,fnrt_organ) < 0.0_r8) .or. & @@ -2050,7 +2050,7 @@ subroutine FatesCheckParams(is_master, parteh_model) write(fates_log(),*) ' Aborting' call endrun(msg=errMsg(sourcefile, __LINE__)) end if - if (parteh_model .eq. 2) then + if (parteh_mode .eq. 2) then if ((EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,store_organ) > 1.0_r8) .or. & (EDPftvarcon_inst%turnover_phos_retrans_p1(ipft,store_organ) > 1.0_r8) .or. & (EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,store_organ) < 0.0_r8) .or. & @@ -2065,7 +2065,7 @@ subroutine FatesCheckParams(is_master, parteh_model) end if ! Growth respiration - if (parteh_model .eq. 1) then + if (parteh_mode .eq. 1) then if ( ( EDPftvarcon_inst%grperc(ipft) < 0.0_r8) .or. & ( EDPftvarcon_inst%grperc(ipft) > 1.0_r8 ) ) then write(fates_log(),*) ' PFT#: ',ipft @@ -2073,7 +2073,7 @@ subroutine FatesCheckParams(is_master, parteh_model) write(fates_log(),*) ' Aborting' call endrun(msg=errMsg(sourcefile, __LINE__)) end if - elseif(parteh_model .eq. 2) then + elseif(parteh_mode .eq. 2) then if ( ( any(EDPftvarcon_inst%prt_unit_gr_resp(ipft,:) < 0.0_r8)) .or. & ( any(EDPftvarcon_inst%prt_unit_gr_resp(ipft,:) >= 1.0_r8)) ) then write(fates_log(),*) ' PFT#: ',ipft @@ -2087,7 +2087,7 @@ subroutine FatesCheckParams(is_master, parteh_model) ! Firstly, the seed production and germination models cannot handle nutrients. So ! we assume (for now) that seeds do not have nutrients (parteh_mode = 1 is c only) - if(parteh_model .eq. 2) then + if(parteh_mode .eq. 2) then if ( (EDPftvarcon_inst%prt_nitr_stoich_p1(ipft,repro_organ) > nearzero) .or. & (EDPftvarcon_inst%prt_nitr_stoich_p1(ipft,repro_organ) < -nearzero) .or. & (EDPftvarcon_inst%prt_phos_stoich_p1(ipft,repro_organ) > nearzero) .or. & @@ -2117,7 +2117,7 @@ subroutine FatesCheckParams(is_master, parteh_model) write(fates_log(),*) ' Aborting' call endrun(msg=errMsg(sourcefile, __LINE__)) end if - if(parteh_model .eq. 2) then + if(parteh_mode .eq. 2) then if( (any(EDPftvarcon_inst%prt_nitr_stoich_p2(ipft,:) < 0.0_r8)) .or. & (any(EDPftvarcon_inst%prt_nitr_stoich_p2(ipft,:) >= 1.0_r8)) ) then write(fates_log(),*) ' PFT#: ',ipft @@ -2129,7 +2129,7 @@ subroutine FatesCheckParams(is_master, parteh_model) end if ! Stoichiometric Ratios - if (parteh_model .eq. 2) then + if (parteh_mode .eq. 2) then if ( (any(EDPftvarcon_inst%prt_phos_stoich_p1(ipft,:) < 0.0_r8)) .or. & (any(EDPftvarcon_inst%prt_phos_stoich_p1(ipft,:) >= 1.0_r8)) .or. & (any(EDPftvarcon_inst%prt_phos_stoich_p2(ipft,:) < 0.0_r8)) .or. & @@ -2143,7 +2143,7 @@ subroutine FatesCheckParams(is_master, parteh_model) end if end if - if (parteh_model .eq. 2) then + if (parteh_mode .eq. 2) then if ( any(EDPftvarcon_inst%prt_alloc_priority(ipft,:) < 0) .or. & any(EDPftvarcon_inst%prt_alloc_priority(ipft,:) > 6) ) then write(fates_log(),*) ' PFT#: ',ipft diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 3b249f94e1..72a0d5ab13 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -107,7 +107,7 @@ module FatesInterfaceMod ! compare it to our maxpatchpersite, ! and gracefully halt if we are over-allocating - integer, protected :: hlm_parteh_model ! This flag signals which Plant Allocation and Reactive + integer, protected :: hlm_parteh_mode ! This flag signals which Plant Allocation and Reactive ! Transport (exensible) Hypothesis (PARTEH) to use @@ -1218,7 +1218,7 @@ subroutine set_fates_ctrlparms(tag,ival,rval,cval) hlm_ipedof = unset_int hlm_max_patch_per_site = unset_int hlm_use_vertsoilc = unset_int - hlm_parteh_model = unset_int + hlm_parteh_mode = unset_int hlm_use_spitfire = unset_int hlm_use_planthydro = unset_int hlm_use_logging = unset_int @@ -1380,9 +1380,9 @@ subroutine set_fates_ctrlparms(tag,ival,rval,cval) call endrun(msg=errMsg(sourcefile, __LINE__)) end if - if(hlm_parteh_model .eq. unset_int) then + if(hlm_parteh_mode .eq. unset_int) then if (fates_global_verbose()) then - write(fates_log(), *) 'switch deciding which plant reactive transport model to use' + write(fates_log(), *) 'switch deciding which plant reactive transport model to use is unset, hlm_parteh_mode, exiting' end if call endrun(msg=errMsg(sourcefile, __LINE__)) end if @@ -1466,9 +1466,9 @@ subroutine set_fates_ctrlparms(tag,ival,rval,cval) end if case('parteh_mode') - hlm_parteh_model = ival + hlm_parteh_mode = ival if (fates_global_verbose()) then - write(fates_log(),*) 'Transfering hlm_parteh_model= ',ival,' to FATES' + write(fates_log(),*) 'Transfering hlm_parteh_mode= ',ival,' to FATES' end if case('use_spitfire') @@ -1572,7 +1572,7 @@ subroutine FatesReportParameters(masterproc) call FatesReportPFTParams(masterproc) call FatesReportParams(masterproc) - call FatesCheckParams(masterproc,hlm_parteh_model) + call FatesCheckParams(masterproc,hlm_parteh_mode) return end subroutine FatesReportParameters @@ -1584,19 +1584,24 @@ subroutine InitPARTEHGlobals() ! Initialize the Plant Allocation and Reactive Transport ! global functions and mapping tables - select case(hlm_parteh_model) - case (1) + select case(hlm_parteh_mode) + case(prt_carbon_allom_hyp) + call InitPRTInstanceAC() - case(2) + + case(prt_cnp_flex_allom_hyp) !call InitPRTInstanceACNP() write(fates_log(),*) 'You specified the allometric CNP mode' write(fates_log(),*) 'with relaxed target stoichiometry.' - write(fates_log(),*) 'This mode is not available yet.' + write(fates_log(),*) 'I.e., namelist parametre fates_parteh_mode = 2' + write(fates_log(),*) 'This mode is not available yet. Please set it to 1.' call endrun(msg=errMsg(sourcefile, __LINE__)) case DEFAULT write(fates_log(),*) 'You specified an unknown PRT module' + write(fates_log(),*) 'Check your setting for fates_parteh_mode' + write(fates_log(),*) 'in the CLM namelist. The only valid value now is 1' write(fates_log(),*) 'Aborting' call endrun(msg=errMsg(sourcefile, __LINE__)) diff --git a/main/FatesRestartInterfaceMod.F90 b/main/FatesRestartInterfaceMod.F90 index 3f0f650a5b..82de4d9a44 100644 --- a/main/FatesRestartInterfaceMod.F90 +++ b/main/FatesRestartInterfaceMod.F90 @@ -23,8 +23,6 @@ module FatesRestartInterfaceMod use PRTGenericMod, only : store_organ use PRTGenericMod, only : repro_organ use PRTGenericMod, only : struct_organ - use PRTGenericMod, only : carbon12_species - use PRTGenericMod, only : SetState use PRTGenericMod, only : prt_instance @@ -855,6 +853,29 @@ end subroutine define_restart_vars subroutine DefinePRTRestartVars(this,initialize_variables,ivar) + ! ---------------------------------------------------------------------------------- + ! PARTEH variables are objects. These objects + ! each are registered to have things like names units and symbols + ! as part of that object. Thus, when defining, reading and writing restarts, + ! instead of manually typing out each variable we want, we just loop through + ! our list of ojbects. + ! + ! We do have to loop through the different parts of the objects indepenently. + ! For instance we can't have one loop that covers the states "val", and + ! the net allocation and reactive transport flux "net_art", so we have to loop + ! these each separately. As other fluxes are added in the future, they need + ! their own definition. + ! + ! Some of the code below is about parsing the strings of these objects + ! and automatically building the names of the PARTEH output variables + ! as we go. + ! + ! Note that parteh variables may or may not be scalars. Each variable's + ! position gets its own variable in the restart file. So the variable + ! name will also parse the string for that position. + ! ----------------------------------------------------------------------------------- + + use FatesIOVariableKindMod, only : cohort_r8 class(fates_restart_interface_type) :: this @@ -1057,7 +1078,7 @@ subroutine set_restart_vectors(this,nc,nsites,sites) integer :: ft ! functional type index integer :: k,j,i ! indices to the radiation matrix - integer :: i_var_pos ! loop counter for var x position + 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 @@ -1195,25 +1216,30 @@ subroutine set_restart_vectors(this,nc,nsites,sites) write(fates_log(),*) 'CLTV upperbound ', ubound(rio_npp_acc_co,1) endif + ! Fill output arrays of PRT variables - i_var_pos = 0 + ! We just loop through the objects, and reference our members relative + ! the base index of the PRT variables + ! ----------------------------------------------------------------------- + + ir_prt_var = ir_prt_base do i_var = 1, prt_instance%num_vars do i_pos = 1, prt_instance%state_descriptor(i_var)%num_pos - - i_var_pos = i_var_pos + 1 - this%rvars(ir_prt_base+i_var_pos)%r81d(io_idx_co) = & + + ir_prt_var = ir_prt_var + 1 + this%rvars(ir_prt_var)%r81d(io_idx_co) = & ccohort%prt%variables(i_var)%val(i_pos) - i_var_pos = i_var_pos + 1 - this%rvars(ir_prt_base+i_var_pos)%r81d(io_idx_co) = & + ir_prt_var = ir_prt_var + 1 + this%rvars(ir_prt_var)%r81d(io_idx_co) = & ccohort%prt%variables(i_var)%turnover(i_pos) - - i_var_pos = i_var_pos + 1 - this%rvars(ir_prt_base+i_var_pos)%r81d(io_idx_co) = & + + ir_prt_var = ir_prt_var + 1 + this%rvars(ir_prt_var)%r81d(io_idx_co) = & ccohort%prt%variables(i_var)%net_art(i_pos) - i_var_pos = i_var_pos + 1 - this%rvars(ir_prt_base+i_var_pos)%r81d(io_idx_co) = & + ir_prt_var = ir_prt_var + 1 + this%rvars(ir_prt_var)%r81d(io_idx_co) = & ccohort%prt%variables(i_var)%burned(i_pos) end do @@ -1640,7 +1666,7 @@ subroutine get_restart_vectors(this, nc, nsites, sites) integer :: totalcohorts ! total cohort count on this thread (diagnostic) integer :: patchespersite ! number of patches per site integer :: cohortsperpatch ! number of cohorts per patch - integer :: i_var_pos ! loop counter for var x position + integer :: i_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 @@ -1761,25 +1787,29 @@ subroutine get_restart_vectors(this, nc, nsites, sites) endif ! Fill PRT state variables with array data - i_var_pos = 0 + ! We just loop through the objects, and reference our members relative + ! the base index of the PRT variables + ! ----------------------------------------------------------------------- + + ir_prt_var = ir_prt_base do i_var = 1, prt_instance%num_vars do i_pos = 1, prt_instance%state_descriptor(i_var)%num_pos - i_var_pos = i_var_pos + 1 + ir_prt_var = ir_prt_var + 1 ccohort%prt%variables(i_var)%val(i_pos) = & - this%rvars(ir_prt_base+i_var_pos)%r81d(io_idx_co) + this%rvars(ir_prt_var)%r81d(io_idx_co) - i_var_pos = i_var_pos + 1 + ir_prt_var = ir_prt_var + 1 ccohort%prt%variables(i_var)%turnover(i_pos) = & - this%rvars(ir_prt_base+i_var_pos)%r81d(io_idx_co) + this%rvars(ir_prt_var)%r81d(io_idx_co) - i_var_pos = i_var_pos + 1 + ir_prt_var = ir_prt_var + 1 ccohort%prt%variables(i_var)%net_art(i_pos) = & - this%rvars(ir_prt_base+i_var_pos)%r81d(io_idx_co) + this%rvars(ir_prt_var)%r81d(io_idx_co) - i_var_pos = i_var_pos + 1 + ir_prt_var = ir_prt_var + 1 ccohort%prt%variables(i_var)%burned(i_pos) = & - this%rvars(ir_prt_base+i_var_pos)%r81d(io_idx_co) + this%rvars(ir_prt_var)%r81d(io_idx_co) end do end do diff --git a/parteh/PRTAllometricCarbonMod.F90 b/parteh/PRTAllometricCarbonMod.F90 index c577b7c51f..48942a1078 100644 --- a/parteh/PRTAllometricCarbonMod.F90 +++ b/parteh/PRTAllometricCarbonMod.F90 @@ -8,9 +8,6 @@ module PRTAllometricCarbonMod ! ! Ryan Knox Apr 2018 ! - ! TO-DO: THE MAPPING TABLES SHOULD BE PROTECTED STATUS. TEST ADDING THIS AFTER 1ST - ! SUCCESFULL RUN - ! ! ------------------------------------------------------------------------------------ use PRTGenericMod , only : prt_instance_type @@ -86,15 +83,15 @@ module PRTAllometricCarbonMod integer, public, parameter :: ac_bc_inout_id_dbh = 1 ! Plant DBH integer, public, parameter :: ac_bc_inout_id_netdc = 2 ! Index for the net daily C input BC - integer, parameter :: num_bc_inout = 2 + integer, parameter :: num_bc_inout = 2 ! Number of in & output boundary conditions integer, public, parameter :: ac_bc_in_id_pft = 1 ! Index for the PFT input BC integer, public, parameter :: ac_bc_in_id_ctrim = 2 ! Index for the canopy trim function - integer, parameter :: num_bc_in = 2 + integer, parameter :: num_bc_in = 2 ! Number of input boundary condition ! THere are no purely output boundary conditions - integer, parameter :: num_bc_out = 0 + integer, parameter :: num_bc_out = 0 ! Number of purely output boundary condtions ! ------------------------------------------------------------------------------------- ! Define the size of the coorindate vector. For this hypothesis, there is only @@ -142,16 +139,40 @@ module PRTAllometricCarbonMod subroutine InitPRTInstanceAC() ! ---------------------------------------------------------------------------------- - ! Initialize and populate the general mapping table that - ! organizes the specific variables in this module to - ! pre-ordained groups, so they can be used to inform - ! the rest of the model + ! Initialize and populate the object that hold the descriptions of the variables, + ! and contains the mappings of each variable to the pre-ordained organ + ! and species list, and the number of boundary conditions of each 3 types. + ! ! This is called very early on in the call sequence of the model, and should occur ! before any plants start being initialized. These mapping tables must - ! exist before that happens. + ! exist before that happens. This initialization only happens once on each + ! machine, and the mapping will be read-only, and a global thing. This step + ! is not initializing the data structures bound to the plants. + ! + ! There are two mapping tables. One mapping table is a 2d array organized + ! by organ and species, that contains the variable index: + ! + ! prt_instance%sp_organ_map + ! + ! The other mapping table is similar, but it is a 1D array, a list of the organs. + ! And each of these the in turn points to a list of the indices associated + ! with that organ. This is useful when you want to do lots of stuff to a specified + ! organ. + ! + ! prt_instance%organ_map + ! + ! IMPORTANT NOTE: Once this object is populated, we can use this to properly + ! allocate the "prt_vartypes_type" objects that attached to each plant. That process + ! is handled by generic functions, and does not need to be written in each hypothesis. + ! ! ----------------------------------------------------------------------------------- allocate(prt_instance_ac) + + ! The "state descriptor" object holds things like the names, the symbols, the units + ! of each variable. By putting it in an object, we can loop through them when + ! doing things like reading/writing history and restarts + allocate(prt_instance_ac%state_descriptor(num_vars)) prt_instance_ac%hyp_name = 'Allometric Carbon Only' @@ -185,41 +206,77 @@ end subroutine InitPRTInstanceAC ! ===================================================================================== - subroutine DailyPRTAC(this) + subroutine DailyPRTAllometricCarbon(this) + + ! ----------------------------------------------------------------------------------- + ! + ! This is the main routine that handles allocation associated with the 1st + ! hypothesis; carbon only, and growth governed by allometry + ! + ! This routine is explained in the technical documentation in detail. + ! + ! Some points: + ! 1) dbh, while not a PARTEH "state variable", is passed in from FATES (or other + ! model), is integrated along with the mass based state variables, and then + ! passed back to the ecosystem model. It is a "inout" style boundary condition. + ! + ! 2) It is assumed that both growth respiration, and maintenance respiration + ! costs have already been paid, and therefore the "carbon_balance" boundary + ! condition is the net carbon gained by the plant over the coarse of the day. + ! Think of "daily integrated NPP". + ! + ! 3) This routine will completely spend carbon_balance if it enters as a positive + ! value, or replace carbon balance (using storage) if it enters as a negative value. + ! + ! 4) It is assumed that the ecosystem model calling this routine has ensured that + ! the net amount of negative carbon is no greater than that which can be replaced + ! by storage. This routine will crash gracefully if that is not true. + ! + ! 5) Leaves and fine-roots are given top priority, but just to replace maintenance + ! turnover. This can also draw from strorage. + ! + ! 6) Storage is given next available carbon gain, either to push up to zero, + ! or to use it to top off stores. + ! + ! 7) Third priority is then given to leaves and fine-roots again, but can only use + ! carbon gain. Also, this transfer will attempt to get pools up to allometry. + ! + ! 8) Fourth priority is to bring other live pools up to allometry, and then structure. + ! + ! 9) Finally, if carbon is yet still available, it will grow all pools out concurrently + ! including some to reproduction. + ! + ! ---------------------------------------------------------------------------------- - ! The class is the only argument, input and output bc's are globals + ! The class is the only argument class(callom_prt_vartypes) :: this ! this class ! ----------------------------------------------------------------------------------- ! These are local copies of the in/out boundary condition structure ! ----------------------------------------------------------------------------------- - real(r8),pointer :: dbh ! Diameter at breast height [cm] - ! this local will point to both in and out bc's - real(r8),pointer :: carbon_balance ! Daily carbon balance for this cohort [kgC] + real(r8),pointer :: dbh ! Diameter at breast height [cm] + ! this local will point to both in and out bc's + real(r8),pointer :: carbon_balance ! Daily carbon balance for this cohort [kgC] - ! These are local copies of the input only boundary conditions - real(r8) :: canopy_trim ! The canopy trimming function [0-1] - integer :: ipft ! Plant Functional Type index + real(r8) :: canopy_trim ! The canopy trimming function [0-1] + integer :: ipft ! Plant Functional Type index - ! ----------------------------------------------------------------------------------- - ! Local copies of output boundary conditions - ! ----------------------------------------------------------------------------------- - - real(r8) :: target_leaf_c ! target leaf carbon [kgC] - real(r8) :: target_fnrt_c ! target fine-root carbon [kgC] - real(r8) :: target_sapw_c ! target sapwood carbon [kgC] - real(r8) :: target_store_c ! target storage carbon [kgC] - real(r8) :: target_agw_c ! target above ground carbon in woody tissues [kgC] - real(r8) :: target_bgw_c ! target below ground carbon in woody tissues [kgC] - real(r8) :: target_struct_c ! target structural carbon [kgC] + + real(r8) :: target_leaf_c ! target leaf carbon [kgC] + real(r8) :: target_fnrt_c ! target fine-root carbon [kgC] + real(r8) :: target_sapw_c ! target sapwood carbon [kgC] + real(r8) :: target_store_c ! target storage carbon [kgC] + real(r8) :: target_agw_c ! target above ground carbon in woody tissues [kgC] + real(r8) :: target_bgw_c ! target below ground carbon in woody tissues [kgC] + real(r8) :: target_struct_c ! target structural carbon [kgC] real(r8) :: sapw_area ! dummy var, x-section area of sapwood [m2] real(r8) :: leaf_below_target ! fineroot biomass below target amount [kgC] real(r8) :: fnrt_below_target ! fineroot biomass below target amount [kgC] - real(r8) :: sapw_below_target ! sapwood biomass below target amount [kgC] + real(r8) :: sapw_below_target ! sapwood biomass below target amount [kgC] real(r8) :: store_below_target ! storage biomass below target amount [kgC] real(r8) :: struct_below_target ! dead (structural) biomass below target amount [kgC] real(r8) :: total_below_target ! total biomass below the allometric target [kgC] @@ -227,26 +284,25 @@ subroutine DailyPRTAC(this) real(r8) :: flux_adj ! adjustment made to growth flux term to minimize error [kgC] real(r8) :: store_target_fraction ! ratio between storage and leaf biomass when on allometry [kgC] - real(r8) :: leaf_c_demand ! leaf carbon that is demanded to replace maintenance turnover [kgC] - real(r8) :: fnrt_c_demand ! fineroot carbon that is demanded to replace + real(r8) :: leaf_c_demand ! leaf carbon that is demanded to replace maintenance turnover [kgC] + real(r8) :: fnrt_c_demand ! fineroot carbon that is demanded to replace ! maintenance turnover [kgC] - real(r8) :: total_c_demand ! total carbon that is demanded to replace maintenance turnover [kgC] + real(r8) :: total_c_demand ! total carbon that is demanded to replace maintenance turnover [kgC] logical :: step_pass ! Did the integration step pass? - real(r8) :: leaf_c_flux - real(r8) :: fnrt_c_flux - real(r8) :: sapw_c_flux - real(r8) :: store_c_flux - real(r8) :: repro_c_flux - real(r8) :: struct_c_flux + real(r8) :: leaf_c_flux ! Transfer into leaves at various stages [kgC] + real(r8) :: fnrt_c_flux ! Transfer into fine-roots at various stages [kgC] + real(r8) :: sapw_c_flux ! Transfer into sapwood at various stages [kgC] + real(r8) :: store_c_flux ! Transfer into storage at various stages [kgC] + real(r8) :: repro_c_flux ! Transfer into reproduction at the final stage [kgC] + real(r8) :: struct_c_flux ! Transfer into structure at various stages [kgC] real(r8) :: leaf_c0 ! Initial value of carbon used to determine net flux real(r8) :: fnrt_c0 ! during this routine - real(r8) :: sapw_c0 - real(r8) :: store_c0 - real(r8) :: repro_c0 - real(r8) :: struct_c0 - + real(r8) :: sapw_c0 ! "" + real(r8) :: store_c0 ! "" + real(r8) :: repro_c0 ! "" + real(r8) :: struct_c0 ! "" logical :: grow_leaf ! Are leaves at allometric target and should be grown? logical :: grow_fnrt ! Are fine-roots at allometric target and should be grown? @@ -264,27 +320,21 @@ subroutine DailyPRTAC(this) integer :: i_var ! local index for iterating state variables - ! Integegrator variables - - real(r8),dimension(n_integration_vars) :: c_pool ! Vector of carbon pools passed to integrator - real(r8),dimension(n_integration_vars) :: c_pool_out ! Vector of carbon pools passed back from integrator - logical,dimension(n_integration_vars) :: c_mask ! Mask of active pools during integration - - real(r8), parameter :: cbal_prec = 1.0e-15_r8 ! Desired precision in carbon balance - integer , parameter :: max_substeps = 300 ! Maximum allowable iterations - real(r8), parameter :: max_trunc_error = 1.0_r8 ! Maximum allowable truncation error - integer, parameter :: ODESolve = 2 ! 1=RKF45, 2=Euler - - real(r8) :: intgr_params(num_bc_in) - + ! Integegrator variables c_pool is "mostly" carbon variables, it also includes + ! dbh... + ! ----------------------------------------------------------------------------------- - ! This is a local array containing the boundary conditions - ! we need this (for now at least) because the integration layer needs things - ! packed into simple types + real(r8),dimension(n_integration_vars) :: c_pool ! Vector of carbon pools passed to integrator + real(r8),dimension(n_integration_vars) :: c_pool_out ! Vector of carbon pools passed back from integrator + logical,dimension(n_integration_vars) :: c_mask ! Mask of active pools during integration + integer , parameter :: max_substeps = 300 ! Maximum allowable iterations + real(r8), parameter :: max_trunc_error = 1.0_r8 ! Maximum allowable truncation error + integer, parameter :: ODESolve = 2 ! 1=RKF45, 2=Euler - ! This array is used to hold parameters that must be passed through - ! a generic integrator to the derivative functions + real(r8) :: intgr_params(num_bc_in) ! The boundary conditions to this routine, + ! are pressed into an array that is also + ! passed to the integrators associate( & leaf_c => this%variables(leaf_c_id)%val(icd), & @@ -295,10 +345,11 @@ subroutine DailyPRTAC(this) struct_c => this%variables(struct_c_id)%val(icd)) - ! =================================================================================== - - ! Copy the boundary conditions into readable local variables - ! We don't use pointers, because inputs should be intent in only + ! ----------------------------------------------------------------------------------- + ! 0. + ! Copy the boundary conditions into readable local variables. + ! We don't use pointers for intput only, only in-out + ! ----------------------------------------------------------------------------------- dbh => this%bc_inout(ac_bc_inout_id_dbh)%rval carbon_balance => this%bc_inout(ac_bc_inout_id_netdc)%rval @@ -309,12 +360,24 @@ subroutine DailyPRTAC(this) intgr_params(:) = un_initialized intgr_params(ac_bc_in_id_ctrim) = this%bc_in(ac_bc_in_id_ctrim)%rval intgr_params(ac_bc_in_id_pft) = real(this%bc_in(ac_bc_in_id_pft)%ival) + + ! ----------------------------------------------------------------------------------- + ! I. Remember the values for the state variables at the beginning of this + ! routines. We will then use that to determine their net allocation and reactive + ! transport flux "%net_art" at the end. + ! ----------------------------------------------------------------------------------- + + leaf_c0 = leaf_c ! Set initial leaf carbon + fnrt_c0 = fnrt_c ! Set initial fine-root carbon + sapw_c0 = sapw_c ! Set initial sapwood carbon + store_c0 = store_c ! Set initial storage carbon + repro_c0 = repro_c ! Set initial reproductive carbon + struct_c0 = struct_c ! Set initial structural carbon ! ----------------------------------------------------------------------------------- - ! I. Calculate target size of the biomass compartment for a given dbh. + ! II. Calculate target size of the biomass compartment for a given dbh. ! ----------------------------------------------------------------------------------- - ! Target sapwood biomass and deriv. according to allometry and trimming [kgC, kgC/cm] call bsap_allom(dbh,ipft,canopy_trim,sapw_area,target_sapw_c) @@ -364,12 +427,7 @@ subroutine DailyPRTAC(this) call bstore_allom(dbh,ipft,canopy_trim,target_store_c) - leaf_c0 = leaf_c - fnrt_c0 = fnrt_c - sapw_c0 = sapw_c - store_c0 = store_c - repro_c0 = repro_c - struct_c0 = struct_c + ! ----------------------------------------------------------------------------------- ! III. Prioritize some amount of carbon to replace leaf/root turnover @@ -505,7 +563,7 @@ subroutine DailyPRTAC(this) end if ! ----------------------------------------------------------------------------------- - ! VIII. If carbon is still available, replenish the structural pool to get + ! VII. If carbon is still available, replenish the structural pool to get ! back on allometry ! ----------------------------------------------------------------------------------- @@ -524,7 +582,7 @@ subroutine DailyPRTAC(this) end if ! ----------------------------------------------------------------------------------- - ! IX. If carbon is yet still available ... + ! VIII. If carbon is yet still available ... ! Our pools are now either on allometry or above (from fusion). ! We we can increment those pools at or below, ! including structure and reproduction according to their rates From 881b5fceff171f3606958ad9b2abb2227f7c02b8 Mon Sep 17 00:00:00 2001 From: Rosie Fisher Date: Wed, 17 Oct 2018 16:53:40 -0700 Subject: [PATCH 32/52] Update parteh/PRTAllometricCarbonMod.F90 --- parteh/PRTAllometricCarbonMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/parteh/PRTAllometricCarbonMod.F90 b/parteh/PRTAllometricCarbonMod.F90 index 48942a1078..a29fd5415a 100644 --- a/parteh/PRTAllometricCarbonMod.F90 +++ b/parteh/PRTAllometricCarbonMod.F90 @@ -622,7 +622,7 @@ subroutine DailyPRTAllometricCarbon(this) target_leaf_c, target_fnrt_c, & target_sapw_c, target_store_c, target_struct_c, & grow_leaf, grow_fnrt, grow_sapw, grow_store) - else + else ! for grasses grow_leaf = .true. grow_fnrt = .true. grow_sapw = .true. From 4808362497cce502bbc92f5596b9cc41302fc9d3 Mon Sep 17 00:00:00 2001 From: Rosie Fisher Date: Wed, 17 Oct 2018 17:06:58 -0700 Subject: [PATCH 33/52] Update parteh/PRTAllometricCarbonMod.F90 --- parteh/PRTAllometricCarbonMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/parteh/PRTAllometricCarbonMod.F90 b/parteh/PRTAllometricCarbonMod.F90 index a29fd5415a..e06406efed 100644 --- a/parteh/PRTAllometricCarbonMod.F90 +++ b/parteh/PRTAllometricCarbonMod.F90 @@ -679,7 +679,7 @@ subroutine DailyPRTAllometricCarbon(this) this%ode_opt_step = 0.5*deltaC end if else - write(fates_log(),*) 'An integrator was chosen that DNE' + write(fates_log(),*) 'An integrator was chosen that does not exist' write(fates_log(),*) 'ODESolve = ',ODESolve call endrun(msg=errMsg(sourcefile, __LINE__)) end if From bfbe4b68cb4a2fad1dd230c016f64837aed1e5e9 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Wed, 17 Oct 2018 18:54:26 -0700 Subject: [PATCH 34/52] Many comments and cleanings for the parteh. --- biogeochem/EDCohortDynamicsMod.F90 | 2 +- biogeophys/FatesPlantRespPhotosynthMod.F90 | 6 +- .../f_wrapper_modules/FatesCohortWrapMod.F90 | 22 +- .../f_wrapper_modules/FatesPARTEHWrapMod.F90 | 7 +- main/EDPftvarcon.F90 | 149 ++++---- main/FatesInterfaceMod.F90 | 11 +- main/FatesRestartInterfaceMod.F90 | 20 +- parameter_files/fates_params_14pfts.cdl | 24 +- parameter_files/fates_params_default.cdl | 24 +- parteh/PRTAllometricCarbonMod.F90 | 142 ++++--- parteh/PRTGenericMod.F90 | 361 +++++++++++------- parteh/PRTLossFluxesMod.F90 | 60 +-- 12 files changed, 473 insertions(+), 355 deletions(-) diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index c6e45a2028..e3b7f42eaa 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -834,7 +834,7 @@ subroutine fuse_cohorts(currentSite, currentPatch, bc_in) ! ----------------------------------------------------------------- if( EDPftvarcon_inst%woody(currentCohort%pft) == itrue ) then - call StructureResetOfDH( currentCohort%prt%GetState(struct_organ,carbon12_species), currentCohort%pft, & + call StructureResetOfDH( currentCohort%prt%GetState(struct_organ,all_carbon_species), currentCohort%pft, & currentCohort%canopy_trim, currentCohort%dbh, currentCohort%hite ) end if diff --git a/biogeophys/FatesPlantRespPhotosynthMod.F90 b/biogeophys/FatesPlantRespPhotosynthMod.F90 index 21297b7509..7dff2326a5 100644 --- a/biogeophys/FatesPlantRespPhotosynthMod.F90 +++ b/biogeophys/FatesPlantRespPhotosynthMod.F90 @@ -367,7 +367,7 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) call bleaf(currentCohort%dbh,currentCohort%pft,currentCohort%canopy_trim,b_leaf) call storage_fraction_of_target(b_leaf, & - currentCohort%prt%GetState(store_organ, carbon12_species), & + currentCohort%prt%GetState(store_organ, all_carbon_species), & frac) call lowstorage_maintresp_reduction(frac,currentCohort%pft, & maintresp_reduction_factor) @@ -444,8 +444,8 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) case (prt_cnp_flex_allom_hyp) - leaf_c = currentCohort%prt%GetState(leaf_organ, carbon12_species) - leaf_n = currentCohort%prt%GetState(leaf_organ, nitrogen_species) + leaf_c = currentCohort%prt%GetState(leaf_organ, all_carbon_species) + leaf_n = currentCohort%prt%GetState(leaf_organ, all_carbon_species) lnc_top = leaf_n / (slatop(ft) * leaf_c ) end select diff --git a/functional_unit_testing/parteh/f_wrapper_modules/FatesCohortWrapMod.F90 b/functional_unit_testing/parteh/f_wrapper_modules/FatesCohortWrapMod.F90 index fb72756f6b..2e42fbbf05 100644 --- a/functional_unit_testing/parteh/f_wrapper_modules/FatesCohortWrapMod.F90 +++ b/functional_unit_testing/parteh/f_wrapper_modules/FatesCohortWrapMod.F90 @@ -37,20 +37,20 @@ module FatesCohortWrapMod use PRTGenericMod, only : struct_organ use PRTGenericMod, only : carbon12_species use PRTGenericMod, only : SetState - use PRTGenericMod, only : prt_instance + use PRTGenericMod, only : prt_global use PRTAllometricCarbonMod, only : callom_prt_vartypes use PRTAllometricCarbonMod, only : ac_bc_inout_id_netdc use PRTAllometricCarbonMod, only : ac_bc_in_id_pft use PRTAllometricCarbonMod, only : ac_bc_in_id_ctrim use PRTAllometricCarbonMod, only : ac_bc_inout_id_dbh - use PRTAllometricCarbonMod, only : prt_instance_ac + use PRTAllometricCarbonMod, only : prt_global_ac use PRTLossFluxesMod, only : PRTMaintTurnover use PRTLossFluxesMod, only : PRTDeciduousTurnover use PRTLossFluxesMod, only : PRTPhenologyFlush - use PRTAllometricCNPMod, only : prt_instance_acnp + use PRTAllometricCNPMod, only : prt_global_acnp use PRTAllometricCNPMod, only : cnp_allom_prt_vartypes use PRTAllometricCNPMod, only : acnp_bc_inout_id_dbh use PRTAllometricCNPMod, only : acnp_bc_inout_id_netdc @@ -231,12 +231,12 @@ subroutine CohortPySet(ipft,hgt_min,canopy_trim) select case(ccohort%parteh_model) case (1) - prt_instance => prt_instance_ac + prt_global => prt_global_ac allocate(callom_prt) ccohort%prt => callom_prt case(2) - prt_instance => prt_instance_acnp + prt_global => prt_global_acnp allocate(cnpallom_prt) ccohort%prt => cnpallom_prt @@ -367,7 +367,7 @@ subroutine WrapDailyPRT(ipft,daily_carbon_gain,canopy_trim,flush_c,drop_frac_c,l select case(int(ccohort%parteh_model)) case (1) - prt_instance => prt_instance_ac + prt_global => prt_global_ac ccohort%daily_carbon_gain = daily_carbon_gain call ccohort%prt%DailyPRT() @@ -376,7 +376,7 @@ subroutine WrapDailyPRT(ipft,daily_carbon_gain,canopy_trim,flush_c,drop_frac_c,l ccohort%carbon_root_exudate = 0.0_r8 case (2) - prt_instance => prt_instance_acnp + 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 @@ -427,9 +427,9 @@ subroutine WrapQueryVars(ipft,leaf_area,crown_area,agb,store_c,target_leaf_c) select case(int(ccohort%parteh_model)) case (1) - prt_instance => prt_instance_ac + prt_global => prt_global_ac case (2) - prt_instance => prt_instance_acnp + prt_global => prt_global_acnp end select @@ -516,9 +516,9 @@ subroutine WrapQueryDiagnostics(ipft, dbh, & select case(int(ccohort%parteh_model)) case (1) - prt_instance => prt_instance_ac + prt_global => prt_global_ac case (2) - prt_instance => prt_instance_acnp + prt_global => prt_global_acnp end select dbh = ccohort%dbh diff --git a/functional_unit_testing/parteh/f_wrapper_modules/FatesPARTEHWrapMod.F90 b/functional_unit_testing/parteh/f_wrapper_modules/FatesPARTEHWrapMod.F90 index 6f6f63ee04..08ee7fb937 100644 --- a/functional_unit_testing/parteh/f_wrapper_modules/FatesPARTEHWrapMod.F90 +++ b/functional_unit_testing/parteh/f_wrapper_modules/FatesPARTEHWrapMod.F90 @@ -38,11 +38,14 @@ subroutine SPMapPyset() !prt_mode) ! select case(int(prt_mode)) ! case (1) - call InitPRTInstanceAC() + ! We actually initialize all hypotheses, since we are intercomparing. + + + call InitPRTGlobalAllometricCarbon() ! case(2) - call InitPRTInstanceACNP() + call InitPRTGlobalAllometricCNP() ! case DEFAULT ! write(fates_log(),*) 'You specified an unknown PRT module' diff --git a/main/EDPftvarcon.F90 b/main/EDPftvarcon.F90 index 513ae66ebb..7c429ed76f 100644 --- a/main/EDPftvarcon.F90 +++ b/main/EDPftvarcon.F90 @@ -180,9 +180,9 @@ module EDPftvarcon real(r8), allocatable :: branch_turnover(:) ! Turnover time for branchfall on live trees (pft) [yr] real(r8), allocatable :: turnover_retrans_mode(:) ! Retranslocation method (pft) - real(r8), allocatable :: turnover_carb_retrans_p1(:,:) ! Parameter 1 for carbon re-translocation (pft x organ) - real(r8), allocatable :: turnover_nitr_retrans_p1(:,:) ! Parameter 1 for nitrogen re-translocation (pft x organ) - real(r8), allocatable :: turnover_phos_retrans_p1(:,:) ! Parameter 1 for phosphorous re-translocation (pft x organ) + 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) ! Plant Hydraulic Parameters @@ -1413,15 +1413,15 @@ subroutine Register_PFT_prt_organs(this, fates_params) call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_2d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'fates_turnover_carb_retrans_p1' + name = 'fates_turnover_carb_retrans' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_2d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'fates_turnover_nitr_retrans_p1' + name = 'fates_turnover_nitr_retrans' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_2d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'fates_turnover_phos_retrans_p1' + name = 'fates_turnover_phos_retrans' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_2d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) @@ -1466,17 +1466,17 @@ subroutine Receive_PFT_prt_organs(this, fates_params) call fates_params%RetreiveParameterAllocate(name=name, & data=this%prt_alloc_priority) - name = 'fates_turnover_carb_retrans_p1' + name = 'fates_turnover_carb_retrans' call fates_params%RetreiveParameterAllocate(name=name, & - data=this%turnover_carb_retrans_p1) + data=this%turnover_carb_retrans) - name = 'fates_turnover_nitr_retrans_p1' + name = 'fates_turnover_nitr_retrans' call fates_params%RetreiveParameterAllocate(name=name, & - data=this%turnover_nitr_retrans_p1) + data=this%turnover_nitr_retrans) - name = 'fates_turnover_phos_retrans_p1' + name = 'fates_turnover_phos_retrans' call fates_params%RetreiveParameterAllocate(name=name, & - data=this%turnover_phos_retrans_p1) + data=this%turnover_phos_retrans) end subroutine Receive_PFT_prt_organs @@ -1735,9 +1735,9 @@ subroutine FatesReportPFTParams(is_master) write(fates_log(),fmt0) 'prt_unit_gr_resp = ',EDPftvarcon_inst%prt_unit_gr_resp write(fates_log(),fmt0) 'prt_alloc_priority = ',EDPftvarcon_inst%prt_alloc_priority - write(fates_log(),fmt0) 'turnover_carb_retrans_p1 = ',EDPftvarcon_inst%turnover_carb_retrans_p1 - write(fates_log(),fmt0) 'turnover_nitr_retrans_p1 = ',EDPftvarcon_inst%turnover_nitr_retrans_p1 - write(fates_log(),fmt0) 'turnover_phos_retrans_p1 = ',EDPftvarcon_inst%turnover_phos_retrans_p1 + write(fates_log(),fmt0) 'turnover_carb_retrans = ',EDPftvarcon_inst%turnover_carb_retrans + write(fates_log(),fmt0) 'turnover_nitr_retrans = ',EDPftvarcon_inst%turnover_nitr_retrans + write(fates_log(),fmt0) 'turnover_phos_retrans = ',EDPftvarcon_inst%turnover_phos_retrans write(fates_log(),*) '-------------------------------------------------' @@ -1936,136 +1936,136 @@ subroutine FatesCheckParams(is_master, parteh_mode) ! Note to advanced users. Feel free to remove these checks... ! ------------------------------------------------------------------- - if ( (EDPftvarcon_inst%turnover_carb_retrans_p1(ipft,repro_organ) > nearzero) ) then + if ( (EDPftvarcon_inst%turnover_carb_retrans(ipft,repro_organ) > nearzero) ) then write(fates_log(),*) ' Retranslocation of reproductive tissues should be zero.' write(fates_log(),*) ' PFT#: ',ipft - write(fates_log(),*) ' carbon: ',EDPftvarcon_inst%turnover_carb_retrans_p1(ipft,repro_organ) + write(fates_log(),*) ' carbon: ',EDPftvarcon_inst%turnover_carb_retrans(ipft,repro_organ) write(fates_log(),*) ' Aborting' call endrun(msg=errMsg(sourcefile, __LINE__)) end if - if (parteh_mode .eq. 2) then - if ((EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,repro_organ) > nearzero) .or. & - (EDPftvarcon_inst%turnover_phos_retrans_p1(ipft,repro_organ) > nearzero) ) then + if (parteh_mode .eq. prt_cnp_flex_allom_hyp) then + if ((EDPftvarcon_inst%turnover_nitr_retrans(ipft,repro_organ) > nearzero) .or. & + (EDPftvarcon_inst%turnover_phos_retrans(ipft,repro_organ) > nearzero) ) then write(fates_log(),*) ' Retranslocation of reproductive tissues should be zero.' write(fates_log(),*) ' PFT#: ',ipft - write(fates_log(),*) ' carbon: ',EDPftvarcon_inst%turnover_carb_retrans_p1(ipft,repro_organ) - write(fates_log(),*) ' nitr: ',EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,repro_organ) - write(fates_log(),*) ' phos: ',EDPftvarcon_inst%turnover_phos_retrans_p1(ipft,repro_organ) + write(fates_log(),*) ' carbon: ',EDPftvarcon_inst%turnover_carb_retrans(ipft,repro_organ) + write(fates_log(),*) ' nitr: ',EDPftvarcon_inst%turnover_nitr_retrans(ipft,repro_organ) + write(fates_log(),*) ' phos: ',EDPftvarcon_inst%turnover_phos_retrans(ipft,repro_organ) write(fates_log(),*) ' Aborting' call endrun(msg=errMsg(sourcefile, __LINE__)) end if end if - if ((EDPftvarcon_inst%turnover_carb_retrans_p1(ipft,sapw_organ) > nearzero)) then + if ((EDPftvarcon_inst%turnover_carb_retrans(ipft,sapw_organ) > nearzero)) then write(fates_log(),*) ' Retranslocation of sapwood tissues should be zero.' write(fates_log(),*) ' PFT#: ',ipft - write(fates_log(),*) ' carbon: ',EDPftvarcon_inst%turnover_carb_retrans_p1(ipft,sapw_organ) + write(fates_log(),*) ' carbon: ',EDPftvarcon_inst%turnover_carb_retrans(ipft,sapw_organ) write(fates_log(),*) ' Aborting' call endrun(msg=errMsg(sourcefile, __LINE__)) end if - if (parteh_mode .eq. 2) then - if ((EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,sapw_organ) > nearzero) .or. & - (EDPftvarcon_inst%turnover_phos_retrans_p1(ipft,sapw_organ) > nearzero) ) then + if (parteh_mode .eq. prt_cnp_flex_allom_hyp) then + if ((EDPftvarcon_inst%turnover_nitr_retrans(ipft,sapw_organ) > nearzero) .or. & + (EDPftvarcon_inst%turnover_phos_retrans(ipft,sapw_organ) > nearzero) ) then write(fates_log(),*) ' Retranslocation of sapwood tissues should be zero.' write(fates_log(),*) ' PFT#: ',ipft - write(fates_log(),*) ' carbon: ',EDPftvarcon_inst%turnover_carb_retrans_p1(ipft,sapw_organ) - write(fates_log(),*) ' nitr: ',EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,sapw_organ) - write(fates_log(),*) ' phos: ',EDPftvarcon_inst%turnover_phos_retrans_p1(ipft,sapw_organ) + write(fates_log(),*) ' carbon: ',EDPftvarcon_inst%turnover_carb_retrans(ipft,sapw_organ) + write(fates_log(),*) ' nitr: ',EDPftvarcon_inst%turnover_nitr_retrans(ipft,sapw_organ) + write(fates_log(),*) ' phos: ',EDPftvarcon_inst%turnover_phos_retrans(ipft,sapw_organ) write(fates_log(),*) ' Aborting' call endrun(msg=errMsg(sourcefile, __LINE__)) end if end if - if ((EDPftvarcon_inst%turnover_carb_retrans_p1(ipft,struct_organ) > nearzero)) then + if ((EDPftvarcon_inst%turnover_carb_retrans(ipft,struct_organ) > nearzero)) then write(fates_log(),*) ' Retranslocation of structural(dead) tissues should be zero.' write(fates_log(),*) ' PFT#: ',ipft - write(fates_log(),*) ' carbon: ',EDPftvarcon_inst%turnover_carb_retrans_p1(ipft,struct_organ) + write(fates_log(),*) ' carbon: ',EDPftvarcon_inst%turnover_carb_retrans(ipft,struct_organ) write(fates_log(),*) ' Aborting' call endrun(msg=errMsg(sourcefile, __LINE__)) end if - if (parteh_mode .eq. 2) then - if ((EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,struct_organ) > nearzero) .or. & - (EDPftvarcon_inst%turnover_phos_retrans_p1(ipft,struct_organ) > nearzero) ) then + if (parteh_mode .eq. prt_cnp_flex_allom_hyp) then + if ((EDPftvarcon_inst%turnover_nitr_retrans(ipft,struct_organ) > nearzero) .or. & + (EDPftvarcon_inst%turnover_phos_retrans(ipft,struct_organ) > nearzero) ) then write(fates_log(),*) ' Retranslocation of structural(dead) tissues should be zero.' write(fates_log(),*) ' PFT#: ',ipft - write(fates_log(),*) ' nitr: ',EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,struct_organ) - write(fates_log(),*) ' phos: ',EDPftvarcon_inst%turnover_phos_retrans_p1(ipft,struct_organ) + write(fates_log(),*) ' nitr: ',EDPftvarcon_inst%turnover_nitr_retrans(ipft,struct_organ) + write(fates_log(),*) ' phos: ',EDPftvarcon_inst%turnover_phos_retrans(ipft,struct_organ) write(fates_log(),*) ' Aborting' call endrun(msg=errMsg(sourcefile, __LINE__)) end if end if ! Leaf retranslocation should be between 0 and 1 - if ( (EDPftvarcon_inst%turnover_carb_retrans_p1(ipft,leaf_organ) > 1.0_r8) .or. & - (EDPftvarcon_inst%turnover_carb_retrans_p1(ipft,leaf_organ) < 0.0_r8) ) then + if ( (EDPftvarcon_inst%turnover_carb_retrans(ipft,leaf_organ) > 1.0_r8) .or. & + (EDPftvarcon_inst%turnover_carb_retrans(ipft,leaf_organ) < 0.0_r8) ) then write(fates_log(),*) ' Retranslocation of leaf tissues should be between 0 and 1.' write(fates_log(),*) ' PFT#: ',ipft - write(fates_log(),*) ' carbon: ',EDPftvarcon_inst%turnover_carb_retrans_p1(ipft,leaf_organ) + write(fates_log(),*) ' carbon: ',EDPftvarcon_inst%turnover_carb_retrans(ipft,leaf_organ) write(fates_log(),*) ' Aborting' call endrun(msg=errMsg(sourcefile, __LINE__)) end if - if (parteh_mode .eq. 2) then - if ((EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,leaf_organ) > 1.0_r8) .or. & - (EDPftvarcon_inst%turnover_phos_retrans_p1(ipft,leaf_organ) > 1.0_r8) .or. & - (EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,leaf_organ) < 0.0_r8) .or. & - (EDPftvarcon_inst%turnover_phos_retrans_p1(ipft,leaf_organ) < 0.0_r8)) then + if (parteh_mode .eq. prt_cnp_flex_allom_hyp) then + if ((EDPftvarcon_inst%turnover_nitr_retrans(ipft,leaf_organ) > 1.0_r8) .or. & + (EDPftvarcon_inst%turnover_phos_retrans(ipft,leaf_organ) > 1.0_r8) .or. & + (EDPftvarcon_inst%turnover_nitr_retrans(ipft,leaf_organ) < 0.0_r8) .or. & + (EDPftvarcon_inst%turnover_phos_retrans(ipft,leaf_organ) < 0.0_r8)) then write(fates_log(),*) ' Retranslocation of leaf tissues should be between 0 and 1.' write(fates_log(),*) ' PFT#: ',ipft - write(fates_log(),*) ' nitr: ',EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,leaf_organ) - write(fates_log(),*) ' phos: ',EDPftvarcon_inst%turnover_phos_retrans_p1(ipft,leaf_organ) + write(fates_log(),*) ' nitr: ',EDPftvarcon_inst%turnover_nitr_retrans(ipft,leaf_organ) + write(fates_log(),*) ' phos: ',EDPftvarcon_inst%turnover_phos_retrans(ipft,leaf_organ) write(fates_log(),*) ' Aborting' call endrun(msg=errMsg(sourcefile, __LINE__)) end if end if ! Fineroot retranslocation should be between 0-1 - if ((EDPftvarcon_inst%turnover_carb_retrans_p1(ipft,fnrt_organ) > 1.0_r8) .or. & - (EDPftvarcon_inst%turnover_carb_retrans_p1(ipft,fnrt_organ) < 0.0_r8)) then + if ((EDPftvarcon_inst%turnover_carb_retrans(ipft,fnrt_organ) > 1.0_r8) .or. & + (EDPftvarcon_inst%turnover_carb_retrans(ipft,fnrt_organ) < 0.0_r8)) then write(fates_log(),*) ' Retranslocation of leaf tissues should be between 0 and 1.' write(fates_log(),*) ' PFT#: ',ipft - write(fates_log(),*) ' carbon: ',EDPftvarcon_inst%turnover_carb_retrans_p1(ipft,fnrt_organ) + write(fates_log(),*) ' carbon: ',EDPftvarcon_inst%turnover_carb_retrans(ipft,fnrt_organ) write(fates_log(),*) ' Aborting' call endrun(msg=errMsg(sourcefile, __LINE__)) end if - if (parteh_mode .eq. 2) then - if ((EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,fnrt_organ) > 1.0_r8) .or. & - (EDPftvarcon_inst%turnover_phos_retrans_p1(ipft,fnrt_organ) > 1.0_r8) .or. & - (EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,fnrt_organ) < 0.0_r8) .or. & - (EDPftvarcon_inst%turnover_phos_retrans_p1(ipft,fnrt_organ) < 0.0_r8)) then + if (parteh_mode .eq. prt_cnp_flex_allom_hyp) then + if ((EDPftvarcon_inst%turnover_nitr_retrans(ipft,fnrt_organ) > 1.0_r8) .or. & + (EDPftvarcon_inst%turnover_phos_retrans(ipft,fnrt_organ) > 1.0_r8) .or. & + (EDPftvarcon_inst%turnover_nitr_retrans(ipft,fnrt_organ) < 0.0_r8) .or. & + (EDPftvarcon_inst%turnover_phos_retrans(ipft,fnrt_organ) < 0.0_r8)) then write(fates_log(),*) ' Retranslocation of leaf tissues should be between 0 and 1.' write(fates_log(),*) ' PFT#: ',ipft - write(fates_log(),*) ' nitr: ',EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,fnrt_organ) - write(fates_log(),*) ' phos: ',EDPftvarcon_inst%turnover_phos_retrans_p1(ipft,fnrt_organ) + write(fates_log(),*) ' nitr: ',EDPftvarcon_inst%turnover_nitr_retrans(ipft,fnrt_organ) + write(fates_log(),*) ' phos: ',EDPftvarcon_inst%turnover_phos_retrans(ipft,fnrt_organ) write(fates_log(),*) ' Aborting' call endrun(msg=errMsg(sourcefile, __LINE__)) end if end if ! Storage retranslocation should be between 0-1 (storage retrans seems weird, but who knows) - if ((EDPftvarcon_inst%turnover_carb_retrans_p1(ipft,store_organ) > 1.0_r8) .or. & - (EDPftvarcon_inst%turnover_carb_retrans_p1(ipft,store_organ) < 0.0_r8)) then + if ((EDPftvarcon_inst%turnover_carb_retrans(ipft,store_organ) > 1.0_r8) .or. & + (EDPftvarcon_inst%turnover_carb_retrans(ipft,store_organ) < 0.0_r8)) then write(fates_log(),*) ' Retranslocation of leaf tissues should be between 0 and 1.' write(fates_log(),*) ' PFT#: ',ipft - write(fates_log(),*) ' carbon: ',EDPftvarcon_inst%turnover_carb_retrans_p1(ipft,store_organ) + write(fates_log(),*) ' carbon: ',EDPftvarcon_inst%turnover_carb_retrans(ipft,store_organ) write(fates_log(),*) ' Aborting' call endrun(msg=errMsg(sourcefile, __LINE__)) end if - if (parteh_mode .eq. 2) then - if ((EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,store_organ) > 1.0_r8) .or. & - (EDPftvarcon_inst%turnover_phos_retrans_p1(ipft,store_organ) > 1.0_r8) .or. & - (EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,store_organ) < 0.0_r8) .or. & - (EDPftvarcon_inst%turnover_phos_retrans_p1(ipft,store_organ) < 0.0_r8)) then + if (parteh_mode .eq. prt_cnp_flex_allom_hyp) then + if ((EDPftvarcon_inst%turnover_nitr_retrans(ipft,store_organ) > 1.0_r8) .or. & + (EDPftvarcon_inst%turnover_phos_retrans(ipft,store_organ) > 1.0_r8) .or. & + (EDPftvarcon_inst%turnover_nitr_retrans(ipft,store_organ) < 0.0_r8) .or. & + (EDPftvarcon_inst%turnover_phos_retrans(ipft,store_organ) < 0.0_r8)) then write(fates_log(),*) ' Retranslocation of leaf tissues should be between 0 and 1.' write(fates_log(),*) ' PFT#: ',ipft - write(fates_log(),*) ' nitr: ',EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,store_organ) - write(fates_log(),*) ' phos: ',EDPftvarcon_inst%turnover_phos_retrans_p1(ipft,store_organ) + write(fates_log(),*) ' nitr: ',EDPftvarcon_inst%turnover_nitr_retrans(ipft,store_organ) + write(fates_log(),*) ' phos: ',EDPftvarcon_inst%turnover_phos_retrans(ipft,store_organ) write(fates_log(),*) ' Aborting' call endrun(msg=errMsg(sourcefile, __LINE__)) end if end if ! Growth respiration - if (parteh_mode .eq. 1) then + if (parteh_mode .eq. prt_carbon_allom_hyp) then if ( ( EDPftvarcon_inst%grperc(ipft) < 0.0_r8) .or. & ( EDPftvarcon_inst%grperc(ipft) > 1.0_r8 ) ) then write(fates_log(),*) ' PFT#: ',ipft @@ -2073,7 +2073,7 @@ subroutine FatesCheckParams(is_master, parteh_mode) write(fates_log(),*) ' Aborting' call endrun(msg=errMsg(sourcefile, __LINE__)) end if - elseif(parteh_mode .eq. 2) then + elseif(parteh_mode .eq. prt_cnp_flex_allom_hyp) then if ( ( any(EDPftvarcon_inst%prt_unit_gr_resp(ipft,:) < 0.0_r8)) .or. & ( any(EDPftvarcon_inst%prt_unit_gr_resp(ipft,:) >= 1.0_r8)) ) then write(fates_log(),*) ' PFT#: ',ipft @@ -2087,7 +2087,7 @@ subroutine FatesCheckParams(is_master, parteh_mode) ! Firstly, the seed production and germination models cannot handle nutrients. So ! we assume (for now) that seeds do not have nutrients (parteh_mode = 1 is c only) - if(parteh_mode .eq. 2) then + if(parteh_mode .eq. prt_cnp_flex_allom_hyp) then if ( (EDPftvarcon_inst%prt_nitr_stoich_p1(ipft,repro_organ) > nearzero) .or. & (EDPftvarcon_inst%prt_nitr_stoich_p1(ipft,repro_organ) < -nearzero) .or. & (EDPftvarcon_inst%prt_phos_stoich_p1(ipft,repro_organ) > nearzero) .or. & @@ -2117,7 +2117,7 @@ subroutine FatesCheckParams(is_master, parteh_mode) write(fates_log(),*) ' Aborting' call endrun(msg=errMsg(sourcefile, __LINE__)) end if - if(parteh_mode .eq. 2) then + if(parteh_mode .eq. prt_cnp_flex_allom_hyp) then if( (any(EDPftvarcon_inst%prt_nitr_stoich_p2(ipft,:) < 0.0_r8)) .or. & (any(EDPftvarcon_inst%prt_nitr_stoich_p2(ipft,:) >= 1.0_r8)) ) then write(fates_log(),*) ' PFT#: ',ipft @@ -2129,7 +2129,7 @@ subroutine FatesCheckParams(is_master, parteh_mode) end if ! Stoichiometric Ratios - if (parteh_mode .eq. 2) then + if (parteh_mode .eq. prt_cnp_flex_allom_hyp) then if ( (any(EDPftvarcon_inst%prt_phos_stoich_p1(ipft,:) < 0.0_r8)) .or. & (any(EDPftvarcon_inst%prt_phos_stoich_p1(ipft,:) >= 1.0_r8)) .or. & (any(EDPftvarcon_inst%prt_phos_stoich_p2(ipft,:) < 0.0_r8)) .or. & @@ -2142,8 +2142,7 @@ subroutine FatesCheckParams(is_master, parteh_mode) call endrun(msg=errMsg(sourcefile, __LINE__)) end if end if - - if (parteh_mode .eq. 2) then + if (parteh_mode .eq. prt_cnp_flex_allom_hyp) then if ( any(EDPftvarcon_inst%prt_alloc_priority(ipft,:) < 0) .or. & any(EDPftvarcon_inst%prt_alloc_priority(ipft,:) > 6) ) then write(fates_log(),*) ' PFT#: ',ipft diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 72a0d5ab13..e0af48ddd3 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -27,9 +27,10 @@ module FatesInterfaceMod use EDPftvarcon , only : FatesCheckParams use EDPftvarcon , only : EDPftvarcon_inst use EDParamsMod , only : FatesReportParams - - use PRTAllometricCarbonMod, only : InitPRTInstanceAC - ! use PRTAllometricCNPMod, only : InitPRTInstanceACNP + use PRTGenericMod , only : prt_carbon_allom_hyp + use PRTGenericMod , only : prt_cnp_flex_allom_hyp + use PRTAllometricCarbonMod, only : InitPRTGlobalAllometricCarbon + ! use PRTAllometricCNPMod, only : InitPRTGlobalAllometricCNP ! CIME Globals use shr_log_mod , only : errMsg => shr_log_errMsg @@ -1587,11 +1588,11 @@ subroutine InitPARTEHGlobals() select case(hlm_parteh_mode) case(prt_carbon_allom_hyp) - call InitPRTInstanceAC() + call InitPRTGlobalAllometricCarbon() case(prt_cnp_flex_allom_hyp) - !call InitPRTInstanceACNP() + !call InitPRTGlobalAllometricCNP() write(fates_log(),*) 'You specified the allometric CNP mode' write(fates_log(),*) 'with relaxed target stoichiometry.' write(fates_log(),*) 'I.e., namelist parametre fates_parteh_mode = 2' diff --git a/main/FatesRestartInterfaceMod.F90 b/main/FatesRestartInterfaceMod.F90 index 82de4d9a44..2e0a096ff9 100644 --- a/main/FatesRestartInterfaceMod.F90 +++ b/main/FatesRestartInterfaceMod.F90 @@ -23,7 +23,7 @@ module FatesRestartInterfaceMod use PRTGenericMod, only : store_organ use PRTGenericMod, only : repro_organ use PRTGenericMod, only : struct_organ - use PRTGenericMod, only : prt_instance + use PRTGenericMod, only : prt_global ! CIME GLOBALS @@ -893,15 +893,15 @@ subroutine DefinePRTRestartVars(this,initialize_variables,ivar) character(len=128) :: symbol character(len=256) :: long_name - do i_var = 1, prt_instance%num_vars + do i_var = 1, prt_global%num_vars ! The base symbol name - symbol_base = prt_instance%state_descriptor(i_var)%symbol + symbol_base = prt_global%state_descriptor(i_var)%symbol ! The long name of the variable - name_base = prt_instance%state_descriptor(i_var)%longname + name_base = prt_global%state_descriptor(i_var)%longname - do i_pos = 1, prt_instance%state_descriptor(i_var)%num_pos + do i_pos = 1, prt_global%state_descriptor(i_var)%num_pos ! String describing the physical position of the variable write(pos_symbol, '(I3.3)') i_pos @@ -1223,8 +1223,8 @@ subroutine set_restart_vectors(this,nc,nsites,sites) ! ----------------------------------------------------------------------- ir_prt_var = ir_prt_base - do i_var = 1, prt_instance%num_vars - do i_pos = 1, prt_instance%state_descriptor(i_var)%num_pos + do i_var = 1, prt_global%num_vars + do i_pos = 1, prt_global%state_descriptor(i_var)%num_pos ir_prt_var = ir_prt_var + 1 this%rvars(ir_prt_var)%r81d(io_idx_co) = & @@ -1666,7 +1666,7 @@ subroutine get_restart_vectors(this, nc, nsites, sites) integer :: totalcohorts ! total cohort count on this thread (diagnostic) integer :: patchespersite ! number of patches per site integer :: cohortsperpatch ! number of cohorts per patch - integer :: i_prt_var ! loop counter for var x position + 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 @@ -1792,8 +1792,8 @@ subroutine get_restart_vectors(this, nc, nsites, sites) ! ----------------------------------------------------------------------- ir_prt_var = ir_prt_base - do i_var = 1, prt_instance%num_vars - do i_pos = 1, prt_instance%state_descriptor(i_var)%num_pos + do i_var = 1, prt_global%num_vars + do i_pos = 1, prt_global%state_descriptor(i_var)%num_pos ir_prt_var = ir_prt_var + 1 ccohort%prt%variables(i_var)%val(i_pos) = & diff --git a/parameter_files/fates_params_14pfts.cdl b/parameter_files/fates_params_14pfts.cdl index 3f14d408ae..88b2204f1b 100644 --- a/parameter_files/fates_params_14pfts.cdl +++ b/parameter_files/fates_params_14pfts.cdl @@ -240,17 +240,17 @@ variables: fates_turnover_retrans_mode:units = "index" ; fates_turnover_retrans_mode:long_name = "retranslocation method for leaf/fineroot turnover" ; - float fates_turnover_carb_retrans_p1(fates_prt_organs,fates_pft) ; - fates_turnover_carb_retrans_p1:units = "na" ; - fates_turnover_carb_retrans_p1:long_name = "retranslocation of carbon in turnover, parameter 1" ; + float 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_p1(fates_prt_organs,fates_pft) ; - fates_turnover_nitr_retrans_p1:units = "na" ; - fates_turnover_nitr_retrans_p1:long_name = "retranslocation of nitrogen in turnover, parameter 1" ; + float 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_p1(fates_prt_organs,fates_pft) ; - fates_turnover_phos_retrans_p1:units = "na" ; - fates_turnover_phos_retrans_p1:long_name = "retranslocation of phosphorous in turnover, parameter 1" ; + float 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_c2b(fates_pft) ; fates_c2b:units = "ratio" ; @@ -827,7 +827,7 @@ data: fates_turnover_retrans_mode = 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1; - fates_turnover_carb_retrans_p1 = + fates_turnover_carb_retrans = 0.025, 0.025, 0.025, 0.05, 0.025, 0.05, 0.05, 0.05, 0.025, 0.05, 0.05, 0.05, 0.05, 0.05, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, @@ -836,7 +836,7 @@ data: 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00; - fates_turnover_nitr_retrans_p1 = + fates_turnover_nitr_retrans = _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, @@ -844,7 +844,7 @@ data: _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _; - fates_turnover_phos_retrans_p1 = + fates_turnover_phos_retrans = _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, diff --git a/parameter_files/fates_params_default.cdl b/parameter_files/fates_params_default.cdl index ed1bf71b5a..0984f1c3e0 100644 --- a/parameter_files/fates_params_default.cdl +++ b/parameter_files/fates_params_default.cdl @@ -207,17 +207,17 @@ variables: fates_turnover_retrans_mode:units = "index" ; fates_turnover_retrans_mode:long_name = "retranslocation method for leaf/fineroot turnover" ; - float fates_turnover_carb_retrans_p1(fates_prt_organs,fates_pft) ; - fates_turnover_carb_retrans_p1:units = "na" ; - fates_turnover_carb_retrans_p1:long_name = "retranslocation of carbon in turnover, parameter 1" ; + float 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_p1(fates_prt_organs,fates_pft) ; - fates_turnover_nitr_retrans_p1:units = "na" ; - fates_turnover_nitr_retrans_p1:long_name = "retranslocation of nitrogen in turnover, parameter 1" ; + float 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_p1(fates_prt_organs,fates_pft) ; - fates_turnover_phos_retrans_p1:units = "na" ; - fates_turnover_phos_retrans_p1:long_name = "retranslocation of phosphorous in turnover, parameter 1" ; + float 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 " ; float fates_c2b(fates_pft) ; fates_c2b:units = "ratio" ; @@ -812,7 +812,7 @@ data: fates_turnover_retrans_mode = 1, 1; - fates_turnover_carb_retrans_p1 = + fates_turnover_carb_retrans = 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, @@ -820,7 +820,7 @@ data: 0.00, 0.00, 0.00, 0.00; - fates_turnover_nitr_retrans_p1 = + fates_turnover_nitr_retrans = _, _, _, _, _, _, @@ -828,7 +828,7 @@ data: _, _, _, _; - fates_turnover_phos_retrans_p1 = + fates_turnover_phos_retrans = _, _, _, _, _, _, diff --git a/parteh/PRTAllometricCarbonMod.F90 b/parteh/PRTAllometricCarbonMod.F90 index 48942a1078..517c0e3bdf 100644 --- a/parteh/PRTAllometricCarbonMod.F90 +++ b/parteh/PRTAllometricCarbonMod.F90 @@ -6,12 +6,13 @@ module PRTAllometricCarbonMod ! Plant Allocation and Reactive Transport Extensible Hypotheses (PARTEH) ! CARBON only, allometric growth hypothesis ! - ! Ryan Knox Apr 2018 + ! Adapted from code originally in ED, by Rosie Fisher and Paul Moorcroft + ! This refactor written by : Ryan Knox Apr 2018 ! ! ------------------------------------------------------------------------------------ - use PRTGenericMod , only : prt_instance_type - use PRTGenericMod , only : prt_instance + use PRTGenericMod , only : prt_global_type + use PRTGenericMod , only : prt_global use PRTGenericMod , only : prt_vartype use PRTGenericMod , only : prt_vartypes use PRTGenericMod , only : carbon12_species @@ -110,8 +111,8 @@ module PRTAllometricCarbonMod contains - procedure :: DailyPRT => DailyPRTAC - procedure :: FastPRT => FastPRTAC + procedure :: DailyPRT => DailyPRTAllometricCarbon + procedure :: FastPRT => FastPRTAllometricCarbon end type callom_prt_vartypes @@ -126,17 +127,20 @@ module PRTAllometricCarbonMod ! This is the instance of the mapping table and variable definitions - ! this is only allocated once per node - class(prt_instance_type), public, target, allocatable :: prt_instance_ac + ! this is only allocated once per node. This should be read-only + ! everywhere in the code, except for where it is populated in this init routine + ! below. + class(prt_global_type), protected, target, allocatable :: prt_global_ac - public :: InitPRTInstanceAC + + public :: InitPRTGlobalAllometricCarbon contains - subroutine InitPRTInstanceAC() + subroutine InitPRTGlobalAllometricCarbon() ! ---------------------------------------------------------------------------------- ! Initialize and populate the object that hold the descriptions of the variables, @@ -152,14 +156,14 @@ subroutine InitPRTInstanceAC() ! There are two mapping tables. One mapping table is a 2d array organized ! by organ and species, that contains the variable index: ! - ! prt_instance%sp_organ_map + ! prt_global%sp_organ_map ! ! The other mapping table is similar, but it is a 1D array, a list of the organs. ! And each of these the in turn points to a list of the indices associated ! with that organ. This is useful when you want to do lots of stuff to a specified ! organ. ! - ! prt_instance%organ_map + ! prt_global%organ_map ! ! IMPORTANT NOTE: Once this object is populated, we can use this to properly ! allocate the "prt_vartypes_type" objects that attached to each plant. That process @@ -167,41 +171,41 @@ subroutine InitPRTInstanceAC() ! ! ----------------------------------------------------------------------------------- - allocate(prt_instance_ac) + allocate(prt_global_ac) ! The "state descriptor" object holds things like the names, the symbols, the units ! of each variable. By putting it in an object, we can loop through them when ! doing things like reading/writing history and restarts - allocate(prt_instance_ac%state_descriptor(num_vars)) + allocate(prt_global_ac%state_descriptor(num_vars)) - prt_instance_ac%hyp_name = 'Allometric Carbon Only' + prt_global_ac%hyp_name = 'Allometric Carbon Only' ! Set mapping tables to zero - call prt_instance_ac%ZeroInstance() + call prt_global_ac%ZeroGlobal() ! Register the variables. Each variable must be associated with a global identifier ! for an organ and species. - call prt_instance_ac%InitInstance(leaf_c_id,"Leaf Carbon","leaf_c",leaf_organ,carbon12_species,icd) - call prt_instance_ac%InitInstance(fnrt_c_id,"Fine Root Carbon","fnrt_c",fnrt_organ,carbon12_species,icd) - call prt_instance_ac%InitInstance(sapw_c_id,"Sapwood Carbon","sapw_c",sapw_organ,carbon12_species,icd) - call prt_instance_ac%InitInstance(store_c_id,"Storage Carbon","store_c",store_organ,carbon12_species,icd) - call prt_instance_ac%InitInstance(struct_c_id,"Structural Carbon","struct_c",struct_organ,carbon12_species,icd) - call prt_instance_ac%InitInstance(repro_c_id,"Reproductive Carbon","repro_c",repro_organ,carbon12_species,icd) + call prt_global_ac%RegisterVarInGlobal(leaf_c_id,"Leaf Carbon","leaf_c",leaf_organ,carbon12_species,icd) + call prt_global_ac%RegisterVarInGlobal(fnrt_c_id,"Fine Root Carbon","fnrt_c",fnrt_organ,carbon12_species,icd) + call prt_global_ac%RegisterVarInGlobal(sapw_c_id,"Sapwood Carbon","sapw_c",sapw_organ,carbon12_species,icd) + call prt_global_ac%RegisterVarInGlobal(store_c_id,"Storage Carbon","store_c",store_organ,carbon12_species,icd) + call prt_global_ac%RegisterVarInGlobal(struct_c_id,"Structural Carbon","struct_c",struct_organ,carbon12_species,icd) + call prt_global_ac%RegisterVarInGlobal(repro_c_id,"Reproductive Carbon","repro_c",repro_organ,carbon12_species,icd) ! Set some of the array sizes for input and output boundary conditions - prt_instance_ac%num_bc_in = num_bc_in - prt_instance_ac%num_bc_out = num_bc_out - prt_instance_ac%num_bc_inout = num_bc_inout - prt_instance_ac%num_vars = num_vars + prt_global_ac%num_bc_in = num_bc_in + prt_global_ac%num_bc_out = num_bc_out + prt_global_ac%num_bc_inout = num_bc_inout + prt_global_ac%num_vars = num_vars ! Have the global generic pointer, point to this hypothesis' object - prt_instance => prt_instance_ac + prt_global => prt_global_ac return - end subroutine InitPRTInstanceAC + end subroutine InitPRTGlobalAllometricCarbon ! ===================================================================================== @@ -348,7 +352,7 @@ subroutine DailyPRTAllometricCarbon(this) ! ----------------------------------------------------------------------------------- ! 0. ! Copy the boundary conditions into readable local variables. - ! We don't use pointers for intput only, only in-out + ! We don't use pointers for bc's that ar "in" only, only "in-out" and "out" ! ----------------------------------------------------------------------------------- dbh => this%bc_inout(ac_bc_inout_id_dbh)%rval @@ -449,8 +453,9 @@ subroutine DailyPRTAllometricCarbon(this) if (total_c_demand> nearzero ) then - ! If we are testing b4b, then we pay this even if we don't have the carbon + ! We pay this even if we don't have the carbon ! Just don't pay so much carbon that storage+carbon_balance can't pay for it + leaf_c_flux = min(leaf_c_demand, & max(0.0_r8,(store_c+carbon_balance)* & (leaf_c_demand/total_c_demand))) @@ -629,14 +634,28 @@ subroutine DailyPRTAllometricCarbon(this) grow_store = .true. end if + ! -------------------------------------------------------------------------------- + ! The numerical integration of growth requires that the instantaneous state + ! variables are passed in as an array. We call it "c_pool". + ! ! Initialize the adaptive integrator arrays and flags - ! ----------------------------------------------------------------------------------- + ! -------------------------------------------------------------------------------- + ierr = 1 totalC = carbon_balance nsteps = 0 - c_pool(:) = 0.0_r8 - c_mask(:) = .false. + c_pool(:) = 0.0_r8 ! Zero state variable array + c_mask(:) = .false. ! This mask tells the integrator + ! which indices are active. Its possible + ! that due to fusion, or previous numerical + ! truncation errors, that one of these pools + ! may be larger than its target! We check + ! this, and if true, then we flag that + ! pool to be ignored. c_mask(i) = .false. + ! For grasses, since they don't grow very + ! large and thus won't accumulate such large + ! errors, we always mask as true. c_pool(leaf_c_id) = leaf_c c_pool(fnrt_c_id) = fnrt_c @@ -654,6 +673,11 @@ subroutine DailyPRTAllometricCarbon(this) c_mask(repro_c_id) = .true. ! Always calculate reproduction on growth c_mask(dbh_id) = .true. ! Always increment dbh on growth step + + ! When using the Euler method, we keep things simple. We always try + ! to make the first integration step to span the entirety of the integration + ! window for the independent variable (available carbon) + if(ODESolve == 2) then this%ode_opt_step = totalC end if @@ -668,6 +692,16 @@ subroutine DailyPRTAllometricCarbon(this) elseif(ODESolve == 2) then call Euler(AllomCGrowthDeriv,c_pool,c_mask,deltaC,totalC,intgr_params,c_pool_out) ! step_pass = .true. + + ! When integrating along the allometric curve, we have the luxury of perfect + ! hindsite. Ie, after we have made our step, we can see if the amount + ! of each carbon we have matches the target associated with the new dbh. + ! The following call evaluates how close we are to the allometically defined + ! targets. If we are too far (governed by max_trunc_error), then we + ! pass back the pass/fail flag (step_pass) as false. If false, then + ! we halve the step-size, and then retry. If that step was fine, then + ! we remember the current step size as a good next guess. + call CheckIntegratedAllometries(c_pool_out(dbh_id),ipft,canopy_trim, & c_pool_out(leaf_c_id), c_pool_out(fnrt_c_id), c_pool_out(sapw_c_id), & c_pool_out(store_c_id), c_pool_out(struct_c_id), & @@ -706,7 +740,12 @@ subroutine DailyPRTAllometricCarbon(this) call endrun(msg=errMsg(sourcefile, __LINE__)) end if - ! TotalC should eventually be whittled down to near zero + ! + ! TotalC should eventually be whittled down to near zero. + ! The solvers are not perfect, so we can't expect it to be perfectly zero. + ! Note that calloc_abs_error is 1e-9, which is really small (1 microgram of carbon) + ! yet also six orders of magnitude greater than typical rounding errors (~1e-15). + ! At that point, update the actual states ! -------------------------------------------------------------------------------- if( (totalC < calloc_abs_error) .and. (step_pass) )then @@ -793,10 +832,10 @@ subroutine DailyPRTAllometricCarbon(this) - end associate + end associate - return - end subroutine DailyPRTAC + return + end subroutine DailyPRTAllometricCarbon ! ===================================================================================== @@ -821,7 +860,8 @@ function AllomCGrowthDeriv(c_pools,c_mask,cbalance,intgr_params) result(dCdx) ! parameters into this function - ! Return Value + ! Return Value + ! Change in carbon (each pool) per change in total allocatable carbon (kgC/kgC) real(r8),dimension(lbound(c_pools,dim=1):ubound(c_pools,dim=1)) :: dCdx ! locals @@ -835,14 +875,14 @@ function AllomCGrowthDeriv(c_pools,c_mask,cbalance,intgr_params) result(dCdx) real(r8) :: ct_store ! target storage, dummy var (kgC) real(r8) :: ct_dead ! target structural biomas, dummy var (kgC) real(r8) :: sapw_area ! dummy sapwood area - real(r8) :: ct_dleafdd ! target leaf biomass derivative wrt d, (kgC/cm) - real(r8) :: ct_dfnrtdd ! target fine-root biomass derivative wrt d, (kgC/cm) - real(r8) :: ct_dsapdd ! target sapwood biomass derivative wrt d, (kgC/cm) - real(r8) :: ct_dagwdd ! target AG wood biomass derivative wrt d, (kgC/cm) - real(r8) :: ct_dbgwdd ! target BG wood biomass derivative wrt d, (kgC/cm) - real(r8) :: ct_dstoredd ! target storage biomass derivative wrt d, (kgC/cm) - real(r8) :: ct_ddeaddd ! target structural biomass derivative wrt d, (kgC/cm) - real(r8) :: ct_dtotaldd ! target total (not reproductive) biomass derivative wrt d, (kgC/cm) + real(r8) :: ct_dleafdd ! target leaf biomass derivative wrt diameter, (kgC/cm) + real(r8) :: ct_dfnrtdd ! target fine-root biomass derivative wrt diameter, (kgC/cm) + real(r8) :: ct_dsapdd ! target sapwood biomass derivative wrt diameter, (kgC/cm) + real(r8) :: ct_dagwdd ! target AG wood biomass derivative wrt diameter, (kgC/cm) + real(r8) :: ct_dbgwdd ! target BG wood biomass derivative wrt diameter, (kgC/cm) + real(r8) :: ct_dstoredd ! target storage biomass derivative wrt diameter, (kgC/cm) + real(r8) :: ct_ddeaddd ! target structural biomass derivative wrt diameter, (kgC/cm) + real(r8) :: ct_dtotaldd ! target total (not reproductive) biomass derivative wrt diameter, (kgC/cm) real(r8) :: repro_fraction ! fraction of carbon balance directed towards reproduction (kgC/kgC) @@ -864,11 +904,6 @@ 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)) - if(dbh>huge(dbh)) then - print*,"BIG D IN DERIV:",dbh - stop - end if - call bleaf(dbh,ipft,canopy_trim,ct_leaf,ct_dleafdd) call bfineroot(dbh,ipft,canopy_trim,ct_fnrt,ct_dfnrtdd) call bsap_allom(dbh,ipft,canopy_trim,sapw_area,ct_sap,ct_dsapdd) @@ -1018,7 +1053,7 @@ end subroutine TargetAllometryCheck ! ===================================================================================== - subroutine FastPRTAC(this) + subroutine FastPRTAllometricCarbon(this) implicit none class(callom_prt_vartypes) :: this ! this class @@ -1026,13 +1061,10 @@ subroutine FastPRTAC(this) ! This routine does nothing, because in the carbon only allometric RT model ! we currently don't have any fast-timestep processes ! Think of this as a stub. - - - return - end subroutine FastPRTAC + end subroutine FastPRTAllometricCarbon end module PRTAllometricCarbonMod diff --git a/parteh/PRTGenericMod.F90 b/parteh/PRTGenericMod.F90 index 54a054de6f..0b2aaf7999 100644 --- a/parteh/PRTGenericMod.F90 +++ b/parteh/PRTGenericMod.F90 @@ -5,21 +5,16 @@ module PRTGenericMod ! Extensible Hypotheses (EH) = PARTEH ! ! Non-Specific (Generic) Classes and Functions - ! This contains the base classes for both the variables and the "instance" + ! This contains the base classes for both the variables and the global class ! This also contains science relevent procedures that are agnostic of hypothesis ! such as maintenance turnover and restranslocation. ! - ! Ryan Knox, April 2018 + ! THIS ROUTINE SHOULD NOT HAVE TO BE MODIFIED TO ACCOMODATE NEW HYPOTHESES + ! (in principle ...) ! + ! Ryan Knox, April 2018 ! ------------------------------------------------------------------------------------ - ! ------------------------------------------------------------------------------------ - ! TO-DO: Impose a parameter check function - ! reproduction must be priority 0 in CNP - ! - ! TO-DO: Create a generic mapping table that will list all species - ! of a specific organ of interest. - ! ------------------------------------------------------------------------------------ use FatesConstantsMod, only : r8 => fates_r8 use FatesConstantsMod, only : i4 => fates_int @@ -27,14 +22,11 @@ module PRTGenericMod use FatesConstantsMod, only : calloc_abs_error use FatesGlobals , only : endrun => fates_endrun use FatesGlobals , only : fates_log - use shr_log_mod , only : errMsg => shr_log_errMsg implicit none - logical, parameter :: debug = .true. - integer, parameter :: maxlen_varname = 128 integer, parameter :: maxlen_varsymbol = 32 integer, parameter :: maxlen_varunits = 32 @@ -132,8 +124,22 @@ module PRTGenericMod ! ------------------------------------------------------------------------------------- - ! This is a generic variable type that can be used to describe all - ! species x organ variable combinations. + ! + ! The following is the data structure that holds the state (ie carbon, + ! nutrients, etc) for each pool of each plant. + ! + ! For example, this could be the carbon 12 of the leaf pool; its instantaneous state, + ! and its fluxes. + ! + ! Note also that these are vectors and not scalars, which indicates that there + ! may be more than 1 discrete spatial positions. For instance, there might be multiple + ! leaf layers or something. + ! + ! Since there are many variables, as well as boundary conditions, this object is + ! NESTED in the prt_vartypes (<---- see the "s" at the end?) structure that follows. + ! + ! Each object will have a unique index associated with it, it will also be mapped + ! to a specific organ and species combination. ! ! It is assumed that over the control period (probably 1 day) that ! changes in the current state (val) relative to the value at the start of the @@ -166,7 +172,9 @@ module PRTGenericMod ! ------------------------------------------------------------------------------------- - ! Input boundary conditions + ! Input boundary conditions. These will be allocated as an array for each plant. + ! This type will also be broken into 3 types of boundary conditions: input only, + ! output only, and input-output. ! ------------------------------------------------------------------------------------- type prt_bctype @@ -178,7 +186,8 @@ module PRTGenericMod ! ------------------------------------------------------------------------------------- - ! This generic type defines the object that attaches to the instance of any plant. + ! The following is the object that is directly attached to each plant. + ! ! ie this is the parent object. ! It contains the state variable object: variables ! as well as the boundary condition pointers bc_inout, bc_in and bc_out @@ -194,7 +203,7 @@ module PRTGenericMod type prt_vartypes - type(prt_vartype),allocatable :: variables(:) ! The state variables + 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 @@ -229,11 +238,14 @@ module PRTGenericMod procedure, non_overridable :: CopyPRTVartypes end type prt_vartypes + + + ! ------------------------------------------------------------------------------------- - ! This next section contains the object that describe the mapping for each specific + ! This next section contains the objects that describe the mapping for each specific ! hypothesis. It is also a way to call the descriptions of variables for any ! arbitrary hypothesis. - ! These are things that are generally true, not specific to each plant. + ! These are things that are globally true, not specific to each plant. ! For instance the map just contains the list of variable names, not the values for ! each plant. ! These are not instanced on every plant, they are just instanced once on every model @@ -292,7 +304,7 @@ module PRTGenericMod ! ------------------------------------------------------------------------------------- - type prt_instance_type + type prt_global_type ! Note that index 0 is reserved for "all" or "irrelevant" character(len=maxlen_varname) :: hyp_name @@ -322,13 +334,13 @@ module PRTGenericMod contains - procedure, non_overridable :: ZeroInstance - procedure, non_overridable :: InitInstance + procedure, non_overridable :: ZeroGlobal + procedure, non_overridable :: RegisterVarInGlobal - end type prt_instance_type + end type prt_global_type - type(prt_instance_type),pointer :: prt_instance + type(prt_global_type),pointer :: prt_global contains @@ -337,9 +349,18 @@ module PRTGenericMod ! Module Functions and Subroutines ! ===================================================================================== - subroutine ZeroInstance(this) - - class(prt_instance_type) :: this + + subroutine ZeroGlobal(this) + + + ! This subroutine zero's out the map between variable indexes and the + ! species and organs they are associated with. + ! It also sets the counts of the variables and boundary conditions as + ! a nonsense number that will trigger a fail if they are specified later. + ! This routine must be called + + + class(prt_global_type) :: this integer :: io ! Organ loop counter integer :: is ! Species loop counter @@ -363,13 +384,18 @@ subroutine ZeroInstance(this) this%num_vars = -9 return - end subroutine ZeroInstance + end subroutine ZeroGlobal ! ===================================================================================== - subroutine InitInstance(this, var_id, long_name, symbol, organ_id, spec_id, num_pos) + subroutine RegisterVarInGlobal(this, var_id, long_name, symbol, organ_id, spec_id, num_pos) + + + ! This subroutine is called for each variable that is defined in each specific hypothesis. + ! For instance, this is called six times in the carbon only hypothesis, + ! each time providing names, symbols, associated organs and species for each pool. - class(prt_instance_type) :: this + class(prt_global_type) :: this integer, intent(in) :: var_id character(len=*),intent(in) :: long_name character(len=*),intent(in) :: symbol @@ -377,7 +403,6 @@ subroutine InitInstance(this, var_id, long_name, symbol, organ_id, spec_id, num_ integer, intent(in) :: spec_id integer, intent(in) :: num_pos - ! Set the descriptions and the associated organs/species in the variable's ! own array @@ -399,7 +424,7 @@ subroutine InitInstance(this, var_id, long_name, symbol, organ_id, spec_id, num_ return - end subroutine InitInstance + end subroutine RegisterVarInGlobal ! ===================================================================================== @@ -409,7 +434,11 @@ subroutine InitPRTVartype(this) ! This subroutine should be the first call whenever a prt_vartype object is - ! instantiated. This routine handles the allocation (extended procedure) + ! instantiated. + ! + ! Most likely, this will occur whenever a new plant or cohort is created. + ! + ! This routine handles the allocation (extended procedure) ! and then the initializing of states with bogus information, and then ! the flushing of all boundary conditions to null. @@ -428,8 +457,7 @@ subroutine InitAllocate(this) ! ---------------------------------------------------------------------------------- ! This initialization is called everytime a plant/cohort - ! is newly recruited. This simply sets-up, allocates - ! and sets some initialization values + ! is newly recruited. Like the name implies, we are just allocating space here. ! ---------------------------------------------------------------------------------- class(prt_vartypes) :: this @@ -440,24 +468,24 @@ subroutine InitAllocate(this) ! Allocate the boundar condition arrays and flush them to no-data flags ! ---------------------------------------------------------------------------------- - if(prt_instance%num_bc_in > 0) then - allocate(this%bc_in(prt_instance%num_bc_in)) + if(prt_global%num_bc_in > 0) then + allocate(this%bc_in(prt_global%num_bc_in)) end if - if(prt_instance%num_bc_inout > 0) then - allocate(this%bc_inout(prt_instance%num_bc_inout)) + if(prt_global%num_bc_inout > 0) then + allocate(this%bc_inout(prt_global%num_bc_inout)) end if - if(prt_instance%num_bc_out > 0) then - allocate(this%bc_out(prt_instance%num_bc_out)) + if(prt_global%num_bc_out > 0) then + allocate(this%bc_out(prt_global%num_bc_out)) end if ! Allocate the state variables - allocate(this%variables(prt_instance%num_vars)) + allocate(this%variables(prt_global%num_vars)) - do i_var = 1, prt_instance%num_vars + do i_var = 1, prt_global%num_vars - num_pos = prt_instance%state_descriptor(i_var)%num_pos + num_pos = prt_global%state_descriptor(i_var)%num_pos allocate(this%variables(i_var)%val(num_pos)) allocate(this%variables(i_var)%val0(num_pos)) @@ -475,11 +503,16 @@ end subroutine InitAllocate subroutine InitializeInitialConditions(this) + ! ---------------------------------------------------------------------------------- + ! This routine sets all PARTEH variables to a nonsense value. + ! This ensures that a fail is triggered if a value is not initialized correctly. + ! ---------------------------------------------------------------------------------- + class(prt_vartypes) :: this integer :: i_var ! Variable index - do i_var = 1, prt_instance%num_vars + do i_var = 1, prt_global%num_vars this%variables(i_var)%val(:) = un_initialized this%variables(i_var)%val0(:) = un_initialized this%variables(i_var)%turnover(:) = un_initialized @@ -499,9 +532,14 @@ end subroutine InitializeInitialConditions subroutine CheckInitialConditions(this) - ! This subroutine is called for every variable defined in each specific - ! hypothesis. The global index for the specific hypothesis' variable - ! will be provided as the second argument. + ! This subroutine makes sure that every variable defined + ! in the hypothesis has been given an initial value. + ! + ! This should be called following any blocks where initial + ! conditions are set. In fates, these calls already + ! exist and when new hypotheses are added, they will + ! already be checked if the initial conditions are + ! specified in parallel with the other hypotheses. class(prt_vartypes) :: this @@ -511,7 +549,7 @@ subroutine CheckInitialConditions(this) integer :: i_gorgan ! The global organ id for this variable integer :: i_gspecies ! The global species id for this variable - do i_var = 1, prt_instance%num_vars + do i_var = 1, prt_global%num_vars n_cor_ids = size(this%variables(i_var)%val,1) @@ -519,11 +557,11 @@ subroutine CheckInitialConditions(this) if(this%variables(i_var)%val(i_cor) < check_initialized) then - i_gorgan = prt_instance%state_descriptor(i_var)%organ_id - i_gspecies = prt_instance%state_descriptor(i_var)%spec_id + i_gorgan = prt_global%state_descriptor(i_var)%organ_id + i_gspecies = prt_global%state_descriptor(i_var)%spec_id write(fates_log(),*)'Not all initial conditions for state variables' - write(fates_log(),*)' in PRT hypothesis: ',trim(prt_instance%hyp_name) + write(fates_log(),*)' in PRT hypothesis: ',trim(prt_global%hyp_name) write(fates_log(),*)' were written out.' write(fates_log(),*)' i_var: ',i_var write(fates_log(),*)' i_cor: ',i_cor @@ -585,12 +623,15 @@ end subroutine FlushBCs ! ===================================================================================== subroutine RegisterBCIn(this,bc_id, bc_rval, bc_ival ) - - - ! This subroutine should be called once when PARTEH - ! object that is bound to the plant object is first intantiated. - ! Unless there is some reason the boundary condition pointers - ! are changing. + + ! This routine must be called once for each "input only" boundary condition of each + ! hypothesis. + ! The group of calls only needs to happen once, following InitPRTVartype. + ! Since we use pointers, we don't need to constantly ask for new boundary conditions + ! + ! The only complication to this would occur, if the boundary condition variable + ! that these pointers point to is being disassociated. In that case, one would + ! need to re-register that boundary condition variable. ! Input Arguments @@ -612,12 +653,72 @@ subroutine RegisterBCIn(this,bc_id, bc_rval, bc_ival ) return end subroutine RegisterBCIn + ! ===================================================================================== + + subroutine RegisterBCOut(this,bc_id, bc_rval, bc_ival ) + + + ! This routine is similar to the routine above RegisterBCIn, except this + ! is for registering "output only" boundary conditions. + + + ! Input Arguments + + class(prt_vartypes) :: this + integer,intent(in) :: bc_id + real(r8), optional, intent(inout),target :: bc_rval + integer, optional, intent(inout),target :: bc_ival + + if(present(bc_ival)) then + this%bc_out(bc_id)%ival => bc_ival + end if + + if(present(bc_rval)) then + this%bc_out(bc_id)%rval => bc_rval + end if + + return + end subroutine RegisterBCOut + + ! ===================================================================================== + + subroutine RegisterBCInOut(this,bc_id, bc_rval, bc_ival ) + + + ! This routine is similar to the two routines above, except this + ! is for registering "input-output" boundary conditions. + ! These are conditions that are passed into PARTEH, and are expected + ! to be updated (or not), and passed back to the host (FATES). + + ! Input Arguments + + class(prt_vartypes) :: this + integer,intent(in) :: bc_id + real(r8), optional, intent(inout),target :: bc_rval + integer, optional, intent(inout),target :: bc_ival + + if(present(bc_ival)) then + this%bc_inout(bc_id)%ival => bc_ival + end if + + if(present(bc_rval)) then + this%bc_inout(bc_id)%rval => bc_rval + end if + + return + end subroutine RegisterBCInOut ! ===================================================================================== subroutine CopyPRTVartypes(this, donor_prt_obj) + ! Here we copy over all information from a donor_prt_object into the current PRT + ! object. It is assumed that the current PRT object + ! has already been initialized ( ie. InitAllocate() ) + ! variable val0 is omitted, because it is ephemeral and used only during the + ! allocation process + ! Arguments class(prt_vartypes) :: this class(prt_vartypes), intent(in), pointer :: donor_prt_obj @@ -631,13 +732,7 @@ subroutine CopyPRTVartypes(this, donor_prt_obj) integer :: num_bc_inout integer :: num_bc_out - ! Here we copy over all information from a donor_prt_object into the current PRT - ! object. It is assumed that the current PRT object - ! has already bee initialized ( ie. InitAllocate() ) - ! variable val0 is omitted, because it is ephemeral and used only during the - ! allocation process - - do i_var = 1, prt_instance%num_vars + do i_var = 1, prt_global%num_vars this%variables(i_var)%val(:) = donor_prt_obj%variables(i_var)%val(:) this%variables(i_var)%val0(:) = donor_prt_obj%variables(i_var)%val0(:) this%variables(i_var)%net_art(:) = donor_prt_obj%variables(i_var)%net_art(:) @@ -675,7 +770,7 @@ subroutine WeightedFusePRTVartypes(this,donor_prt_obj, recipient_fuse_weight, po pos_id = 1 end if - do i_var = 1, prt_instance%num_vars + do i_var = 1, prt_global%num_vars this%variables(i_var)%val(pos_id) = recipient_fuse_weight * this%variables(i_var)%val(pos_id) + & (1.0_r8-recipient_fuse_weight) * donor_prt_obj%variables(i_var)%val(pos_id) @@ -705,6 +800,17 @@ end subroutine WeightedFusePRTVartypes subroutine DeallocatePRTVartypes(this) + ! --------------------------------------------------------------------------------- + ! Unfortunately ... all plants must die. It is sad, but when this happens + ! we must also deallocate our memory of them. Man, thats really is sad. Why + ! must we also forget them... Well, anyway, any time a plant/cohort + ! is deallocated, we must also deallocate all this memory bound in the PARTEH + ! data structure. But on the bright side, there will always be new recruits, + ! a new generation, to allocate as well. Life must go on. + ! I suppose since we are recording their life in the history output, in a way + ! we are remembering them. I feel better now. + ! --------------------------------------------------------------------------------- + class(prt_vartypes) :: this integer :: i_var @@ -712,7 +818,7 @@ subroutine DeallocatePRTVartypes(this) ! Check to see if there is any value in these pools? ! SHould not deallocate if there is any carbon left - do i_var = 1, prt_instance%num_vars + do i_var = 1, prt_global%num_vars deallocate(this%variables(i_var)%val) deallocate(this%variables(i_var)%val0) deallocate(this%variables(i_var)%net_art) @@ -736,51 +842,6 @@ subroutine DeallocatePRTVartypes(this) return end subroutine DeallocatePRTVartypes - - ! ===================================================================================== - - subroutine RegisterBCOut(this,bc_id, bc_rval, bc_ival ) - - ! Input Arguments - - class(prt_vartypes) :: this - integer,intent(in) :: bc_id - real(r8), optional, intent(inout),target :: bc_rval - integer, optional, intent(inout),target :: bc_ival - - if(present(bc_ival)) then - this%bc_out(bc_id)%ival => bc_ival - end if - - if(present(bc_rval)) then - this%bc_out(bc_id)%rval => bc_rval - end if - - return - end subroutine RegisterBCOut - - ! ===================================================================================== - - subroutine RegisterBCInOut(this,bc_id, bc_rval, bc_ival ) - - ! Input Arguments - - class(prt_vartypes) :: this - integer,intent(in) :: bc_id - real(r8), optional, intent(inout),target :: bc_rval - integer, optional, intent(inout),target :: bc_ival - - if(present(bc_ival)) then - this%bc_inout(bc_id)%ival => bc_ival - end if - - if(present(bc_rval)) then - this%bc_inout(bc_id)%rval => bc_rval - end if - - return - end subroutine RegisterBCInOut - ! ===================================================================================== @@ -791,13 +852,16 @@ subroutine ZeroRates(this) ! It also sets the initial value to the current state. ! This allows us to make mass conservation checks, where ! val - val0 = net_art + turnover + ! + ! This subroutine is called each day in FATES, which is the control interval + ! that we conserve carbon from the allocation and turnover process. ! --------------------------------------------------------------------------------- class(prt_vartypes) :: this integer :: i_var ! Variable index - do i_var = 1, prt_instance%num_vars + do i_var = 1, prt_global%num_vars this%variables(i_var)%val0(:) = this%variables(i_var)%val(:) this%variables(i_var)%net_art(:) = 0.0_r8 this%variables(i_var)%turnover(:) = 0.0_r8 @@ -810,6 +874,14 @@ end subroutine ZeroRates subroutine CheckMassConservation(this,ipft,position_id) + + ! --------------------------------------------------------------------------------- + ! At any time, the sum of fluxes should equal the difference between val and val0. + ! This routine loops over all variables and ensures this is true. + ! The final argument is any uniqely identifying index that can be used + ! to differentiate where in the call sequence a failure in conservation occurs. + ! --------------------------------------------------------------------------------- + class(prt_vartypes) :: this integer, intent(in) :: ipft integer, intent(in) :: position_id ! Helps to know where @@ -822,10 +894,9 @@ subroutine CheckMassConservation(this,ipft,position_id) real(r8) :: rel_err + do i_var = 1, prt_global%num_vars - do i_var = 1, prt_instance%num_vars - - do i_pos = 1, prt_instance%state_descriptor(i_var)%num_pos + do i_pos = 1, prt_global%state_descriptor(i_var)%num_pos err = abs((this%variables(i_var)%val(i_pos) - this%variables(i_var)%val0(i_pos)) - & (this%variables(i_var)%net_art(i_pos) & @@ -844,11 +915,11 @@ subroutine CheckMassConservation(this,ipft,position_id) write(fates_log(),*) ' always equal the integrated fluxes.' write(fates_log(),*) ' pft id: ',ipft write(fates_log(),*) ' position id: ',position_id - write(fates_log(),*) ' organ id: ',prt_instance%state_descriptor(i_var)%organ_id - write(fates_log(),*) ' species_id: ',prt_instance%state_descriptor(i_var)%spec_id + write(fates_log(),*) ' organ id: ',prt_global%state_descriptor(i_var)%organ_id + write(fates_log(),*) ' species_id: ',prt_global%state_descriptor(i_var)%spec_id write(fates_log(),*) ' position id: ',i_pos - write(fates_log(),*) ' symbol: ',trim(prt_instance%state_descriptor(i_var)%symbol) - write(fates_log(),*) ' longname: ',trim(prt_instance%state_descriptor(i_var)%longname) + write(fates_log(),*) ' symbol: ',trim(prt_global%state_descriptor(i_var)%symbol) + write(fates_log(),*) ' longname: ',trim(prt_global%state_descriptor(i_var)%longname) write(fates_log(),*) ' err: ',err,' max error: ',calloc_abs_error write(fates_log(),*) ' terms: ', this%variables(i_var)%val(i_pos), & this%variables(i_var)%val0(i_pos), & @@ -870,11 +941,12 @@ end subroutine CheckMassConservation function GetState(this, organ_id, species_id, position_id) result(sp_organ_val) ! This function returns the current amount of mass for - ! any combination of organ and species. If a position + ! any combination of organ and species. **IF** a position ! is provided, it will use it, but otherwise, it will sum over ! all dimensions. It also can accomodate all_carbon_species, which ! will return the mass of all carbon isotopes combined. + class(prt_vartypes) :: this integer,intent(in) :: organ_id integer,intent(in) :: species_id @@ -901,18 +973,17 @@ function GetState(this, organ_id, species_id, position_id) result(sp_organ_val) i_pos = position_id do ispec = 1,num_species - i_var = prt_instance%sp_organ_map(organ_id,spec_ids(ispec)) - if(i_var>0) sp_organ_val = sp_organ_val + this%variables(i_var)%val(i_pos) + i_var = prt_global%sp_organ_map(organ_id,spec_ids(ispec)) + if (i_var>0) sp_organ_val = sp_organ_val + this%variables(i_var)%val(i_pos) end do else do ispec = 1,num_species - i_var = prt_instance%sp_organ_map(organ_id,spec_ids(ispec)) + i_var = prt_global%sp_organ_map(organ_id,spec_ids(ispec)) if(i_var>0)then - - do i_pos = 1, prt_instance%state_descriptor(i_var)%num_pos + do i_pos = 1, prt_global%state_descriptor(i_var)%num_pos sp_organ_val = sp_organ_val + this%variables(i_var)%val(i_pos) end do end if @@ -930,9 +1001,11 @@ end function GetState function GetTurnover(this, organ_id, species_id, position_id) result(sp_organ_turnover) - + ! THis function is very similar to GetState, with the only difference that it ! returns the turnover mass so-far during the period of interest. + ! + ! NOTE: THIS HAS NOTHING TO DO WITH SPECIFYING TURNOVER. THIS IS JUST A QUERY FUNCTION class(prt_vartypes) :: this @@ -961,7 +1034,7 @@ function GetTurnover(this, organ_id, species_id, position_id) result(sp_organ_tu i_pos = position_id do ispec = 1,num_species - i_var = prt_instance%sp_organ_map(organ_id,spec_ids(ispec)) + i_var = prt_global%sp_organ_map(organ_id,spec_ids(ispec)) if(i_var>0) sp_organ_turnover = sp_organ_turnover + & this%variables(i_var)%turnover(i_pos) end do @@ -969,9 +1042,9 @@ function GetTurnover(this, organ_id, species_id, position_id) result(sp_organ_tu else do ispec = 1,num_species - i_var = prt_instance%sp_organ_map(organ_id,spec_ids(ispec)) + i_var = prt_global%sp_organ_map(organ_id,spec_ids(ispec)) if(i_var>0) then - do i_pos = 1, prt_instance%state_descriptor(i_var)%num_pos + do i_pos = 1, prt_global%state_descriptor(i_var)%num_pos sp_organ_turnover = sp_organ_turnover + this%variables(i_var)%turnover(i_pos) end do end if @@ -989,6 +1062,8 @@ function GetBurned(this, organ_id, species_id, position_id) result(sp_organ_burn ! THis function is very similar to GetTurnover, with the only difference that it ! returns the turnover mass so-far during the period of interest. + + ! NOTE: THIS HAS NOTHING TO DO WITH SPECIFYING BURNING. THIS IS JUST A QUERY FUNCTION class(prt_vartypes) :: this integer,intent(in) :: organ_id @@ -1016,7 +1091,7 @@ function GetBurned(this, organ_id, species_id, position_id) result(sp_organ_burn i_pos = position_id do ispec = 1,num_species - i_var = prt_instance%sp_organ_map(organ_id,spec_ids(ispec)) + i_var = prt_global%sp_organ_map(organ_id,spec_ids(ispec)) if(i_var>0) sp_organ_burned = sp_organ_burned + & this%variables(i_var)%burned(i_pos) end do @@ -1024,9 +1099,9 @@ function GetBurned(this, organ_id, species_id, position_id) result(sp_organ_burn else do ispec = 1,num_species - i_var = prt_instance%sp_organ_map(organ_id,spec_ids(ispec)) + i_var = prt_global%sp_organ_map(organ_id,spec_ids(ispec)) if(i_var>0) then - do i_pos = 1, prt_instance%state_descriptor(i_var)%num_pos + do i_pos = 1, prt_global%state_descriptor(i_var)%num_pos sp_organ_burned = sp_organ_burned + this%variables(i_var)%burned(i_pos) end do end if @@ -1045,6 +1120,9 @@ function GetNetART(this, organ_id, species_id, position_id) result(sp_organ_neta ! THis function is very similar to GetTurnover, with the only difference that it ! returns the Net changes due to Allocations Reactions and Transport in that pool + ! NOTE: THIS HAS NOTHING TO DO WITH SPECIFYING ALLOCATION/TRANSPORT. + ! THIS IS JUST A QUERY FUNCTION + class(prt_vartypes) :: this integer,intent(in) :: organ_id integer,intent(in) :: species_id @@ -1071,7 +1149,7 @@ function GetNetART(this, organ_id, species_id, position_id) result(sp_organ_neta i_pos = position_id do ispec = 1,num_species - i_var = prt_instance%sp_organ_map(organ_id,spec_ids(ispec)) + i_var = prt_global%sp_organ_map(organ_id,spec_ids(ispec)) if(i_var>0) sp_organ_netart = sp_organ_netart + & this%variables(i_var)%net_art(i_pos) end do @@ -1079,9 +1157,9 @@ function GetNetART(this, organ_id, species_id, position_id) result(sp_organ_neta else do ispec = 1,num_species - i_var = prt_instance%sp_organ_map(organ_id,spec_ids(ispec)) + i_var = prt_global%sp_organ_map(organ_id,spec_ids(ispec)) if(i_var>0) then - do i_pos = 1, prt_instance%state_descriptor(i_var)%num_pos + do i_pos = 1, prt_global%state_descriptor(i_var)%num_pos sp_organ_netart = sp_organ_netart + this%variables(i_var)%net_art(i_pos) end do end if @@ -1097,6 +1175,11 @@ end function GetNetART function GetCoordVal(this, organ_id, species_id ) result(prt_val) + + ! This is support code that may be helpful when we have variables in parteh + ! that have multiple discrete spatial positions. + + class(prt_vartypes) :: this integer,intent(in) :: organ_id integer,intent(in) :: species_id @@ -1163,13 +1246,13 @@ subroutine SetState(prt,organ_id, species_id, state_val, position_id) i_pos = 1 end if - i_var = prt_instance%sp_organ_map(organ_id,species_id) + i_var = prt_global%sp_organ_map(organ_id,species_id) - if(i_pos > prt_instance%state_descriptor(i_var)%num_pos )then + if(i_pos > prt_global%state_descriptor(i_var)%num_pos )then write(fates_log(),*) 'A position index was specified that is' write(fates_log(),*) 'greater than the allocated position space' write(fates_log(),*) ' i_pos: ',i_pos - write(fates_log(),*) ' num_pos: ',prt_instance%state_descriptor(i_var)%num_pos + write(fates_log(),*) ' num_pos: ',prt_global%state_descriptor(i_var)%num_pos call endrun(msg=errMsg(__FILE__, __LINE__)) end if diff --git a/parteh/PRTLossFluxesMod.F90 b/parteh/PRTLossFluxesMod.F90 index 01f38764c7..c33480522d 100644 --- a/parteh/PRTLossFluxesMod.F90 +++ b/parteh/PRTLossFluxesMod.F90 @@ -16,7 +16,7 @@ module PRTLossFluxesMod use PRTGenericMod, only : un_initialized use PRTGenericMod, only : check_initialized use PRTGenericMod, only : num_organ_types - use PRTGenericMod, only : prt_instance + use PRTGenericMod, only : prt_global use FatesInterfaceMod, only : hlm_freq_day use FatesConstantsMod, only : r8 => fates_r8 @@ -32,7 +32,7 @@ module PRTLossFluxesMod private ! ------------------------------------------------------------------------------------- - ! This module hosts two public functions that handle all things + ! This module hosts the public functions that handle all things ! related to loss fluxes. They broadly cover the two types of turnover; ! that which happens as events (storms, deciduous drop, herbivory ! fire, etc), and maintenance turnover (constant background) @@ -106,18 +106,18 @@ subroutine PRTPhenologyFlush(prt, ipft, organ_id, c_store_transfer_frac) end if - associate(organ_map => prt_instance%organ_map) + associate(organ_map => prt_global%organ_map) ! First transfer in carbon ! -------------------------------------------------------------------------------- - i_cvar = prt_instance%sp_organ_map(organ_id,carbon12_species) + i_cvar = prt_global%sp_organ_map(organ_id,carbon12_species) ! Get the variable id of the storage pool for this species (carbon12) - i_store = prt_instance%sp_organ_map(store_organ,carbon12_species) + i_store = prt_global%sp_organ_map(store_organ,carbon12_species) ! Loop over all of the coordinate ids - do i_pos = 1,prt_instance%state_descriptor(i_cvar)%num_pos + do i_pos = 1,prt_global%state_descriptor(i_cvar)%num_pos ! Calculate the mass transferred out of storage into the pool of interest mass_transfer = prt%variables(i_store)%val(i_pos) * c_store_transfer_frac @@ -154,12 +154,12 @@ subroutine PRTPhenologyFlush(prt, ipft, organ_id, c_store_transfer_frac) i_var = organ_map(organ_id)%var_id(i_sp_var) ! Variable index for the species of interest - spec_id = prt_instance%state_descriptor(i_var)%spec_id + spec_id = prt_global%state_descriptor(i_var)%spec_id if ( spec_id .ne. carbon12_species ) then ! Get the variable id of the storage pool for this species - i_store = prt_instance%sp_organ_map(store_organ,spec_id) + i_store = prt_global%sp_organ_map(store_organ,spec_id) ! Calculate the stoichiometry with C for this species @@ -177,7 +177,7 @@ subroutine PRTPhenologyFlush(prt, ipft, organ_id, c_store_transfer_frac) ! Loop over all of the coordinate ids - do i_pos = 1,prt_instance%state_descriptor(i_var)%num_pos + do i_pos = 1,prt_global%state_descriptor(i_var)%num_pos ! The target quanitity for this species is based on the amount ! of carbon @@ -240,7 +240,7 @@ subroutine PRTBurnLosses(prt, organ_id, mass_fraction) real(r8) :: burned_mass ! Burned mass of each species, in eahc ! position, in the organ of interest - associate(organ_map => prt_instance%organ_map) + associate(organ_map => prt_global%organ_map) ! This is the total number of state variables associated ! with this particular organ @@ -251,10 +251,10 @@ subroutine PRTBurnLosses(prt, organ_id, mass_fraction) i_var = organ_map(organ_id)%var_id(i_sp_var) - spec_id = prt_instance%state_descriptor(i_var)%spec_id + spec_id = prt_global%state_descriptor(i_var)%spec_id ! Loop over all of the coordinate ids - do i_pos = 1,prt_instance%state_descriptor(i_var)%num_pos + do i_pos = 1,prt_global%state_descriptor(i_var)%num_pos ! The mass that is leaving the plant burned_mass = mass_fraction * prt%variables(i_var)%val(i_pos) @@ -297,9 +297,9 @@ subroutine PRTReproRelease(prt, organ_id, spec_id, mass_fraction, mass_out) integer :: i_var ! index for the variable of interest - associate(organ_map => prt_instance%organ_map, & - sp_organ_map => prt_instance%sp_organ_map, & - state_descriptor => prt_instance%state_descriptor) + associate(organ_map => prt_global%organ_map, & + sp_organ_map => prt_global%sp_organ_map, & + state_descriptor => prt_global%state_descriptor) ! This is the total number of state variables associated ! with this particular organ. @@ -327,7 +327,7 @@ subroutine PRTReproRelease(prt, organ_id, spec_id, mass_fraction, mass_out) mass_out = 0.0_r8 ! Loop over all of the coordinate ids - do i_pos = 1, prt_instance%state_descriptor(i_var)%num_pos + do i_pos = 1, prt_global%state_descriptor(i_var)%num_pos ! The mass that is leaving the plant mass_out = mass_out + mass_fraction * prt%variables(i_var)%val(i_pos) @@ -421,7 +421,7 @@ subroutine DeciduousTurnoverSimpleRetranslocation(prt,ipft,organ_id,mass_fractio real(r8) :: retranslocated_mass - associate(organ_map => prt_instance%organ_map) + associate(organ_map => prt_global%organ_map) if( (organ_id == store_organ) .or. & (organ_id == struct_organ) .or. & @@ -446,14 +446,14 @@ subroutine DeciduousTurnoverSimpleRetranslocation(prt,ipft,organ_id,mass_fractio i_var = organ_map(organ_id)%var_id(i_sp_var) - spec_id = prt_instance%state_descriptor(i_var)%spec_id + spec_id = prt_global%state_descriptor(i_var)%spec_id if ( any(spec_id == carbon_species) ) then - retrans = EDPftvarcon_inst%turnover_carb_retrans_p1(ipft,organ_id) + retrans = EDPftvarcon_inst%turnover_carb_retrans(ipft,organ_id) else if( spec_id == nitrogen_species ) then - retrans = EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,organ_id) + retrans = EDPftvarcon_inst%turnover_nitr_retrans(ipft,organ_id) else if( spec_id == phosphorous_species ) then - retrans = EDPftvarcon_inst%turnover_phos_retrans_p1(ipft,organ_id) + retrans = EDPftvarcon_inst%turnover_phos_retrans(ipft,organ_id) else write(fates_log(),*) 'Please add a new re-translocation clause to your ' write(fates_log(),*) ' organ x species combination' @@ -463,10 +463,10 @@ subroutine DeciduousTurnoverSimpleRetranslocation(prt,ipft,organ_id,mass_fractio end if ! Get the variable id of the storage pool for this species - store_var_id = prt_instance%sp_organ_map(store_organ,spec_id) + store_var_id = prt_global%sp_organ_map(store_organ,spec_id) ! Loop over all of the coordinate ids - do i_pos = 1, prt_instance%state_descriptor(i_var)%num_pos + do i_pos = 1, prt_global%state_descriptor(i_var)%num_pos ! The mass that is leaving the plant turnover_mass = (1.0_r8 - retrans) * mass_fraction * prt%variables(i_var)%val(i_pos) @@ -600,17 +600,17 @@ subroutine MaintTurnoverSimpleRetranslocation(prt,ipft) base_turnover(repro_organ) = 0.0_r8 - do i_var = 1, prt_instance%num_vars + do i_var = 1, prt_global%num_vars - organ_id = prt_instance%state_descriptor(i_var)%organ_id - spec_id = prt_instance%state_descriptor(i_var)%spec_id + organ_id = prt_global%state_descriptor(i_var)%organ_id + spec_id = prt_global%state_descriptor(i_var)%spec_id if ( any(spec_id == carbon_species) ) then - retrans = EDPftvarcon_inst%turnover_carb_retrans_p1(ipft,organ_id) + retrans = EDPftvarcon_inst%turnover_carb_retrans(ipft,organ_id) else if( spec_id == nitrogen_species ) then - retrans = EDPftvarcon_inst%turnover_nitr_retrans_p1(ipft,organ_id) + retrans = EDPftvarcon_inst%turnover_nitr_retrans(ipft,organ_id) else if( spec_id == phosphorous_species ) then - retrans = EDPftvarcon_inst%turnover_phos_retrans_p1(ipft,organ_id) + retrans = EDPftvarcon_inst%turnover_phos_retrans(ipft,organ_id) else write(fates_log(),*) 'Please add a new re-translocation clause to your ' write(fates_log(),*) ' organ x species combination' @@ -637,7 +637,7 @@ subroutine MaintTurnoverSimpleRetranslocation(prt,ipft) call endrun(msg=errMsg(__FILE__, __LINE__)) end if - do i_pos = 1, prt_instance%state_descriptor(i_var)%num_pos + do i_pos = 1, prt_global%state_descriptor(i_var)%num_pos turnover = (1.0_r8 - retrans) * base_turnover(organ_id) * prt%variables(i_var)%val(i_pos) From a50380a890584ebc167cd8a5513682e74d7a46a5 Mon Sep 17 00:00:00 2001 From: Charles Koven Date: Fri, 24 Aug 2018 14:31:27 -0700 Subject: [PATCH 35/52] added a growth flux history field to track the number of trees growing into a given size class --- biogeochem/EDCohortDynamicsMod.F90 | 10 +++++++++- main/EDTypesMod.F90 | 3 +++ main/FatesHistoryInterfaceMod.F90 | 31 ++++++++++++++++++++++++++++++ 3 files changed, 43 insertions(+), 1 deletion(-) diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index d57000e18f..7ac8ba8e9a 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -241,6 +241,7 @@ subroutine nan_cohort(cc_p) currentCohort%NV = fates_unset_int ! Number of leaf layers: - currentCohort%status_coh = fates_unset_int ! growth status of plant (2 = leaves on , 1 = leaves off) currentCohort%size_class = fates_unset_int ! size class index + currentCohort%size_class_lasttimestep = nan ! size class index (represented as float to accomodate fusion) 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) @@ -391,7 +392,8 @@ subroutine zero_cohort(cc_p) currentCohort%npp_dead = 0._r8 currentCohort%npp_seed = 0._r8 currentCohort%npp_stor = 0._r8 - + currentCohort%size_class = 1 + currentCohort%size_class_lasttimestep = 0._r8 end subroutine zero_cohort !-------------------------------------------------------------------------------------! @@ -732,6 +734,10 @@ subroutine fuse_cohorts(currentSite, currentPatch, bc_in) currentCohort%canopy_layer_yesterday = (currentCohort%n*currentCohort%canopy_layer_yesterday + & nextc%n*nextc%canopy_layer_yesterday)/newn + ! size class the prior timestep, tracked as a real to accomodate fusion + currentCohort%size_class_lasttimestep = (currentCohort%n*currentCohort%size_class_lasttimestep + & + nextc%n*nextc%size_class_lasttimestep)/newn + ! Flux and biophysics variables have not been calculated for recruits we just default to ! their initization values, which should be the same for eahc @@ -1137,6 +1143,7 @@ subroutine copy_cohort( currentCohort,copyc ) n%excl_weight = o%excl_weight n%prom_weight = o%prom_weight n%size_class = o%size_class + n%size_class_lasttimestep = o%size_class_lasttimestep n%size_by_pft_class = o%size_by_pft_class ! CARBON FLUXES @@ -1230,6 +1237,7 @@ subroutine copy_cohort( currentCohort,copyc ) ! indices for binning n%size_class = o%size_class + n%size_class_lasttimestep = o%size_class_lasttimestep n%size_by_pft_class = o%size_by_pft_class !Pointers diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 7d4c2e2841..622337f8bc 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -170,6 +170,9 @@ module EDTypesMod ! type classification. We also maintain this in the main cohort memory ! because we don't want to continually re-calculate the cohort's position when ! performing size diagnostics at high-frequency calls + real(r8) :: size_class_lasttimestep ! size class of the cohort at the end of the previous timestep (used for calculating growth flux) + ! represented as a real so as to accomodate the case where merging leads to a cohort that was + ! fractionally in one size class and fractionally in the other ! CARBON FLUXES diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 7497d53673..a85f0622f8 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -175,6 +175,7 @@ module FatesHistoryInterfaceMod integer, private :: ih_ar_understory_si_scpf integer, private :: ih_ddbh_si_scpf + integer, private :: ih_growthflux_si_scpf integer, private :: ih_ba_si_scpf integer, private :: ih_m1_si_scpf integer, private :: ih_m2_si_scpf @@ -185,6 +186,7 @@ module FatesHistoryInterfaceMod integer, private :: ih_m7_si_scpf integer, private :: ih_m8_si_scpf + integer, private :: ih_ar_si_scpf integer, private :: ih_ar_grow_si_scpf integer, private :: ih_ar_maint_si_scpf @@ -193,6 +195,7 @@ module FatesHistoryInterfaceMod integer, private :: ih_ar_crootm_si_scpf integer, private :: ih_ar_frootm_si_scpf + ! indices to (site x scls) variables integer, private :: ih_ba_si_scls integer, private :: ih_nplant_si_scls @@ -1270,6 +1273,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) use FatesSizeAgeTypeIndicesMod, only : get_agepft_class_index use FatesSizeAgeTypeIndicesMod, only : get_age_class_index use FatesSizeAgeTypeIndicesMod, only : get_height_index + use FatesSizeAgeTypeIndicesMod, only : sizetype_class_index use EDTypesMod , only : nlevleaf use EDParamsMod, only : ED_val_history_height_bin_edges @@ -1387,6 +1391,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_ar_canopy_si_scpf => this%hvars(ih_ar_canopy_si_scpf)%r82d, & hio_ar_understory_si_scpf => this%hvars(ih_ar_understory_si_scpf)%r82d, & hio_ddbh_si_scpf => this%hvars(ih_ddbh_si_scpf)%r82d, & + hio_growthflux_si_scpf => this%hvars(ih_growthflux_si_scpf)%r82d, & hio_ba_si_scpf => this%hvars(ih_ba_si_scpf)%r82d, & hio_nplant_si_scpf => this%hvars(ih_nplant_si_scpf)%r82d, & @@ -1555,6 +1560,8 @@ subroutine update_history_dyn(this,nc,nsites,sites) do while(associated(ccohort)) ft = ccohort%pft + + call sizetype_class_index(ccohort%dbh, ccohort%pft, ccohort%size_class, ccohort%size_by_pft_class) ! Increment the number of cohorts per site hio_ncohorts_si(io_si) = hio_ncohorts_si(io_si) + 1._r8 @@ -1752,6 +1759,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) ! growth increment hio_ddbh_si_scpf(io_si,scpf) = hio_ddbh_si_scpf(io_si,scpf) + & ccohort%ddbhdt*ccohort%n + end if hio_agb_si_scls(io_si,scls) = hio_agb_si_scls(io_si,scls) + & @@ -1974,8 +1982,26 @@ subroutine update_history_dyn(this,nc,nsites,sites) ! ! ccohort%canopy_layer_yesterday = real(ccohort%canopy_layer, r8) + ! + ! growth flux of individuals into a given bin + if ( real(scls, r8) .gt. ccohort%size_class_lasttimestep ) then ! increment the size class counter of this size class bin + hio_growthflux_si_scpf(io_si,scpf) = hio_growthflux_si_scpf(io_si,scpf) + & + (real(scls, r8) - ccohort%size_class_lasttimestep) * ccohort%n * days_per_year + ccohort%size_class_lasttimestep = real(scls, r8) + else if ( real(scls, r8) .lt. ccohort%size_class_lasttimestep ) then ! decrement the counter of the larger size class bin + hio_growthflux_si_scpf(io_si,scpf+1) = hio_growthflux_si_scpf(io_si,scpf+1) + & + (real(scls, r8) - ccohort%size_class_lasttimestep) * ccohort%n * days_per_year + ccohort%size_class_lasttimestep = real(scls, r8) + endif end associate + else ! i.e. cohort%isnew + ! + ! if cohort is new, track its growth flux into the first size bin + i_scpf = (ccohort%pft-1)*nlevsclass+1 + hio_growthflux_si_scpf(io_si,i_scpf) = hio_growthflux_si_scpf(io_si,i_scpf) + ccohort%n * days_per_year + ccohort%size_class_lasttimestep = 1._r8 + ! end if ! resolve some canopy area profiles, both total and of occupied leaves @@ -3744,6 +3770,11 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_ddbh_si_scpf ) + call this%set_history_var(vname='GROWTHFLUX_SCPF', units = 'n/yr/ha', & + long='flux of individuals into a given size class bin via growth and recruitment',use_default='inactive', & + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_growthflux_si_scpf ) + call this%set_history_var(vname='DDBH_CANOPY_SCPF', units = 'cm/yr/ha', & long='diameter growth increment by pft/size',use_default='inactive', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & From 5dce510d531efc195265beee1e5cfe870981f783 Mon Sep 17 00:00:00 2001 From: Charles Koven Date: Mon, 27 Aug 2018 11:25:12 -0700 Subject: [PATCH 36/52] rewrote growthflux calculator to separate real from fusion-induced growth, and traced logic more explicitly for each of those cases --- biogeochem/EDCohortDynamicsMod.F90 | 47 ++++++++++++++++++++++++++---- main/EDInitMod.F90 | 4 +++ main/EDTypesMod.F90 | 5 ++-- main/FatesHistoryInterfaceMod.F90 | 35 +++++++++++++++------- 4 files changed, 71 insertions(+), 20 deletions(-) diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index 7ac8ba8e9a..08fb35c512 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -241,7 +241,7 @@ subroutine nan_cohort(cc_p) currentCohort%NV = fates_unset_int ! Number of leaf layers: - currentCohort%status_coh = fates_unset_int ! growth status of plant (2 = leaves on , 1 = leaves off) currentCohort%size_class = fates_unset_int ! size class index - currentCohort%size_class_lasttimestep = nan ! size class index (represented as float to accomodate fusion) + 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) @@ -393,7 +393,7 @@ subroutine zero_cohort(cc_p) currentCohort%npp_seed = 0._r8 currentCohort%npp_stor = 0._r8 currentCohort%size_class = 1 - currentCohort%size_class_lasttimestep = 0._r8 + currentCohort%size_class_lasttimestep = 0 end subroutine zero_cohort !-------------------------------------------------------------------------------------! @@ -605,6 +605,9 @@ subroutine fuse_cohorts(currentSite, currentPatch, bc_in) real(r8) :: diff real(r8) :: dynamic_fusion_tolerance + integer :: largersc, smallersc, sc_i ! indices for tracking the growth flux caused by fusion + real(r8) :: larger_n, smaller_n + logical, parameter :: FUSE_DEBUG = .false. ! This debug is over-verbose ! and gets its own flag @@ -734,10 +737,42 @@ subroutine fuse_cohorts(currentSite, currentPatch, bc_in) currentCohort%canopy_layer_yesterday = (currentCohort%n*currentCohort%canopy_layer_yesterday + & nextc%n*nextc%canopy_layer_yesterday)/newn - ! size class the prior timestep, tracked as a real to accomodate fusion - currentCohort%size_class_lasttimestep = (currentCohort%n*currentCohort%size_class_lasttimestep + & - nextc%n*nextc%size_class_lasttimestep)/newn - + ! keep track of the size class bins so that we can monitor growth fluxes + ! compare the values. if they are the same, then nothing needs to be done. if not, track the diagnostic flux + if (currentCohort%size_class_lasttimestep .ne. nextc%size_class_lasttimestep ) then + ! + ! keep track of which was which, irresespective of which cohort they were in + if (currentCohort%size_class_lasttimestep .gt. nextc%size_class_lasttimestep) then + largersc = currentCohort%size_class_lasttimestep + smallersc = nextc%size_class_lasttimestep + larger_n = currentCohort%n + smaller_n = nextc%n + else + largersc = nextc%size_class_lasttimestep + smallersc = currentCohort%size_class_lasttimestep + larger_n = nextc%n + smaller_n = currentCohort%n + endif + ! + ! it is possible that fusion has caused cohorts separated by at least two size bin deltas to join. + ! so slightly complicated to keep track of because the resulting cohort could be in one of the old bins or in between + ! structure as a loop to handle the general case + ! + ! first the positive growth case + do sc_i = smallersc + 1, currentCohort%size_class + currentSite%growthflux_fusion(sc_i, currentCohort%pft) = & + currentSite%growthflux_fusion(sc_i, currentCohort%pft) + smaller_n + end do + ! + ! next the negative growth case + do sc_i = currentCohort%size_class + 1, largersc + currentSite%growthflux_fusion(sc_i, currentCohort%pft) = & + currentSite%growthflux_fusion(sc_i, currentCohort%pft) - larger_n + end do + ! now that we've tracked the change flux. reset the memory of the prior timestep + currentCohort%size_class_lasttimestep = currentCohort%size_class + endif + ! Flux and biophysics variables have not been calculated for recruits we just default to ! their initization values, which should be the same for eahc diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index 90068a13b7..94de02c0f4 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -72,6 +72,7 @@ subroutine init_site_vars( site_in ) allocate(site_in%demotion_rate(1:nlevsclass)) allocate(site_in%promotion_rate(1:nlevsclass)) allocate(site_in%imort_rate(1:nlevsclass,1:numpft)) + allocate(site_in%growthflux_fusion(1:nlevsclass,1:numpft)) ! end subroutine init_site_vars @@ -126,6 +127,9 @@ subroutine zero_site( site_in ) site_in%imort_rate(:,:) = 0._r8 site_in%imort_carbonflux = 0._r8 + ! fusoin-induced growth flux of individuals + site_in%growthflux_fusion(:,:) = 0._r8 + ! demotion/promotion info site_in%demotion_rate(:) = 0._r8 site_in%demotion_carbonflux = 0._r8 diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 622337f8bc..fdf14145cd 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -170,9 +170,7 @@ module EDTypesMod ! type classification. We also maintain this in the main cohort memory ! because we don't want to continually re-calculate the cohort's position when ! performing size diagnostics at high-frequency calls - real(r8) :: size_class_lasttimestep ! size class of the cohort at the end of the previous timestep (used for calculating growth flux) - ! represented as a real so as to accomodate the case where merging leads to a cohort that was - ! fractionally in one size class and fractionally in the other + integer :: size_class_lasttimestep ! size class of the cohort at the end of the previous timestep (used for calculating growth flux) ! CARBON FLUXES @@ -599,6 +597,7 @@ module EDTypesMod 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 :: growthflux_fusion(:,:) ! rate of individuals moving into a given size class bin 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] diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index a85f0622f8..24be8b6453 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -176,6 +176,7 @@ module FatesHistoryInterfaceMod 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 @@ -1392,6 +1393,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_ar_understory_si_scpf => this%hvars(ih_ar_understory_si_scpf)%r82d, & hio_ddbh_si_scpf => this%hvars(ih_ddbh_si_scpf)%r82d, & hio_growthflux_si_scpf => this%hvars(ih_growthflux_si_scpf)%r82d, & + hio_growthflux_fusion_si_scpf => this%hvars(ih_growthflux_fusion_si_scpf)%r82d, & hio_ba_si_scpf => this%hvars(ih_ba_si_scpf)%r82d, & hio_nplant_si_scpf => this%hvars(ih_nplant_si_scpf)%r82d, & @@ -1984,23 +1986,23 @@ subroutine update_history_dyn(this,nc,nsites,sites) ccohort%canopy_layer_yesterday = real(ccohort%canopy_layer, r8) ! ! growth flux of individuals into a given bin - if ( real(scls, r8) .gt. ccohort%size_class_lasttimestep ) then ! increment the size class counter of this size class bin - hio_growthflux_si_scpf(io_si,scpf) = hio_growthflux_si_scpf(io_si,scpf) + & - (real(scls, r8) - ccohort%size_class_lasttimestep) * ccohort%n * days_per_year - ccohort%size_class_lasttimestep = real(scls, r8) - else if ( real(scls, r8) .lt. ccohort%size_class_lasttimestep ) then ! decrement the counter of the larger size class bin - hio_growthflux_si_scpf(io_si,scpf+1) = hio_growthflux_si_scpf(io_si,scpf+1) + & - (real(scls, r8) - ccohort%size_class_lasttimestep) * ccohort%n * days_per_year - ccohort%size_class_lasttimestep = real(scls, r8) - endif - + ! track the actual growth here, the virtual growth from fusion lower down + if ( (scls - ccohort%size_class_lasttimestep ) .gt. 0) then + do i_scls = ccohort%size_class_lasttimestep + 1, scls + i_scpf = (ccohort%pft-1)*nlevsclass+i_scls + hio_growthflux_si_scpf(io_si,i_scpf) = hio_growthflux_si_scpf(io_si,i_scpf) + & + ccohort%n * days_per_year + end do + end if + ccohort%size_class_lasttimestep = scls + ! end associate else ! i.e. cohort%isnew ! ! if cohort is new, track its growth flux into the first size bin i_scpf = (ccohort%pft-1)*nlevsclass+1 hio_growthflux_si_scpf(io_si,i_scpf) = hio_growthflux_si_scpf(io_si,i_scpf) + ccohort%n * days_per_year - ccohort%size_class_lasttimestep = 1._r8 + ccohort%size_class_lasttimestep = 1 ! end if @@ -2134,6 +2136,10 @@ subroutine update_history_dyn(this,nc,nsites,sites) iscag = i_scls ! since imort is by definition something that only happens in newly disturbed patches, treat as such hio_mortality_understory_si_scag(io_si,iscag) = hio_mortality_understory_si_scag(io_si,iscag) + & sites(s)%imort_rate(i_scls, i_pft) + ! + ! while in this loop, pass the fusion-induced growth rate flux to history + hio_growthflux_fusion_si_scpf(io_si,i_scpf) = hio_growthflux_fusion_si_scpf(io_si,i_scpf) + & + sites(s)%growthflux_fusion(i_scls, i_pft) * days_per_year end do end do ! @@ -2144,6 +2150,8 @@ subroutine update_history_dyn(this,nc,nsites,sites) sites(s)%terminated_nindivs(:,:,:) = 0._r8 sites(s)%imort_carbonflux = 0._r8 sites(s)%imort_rate(:,:) = 0._r8 + ! + sites(s)%growthflux_fusion(:,:) = 0._r8 ! pass the recruitment rate as a flux to the history, and then reset the recruitment buffer do i_pft = 1, numpft @@ -3775,6 +3783,11 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_growthflux_si_scpf ) + call this%set_history_var(vname='GROWTHFLUX_FUSION_SCPF', units = 'n/yr/ha', & + long='flux of individuals into a given size class bin via fusion',use_default='inactive', & + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_growthflux_fusion_si_scpf ) + call this%set_history_var(vname='DDBH_CANOPY_SCPF', units = 'cm/yr/ha', & long='diameter growth increment by pft/size',use_default='inactive', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & From e2775c2cc068686d35ca2dd60cbe35bc0feae29a Mon Sep 17 00:00:00 2001 From: ckoven Date: Thu, 18 Oct 2018 15:23:26 -0600 Subject: [PATCH 37/52] fixed error in merge commit --- biogeochem/EDCohortDynamicsMod.F90 | 51 ++---------------------------- 1 file changed, 2 insertions(+), 49 deletions(-) diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index aada120b9c..a6b65614ab 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -345,55 +345,6 @@ subroutine zero_cohort(cc_p) currentCohort => cc_p -<<<<<<< HEAD - currentCohort%NV = 0 - currentCohort%status_coh = 0 - currentCohort%rdark = 0._r8 - currentCohort%resp_m = 0._r8 - currentCohort%resp_g = 0._r8 - currentCohort%livestem_mr = 0._r8 - currentCohort%livecroot_mr = 0._r8 - currentCohort%froot_mr = 0._r8 - currentCohort%fire_mort = 0._r8 - currentcohort%npp_acc = 0._r8 - currentcohort%gpp_acc = 0._r8 - currentcohort%resp_acc = 0._r8 - currentcohort%npp_tstep = 0._r8 - currentcohort%gpp_tstep = 0._r8 - currentcohort%resp_tstep = 0._r8 - currentcohort%resp_acc_hold = 0._r8 - currentcohort%leaf_litter = 0._r8 - 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%cfa = 0._r8 - currentcohort%md = 0._r8 - currentcohort%root_md = 0._r8 - currentcohort%leaf_md = 0._r8 - currentcohort%bstore_md = 0._r8 - currentcohort%bsw_md = 0._r8 - currentcohort%bdead_md = 0._r8 - currentcohort%npp_acc_hold = 0._r8 - currentcohort%gpp_acc_hold = 0._r8 - currentcohort%dmort = 0._r8 - currentcohort%g_sb_laweight = 0._r8 - currentcohort%treesai = 0._r8 - currentCohort%lmort_direct = 0._r8 - currentCohort%lmort_infra = 0._r8 - currentCohort%lmort_collateral = 0._r8 - currentCohort%leaf_cost = 0._r8 - currentcohort%excl_weight = 0._r8 - currentcohort%prom_weight = 0._r8 - currentcohort%crownfire_mort = 0._r8 - currentcohort%cambial_mort = 0._r8 - currentCohort%npp_leaf = 0._r8 - currentCohort%npp_fnrt = 0._r8 - currentCohort%npp_sapw = 0._r8 - currentCohort%npp_dead = 0._r8 - currentCohort%npp_seed = 0._r8 - currentCohort%npp_stor = 0._r8 - currentCohort%size_class = 1 - currentCohort%size_class_lasttimestep = 0 currentCohort%NV = 0 currentCohort%status_coh = 0 currentCohort%rdark = 0._r8 @@ -440,6 +391,8 @@ subroutine zero_cohort(cc_p) currentCohort%npp_dead = 0._r8 currentCohort%npp_seed = 0._r8 currentCohort%npp_stor = 0._r8 + currentCohort%size_class = 1 + currentCohort%size_class_lasttimestep = 0 end subroutine zero_cohort From 9bf1ad78e6378bcfb8900464d4fc43f6d6f7fe36 Mon Sep 17 00:00:00 2001 From: Charlie Koven Date: Thu, 18 Oct 2018 14:30:43 -0700 Subject: [PATCH 38/52] Update parteh/PRTGenericMod.F90 --- parteh/PRTGenericMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/parteh/PRTGenericMod.F90 b/parteh/PRTGenericMod.F90 index 0b2aaf7999..8098254522 100644 --- a/parteh/PRTGenericMod.F90 +++ b/parteh/PRTGenericMod.F90 @@ -44,7 +44,7 @@ module PRTGenericMod ! ------------------------------------------------------------------------------------- ! IMPORTANT! ! All species in all organs should be expressed in terms of KILOGRAMS - ! All rates of change are expressed in terms of kilorams / day + ! All rates of change are expressed in terms of kilograms / day ! This assumption cannot be broken! ! ------------------------------------------------------------------------------------- From ba3a24e7c4e74d61a1a15242bb5d11fe61e130ed Mon Sep 17 00:00:00 2001 From: Charlie Koven Date: Thu, 18 Oct 2018 14:32:03 -0700 Subject: [PATCH 39/52] Update parteh/PRTGenericMod.F90 --- parteh/PRTGenericMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/parteh/PRTGenericMod.F90 b/parteh/PRTGenericMod.F90 index 8098254522..107e27312f 100644 --- a/parteh/PRTGenericMod.F90 +++ b/parteh/PRTGenericMod.F90 @@ -1061,7 +1061,7 @@ end function GetTurnover function GetBurned(this, organ_id, species_id, position_id) result(sp_organ_burned) ! THis function is very similar to GetTurnover, with the only difference that it - ! returns the turnover mass so-far during the period of interest. + ! returns the burned mass so-far during the period of interest. ! NOTE: THIS HAS NOTHING TO DO WITH SPECIFYING BURNING. THIS IS JUST A QUERY FUNCTION From a2119adc3e2f4a1115d728bd99ddb89def6d797e Mon Sep 17 00:00:00 2001 From: Charlie Koven Date: Thu, 18 Oct 2018 14:38:09 -0700 Subject: [PATCH 40/52] Update parteh/PRTLossFluxesMod.F90 --- parteh/PRTLossFluxesMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/parteh/PRTLossFluxesMod.F90 b/parteh/PRTLossFluxesMod.F90 index c33480522d..9d001ab97e 100644 --- a/parteh/PRTLossFluxesMod.F90 +++ b/parteh/PRTLossFluxesMod.F90 @@ -50,7 +50,7 @@ module PRTLossFluxesMod ! but it will be called none-the-less). ! ! THIS ROUTINE ONLY DEALS WITH LOSSES OF BIOMASS FROM PLANTS THAT ARE SURVIVING - ! AN EVENT. IF A PLANT DIES, THEN THIS ROUTINE DOES NOT HANDLE ITS FLUXES. It + ! AN EVENT. IF A PLANT DIES, THEN THESE ROUTINES DO NOT HANDLE ITS FLUXES. It ! is however likely that an event like fire will kill a portion of a population, ! and damage the remaining population, these routines will assist in the latter. ! From ee3936465e056f744cbd088b90dfbf1ee7fc68c3 Mon Sep 17 00:00:00 2001 From: Charlie Koven Date: Thu, 18 Oct 2018 14:38:28 -0700 Subject: [PATCH 41/52] Update parteh/PRTAllometricCarbonMod.F90 --- parteh/PRTAllometricCarbonMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/parteh/PRTAllometricCarbonMod.F90 b/parteh/PRTAllometricCarbonMod.F90 index f88fa1f3f5..1d53a13d64 100644 --- a/parteh/PRTAllometricCarbonMod.F90 +++ b/parteh/PRTAllometricCarbonMod.F90 @@ -143,7 +143,7 @@ module PRTAllometricCarbonMod subroutine InitPRTGlobalAllometricCarbon() ! ---------------------------------------------------------------------------------- - ! Initialize and populate the object that hold the descriptions of the variables, + ! Initialize and populate the object that holds the descriptions of the variables, ! and contains the mappings of each variable to the pre-ordained organ ! and species list, and the number of boundary conditions of each 3 types. ! From ad301bc78d169ead58381216f0b72611dc4c6b74 Mon Sep 17 00:00:00 2001 From: jkshuman Date: Thu, 18 Oct 2018 14:50:04 -0700 Subject: [PATCH 42/52] Update biogeochem/EDPatchDynamicsMod.F90 --- biogeochem/EDPatchDynamicsMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 1c31b1437f..56582f5e9d 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -881,7 +881,7 @@ subroutine fire_litter_fluxes(currentSite, cp_target, new_patch_target, patch_si 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 grass. KgC/individual/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] From ef87e48e035720f8535d90993d7e5ca3e93e57d3 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 18 Oct 2018 16:55:36 -0700 Subject: [PATCH 43/52] More updates to comments and variable naming conventions, like bl -> leaf_c --- biogeochem/EDPhysiologyMod.F90 | 44 +++++++++--------- biogeochem/FatesAllometryMod.F90 | 18 +++---- parteh/PRTGenericMod.F90 | 41 +++++++++------- parteh/PRTLossFluxesMod.F90 | 80 +++++++++++++++++--------------- 4 files changed, 97 insertions(+), 86 deletions(-) diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 7bcecb848a..444c111833 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -208,28 +208,28 @@ subroutine trim_canopy( currentSite ) type (ed_cohort_type) , pointer :: currentCohort type (ed_patch_type) , pointer :: currentPatch - integer :: z ! leaf layer - integer :: ipft ! pft index - logical :: trimmed ! was this layer trimmed in this year? If not expand the canopy. - real(r8) :: tar_bl ! target leaf biomass (leaves flushed, trimmed) - real(r8) :: tar_bfr ! target fine-root biomass (leaves flushed, trimmed) - real(r8) :: bfr_per_bleaf ! ratio of fine root per leaf biomass - real(r8) :: sla_levleaf ! sla at leaf level z - real(r8) :: nscaler_levleaf ! nscaler value at leaf level z - integer :: cl ! canopy layer index - 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] - real(r8) :: leaf_inc ! LAI-only portion of the vegetation increment of dinc_ed - real(r8) :: lai_canopy_above ! the LAI in the canopy layers above the layer of interest - real(r8) :: lai_layers_above ! the LAI in the leaf layers, within the current canopy, - ! above the leaf layer of interest - 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 + integer :: z ! leaf layer + integer :: ipft ! pft index + logical :: trimmed ! was this layer trimmed in this year? If not expand the canopy. + real(r8) :: tar_bl ! target leaf biomass (leaves flushed, trimmed) + real(r8) :: tar_bfr ! target fine-root biomass (leaves flushed, trimmed) + real(r8) :: bfr_per_bleaf ! ratio of fine root per leaf biomass + real(r8) :: sla_levleaf ! sla at leaf level z + real(r8) :: nscaler_levleaf ! nscaler value at leaf level z + integer :: cl ! canopy layer index + 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] + real(r8) :: leaf_inc ! LAI-only portion of the vegetation increment of dinc_ed + real(r8) :: lai_canopy_above ! the LAI in the canopy layers above the layer of interest + real(r8) :: lai_layers_above ! the LAI in the leaf layers, within the current canopy, + ! above the leaf layer of interest + 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 !---------------------------------------------------------------------- diff --git a/biogeochem/FatesAllometryMod.F90 b/biogeochem/FatesAllometryMod.F90 index 3f011b98c0..16938889d1 100644 --- a/biogeochem/FatesAllometryMod.F90 +++ b/biogeochem/FatesAllometryMod.F90 @@ -548,7 +548,7 @@ end subroutine storage_fraction_of_target ! ===================================================================================== - real(r8) function tree_lai( bl, pft, c_area, nplant, cl, canopy_lai) + real(r8) function tree_lai( leaf_c, pft, c_area, nplant, cl, canopy_lai) ! ----------------------------------------------------------------------------------- ! LAI of individual trees is a function of the total leaf area and the total @@ -556,8 +556,8 @@ real(r8) function tree_lai( bl, pft, c_area, nplant, cl, canopy_lai) ! ---------------------------------------------------------------------------------- ! !ARGUMENTS - real(r8), intent(in) :: bl ! plant leaf biomass [kg] - integer, intent(in) :: pft + real(r8), intent(in) :: leaf_c ! plant leaf carbon [kg] + integer, intent(in) :: pft ! Plant Functional Type index real(r8), intent(in) :: c_area ! areal extent of canopy (m2) real(r8), intent(in) :: nplant ! number of individuals in cohort per ha integer, intent(in) :: cl ! canopy layer index @@ -579,15 +579,15 @@ real(r8) function tree_lai( bl, pft, c_area, nplant, cl, canopy_lai) ! tree_lai function !---------------------------------------------------------------------- - if( bl < 0._r8 .or. pft == 0 ) then - ! This message was signalling many times - ! because of cases where leaf biomass is a negative that is - ! within reasonable precision of 0 (ie -1e-19) - ! write(fates_log(),*) 'problem in treelai',bl,pft + if( leaf_c < -1.1_r8*calloc_abs_error .or. pft == 0 ) then + write(fates_log(),*) 'negative leaf carbon in LAI calculation?' + write(fates_log(),*) 'or.. pft was zero?' + write(fates_log(),*) 'problem in treelai',leaf_c,pft + call endrun(msg=errMsg(sourcefile, __LINE__)) endif slat = g_per_kg * EDPftvarcon_inst%slatop(pft) ! m2/g to m2/kg - leafc_per_unitarea = bl/(c_area/nplant) !KgC/m2 + leafc_per_unitarea = leaf_c/(c_area/nplant) !KgC/m2 if(leafc_per_unitarea > 0.0_r8)then diff --git a/parteh/PRTGenericMod.F90 b/parteh/PRTGenericMod.F90 index 107e27312f..1c7ec9124a 100644 --- a/parteh/PRTGenericMod.F90 +++ b/parteh/PRTGenericMod.F90 @@ -32,7 +32,6 @@ module PRTGenericMod integer, parameter :: maxlen_varunits = 32 integer, parameter :: len_baseunit = 6 - ! SEND THESE TO CONSTANTS ! We use this parameter as the value for which we set un-initialized values real(r8), parameter :: un_initialized = -9.9e32_r8 @@ -81,11 +80,14 @@ module PRTGenericMod ! to the species that are acknowledged in the calling model ! ------------------------------------------------------------------------------------- - integer, parameter :: num_species_types = 17 ! Total number of unique species - ! curently recognized by PARTEH - ! should be max index in list below + integer, parameter :: num_species_types = 6 ! Total number of unique species + ! curently recognized by PARTEH + ! should be max index in list below - ! The following list of unique public indices should be monotonic, and self-explanatory + ! The following list are the unique indices associated with the + ! species used in each hypothesis. Note these are just POTENTIAL + ! species. At the time of writing this, we are very far away from + ! creating allocation schemes that even use potassium. integer, parameter :: all_carbon_species = 0 integer, parameter :: carbon12_species = 1 @@ -94,17 +96,22 @@ module PRTGenericMod integer, parameter :: nitrogen_species = 4 integer, parameter :: phosphorous_species = 5 integer, parameter :: potassium_species = 6 - integer, parameter :: calcium_species = 7 - integer, parameter :: magnesium_species = 8 - integer, parameter :: sulfur_species = 9 - integer, parameter :: chlorine_species = 10 - integer, parameter :: iron_species = 11 - integer, parameter :: manganese_species = 12 - integer, parameter :: zinc_species = 13 - integer, parameter :: copper_species = 14 - integer, parameter :: boron_species = 15 - integer, parameter :: molybdenum_species = 16 - integer, parameter :: nickel_species = 17 + + ! The following species 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_species = 7 + ! integer, parameter :: magnesium_species = 8 + ! integer, parameter :: sulfur_species = 9 + ! integer, parameter :: chlorine_species = 10 + ! integer, parameter :: iron_species = 11 + ! integer, parameter :: manganese_species = 12 + ! integer, parameter :: zinc_species = 13 + ! integer, parameter :: copper_species = 14 + ! integer, parameter :: boron_species = 15 + ! integer, parameter :: molybdenum_species = 16 + ! integer, parameter :: nickel_species = 17 ! We have some lists of species or lists of organs, such as @@ -119,7 +126,7 @@ module PRTGenericMod ! List of all carbon species, the special index "all_carbon_species" ! implies the following list of carbon organs - integer, parameter, dimension(3) :: carbon_species = & + integer, parameter, dimension(3) :: carbon_species_list = & [carbon12_species, carbon13_species, carbon14_species] diff --git a/parteh/PRTLossFluxesMod.F90 b/parteh/PRTLossFluxesMod.F90 index 9d001ab97e..43d5bc9b24 100644 --- a/parteh/PRTLossFluxesMod.F90 +++ b/parteh/PRTLossFluxesMod.F90 @@ -9,7 +9,7 @@ module PRTLossFluxesMod use PRTGenericMod, only : repro_organ use PRTGenericMod, only : struct_organ use PRTGenericMod, only : all_carbon_species - use PRTGenericMod, only : carbon_species ! This is a vector + use PRTGenericMod, only : carbon_species_list use PRTGenericMod, only : carbon12_species use PRTGenericMod, only : nitrogen_species use PRTGenericMod, only : phosphorous_species @@ -32,7 +32,7 @@ module PRTLossFluxesMod private ! ------------------------------------------------------------------------------------- - ! This module hosts the public functions that handle all things + ! These modules house the public functions that handle all things ! related to loss fluxes. They broadly cover the two types of turnover; ! that which happens as events (storms, deciduous drop, herbivory ! fire, etc), and maintenance turnover (constant background) @@ -42,12 +42,12 @@ module PRTLossFluxesMod ! Retranslocation is handled by a single ! flag that defines the mode for each PFT. So there ! are assumptions here. A deciduous plant does not - ! have maintenance leaf and fine-root turnover, and vice - ! versa. Therefore, the retranslocation parameter - ! will have different meanings potentially, for each PFT. - ! - ! Branchfall occurs for each PFT (it may be at a reduced rate, - ! but it will be called none-the-less). + ! have maintenance leaf and fine-root turnover. An evergreen + ! plant does not have seasonal or stress induced phenology. + ! Therefore, the retranslocation parameter + ! will have different meanings potentially, for each PFT. For evergreens, + ! it will be the retranslocation during maintenance turnover. For deciduous, + ! it is during leaf drop. ! ! THIS ROUTINE ONLY DEALS WITH LOSSES OF BIOMASS FROM PLANTS THAT ARE SURVIVING ! AN EVENT. IF A PLANT DIES, THEN THESE ROUTINES DO NOT HANDLE ITS FLUXES. It @@ -68,9 +68,11 @@ module PRTLossFluxesMod subroutine PRTPhenologyFlush(prt, ipft, organ_id, c_store_transfer_frac) + ! ---------------------------------------------------------------------------------- ! This subroutine is used to flush (leaves) from storage upon bud-burst. ! Leaves are somewhat implied here, but the function does allow for other ! pools (fine-roots) to be flushed from storage as well. + ! ---------------------------------------------------------------------------------- class(prt_vartypes) :: prt integer,intent(in) :: ipft @@ -211,8 +213,6 @@ subroutine PRTPhenologyFlush(prt, ipft, organ_id, c_store_transfer_frac) end do - - end associate return end subroutine PRTPhenologyFlush @@ -221,12 +221,14 @@ end subroutine PRTPhenologyFlush subroutine PRTBurnLosses(prt, organ_id, mass_fraction) + ! ---------------------------------------------------------------------------------- ! This subroutine assumes that there is no re-translocation associated ! with burn. There is only one destiny for burned mass within ! the organ, and that is outside the plant. ! It is also assumed that non PARTEH parts of the code (ie the fire-model) ! will decide what to do with the burned mass (i.e. sent it to the litter ! pool or send to atmosphere, or.. other?) + ! ---------------------------------------------------------------------------------- class(prt_vartypes) :: prt integer,intent(in) :: organ_id @@ -272,20 +274,22 @@ subroutine PRTBurnLosses(prt, organ_id, mass_fraction) end do end associate - end subroutine PRTBurnLosses + end subroutine PRTBurnLosses - ! ===================================================================================== + ! ===================================================================================== - subroutine PRTReproRelease(prt, organ_id, spec_id, mass_fraction, mass_out) + subroutine PRTReproRelease(prt, organ_id, spec_id, mass_fraction, mass_out) + ! ---------------------------------------------------------------------------------- ! This subroutine assumes that there is no re-translocation associated ! with the release of reproductive tissues. ! We also do not have a special flux for the release of reproductive ! tissues. To not confuse this with turnover, we will provide an output ! mass flux, and instead of tracking it, we will just set val0 to val ! to prevent mass imbalances. + ! ---------------------------------------------------------------------------------- class(prt_vartypes) :: prt integer,intent(in) :: organ_id @@ -341,25 +345,27 @@ subroutine PRTReproRelease(prt, organ_id, spec_id, mass_fraction, mass_out) prt%variables(i_var)%val0(i_pos) = prt%variables(i_var)%val(i_pos) - & prt%variables(i_var)%net_art(i_pos) - + end do end associate - end subroutine PRTReproRelease + end subroutine PRTReproRelease - ! =================================================================================== + ! =================================================================================== - subroutine PRTDeciduousTurnover(prt,ipft,organ_id,mass_fraction) + subroutine PRTDeciduousTurnover(prt,ipft,organ_id,mass_fraction) ! --------------------------------------------------------------------------------- ! Generic subroutine (wrapper) calling specialized routines handling ! the turnover of tissues in living plants (non-mortal) ! --------------------------------------------------------------------------------- + class(prt_vartypes) :: prt integer,intent(in) :: ipft - integer,intent(in) :: organ_id - real(r8),intent(in) :: mass_fraction + integer,intent(in) :: organ_id ! see PRTGenericMod for organ list + real(r8),intent(in) :: mass_fraction ! The fraction of mass in this organ that should + ! leave the indicated organ. ! We currently only allow the flushing and drop of leaves. ! If other organs should be desired (like seasonality of fine-roots) @@ -405,20 +411,21 @@ subroutine DeciduousTurnoverSimpleRetranslocation(prt,ipft,organ_id,mass_fractio class(prt_vartypes) :: prt integer,intent(in) :: ipft - integer,intent(in) :: organ_id - real(r8),intent(in) :: mass_fraction - - integer :: i_var ! index for the variable of interest - integer :: i_sp_var ! loop counter for all species in this organ - - integer :: num_sp_vars ! Loop size for iterating over all species - ! in the organ that is turning over - integer :: spec_id ! Species id of the turnover pool - integer :: store_var_id ! Variable id of the storage pool - integer :: i_pos ! position index (spatial) - real(r8) :: retrans ! retranslocated fraction - real(r8) :: turnover_mass - real(r8) :: retranslocated_mass + integer,intent(in) :: organ_id ! see PRTGenericMod for organ list + real(r8),intent(in) :: mass_fraction ! The fraction of mass in this organ that should + ! leave the indicated organ. + + integer :: i_var ! index for the variable of interest + integer :: i_sp_var ! loop counter for all species in this organ + + integer :: num_sp_vars ! Loop size for iterating over all species + ! in the organ that is turning over + integer :: spec_id ! Species id of the turnover pool + integer :: store_var_id ! Variable id of the storage pool + integer :: i_pos ! position index (spatial) + real(r8) :: retrans ! retranslocated fraction + real(r8) :: turnover_mass ! mass sent to turnover (leaves the plant) + real(r8) :: retranslocated_mass ! mass redistributed to storage associate(organ_map => prt_global%organ_map) @@ -435,20 +442,17 @@ subroutine DeciduousTurnoverSimpleRetranslocation(prt,ipft,organ_id,mass_fractio end if - - ! This is the total number of state variables associated ! with this particular organ num_sp_vars = organ_map(organ_id)%num_vars - do i_sp_var = 1, num_sp_vars i_var = organ_map(organ_id)%var_id(i_sp_var) spec_id = prt_global%state_descriptor(i_var)%spec_id - if ( any(spec_id == carbon_species) ) then + if ( any(spec_id == carbon_species_list) ) then retrans = EDPftvarcon_inst%turnover_carb_retrans(ipft,organ_id) else if( spec_id == nitrogen_species ) then retrans = EDPftvarcon_inst%turnover_nitr_retrans(ipft,organ_id) @@ -605,7 +609,7 @@ subroutine MaintTurnoverSimpleRetranslocation(prt,ipft) organ_id = prt_global%state_descriptor(i_var)%organ_id spec_id = prt_global%state_descriptor(i_var)%spec_id - if ( any(spec_id == carbon_species) ) then + if ( any(spec_id == carbon_species_list) ) then retrans = EDPftvarcon_inst%turnover_carb_retrans(ipft,organ_id) else if( spec_id == nitrogen_species ) then retrans = EDPftvarcon_inst%turnover_nitr_retrans(ipft,organ_id) From a2dd80d735adb0c31271c5941e47fc56c135e43b Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 18 Oct 2018 18:20:31 -0700 Subject: [PATCH 44/52] unified the grperc parameters, only grperc is used in the parameter file now. --- biogeochem/FatesAllometryMod.F90 | 1 + main/EDPftvarcon.F90 | 70 ++++++++++++++++-------- parameter_files/fates_params_14pfts.cdl | 13 ----- parameter_files/fates_params_default.cdl | 12 ---- parteh/PRTGenericMod.F90 | 8 +-- 5 files changed, 53 insertions(+), 51 deletions(-) diff --git a/biogeochem/FatesAllometryMod.F90 b/biogeochem/FatesAllometryMod.F90 index 16938889d1..81881a190a 100644 --- a/biogeochem/FatesAllometryMod.F90 +++ b/biogeochem/FatesAllometryMod.F90 @@ -89,6 +89,7 @@ module FatesAllometryMod use FatesConstantsMod, only : g_per_kg use FatesConstantsMod, only : cm2_per_m2 use FatesConstantsMod, only : kg_per_Megag + use FatesConstantsMod, only : calloc_abs_error use shr_log_mod , only : errMsg => shr_log_errMsg use FatesGlobals , only : fates_log use FatesGlobals , only : endrun => fates_endrun diff --git a/main/EDPftvarcon.F90 b/main/EDPftvarcon.F90 index 7c429ed76f..161f0b7558 100644 --- a/main/EDPftvarcon.F90 +++ b/main/EDPftvarcon.F90 @@ -14,6 +14,7 @@ module EDPftvarcon use PRTGenericMod, only : prt_cnp_flex_allom_hyp use PRTGenericMod, only : prt_carbon_allom_hyp + use PRTGenericMod, only : num_organ_types use PRTGenericMod, only : leaf_organ, fnrt_organ, store_organ use PRTGenericMod, only : sapw_organ, struct_organ, repro_organ @@ -75,8 +76,7 @@ module EDPftvarcon real(r8), allocatable :: vcmax25top(:) real(r8), allocatable :: smpso(:) real(r8), allocatable :: smpsc(:) - real(r8), allocatable :: grperc(:) ! Growth respiration per unit Carbon gained - ! ONLY parteh_mode == 1 [kg/kg] + real(r8), allocatable :: maintresp_reduction_curvature(:) ! curvature of MR reduction as f(carbon storage), ! 1=linear, 0=very curved real(r8), allocatable :: maintresp_reduction_intercept(:) ! intercept of MR reduction as f(carbon storage), @@ -163,12 +163,25 @@ module EDPftvarcon ! Plant Reactive Transport (allocation) - real(r8), allocatable :: prt_unit_gr_resp(:,:) ! Unit growth respiration (pft x organ) [kgC/kgC] - 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_alloc_priority(:,:) ! Allocation priority for each organ (pft x organ) [integer 0-6] + real(r8), allocatable :: grperc(:) ! Growth respiration per unit Carbon gained + ! One value for whole plant + ! ONLY parteh_mode == 1 [kg/kg] + + real(r8), allocatable :: prt_grperc_organ(:,:) ! Unit growth respiration (pft x organ) [kg/kg] + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! THIS IS NOT READ IN BY THE PARAMETER FILE + ! THIS IS JUST FILLED BY GRPERC. WE KEEP THIS + ! PARAMETER FOR HYPOTHESIS TESTING (ADVANCED USE) + ! IT HAS THE PRT_ TAG BECAUSE THIS PARAMETER + ! IS USED INSIDE PARTEH, WHILE GRPERC IS APPLIED + ! IN THE LEAF BIOPHYSICS SCHEME + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + 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_alloc_priority(:,:) ! Allocation priority for each organ (pft x organ) [integer 0-6] ! Turnover related things @@ -1389,10 +1402,6 @@ subroutine Register_PFT_prt_organs(this, fates_params) dim_names(1) = dimension_name_pft dim_names(2) = dimension_name_prt_organs - name = 'fates_prt_unit_gr_resp' - call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_2d, & - dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'fates_prt_nitr_stoich_p1' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_2d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) @@ -1442,10 +1451,6 @@ subroutine Receive_PFT_prt_organs(this, fates_params) character(len=param_string_length) :: name - name = 'fates_prt_unit_gr_resp' - call fates_params%RetreiveParameterAllocate(name=name, & - data=this%prt_unit_gr_resp) - name = 'fates_prt_nitr_stoich_p1' call fates_params%RetreiveParameterAllocate(name=name, & data=this%prt_nitr_stoich_p1) @@ -1732,7 +1737,7 @@ subroutine FatesReportPFTParams(is_master) write(fates_log(),fmt0) 'prt_nitr_stoich_p2 = ',EDPftvarcon_inst%prt_nitr_stoich_p2 write(fates_log(),fmt0) 'prt_phos_stoich_p1 = ',EDPftvarcon_inst%prt_phos_stoich_p1 write(fates_log(),fmt0) 'prt_phos_stoich_p2 = ',EDPftvarcon_inst%prt_phos_stoich_p2 - write(fates_log(),fmt0) 'prt_unit_gr_resp = ',EDPftvarcon_inst%prt_unit_gr_resp + write(fates_log(),fmt0) 'prt_grperc_organ = ',EDPftvarcon_inst%prt_grperc_organ write(fates_log(),fmt0) 'prt_alloc_priority = ',EDPftvarcon_inst%prt_alloc_priority write(fates_log(),fmt0) 'turnover_carb_retrans = ',EDPftvarcon_inst%turnover_carb_retrans @@ -1767,13 +1772,23 @@ subroutine FatesCheckParams(is_master, parteh_mode) character(len=32),parameter :: fmt0 = '(a,100(F12.4,1X))' - integer :: npft,ipft + integer :: npft ! number of PFTs + integer :: ipft ! pft index + integer :: norgans ! size of the plant organ dimension npft = size(EDPftvarcon_inst%pft_used,1) + ! Prior to performing checks copy grperc to the + ! organ dimensioned version - if(.not.is_master) return + norgans = size(EDPftvarcon_inst%prt_nitr_stoich_p1,2) + allocate(EDPftvarcon_inst%prt_grperc_organ(npft,norgans)) + do ipft = 1,npft + EDPftvarcon_inst%prt_grperc_organ(ipft,1:norgans) = EDPftvarcon_inst%grperc(ipft) + end do + + if(.not.is_master) return if (parteh_mode .eq. prt_cnp_flex_allom_hyp) then write(fates_log(),*) 'FATES Plant Allocation and Reactive Transport' @@ -1791,6 +1806,17 @@ subroutine FatesCheckParams(is_master, parteh_mode) call endrun(msg=errMsg(sourcefile, __LINE__)) end if + + if (norgans .ne. num_organ_types) then + write(fates_log(),*) 'The size of the organ dimension for PRT parameters' + write(fates_log(),*) 'as specified in the parameter file is incompatible.' + write(fates_log(),*) 'All currently acceptable hypothesese are using' + write(fates_log(),*) 'the full set of num_organ_types = ',num_organ_types + write(fates_log(),*) 'The parameter file listed ',norgans + write(fates_log(),*) 'Exiting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + do ipft = 1,npft @@ -2074,10 +2100,10 @@ subroutine FatesCheckParams(is_master, parteh_mode) call endrun(msg=errMsg(sourcefile, __LINE__)) end if elseif(parteh_mode .eq. prt_cnp_flex_allom_hyp) then - if ( ( any(EDPftvarcon_inst%prt_unit_gr_resp(ipft,:) < 0.0_r8)) .or. & - ( any(EDPftvarcon_inst%prt_unit_gr_resp(ipft,:) >= 1.0_r8)) ) then + if ( ( any(EDPftvarcon_inst%prt_grperc_organ(ipft,:) < 0.0_r8)) .or. & + ( any(EDPftvarcon_inst%prt_grperc_organ(ipft,:) >= 1.0_r8)) ) then write(fates_log(),*) ' PFT#: ',ipft - write(fates_log(),*) ' Growth respiration must be between 0 and 1: ',EDPftvarcon_inst%prt_unit_gr_resp(ipft,:) + write(fates_log(),*) ' Growth respiration must be between 0 and 1: ',EDPftvarcon_inst%prt_grperc_organ(ipft,:) write(fates_log(),*) ' Aborting' call endrun(msg=errMsg(sourcefile, __LINE__)) end if diff --git a/parameter_files/fates_params_14pfts.cdl b/parameter_files/fates_params_14pfts.cdl index 88b2204f1b..e0caf701d2 100644 --- a/parameter_files/fates_params_14pfts.cdl +++ b/parameter_files/fates_params_14pfts.cdl @@ -208,10 +208,6 @@ variables: fates_branch_turnover:units = "yr-1" ; fates_branch_turnover:long_name = "turnover time of branches" ; - float fates_prt_unit_gr_resp(fates_prt_organs,fates_pft) ; - fates_prt_unit_gr_resp:units = "gC/gC" ; - fates_prt_unit_gr_resp:long_name = "Unit growth respiration rate per organ" ; - float 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" ; @@ -772,15 +768,6 @@ data: fates_branch_turnover = 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 0, 0, 0 ; - fates_prt_unit_gr_resp = - 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, - 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, - 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, - 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, - 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, - 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11; - - fates_prt_nitr_stoich_p1 = 0.033, 0.029, 0.025, 0.04, 0.033, 0.04, 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, 0.024, 0.024, diff --git a/parameter_files/fates_params_default.cdl b/parameter_files/fates_params_default.cdl index 0984f1c3e0..30a335707a 100644 --- a/parameter_files/fates_params_default.cdl +++ b/parameter_files/fates_params_default.cdl @@ -175,10 +175,6 @@ variables: fates_branch_turnover:units = "yr-1" ; fates_branch_turnover:long_name = "turnover time of branches" ; - float fates_prt_unit_gr_resp(fates_prt_organs,fates_pft) ; - fates_prt_unit_gr_resp:units = "gC/gC" ; - fates_prt_unit_gr_resp:long_name = "Unit growth respiration rate per organ" ; - float 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" ; @@ -758,14 +754,6 @@ data: fates_branch_turnover = 50, 50 ; - fates_prt_unit_gr_resp = - 0.11, 0.11, - 0.11, 0.11, - 0.11, 0.11, - 0.11, 0.11, - 0.11, 0.11, - 0.11, 0.11; - fates_prt_nitr_stoich_p1 = 0.033, 0.033, 0.024, 0.024, diff --git a/parteh/PRTGenericMod.F90 b/parteh/PRTGenericMod.F90 index 1c7ec9124a..5a5dba681d 100644 --- a/parteh/PRTGenericMod.F90 +++ b/parteh/PRTGenericMod.F90 @@ -969,7 +969,7 @@ function GetState(this, organ_id, species_id, position_id) result(sp_organ_val) sp_organ_val = 0.0_r8 if(species_id == all_carbon_species) then - spec_ids(1:3) = carbon_species(1:3) + spec_ids(1:3) = carbon_species_list(1:3) num_species = 3 else num_species = 1 @@ -1030,7 +1030,7 @@ function GetTurnover(this, organ_id, species_id, position_id) result(sp_organ_tu sp_organ_turnover = 0.0_r8 if(species_id == all_carbon_species) then - spec_ids(1:3) = carbon_species(1:3) + spec_ids(1:3) = carbon_species_list(1:3) num_species = 3 else num_species = 1 @@ -1087,7 +1087,7 @@ function GetBurned(this, organ_id, species_id, position_id) result(sp_organ_burn sp_organ_burned = 0.0_r8 if(species_id == all_carbon_species) then - spec_ids(1:3) = carbon_species(1:3) + spec_ids(1:3) = carbon_species_list(1:3) num_species = 3 else num_species = 1 @@ -1145,7 +1145,7 @@ function GetNetART(this, organ_id, species_id, position_id) result(sp_organ_neta sp_organ_netart = 0.0_r8 if(species_id == all_carbon_species) then - spec_ids(1:3) = carbon_species(1:3) + spec_ids(1:3) = carbon_species_list(1:3) num_species = 3 else num_species = 1 From 4be98cc388a12824e01e3449de2e2ddaf34264b7 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 18 Oct 2018 18:54:54 -0700 Subject: [PATCH 45/52] Updated functional unit tests to conform to newly named variables. --- .../f_wrapper_modules/FatesPARTEHWrapMod.F90 | 4 +-- .../f_wrapper_modules/FatesPFTWrapMod.F90 | 30 +++++++++---------- .../parteh/parteh_controls_defaults.xml | 6 ++-- .../parteh/parteh_controls_phenevents_v2.xml | 6 ++-- .../parteh/parteh_controls_smoketests.xml | 6 ++-- .../parteh/parteh_controls_variable_netc.xml | 6 ++-- parteh/PRTAllometricCarbonMod.F90 | 2 +- 7 files changed, 30 insertions(+), 30 deletions(-) diff --git a/functional_unit_testing/parteh/f_wrapper_modules/FatesPARTEHWrapMod.F90 b/functional_unit_testing/parteh/f_wrapper_modules/FatesPARTEHWrapMod.F90 index 08ee7fb937..1b5b363377 100644 --- a/functional_unit_testing/parteh/f_wrapper_modules/FatesPARTEHWrapMod.F90 +++ b/functional_unit_testing/parteh/f_wrapper_modules/FatesPARTEHWrapMod.F90 @@ -12,8 +12,8 @@ module FatesPARTEHWrapMod - use PRTAllometricCarbonMod, only : InitPRTInstanceAC - use PRTAllometricCNPMod, only : InitPRTInstanceACNP + use PRTAllometricCarbonMod, only : InitPRTGlobalAllometricCarbon + use PRTAllometricCNPMod, only : InitPRTGlobalAllometricCNP use FatesGlobals , only : endrun => fates_endrun use FatesGlobals , only : fates_log use shr_log_mod , only : errMsg => shr_log_errMsg diff --git a/functional_unit_testing/parteh/f_wrapper_modules/FatesPFTWrapMod.F90 b/functional_unit_testing/parteh/f_wrapper_modules/FatesPFTWrapMod.F90 index 75e30b32e7..f186be1b84 100644 --- a/functional_unit_testing/parteh/f_wrapper_modules/FatesPFTWrapMod.F90 +++ b/functional_unit_testing/parteh/f_wrapper_modules/FatesPFTWrapMod.F90 @@ -99,9 +99,9 @@ module EDPftvarcon ! THese are new, but not necessarily PARTEH labeled real(r8), pointer :: turnover_retrans_mode(:) - real(r8), pointer :: turnover_carb_retrans_p1(:,:) - real(r8), pointer :: turnover_nitr_retrans_p1(:,:) - real(r8), pointer :: turnover_phos_retrans_p1(:,:) + real(r8), pointer :: turnover_carb_retrans(:,:) + real(r8), pointer :: turnover_nitr_retrans(:,:) + real(r8), pointer :: turnover_phos_retrans(:,:) end type EDPftvarcon_inst_type @@ -543,23 +543,23 @@ subroutine EDPftvarconAlloc(numpft_in, numorgans_in) EDPftvarcon_ptr%var(iv)%var_name = "fates_turnover_retrans_mode" EDPftvarcon_ptr%var(iv)%rp_1d => EDPftvarcon_inst%turnover_retrans_mode - allocate( EDPftvarcon_inst%turnover_carb_retrans_p1(1:num_pft,1:num_organs) ) - EDPftvarcon_inst%turnover_carb_retrans_p1(:,:) = nan + allocate( EDPftvarcon_inst%turnover_carb_retrans(1:num_pft,1:num_organs) ) + EDPftvarcon_inst%turnover_carb_retrans(:,:) = nan iv = iv + 1 - EDPftvarcon_ptr%var(iv)%var_name = "fates_turnover_carb_retrans_p1" - EDPftvarcon_ptr%var(iv)%rp_2d => EDPftvarcon_inst%turnover_carb_retrans_p1 + EDPftvarcon_ptr%var(iv)%var_name = "fates_turnover_carb_retrans" + EDPftvarcon_ptr%var(iv)%rp_2d => EDPftvarcon_inst%turnover_carb_retrans - allocate( EDPftvarcon_inst%turnover_nitr_retrans_p1(1:num_pft,1:num_organs) ) - EDPftvarcon_inst%turnover_nitr_retrans_p1(:,:) = nan + allocate( EDPftvarcon_inst%turnover_nitr_retrans(1:num_pft,1:num_organs) ) + EDPftvarcon_inst%turnover_nitr_retrans(:,:) = nan iv = iv + 1 - EDPftvarcon_ptr%var(iv)%var_name = "fates_turnover_nitr_retrans_p1" - EDPftvarcon_ptr%var(iv)%rp_2d => EDPftvarcon_inst%turnover_nitr_retrans_p1 + EDPftvarcon_ptr%var(iv)%var_name = "fates_turnover_nitr_retrans" + EDPftvarcon_ptr%var(iv)%rp_2d => EDPftvarcon_inst%turnover_nitr_retrans - allocate( EDPftvarcon_inst%turnover_phos_retrans_p1(1:num_pft,1:num_organs) ) - EDPftvarcon_inst%turnover_phos_retrans_p1(:,:) = nan + allocate( EDPftvarcon_inst%turnover_phos_retrans(1:num_pft,1:num_organs) ) + EDPftvarcon_inst%turnover_phos_retrans(:,:) = nan iv = iv + 1 - EDPftvarcon_ptr%var(iv)%var_name = "fates_turnover_phos_retrans_p1" - EDPftvarcon_ptr%var(iv)%rp_2d => EDPftvarcon_inst%turnover_phos_retrans_p1 + EDPftvarcon_ptr%var(iv)%var_name = "fates_turnover_phos_retrans" + EDPftvarcon_ptr%var(iv)%rp_2d => EDPftvarcon_inst%turnover_phos_retrans ! We should gracefully fail if rootprof_beta is requested diff --git a/functional_unit_testing/parteh/parteh_controls_defaults.xml b/functional_unit_testing/parteh/parteh_controls_defaults.xml index 0efa50f750..5582212aef 100644 --- a/functional_unit_testing/parteh/parteh_controls_defaults.xml +++ b/functional_unit_testing/parteh/parteh_controls_defaults.xml @@ -101,9 +101,9 @@ 1,1 - 0.025, 0.025, 0.025, 0.025, 0.025, 0.025, 0.025, 0.025, 0.025, 0.025, 0.025, 0.025 - -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9 - -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9 + 0.025, 0.025, 0.025, 0.025, 0.025, 0.025, 0.025, 0.025, 0.025, 0.025, 0.025, 0.025 + -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9 + -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9 -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9 -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9 -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9, -9 diff --git a/functional_unit_testing/parteh/parteh_controls_phenevents_v2.xml b/functional_unit_testing/parteh/parteh_controls_phenevents_v2.xml index f6e1f4b789..18cf824c62 100644 --- a/functional_unit_testing/parteh/parteh_controls_phenevents_v2.xml +++ b/functional_unit_testing/parteh/parteh_controls_phenevents_v2.xml @@ -104,17 +104,17 @@ 1,1,1,1,1 - 0.05,0.05,0,0,0,0, + 0.05,0.05,0,0,0,0, 0.05,0.05,0,0,0,0, 0.05,0.05,0,0,0,0, 0.05,0.05,0,0,0,0, 0.05,0.05,0,0,0,0 - 0,0,0,0,0,0, + 0,0,0,0,0,0, 0,0,0,0,0,0, 0.25,0,0,0,0,0, 0.25,0,0,0,0,0, 0.25,0,0,0,0,0 - 0,0,0,0,0,0, + 0,0,0,0,0,0, 0,0,0,0,0,0, 0.25,0,0,0,0,0, 0.25,0,0,0,0,0, diff --git a/functional_unit_testing/parteh/parteh_controls_smoketests.xml b/functional_unit_testing/parteh/parteh_controls_smoketests.xml index c92a4acd96..d7675c7276 100644 --- a/functional_unit_testing/parteh/parteh_controls_smoketests.xml +++ b/functional_unit_testing/parteh/parteh_controls_smoketests.xml @@ -104,17 +104,17 @@ 1,1,1,1,1 - 0,0,0,0,0,0, + 0,0,0,0,0,0, 0,0,0,0,0,0, 0.05,0.05,0,0,0,0, 0.05,0.05,0,0,0,0, 0.05,0.05,0,0,0,0 - 0,0,0,0,0,0, + 0,0,0,0,0,0, 0,0,0,0,0,0, 0.25,0.15,0,0,0,0, 0.25,0,0,0,0,0, 0.25,0,0,0,0,0 - 0,0,0,0,0,0, + 0,0,0,0,0,0, 0,0,0,0,0,0, 0.25,0.15,0,0,0,0, 0.25,0,0,0,0,0, diff --git a/functional_unit_testing/parteh/parteh_controls_variable_netc.xml b/functional_unit_testing/parteh/parteh_controls_variable_netc.xml index 40c043dce2..47be70426d 100644 --- a/functional_unit_testing/parteh/parteh_controls_variable_netc.xml +++ b/functional_unit_testing/parteh/parteh_controls_variable_netc.xml @@ -99,13 +99,13 @@ 50.0 , 50.0 , 50.0 1,1,1 - 0.05,0,0,0,0,0, + 0.05,0,0,0,0,0, 0.05,0,0,0,0,0, 0.05,0,0,0,0,0 - -9,0,0,0,0,0, + -9,0,0,0,0,0, 0.25,0,0,0,0,0, 0.25,0,0,0,0,0 - -9,0,0,0,0,0, + -9,0,0,0,0,0, 0.25,0,0,0,0,0, 0.25,0,0,0,0,0 diff --git a/parteh/PRTAllometricCarbonMod.F90 b/parteh/PRTAllometricCarbonMod.F90 index 1d53a13d64..567b23e2e3 100644 --- a/parteh/PRTAllometricCarbonMod.F90 +++ b/parteh/PRTAllometricCarbonMod.F90 @@ -131,7 +131,7 @@ module PRTAllometricCarbonMod ! everywhere in the code, except for where it is populated in this init routine ! below. - class(prt_global_type), protected, target, allocatable :: prt_global_ac + class(prt_global_type), public, target, allocatable :: prt_global_ac public :: InitPRTGlobalAllometricCarbon From c68e0b93c10a98db4009b25cac426051cfc0fb37 Mon Sep 17 00:00:00 2001 From: Chonggang Xu Date: Fri, 19 Oct 2018 13:08:01 -0600 Subject: [PATCH 46/52] update the default parameter files for FATES-HYDRO --- parameter_files/fates_params_default.cdl | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/parameter_files/fates_params_default.cdl b/parameter_files/fates_params_default.cdl index 8f58d4cefa..a6304e1e91 100644 --- a/parameter_files/fates_params_default.cdl +++ b/parameter_files/fates_params_default.cdl @@ -620,10 +620,10 @@ data: -2.25, -2.25 ; fates_hydr_pinot_node = - -999, -999, - -999, -999, - -999, -999, - -999, -999 ; + -1.465984, -1.465984, + -1.228070, -1.228070, + -1.228070, -1.228070, + -1.043478, -1.043478 ; fates_hydr_pitlp_node = -1.67, -1.67, @@ -895,7 +895,7 @@ data: fates_fire_nignitions = 15 ; - fates_hydr_kmax_rsurf = 0.001; + fates_hydr_kmax_rsurf = 20; fates_hydr_psi0 = 0 ; From daacfb2f9f7b0be63cb96d2a351a344c92a79308 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Mon, 22 Oct 2018 13:37:46 -0700 Subject: [PATCH 47/52] parteh: Changed naming convention from species (chemical) to element. Also added flexibility in leaf flushing algorithm. --- biogeochem/EDCanopyStructureMod.F90 | 57 ++- biogeochem/EDCohortDynamicsMod.F90 | 46 +-- biogeochem/EDLoggingMortalityMod.F90 | 12 +- biogeochem/EDMortalityFunctionsMod.F90 | 4 +- biogeochem/EDPatchDynamicsMod.F90 | 40 +- biogeochem/EDPhysiologyMod.F90 | 46 +-- biogeophys/FatesPlantHydraulicsMod.F90 | 32 +- biogeophys/FatesPlantRespPhotosynthMod.F90 | 21 +- fire/SFMainMod.F90 | 20 +- main/ChecksBalancesMod.F90 | 29 +- main/EDMainMod.F90 | 12 +- main/EDTypesMod.F90 | 14 +- main/FatesHistoryInterfaceMod.F90 | 34 +- main/FatesRestartInterfaceMod.F90 | 16 +- parteh/PRTAllometricCarbonMod.F90 | 40 +- parteh/PRTGenericMod.F90 | 432 ++++++++++----------- parteh/PRTLossFluxesMod.F90 | 267 +++++++------ 17 files changed, 556 insertions(+), 566 deletions(-) diff --git a/biogeochem/EDCanopyStructureMod.F90 b/biogeochem/EDCanopyStructureMod.F90 index f23b87c4cd..dd3b26fd28 100644 --- a/biogeochem/EDCanopyStructureMod.F90 +++ b/biogeochem/EDCanopyStructureMod.F90 @@ -28,10 +28,7 @@ module EDCanopyStructureMod use FatesPlantHydraulicsMod, only : UpdateH2OVeg,InitHydrCohort use PRTGenericMod, only : leaf_organ - use PRTGenericMod, only : all_carbon_species - use PRTGenericMod, only : carbon12_species - use PRTGenericMod, only : nitrogen_species - use PRTGenericMod, only : phosphorous_species + use PRTGenericMod, only : all_carbon_elements use PRTGenericMod, only : leaf_organ use PRTGenericMod, only : fnrt_organ use PRTGenericMod, only : sapw_organ @@ -473,11 +470,11 @@ subroutine DemoteFromLayer(currentSite,currentPatch,i_lyr) cc_loss = currentCohort%excl_weight - leaf_c = currentCohort%prt%GetState(leaf_organ,all_carbon_species) - store_c = currentCohort%prt%GetState(store_organ,all_carbon_species) - fnrt_c = currentCohort%prt%GetState(fnrt_organ,all_carbon_species) - sapw_c = currentCohort%prt%GetState(sapw_organ,all_carbon_species) - struct_c = currentCohort%prt%GetState(struct_organ,all_carbon_species) + 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) if(currentCohort%canopy_layer == i_lyr .and. cc_loss>nearzero )then @@ -694,11 +691,11 @@ subroutine PromoteIntoLayer(currentSite,currentPatch,i_lyr) !look at the cohorts in the canopy layer below... if(currentCohort%canopy_layer == i_lyr+1)then - leaf_c = currentCohort%prt%GetState(leaf_organ,all_carbon_species) - store_c = currentCohort%prt%GetState(store_organ,all_carbon_species) - fnrt_c = currentCohort%prt%GetState(fnrt_organ,all_carbon_species) - sapw_c = currentCohort%prt%GetState(sapw_organ,all_carbon_species) - struct_c = currentCohort%prt%GetState(struct_organ,all_carbon_species) + 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) currentCohort%canopy_layer = i_lyr call carea_allom(currentCohort%dbh,currentCohort%n,currentSite%spread, & @@ -841,11 +838,11 @@ subroutine PromoteIntoLayer(currentSite,currentPatch,i_lyr) currentSite%promotion_rate(currentCohort%size_class) = & currentSite%promotion_rate(currentCohort%size_class) + currentCohort%n - leaf_c = currentCohort%prt%GetState(leaf_organ,all_carbon_species) - store_c = currentCohort%prt%GetState(store_organ,all_carbon_species) - fnrt_c = currentCohort%prt%GetState(fnrt_organ,all_carbon_species) - sapw_c = currentCohort%prt%GetState(sapw_organ,all_carbon_species) - struct_c = currentCohort%prt%GetState(struct_organ,all_carbon_species) + 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) currentSite%promotion_carbonflux = currentSite%promotion_carbonflux + & (leaf_c + fnrt_c + store_c + sapw_c + struct_c) * currentCohort%n @@ -877,11 +874,11 @@ subroutine PromoteIntoLayer(currentSite,currentPatch,i_lyr) currentSite%promotion_rate(copyc%size_class) = & currentSite%promotion_rate(copyc%size_class) + copyc%n - leaf_c = copyc%prt%GetState(leaf_organ,all_carbon_species) - store_c = copyc%prt%GetState(store_organ,all_carbon_species) - fnrt_c = copyc%prt%GetState(fnrt_organ,all_carbon_species) - sapw_c = copyc%prt%GetState(sapw_organ,all_carbon_species) - struct_c = copyc%prt%GetState(struct_organ,all_carbon_species) + leaf_c = copyc%prt%GetState(leaf_organ,all_carbon_elements) + store_c = copyc%prt%GetState(store_organ,all_carbon_elements) + fnrt_c = copyc%prt%GetState(fnrt_organ,all_carbon_elements) + sapw_c = copyc%prt%GetState(sapw_organ,all_carbon_elements) + struct_c = copyc%prt%GetState(struct_organ,all_carbon_elements) currentSite%promotion_carbonflux = currentSite%promotion_carbonflux + & (leaf_c + fnrt_c + store_c + sapw_c + struct_c) * copyc%n @@ -1066,11 +1063,11 @@ subroutine canopy_summarization( nsites, sites, bc_in ) ft = currentCohort%pft - leaf_c = currentCohort%prt%GetState(leaf_organ, all_carbon_species) - sapw_c = currentCohort%prt%GetState(sapw_organ, all_carbon_species) - struct_c = currentCohort%prt%GetState(struct_organ, all_carbon_species) - fnrt_c = currentCohort%prt%GetState(fnrt_organ, all_carbon_species) - store_c = currentCohort%prt%GetState(store_organ, all_carbon_species) + 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) + fnrt_c = currentCohort%prt%GetState(fnrt_organ, all_carbon_elements) + store_c = currentCohort%prt%GetState(store_organ, all_carbon_elements) ! Update the cohort's index within the size bin classes ! Update the cohort's index within the SCPF classification system @@ -1253,7 +1250,7 @@ subroutine leaf_area_profile( currentSite , snow_depth_si, frac_sno_eff_si) ! Note that the canopy_layer_lai is also calculated in this loop ! but since we go top down in terms of plant size, we should be okay - leaf_c = currentCohort%prt%GetState(leaf_organ,all_carbon_species) + 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, & diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index e3b7f42eaa..820c9078cb 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -42,10 +42,10 @@ module EDCohortDynamicsMod use PRTGenericMod, only : prt_cnp_flex_allom_hyp use PRTGenericMod, only : InitPRTVartype use PRTGenericMod, only : prt_vartypes - use PRTGenericMod, only : all_carbon_species - use PRTGenericMod, only : carbon12_species - use PRTGenericMod, only : nitrogen_species - use PRTGenericMod, only : phosphorous_species + use PRTGenericMod, only : all_carbon_elements + use PRTGenericMod, only : carbon12_element + use PRTGenericMod, only : nitrogen_element + use PRTGenericMod, only : phosphorous_element use PRTGenericMod, only : leaf_organ use PRTGenericMod, only : fnrt_organ use PRTGenericMod, only : sapw_organ @@ -168,12 +168,12 @@ subroutine create_cohort(currentSite, patchptr, pft, nn, hite, dbh, bleaf, bfine select case(hlm_parteh_mode) case (prt_carbon_allom_hyp) - call SetState(new_cohort%prt,leaf_organ, carbon12_species, bleaf) - call SetState(new_cohort%prt,fnrt_organ, carbon12_species, bfineroot) - call SetState(new_cohort%prt,sapw_organ, carbon12_species, bsap) - call SetState(new_cohort%prt,store_organ, carbon12_species, bstore) - call SetState(new_cohort%prt,struct_organ , carbon12_species, bdead) - call SetState(new_cohort%prt,repro_organ , carbon12_species, 0.0_r8) + call SetState(new_cohort%prt,leaf_organ, carbon12_element, bleaf) + 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 @@ -540,12 +540,12 @@ subroutine terminate_cohorts( currentSite, currentPatch, level ) terminate = 0 tallerCohort => currentCohort%taller - leaf_c = currentCohort%prt%GetState(leaf_organ, all_carbon_species) - store_c = currentCohort%prt%GetState(store_organ, all_carbon_species) - sapw_c = currentCohort%prt%GetState(sapw_organ, all_carbon_species) - fnrt_c = currentCohort%prt%GetState(fnrt_organ, all_carbon_species) - struct_c = currentCohort%prt%GetState(struct_organ, all_carbon_species) - repro_c = currentCohort%prt%GetState(repro_organ, all_carbon_species) + 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) ! Check if number density is so low is breaks math (level 1) if (currentcohort%n < min_n_safemath .and. level == 1) then @@ -653,12 +653,12 @@ subroutine terminate_cohorts( currentSite, currentPatch, level ) end if ! Zero out the state pools - call SetState(currentCohort%prt,leaf_organ,carbon12_species,0.0_r8) - call SetState(currentCohort%prt,fnrt_organ,carbon12_species,0.0_r8) - call SetState(currentCohort%prt,sapw_organ,carbon12_species,0.0_r8) - call SetState(currentCohort%prt,struct_organ,carbon12_species,0.0_r8) - call SetState(currentCohort%prt,repro_organ,carbon12_species,0.0_r8) - call SetState(currentCohort%prt,store_organ,carbon12_species,0.0_r8) + 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 @@ -834,7 +834,7 @@ subroutine fuse_cohorts(currentSite, currentPatch, bc_in) ! ----------------------------------------------------------------- if( EDPftvarcon_inst%woody(currentCohort%pft) == itrue ) then - call StructureResetOfDH( currentCohort%prt%GetState(struct_organ,all_carbon_species), currentCohort%pft, & + call StructureResetOfDH( currentCohort%prt%GetState(struct_organ,all_carbon_elements), currentCohort%pft, & currentCohort%canopy_trim, currentCohort%dbh, currentCohort%hite ) end if diff --git a/biogeochem/EDLoggingMortalityMod.F90 b/biogeochem/EDLoggingMortalityMod.F90 index 3a83f8d071..4976d3ab55 100644 --- a/biogeochem/EDLoggingMortalityMod.F90 +++ b/biogeochem/EDLoggingMortalityMod.F90 @@ -46,7 +46,7 @@ module EDLoggingMortalityMod use shr_log_mod , only : errMsg => shr_log_errMsg use FatesPlantHydraulicsMod, only : AccumulateMortalityWaterStorage - use PRTGenericMod , only : all_carbon_species + use PRTGenericMod , only : all_carbon_elements use PRTGenericMod , only : sapw_organ, struct_organ, leaf_organ use PRTGenericMod , only : fnrt_organ, store_organ, repro_organ @@ -285,11 +285,11 @@ subroutine logging_litter_fluxes(currentSite, currentPatch, newPatch, patch_site do while(associated(currentCohort)) p = currentCohort%pft - sapw_c = currentCohort%prt%GetState(sapw_organ, all_carbon_species) - struct_c = currentCohort%prt%GetState(struct_organ, all_carbon_species) - leaf_c = currentCohort%prt%GetState(leaf_organ, all_carbon_species) - fnrt_c = currentCohort%prt%GetState(fnrt_organ, all_carbon_species) - store_c = currentCohort%prt%GetState(store_organ, all_carbon_species) + 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 diff --git a/biogeochem/EDMortalityFunctionsMod.F90 b/biogeochem/EDMortalityFunctionsMod.F90 index 1daedf65c8..b052d34773 100644 --- a/biogeochem/EDMortalityFunctionsMod.F90 +++ b/biogeochem/EDMortalityFunctionsMod.F90 @@ -20,7 +20,7 @@ module EDMortalityFunctionsMod use EDParamsMod , only : fates_mortality_disturbance_fraction use FatesInterfaceMod , only : bc_in_type - use PRTGenericMod, only : all_carbon_species + use PRTGenericMod, only : all_carbon_elements use PRTGenericMod, only : store_organ implicit none @@ -88,7 +88,7 @@ subroutine mortality_rates( cohort_in,bc_in,cmort,hmort,bmort,frmort ) if ( cohort_in%dbh > 0._r8 ) then call bleaf(cohort_in%dbh,cohort_in%pft,cohort_in%canopy_trim,leaf_c_target) - store_c = cohort_in%prt%GetState(store_organ,all_carbon_species) + store_c = cohort_in%prt%GetState(store_organ,all_carbon_elements) call storage_fraction_of_target(leaf_c_target, store_c, frac) if( frac .lt. 1._r8) then diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 56582f5e9d..67206f73e1 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -40,9 +40,7 @@ module EDPatchDynamicsMod use EDCohortDynamicsMod , only : InitPRTCohort - use PRTGenericMod, only : all_carbon_species - use PRTGenericMod, only : nitrogen_species - use PRTGenericMod, only : phosphorous_species + use PRTGenericMod, only : all_carbon_elements use PRTGenericMod, only : leaf_organ use PRTGenericMod, only : fnrt_organ use PRTGenericMod, only : sapw_organ @@ -416,11 +414,11 @@ subroutine spawn_patches( currentSite, bc_in) nc%canopy_layer = 1 nc%canopy_layer_yesterday = 1._r8 - sapw_c = currentCohort%prt%GetState(sapw_organ, all_carbon_species) - struct_c = currentCohort%prt%GetState(struct_organ, all_carbon_species) - leaf_c = currentCohort%prt%GetState(leaf_organ, all_carbon_species) - fnrt_c = currentCohort%prt%GetState(fnrt_organ, all_carbon_species) - store_c = currentCohort%prt%GetState(store_organ, all_carbon_species) + 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 @@ -934,11 +932,11 @@ subroutine fire_litter_fluxes(currentSite, cp_target, new_patch_target, patch_si ! Divide their litter into the four litter streams, and spread evenly across ground surface. !************************************/ - sapw_c = currentCohort%prt%GetState(sapw_organ, all_carbon_species) - struct_c = currentCohort%prt%GetState(struct_organ, all_carbon_species) - leaf_c = currentCohort%prt%GetState(leaf_organ, all_carbon_species) - fnrt_c = currentCohort%prt%GetState(fnrt_organ, all_carbon_species) - store_c = currentCohort%prt%GetState(store_organ, all_carbon_species) + 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) @@ -1050,8 +1048,8 @@ subroutine fire_litter_fluxes(currentSite, cp_target, new_patch_target, patch_si currentCohort => new_patch%shortest do while(associated(currentCohort)) - sapw_c = currentCohort%prt%GetState(sapw_organ, all_carbon_species) - leaf_c = currentCohort%prt%GetState(leaf_organ, all_carbon_species) + 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) @@ -1135,11 +1133,11 @@ subroutine mortality_litter_fluxes(currentSite, cp_target, new_patch_target, pat do while(associated(currentCohort)) p = currentCohort%pft - sapw_c = currentCohort%prt%GetState(sapw_organ, all_carbon_species) - struct_c = currentCohort%prt%GetState(struct_organ, all_carbon_species) - leaf_c = currentCohort%prt%GetState(leaf_organ, all_carbon_species) - fnrt_c = currentCohort%prt%GetState(fnrt_organ, all_carbon_species) - store_c = currentCohort%prt%GetState(store_organ, all_carbon_species) + 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) @@ -1979,7 +1977,7 @@ subroutine patch_pft_size_profile(cp_pnt) currentPatch%pft_agb_profile(currentCohort%pft,j) = & currentPatch%pft_agb_profile(currentCohort%pft,j) + & - currentCohort%prt%GetState(struct_organ, all_carbon_species) * & + currentCohort%prt%GetState(struct_organ, all_carbon_elements) * & currentCohort%n/currentPatch%area endif diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 444c111833..bd92830686 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -56,10 +56,10 @@ module EDPhysiologyMod use FatesAllometryMod , only : StructureResetOfDH use PRTGenericMod, only : leaf_organ - use PRTGenericMod, only : all_carbon_species - use PRTGenericMod, only : carbon12_species - use PRTGenericMod, only : nitrogen_species - use PRTGenericMod, only : phosphorous_species + use PRTGenericMod, only : all_carbon_elements + use PRTGenericMod, only : carbon12_element + use PRTGenericMod, only : nitrogen_element + use PRTGenericMod, only : phosphorous_element use PRTGenericMod, only : leaf_organ use PRTGenericMod, only : fnrt_organ use PRTGenericMod, only : sapw_organ @@ -243,7 +243,7 @@ subroutine trim_canopy( currentSite ) ipft = currentCohort%pft call carea_allom(currentCohort%dbh,currentCohort%n,currentSite%spread,currentCohort%pft,currentCohort%c_area) - leaf_c = currentCohort%prt%GetState(leaf_organ, all_carbon_species) + 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, & @@ -665,8 +665,8 @@ subroutine phenology_leafonoff(currentSite) call currentCohort%prt%CheckMassConservation(ipft,0) - store_c = currentCohort%prt%GetState(store_organ, carbon12_species) - leaf_c = currentCohort%prt%GetState(leaf_organ, carbon12_species) + store_c = currentCohort%prt%GetState(store_organ, all_carbon_elements) + leaf_c = currentCohort%prt%GetState(leaf_organ, all_carbon_elements) !COLD LEAF ON if (EDPftvarcon_inst%season_decid(ipft) == 1)then @@ -704,7 +704,7 @@ subroutine phenology_leafonoff(currentSite) currentCohort%laimemory = leaf_c ! Drop Leaves (this routine will update the leaf state variables, - ! for carbon and any other species that are prognostic. It will + ! 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, & @@ -1065,17 +1065,17 @@ subroutine CWD_Input( currentSite, currentPatch) do while(associated(currentCohort)) pft = currentCohort%pft - leaf_c_turnover = currentCohort%prt%GetTurnover(leaf_organ,all_carbon_species) - store_c_turnover = currentCohort%prt%GetTurnover(store_organ,all_carbon_species) - fnrt_c_turnover = currentCohort%prt%GetTurnover(fnrt_organ,all_carbon_species) - sapw_c_turnover = currentCohort%prt%GetTurnover(sapw_organ,all_carbon_species) - struct_c_turnover = currentCohort%prt%GetTurnover(struct_organ,all_carbon_species) + 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) - leaf_c = currentCohort%prt%GetState(leaf_organ,all_carbon_species) - store_c = currentCohort%prt%GetState(store_organ,all_carbon_species) - fnrt_c = currentCohort%prt%GetState(fnrt_organ,all_carbon_species) - sapw_c = currentCohort%prt%GetState(sapw_organ,all_carbon_species) - struct_c = currentCohort%prt%GetState(struct_organ,all_carbon_species) + 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) ! ================================================ ! Litter from tissue turnover. KgC/m2/year @@ -1643,11 +1643,11 @@ subroutine flux_into_litter_pools(nsites, sites, bc_in, bc_out) currentCohort => currentPatch%tallest do while(associated(currentCohort)) - leaf_c = currentCohort%prt%GetState(leaf_organ,all_carbon_species) - store_c = currentCohort%prt%GetState(store_organ,all_carbon_species) - fnrt_c = currentCohort%prt%GetState(fnrt_organ,all_carbon_species) - sapw_c = currentCohort%prt%GetState(sapw_organ,all_carbon_species) - struct_c = currentCohort%prt%GetState(struct_organ,all_carbon_species) + 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) * & diff --git a/biogeophys/FatesPlantHydraulicsMod.F90 b/biogeophys/FatesPlantHydraulicsMod.F90 index bf29dfbf32..ab5487d4ac 100644 --- a/biogeophys/FatesPlantHydraulicsMod.F90 +++ b/biogeophys/FatesPlantHydraulicsMod.F90 @@ -71,13 +71,9 @@ module FatesPlantHydraulicsMod use FatesHydraulicsMemMod, only: InitHydraulicsDerived use FatesHydraulicsMemMod, only: nlevsoi_hyd_max - use PRTGenericMod, only : all_carbon_species - use PRTGenericMod, only : carbon12_species - use PRTGenericMod, only : nitrogen_species - use PRTGenericMod, only : phosphorous_species + use PRTGenericMod, only : all_carbon_elements use PRTGenericMod, only : leaf_organ, fnrt_organ, sapw_organ use PRTGenericMod, only : store_organ, repro_organ, struct_organ - use PRTGenericMod, only : carbon12_species use clm_time_manager , only : get_step_size, get_nstep @@ -339,10 +335,10 @@ subroutine updateSizeDepTreeHydProps(currentSite,cc_p,bc_in) roota = EDPftvarcon_inst%roota_par(FT) rootb = EDPftvarcon_inst%rootb_par(FT) - leaf_c = cCohort%prt%GetState(leaf_organ, all_carbon_species) - sapw_c = cCohort%prt%GetState(sapw_organ, all_carbon_species) - fnrt_c = cCohort%prt%GetState(fnrt_organ, all_carbon_species) - struct_c = cCohort%prt%GetState(struct_organ, all_carbon_species) + leaf_c = cCohort%prt%GetState(leaf_organ, all_carbon_elements) + sapw_c = cCohort%prt%GetState(sapw_organ, all_carbon_elements) + fnrt_c = cCohort%prt%GetState(fnrt_organ, all_carbon_elements) + struct_c = cCohort%prt%GetState(struct_organ, all_carbon_elements) !roota = 4.372_r8 ! TESTING: deep (see Zeng 2001 Table 1) !rootb = 0.978_r8 ! TESTING: deep (see Zeng 2001 Table 1) @@ -908,9 +904,9 @@ subroutine UpdateH2OVeg(nsites,sites,bc_out) currentCohort=>currentPatch%tallest do while(associated(currentCohort)) balive_patch = balive_patch + & - (currentCohort%prt%GetState(fnrt_organ, all_carbon_species) + & - currentCohort%prt%GetState(sapw_organ, all_carbon_species) + & - currentCohort%prt%GetState(leaf_organ, all_carbon_species)) * currentCohort%n + (currentCohort%prt%GetState(fnrt_organ, all_carbon_elements) + & + currentCohort%prt%GetState(sapw_organ, all_carbon_elements) + & + currentCohort%prt%GetState(leaf_organ, all_carbon_elements)) * currentCohort%n currentCohort => currentCohort%shorter enddo !cohort @@ -1316,9 +1312,9 @@ subroutine BTranForHLMDiagnosticsFromCohortHydr(nsites,sites,bc_out) ccohort=>cpatch%tallest do while(associated(ccohort)) balive_patch = balive_patch + & - (cCohort%prt%GetState(fnrt_organ, all_carbon_species) + & - cCohort%prt%GetState(sapw_organ, all_carbon_species) + & - cCohort%prt%GetState(leaf_organ, all_carbon_species))* ccohort%n + (cCohort%prt%GetState(fnrt_organ, all_carbon_elements) + & + cCohort%prt%GetState(sapw_organ, all_carbon_elements) + & + cCohort%prt%GetState(leaf_organ, all_carbon_elements))* ccohort%n ccohort => ccohort%shorter enddo !cohort @@ -1327,9 +1323,9 @@ subroutine BTranForHLMDiagnosticsFromCohortHydr(nsites,sites,bc_out) do while(associated(ccohort)) bc_out(s)%btran_pa(ifp) = bc_out(s)%btran_pa(ifp) + & ccohort%co_hydr%btran(1) * & - (cCohort%prt%GetState(fnrt_organ, all_carbon_species) + & - cCohort%prt%GetState(sapw_organ, all_carbon_species) + & - cCohort%prt%GetState(leaf_organ, all_carbon_species)) * & + (cCohort%prt%GetState(fnrt_organ, all_carbon_elements) + & + cCohort%prt%GetState(sapw_organ, all_carbon_elements) + & + cCohort%prt%GetState(leaf_organ, all_carbon_elements)) * & ccohort%n / balive_patch ccohort => ccohort%shorter enddo !cohort diff --git a/biogeophys/FatesPlantRespPhotosynthMod.F90 b/biogeophys/FatesPlantRespPhotosynthMod.F90 index 7dff2326a5..56ca97ea23 100644 --- a/biogeophys/FatesPlantRespPhotosynthMod.F90 +++ b/biogeophys/FatesPlantRespPhotosynthMod.F90 @@ -33,9 +33,8 @@ module FATESPlantRespPhotosynthMod use PRTGenericMod, only : prt_carbon_allom_hyp use PRTGenericMod, only : prt_cnp_flex_allom_hyp - use PRTGenericMod, only : all_carbon_species - use PRTGenericMod, only : nitrogen_species - use PRTGenericMod, only : phosphorous_species + use PRTGenericMod, only : all_carbon_elements + use PRTGenericMod, only : nitrogen_element use PRTGenericMod, only : leaf_organ use PRTGenericMod, only : fnrt_organ use PRTGenericMod, only : sapw_organ @@ -367,7 +366,7 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) call bleaf(currentCohort%dbh,currentCohort%pft,currentCohort%canopy_trim,b_leaf) call storage_fraction_of_target(b_leaf, & - currentCohort%prt%GetState(store_organ, all_carbon_species), & + currentCohort%prt%GetState(store_organ, all_carbon_elements), & frac) call lowstorage_maintresp_reduction(frac,currentCohort%pft, & maintresp_reduction_factor) @@ -444,8 +443,8 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) case (prt_cnp_flex_allom_hyp) - leaf_c = currentCohort%prt%GetState(leaf_organ, all_carbon_species) - leaf_n = currentCohort%prt%GetState(leaf_organ, all_carbon_species) + leaf_c = currentCohort%prt%GetState(leaf_organ, all_carbon_elements) + leaf_n = currentCohort%prt%GetState(leaf_organ, all_carbon_elements) lnc_top = leaf_n / (slatop(ft) * leaf_c ) end select @@ -580,8 +579,8 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) ! Units are in (kgN/plant) ! ------------------------------------------------------------------ - sapw_c = currentCohort%prt%GetState(sapw_organ, all_carbon_species) - fnrt_c = currentCohort%prt%GetState(fnrt_organ, all_carbon_species) + sapw_c = currentCohort%prt%GetState(sapw_organ, all_carbon_elements) + fnrt_c = currentCohort%prt%GetState(fnrt_organ, all_carbon_elements) select case(hlm_parteh_mode) case (prt_carbon_allom_hyp) @@ -597,12 +596,12 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) case(prt_cnp_flex_allom_hyp) live_stem_n = EDPftvarcon_inst%allom_agb_frac(currentCohort%pft) * & - currentCohort%prt%GetState(sapw_organ, nitrogen_species) + currentCohort%prt%GetState(sapw_organ, nitrogen_element) live_croot_n = (1.0_r8-EDPftvarcon_inst%allom_agb_frac(currentCohort%pft)) * & - currentCohort%prt%GetState(sapw_organ, nitrogen_species) + currentCohort%prt%GetState(sapw_organ, nitrogen_element) - fnrt_n = currentCohort%prt%GetState(fnrt_organ, nitrogen_species) + fnrt_n = currentCohort%prt%GetState(fnrt_organ, nitrogen_element) case default diff --git a/fire/SFMainMod.F90 b/fire/SFMainMod.F90 index 1acef0e088..8ad11e3fbc 100644 --- a/fire/SFMainMod.F90 +++ b/fire/SFMainMod.F90 @@ -29,17 +29,13 @@ module SFMainMod use EDtypesMod , only : TR_SF use PRTGenericMod, only : leaf_organ - use PRTGenericMod, only : all_carbon_species - use PRTGenericMod, only : carbon12_species - use PRTGenericMod, only : nitrogen_species - use PRTGenericMod, only : phosphorous_species + use PRTGenericMod, only : all_carbon_elements use PRTGenericMod, only : leaf_organ use PRTGenericMod, only : fnrt_organ use PRTGenericMod, only : sapw_organ use PRTGenericMod, only : store_organ use PRTGenericMod, only : repro_organ use PRTGenericMod, only : struct_organ - use PRTGenericMod, only : carbon12_species use PRTGenericMod, only : SetState @@ -184,7 +180,7 @@ subroutine charecteristics_of_fuel ( currentSite ) if(EDPftvarcon_inst%woody(currentCohort%pft) == 0)then currentPatch%livegrass = currentPatch%livegrass + & - currentCohort%prt%GetState(leaf_organ, all_carbon_species) * & + currentCohort%prt%GetState(leaf_organ, all_carbon_elements) * & currentCohort%n/currentPatch%area endif @@ -846,9 +842,9 @@ subroutine crown_scorching ( currentSite ) do while(associated(currentCohort)) if (EDPftvarcon_inst%woody(currentCohort%pft) == 1) then !trees only - leaf_c = currentCohort%prt%GetState(leaf_organ, all_carbon_species) - sapw_c = currentCohort%prt%GetState(sapw_organ, all_carbon_species) - struct_c = currentCohort%prt%GetState(struct_organ, all_carbon_species) + 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 + & @@ -868,9 +864,9 @@ subroutine crown_scorching ( currentSite ) 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_species) - sapw_c = currentCohort%prt%GetState(sapw_organ, all_carbon_species) - struct_c = currentCohort%prt%GetState(struct_organ, all_carbon_species) + 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) f_ag_bmass = currentCohort%n * (leaf_c + & EDPftvarcon_inst%allom_agb_frac(currentCohort%pft)*(sapw_c + struct_c)) & diff --git a/main/ChecksBalancesMod.F90 b/main/ChecksBalancesMod.F90 index f7b3235ecc..044a191fa2 100644 --- a/main/ChecksBalancesMod.F90 +++ b/main/ChecksBalancesMod.F90 @@ -5,10 +5,7 @@ module ChecksBalancesMod 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_species - use PRTGenericMod, only : carbon12_species - use PRTGenericMod, only : nitrogen_species - use PRTGenericMod, only : phosphorous_species + use PRTGenericMod, only : all_carbon_elements use PRTGenericMod, only : leaf_organ use PRTGenericMod, only : fnrt_organ use PRTGenericMod, only : sapw_organ @@ -89,12 +86,12 @@ subroutine SummarizeNetFluxes( nsites, sites, bc_in, is_beg_day ) ! map biomass pools to column level sites(s)%biomass_stock = sites(s)%biomass_stock + & - ( currentCohort%prt%GetState(struct_organ,all_carbon_species) + & - currentCohort%prt%GetState(sapw_organ,all_carbon_species) + & - currentCohort%prt%GetState(leaf_organ,all_carbon_species) + & - currentCohort%prt%GetState(fnrt_organ,all_carbon_species) + & - currentCohort%prt%GetState(store_organ,all_carbon_species) + & - currentCohort%prt%GetState(repro_organ,all_carbon_species) ) & + ( 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 @@ -281,12 +278,12 @@ subroutine SiteCarbonStock(currentSite,total_stock,biomass_stock,litter_stock,se currentCohort => currentPatch%tallest do while(associated(currentCohort)) biomass_stock = biomass_stock + & - (currentCohort%prt%GetState(struct_organ,all_carbon_species) + & - currentCohort%prt%GetState(sapw_organ,all_carbon_species) + & - currentCohort%prt%GetState(leaf_organ,all_carbon_species) + & - currentCohort%prt%GetState(fnrt_organ,all_carbon_species) + & - currentCohort%prt%GetState(store_organ,all_carbon_species) + & - currentCohort%prt%GetState(repro_organ,all_carbon_species) ) & + (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 diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index 55bd9cc336..af5256ed9f 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -54,10 +54,8 @@ module EDMainMod use ChecksBalancesMod , only : SiteCarbonStock use EDMortalityFunctionsMod , only : Mortality_Derivative - use PRTGenericMod, only : all_carbon_species - use PRTGenericMod, only : carbon12_species - use PRTGenericMod, only : nitrogen_species - use PRTGenericMod, only : phosphorous_species + use PRTGenericMod, only : carbon12_element + use PRTGenericMod, only : all_carbon_elements use PRTGenericMod, only : leaf_organ use PRTGenericMod, only : fnrt_organ use PRTGenericMod, only : sapw_organ @@ -346,7 +344,7 @@ subroutine ed_integrate_state_variables(currentSite, bc_in ) call currentCohort%prt%CheckMassConservation(ft,5) ! Transfer all reproductive tissues into seed production - call PRTReproRelease(currentCohort%prt,repro_organ,carbon12_species, & + call PRTReproRelease(currentCohort%prt,repro_organ,carbon12_element, & 1.0_r8, currentCohort%seed_prod) currentCohort%seed_prod = currentCohort%seed_prod / hlm_freq_day @@ -609,8 +607,8 @@ subroutine ed_total_balance_check (currentSite, call_index ) write(fates_log(),*)'---' currentCohort => currentPatch%tallest do while(associated(currentCohort)) - write(fates_log(),*) 'structure: ',currentCohort%prt%GetState(struct_organ,all_carbon_species) - write(fates_log(),*) 'storage: ',currentCohort%prt%GetState(store_organ,all_carbon_species) + write(fates_log(),*) 'structure: ',currentCohort%prt%GetState(struct_organ,all_carbon_elements) + write(fates_log(),*) 'storage: ',currentCohort%prt%GetState(store_organ,all_carbon_elements) write(fates_log(),*) 'N plant: ',currentCohort%n currentCohort => currentCohort%shorter; enddo !end cohort loop diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 73101a5bd9..14f8596fed 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -8,7 +8,7 @@ module EDTypesMod 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_species + use PRTGenericMod, only : all_carbon_elements implicit none save @@ -728,12 +728,12 @@ subroutine dump_cohort(ccohort) write(fates_log(),*) 'co%hite = ', ccohort%hite write(fates_log(),*) 'co%laimemory = ', ccohort%laimemory - write(fates_log(),*) 'leaf carbon = ', ccohort%prt%GetState(leaf_organ,all_carbon_species) - write(fates_log(),*) 'fineroot carbon = ', ccohort%prt%GetState(fnrt_organ,all_carbon_species) - write(fates_log(),*) 'sapwood carbon = ', ccohort%prt%GetState(sapw_organ,all_carbon_species) - write(fates_log(),*) 'structural (dead) carbon = ', ccohort%prt%GetState(struct_organ,all_carbon_species) - write(fates_log(),*) 'storage carbon = ', ccohort%prt%GetState(store_organ,all_carbon_species) - write(fates_log(),*) 'reproductive carbon = ', ccohort%prt%GetState(repro_organ,all_carbon_species) + 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) + write(fates_log(),*) 'sapwood carbon = ', ccohort%prt%GetState(sapw_organ,all_carbon_elements) + write(fates_log(),*) 'structural (dead) carbon = ', ccohort%prt%GetState(struct_organ,all_carbon_elements) + write(fates_log(),*) 'storage carbon = ', ccohort%prt%GetState(store_organ,all_carbon_elements) + write(fates_log(),*) 'reproductive carbon = ', ccohort%prt%GetState(repro_organ,all_carbon_elements) write(fates_log(),*) 'co%lai = ', ccohort%lai write(fates_log(),*) 'co%sai = ', ccohort%sai diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index f6ebb86ffd..8b6bf1bdd5 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -36,7 +36,7 @@ module FatesHistoryInterfaceMod use PRTGenericMod , only : leaf_organ, fnrt_organ, sapw_organ use PRTGenericMod , only : struct_organ, store_organ, repro_organ - use PRTGenericMod , only : all_carbon_species + use PRTGenericMod , only : all_carbon_elements implicit none @@ -1639,11 +1639,11 @@ subroutine update_history_dyn(this,nc,nsites,sites) ! Mass pools [kgC] - sapw_c = ccohort%prt%GetState(sapw_organ, all_carbon_species) - struct_c = ccohort%prt%GetState(struct_organ, all_carbon_species) - leaf_c = ccohort%prt%GetState(leaf_organ, all_carbon_species) - fnrt_c = ccohort%prt%GetState(fnrt_organ, all_carbon_species) - store_c = ccohort%prt%GetState(store_organ, all_carbon_species) + sapw_c = ccohort%prt%GetState(sapw_organ, all_carbon_elements) + struct_c = ccohort%prt%GetState(struct_organ, all_carbon_elements) + leaf_c = ccohort%prt%GetState(leaf_organ, all_carbon_elements) + fnrt_c = ccohort%prt%GetState(fnrt_organ, all_carbon_elements) + store_c = ccohort%prt%GetState(store_organ, all_carbon_elements) alive_c = leaf_c + fnrt_c + sapw_c total_c = alive_c + store_c + struct_c @@ -1702,19 +1702,19 @@ subroutine update_history_dyn(this,nc,nsites,sites) if( .not.(ccohort%isnew) ) then ! Turnover pools [kgC/day] / [yr/day] = [kgC/yr] - sapw_c_turnover = ccohort%prt%GetTurnover(sapw_organ, all_carbon_species) / hlm_freq_day - store_c_turnover = ccohort%prt%GetTurnover(store_organ, all_carbon_species) / hlm_freq_day - leaf_c_turnover = ccohort%prt%GetTurnover(leaf_organ, all_carbon_species) / hlm_freq_day - fnrt_c_turnover = ccohort%prt%GetTurnover(fnrt_organ, all_carbon_species) / hlm_freq_day - struct_c_turnover = ccohort%prt%GetTurnover(struct_organ, all_carbon_species) / hlm_freq_day + sapw_c_turnover = ccohort%prt%GetTurnover(sapw_organ, all_carbon_elements) / hlm_freq_day + store_c_turnover = ccohort%prt%GetTurnover(store_organ, all_carbon_elements) / hlm_freq_day + leaf_c_turnover = ccohort%prt%GetTurnover(leaf_organ, all_carbon_elements) / hlm_freq_day + fnrt_c_turnover = ccohort%prt%GetTurnover(fnrt_organ, all_carbon_elements) / hlm_freq_day + struct_c_turnover = ccohort%prt%GetTurnover(struct_organ, all_carbon_elements) / hlm_freq_day ! Net change from allocation and transport [kgC/day] / [yr/day] = [kgC/yr] - sapw_c_net_art = ccohort%prt%GetNetArt(sapw_organ, all_carbon_species) / hlm_freq_day - store_c_net_art = ccohort%prt%GetNetArt(store_organ, all_carbon_species) / hlm_freq_day - leaf_c_net_art = ccohort%prt%GetNetArt(leaf_organ, all_carbon_species) / hlm_freq_day - fnrt_c_net_art = ccohort%prt%GetNetArt(fnrt_organ, all_carbon_species) / hlm_freq_day - struct_c_net_art = ccohort%prt%GetNetArt(struct_organ, all_carbon_species) / hlm_freq_day - repro_c_net_art = ccohort%prt%GetNetArt(repro_organ, all_carbon_species) / hlm_freq_day + sapw_c_net_art = ccohort%prt%GetNetAlloc(sapw_organ, all_carbon_elements) / hlm_freq_day + store_c_net_art = ccohort%prt%GetNetAlloc(store_organ, all_carbon_elements) / hlm_freq_day + leaf_c_net_art = ccohort%prt%GetNetAlloc(leaf_organ, all_carbon_elements) / hlm_freq_day + fnrt_c_net_art = ccohort%prt%GetNetAlloc(fnrt_organ, all_carbon_elements) / hlm_freq_day + struct_c_net_art = ccohort%prt%GetNetAlloc(struct_organ, all_carbon_elements) / hlm_freq_day + repro_c_net_art = ccohort%prt%GetNetAlloc(repro_organ, all_carbon_elements) / hlm_freq_day associate( scpf => ccohort%size_by_pft_class, & diff --git a/main/FatesRestartInterfaceMod.F90 b/main/FatesRestartInterfaceMod.F90 index 2e0a096ff9..cf00f9c51b 100644 --- a/main/FatesRestartInterfaceMod.F90 +++ b/main/FatesRestartInterfaceMod.F90 @@ -13,16 +13,6 @@ module FatesRestartInterfaceMod use FatesInterfaceMod, only : bc_in_type use FatesSizeAgeTypeIndicesMod, only : get_sizeage_class_index - use PRTGenericMod, only : all_carbon_species - use PRTGenericMod, only : carbon12_species - use PRTGenericMod, only : nitrogen_species - use PRTGenericMod, only : phosphorous_species - use PRTGenericMod, only : leaf_organ - use PRTGenericMod, only : fnrt_organ - use PRTGenericMod, only : sapw_organ - use PRTGenericMod, only : store_organ - use PRTGenericMod, only : repro_organ - use PRTGenericMod, only : struct_organ use PRTGenericMod, only : prt_global @@ -862,7 +852,7 @@ subroutine DefinePRTRestartVars(this,initialize_variables,ivar) ! ! We do have to loop through the different parts of the objects indepenently. ! For instance we can't have one loop that covers the states "val", and - ! the net allocation and reactive transport flux "net_art", so we have to loop + ! the net allocation and reactive transport flux "net_alloc", so we have to loop ! these each separately. As other fluxes are added in the future, they need ! their own definition. ! @@ -1236,7 +1226,7 @@ subroutine set_restart_vectors(this,nc,nsites,sites) ir_prt_var = ir_prt_var + 1 this%rvars(ir_prt_var)%r81d(io_idx_co) = & - ccohort%prt%variables(i_var)%net_art(i_pos) + ccohort%prt%variables(i_var)%net_alloc(i_pos) ir_prt_var = ir_prt_var + 1 this%rvars(ir_prt_var)%r81d(io_idx_co) = & @@ -1804,7 +1794,7 @@ subroutine get_restart_vectors(this, nc, nsites, sites) this%rvars(ir_prt_var)%r81d(io_idx_co) ir_prt_var = ir_prt_var + 1 - ccohort%prt%variables(i_var)%net_art(i_pos) = & + ccohort%prt%variables(i_var)%net_alloc(i_pos) = & this%rvars(ir_prt_var)%r81d(io_idx_co) ir_prt_var = ir_prt_var + 1 diff --git a/parteh/PRTAllometricCarbonMod.F90 b/parteh/PRTAllometricCarbonMod.F90 index 567b23e2e3..8a2da57bc2 100644 --- a/parteh/PRTAllometricCarbonMod.F90 +++ b/parteh/PRTAllometricCarbonMod.F90 @@ -15,7 +15,7 @@ module PRTAllometricCarbonMod use PRTGenericMod , only : prt_global use PRTGenericMod , only : prt_vartype use PRTGenericMod , only : prt_vartypes - use PRTGenericMod , only : carbon12_species + use PRTGenericMod , only : carbon12_element use PRTGenericMod , only : leaf_organ use PRTGenericMod , only : fnrt_organ use PRTGenericMod , only : sapw_organ @@ -187,12 +187,12 @@ subroutine InitPRTGlobalAllometricCarbon() ! Register the variables. Each variable must be associated with a global identifier ! for an organ and species. - call prt_global_ac%RegisterVarInGlobal(leaf_c_id,"Leaf Carbon","leaf_c",leaf_organ,carbon12_species,icd) - call prt_global_ac%RegisterVarInGlobal(fnrt_c_id,"Fine Root Carbon","fnrt_c",fnrt_organ,carbon12_species,icd) - call prt_global_ac%RegisterVarInGlobal(sapw_c_id,"Sapwood Carbon","sapw_c",sapw_organ,carbon12_species,icd) - call prt_global_ac%RegisterVarInGlobal(store_c_id,"Storage Carbon","store_c",store_organ,carbon12_species,icd) - call prt_global_ac%RegisterVarInGlobal(struct_c_id,"Structural Carbon","struct_c",struct_organ,carbon12_species,icd) - call prt_global_ac%RegisterVarInGlobal(repro_c_id,"Reproductive Carbon","repro_c",repro_organ,carbon12_species,icd) + call prt_global_ac%RegisterVarInGlobal(leaf_c_id,"Leaf Carbon","leaf_c",leaf_organ,carbon12_element,icd) + call prt_global_ac%RegisterVarInGlobal(fnrt_c_id,"Fine Root Carbon","fnrt_c",fnrt_organ,carbon12_element,icd) + call prt_global_ac%RegisterVarInGlobal(sapw_c_id,"Sapwood Carbon","sapw_c",sapw_organ,carbon12_element,icd) + call prt_global_ac%RegisterVarInGlobal(store_c_id,"Storage Carbon","store_c",store_organ,carbon12_element,icd) + call prt_global_ac%RegisterVarInGlobal(struct_c_id,"Structural Carbon","struct_c",struct_organ,carbon12_element,icd) + call prt_global_ac%RegisterVarInGlobal(repro_c_id,"Reproductive Carbon","repro_c",repro_organ,carbon12_element,icd) ! Set some of the array sizes for input and output boundary conditions prt_global_ac%num_bc_in = num_bc_in @@ -368,7 +368,7 @@ subroutine DailyPRTAllometricCarbon(this) ! ----------------------------------------------------------------------------------- ! I. Remember the values for the state variables at the beginning of this ! routines. We will then use that to determine their net allocation and reactive - ! transport flux "%net_art" at the end. + ! transport flux "%net_alloc" at the end. ! ----------------------------------------------------------------------------------- leaf_c0 = leaf_c ! Set initial leaf carbon @@ -809,23 +809,23 @@ subroutine DailyPRTAllometricCarbon(this) ! Track the net allocations and transport from this routine - this%variables(leaf_c_id)%net_art(icd) = & - this%variables(leaf_c_id)%net_art(icd) + (leaf_c - leaf_c0) + this%variables(leaf_c_id)%net_alloc(icd) = & + this%variables(leaf_c_id)%net_alloc(icd) + (leaf_c - leaf_c0) - this%variables(fnrt_c_id)%net_art(icd) = & - this%variables(fnrt_c_id)%net_art(icd) + (fnrt_c - fnrt_c0) + this%variables(fnrt_c_id)%net_alloc(icd) = & + this%variables(fnrt_c_id)%net_alloc(icd) + (fnrt_c - fnrt_c0) - this%variables(sapw_c_id)%net_art(icd) = & - this%variables(sapw_c_id)%net_art(icd) + (sapw_c - sapw_c0) + this%variables(sapw_c_id)%net_alloc(icd) = & + this%variables(sapw_c_id)%net_alloc(icd) + (sapw_c - sapw_c0) - this%variables(store_c_id)%net_art(icd) = & - this%variables(store_c_id)%net_art(icd) + (store_c - store_c0) + this%variables(store_c_id)%net_alloc(icd) = & + this%variables(store_c_id)%net_alloc(icd) + (store_c - store_c0) - this%variables(repro_c_id)%net_art(icd) = & - this%variables(repro_c_id)%net_art(icd) + (repro_c - repro_c0) + this%variables(repro_c_id)%net_alloc(icd) = & + this%variables(repro_c_id)%net_alloc(icd) + (repro_c - repro_c0) - this%variables(struct_c_id)%net_art(icd) = & - this%variables(struct_c_id)%net_art(icd) + (struct_c - struct_c0) + this%variables(struct_c_id)%net_alloc(icd) = & + this%variables(struct_c_id)%net_alloc(icd) + (struct_c - struct_c0) diff --git a/parteh/PRTGenericMod.F90 b/parteh/PRTGenericMod.F90 index 5a5dba681d..945283694c 100644 --- a/parteh/PRTGenericMod.F90 +++ b/parteh/PRTGenericMod.F90 @@ -6,8 +6,13 @@ module PRTGenericMod ! ! Non-Specific (Generic) Classes and Functions ! This contains the base classes for both the variables and the global class - ! This also contains science relevent procedures that are agnostic of hypothesis - ! such as maintenance turnover and restranslocation. + ! + ! General idea: PARTEH treats its state variables as objects. Each object + ! can be mapped to, or associated with: + ! 1) an organ + ! 2) a spatial position associated with that organ + ! 3) a chemical element (ie carbon isotope or nutrient), aka chemical species + ! ! ! THIS ROUTINE SHOULD NOT HAVE TO BE MODIFIED TO ACCOMODATE NEW HYPOTHESES ! (in principle ...) @@ -42,7 +47,7 @@ module PRTGenericMod ! ------------------------------------------------------------------------------------- ! IMPORTANT! - ! All species in all organs should be expressed in terms of KILOGRAMS + ! All elements in all organs should be expressed in terms of KILOGRAMS ! All rates of change are expressed in terms of kilograms / day ! This assumption cannot be broken! ! ------------------------------------------------------------------------------------- @@ -75,59 +80,59 @@ module PRTGenericMod integer, parameter :: struct_organ = 6 ! index for structure (dead) organs ! ------------------------------------------------------------------------------------- - ! Species types - ! These are public indices used to map the species in each hypothesis - ! to the species that are acknowledged in the calling model + ! Element types + ! These are public indices used to map the elements (chem species) in each hypothesis + ! to the element that are acknowledged in the calling model ! ------------------------------------------------------------------------------------- - integer, parameter :: num_species_types = 6 ! Total number of unique species + integer, parameter :: num_element_types = 6 ! Total number of unique element ! curently recognized by PARTEH ! should be max index in list below ! The following list are the unique indices associated with the - ! species used in each hypothesis. Note these are just POTENTIAL - ! species. At the time of writing this, we are very far away from + ! element used in each hypothesis. Note these are just POTENTIAL + ! element. At the time of writing this, we are very far away from ! creating allocation schemes that even use potassium. - integer, parameter :: all_carbon_species = 0 - integer, parameter :: carbon12_species = 1 - integer, parameter :: carbon13_species = 2 - integer, parameter :: carbon14_species = 3 - integer, parameter :: nitrogen_species = 4 - integer, parameter :: phosphorous_species = 5 - integer, parameter :: potassium_species = 6 - - ! The following species are just placeholders. In the future + 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 + + ! 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_species = 7 - ! integer, parameter :: magnesium_species = 8 - ! integer, parameter :: sulfur_species = 9 - ! integer, parameter :: chlorine_species = 10 - ! integer, parameter :: iron_species = 11 - ! integer, parameter :: manganese_species = 12 - ! integer, parameter :: zinc_species = 13 - ! integer, parameter :: copper_species = 14 - ! integer, parameter :: boron_species = 15 - ! integer, parameter :: molybdenum_species = 16 - ! integer, parameter :: nickel_species = 17 + ! 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 - ! We have some lists of species or lists of organs, such as - ! a list of all carbon species. To keep routines simple + ! 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 - ! carbon species is the biggest list + ! the carbon elements are the biggest list ! right now - ! List of all carbon species, the special index "all_carbon_species" + ! List of all carbon elements, the special index "all_carbon_elements" ! implies the following list of carbon organs - integer, parameter, dimension(3) :: carbon_species_list = & - [carbon12_species, carbon13_species, carbon14_species] + integer, parameter, dimension(3) :: carbon_elements_list = & + [carbon12_element, carbon13_element, carbon14_element] ! ------------------------------------------------------------------------------------- @@ -146,12 +151,12 @@ module PRTGenericMod ! NESTED in the prt_vartypes (<---- see the "s" at the end?) structure that follows. ! ! Each object will have a unique index associated with it, it will also be mapped - ! to a specific organ and species combination. + ! to a specific organ and element combination. ! ! It is assumed that over the control period (probably 1 day) that ! changes in the current state (val) relative to the value at the start of the ! control period (val0), are equal to the time integrated flux terms - ! (net_art, turnover, etc) + ! (net_alloc, turnover, etc) ! ! ------------------------------------------------------------------------------------- @@ -160,7 +165,7 @@ module PRTGenericMod real(r8),allocatable :: val(:) ! Instantaneous state variable [kg] real(r8),allocatable :: val0(:) ! State variable at the beginning ! of the control period [kg] - real(r8),allocatable :: net_art(:) ! Net change due to allocation/transport [kg] + real(r8),allocatable :: net_alloc(:) ! Net change due to allocation/transport [kg] ! over the control period [kg] real(r8),allocatable :: turnover(:) ! Losses due to turnover [kg] ! or, any mass destined for litter @@ -237,7 +242,7 @@ module PRTGenericMod procedure, non_overridable :: GetState procedure, non_overridable :: GetTurnover procedure, non_overridable :: GetBurned - procedure, non_overridable :: GetNetART + procedure, non_overridable :: GetNetAlloc procedure, non_overridable :: ZeroRates procedure, non_overridable :: CheckMassConservation procedure, non_overridable :: DeallocatePRTVartypes @@ -269,7 +274,7 @@ module PRTGenericMod character(len=maxlen_varname) :: longname character(len=maxlen_varsymbol) :: symbol integer :: organ_id ! global id for organ - integer :: spec_id ! global id for species + integer :: element_id ! global id for element integer :: num_pos ! number of descrete spatial positions ! Also, will probably need flags to define different types of groups that this variable @@ -281,11 +286,11 @@ module PRTGenericMod ! This type will help us loop through all the different variables associated ! with a specific organ type. Since variables are a combination of organ and - ! species, the number of unique variables is capped at the number of species + ! element, the number of unique variables is capped at the number of elements ! per each organ. type organ_map_type - integer, dimension(1:num_species_types) :: var_id + integer, dimension(1:num_element_types) :: var_id integer :: num_vars end type organ_map_type @@ -293,7 +298,7 @@ module PRTGenericMod ! This structure packs both the mapping structure and the variable descriptors ! ------------------------------------------------------------------------------------- ! This array should contain the lists of indices to - ! the species x organ variable structure that is used to map variables to the outside + ! the element x organ variable structure that is used to map variables to the outside ! world. ! ! @@ -310,20 +315,19 @@ module PRTGenericMod ! ! ------------------------------------------------------------------------------------- - type prt_global_type ! Note that index 0 is reserved for "all" or "irrelevant" character(len=maxlen_varname) :: hyp_name - ! This will save the specific variable id associated with each organ and species - integer, dimension(0:num_organ_types,0:num_species_types) :: sp_organ_map + ! This will save the specific variable id associated with each organ and element + integer, dimension(0:num_organ_types,0:num_element_types) :: sp_organ_map - + ! This holds the verbose descriptions of the variables, symbols, names, etc type(state_descriptor_type), allocatable :: state_descriptor(:) ! This will save the list of variable ids associated with each organ. There - ! are multiple of these because we may have multiple species per organ. + ! are multiple of these because we may have multiple element per organ. type(organ_map_type), dimension(1:num_organ_types) :: organ_map ! The number of input boundary conditions @@ -361,7 +365,7 @@ subroutine ZeroGlobal(this) ! This subroutine zero's out the map between variable indexes and the - ! species and organs they are associated with. + ! elements and organs they are associated with. ! It also sets the counts of the variables and boundary conditions as ! a nonsense number that will trigger a fail if they are specified later. ! This routine must be called @@ -370,11 +374,11 @@ subroutine ZeroGlobal(this) class(prt_global_type) :: this integer :: io ! Organ loop counter - integer :: is ! Species loop counter + integer :: is ! Element loop counter ! First zero out the array do io = 1,num_organ_types - do is = 1,num_species_types + do is = 1,num_element_types this%sp_organ_map(io,is) = 0 this%organ_map(io)%var_id(is) = 0 end do @@ -395,33 +399,33 @@ end subroutine ZeroGlobal ! ===================================================================================== - subroutine RegisterVarInGlobal(this, var_id, long_name, symbol, organ_id, spec_id, num_pos) + subroutine RegisterVarInGlobal(this, var_id, long_name, symbol, organ_id, element_id, num_pos) ! This subroutine is called for each variable that is defined in each specific hypothesis. ! For instance, this is called six times in the carbon only hypothesis, - ! each time providing names, symbols, associated organs and species for each pool. + ! each time providing names, symbols, associated organs and element for each pool. class(prt_global_type) :: this integer, intent(in) :: var_id character(len=*),intent(in) :: long_name character(len=*),intent(in) :: symbol integer, intent(in) :: organ_id - integer, intent(in) :: spec_id + integer, intent(in) :: element_id integer, intent(in) :: num_pos - ! Set the descriptions and the associated organs/species in the variable's + ! Set the descriptions and the associated organs/element in the variable's ! own array - this%state_descriptor(var_id)%longname = long_name - this%state_descriptor(var_id)%symbol = symbol - this%state_descriptor(var_id)%organ_id = organ_id - this%state_descriptor(var_id)%spec_id = spec_id - this%state_descriptor(var_id)%num_pos = num_pos + this%state_descriptor(var_id)%longname = long_name + this%state_descriptor(var_id)%symbol = symbol + this%state_descriptor(var_id)%organ_id = organ_id + this%state_descriptor(var_id)%element_id = element_id + this%state_descriptor(var_id)%num_pos = num_pos ! Set the mapping tables for the external model - this%sp_organ_map(organ_id,spec_id) = var_id + this%sp_organ_map(organ_id,element_id) = var_id ! Set another map that helps to locate all the relevant pools associated ! with an organ @@ -497,7 +501,7 @@ subroutine InitAllocate(this) allocate(this%variables(i_var)%val(num_pos)) allocate(this%variables(i_var)%val0(num_pos)) allocate(this%variables(i_var)%turnover(num_pos)) - allocate(this%variables(i_var)%net_art(num_pos)) + allocate(this%variables(i_var)%net_alloc(num_pos)) allocate(this%variables(i_var)%burned(num_pos)) end do @@ -520,11 +524,11 @@ subroutine InitializeInitialConditions(this) integer :: i_var ! Variable index do i_var = 1, prt_global%num_vars - this%variables(i_var)%val(:) = un_initialized - this%variables(i_var)%val0(:) = un_initialized - this%variables(i_var)%turnover(:) = un_initialized - this%variables(i_var)%burned(:) = un_initialized - this%variables(i_var)%net_art(:) = un_initialized + this%variables(i_var)%val(:) = un_initialized + this%variables(i_var)%val0(:) = un_initialized + this%variables(i_var)%turnover(:) = un_initialized + this%variables(i_var)%burned(:) = un_initialized + this%variables(i_var)%net_alloc(:) = un_initialized end do ! Initialize the optimum step size as very large. @@ -553,8 +557,8 @@ subroutine CheckInitialConditions(this) integer :: i_var ! index for iterating variables integer :: n_cor_ids ! Number of coordinate ids integer :: i_cor ! index for iterating coordinate dimension - integer :: i_gorgan ! The global organ id for this variable - integer :: i_gspecies ! The global species id for this variable + integer :: i_organ ! The global organ id for this variable + integer :: i_element ! The global element id for this variable do i_var = 1, prt_global%num_vars @@ -564,16 +568,16 @@ subroutine CheckInitialConditions(this) if(this%variables(i_var)%val(i_cor) < check_initialized) then - i_gorgan = prt_global%state_descriptor(i_var)%organ_id - i_gspecies = prt_global%state_descriptor(i_var)%spec_id + i_organ = prt_global%state_descriptor(i_var)%organ_id + i_element = prt_global%state_descriptor(i_var)%element_id write(fates_log(),*)'Not all initial conditions for state variables' write(fates_log(),*)' in PRT hypothesis: ',trim(prt_global%hyp_name) write(fates_log(),*)' were written out.' write(fates_log(),*)' i_var: ',i_var write(fates_log(),*)' i_cor: ',i_cor - write(fates_log(),*)' organ_id:',i_gorgan - write(fates_log(),*)' species_id',i_gspecies + write(fates_log(),*)' organ_id:',i_organ + write(fates_log(),*)' element_id',i_element write(fates_log(),*)'Exiting' call endrun(msg=errMsg(__FILE__, __LINE__)) end if @@ -643,8 +647,8 @@ subroutine RegisterBCIn(this,bc_id, bc_rval, bc_ival ) ! Input Arguments - class(prt_vartypes) :: this - integer,intent(in) :: bc_id + class(prt_vartypes) :: this + integer,intent(in) :: bc_id real(r8),optional, intent(inout), target :: bc_rval integer, optional, intent(inout), target :: bc_ival @@ -742,7 +746,7 @@ subroutine CopyPRTVartypes(this, donor_prt_obj) do i_var = 1, prt_global%num_vars this%variables(i_var)%val(:) = donor_prt_obj%variables(i_var)%val(:) this%variables(i_var)%val0(:) = donor_prt_obj%variables(i_var)%val0(:) - this%variables(i_var)%net_art(:) = donor_prt_obj%variables(i_var)%net_art(:) + this%variables(i_var)%net_alloc(:) = donor_prt_obj%variables(i_var)%net_alloc(:) this%variables(i_var)%turnover(:) = donor_prt_obj%variables(i_var)%turnover(:) this%variables(i_var)%burned(:) = donor_prt_obj%variables(i_var)%burned(:) end do @@ -764,12 +768,12 @@ subroutine WeightedFusePRTVartypes(this,donor_prt_obj, recipient_fuse_weight, po class(prt_vartypes) :: this class(prt_vartypes), intent(in), pointer :: donor_prt_obj real(r8),intent(in) :: recipient_fuse_weight ! This is the weighting - ! for the recipient + ! for the recipient integer,intent(in),optional :: position_id ! Locals - integer :: i_var ! Loop iterator over variables - integer :: pos_id ! coordinate id (defaults to 1) + integer :: i_var ! Loop iterator over variables + integer :: pos_id ! coordinate id (defaults to 1, if not position_id) if(present(position_id)) then pos_id = position_id @@ -785,8 +789,8 @@ subroutine WeightedFusePRTVartypes(this,donor_prt_obj, recipient_fuse_weight, po this%variables(i_var)%val0(pos_id) = recipient_fuse_weight * this%variables(i_var)%val0(pos_id) + & (1.0_r8-recipient_fuse_weight) * donor_prt_obj%variables(i_var)%val0(pos_id) - this%variables(i_var)%net_art(pos_id) = recipient_fuse_weight * this%variables(i_var)%net_art(pos_id) + & - (1.0_r8-recipient_fuse_weight) * donor_prt_obj%variables(i_var)%net_art(pos_id) + this%variables(i_var)%net_alloc(pos_id) = recipient_fuse_weight * this%variables(i_var)%net_alloc(pos_id) + & + (1.0_r8-recipient_fuse_weight) * donor_prt_obj%variables(i_var)%net_alloc(pos_id) this%variables(i_var)%turnover(pos_id) = recipient_fuse_weight * this%variables(i_var)%turnover(pos_id) + & (1.0_r8-recipient_fuse_weight) * donor_prt_obj%variables(i_var)%turnover(pos_id) @@ -819,7 +823,6 @@ subroutine DeallocatePRTVartypes(this) ! --------------------------------------------------------------------------------- class(prt_vartypes) :: this - integer :: i_var ! Check to see if there is any value in these pools? @@ -828,7 +831,7 @@ subroutine DeallocatePRTVartypes(this) do i_var = 1, prt_global%num_vars deallocate(this%variables(i_var)%val) deallocate(this%variables(i_var)%val0) - deallocate(this%variables(i_var)%net_art) + deallocate(this%variables(i_var)%net_alloc) deallocate(this%variables(i_var)%turnover) deallocate(this%variables(i_var)%burned) end do @@ -858,7 +861,7 @@ subroutine ZeroRates(this) ! This subroutine zeros all of the rates of change for our variables. ! It also sets the initial value to the current state. ! This allows us to make mass conservation checks, where - ! val - val0 = net_art + turnover + ! val - val0 = net_alloc + turnover ! ! This subroutine is called each day in FATES, which is the control interval ! that we conserve carbon from the allocation and turnover process. @@ -869,10 +872,10 @@ subroutine ZeroRates(this) integer :: i_var ! Variable index do i_var = 1, prt_global%num_vars - this%variables(i_var)%val0(:) = this%variables(i_var)%val(:) - this%variables(i_var)%net_art(:) = 0.0_r8 - this%variables(i_var)%turnover(:) = 0.0_r8 - this%variables(i_var)%burned(:) = 0.0_r8 + this%variables(i_var)%val0(:) = this%variables(i_var)%val(:) + this%variables(i_var)%net_alloc(:) = 0.0_r8 + this%variables(i_var)%turnover(:) = 0.0_r8 + this%variables(i_var)%burned(:) = 0.0_r8 end do end subroutine ZeroRates @@ -889,16 +892,16 @@ subroutine CheckMassConservation(this,ipft,position_id) ! to differentiate where in the call sequence a failure in conservation occurs. ! --------------------------------------------------------------------------------- - class(prt_vartypes) :: this - integer, intent(in) :: ipft + class(prt_vartypes) :: this + integer, intent(in) :: ipft ! functional type of the plant integer, intent(in) :: position_id ! Helps to know where ! in the call sequence this was called integer :: i_var ! Variable index integer :: i_pos ! Position (coordinate) index - real(r8) :: err - real(r8) :: rel_err + real(r8) :: err ! absolute error [kg] + real(r8) :: rel_err ! error relative to the pool's size [kg] do i_var = 1, prt_global%num_vars @@ -906,11 +909,11 @@ subroutine CheckMassConservation(this,ipft,position_id) do i_pos = 1, prt_global%state_descriptor(i_var)%num_pos err = abs((this%variables(i_var)%val(i_pos) - this%variables(i_var)%val0(i_pos)) - & - (this%variables(i_var)%net_art(i_pos) & + (this%variables(i_var)%net_alloc(i_pos) & -this%variables(i_var)%turnover(i_pos) & -this%variables(i_var)%burned(i_pos) )) - if(this%variables(i_var)%val(i_pos) > nearzero) then + if(this%variables(i_var)%val(i_pos) > nearzero ) then rel_err = err / this%variables(i_var)%val(i_pos) else rel_err = 0.0_r8 @@ -923,14 +926,14 @@ subroutine CheckMassConservation(this,ipft,position_id) write(fates_log(),*) ' pft id: ',ipft write(fates_log(),*) ' position id: ',position_id write(fates_log(),*) ' organ id: ',prt_global%state_descriptor(i_var)%organ_id - write(fates_log(),*) ' species_id: ',prt_global%state_descriptor(i_var)%spec_id + write(fates_log(),*) ' element_id: ',prt_global%state_descriptor(i_var)%element_id write(fates_log(),*) ' position id: ',i_pos write(fates_log(),*) ' symbol: ',trim(prt_global%state_descriptor(i_var)%symbol) write(fates_log(),*) ' longname: ',trim(prt_global%state_descriptor(i_var)%longname) write(fates_log(),*) ' err: ',err,' max error: ',calloc_abs_error write(fates_log(),*) ' terms: ', this%variables(i_var)%val(i_pos), & this%variables(i_var)%val0(i_pos), & - this%variables(i_var)%net_art(i_pos), & + this%variables(i_var)%net_alloc(i_pos), & this%variables(i_var)%turnover(i_pos), & this%variables(i_var)%burned(i_pos) write(fates_log(),*) ' Exiting.' @@ -945,53 +948,52 @@ end subroutine CheckMassConservation ! ==================================================================================== - function GetState(this, organ_id, species_id, position_id) result(sp_organ_val) + function GetState(this, organ_id, element_id, position_id) result(state_val) ! This function returns the current amount of mass for - ! any combination of organ and species. **IF** a position + ! any combination of organ and element. **IF** a position ! is provided, it will use it, but otherwise, it will sum over - ! all dimensions. It also can accomodate all_carbon_species, which + ! all dimensions. It also can accomodate all_carbon_element, which ! will return the mass of all carbon isotopes combined. - - - class(prt_vartypes) :: this - integer,intent(in) :: organ_id - integer,intent(in) :: species_id - integer,intent(in),optional :: position_id - real(r8) :: sp_organ_val - - integer :: i_pos - integer :: ispec - integer :: num_species - integer,dimension(max_spec_per_group) :: spec_ids - integer :: i_var + + class(prt_vartypes) :: this + integer,intent(in) :: organ_id ! Organ type querried + integer,intent(in) :: element_id ! Element type querried + integer,intent(in),optional :: position_id ! Position querried + real(r8) :: state_val ! Mass (value) of state variable [kg] + + integer :: i_pos ! position loop counter + integer :: i_element ! element loop counter + integer :: num_element ! total number of elements + integer,dimension(max_spec_per_group) :: element_ids ! element ids (if element list) + integer :: i_var ! variable id - sp_organ_val = 0.0_r8 + state_val = 0.0_r8 - if(species_id == all_carbon_species) then - spec_ids(1:3) = carbon_species_list(1:3) - num_species = 3 + if(element_id == all_carbon_elements) then + element_ids(1:3) = carbon_elements_list(1:3) + num_element = 3 else - num_species = 1 - spec_ids(1) = species_id + num_element = 1 + element_ids(1) = element_id end if if(present(position_id)) then i_pos = position_id - do ispec = 1,num_species - i_var = prt_global%sp_organ_map(organ_id,spec_ids(ispec)) - if (i_var>0) sp_organ_val = sp_organ_val + this%variables(i_var)%val(i_pos) + do i_element = 1,num_element + i_var = prt_global%sp_organ_map(organ_id,element_ids(i_element)) + if (i_var>0) state_val = state_val + this%variables(i_var)%val(i_pos) end do else - do ispec = 1,num_species + do i_element = 1,num_element - i_var = prt_global%sp_organ_map(organ_id,spec_ids(ispec)) + i_var = prt_global%sp_organ_map(organ_id,element_ids(i_element)) if(i_var>0)then do i_pos = 1, prt_global%state_descriptor(i_var)%num_pos - sp_organ_val = sp_organ_val + this%variables(i_var)%val(i_pos) + state_val = state_val + this%variables(i_var)%val(i_pos) end do end if @@ -1006,7 +1008,7 @@ end function GetState ! ==================================================================================== - function GetTurnover(this, organ_id, species_id, position_id) result(sp_organ_turnover) + function GetTurnover(this, organ_id, element_id, position_id) result(turnover_val) ! THis function is very similar to GetState, with the only difference that it @@ -1015,44 +1017,44 @@ function GetTurnover(this, organ_id, species_id, position_id) result(sp_organ_tu ! NOTE: THIS HAS NOTHING TO DO WITH SPECIFYING TURNOVER. THIS IS JUST A QUERY FUNCTION - class(prt_vartypes) :: this - integer,intent(in) :: organ_id - integer,intent(in) :: species_id - integer,intent(in),optional :: position_id - real(r8) :: sp_organ_turnover + class(prt_vartypes) :: this + integer,intent(in) :: organ_id ! Organ type querried + integer,intent(in) :: element_id ! Element type querried + integer,intent(in),optional :: position_id ! Position querried + real(r8) :: turnover_val ! Amount (value) of turnover [kg] - integer :: i_pos - integer :: ispec - integer :: num_species - integer,dimension(max_spec_per_group) :: spec_ids - integer :: i_var + integer :: i_pos ! position loop counter + integer :: i_element ! element loop counter + integer :: num_element ! total number of elements + integer,dimension(max_spec_per_group) :: element_ids ! element ids (if element list) + integer :: i_var ! variable id - sp_organ_turnover = 0.0_r8 + turnover_val = 0.0_r8 - if(species_id == all_carbon_species) then - spec_ids(1:3) = carbon_species_list(1:3) - num_species = 3 + if(element_id == all_carbon_elements) then + element_ids(1:3) = carbon_elements_list(1:3) + num_element = 3 else - num_species = 1 - spec_ids(1) = species_id + num_element = 1 + element_ids(1) = element_id end if if(present(position_id)) then i_pos = position_id - do ispec = 1,num_species - i_var = prt_global%sp_organ_map(organ_id,spec_ids(ispec)) - if(i_var>0) sp_organ_turnover = sp_organ_turnover + & + do i_element = 1,num_element + i_var = prt_global%sp_organ_map(organ_id,element_ids(i_element)) + if(i_var>0) turnover_val = turnover_val + & this%variables(i_var)%turnover(i_pos) end do else - do ispec = 1,num_species - i_var = prt_global%sp_organ_map(organ_id,spec_ids(ispec)) + do i_element = 1,num_element + i_var = prt_global%sp_organ_map(organ_id,element_ids(i_element)) if(i_var>0) then do i_pos = 1, prt_global%state_descriptor(i_var)%num_pos - sp_organ_turnover = sp_organ_turnover + this%variables(i_var)%turnover(i_pos) + turnover_val = turnover_val + this%variables(i_var)%turnover(i_pos) end do end if @@ -1065,51 +1067,52 @@ end function GetTurnover ! ========================================================================= - function GetBurned(this, organ_id, species_id, position_id) result(sp_organ_burned) + function GetBurned(this, organ_id, element_id, position_id) result(burned_val) ! THis function is very similar to GetTurnover, with the only difference that it ! returns the burned mass so-far during the period of interest. ! NOTE: THIS HAS NOTHING TO DO WITH SPECIFYING BURNING. THIS IS JUST A QUERY FUNCTION - class(prt_vartypes) :: this - integer,intent(in) :: organ_id - integer,intent(in) :: species_id - integer,intent(in),optional :: position_id - real(r8) :: sp_organ_burned - - integer :: i_pos - integer :: ispec - integer :: num_species - integer,dimension(max_spec_per_group) :: spec_ids - integer :: i_var + class(prt_vartypes) :: this + integer,intent(in) :: organ_id ! Organ type querried + integer,intent(in) :: element_id ! Element type querried + integer,intent(in),optional :: position_id ! Position querried + real(r8) :: burned_val ! Amount (value) of burned [kg] + + integer :: i_pos ! position loop counter + integer :: i_element ! element loop counter + integer :: num_element ! total number of elements + integer,dimension(max_spec_per_group) :: element_ids ! element ids (if element list) + integer :: i_var ! variable id + - sp_organ_burned = 0.0_r8 + burned_val = 0.0_r8 - if(species_id == all_carbon_species) then - spec_ids(1:3) = carbon_species_list(1:3) - num_species = 3 + if(element_id == all_carbon_elements) then + element_ids(1:3) = carbon_elements_list(1:3) + num_element = 3 else - num_species = 1 - spec_ids(1) = species_id + num_element = 1 + element_ids(1) = element_id end if if(present(position_id)) then i_pos = position_id - do ispec = 1,num_species - i_var = prt_global%sp_organ_map(organ_id,spec_ids(ispec)) - if(i_var>0) sp_organ_burned = sp_organ_burned + & + do i_element = 1,num_element + i_var = prt_global%sp_organ_map(organ_id,element_ids(i_element)) + if(i_var>0) burned_val = burned_val + & this%variables(i_var)%burned(i_pos) end do else - do ispec = 1,num_species - i_var = prt_global%sp_organ_map(organ_id,spec_ids(ispec)) + do i_element = 1,num_element + i_var = prt_global%sp_organ_map(organ_id,element_ids(i_element)) if(i_var>0) then do i_pos = 1, prt_global%state_descriptor(i_var)%num_pos - sp_organ_burned = sp_organ_burned + this%variables(i_var)%burned(i_pos) + burned_val = burned_val + this%variables(i_var)%burned(i_pos) end do end if @@ -1122,7 +1125,7 @@ end function GetBurned ! ==================================================================================== - function GetNetART(this, organ_id, species_id, position_id) result(sp_organ_netart) + function GetNetAlloc(this, organ_id, element_id, position_id) result(val_netalloc) ! THis function is very similar to GetTurnover, with the only difference that it ! returns the Net changes due to Allocations Reactions and Transport in that pool @@ -1130,44 +1133,44 @@ function GetNetART(this, organ_id, species_id, position_id) result(sp_organ_neta ! NOTE: THIS HAS NOTHING TO DO WITH SPECIFYING ALLOCATION/TRANSPORT. ! THIS IS JUST A QUERY FUNCTION - class(prt_vartypes) :: this - integer,intent(in) :: organ_id - integer,intent(in) :: species_id - integer,intent(in),optional :: position_id - real(r8) :: sp_organ_netart - - integer :: i_pos - integer :: ispec - integer :: num_species - integer,dimension(max_spec_per_group) :: spec_ids - integer :: i_var - - sp_organ_netart = 0.0_r8 + class(prt_vartypes) :: this + integer,intent(in) :: organ_id ! Organ type querried + integer,intent(in) :: element_id ! Element type querried + integer,intent(in),optional :: position_id ! Position querried + real(r8) :: val_netalloc ! Amount (value) of allocation [kg] + + integer :: i_pos ! position loop counter + integer :: i_element ! element loop counter + integer :: num_element ! total number of elements + integer,dimension(max_spec_per_group) :: element_ids ! element ids (if element list) + integer :: i_var ! variable id + + val_netalloc = 0.0_r8 - if(species_id == all_carbon_species) then - spec_ids(1:3) = carbon_species_list(1:3) - num_species = 3 + if(element_id == all_carbon_elements) then + element_ids(1:3) = carbon_elements_list(1:3) + num_element = 3 else - num_species = 1 - spec_ids(1) = species_id + num_element = 1 + element_ids(1) = element_id end if if(present(position_id)) then i_pos = position_id - do ispec = 1,num_species - i_var = prt_global%sp_organ_map(organ_id,spec_ids(ispec)) - if(i_var>0) sp_organ_netart = sp_organ_netart + & - this%variables(i_var)%net_art(i_pos) + do i_element = 1,num_element + i_var = prt_global%sp_organ_map(organ_id,element_ids(i_element)) + if(i_var>0) val_netalloc = val_netalloc + & + this%variables(i_var)%net_alloc(i_pos) end do else - do ispec = 1,num_species - i_var = prt_global%sp_organ_map(organ_id,spec_ids(ispec)) + do i_element = 1,num_element + i_var = prt_global%sp_organ_map(organ_id,element_ids(i_element)) if(i_var>0) then do i_pos = 1, prt_global%state_descriptor(i_var)%num_pos - sp_organ_netart = sp_organ_netart + this%variables(i_var)%net_art(i_pos) + val_netalloc = val_netalloc + this%variables(i_var)%net_alloc(i_pos) end do end if @@ -1176,20 +1179,19 @@ function GetNetART(this, organ_id, species_id, position_id) result(sp_organ_neta end if return - end function GetNetART + end function GetNetAlloc ! ===================================================================================== - function GetCoordVal(this, organ_id, species_id ) result(prt_val) + function GetCoordVal(this, organ_id, element_id ) result(prt_val) - ! This is support code that may be helpful when we have variables in parteh ! that have multiple discrete spatial positions. class(prt_vartypes) :: this integer,intent(in) :: organ_id - integer,intent(in) :: species_id + integer,intent(in) :: element_id real(r8) :: prt_val write(fates_log(),*)'Init must be extended by a child class.' @@ -1221,27 +1223,25 @@ end subroutine FastPRTBase ! ==================================================================================== - subroutine SetState(prt,organ_id, species_id, state_val, position_id) + subroutine SetState(prt,organ_id, element_id, state_val, position_id) ! This routine should only be called for initalizing the state value ! of a plant's pools. A value is passed in to set the state of - ! organ and species couplets, and position id if it is provided. + ! organ and element couplets, and position id if it is provided. ! A select statement will most definitely bracket the call to this ! routine. - class(prt_vartypes) :: prt - integer,intent(in) :: organ_id - integer,intent(in) :: species_id - real(r8),intent(in) :: state_val - integer,intent(in),optional :: position_id - + class(prt_vartypes) :: prt + integer,intent(in) :: organ_id ! organ of interest + integer,intent(in) :: element_id ! element of interest + real(r8),intent(in) :: state_val ! value to be initialized + integer,intent(in),optional :: position_id ! position of interest - integer :: ispec - integer,dimension(max_spec_per_group) :: spec_ids - integer :: i_var - integer :: i_pos + integer :: i_element ! loop counter for elements + integer :: i_var ! variable loop counter + integer :: i_pos ! position loop counter - if(species_id == all_carbon_species) then + if(element_id == all_carbon_elements) then write(fates_log(),*) 'You cannot set the state of all isotopes simultaneously.' write(fates_log(),*) 'You can only set 1. Exiting.' call endrun(msg=errMsg(__FILE__, __LINE__)) @@ -1253,7 +1253,7 @@ subroutine SetState(prt,organ_id, species_id, state_val, position_id) i_pos = 1 end if - i_var = prt_global%sp_organ_map(organ_id,species_id) + i_var = prt_global%sp_organ_map(organ_id,element_id) if(i_pos > prt_global%state_descriptor(i_var)%num_pos )then write(fates_log(),*) 'A position index was specified that is' @@ -1271,7 +1271,7 @@ subroutine SetState(prt,organ_id, species_id, state_val, position_id) write(fates_log(),*) ' a pool with a specie x organ combination. ' write(fates_log(),*) ' that does not exist.' write(fates_log(),*) ' organ_id:',organ_id - write(fates_log(),*) ' species_id:',species_id + write(fates_log(),*) ' element_id:',element_id write(fates_log(),*) 'Exiting' call endrun(msg=errMsg(__FILE__, __LINE__)) end if diff --git a/parteh/PRTLossFluxesMod.F90 b/parteh/PRTLossFluxesMod.F90 index 43d5bc9b24..e91ee09bf2 100644 --- a/parteh/PRTLossFluxesMod.F90 +++ b/parteh/PRTLossFluxesMod.F90 @@ -8,11 +8,12 @@ module PRTLossFluxesMod use PRTGenericMod, only : store_organ use PRTGenericMod, only : repro_organ use PRTGenericMod, only : struct_organ - use PRTGenericMod, only : all_carbon_species - use PRTGenericMod, only : carbon_species_list - use PRTGenericMod, only : carbon12_species - use PRTGenericMod, only : nitrogen_species - use PRTGenericMod, only : phosphorous_species + use PRTGenericMod, only : carbon_elements_list + use PRTGenericMod, only : carbon12_element + use PRTGenericMod, only : carbon13_element + use PRTGenericMod, only : carbon14_element + use PRTGenericMod, only : nitrogen_element + use PRTGenericMod, only : phosphorous_element use PRTGenericMod, only : un_initialized use PRTGenericMod, only : check_initialized use PRTGenericMod, only : num_organ_types @@ -81,18 +82,19 @@ subroutine PRTPhenologyFlush(prt, ipft, organ_id, c_store_transfer_frac) ! transferred from storage integer :: i_var ! variable index - integer :: i_sp_var ! index for all species in - ! a given organ + integer :: i_var_of_organ ! index for all variables in + ! a given organ (mostly likely + ! synonymous with diff elements) integer :: i_cvar ! carbon variable index integer :: i_pos ! spatial position index integer :: i_store ! storage variable index - integer :: spec_id ! global species identifier + integer :: element_id ! global element identifier real(r8) :: mass_transfer ! The actual mass ! removed from storage ! for each pool - real(r8) :: target_stoich ! stoichiometry of species of interest - real(r8) :: sp_target ! target nutrient mass for species - real(r8) :: sp_demand ! nutrient demand for species + real(r8) :: target_stoich ! stoichiometry of pool of interest + real(r8) :: sp_target ! target nutrient mass for element + real(r8) :: sp_demand ! nutrient demand for element ! We currently only allow the flushing and drop of leaves. @@ -110,69 +112,92 @@ subroutine PRTPhenologyFlush(prt, ipft, organ_id, c_store_transfer_frac) associate(organ_map => prt_global%organ_map) - ! First transfer in carbon - ! -------------------------------------------------------------------------------- + ! Flush carbon variables first, as their transfer + ! rates from storage is dependant on the fraction + ! passed in by the argument. + ! After the values are updated, we can then + ! identify the stoichiometry targets which + ! govern the nutrient fluxes - i_cvar = prt_global%sp_organ_map(organ_id,carbon12_species) - - ! Get the variable id of the storage pool for this species (carbon12) - i_store = prt_global%sp_organ_map(store_organ,carbon12_species) - - ! Loop over all of the coordinate ids - do i_pos = 1,prt_global%state_descriptor(i_cvar)%num_pos - - ! Calculate the mass transferred out of storage into the pool of interest - mass_transfer = prt%variables(i_store)%val(i_pos) * c_store_transfer_frac - - ! Increment the c pool of interest - prt%variables(i_cvar)%net_art(i_pos) = & - prt%variables(i_cvar)%net_art(i_pos) + mass_transfer - - ! Update the c pool - prt%variables(i_cvar)%val(i_pos) = & - prt%variables(i_cvar)%val(i_pos) + mass_transfer + do i_var_of_organ = 1, organ_map(organ_id)%num_vars - ! Increment the c pool of interest - prt%variables(i_store)%net_art(i_pos) = & - prt%variables(i_store)%net_art(i_pos) - mass_transfer + ! The variable index + i_var = organ_map(organ_id)%var_id(i_var_of_organ) - ! Update the c pool - prt%variables(i_store)%val(i_pos) = & - prt%variables(i_store)%val(i_pos) - mass_transfer + ! The element index of the varible of interest + element_id = prt_global%state_descriptor(i_var)%element_id - - end do + ! This will filter IN all carbon related variables + if( any(element_id == carbon_elements_list) ) then + + ! No hypotheses exist for how to flush carbon isotopes + ! yet. Please fill this in. + if( (element_id == carbon13_element) .or. & + (element_id == carbon14_element) )then + write(fates_log(),*) ' Phenology flushing routine does not know' + write(fates_log(),*) ' how to handle carbon isotopes. Please' + write(fates_log(),*) ' evaluate the code referenced in this message' + write(fates_log(),*) ' and provide a hypothesis.' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + ! Get the variable id of the storage pool for this element (carbon12) + i_store = prt_global%sp_organ_map(store_organ,element_id) + + ! Loop over all of the coordinate ids + do i_pos = 1,prt_global%state_descriptor(i_var)%num_pos + + ! Calculate the mass transferred out of storage into the pool of interest + mass_transfer = prt%variables(i_store)%val(i_pos) * c_store_transfer_frac + + ! Increment the c pool of interest's allocation flux + prt%variables(i_var)%net_alloc(i_pos) = & + prt%variables(i_var)%net_alloc(i_pos) + mass_transfer + + ! Update the c pool + prt%variables(i_var)%val(i_pos) = & + prt%variables(i_var)%val(i_pos) + mass_transfer + + ! Increment the storage pool's allocation flux + prt%variables(i_store)%net_alloc(i_pos) = & + prt%variables(i_store)%net_alloc(i_pos) - mass_transfer + + ! Update the storage c pool + prt%variables(i_store)%val(i_pos) = & + prt%variables(i_store)%val(i_pos) - mass_transfer + + + end do + end if + end do + - ! Transfer in other species + ! Transfer in other elements (nutrients) ! -------------------------------------------------------------------------------- - - ! This is the total number of state variables associated - ! with this particular organ (ie carbon, nitrogen, phosphorous, ...) - - do i_sp_var = 1, organ_map(organ_id)%num_vars + do i_var_of_organ = 1, organ_map(organ_id)%num_vars - i_var = organ_map(organ_id)%var_id(i_sp_var) + i_var = organ_map(organ_id)%var_id(i_var_of_organ) - ! Variable index for the species of interest - spec_id = prt_global%state_descriptor(i_var)%spec_id + ! Variable index for the element of interest + element_id = prt_global%state_descriptor(i_var)%element_id - if ( spec_id .ne. carbon12_species ) then + ! This will filter OUT all carbon related elements + if ( .not. any(element_id == carbon_elements_list) ) then - ! Get the variable id of the storage pool for this species - i_store = prt_global%sp_organ_map(store_organ,spec_id) + ! Get the variable id of the storage pool for this element + i_store = prt_global%sp_organ_map(store_organ,element_id) - ! Calculate the stoichiometry with C for this species + ! Calculate the stoichiometry with C for this element - if( spec_id == nitrogen_species ) then + if( element_id == nitrogen_element ) then target_stoich = EDPftvarcon_inst%prt_nitr_stoich_p1(ipft,organ_id) - else if( spec_id == phosphorous_species ) then + else if( element_id == phosphorous_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 species that DNE' - write(fates_log(),*) ' organ: ',organ_id,' species: ',spec_id + 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 @@ -181,7 +206,7 @@ subroutine PRTPhenologyFlush(prt, ipft, organ_id, c_store_transfer_frac) ! Loop over all of the coordinate ids do i_pos = 1,prt_global%state_descriptor(i_var)%num_pos - ! The target quanitity for this species is based on the amount + ! The target quanitity for this element is based on the amount ! of carbon sp_target = prt%variables(i_cvar)%val(i_pos) * target_stoich @@ -191,16 +216,16 @@ subroutine PRTPhenologyFlush(prt, ipft, organ_id, c_store_transfer_frac) mass_transfer = min(sp_demand, prt%variables(i_store)%val(i_pos)) ! Increment the pool of interest - prt%variables(i_var)%net_art(i_pos) = & - prt%variables(i_var)%net_art(i_pos) + mass_transfer + prt%variables(i_var)%net_alloc(i_pos) = & + prt%variables(i_var)%net_alloc(i_pos) + mass_transfer ! Update the c pool prt%variables(i_var)%val(i_pos) = & prt%variables(i_var)%val(i_pos) + mass_transfer ! Increment the c pool of interest - prt%variables(i_store)%net_art(i_pos) = & - prt%variables(i_store)%net_art(i_pos) - mass_transfer + prt%variables(i_store)%net_alloc(i_pos) = & + prt%variables(i_store)%net_alloc(i_pos) - mass_transfer ! Update the c pool prt%variables(i_store)%val(i_pos) = & @@ -234,26 +259,23 @@ subroutine PRTBurnLosses(prt, organ_id, mass_fraction) integer,intent(in) :: organ_id real(r8),intent(in) :: mass_fraction - integer :: i_pos ! position index - integer :: i_var ! index for the variable of interest - integer :: i_sp_var ! loop counter for all species in this organ - integer :: num_sp_vars ! Loop size for iterating over all species - integer :: spec_id ! Species id of the turnover pool - real(r8) :: burned_mass ! Burned mass of each species, in eahc - ! position, in the organ of interest + integer :: i_pos ! position index + integer :: i_var ! index for the variable of interest + integer :: i_var_of_organ ! loop counter for all element in this organ + integer :: element_id ! Element id of the turnover pool + real(r8) :: burned_mass ! Burned mass of each element, in eahc + ! position, in the organ of interest associate(organ_map => prt_global%organ_map) ! This is the total number of state variables associated ! with this particular organ - num_sp_vars = organ_map(organ_id)%num_vars - - do i_sp_var = 1, num_sp_vars + do i_var_of_organ = 1, organ_map(organ_id)%num_vars - i_var = organ_map(organ_id)%var_id(i_sp_var) + i_var = organ_map(organ_id)%var_id(i_var_of_organ) - spec_id = prt_global%state_descriptor(i_var)%spec_id + element_id = prt_global%state_descriptor(i_var)%element_id ! Loop over all of the coordinate ids do i_pos = 1,prt_global%state_descriptor(i_var)%num_pos @@ -280,7 +302,7 @@ end subroutine PRTBurnLosses ! ===================================================================================== - subroutine PRTReproRelease(prt, organ_id, spec_id, mass_fraction, mass_out) + subroutine PRTReproRelease(prt, organ_id, element_id, mass_fraction, mass_out) ! ---------------------------------------------------------------------------------- ! This subroutine assumes that there is no re-translocation associated @@ -293,7 +315,7 @@ subroutine PRTReproRelease(prt, organ_id, spec_id, mass_fraction, mass_out) class(prt_vartypes) :: prt integer,intent(in) :: organ_id - integer,intent(in) :: spec_id + integer,intent(in) :: element_id real(r8),intent(in) :: mass_fraction real(r8),intent(out) :: mass_out @@ -316,8 +338,8 @@ subroutine PRTReproRelease(prt, organ_id, spec_id, mass_fraction, mass_out) call endrun(msg=errMsg(__FILE__, __LINE__)) end if - if (spec_id .ne. carbon12_species) then - write(fates_log(),*) 'Reproductive tissue releases were called for a species other than c12' + if (element_id .ne. carbon12_element) then + write(fates_log(),*) 'Reproductive tissue releases were called for a element other than c12' write(fates_log(),*) 'Only carbon seed masses are curently handled.' call endrun(msg=errMsg(__FILE__, __LINE__)) end if @@ -325,7 +347,7 @@ subroutine PRTReproRelease(prt, organ_id, spec_id, mass_fraction, mass_out) ! This is the total number of state variables associated ! with this particular organ - i_var = sp_organ_map(organ_id,spec_id) + i_var = sp_organ_map(organ_id,element_id) ! Reproductive mass leaving the plant mass_out = 0.0_r8 @@ -343,7 +365,7 @@ subroutine PRTReproRelease(prt, organ_id, spec_id, mass_fraction, mass_out) ! Update the val0 (because we don't give this dedicated flux) ! This is somewhat of a hack prt%variables(i_var)%val0(i_pos) = prt%variables(i_var)%val(i_pos) - & - prt%variables(i_var)%net_art(i_pos) + prt%variables(i_var)%net_alloc(i_pos) end do @@ -353,7 +375,6 @@ end subroutine PRTReproRelease ! =================================================================================== - subroutine PRTDeciduousTurnover(prt,ipft,organ_id,mass_fraction) ! --------------------------------------------------------------------------------- @@ -416,11 +437,8 @@ subroutine DeciduousTurnoverSimpleRetranslocation(prt,ipft,organ_id,mass_fractio ! leave the indicated organ. integer :: i_var ! index for the variable of interest - integer :: i_sp_var ! loop counter for all species in this organ - - integer :: num_sp_vars ! Loop size for iterating over all species - ! in the organ that is turning over - integer :: spec_id ! Species id of the turnover pool + integer :: i_var_of_organ ! loop counter for all element in this organ + integer :: element_id ! Element id of the turnover pool integer :: store_var_id ! Variable id of the storage pool integer :: i_pos ! position index (spatial) real(r8) :: retrans ! retranslocated fraction @@ -442,32 +460,28 @@ subroutine DeciduousTurnoverSimpleRetranslocation(prt,ipft,organ_id,mass_fractio end if - ! This is the total number of state variables associated - ! with this particular organ - num_sp_vars = organ_map(organ_id)%num_vars - - do i_sp_var = 1, num_sp_vars + do i_var_of_organ = 1, organ_map(organ_id)%num_vars - i_var = organ_map(organ_id)%var_id(i_sp_var) + i_var = organ_map(organ_id)%var_id(i_var_of_organ) - spec_id = prt_global%state_descriptor(i_var)%spec_id + element_id = prt_global%state_descriptor(i_var)%element_id - if ( any(spec_id == carbon_species_list) ) then + if ( any(element_id == carbon_elements_list) ) then retrans = EDPftvarcon_inst%turnover_carb_retrans(ipft,organ_id) - else if( spec_id == nitrogen_species ) then + else if( element_id == nitrogen_element ) then retrans = EDPftvarcon_inst%turnover_nitr_retrans(ipft,organ_id) - else if( spec_id == phosphorous_species ) then + else if( element_id == phosphorous_element ) then retrans = EDPftvarcon_inst%turnover_phos_retrans(ipft,organ_id) else write(fates_log(),*) 'Please add a new re-translocation clause to your ' - write(fates_log(),*) ' organ x species combination' - write(fates_log(),*) ' organ: ',leaf_organ,' species: ',spec_id + write(fates_log(),*) ' organ x element combination' + write(fates_log(),*) ' organ: ',leaf_organ,' element: ',element_id write(fates_log(),*) 'Exiting' call endrun(msg=errMsg(__FILE__, __LINE__)) end if - ! Get the variable id of the storage pool for this species - store_var_id = prt_global%sp_organ_map(store_organ,spec_id) + ! Get the variable id of the storage pool for this element + store_var_id = prt_global%sp_organ_map(store_organ,element_id) ! Loop over all of the coordinate ids do i_pos = 1, prt_global%state_descriptor(i_var)%num_pos @@ -483,7 +497,7 @@ subroutine DeciduousTurnoverSimpleRetranslocation(prt,ipft,organ_id,mass_fractio + turnover_mass ! Track the amount of mass the is being re-translocated (- is amount lost) - prt%variables(i_var)%net_art(i_pos) = prt%variables(i_var)%net_art(i_pos) & + prt%variables(i_var)%net_alloc(i_pos) = prt%variables(i_var)%net_alloc(i_pos) & - retranslocated_mass ! Update the state of the pool to reflect the mass lost @@ -493,8 +507,8 @@ subroutine DeciduousTurnoverSimpleRetranslocation(prt,ipft,organ_id,mass_fractio ! Now, since re-translocation is handled by the storage pool, ! we add the re-translocated mass to it - prt%variables(store_var_id)%net_art(i_pos) = & - prt%variables(store_var_id)%net_art(i_pos) + retranslocated_mass + prt%variables(store_var_id)%net_alloc(i_pos) = & + prt%variables(store_var_id)%net_alloc(i_pos) + retranslocated_mass prt%variables(store_var_id)%val(i_pos) = & prt%variables(store_var_id)%val(i_pos) + retranslocated_mass @@ -556,21 +570,17 @@ subroutine MaintTurnoverSimpleRetranslocation(prt,ipft) class(prt_vartypes) :: prt integer,intent(in) :: ipft - integer :: i_var - integer :: spec_id - integer :: organ_id - integer :: i_pos - - real(r8) :: turnover - real(r8) :: leaf_turnover - real(r8) :: fnrt_turnover - real(r8) :: sapw_turnover - real(r8) :: store_turnover - real(r8) :: struct_turnover - real(r8) :: repro_turnover - real(r8), dimension(num_organ_types) :: base_turnover ! A temp for the actual turnover removed from pool - real(r8) :: retrans ! A temp for the actual re-translocated mass + integer :: i_var ! the variable index + integer :: element_id ! the element associated w/ each variable + integer :: organ_id ! the organ associated w/ each variable + integer :: i_pos ! spatial position loop counter + + real(r8) :: turnover ! Actual turnover removed from each + ! pool [kg] + real(r8) :: retrans ! A temp for the actual re-translocated mass + ! A temp for the actual turnover removed from pool + real(r8), dimension(num_organ_types) :: base_turnover ! ----------------------------------------------------------------------------------- ! Calculate the turnover rates (maybe this should be done once in the parameter @@ -578,6 +588,10 @@ subroutine MaintTurnoverSimpleRetranslocation(prt,ipft) ! ----------------------------------------------------------------------------------- base_turnover(:) = un_initialized + + ! All plants can have branch turnover, if branchfall is nonz-ero, + ! which will reduce sapwood, structure and storage. + ! ----------------------------------------------------------------------------------- if ( EDPftvarcon_inst%branch_turnover(ipft) > nearzero ) then base_turnover(sapw_organ) = hlm_freq_day / EDPftvarcon_inst%branch_turnover(ipft) @@ -589,12 +603,17 @@ subroutine MaintTurnoverSimpleRetranslocation(prt,ipft) base_turnover(store_organ) = 0.0_r8 end if + ! All plants are allowed to have fine-root turnover if a non-zero + ! life-span is selected + ! --------------------------------------------------------------------------------- if ( EDPftvarcon_inst%root_long(ipft) > nearzero ) then base_turnover(fnrt_organ) = hlm_freq_day / EDPftvarcon_inst%root_long(ipft) else base_turnover(fnrt_organ) = 0.0_r8 end if + ! Only EVERGREENS HAVE MAINTENANCE LEAF TURNOVER + ! ------------------------------------------------------------------------------------- if ( (EDPftvarcon_inst%leaf_long(ipft) > nearzero ) .and. & (EDPftvarcon_inst%evergreen(ipft) == 1) ) then base_turnover(leaf_organ) = hlm_freq_day / EDPftvarcon_inst%leaf_long(ipft) @@ -607,18 +626,18 @@ subroutine MaintTurnoverSimpleRetranslocation(prt,ipft) do i_var = 1, prt_global%num_vars organ_id = prt_global%state_descriptor(i_var)%organ_id - spec_id = prt_global%state_descriptor(i_var)%spec_id + element_id = prt_global%state_descriptor(i_var)%element_id - if ( any(spec_id == carbon_species_list) ) then + if ( any(element_id == carbon_elements_list) ) then retrans = EDPftvarcon_inst%turnover_carb_retrans(ipft,organ_id) - else if( spec_id == nitrogen_species ) then + else if( element_id == nitrogen_element ) then retrans = EDPftvarcon_inst%turnover_nitr_retrans(ipft,organ_id) - else if( spec_id == phosphorous_species ) then + else if( element_id == phosphorous_element ) then retrans = EDPftvarcon_inst%turnover_phos_retrans(ipft,organ_id) else write(fates_log(),*) 'Please add a new re-translocation clause to your ' - write(fates_log(),*) ' organ x species combination' - write(fates_log(),*) ' organ: ',organ_id,' species: ',spec_id + write(fates_log(),*) ' organ x element combination' + write(fates_log(),*) ' organ: ',organ_id,' element: ',element_id write(fates_log(),*) 'Exiting' call endrun(msg=errMsg(__FILE__, __LINE__)) end if @@ -626,7 +645,7 @@ subroutine MaintTurnoverSimpleRetranslocation(prt,ipft) if(base_turnover(organ_id) < check_initialized) then write(fates_log(),*) 'A maintenance turnover rate for the organ' write(fates_log(),*) ' was not specified....' - write(fates_log(),*) ' organ: ',organ_id,' species: ',spec_id + write(fates_log(),*) ' organ: ',organ_id,' element: ',element_id write(fates_log(),*) ' base turnover rate: ',base_turnover(organ_id) write(fates_log(),*) 'Exiting' call endrun(msg=errMsg(__FILE__, __LINE__)) @@ -635,7 +654,7 @@ subroutine MaintTurnoverSimpleRetranslocation(prt,ipft) if(retrans<0.0 .or. retrans>1.0) then write(fates_log(),*) 'Unacceptable retranslocation calculated' - write(fates_log(),*) ' organ: ',organ_id,' species: ',spec_id + write(fates_log(),*) ' organ: ',organ_id,' element: ',element_id write(fates_log(),*) ' retranslocation fraction: ',retrans write(fates_log(),*) 'Exiting' call endrun(msg=errMsg(__FILE__, __LINE__)) From f20cd6841903f1b2fcc047dbd39b6d7916794058 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Mon, 22 Oct 2018 15:47:55 -0700 Subject: [PATCH 48/52] parteh: Updated species (chem) to element in functional unit test code --- .../f_wrapper_modules/FatesCohortWrapMod.F90 | 142 +++++++++--------- 1 file changed, 71 insertions(+), 71 deletions(-) diff --git a/functional_unit_testing/parteh/f_wrapper_modules/FatesCohortWrapMod.F90 b/functional_unit_testing/parteh/f_wrapper_modules/FatesCohortWrapMod.F90 index 2e42fbbf05..9907c567b9 100644 --- a/functional_unit_testing/parteh/f_wrapper_modules/FatesCohortWrapMod.F90 +++ b/functional_unit_testing/parteh/f_wrapper_modules/FatesCohortWrapMod.F90 @@ -25,17 +25,17 @@ module FatesCohortWrapMod use PRTGenericMod, only : InitPRTVartype use PRTGenericMod, only : prt_vartypes use PRTGenericMod, only : leaf_organ - use PRTGenericMod, only : all_carbon_species - use PRTGenericMod, only : carbon12_species - use PRTGenericMod, only : nitrogen_species - use PRTGenericMod, only : phosphorous_species + use PRTGenericMod, only : all_carbon_elements + use PRTGenericMod, only : carbon12_element + use PRTGenericMod, only : nitrogen_element + use PRTGenericMod, only : phosphorous_element use PRTGenericMod, only : leaf_organ use PRTGenericMod, only : fnrt_organ use PRTGenericMod, only : sapw_organ use PRTGenericMod, only : store_organ use PRTGenericMod, only : repro_organ use PRTGenericMod, only : struct_organ - use PRTGenericMod, only : carbon12_species + use PRTGenericMod, only : carbon12_element use PRTGenericMod, only : SetState use PRTGenericMod, only : prt_global @@ -251,12 +251,12 @@ subroutine CohortPySet(ipft,hgt_min,canopy_trim) select case(ccohort%parteh_model) case (1) - call SetState(ccohort%prt,leaf_organ, carbon12_species, leaf_c) - call SetState(ccohort%prt,fnrt_organ, carbon12_species, fnrt_c) - call SetState(ccohort%prt,sapw_organ, carbon12_species, sapw_c) - call SetState(ccohort%prt,store_organ, carbon12_species, store_c) - call SetState(ccohort%prt,struct_organ , carbon12_species, struct_c) - call SetState(ccohort%prt,repro_organ , carbon12_species, repro_c) + call SetState(ccohort%prt,leaf_organ, carbon12_element, leaf_c) + call SetState(ccohort%prt,fnrt_organ, carbon12_element, fnrt_c) + call SetState(ccohort%prt,sapw_organ, carbon12_element, sapw_c) + call SetState(ccohort%prt,store_organ, carbon12_element, store_c) + call SetState(ccohort%prt,struct_organ , carbon12_element, struct_c) + call SetState(ccohort%prt,repro_organ , carbon12_element, repro_c) call ccohort%prt%RegisterBCInOut(ac_bc_inout_id_dbh,bc_rval = ccohort%dbh) call ccohort%prt%RegisterBCInOut(ac_bc_inout_id_netdc,bc_rval = ccohort%daily_carbon_gain) @@ -284,26 +284,26 @@ subroutine CohortPySet(ipft,hgt_min,canopy_trim) ccohort%accum_r_maint_deficit = 0.0_r8 - call SetState(ccohort%prt,leaf_organ, carbon12_species, leaf_c) - call SetState(ccohort%prt,fnrt_organ, carbon12_species, fnrt_c) - call SetState(ccohort%prt,sapw_organ, carbon12_species, sapw_c) - call SetState(ccohort%prt,store_organ, carbon12_species, store_c) - call SetState(ccohort%prt,struct_organ , carbon12_species, struct_c) - call SetState(ccohort%prt,repro_organ , carbon12_species, repro_c) - - call SetState(ccohort%prt,leaf_organ, nitrogen_species, leaf_n) - call SetState(ccohort%prt,fnrt_organ, nitrogen_species, fnrt_n) - call SetState(ccohort%prt,sapw_organ, nitrogen_species, sapw_n) - call SetState(ccohort%prt,store_organ, nitrogen_species, store_n) - call SetState(ccohort%prt,struct_organ , nitrogen_species, struct_n) - call SetState(ccohort%prt,repro_organ , nitrogen_species, repro_n) - - call SetState(ccohort%prt,leaf_organ, phosphorous_species, leaf_p) - call SetState(ccohort%prt,fnrt_organ, phosphorous_species, fnrt_p) - call SetState(ccohort%prt,sapw_organ, phosphorous_species, sapw_p) - call SetState(ccohort%prt,store_organ, phosphorous_species, store_p) - call SetState(ccohort%prt,struct_organ , phosphorous_species, struct_p) - call SetState(ccohort%prt,repro_organ , phosphorous_species, repro_p) + call SetState(ccohort%prt,leaf_organ, carbon12_element, leaf_c) + call SetState(ccohort%prt,fnrt_organ, carbon12_element, fnrt_c) + call SetState(ccohort%prt,sapw_organ, carbon12_element, sapw_c) + call SetState(ccohort%prt,store_organ, carbon12_element, store_c) + call SetState(ccohort%prt,struct_organ , carbon12_element, struct_c) + call SetState(ccohort%prt,repro_organ , carbon12_element, repro_c) + + call SetState(ccohort%prt,leaf_organ, nitrogen_element, leaf_n) + call SetState(ccohort%prt,fnrt_organ, nitrogen_element, fnrt_n) + call SetState(ccohort%prt,sapw_organ, nitrogen_element, sapw_n) + call SetState(ccohort%prt,store_organ, nitrogen_element, store_n) + 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) ! Register In/Out Boundary Conditions call ccohort%prt%RegisterBCInOut(acnp_bc_inout_id_dbh,bc_rval = ccohort%dbh) @@ -433,8 +433,8 @@ subroutine WrapQueryVars(ipft,leaf_area,crown_area,agb,store_c,target_leaf_c) end select - leaf_c = ccohort%prt%GetState(leaf_organ, all_carbon_species ) - store_c = ccohort%prt%GetState(store_organ, all_carbon_species ) + leaf_c = ccohort%prt%GetState(leaf_organ, all_carbon_elements ) + store_c = ccohort%prt%GetState(store_organ, all_carbon_elements ) call carea_allom(ccohort%dbh,nplant,site_spread,ipft,crown_area) @@ -523,44 +523,44 @@ subroutine WrapQueryDiagnostics(ipft, dbh, & dbh = ccohort%dbh - leaf_c = ccohort%prt%GetState(organ_id=leaf_organ, species_id=all_carbon_species) - fnrt_c = ccohort%prt%GetState(organ_id=fnrt_organ, species_id=all_carbon_species) - sapw_c = ccohort%prt%GetState(organ_id=sapw_organ, species_id=all_carbon_species) - store_c = ccohort%prt%GetState(organ_id=store_organ, species_id=all_carbon_species) - struct_c = ccohort%prt%GetState(organ_id=struct_organ, species_id=all_carbon_species) - repro_c = ccohort%prt%GetState(organ_id=repro_organ, species_id=all_carbon_species) - - leaf_cturn = ccohort%prt%GetTurnover(organ_id=leaf_organ, species_id=all_carbon_species) - fnrt_cturn = ccohort%prt%GetTurnover(organ_id=fnrt_organ, species_id=all_carbon_species) - sapw_cturn = ccohort%prt%GetTurnover(organ_id=sapw_organ, species_id=all_carbon_species) - store_cturn = ccohort%prt%GetTurnover(organ_id=store_organ, species_id=all_carbon_species) - struct_cturn = ccohort%prt%GetTurnover(organ_id=struct_organ, species_id=all_carbon_species) - - leaf_n = ccohort%prt%GetState(organ_id=leaf_organ, species_id=nitrogen_species) - fnrt_n = ccohort%prt%GetState(organ_id=fnrt_organ, species_id=nitrogen_species) - sapw_n = ccohort%prt%GetState(organ_id=sapw_organ, species_id=nitrogen_species) - store_n = ccohort%prt%GetState(organ_id=store_organ, species_id=nitrogen_species) - struct_n = ccohort%prt%GetState(organ_id=struct_organ, species_id=nitrogen_species) - repro_n = ccohort%prt%GetState(organ_id=repro_organ, species_id=nitrogen_species) - - leaf_nturn = ccohort%prt%GetTurnover(organ_id=leaf_organ, species_id=nitrogen_species) - fnrt_nturn = ccohort%prt%GetTurnover(organ_id=fnrt_organ, species_id=nitrogen_species) - sapw_nturn = ccohort%prt%GetTurnover(organ_id=sapw_organ, species_id=nitrogen_species) - store_nturn = ccohort%prt%GetTurnover(organ_id=store_organ, species_id=nitrogen_species) - struct_nturn = ccohort%prt%GetTurnover(organ_id=struct_organ, species_id=nitrogen_species) - - leaf_p = ccohort%prt%GetState(organ_id=leaf_organ, species_id=phosphorous_species) - fnrt_p = ccohort%prt%GetState(organ_id=fnrt_organ, species_id=phosphorous_species) - sapw_p = ccohort%prt%GetState(organ_id=sapw_organ, species_id=phosphorous_species) - store_p = ccohort%prt%GetState(organ_id=store_organ, species_id=phosphorous_species) - struct_p = ccohort%prt%GetState(organ_id=struct_organ, species_id=phosphorous_species) - repro_p = ccohort%prt%GetState(organ_id=repro_organ, species_id=phosphorous_species) - - leaf_pturn = ccohort%prt%GetTurnover(organ_id=leaf_organ, species_id=phosphorous_species) - fnrt_pturn = ccohort%prt%GetTurnover(organ_id=fnrt_organ, species_id=phosphorous_species) - sapw_pturn = ccohort%prt%GetTurnover(organ_id=sapw_organ, species_id=phosphorous_species) - store_pturn = ccohort%prt%GetTurnover(organ_id=store_organ, species_id=phosphorous_species) - struct_pturn = ccohort%prt%GetTurnover(organ_id=struct_organ, species_id=phosphorous_species) + leaf_c = ccohort%prt%GetState(organ_id=leaf_organ, species_id=all_carbon_elements) + fnrt_c = ccohort%prt%GetState(organ_id=fnrt_organ, species_id=all_carbon_elements) + sapw_c = ccohort%prt%GetState(organ_id=sapw_organ, species_id=all_carbon_elements) + store_c = ccohort%prt%GetState(organ_id=store_organ, species_id=all_carbon_elements) + struct_c = ccohort%prt%GetState(organ_id=struct_organ, species_id=all_carbon_elements) + repro_c = ccohort%prt%GetState(organ_id=repro_organ, species_id=all_carbon_elements) + + leaf_cturn = ccohort%prt%GetTurnover(organ_id=leaf_organ, species_id=all_carbon_elements) + fnrt_cturn = ccohort%prt%GetTurnover(organ_id=fnrt_organ, species_id=all_carbon_elements) + sapw_cturn = ccohort%prt%GetTurnover(organ_id=sapw_organ, species_id=all_carbon_elements) + store_cturn = ccohort%prt%GetTurnover(organ_id=store_organ, species_id=all_carbon_elements) + struct_cturn = ccohort%prt%GetTurnover(organ_id=struct_organ, species_id=all_carbon_elements) + + leaf_n = ccohort%prt%GetState(organ_id=leaf_organ, species_id=nitrogen_element) + fnrt_n = ccohort%prt%GetState(organ_id=fnrt_organ, species_id=nitrogen_element) + sapw_n = ccohort%prt%GetState(organ_id=sapw_organ, species_id=nitrogen_element) + store_n = ccohort%prt%GetState(organ_id=store_organ, species_id=nitrogen_element) + struct_n = ccohort%prt%GetState(organ_id=struct_organ, species_id=nitrogen_element) + repro_n = ccohort%prt%GetState(organ_id=repro_organ, species_id=nitrogen_element) + + leaf_nturn = ccohort%prt%GetTurnover(organ_id=leaf_organ, species_id=nitrogen_element) + fnrt_nturn = ccohort%prt%GetTurnover(organ_id=fnrt_organ, species_id=nitrogen_element) + sapw_nturn = ccohort%prt%GetTurnover(organ_id=sapw_organ, species_id=nitrogen_element) + 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_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) growth_resp = ccohort%daily_r_grow From c8d20250fd0ec107300f9cff13c83e1a950d9134 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Tue, 23 Oct 2018 11:03:29 -0600 Subject: [PATCH 49/52] parteh: placed call to net_allocation query inside an isnew conditional, fixed day-> conversion factor --- main/FatesHistoryInterfaceMod.F90 | 100 +++++++++++++++--------------- 1 file changed, 50 insertions(+), 50 deletions(-) diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 8b6bf1bdd5..f7296af039 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -1318,12 +1318,12 @@ subroutine update_history_dyn(this,nc,nsites,sites) real(r8) :: leaf_c_turnover real(r8) :: fnrt_c_turnover real(r8) :: struct_c_turnover - real(r8) :: sapw_c_net_art - real(r8) :: store_c_net_art - real(r8) :: leaf_c_net_art - real(r8) :: fnrt_c_net_art - real(r8) :: struct_c_net_art - real(r8) :: repro_c_net_art + real(r8) :: sapw_c_net_alloc + real(r8) :: store_c_net_alloc + real(r8) :: leaf_c_net_alloc + real(r8) :: fnrt_c_net_alloc + real(r8) :: struct_c_net_alloc + real(r8) :: repro_c_net_alloc type(ed_patch_type),pointer :: cpatch type(ed_cohort_type),pointer :: ccohort @@ -1681,17 +1681,6 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_biomass_si_age(io_si,cpatch%age_class) = hio_biomass_si_age(io_si,cpatch%age_class) & + total_c * ccohort%n * AREA_INV - - ! ecosystem-level, organ-partitioned NPP/allocation fluxes - hio_npp_leaf_si(io_si) = hio_npp_leaf_si(io_si) + leaf_c_net_art * n_perm2 - hio_npp_seed_si(io_si) = hio_npp_seed_si(io_si) + repro_c_net_art * n_perm2 - hio_npp_stem_si(io_si) = hio_npp_stem_si(io_si) + (sapw_c_net_art + struct_c_net_art) * n_perm2 * & - (EDPftvarcon_inst%allom_agb_frac(ccohort%pft)) - hio_npp_froot_si(io_si) = hio_npp_froot_si(io_si) + fnrt_c_net_art * n_perm2 - hio_npp_croot_si(io_si) = hio_npp_croot_si(io_si) + (sapw_c_net_art + struct_c_net_art) * n_perm2 * & - (1._r8-EDPftvarcon_inst%allom_agb_frac(ccohort%pft)) - hio_npp_stor_si(io_si) = hio_npp_stor_si(io_si) + store_c_net_art * n_perm2 - ! Site by Size-Class x PFT (SCPF) ! ------------------------------------------------------------------------ @@ -1701,20 +1690,31 @@ subroutine update_history_dyn(this,nc,nsites,sites) ! have any meaning, otherwise they are just inialization values if( .not.(ccohort%isnew) ) then - ! Turnover pools [kgC/day] / [yr/day] = [kgC/yr] - sapw_c_turnover = ccohort%prt%GetTurnover(sapw_organ, all_carbon_elements) / hlm_freq_day - store_c_turnover = ccohort%prt%GetTurnover(store_organ, all_carbon_elements) / hlm_freq_day - leaf_c_turnover = ccohort%prt%GetTurnover(leaf_organ, all_carbon_elements) / hlm_freq_day - fnrt_c_turnover = ccohort%prt%GetTurnover(fnrt_organ, all_carbon_elements) / hlm_freq_day - struct_c_turnover = ccohort%prt%GetTurnover(struct_organ, all_carbon_elements) / hlm_freq_day + ! Turnover pools [kgC/day] * [day/yr] = [kgC/yr] + sapw_c_turnover = ccohort%prt%GetTurnover(sapw_organ, all_carbon_elements) * days_per_year + store_c_turnover = ccohort%prt%GetTurnover(store_organ, all_carbon_elements) * days_per_year + leaf_c_turnover = ccohort%prt%GetTurnover(leaf_organ, all_carbon_elements) * days_per_year + fnrt_c_turnover = ccohort%prt%GetTurnover(fnrt_organ, all_carbon_elements) * days_per_year + struct_c_turnover = ccohort%prt%GetTurnover(struct_organ, all_carbon_elements) * days_per_year + + ! Net change from allocation and transport [kgC/day] * [day/yr] = [kgC/yr] + sapw_c_net_alloc = ccohort%prt%GetNetAlloc(sapw_organ, all_carbon_elements) * days_per_year + store_c_net_alloc = ccohort%prt%GetNetAlloc(store_organ, all_carbon_elements) * days_per_year + leaf_c_net_alloc = ccohort%prt%GetNetAlloc(leaf_organ, all_carbon_elements) * days_per_year + fnrt_c_net_alloc = ccohort%prt%GetNetAlloc(fnrt_organ, all_carbon_elements) * days_per_year + struct_c_net_alloc = ccohort%prt%GetNetAlloc(struct_organ, all_carbon_elements) * days_per_year + repro_c_net_alloc = ccohort%prt%GetNetAlloc(repro_organ, all_carbon_elements) * days_per_year + + ! ecosystem-level, organ-partitioned NPP/allocation fluxes + hio_npp_leaf_si(io_si) = hio_npp_leaf_si(io_si) + leaf_c_net_alloc * n_perm2 + hio_npp_seed_si(io_si) = hio_npp_seed_si(io_si) + repro_c_net_alloc * n_perm2 + hio_npp_stem_si(io_si) = hio_npp_stem_si(io_si) + (sapw_c_net_alloc + struct_c_net_alloc) * n_perm2 * & + (EDPftvarcon_inst%allom_agb_frac(ccohort%pft)) + hio_npp_froot_si(io_si) = hio_npp_froot_si(io_si) + fnrt_c_net_alloc * n_perm2 + hio_npp_croot_si(io_si) = hio_npp_croot_si(io_si) + (sapw_c_net_alloc + struct_c_net_alloc) * n_perm2 * & + (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 - ! Net change from allocation and transport [kgC/day] / [yr/day] = [kgC/yr] - sapw_c_net_art = ccohort%prt%GetNetAlloc(sapw_organ, all_carbon_elements) / hlm_freq_day - store_c_net_art = ccohort%prt%GetNetAlloc(store_organ, all_carbon_elements) / hlm_freq_day - leaf_c_net_art = ccohort%prt%GetNetAlloc(leaf_organ, all_carbon_elements) / hlm_freq_day - fnrt_c_net_art = ccohort%prt%GetNetAlloc(fnrt_organ, all_carbon_elements) / hlm_freq_day - struct_c_net_art = ccohort%prt%GetNetAlloc(struct_organ, all_carbon_elements) / hlm_freq_day - repro_c_net_art = ccohort%prt%GetNetAlloc(repro_organ, all_carbon_elements) / hlm_freq_day associate( scpf => ccohort%size_by_pft_class, & @@ -1725,25 +1725,25 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_npp_totl_si_scpf(io_si,scpf) = hio_npp_totl_si_scpf(io_si,scpf) + & ccohort%npp_acc_hold *n_perm2 hio_npp_leaf_si_scpf(io_si,scpf) = hio_npp_leaf_si_scpf(io_si,scpf) + & - leaf_c_net_art*n_perm2 + leaf_c_net_alloc*n_perm2 hio_npp_fnrt_si_scpf(io_si,scpf) = hio_npp_fnrt_si_scpf(io_si,scpf) + & - fnrt_c_net_art*n_perm2 + fnrt_c_net_alloc*n_perm2 hio_npp_bgsw_si_scpf(io_si,scpf) = hio_npp_bgsw_si_scpf(io_si,scpf) + & - sapw_c_net_art*n_perm2* & + sapw_c_net_alloc*n_perm2* & (1._r8-EDPftvarcon_inst%allom_agb_frac(ccohort%pft)) hio_npp_agsw_si_scpf(io_si,scpf) = hio_npp_agsw_si_scpf(io_si,scpf) + & - sapw_c_net_art*n_perm2* & + sapw_c_net_alloc*n_perm2* & EDPftvarcon_inst%allom_agb_frac(ccohort%pft) hio_npp_bgdw_si_scpf(io_si,scpf) = hio_npp_bgdw_si_scpf(io_si,scpf) + & - struct_c_net_art*n_perm2* & + struct_c_net_alloc*n_perm2* & (1._r8-EDPftvarcon_inst%allom_agb_frac(ccohort%pft)) hio_npp_agdw_si_scpf(io_si,scpf) = hio_npp_agdw_si_scpf(io_si,scpf) + & - struct_c_net_art*n_perm2* & + struct_c_net_alloc*n_perm2* & EDPftvarcon_inst%allom_agb_frac(ccohort%pft) hio_npp_seed_si_scpf(io_si,scpf) = hio_npp_seed_si_scpf(io_si,scpf) + & - repro_c_net_art*n_perm2 + repro_c_net_alloc*n_perm2 hio_npp_stor_si_scpf(io_si,scpf) = hio_npp_stor_si_scpf(io_si,scpf) + & - store_c_net_art*n_perm2 + store_c_net_alloc*n_perm2 ! Woody State Variables (basal area and number density and mortality) if (EDPftvarcon_inst%woody(ft) == 1) then @@ -1883,17 +1883,17 @@ subroutine update_history_dyn(this,nc,nsites,sites) ccohort%seed_prod * ccohort%n hio_npp_leaf_canopy_si_scls(io_si,scls) = hio_npp_leaf_canopy_si_scls(io_si,scls) + & - leaf_c_net_art * ccohort%n + leaf_c_net_alloc * ccohort%n hio_npp_fnrt_canopy_si_scls(io_si,scls) = hio_npp_fnrt_canopy_si_scls(io_si,scls) + & - fnrt_c_net_art * ccohort%n + fnrt_c_net_alloc * ccohort%n hio_npp_sapw_canopy_si_scls(io_si,scls) = hio_npp_sapw_canopy_si_scls(io_si,scls) + & - sapw_c_net_art * ccohort%n + sapw_c_net_alloc * ccohort%n hio_npp_dead_canopy_si_scls(io_si,scls) = hio_npp_dead_canopy_si_scls(io_si,scls) + & - struct_c_net_art * ccohort%n + struct_c_net_alloc * ccohort%n hio_npp_seed_canopy_si_scls(io_si,scls) = hio_npp_seed_canopy_si_scls(io_si,scls) + & - repro_c_net_art * ccohort%n + repro_c_net_alloc * ccohort%n hio_npp_stor_canopy_si_scls(io_si,scls) = hio_npp_stor_canopy_si_scls(io_si,scls) + & - store_c_net_art * ccohort%n + store_c_net_alloc * ccohort%n hio_yesterdaycanopylevel_canopy_si_scls(io_si,scls) = & hio_yesterdaycanopylevel_canopy_si_scls(io_si,scls) + & @@ -1964,17 +1964,17 @@ subroutine update_history_dyn(this,nc,nsites,sites) ccohort%seed_prod * ccohort%n hio_npp_leaf_understory_si_scls(io_si,scls) = hio_npp_leaf_understory_si_scls(io_si,scls) + & - leaf_c_net_art * ccohort%n + leaf_c_net_alloc * ccohort%n hio_npp_fnrt_understory_si_scls(io_si,scls) = hio_npp_fnrt_understory_si_scls(io_si,scls) + & - fnrt_c_net_art * ccohort%n + fnrt_c_net_alloc * ccohort%n hio_npp_sapw_understory_si_scls(io_si,scls) = hio_npp_sapw_understory_si_scls(io_si,scls) + & - sapw_c_net_art * ccohort%n + sapw_c_net_alloc * ccohort%n hio_npp_dead_understory_si_scls(io_si,scls) = hio_npp_dead_understory_si_scls(io_si,scls) + & - struct_c_net_art * ccohort%n + struct_c_net_alloc * ccohort%n hio_npp_seed_understory_si_scls(io_si,scls) = hio_npp_seed_understory_si_scls(io_si,scls) + & - repro_c_net_art * ccohort%n + repro_c_net_alloc * ccohort%n hio_npp_stor_understory_si_scls(io_si,scls) = hio_npp_stor_understory_si_scls(io_si,scls) + & - store_c_net_art * ccohort%n + store_c_net_alloc * ccohort%n hio_yesterdaycanopylevel_understory_si_scls(io_si,scls) = & hio_yesterdaycanopylevel_understory_si_scls(io_si,scls) + & From 536ab42da20bb3e89bed9311f3df3b242fac0daf Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Wed, 24 Oct 2018 17:24:29 -0700 Subject: [PATCH 50/52] Added last size class to restarts --- main/FatesRestartInterfaceMod.F90 | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/main/FatesRestartInterfaceMod.F90 b/main/FatesRestartInterfaceMod.F90 index cf00f9c51b..cfc929580d 100644 --- a/main/FatesRestartInterfaceMod.F90 +++ b/main/FatesRestartInterfaceMod.F90 @@ -79,6 +79,7 @@ module FatesRestartInterfaceMod 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_height_co integer, private :: ir_laimemory_co @@ -623,6 +624,10 @@ subroutine define_restart_vars(this, initialize_variables) long_name='ed cohort - canopy_trim', units='fraction', flushval = flushzero, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_canopy_trim_co ) + call this%set_restart_var(vname='fates_size_class_lasttimestep', vtype=cohort_int, & + long_name='ed cohort - size-class last timestep', units='index', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_size_class_lasttimestep_co ) + call this%set_restart_var(vname='fates_dbh', vtype=cohort_r8, & long_name='ed cohort - diameter at breast height', units='cm', flushval = flushzero, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_dbh_co ) @@ -1105,6 +1110,7 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_canopy_layer_co => this%rvars(ir_canopy_layer_co)%r81d, & 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_size_class_lasttimestep => this%rvars(ir_size_class_lasttimestep_co)%int1d, & rio_dbh_co => this%rvars(ir_dbh_co)%r81d, & rio_height_co => this%rvars(ir_height_co)%r81d, & rio_laimemory_co => this%rvars(ir_laimemory_co)%r81d, & @@ -1239,6 +1245,7 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_canopy_layer_co(io_idx_co) = ccohort%canopy_layer rio_canopy_layer_yesterday_co(io_idx_co) = ccohort%canopy_layer_yesterday rio_canopy_trim_co(io_idx_co) = ccohort%canopy_trim + 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 @@ -1689,6 +1696,7 @@ subroutine get_restart_vectors(this, nc, nsites, sites) rio_canopy_layer_co => this%rvars(ir_canopy_layer_co)%r81d, & 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_size_class_lasttimestep => this%rvars(ir_size_class_lasttimestep_co)%int1d, & rio_dbh_co => this%rvars(ir_dbh_co)%r81d, & rio_height_co => this%rvars(ir_height_co)%r81d, & rio_laimemory_co => this%rvars(ir_laimemory_co)%r81d, & @@ -1806,6 +1814,7 @@ subroutine get_restart_vectors(this, nc, nsites, sites) ccohort%canopy_layer = rio_canopy_layer_co(io_idx_co) ccohort%canopy_layer_yesterday = rio_canopy_layer_yesterday_co(io_idx_co) ccohort%canopy_trim = rio_canopy_trim_co(io_idx_co) + ccohort%size_class_lasttimestep = rio_size_class_lasttimestep(io_idx_co) ccohort%dbh = rio_dbh_co(io_idx_co) ccohort%hite = rio_height_co(io_idx_co) ccohort%laimemory = rio_laimemory_co(io_idx_co) From bf52b33677059707c0f90bcfef92dd120febc227 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 25 Oct 2018 13:20:16 -0700 Subject: [PATCH 51/52] Fixed some type conversion ambiguities (should still be b4b), and added Yilins unit catch on rs2 --- biogeochem/EDCanopyStructureMod.F90 | 6 +++--- biogeochem/EDPhysiologyMod.F90 | 2 +- biogeophys/EDBtranMod.F90 | 2 +- biogeophys/FatesPlantHydraulicsMod.F90 | 20 ++++++++++---------- fire/SFMainMod.F90 | 8 +++++--- main/EDMainMod.F90 | 12 ++++++------ main/EDPftvarcon.F90 | 2 +- parameter_files/fates_params_14pfts.cdl | 2 +- parameter_files/fates_params_default.cdl | 2 +- 9 files changed, 29 insertions(+), 27 deletions(-) diff --git a/biogeochem/EDCanopyStructureMod.F90 b/biogeochem/EDCanopyStructureMod.F90 index e9b0f51dbd..caf6861577 100644 --- a/biogeochem/EDCanopyStructureMod.F90 +++ b/biogeochem/EDCanopyStructureMod.F90 @@ -1422,11 +1422,11 @@ subroutine leaf_area_profile( currentSite , snow_depth_si, frac_sno_eff_si) ! is obscured by snow. layer_top_hite = currentCohort%hite - & - ( dble(iv-1.0)/currentCohort%NV * currentCohort%hite * & + ( real(iv-1,r8)/currentCohort%NV * currentCohort%hite * & EDPftvarcon_inst%crown(currentCohort%pft) ) layer_bottom_hite = currentCohort%hite - & - ( dble(iv)/currentCohort%NV * currentCohort%hite * & + ( real(iv,r8)/currentCohort%NV * currentCohort%hite * & EDPftvarcon_inst%crown(currentCohort%pft) ) fraction_exposed = 1.0_r8 @@ -1449,7 +1449,7 @@ subroutine leaf_area_profile( currentSite , snow_depth_si, frac_sno_eff_si) if(iv==currentCohort%NV) then remainder = (currentCohort%treelai + currentCohort%treesai) - & - (dinc_ed*dble(currentCohort%nv-1.0_r8)) + (dinc_ed*real(currentCohort%nv-1,r8)) if(remainder > dinc_ed )then write(fates_log(), *)'ED: issue with remainder', & currentCohort%treelai,currentCohort%treesai,dinc_ed, & diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index bd92830686..5207dbcd44 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -589,7 +589,7 @@ subroutine phenology( currentSite, bc_in ) if ((t >= currentSite%dleafondate - 30.and.t <= currentSite%dleafondate + 30).or.(t > 360 - 15.and. & currentSite%dleafondate < 15))then ! are we in the window? ! TODO: CHANGE THIS MATH, MOVE THE DENOMENATOR OUTSIDE OF THE SUM (rgk 01-2017) - if (sum(currentSite%water_memory(1:numWaterMem)/dble(numWaterMem)) & + if (sum(currentSite%water_memory(1:numWaterMem)/real(numWaterMem,r8)) & >= ED_val_phen_drought_threshold.and.currentSite%dstatus == 1.and.t >= 10)then ! leave some minimum time between leaf off and leaf on to prevent 'flickering'. if (timesincedleafoff > ED_val_phen_doff_time)then diff --git a/biogeophys/EDBtranMod.F90 b/biogeophys/EDBtranMod.F90 index 7f046dfe68..1b095a87a5 100644 --- a/biogeophys/EDBtranMod.F90 +++ b/biogeophys/EDBtranMod.F90 @@ -197,7 +197,7 @@ subroutine btran_ed( nsites, sites, bc_in, bc_out) cpatch%rootr_ft(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/dble(numpft) + cpatch%rootr_ft(ft,j) * 1._r8/real(numpft,r8) end if enddo enddo diff --git a/biogeophys/FatesPlantHydraulicsMod.F90 b/biogeophys/FatesPlantHydraulicsMod.F90 index 28c0757a8e..d27f6ebb63 100644 --- a/biogeophys/FatesPlantHydraulicsMod.F90 +++ b/biogeophys/FatesPlantHydraulicsMod.F90 @@ -411,7 +411,7 @@ subroutine updateSizeDepTreeHydProps(currentSite,cc_p,bc_in) ! TRANSPORTING ROOT DEPTH & VOLUME !in special case where n_hypool_troot = 1, the node depth of the single troot pool !is the depth at which 50% total root distribution is attained - dcumul_rf = 1._r8/dble(n_hypool_troot) + dcumul_rf = 1._r8/real(n_hypool_troot,r8) do k=1,n_hypool_troot cumul_rf = dcumul_rf*k @@ -1027,11 +1027,11 @@ subroutine updateSizeDepRhizHydProps(currentSite, bc_in ) 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) = (1._r8/kmax_root_surf_total + & - 1._r8/kmax_soil_total)**-1._r8 + 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 + 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 + 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 @@ -1042,11 +1042,11 @@ subroutine updateSizeDepRhizHydProps(currentSite, bc_in ) kmax_soil_total = 2._r8*pi_const*csite_hydr%l_aroot_1D / & log(csite_hydr%r_node_shell_1D(k)/csite_hydr%rs1(j))*hksat_s csite_hydr%kmax_upper_shell_1D(k) = (1._r8/kmax_root_surf_total + & - 1._r8/kmax_soil_total)**-1._r8 + 1._r8/kmax_soil_total)**(-1._r8) csite_hydr%kmax_bound_shell_1D(k) = (1._r8/kmax_root_surf_total + & - 1._r8/kmax_soil_total)**-1._r8 + 1._r8/kmax_soil_total)**(-1._r8) csite_hydr%kmax_lower_shell_1D(k) = (1._r8/kmax_root_surf_total + & - 1._r8/kmax_soil_total)**-1._r8 + 1._r8/kmax_soil_total)**(-1._r8) end if end if else @@ -2555,7 +2555,7 @@ subroutine Hydraulics_1DSolve(cc_p, ft, z_node, v_node, ths_node, thr_node, kmax iterh1 = 0 do while( iterh1 == 0 .or. ((abs(we_local) > thresh .or. supsub_flag /= 0) .and. iterh1 < maxiter) ) dt_fac = max(imult*iterh1,1) - dt_fac2 = DBLE(dt_fac) + dt_fac2 = real(dt_fac,r8) dt_new = dtime/dt_fac2 !! restore initial states for a fresh attempt using new sub-timesteps @@ -4101,7 +4101,7 @@ subroutine swcCampbell_satfrac_from_psi(psi, psisat, B, satfrac) ! !LOCAL VARIABLES: !------------------------------------------------------------------------------ - satfrac = (psi/psisat)**(-1/B) + satfrac = (psi/psisat)**(-1.0_r8/B) end subroutine swcCampbell_satfrac_from_psi @@ -4439,7 +4439,7 @@ subroutine shellGeom(l_aroot, rs1, area, dz, r_out_shell, r_node_shell, v_shell) r_out_shell(nshell) = (pi_const*l_aroot/(area*dz))**(-0.5_r8) ! eqn(8) S98 if(nshell > 1) then do k = 1,nshell-1 - r_out_shell(k) = rs1*(r_out_shell(nshell)/rs1)**((k+0._r8)/nshell) ! eqn(7) S98 + r_out_shell(k) = rs1*(r_out_shell(nshell)/rs1)**((real(k,r8))/real(nshell,r8)) ! eqn(7) S98 enddo end if diff --git a/fire/SFMainMod.F90 b/fire/SFMainMod.F90 index 8ad11e3fbc..2a7a1ca01c 100644 --- a/fire/SFMainMod.F90 +++ b/fire/SFMainMod.F90 @@ -245,7 +245,7 @@ subroutine charecteristics_of_fuel ( currentSite ) endif ! FIX(RF,032414): needs refactoring. ! average water content !is this the correct metric? - timeav_swc = sum(currentSite%water_memory(1:numWaterMem)) / dble(numWaterMem) + 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) @@ -769,7 +769,8 @@ subroutine area_burnt ( currentSite ) ! 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 + + ! 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) @@ -784,9 +785,10 @@ subroutine area_burnt ( currentSite ) 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 + patch_area_in_m2 = gridarea *currentPatch%area/area currentPatch%frac_burnt = currentPatch%AB / patch_area_in_m2 if(write_SF == itrue)then diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index af5256ed9f..aca5a3df14 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -330,9 +330,9 @@ subroutine ed_integrate_state_variables(currentSite, bc_in ) currentCohort%npp_acc = currentCohort%npp_acc_hold / hlm_days_per_year endif else - currentCohort%npp_acc_hold = currentCohort%npp_acc * dble(hlm_days_per_year) - currentCohort%gpp_acc_hold = currentCohort%gpp_acc * dble(hlm_days_per_year) - currentCohort%resp_acc_hold = currentCohort%resp_acc * dble(hlm_days_per_year) + 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 @@ -657,9 +657,9 @@ subroutine bypass_dynamics(currentSite) currentCohort%isnew=.false. - currentCohort%npp_acc_hold = currentCohort%npp_acc * dble(hlm_days_per_year) - currentCohort%gpp_acc_hold = currentCohort%gpp_acc * dble(hlm_days_per_year) - currentCohort%resp_acc_hold = currentCohort%resp_acc * dble(hlm_days_per_year) + 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) currentCohort%npp_acc = 0.0_r8 currentCohort%gpp_acc = 0.0_r8 diff --git a/main/EDPftvarcon.F90 b/main/EDPftvarcon.F90 index 161f0b7558..a4966fcfad 100644 --- a/main/EDPftvarcon.F90 +++ b/main/EDPftvarcon.F90 @@ -203,7 +203,7 @@ module EDPftvarcon ! PFT Dimension real(r8), allocatable :: hydr_p_taper(:) ! xylem taper exponent - real(r8), allocatable :: hydr_rs2(:) ! absorbing root radius (mm) + real(r8), allocatable :: hydr_rs2(:) ! absorbing root radius (m) real(r8), allocatable :: hydr_srl(:) ! specific root length (m g-1) real(r8), allocatable :: hydr_rfrac_stem(:) ! fraction of total tree resistance from troot to canopy real(r8), allocatable :: hydr_avuln_gs(:) ! shape parameter for stomatal control of water vapor exiting leaf diff --git a/parameter_files/fates_params_14pfts.cdl b/parameter_files/fates_params_14pfts.cdl index e0caf701d2..39f1d6ee40 100644 --- a/parameter_files/fates_params_14pfts.cdl +++ b/parameter_files/fates_params_14pfts.cdl @@ -315,7 +315,7 @@ variables: 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) ; - fates_hydr_rs2:units = "mm" ; + fates_hydr_rs2:units = "m" ; fates_hydr_rs2:long_name = "absorbing root radius" ; float fates_hydr_srl(fates_pft) ; fates_hydr_srl:units = "m g-1" ; diff --git a/parameter_files/fates_params_default.cdl b/parameter_files/fates_params_default.cdl index 49115ef41c..9684fd2c27 100644 --- a/parameter_files/fates_params_default.cdl +++ b/parameter_files/fates_params_default.cdl @@ -258,7 +258,7 @@ variables: 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) ; - fates_hydr_rs2:units = "mm" ; + fates_hydr_rs2:units = "m" ; fates_hydr_rs2:long_name = "absorbing root radius" ; float fates_hydr_srl(fates_pft) ; fates_hydr_srl:units = "m g-1" ; From 15aeb556510d1f0523119ec10ca6284d24ace569 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Tue, 30 Oct 2018 14:17:11 -0700 Subject: [PATCH 52/52] Migrated spread intialization from logical flag to two optional reals --- main/EDInitMod.F90 | 17 ++++++++++++++--- main/EDTypesMod.F90 | 15 ++++++++++++++- main/FatesInventoryInitMod.F90 | 6 ++---- 3 files changed, 30 insertions(+), 8 deletions(-) diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index 7b2d68b6d6..a25246020c 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -19,7 +19,8 @@ module EDInitMod use EDTypesMod , only : nuMWaterMem use EDTypesMod , only : maxpft use EDTypesMod , only : AREA - use EDTypesMod , only : init_dense_forest + use EDTypesMod , only : init_spread_near_bare_ground + use EDTypesMod , only : init_spread_inventory use FatesInterfaceMod , only : bc_in_type use FatesInterfaceMod , only : hlm_use_planthydro use FatesInterfaceMod , only : hlm_use_inventory_init @@ -221,8 +222,6 @@ subroutine set_site_properties( nsites, sites) sites(s)%frac_burnt = 0.0_r8 sites(s)%old_stock = 0.0_r8 - sites(s)%spread = 1.0_r8 - if(init_dense_forest)sites(s)%spread = 0._r8 end do return @@ -280,6 +279,13 @@ subroutine init_patches( nsites, sites, bc_in) if ( hlm_use_inventory_init.eq.itrue ) then + ! Initialize the site-level crown area spread factor (0-1) + ! It is likely that closed canopy forest inventories + ! have smaller spread factors than bare ground (they are crowded) + do s = 1, nsites + sites(s)%spread = init_spread_inventory + enddo + call initialize_sites_by_inventory(nsites,sites,bc_in) do s = 1, nsites @@ -294,6 +300,11 @@ subroutine init_patches( nsites, sites, bc_in) !FIX(SPM,032414) clean this up...inits out of this loop do s = 1, nsites + ! Initialize the site-level crown area spread factor (0-1) + ! It is likely that closed canopy forest inventories + ! have smaller spread factors than bare ground (they are crowded) + sites(s)%spread = init_spread_near_bare_ground + allocate(newp) newp%patchno = 1 diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 6e1ea667b7..fc9c359f67 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -69,7 +69,20 @@ module EDTypesMod ! WAS OUTSIDE THE SCOPE OF THE VERY LARGE CHANGESET WHERE THESE WERE FIRST ! INTRODUCED (RGK 03-2017) logical, parameter :: do_ed_phenology = .true. - logical, parameter :: init_dense_forest = .false. + + + ! This is the community level amount of spread expected in nearly-bare-ground + ! and inventory starting modes. + ! These are used to initialize only. These values will scale between + ! the PFT defined maximum and minimum crown area scaing parameters. + ! + ! A value of 1 indicates that + ! plants should have crown areas at maximum spread for their size and PFT. + ! 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 ! MODEL PARAMETERS diff --git a/main/FatesInventoryInitMod.F90 b/main/FatesInventoryInitMod.F90 index 4ec037f746..dcd66500b9 100644 --- a/main/FatesInventoryInitMod.F90 +++ b/main/FatesInventoryInitMod.F90 @@ -34,7 +34,7 @@ module FatesInventoryInitMod use EDTypesMod , only : ed_cohort_type use EDTypesMod , only : area use EDPftvarcon , only : EDPftvarcon_inst - use EDTypesMod , only : init_dense_forest + implicit none private @@ -929,11 +929,9 @@ subroutine set_inventory_edcohort_type1(csite,bc_in,css_file_unit,npatches, & endif ! Since spread is a canopy level calculation, we need to provide an initial guess here. - site_spread = 0.5_r8 - if(init_dense_forest)site_spread = 0.0_r8 call create_cohort(csite, cpatch, c_pft, temp_cohort%n, temp_cohort%hite, temp_cohort%dbh, & b_leaf, b_fineroot, b_sapwood, temp_cohort%bdead, temp_cohort%bstore, & - temp_cohort%laimemory, cstatus, rstatus, temp_cohort%canopy_trim, 1, site_spread, bc_in) + temp_cohort%laimemory, cstatus, rstatus, temp_cohort%canopy_trim, 1, csite%spread, bc_in) deallocate(temp_cohort) ! get rid of temporary cohort